Mail-SpamAssassin
view release on metacpan or search on metacpan
spamd/spamd.raw view on Meta::CPAN
#!/usr/bin/perl -T -w
# <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements. See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at:
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>
#IMPORTANT: The order of -T -w above is important for spamd_hup.t on Solaris 10 - changed per bug 6883
use strict;
use warnings;
use re 'taint';
my @ORIG_INC_OPTS;
BEGIN {
# bug 8030 - Save what is in @INC to capture any -I arguments passed in to use at SIGHUP restart
# This is done before any use lib statements add anything else to @INC
my %orig_inc;
for (my $i = $#INC; $i >=0; $i--) {
my $path = $INC[$i];
if (!$orig_inc{$path}) { # more stringent checking will done later after more modules are loaded
$orig_inc{$path} = 1;
unshift(@ORIG_INC_OPTS, $path);
}
}
}
my $PREFIX = '@@PREFIX@@'; # substituted at 'make' time
my $DEF_RULES_DIR = '@@DEF_RULES_DIR@@'; # substituted at 'make' time
my $LOCAL_RULES_DIR = '@@LOCAL_RULES_DIR@@'; # substituted at 'make' time
my $LOCAL_STATE_DIR = '@@LOCAL_STATE_DIR@@'; # substituted at 'make' time
use lib '@@INSTALLSITELIB@@'; # substituted at 'make' time
# added by jm for use inside the distro
# This is disabled during the "make install" process.
BEGIN {
if ( -e '../blib/lib/Mail/SpamAssassin.pm' ) { # REMOVEFORINST
unshift ( @INC, '../blib/lib' ); # REMOVEFORINST
} else { # REMOVEFORINST
unshift ( @INC, '../lib' ); # REMOVEFORINST
} # REMOVEFORINST
}
our ($have_getaddrinfo_in_core, $have_getaddrinfo_legacy, $io_socket_module_name,
$have_inet4, $have_inet6, $ai_addrconfig_flag);
# don't force requirement on IO::Socket::IP or IO::Socket::INET6
BEGIN {
require Socket;
$have_getaddrinfo_in_core = eval {
# The Socket module (1.94) bundled with Perl 5.14.* provides
# new affordances for IPv6, including implementations of the
# Socket::getaddrinfo() and Socket::getnameinfo() functions,
# along with related constants and a handful of new functions.
# Perl 5.16.0 upgrades the core Socket module to version 2.001.
# Socket->VERSION(1.94); # provides getaddrinfo() and getnameinfo()
# Socket->VERSION(1.95); # provides AI_ADDRCONFIG
Socket->VERSION(1.96); # provides NIx_NOSERV, and Exporter tag :addrinfo
# Socket->VERSION(1.97); # IO::Socket::IP depends on Socket 1.97
Socket->import(qw(/^(?:AI|NI|NIx|EAI)_/));
# AUTOLOADing 'constants' here enables inlining - see Exporter man page
&AI_ADDRCONFIG; &AI_PASSIVE;
&NI_NUMERICHOST, &NI_NUMERICSERV; &NIx_NOSERV; 1;
};
$have_getaddrinfo_legacy = !$have_getaddrinfo_in_core && eval {
require Socket6;
# Socket6->VERSION(0.13); # provides NI_NAMEREQD
Socket6->VERSION(0.18); # provides AI_NUMERICSERV
Socket6->import(qw(/^(?:AI|NI|NIx|EAI)_/));
&AI_ADDRCONFIG; &AI_PASSIVE; # enable inlining
&NI_NUMERICHOST; &NI_NUMERICSERV; &NI_NAMEREQD; 1;
};
Socket->import(qw(:DEFAULT IPPROTO_TCP));
&SOCK_STREAM; &IPPROTO_TCP; &SOMAXCONN; # enable inlining
&AF_UNSPEC; &AF_INET; &AF_INET6; # enable inlining
$ai_addrconfig_flag = 0;
if ($have_getaddrinfo_in_core) {
# using a modern Socket module
eval { # does the operating system recognize an AI_ADDRCONFIG flag?
if (&AI_ADDRCONFIG && &EAI_BADFLAGS) {
my($err, @res) = Socket::getaddrinfo("localhost", 0,
{ family => &AF_UNSPEC, flags => &AI_ADDRCONFIG });
$ai_addrconfig_flag = &AI_ADDRCONFIG if !$err || $err != &EAI_BADFLAGS;
}
};
*ip_or_name_to_ip_addresses = sub {
my($addr, $ai_family) = @_;
# Socket::getaddrinfo returns a list of hashrefs
my($error, @res) =
Socket::getaddrinfo($addr, 0,
{ family => $ai_family, flags => $ai_addrconfig_flag | &AI_PASSIVE,
socktype => &SOCK_STREAM, protocol => &IPPROTO_TCP });
my(@ip_addrs);
if (!$error) {
for my $a (@res) {
my($err, $ip_addr) =
spamd/spamd.raw view on Meta::CPAN
return ($sock->peerport, $peer_addr, $peer_hostname||$peer_addr,
$sock->sockport);
};
} else { # IPv4 only, no getaddrinfo() available
*ip_or_name_to_ip_addresses = sub {
my($addr, $ai_family) = @_;
$ai_family == &AF_UNSPEC || $ai_family == &AF_INET
or die "Protocol family $ai_family not supported on this platform";
my($error, @ip_addrs, @binaddr);
$! = 0; my @res = gethostbyname($addr);
if (!@res) {
$error = "no results from gethostbyname $!";
} else {
my($name,$aliases,$addrtype,$length);
($name,$aliases,$addrtype,$length,@binaddr) = @res;
}
if (!@binaddr) {
$error = "no such host";
} else {
for (@binaddr) {
my $ip_addr = Socket::inet_ntoa($_);
push(@ip_addrs, $ip_addr) if $ip_addr;
}
}
return ($error, @ip_addrs);
};
*peer_info_from_socket = sub {
my $sock = shift;
my ($peer_port, $in_addr) = Socket::sockaddr_in($sock->peername)
or return;
my $peer_addr = Socket::inet_ntoa($in_addr) or return;
my $peer_hostname = gethostbyaddr($in_addr, &AF_INET);
return ($peer_port, $peer_addr, $peer_hostname||$peer_addr,
$sock->sockport);
};
}
if (eval { require IO::Socket::IP }) { # handles IPv6 and IPv4
IO::Socket::IP->VERSION(0.09); # implements IPV6_V6ONLY
$io_socket_module_name = 'IO::Socket::IP';
} elsif (eval { require IO::Socket::INET6 }) { # handles IPv6 and IPv4
$io_socket_module_name = 'IO::Socket::INET6';
} elsif (eval { require IO::Socket::INET }) { # IPv4 only
$io_socket_module_name = 'IO::Socket::INET';
}
$have_inet4 = # can we create a PF_INET socket?
defined $io_socket_module_name && eval {
my $sock =
$io_socket_module_name->new(LocalAddr => '0.0.0.0', Proto => 'tcp');
$sock->close or die "error closing socket: $!" if $sock;
$sock ? 1 : undef;
};
$have_inet6 = # can we create a PF_INET6 socket?
defined $io_socket_module_name &&
$io_socket_module_name ne 'IO::Socket::INET' &&
eval {
my $sock =
$io_socket_module_name->new(LocalAddr => '::', Proto => 'tcp');
$sock->close or die "error closing socket: $!" if $sock;
$sock ? 1 : undef;
};
}
use IO::Handle;
use IO::Pipe;
use IO::File ();
use Mail::SpamAssassin;
use Mail::SpamAssassin::NetSet;
use Mail::SpamAssassin::SubProcBackChannel;
use Mail::SpamAssassin::SpamdForkScaling qw(:pfstates);
use Mail::SpamAssassin::Logger qw(:DEFAULT log_message);
use Mail::SpamAssassin::Util qw(untaint_var untaint_file_path secure_tmpdir
exit_status_str am_running_on_windows
get_user_groups force_die);
use Mail::SpamAssassin::Timeout;
use Getopt::Long;
use POSIX qw(:sys_wait_h);
use POSIX qw(locale_h setsid sigprocmask);
use Errno;
use Fcntl qw(:flock);
use Cwd ();
use File::Spec 0.8;
use File::Path;
use Carp ();
use Time::HiRes qw(time);
use constant RUNNING_ON_MACOS => ($^O =~ /^darwin/oi);
# Check to make sure the script version and the module version matches.
# If not, die here! Also, deal with unchanged VERSION macro.
if ($Mail::SpamAssassin::VERSION ne '@@VERSION@@' && '@@VERSION@@' ne "\@\@VERSION\@\@") {
die 'spamd: spamd script is v@@VERSION@@, but using modules v'.$Mail::SpamAssassin::VERSION."\n";
}
# Bug 3062: SpamAssassin should be "locale safe"
POSIX::setlocale(LC_TIME,'C');
my %resphash = (
EX_OK => 0, # no problems
EX_USAGE => 64, # command line usage error
EX_DATAERR => 65, # data format error
EX_NOINPUT => 66, # cannot open input
EX_NOUSER => 67, # addressee unknown
EX_NOHOST => 68, # host name unknown
EX_UNAVAILABLE => 69, # service unavailable
EX_SOFTWARE => 70, # internal software error
EX_OSERR => 71, # system error (e.g., can't fork)
EX_OSFILE => 72, # critical OS file missing
EX_CANTCREAT => 73, # can't create (user) output file
spamd/spamd.raw view on Meta::CPAN
if ($opt{'min-children'} < 1) {
$opt{'min-children'} = 1;
}
if ($opt{'min-spare'} < 0) {
$opt{'min-spare'} = 0;
}
if ($opt{'min-spare'} > $childlimit) {
$opt{'min-spare'} = $childlimit-1;
}
if ($opt{'max-spare'} < $opt{'min-spare'}) {
# emulate Apache behaviour:
# http://httpd.apache.org/docs-2.0/mod/prefork.html#maxspareservers
$opt{'max-spare'} = $opt{'min-spare'}+1;
}
my $dontcopy = 1;
if ( $opt{'create-prefs'} ) { $dontcopy = 0; }
my $orighome;
if ( defined $ENV{'HOME'} ) {
if ( defined $opt{'username'} )
{ # spamd is going to run as another user, so reset $HOME
if ( my $nh = ( getpwnam( $opt{'username'} ) )[7] ) {
$ENV{'HOME'} = $nh;
}
else {
die "spamd: unable to determine home directory for user '"
. $opt{'username'} . "'\n";
}
}
$orighome = $ENV{'HOME'}; # keep a copy for use by Razor, Pyzor etc.
delete $ENV{'HOME'}; # we do not want to use this when running spamd
}
# Do welcomelist later in tmp dir. Side effect: this will be done as -u user.
# Initialize SSL options
$opt{'server-key'} ||= "$LOCAL_RULES_DIR/certs/server-key.pem";
$opt{'server-cert'} ||= "$LOCAL_RULES_DIR/certs/server-cert.pem";
$opt{'ssl-verify'} = 1 if $opt{'ssl-ca-file'} || $opt{'ssl-ca-path'};
$opt{'ssl'} ||= $opt{'ssl-verify'};
if ($opt{'ssl-ca-file'} && !-e $opt{'ssl-ca-file'}) {
die "spamd: ssl-ca-file $opt{'ssl-ca-file'} does not exist\n";
}
if ($opt{'ssl-ca-path'} && !-e $opt{'ssl-ca-path'}) {
die "spamd: ssl-ca-path $opt{'ssl-ca-path'} does not exist\n";
}
# ---------------------------------------------------------------------------
# Server (listening) socket setup for the various supported types
dbg("spamd: socket module of choice: %s %s, Socket %s".
", %s PF_INET, %s PF_INET6, %s, AI_ADDRCONFIG %s",
$io_socket_module_name,
$io_socket_module_name->VERSION,
Socket->VERSION,
$have_inet4 ? 'have' : 'no',
$have_inet6 ? 'have' : 'no',
$have_getaddrinfo_in_core ? 'using Socket::getaddrinfo'
: $have_getaddrinfo_legacy ? 'using legacy Socket6::getaddrinfo'
: 'no getaddrinfo, using gethostbyname, IPv4-only',
$ai_addrconfig_flag ? "is supported" : "not supported",
);
my $have_ssl_module;
my @listen_sockets; # list of hashrefs, contains info on all listen sockets
my $server_select_mask;
my @listen_socket_specs = @{$opt{'listen-sockets'}};
{ # merge legacy option --socketpath into @listen_socket_specs
my $socketpath = $opt{'socketpath'};
if (defined $socketpath && $socketpath ne '') {
$socketpath =~ m{^/}
or die "socketpath option should specify an absolute path: $socketpath";
push(@listen_socket_specs, $socketpath);
}
}
# supply a default socket (loopback IP address) if none specified
push(@listen_socket_specs, 'localhost') if !@listen_socket_specs;
for (@listen_socket_specs) {
my $socket_specs = $_;
$socket_specs = '*' if $socket_specs eq ''; # empty implies all interfaces
local($1,$2,$3,$4,$5,$6);
if ($socket_specs =~
m{^ (?: (ssl) : )?
( / .* ) \z }xsi) { # unix socket - absolute path
my($proto,$path) = ($1, $2);
# $proto = 'ssl' if defined $opt{'ssl'} || defined $opt{'ssl-port'};
$proto = !defined($proto) ? '' : lc($proto);
# abstracted out the setup-retry code
dbg("spamd: unix socket: %s", $path);
server_sock_setup(\&server_sock_setup_unix, $socket_specs, $path);
} elsif ($socket_specs =~
m{^ (?: (ssl) : )?
(?: \[ ( [^\]]* ) \]
| ( [a-z0-9._-]* )
| ( [a-f0-9]* : [a-f0-9]* : [a-f0-9:]*
(?: % [a-z0-9._~-]* )? \z )
| ( \* )
)?
(?: : ( [a-z0-9-]* ) )? \z }xsi) {
my($proto,$addr,$port) = ($1, $2||$3||$4||$5, $6);
$addr = 'localhost' if !defined $addr;
$proto = 'ssl' if defined $opt{'ssl'} || defined $opt{'ssl-port'};
$proto = !defined($proto) ? '' : lc($proto);
$port = $opt{'ssl-port'} if !defined $port && $proto eq 'ssl';
$port = $opt{'port'} if !defined $port || $port eq '';
$port = '783' if !defined $port || $port eq '';
if ($port ne '' && $port !~ /^(\d+)\z/) {
$port = ( getservbyname($port,'tcp') )[2];
$port or die "spamd: invalid port: $port, socket: $socket_specs\n";
}
spamd/spamd.raw view on Meta::CPAN
my $server_unix = IO::Socket::UNIX->new(%socket);
# sanity check! cf. bug 3490
if (not $server_unix or not -S $path) {
unless ($server_unix) {
dbg "spamd: socket path might have been truncated due to system limits\n";
die "spamd: could not create UNIX socket on $path: $!\n";
}
my $hostpath = $server_unix->hostpath();
if ($hostpath ne $path) {
warn "spamd: socket path was truncated at position " . length($hostpath) . "\n";
warn "spamd: leaving stale socket at $hostpath\n" if -S $hostpath;
die "spamd: path length for UNIX socket on $path exceeds system limit, exiting\n";
}
else {
die "spamd: could not find newly-created UNIX socket on $path: $!\n";
}
}
my $mode = $opt{socketmode};
if ($mode) {
$mode = oct $mode;
} else {
$mode = 0666; # default
}
my $owner = $opt{socketowner};
my $group = $opt{socketgroup};
if ($owner || $group) {
my $uid = -1;
my $gid = -1;
if ($owner) {
my ($login,$pass,$puid,$pgid) = getpwnam($owner)
or die "spamd: $owner not in passwd database\n";
$uid = $puid;
}
if ($group) {
my ($name,$pass,$ggid,$members) = getgrnam($group)
or die "spamd: $group not in group database\n";
$gid = $ggid;
}
if (!chown $uid, $gid, $path) {
die "spamd: could not chown $path to $uid/$gid: $!";
}
}
if (!chmod $mode, $path) { # make sure everybody can talk to it
die "spamd: could not chmod $path to $mode: $!";
}
push(@listen_sockets, { specs => $socket_specs,
path => $path,
socket => $server_unix,
fd => $server_unix->fileno }) if $server_unix;
1;
}
sub server_sock_setup_inet {
my($socket_specs, $addr, $port, $ssl) = @_;
$have_inet4 || $have_inet6
or warn "spamd: neither the PF_INET (IPv4) nor the PF_INET6 (IPv6) ".
"protocol families seem to be available, pushing our luck anyway\n";
my $ai_family = &AF_UNSPEC; # defaults to any address family (i.e. both)
if ($have_inet6 && (!$have_inet4 || $opt{'force_ipv6'})) {
$ai_family = &AF_INET6;
} elsif ($have_inet4 && (!$have_inet6 || $opt{'force_ipv4'})) {
$ai_family = &AF_INET;
}
my($error, @addresses);
if (!defined $addr || lc $addr eq 'localhost') { # loopback interface
push(@addresses, '::1')
if $ai_family == &AF_UNSPEC || $ai_family == &AF_INET6;
push(@addresses, '127.0.0.1')
if $ai_family == &AF_UNSPEC || $ai_family == &AF_INET;
} elsif ($addr eq '*' || $addr eq '') { # any address
push(@addresses, '::')
if $ai_family == &AF_UNSPEC || $ai_family == &AF_INET6;
push(@addresses, '0.0.0.0')
if $ai_family == &AF_UNSPEC || $ai_family == &AF_INET;
} else {
($error, @addresses) = ip_or_name_to_ip_addresses($addr, $ai_family);
}
die "spamd: invalid address for a listen socket: \"$socket_specs\": $error\n"
if $error;
die "spamd: no valid address for a listen socket: \"$socket_specs\"\n"
if !@addresses;
dbg("spamd: attempting to listen on IP addresses: %s, port %d",
join(', ',@addresses), $port);
my(@diag_succ, @diag_fail);
for my $adr (@addresses) {
my %sockopt = (
LocalAddr => $adr,
LocalPort => $port,
Type => &SOCK_STREAM,
Proto => 'tcp',
ReuseAddr => 1,
Listen => &SOMAXCONN,
);
$sockopt{V6Only} = 1 if $io_socket_module_name eq 'IO::Socket::IP'
&& IO::Socket::IP->VERSION >= 0.09;
if ($ssl) {
if (!$have_ssl_module) {
eval { require IO::Socket::SSL; }
or die "spamd: SSL encryption requested, ".
"but IO::Socket::SSL is unavailable ($@)\n";
$have_ssl_module = 1;
}
%sockopt = (%sockopt, (
SSL_server => 1,
SSL_key_file => $opt{'server-key'},
SSL_cert_file => $opt{'server-cert'},
SSL_on_peer_shutdown => sub { return 0 },
));
my $ssl_mode;
if ($opt{'ssl-verify'}) {
$ssl_mode = Net::SSLeay::VERIFY_PEER()
| Net::SSLeay::VERIFY_FAIL_IF_NO_PEER_CERT();
if ($opt{'ssl-ca-file'}) {
$sockopt{SSL_ca_file} = $opt{'ssl-ca-file'};
}
if ($opt{'ssl-ca-path'}) {
$sockopt{SSL_ca_path} = $opt{'ssl-ca-path'};
}
$sockopt{SSL_check_crl} = 0;
$sockopt{SSL_verifycn_scheme} = 'none';
( run in 1.890 second using v1.01-cache-2.11-cpan-5837b0d9d2c )