--- spamd.raw Thu Sep 5 12:47:38 2002 +++ /u/n/m/nmueller/work/spamassassin-2.41/spamd/spamd.raw Wed Sep 25 14:37:08 2002 @@ -12,7 +12,9 @@ use lib '../lib'; # added by jm for use inside the distro use strict; -use Socket; +use IO::Socket; +use IO::Handle; use Carp; use Config; use Mail::SpamAssassin; @@ -48,6 +50,9 @@ my @OLD_ARGV = @ARGV; # Getopt::Long tends to clear @ARGV Getopt::Long::Configure ("bundling"); GetOptions( + 'server-key=s' => \$opt{'server-key'}, + 'server-cert=s' => \$opt{'server-cert'}, + 'ssl' => \$opt{'ssl'}, 'auto-whitelist|whitelist|a' => \$opt{'auto-whitelist'}, 'create-prefs!', => \$opt{'create-prefs'}, 'c' => \$opt{'create-prefs'}, 'daemonize!' => \$opt{'daemonize'}, 'd' => \$opt{'daemonize'}, @@ -79,6 +84,24 @@ $opt{'help'} and pod2usage(-exitval => $resphash{'EX_USAGE'}, -verbose => 0, -message => 'For more details, use "man spamd"'); +# Check for server certs +$opt{'server-key'} ||= "$LOCAL_RULES_DIR/certs/server-key.pem"; +$opt{'server-cert'} ||= "$LOCAL_RULES_DIR/certs/server-cert.pem"; +if ($opt{'ssl'}) +{ + require IO::Socket::SSL; + + if (!-e $opt{'server-key'}) + { + die "The server key file $opt{'server-key'} does not exist"; + } + if (!-e $opt{'server-cert'}) + { + die "The server certificate file $opt{'server-cert'} does not exist"; + } +} + # These can be changed on command line with -A flag if(@{$opt{'allowed-ip'}}) { @@ -138,16 +161,36 @@ setlogsock($socktype) unless $log_facility eq 'stderr'; my $port = $opt{'port'} || 783; -my $addr = gethostbyname($opt{'listen-ip'} || '127.0.0.1'); +my $addr = (gethostbyname($opt{'listen-ip'} || '127.0.0.1'))[0]; my $proto = getprotobyname('tcp'); ($port) = $port =~ /^(\d+)$/ or die "invalid port"; # Be a well-behaved daemon -socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; -setsockopt(Server,SOL_SOCKET,SO_REUSEADDR,pack("l",1)) || die "setsockopt: $!"; -bind(Server, sockaddr_in($port, $addr)) || die "bind: $!"; -listen(Server,SOMAXCONN) || die "listen: $!"; +my $server; +if ($opt{'ssl'}) +{ + $server = new IO::Socket::SSL(LocalAddr => $addr, + LocalPort => $port, + Proto => $proto, + Type => SOCK_STREAM, + ReuseAddr => 1, + Listen => 5, + SSL_verify_mode => 0x00, + SSL_key_file => $opt{'server-key'}, + SSL_cert_file => $opt{'server-cert'}) + || die "new IO::Socket::SSL: $! $@"; +} +else +{ + $server = new IO::Socket::INET(LocalAddr => $addr, + LocalPort => $port, + Proto => $proto, + Type => SOCK_STREAM, + ReuseAddr => 1, + Listen => 10) + || die "new IO::Socket::INET: $! $@"; +} $opt{'daemonize'} and daemonize(); @@ -205,6 +248,7 @@ my $current_user; my $paddr; +my $client; sub REAPER { # Adapted from the perlipc manpage cleanupchildren; @@ -227,12 +271,13 @@ } logmsg "server started on port $port (running version ".Mail::SpamAssassin::Version().")"; -for ( ; ($paddr = accept(Client,Server)) ; close Client) +while (1) { - + $client = $server->accept + || next; my $start = time; - my($port,$iaddr) = sockaddr_in($paddr); + my($port,$iaddr) = sockaddr_in($client->peername); my $name = gethostbyaddr($iaddr,AF_INET); if (ip_is_allowed(inet_ntoa($iaddr))) { @@ -241,17 +286,20 @@ } else { logmsg "unauthorized connection from $name [", inet_ntoa($iaddr),"] at port $port"; + $client->close; next; } spawn sub { $|=1; # always immediately flush output + my ($client) = @_; + # First request line off stream - local $_ = ; + local $_ = <$client>; if (!defined $_) { - protocol_error ("(closed before headers)"); + protocol_error ("(closed before headers)", $client); return 1; } @@ -285,10 +333,10 @@ { while(1) { - $_ = ; + $_ = <$client>; if(!defined $_) { - protocol_error ("(EOF during headers)"); + protocol_error ("(EOF during headers)", $client); return 1; } @@ -348,7 +396,7 @@ my $actual_length; my $in_header = 1; my $msgid; - for () { + while (<$client>) { if ($in_header) { if (/^$/) { $in_header = 0; @@ -363,6 +411,7 @@ } push(@msglines, $_); $actual_length += length; + last if $actual_length == $expected_length; } logmsg "checking message $msgid for $current_user:$>" . @@ -403,9 +452,9 @@ { $response_header .= "Spam: False ; $msg_score / $msg_threshold"; } - print $response_header, "\r\n\r\n"; - print $status->get_names_of_tests_hit,"\r\n" if ($method eq "SYMBOLS"); - print $status->get_report,"\r\n" if ($method eq "REPORT" or $method eq "REPORT_IFSPAM" and $status->is_spam); + print $client $response_header, "\r\n\r\n"; + print $client $status->get_names_of_tests_hit,"\r\n" if ($method eq "SYMBOLS"); + print $client $status->get_report,"\r\n" if ($method eq "REPORT" or $method eq "REPORT_IFSPAM" and $status->is_spam); $current_user ||= '(unknown)'; logmsg "$was_it_spam ($msg_score/$msg_threshold) for $current_user:$> in ". sprintf("%3d", time - $start) ." seconds, $actual_length bytes.\n"; @@ -429,10 +478,10 @@ { while(1) { - $_ = ; + $_ = <$client>; if(!defined $_) { - protocol_error ("(EOF during headers)"); + protocol_error ("(EOF during headers)", $client); return 1; } @@ -492,7 +541,7 @@ my $actual_length; my $in_header = 1; my $msgid; - for () { + while (<$client>) { if ($in_header) { if (/^$/) { $in_header = 0; @@ -507,6 +556,7 @@ } push(@msglines, $_); $actual_length += length; + last if $actual_length == $expected_length; } logmsg "processing message $msgid for $current_user:$>" . @@ -519,7 +569,8 @@ # Check length if we're supposed to if($expected_length) { - if($actual_length != $expected_length) { protocol_error ("(Content-length mismatch: $expected_length vs. $actual_length)"); return 1; } + if($actual_length != $expected_length) { + protocol_error ("(Content-length mismatch: $expected_length vs. $actual_length)", $client); return 1; } } # Now use copy-on-writed (hopefully) SA object @@ -531,13 +582,13 @@ my $msg_resp_length = length($msg_resp); if($version >= 1.2) # Spamc protocol 1.2 means it accepts content-length { - print "SPAMD/1.1 $resphash{$resp} $resp\r\n", + print $client "SPAMD/1.1 $resphash{$resp} $resp\r\n", "Content-length: $msg_resp_length\r\n\r\n", $msg_resp; } else # Earlier than 1.2 didn't accept content-length { - print "SPAMD/1.0 $resphash{$resp} $resp\r\n", + print $client "SPAMD/1.0 $resphash{$resp} $resp\r\n", $msg_resp; } my $was_it_spam; @@ -555,7 +606,7 @@ else { - protocol_error ($_); + protocol_error ($_, $client); } }; @@ -566,13 +617,15 @@ # essentially does this! cleanupchildren; + $client->close; } sub protocol_error { local $_ = shift; + my $client = shift; my $resp = "EX_PROTOCOL"; - print "SPAMD/1.0 $resphash{$resp} Bad header line: $_\r\n"; + print $client "SPAMD/1.0 $resphash{$resp} Bad header line: $_\r\n"; logmsg "bad protocol: header error: $_"; } @@ -605,10 +658,10 @@ } # else I'm the child -- go spawn - close Server; - open(STDIN, "<&Client") || die "can't dup client to stdin"; - open(STDOUT, ">&Client") || die "can't dup client to stdout"; - exit &$coderef(); + $server->close; + #STDIN->fdopen($client, "r") || die "can't dup client to stdin"; + #STDOUT->fdopen($client, "w")|| die "can't dup client to stdout"; + exit &$coderef($client); } sub handle_user @@ -773,7 +826,7 @@ { my ($sig) = @_; logmsg "server killed by SIG$sig, shutting down"; - close Server; + $server->close; defined($opt{'pidfile'}) and unlink($opt{'pidfile'}); exit 0; } @@ -855,6 +908,9 @@ -V, --virtual-config=dir Enable Virtual configs (needs -x) -r pidfile, --pidfile Write the process id to pidfile -s facility, --syslog=facility Specify the syslog facility (default: mail) + --server-key keyfile Specify an SSL keyfile + --server-cert certfile Specify an SSL certificate + --ssl Run an SSL server -u username, --username=username Run as username -v, --vpopmail Enable vpopmail config -x, --nouser-config Disable user config files