steffen: server/kolab/kolab kolab_smtpdpolicy,NONE,1.1

cvs at intevation.de cvs at intevation.de
Mon Jun 7 12:04:14 CEST 2004


Author: steffen

Update of /kolabrepository/server/kolab/kolab
In directory doto:/tmp/cvs-serv19722

Added Files:
	kolab_smtpdpolicy 
Log Message:
policy server skeleton

--- NEW FILE: kolab_smtpdpolicy ---
#!@l_prefix@/bin/perl

##
##  Copyright (c) 2004  Klaraelvdalens Datakonsult AB
##
##    Writen by Steffen Hansen <steffen at klaralvdalens-datakonsult.se>
##
##  This  program is free  software; you can redistribute  it and/or
##  modify it  under the terms of the GNU  General Public License as
##  published by the  Free Software Foundation; either version 2, or
##  (at your option) any later version.
##
##  This program is  distributed in the hope that it will be useful,
##  but WITHOUT  ANY WARRANTY; without even the  implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
##  General Public License for more details.
##
##  You can view the  GNU General Public License, online, at the GNU
##  Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
##

use Fcntl;
use Sys::Syslog qw(:DEFAULT setlogsock);
use URI;
use Net::LDAP;
use Net::LDAP::Entry;

#
# Usage: kolab_smtpd_policy.pl [-v]
#
# Delegated Postfix SMTPD policy server for Kolab. This server implements
# various policies for Kolab:
#
# 1) Only authenticated users can use From addresses <username>@$domain
# 2) Some distribution lists are only available to authenticated users
#
# Logging is sent to syslogd.
#
# How it works: each time a Postfix SMTP server process is started
# it connects to the policy service socket, and Postfix runs one
# instance of this PERL script.  By default, a Postfix SMTP server
# process terminates after 100 seconds of idle time, or after serving
# 100 clients. Thus, the cost of starting this PERL script is smoothed
# out over time.
#
# To run this from /etc/postfix/master.cf:
#
#    policy  unix  -       n       n       -       -       spawn
#      user=kolab-n argv=/usr/bin/perl /usr/libexec/postfix/kolab_smtpd_policy.pl
#
# To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
#
#    smtpd_recipient_restrictions =
#	...
#	reject_unauth_destination
#	check_policy_service unix:private/policy
#	...
#
# NOTE: specify check_policy_service AFTER reject_unauth_destination
# or else your system can become an open relay.
#
# To test this script by hand, execute:
#
#    % perl kolab_smtpd_policy.pl
#
# Each query is a bunch of attributes. Order does not matter, and
# the demo script uses only a few of all the attributes shown below:
#
#    request=smtpd_access_policy
#    protocol_state=RCPT
#    protocol_name=SMTP
#    helo_name=some.domain.tld
#    queue_id=8045F2AB23
#    sender=foo at bar.tld
#    recipient=bar at foo.tld
#    client_address=1.2.3.4
#    client_name=another.domain.tld
#    instance=123.456.7
#    sasl_method=plain
#    sasl_username=you
#    sasl_sender=
#    size=12345
#    [empty line]
#
# The policy server script will answer in the same style, with an
# attribute list followed by a empty line:
#
#    action=dunno
#    [empty line]
#

#
# Syslogging options for verbose mode and for fatal errors.
# NOTE: comment out the $syslog_socktype line if syslogging does not
# work on your system.
#
$syslog_socktype = 'unix'; # inet, unix, stream, console
$syslog_facility="mail";
$syslog_options="pid";
$syslog_priority="info";

sub mylog {
  my $prio = shift;
  my $fmt = shift;

  my $text = sprintf( $fmt, @_ );

  #Kolab::log( 'P', $text );
  syslog $prio, $text;
}

#
# SMTPD access policy routine. The result is an action just like
# it would be specified on the right-hand side of a Postfix access
# table.  Request attributes are available via the %attr hash.
#
sub smtpd_access_policy {

  # Get relevant attributes
  my $sender = $attr{'sender'};
  my $recip  = $attr{'recipient'};
  my $username = $attr{'sasl_username'};

  mylog($syslog_priority, "Checking sender=\"$sender\", recipient=\"$recip\", username=\"$username\"") if $verbose;

  #### This should probably be simplifed to 
  #### reject sender <anything>@domain.tld if the user is
  #### not authenticated

  # Check for allowed sender
  my $mesg = $ldap->search( base=> $conf_ldapbase,
			    scope=> 'sub', filter=> "(&(mail=$sender)(objectclass=kInetOrgPerson))");
  if( !$mesg->code ) {
    mylog($syslog_priority, "LDAP search returned ".$mesg->count()." objects") if $verbose;
    foreach $ldapobject ($mesg->entries) {
      mylog($syslog_priority, "Got object ".$ldapobject->get_value('uid') ) if $verbose;
      if( $username eq $ldapobject->get_value('uid') ) {
	# All OK, user is sending as herself
	mylog($syslog_priority, "$username using valid from address $sender") if $verbose;	
      } else {
	# UPS, fake sender
	mylog($syslog_priority, "Attempt to fake address $sender") if $verbose;	
	return "REJECT Invalid sender";
      }
    }
  } else {
    # LDAP error?
    mylog($syslog_priority, "Query returned error: ".$mesg->error ) if $verbose;	
  }

  # Now check for valid access to restricted distribution lists
  if( !$username ) {
    $recip =~ /(.*)@(.*)/;
    my $cn = $1;
    my $domain = $2;
    if( $domain eq $Kolab::config{'postfix-mydomain'} ) {
      $mesg = $ldap->search( base=> 'cn=internal,'.$Kolab::config{'base_dn'},
			     scope=> 'one', filter=> "(&(cn=$recip)(objectclass=groupOfNames)");
      if( !$mesg->code && $mesg->count() > 0 ) {
	# Ups, recipient is a restricted list, reject
	mylog( $syslog_priority, "Attempt from $sender to access restricted list $recip" ) if $verbose;	
	return "REJECT Access denied";
      }
    }
  }

  # The result can be any action that is allowed in a Postfix access(5) map.
  #
  # To label mail, return ``PREPEND'' headername: headertext
  #
  # In case of success, return ``DUNNO'' instead of ``OK'' so that the
  # check_policy_service restriction can be followed by other restrictions.
  #
  # In case of failure, specify ``DEFER_IF_PERMIT optional text...''
  # so that mail can still be blocked by other access restrictions.

  mylog($syslog_priority, "sender $sender, recipient $recip seems ok") if $verbose;

  return "DUNNO";
}

#
# Log an error and abort.
#
sub fatal_exit {
    my($first) = shift(@_);
    mylog("err", "fatal: $first", @_);
    exit 1;
}

#
# Signal 11 means that we have crashed perl
#
sub sigsegv_handler {
    fatal_exit "Caught signal 11;";
}

$SIG{'SEGV'} = 'sigsegv_handler';

#
# This process runs as a daemon, so it can't log to a terminal. Use
# syslog so that people can actually see our messages.
#
setlogsock $syslog_socktype;
openlog $0, $syslog_options, $syslog_facility;

#
# We don't need getopt() for now.
#
while ($option = shift(@ARGV)) {
  if ($option eq "-v") {
    $verbose = 1;
  } elsif ($option eq '-ldap') {
    $conf_ldapuri = shift(@ARGV);
  } elsif ($option eq '-base') {
    $conf_ldapbase = shift(@ARGV);
  } else {
    mylog( $syslog_priority, "Invalid option: %s. Usage: %s [-v] -ldap <uri> -base <base_dn>",
	   $option, $0);
    exit 1;
  }
}

#
# Unbuffer standard output.
#
select((select(STDOUT), $| = 1)[0]);

#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
my $ldapuri = URI->new($conf_ldapuri) || fatal_exit("error: could not parse given uri");
$ldap = Net::LDAP->new($ldapuri->host, port=> $ldapuri->port) || fatal_exit("could not connect ldap server");
if ($ldap) {
  # $ldap->bind($Kolab::config{'bind_dn'}, password=> $Kolab::config{'bind_pw'}) 
  #   || warn "could not bind to ldap";
  $ldap->bind || fatal_exit("could not bind");
} else {
  fatal_exit( "Could not contact LDAP server" );
}

while (<STDIN>) {
    if (/([^=]+)=(.*)\n/) {
	$attr{substr($1, 0, 512)} = substr($2, 0, 512);
    } elsif ($_ eq "\n") {
	if ($verbose) {
	    for (keys %attr) {
		mylog( $syslog_priority, "Attribute: %s=%s", $_, $attr{$_});
	    }
	}
	fatal_exit "unrecognized request type: '%s'", $attr{'request'}
	    unless $attr{'request'} eq "smtpd_access_policy";
	$action = smtpd_access_policy();
	mylog( $syslog_priority, "Action: %s", $action) if $verbose;
	print STDOUT "action=$action\n\n";
	%attr = ();
    } else {
	chop;
	mylog( $syslog_priority, "warning: ignoring garbage: %.100s", $_);
    }
}





More information about the commits mailing list