Mailing List Archive

Author: jm
Date: Tue Aug 29 10:09:31 2006
New Revision: 438116

URL: http://svn.apache.org/viewvc?rev=438116&view=rev
Log:
bug 4603: Mail::SpamAssassin::Spamd::Apache2 -- mod_perl2 module, implementing spamd as a mod_perl module, contributed as a Google Summer of Code project by Radoslaw Zielinski

Added:
spamassassin/trunk/spamd-apache2/
spamassassin/trunk/spamd-apache2/MANIFEST
spamassassin/trunk/spamd-apache2/MANIFEST.SKIP
spamassassin/trunk/spamd-apache2/META.yml
spamassassin/trunk/spamd-apache2/Makefile.PL
spamassassin/trunk/spamd-apache2/README.apache
spamassassin/trunk/spamd-apache2/bin/
spamassassin/trunk/spamd-apache2/bin/Bench-spamd.pl (with props)
spamassassin/trunk/spamd-apache2/bin/Spamd (with props)
spamassassin/trunk/spamd-apache2/bin/apache-spamd.pl (with props)
spamassassin/trunk/spamd-apache2/lib/
spamassassin/trunk/spamd-apache2/lib/Mail/
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd.pm
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2.pm
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclIP.pm
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclRFC1413.pm
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/Config.pm
spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Config.pm
spamassassin/trunk/spamd-apache2/t/
spamassassin/trunk/spamd-apache2/t/30run.t
spamassassin/trunk/spamd-apache2/t/TEST.PL
spamassassin/trunk/spamd-apache2/t/certs/
spamassassin/trunk/spamd-apache2/t/certs/Makefile
spamassassin/trunk/spamd-apache2/t/certs/server.crt
spamassassin/trunk/spamd-apache2/t/certs/server.csr
spamassassin/trunk/spamd-apache2/t/certs/server.key
spamassassin/trunk/spamd-apache2/t/conf/
spamassassin/trunk/spamd-apache2/t/conf/extra.last.conf.in

Added: spamassassin/trunk/spamd-apache2/MANIFEST
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/MANIFEST?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/MANIFEST (added)
+++ spamassassin/trunk/spamd-apache2/MANIFEST Tue Aug 29 10:09:31 2006
@@ -0,0 +1,21 @@
+bin/apache-spamd.pl
+bin/Bench-spamd.pl
+bin/Spamd
+lib/Mail/SpamAssassin/Spamd/Apache2/AclIP.pm
+lib/Mail/SpamAssassin/Spamd/Apache2/AclRFC1413.pm
+lib/Mail/SpamAssassin/Spamd/Apache2/Config.pm
+lib/Mail/SpamAssassin/Spamd/Apache2.pm
+lib/Mail/SpamAssassin/Spamd/Config.pm
+lib/Mail/SpamAssassin/Spamd.pm
+Makefile.PL
+MANIFEST.SKIP
+MANIFEST This list of files
+README.apache
+t/30run.t
+t/certs/Makefile
+t/certs/server.crt
+t/certs/server.csr
+t/certs/server.key
+t/conf/extra.last.conf.in
+t/TEST.PL
+META.yml Module meta-data (added by MakeMaker)

Added: spamassassin/trunk/spamd-apache2/MANIFEST.SKIP
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/MANIFEST.SKIP?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/MANIFEST.SKIP (added)
+++ spamassassin/trunk/spamd-apache2/MANIFEST.SKIP Tue Aug 29 10:09:31 2006
@@ -0,0 +1,8 @@
+(^|/)\.
+~$
+^logs/
+^t/logs/
+\.conf$
+\.pl$
+\bCVS\b
+^t/TEST$

Added: spamassassin/trunk/spamd-apache2/META.yml
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/META.yml?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/META.yml (added)
+++ spamassassin/trunk/spamd-apache2/META.yml Tue Aug 29 10:09:31 2006
@@ -0,0 +1,16 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Mail-SpamAssassin-Spamd-Apache2
+version: 0.03
+version_from:
+installdirs: site
+requires:
+ Apache::Test: 0
+ File::Path: 0
+ File::Temp: 0
+ Getopt::Long: 2.34
+ Mail::SpamAssassin: 3.001
+ mod_perl2: 2
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30

Added: spamassassin/trunk/spamd-apache2/Makefile.PL
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/Makefile.PL?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/Makefile.PL (added)
+++ spamassassin/trunk/spamd-apache2/Makefile.PL Tue Aug 29 10:09:31 2006
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+use strict;
+use ExtUtils::MakeMaker;
+use Apache::TestMM qw(test clean);
+
+unless (grep /^-?-apxs$/, @ARGV) {
+ if (my $apxs = find_in_path('apxs')) {
+ push @ARGV, '--apxs', $apxs;
+ }
+ else {
+ warn 'apxs not found in PATH; ',
+ 'try "perl Makefile.PL --apxs /path/to/apxs"', "\n";
+ }
+}
+
+Apache::TestMM::filter_args();
+Apache::TestMM::generate_script('t/TEST');
+
+WriteMakefile(
+ VERSION => '0.03',
+ NAME => 'Mail::SpamAssassin::Spamd::Apache2',
+ ABSTRACT => 'mod_perl2 module implementing spamd in Apache2',
+ AUTHOR => 'Radoslaw Zielinski <radek@pld-linux.org>',
+ EXE_FILES => [qw(bin/apache-spamd.pl)],
+ PREREQ_PM => {
+ 'mod_perl2' => 2,
+ 'Mail::SpamAssassin' => 3.001,
+ 'File::Path' => 0,
+ 'File::Temp' => 0,
+ 'Getopt::Long' => 2.34,
+ 'Apache::Test' => 0,
+ },
+);
+
+
+sub find_in_path {
+ require File::Spec;
+ my $prog = shift or die;
+ return $_
+ for grep -x, map File::Spec->catfile($_, $prog), File::Spec->path();
+ undef;
+}
+
+# Apache::Test checks if server is alive by trying "GET / HTTP/1.0".
+# Can be skipped either with this hack, or... by allowing GET.
+#sub MY::postamble {
+# "PASSENV += APACHE_TEST_PRETEND_NO_LWP=1\n"
+#}
+
+# vim: ts=4 sw=4 noet

Added: spamassassin/trunk/spamd-apache2/README.apache
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/README.apache?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/README.apache (added)
+++ spamassassin/trunk/spamd-apache2/README.apache Tue Aug 29 10:09:31 2006
@@ -0,0 +1,72 @@
+Mail::SpamAssassin::Spamd::Apache2
+==================================
+
+This distribution contains a mod_perl2 module, implementing the spamd
+protocol from the SpamAssassin (http://spamassassin.apache.org/) project
+in Apache2. It's mostly compatible with the original spamd.
+
+The apache-spamd.pl script is included to help you configuring Apache.
+
+It has been tested on Linux with perl 5.8.8 (with threads), Apache 2.2.2,
+and mod_perl 2.0.2 (DSO). Success / failure reports for other platforms
+and configurations are most welcome.
+
+Right now, consider this an alpha version.
+
+Refer to apache-spamd.pl and Mail::SpamAssassin::Spamd::Apache2::Config
+documentation (read with perldoc or man) for configuration instructions.
+
+
+TODO
+
+Hmm... done?
+
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+DEPENDENCIES
+
+ Apache version 2
+ mod_perl
+
+If you want to use SSL, you'll also need mod_ssl. mod_identd is required
+for --auth-ident.
+
+Tests use the Apache::Test framework, distributed with mod_perl and
+available separately on CPAN.
+
+
+BUGS
+
+For now, report to me directly or to the SpamAssassin dev list.
+
+Include perl, Apache and mod_perl versions. `httpd -V` shouldn't hurt
+(unless you know it doesn't matter in your case). `httpd -l` might also
+be handy, if you're reporting an apache-spamd.pl issue. Don't forget
+relevant lines from logs/error_log.
+
+Known bugs: worker (and other threading MPMs) probably will cause
+problems. SA isn't really thread-safe; one example is using umask().
+Some helpers like Razor / Pyzor / DCC probably do chdir(). I consider
+this a problem of SA, not this code.
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2006 by Radosław Zieliński <radek@pld-linux.org>
+
+Based on spamd code, (C) by The SpamAssassin(tm) Project
+
+This library is free software; you can redistribute it and/or modify it
+under the terms of the Apache License, Version 2.0.
+
+
+# vim: encoding=utf8

Added: spamassassin/trunk/spamd-apache2/bin/Bench-spamd.pl
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/bin/Bench-spamd.pl?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/bin/Bench-spamd.pl (added)
+++ spamassassin/trunk/spamd-apache2/bin/Bench-spamd.pl Tue Aug 29 10:09:31 2006
@@ -0,0 +1,231 @@
+#!/usr/bin/perl -w
+use strict;
+use Getopt::Long qw(GetOptions :config no_ignore_case);
+use Time::HiRes qw(gettimeofday tv_interval);
+
+my %opt = (
+ host => 'localhost',
+ port => 30783,
+ conc => 2,
+ max => 0,
+);
+
+GetOptions(\%opt, qw(host|h=s port|p=i conc|concurrency|c=i max|m=i));
+die "usage:\n\t$0 list of mboxes\n" unless @ARGV;
+
+my (@mboxes, $curr_mbox, $mbox_fh) = @ARGV;
+
+#my $all_all = 0;
+#for my $f (@ARGV) {
+# my $mbox = Mail::MboxParser->new($f) or die;
+# $mbox->make_index;
+# push @mboxes, $mbox;
+# print 'mbox ' . $mbox->nmsgs() . "\t$f\n";
+# $all_all += $mbox->nmsgs;
+#}
+
+use IO::Socket::INET6;
+use IO::Multiplex;
+
+my @sockets;
+my %conn = (
+ PeerAddr => $opt{host},
+ PeerPort => $opt{port},
+);
+
+my $mux = IO::Multiplex->new;
+$mux->set_callback_object(__PACKAGE__);
+
+my $msgs = 0;
+my $tempfoo;
+my $start = [gettimeofday];
+
+while ($mux->handles < $opt{conc} && new_conn()) {
+ ##warn ~~ $mux->handles();
+ die if $mux->handles > $opt{conc};
+}
+$mux->loop;
+
+my $howlong = tv_interval($start);
+my $hour = int($howlong / 3600);
+my $min = int(($howlong % 3600) / 60);
+my $sec = $howlong % 60;
+printf
+"parsed %d messages in %02d:%02d:%02d (%s s), %.4f msgs/s (%.0f msgs/min, %.0f msgs/h)\n",
+ $msgs, $hour, $min, $sec, $howlong, $msgs / $howlong, $msgs * 60 / $howlong,
+ $msgs * 60 * 60 / $howlong;
+
+#sleep 1;
+
+sub new_conn {
+ my $message = next_message() or return;
+ die 'handles: ' . $mux->handles if $mux->handles > $opt{conc};
+
+ return if $opt{max} && $msgs >= $opt{max};
+ ++$msgs;
+
+ # return 1 unless ++$tempfoo >= 6800;
+ #die "'$$message'";
+
+ my $s = IO::Socket::INET6->new(%conn) or die;
+ $mux->add($s) or die;
+ my $spamc = Spamc->new(id => $msgs, s => $s, start => [gettimeofday],);
+ $mux->set_callback_object($spamc, $s);
+ $mux->set_timeout($s, 20);
+ $mux->write($s,
+ "SYMBOLS SPAMC/1.9\r\n"
+ . 'Content-length: '
+ . length($$message)
+ . "\r\n\r\n"
+ . $$message)
+ or die;
+ 1;
+}
+
+sub next_message {
+ local $/ = "\nFrom ";
+ if ($curr_mbox && !eof $mbox_fh) {
+ my $msg = tell $mbox_fh ? <$mbox_fh> : 'From ' . <$mbox_fh>;
+ $msg =~ s/\r?\n(?:From )?$//; # (?:...) is for last message
+ return \$msg;
+ }
+ else { # end of mbox or first one
+ return unless @mboxes; # end
+ $curr_mbox = shift @mboxes;
+ close $mbox_fh if $mbox_fh;
+ open $mbox_fh, '<', $curr_mbox or die "open $curr_mbox: $!";
+ return next_message(); # ;->
+ }
+}
+
+package Spamc;
+
+sub mux_input {
+ my ($self, $mux, $fh, $in) = @_;
+
+ my $ret = $self->parse($in);
+ if (defined $ret) {
+ main::new_conn();
+ if ($ret) { # ok
+ (my $body = $self->{body}) =~ y/\r\n/ /s;
+ $self->{headers}->{spam} =~
+ /^([TF])\S+\s*;\s*(-?[\d.]+)\s*\/\s*([\d.]+)\b/
+ or die "bad Spam header: '$self->{headers}->{spam}'";
+ printf "%-8s %5s %1s %4s/%3s %s\n",
+ Time::HiRes::tv_interval($self->{start}),
+ ($self->{id} ? $self->{id} : '(wtf)'), $1, $2, $3, $body;
+ }
+ else {
+ warn 'fail for ', ($self->{id} ? $self->{id} : '(wtf)'),
+ ": $self->{rcode} $self->{rmsg}\n";
+ $mux->kill_output($fh);
+ }
+ $fh->close; # are both needed?
+ $mux->close($fh);
+ }
+
+ # undef $$in;
+ # $mux->close($fh);
+}
+
+sub mux_timeout {
+ my $self = shift;
+ my $mux = shift;
+ warn "timeout for $self->{id}\n";
+ $mux->close($self->{s});
+}
+
+sub new {
+ my $class = shift;
+ bless {@_}, $class;
+}
+
+sub parse {
+ my $self = shift;
+ my $in = ref $_[0] ? $_[0] : \$_[0];
+ my $ret;
+ while ($$in =~ /\n/
+ or defined $self->{body}
+ && (length $$in || $self->{headers}->{content_length} == 0))
+ {
+ $ret =
+ !defined $self->{banner} ? $self->banner($in)
+ : !defined $self->{body} ? $self->headers($in)
+ : $self->body($in);
+ return $ret if defined $ret;
+ }
+ undef;
+}
+
+sub banner {
+ my $self = shift;
+ my $in = shift;
+ if ($$in =~ s/^SPAMD\/(\d\.\d)\s+(\d+)\s+([^\r\n]+)\r?\n//) {
+ (@{$self}{qw(sver rcode rmsg)}) = ($1, $2, $3);
+ $self->{banner}++;
+ }
+ else {
+ warn "unparseable input from spamd: '$$in'";
+ return 0;
+ }
+ if ($self->{rcode} != 0) {
+# warn "fail: $self->{rcode} $self->{rmsg}\n";
+ return 0;
+ }
+ undef;
+}
+
+sub headers {
+ my $self = shift;
+ my $in = shift;
+ die "blah" unless $self->{banner};
+ while ($$in =~ s/^([a-z\d_-]+):\s+([^\r\n]+)\r?\n//i) {
+ my ($h, $v) = ($1, $2);
+ $h =~ y/A-Z-/a-z_/;
+ $self->{headers}->{$h} = $v;
+ }
+ die "content-length not numeric"
+ if defined $self->{headers}->{content_length}
+ && $self->{headers}->{content_length} !~ /^\d+$/;
+ if ($$in =~ s/^\r?\n//) {
+ $self->{body} = '';
+ unless ($self->{headers}->{spam}) {
+ warn "no Spam header", keys %{ $self->{headers} };
+ return 0;
+ }
+ unless (defined $self->{headers}->{content_length}) {
+ warn "Content-length is required";
+ return 0;
+ }
+ }
+ elsif ($$in =~ /\n/) {
+ warn "bad header '$$in'";
+ return 0;
+ }
+ undef;
+}
+
+sub body {
+ my $self = shift;
+ my $in = shift;
+ die "fubar"
+ unless $self->{banner} && $self->{headers} && defined $self->{body};
+ $self->{body} .= $$in;
+ $$in = '';
+ if (defined(my $l = $self->{headers}->{content_length})) {
+ if (length $self->{body} == $l) {
+ return 1;
+ }
+ elsif (length $self->{body} > $l) {
+ warn "body too long";
+ return 0;
+ }
+ }
+ else {
+ return 1 if $self->{body} =~ /\n/; # only good for one line output
+ }
+ undef;
+}
+
+#sub DESTROY { my $self = shift; warn "DESTROY $self->{id}"; }
+1;

Propchange: spamassassin/trunk/spamd-apache2/bin/Bench-spamd.pl
------------------------------------------------------------------------------
svn:executable = *

Added: spamassassin/trunk/spamd-apache2/bin/Spamd
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/bin/Spamd?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/bin/Spamd (added)
+++ spamassassin/trunk/spamd-apache2/bin/Spamd Tue Aug 29 10:09:31 2006
@@ -0,0 +1,14 @@
+#!/bin/sh
+
+httpd.worker -d "$PWD" -f /dev/null \
+ -k $1 \
+ -C 'LoadModule perl_module modules/mod_perl.so' \
+ -C 'PidFile run/apache_spamd.pidd' \
+ -C 'LockFile run/accept.lock' \
+ -C 'PerlSwitches -I/home/users/radek/httpd/lib' \
+ -C 'PerlModule Mail::SpamAssassin::Spamd::Apache2' \
+ -C 'PerlLoadModule Mail::SpamAssassin::Spamd::Apache2::Config' \
+ -C 'Listen 42424' \
+ -c 'SAenabled on' \
+ -e 'notice' \
+

Propchange: spamassassin/trunk/spamd-apache2/bin/Spamd
------------------------------------------------------------------------------
svn:executable = *

Added: spamassassin/trunk/spamd-apache2/bin/apache-spamd.pl
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/bin/apache-spamd.pl?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/bin/apache-spamd.pl (added)
+++ spamassassin/trunk/spamd-apache2/bin/apache-spamd.pl Tue Aug 29 10:09:31 2006
@@ -0,0 +1,359 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Mail::SpamAssassin::Spamd::Config ();
+use Mail::SpamAssassin::Util (); # heavy, loads M::SA
+use Sys::Hostname qw(hostname);
+use File::Spec ();
+use Cwd ();
+
+=head1 NAME
+
+apache-spamd -- start spamd with Apache as backend
+
+=head1 SYNOPSIS
+
+ apache-spamd --pidfile ... [ OPTIONS ]
+
+OPTIONS:
+ --httpd_path=path path to httpd, eg. /usr/sbin/httpd.prefork
+ --httpd_opt=opt option for httpd (can occur multiple times)
+ --httpd_directive=line directive for httpd (can occur multiple times)
+ -k CMD passed to httpd (see L<httpd(1)> for values)
+ --apxs=path path to apxs, eg /usr/sbin/apxs
+ --httpd_conf=path just write a config file for Apache and exit
+
+See L<spamd(1)> for other options.
+
+If some modules are not in @INC, invoke this way:
+ perl -I/path/to/modules apache-spamd.pl \
+ --httpd_directive "PerlSwitches -I/path/to/modules"
+
+=head1 DESCRIPTION
+
+Starts spamd with Apache as a backend. Apache is configured according to
+command line options, compatible to spamd where possible and makes sense.
+
+If this script doesn't work for you, complain.
+
+=head1 TODO
+
+ * misc MPMs
+ * testing on different platforms and configurations
+ * fix FIXME's
+ * review XXX's
+ * --create-prefs (?), --help, --virtual-config-dir
+ * current directory (home_dir_for_helpers?)
+
+=cut
+
+# NOTE: the amount of code here and list of loaded modules doesn't matter;
+# we exec() anyway.
+
+# NOTE: no point in using -T, it'd only mess up code with workarounds;
+# we don't process any user input but command line options.
+
+my $opt = Mail::SpamAssassin::Spamd::Config->new(
+ {
+ defaults => { daemonize => 1, port => 783, },
+ moreopts => [.
+ qw(httpd_path|httpd-path=s httpd_opt|httpd-opt=s@
+ httpd_directive|httpd-directive=s@ k:s apxs=s
+ httpd_conf|httpd-conf=s)
+ ],
+ }
+);
+
+# only standalone spamd implements these options.
+# you miss vpopmail? get a real MTA.
+for my $option (
+ qw(round-robin setuid-with-sql setuid-with-ldap socketpath
+ socketowner socketgroup socketmode paranoid vpopmail)
+ )
+{
+ die "ERROR: --$option can't be used with apache-spamd\n"
+ if defined $opt->{$option};
+}
+
+#
+# XXX: move these options (and sanity checks for them) to M::SA::S::Config?
+#
+
+die "ERROR: '$opt->{httpd_path}' does not exist or not executable\n"
+ if exists $opt->{httpd_path}
+ and !-f $opt->{httpd_path} || !-x _;
+$opt->{httpd_path} ||= 'httpd'; # FIXME: find full path
+
+$opt->{pidfile} ||= '/var/run/apache-spamd.pid' # reasonable default
+ if -w '/var/run/' && -x _ && !-e '/var/run/apache-spamd.pid';
+die "ERROR: --pidfile is mandatory\n" # this seems ugly, but has advantages
+ unless $opt->{pidfile}; # we won't be able to stop otherwise
+if (-d $opt->{pidfile}) {
+ die "ERROR: can't write pid, '$opt->{pidfile}' directory not writable\n"
+ unless -x _ && -w _;
+ $opt->{pidfile} = File::Spec->catfile($opt->{pidfile}, 'apache-spamd.pid');
+}
+
+if (exists $opt->{k}) { # XXX: other option name? or not?
+ die "ERROR: can't use -k with --httpd_conf\n" if exists $opt->{httpd_conf};
+ ## I'm not sure if this toggle idea is a good one...
+ ## useful for development.
+ $opt->{k} ||= -e $opt->{pidfile} ? 'stop' : 'start';
+ die "ERROR: -k start|stop|restart|reload|graceful|graceful-stop"
+ . " or empty for toggle\n"
+ unless $opt->{k} =~ /^(?:start|stop|restart|reload|graceful(?:-stop)?)$/;
+}
+$opt->{k} ||= 'start';
+
+if (exists $opt->{httpd_conf}) {
+ die "ERROR: --httpd_conf must be a regular file\n"
+ if -e $opt->{httpd_conf} && !-f _;
+ $opt->{httpd_conf} = File::Spec->rel2abs($opt->{httpd_conf})
+ unless $opt->{httpd_conf} eq '-';
+}
+
+#
+# start processing command line and preparing config / cmd line for Apache
+#
+
+my @directives; # -C ... (or write these to a temporary config file)
+my @run = ( # arguments to exec()
+ $opt->{httpd_path},
+ '-k', $opt->{k},
+ '-d', Cwd::cwd(), # XXX: smarter... home_dir_for_helpers?
+);
+
+if ($opt->{debug} eq 'all') {
+ push @run, qw(-e debug);
+ push @directives, 'LogLevel debug';
+}
+
+push @run, '-X' if !$opt->{daemonize};
+push @run, @{ $opt->{httpd_opts} } if exists $opt->{httpd_opts};
+
+push @directives, 'ServerName ' . hostname(),
+ qq(PidFile "$opt->{pidfile}"),
+ qq(ErrorLog "$opt->{'log-file'}");
+
+#
+# only bother with these when we're not stopping
+#
+if ($opt->{k} !~ /stop|graceful/) {
+ my $modlist = join ' ', static_apache_modules($opt->{httpd_path});
+
+ push @directives,
+ 'LoadModule perl_module ' . apache_module_path('mod_perl.so')
+ if $modlist !~ /\bmod.perl\.c\b/i;
+
+ # StartServers, MaxClients, etc
+ my $mpm = lc(
+ (
+ $modlist =~ /\b(prefork|worker|mpm_winnt|mpmt_os2
+ |mpm_netware|beos|event|metuxmpm|peruser)\.c\b/ix
+ )[0]
+ );
+ die "ERROR: unable to figure out which MPM is in use\n" unless $mpm;
+ push @directives, mpm_specific_config($mpm);
+
+ # directives from command line; might require mod_perl.so, so let's
+ # ignore these unless we're starting -- shouldn't be critical anyway
+ push @directives, @{ $opt->{httpd_directive} }
+ if exists $opt->{httpd_directive};
+
+ push @directives, "TimeOut $opt->{'timeout-tcp'}" if $opt->{'timeout-tcp'};
+
+ # Listen
+ push @directives, defined $opt->{'listen-ip'}
+ && @{ $opt->{'listen-ip'} }
+ ? map({ 'Listen ' . ($_ =~ /:/ ? "[$_]" : $_) . ":$opt->{port}" }
+ @{ $opt->{'listen-ip'} })
+ : "Listen $opt->{port}";
+
+ if ($opt->{ssl}) {
+ push @directives,
+ 'LoadModule ssl_module ' . apache_module_path('mod_ssl.so')
+ if $modlist !~ /\bmod.ssl\.c\b/i; # XXX: are there other variants?
+ push @directives, qq(SSLCertificateFile "$opt->{'server-cert'}")
+ if exists $opt->{'server-cert'};
+ push @directives, qq(SSLCertificateKeyFile "$opt->{'server-key'}")
+ if exists $opt->{'server-key'};
+ push @directives, 'SSLEngine on';
+ my $random = -r '/dev/urandom' ? 'file:/dev/urandom 256' : 'builtin';
+ push @directives, "SSLRandomSeed startup $random",
+ "SSLRandomSeed connect $random";
+ ##push @directives, 'SSLProtocol all -SSLv2'; # or v3 only?
+ }
+
+ # XXX: available in Apache 2.1+; previously in core (AFAIK);
+ # should we parse httpd -v?
+ push @directives,
+ 'LoadModule ident_module ' . apache_module_path('mod_ident.so'),
+ 'IdentityCheck on'
+ if $opt->{'auth-ident'};
+ push @directives, "IdentityCheckTimeout $opt->{'ident-timeout'}"
+ if $opt->{'auth-ident'} && defined $opt->{'ident-timeout'};
+
+ # SA stuff
+ push @directives,
+ 'PerlLoadModule Mail::SpamAssassin::Spamd::Apache2::Config',
+ 'SAenabled on';
+ push @directives, "SAAllow from @{$opt->{'allowed-ips'}}"
+ if exists $opt->{'allowed-ips'};
+ push @directives, 'SAtell on' if $opt->{'allow-tell'};
+ push @directives, "SAtimeout $opt->{'timeout-child'}"
+ if exists $opt->{'timeout-child'};
+ push @directives, "SAdebug $opt->{debug}" if $opt->{debug};
+ push @directives, 'SAident on'
+ if $opt->{'auth-ident'};
+
+ push @directives, qq(SANew rules_filename "$opt->{configpath}")
+ if defined $opt->{configpath};
+ push @directives, qq(SANew site_rules_filename "$opt->{siteconfigpath}")
+ if defined $opt->{siteconfigpath};
+ push @directives,
+ qq(SANew home_dir_for_helpers "$opt->{home_dir_for_helpers}")
+ if defined $opt->{home_dir_for_helpers};
+ push @directives, qq(SANew local_tests_only $opt->{local})
+ if defined $opt->{local};
+ push @directives, map qq(SANew $_ "$opt->{$_}"), grep defined $opt->{$_},
+ qw(PREFIX DEF_RULES_DIR LOCAL_RULES_DIR LOCAL_STATE_DIR);
+ push @directives, 'SANew paranoid 1' if $opt->{paranoid};
+
+ my @users;
+ push @users, 'local' if $opt->{'user-config'};
+ push @users, 'sql' if $opt->{'sql-config'};
+ push @users, 'ldap' if $opt->{'ldap-config'};
+ push @directives, join ' ', 'SAUsers', @users if @users;
+}
+
+# write directives to conf file (or STDOUT) and exit
+if ($opt->{httpd_conf}) {
+ my $fh;
+ if ($opt->{httpd_conf} eq '-') {
+ open $fh, '>&STDOUT' or die "open >&STDOUT: $!";
+ }
+ else {
+ open $fh, '>', $opt->{httpd_conf}
+ or die "open >'$opt->{httpd_conf}': $!";
+ }
+ print $fh join "\n",
+ "# generated by $0 on " . localtime(time),
+ @directives,
+ "# vim: filetype=apache\n";
+ close $fh or warn "close: $!";
+ exit 0; # user is supposed to run Apache himself
+}
+
+#
+# add directives to command line and run Apache
+#
+
+push @run, '-f',
+ File::Spec->devnull(), # XXX: will work on a non-POSIX platform?
+ map { ; '-C' => $_ } @directives;
+
+warn map({ /^-/ ? "\n $_" : " $_" } @run), "\n"
+ if $opt->{debug} eq 'all';
+
+warn "$0: Running as root, huh? Asking for trouble, aren't we?\n"
+ if $< == 0 && !$opt->{username};
+
+undef $opt; # there is no DESTROY... but could be one ;-)
+exec @run; # we are done
+
+#
+# helper functions
+#
+
+sub get_libexecdir {
+ get_libexecdir_A2BC() || get_libexecdir_apxs();
+}
+
+# read it from Apache2::BuildConfig
+sub get_libexecdir_A2BC {
+ $INC{'Apache2/Build.pm'}++; # hack... needlessly required by BuildConfig
+ require Apache2::BuildConfig;
+ my $cfg = Apache2::BuildConfig->new;
+ $cfg->{APXS_LIBEXECDIR} || $cfg->{MODPERL_APXS_LIBEXECDIR};
+}
+
+# `apxs -q LIBEXECDIR`
+sub get_libexecdir_apxs {
+ my @cmd = (($opt->{apxs} || 'apxs'), '-q', 'LIBEXECDIR');
+ chomp(my $modpath = get_cmd_output(@cmd));
+ die "ERROR: failed to obtain module path from '@cmd'\n"
+ unless length $modpath;
+ die "ERROR: '$modpath' returned by '@cmd' is not an existing directory\n"
+ unless -d $modpath;
+ $modpath;
+}
+
+# as above, cached version
+use vars '$apache_module_path';
+sub apache_module_path {
+ my $modname = shift;
+ $apache_module_path ||= get_libexecdir(); # path is cached
+ my $module = File::Spec->catfile($apache_module_path, $modname);
+ die "ERROR: '$module' does not exist\n" if !-e $module;
+ $module;
+}
+
+# httpd -l
+# XXX: can MPM be a DSO?
+sub static_apache_modules {
+ my $httpd = shift;
+ my @cmd = ($httpd, '-l');
+ my $out = get_cmd_output(@cmd);
+ my @modlist = $out =~ /\b(\S+\.c)\b/gi;
+ die "ERROR: failed to get list of static modules from '@cmd'\n"
+ unless @modlist;
+ @modlist;
+}
+
+sub get_cmd_output {
+ my @cmd = @_;
+ my $output = `@cmd` or die "ERROR: failed to run '@cmd': $!\n";
+ $output;
+}
+
+sub mpm_specific_config {
+ my $mpm = shift;
+ my @ret;
+
+ if ($mpm =~ /^prefork|worker|beos|mpmt_os2$/) {
+ push @ret, "User $opt->{username}" if $opt->{username};
+ push @ret, "Group $opt->{groupname}" if $opt->{groupname};
+ }
+ elsif ($opt->{username} || $opt->{groupname}) {
+ die "ERROR: username / groupname not supported with MPM $mpm\n";
+ }
+
+ if ($mpm eq 'prefork') {
+ push @ret, "StartServers $opt->{'min-spare'}";
+ push @ret, "MinSpareServers $opt->{'min-spare'}";
+ push @ret, "MaxSpareServers $opt->{'max-spare'}";
+ push @ret, "MaxClients $opt->{'max-children'}";
+ }
+ elsif ($mpm eq 'worker') { # XXX: we could be smarter here
+ push @ret, grep length, map { s/^\s+//; s/\s*\b#.*$//; $_ } split /\n/,
+ <<" EOF";
+ StartServers 1
+ ServerLimit 1
+ MinSpareThreads $opt->{'min-spare'}
+ MaxSpareThreads $opt->{'max-spare'}
+ ThreadLimit $opt->{'max-children'}
+ ThreadsPerChild $opt->{'max-children'}
+ EOF
+ }
+ else {
+ warn "WARNING: MPM $mpm not supported, using defaults for performance settings\n";
+ warn "WARNING: prepare for huge memory usage and maybe an emergency reboot\n";
+ }
+
+ push @ret, "MaxRequestsPerChild $opt->{'max-conn-per-child'}"
+ if defined $opt->{'max-conn-per-child'};
+
+ @ret;
+}
+
+# vim: ts=4 sw=4 noet

Propchange: spamassassin/trunk/spamd-apache2/bin/apache-spamd.pl
------------------------------------------------------------------------------
svn:executable = *

Added: spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd.pm?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd.pm (added)
+++ spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd.pm Tue Aug 29 10:09:31 2006
@@ -0,0 +1,695 @@
+package Mail::SpamAssassin::Spamd;
+
+use vars qw(%conf_backup %msa_backup);
+
+use Mail::SpamAssassin::Logger;
+eval { use Time::HiRes qw(time); };
+
+our $SPAMD_VER = '1.3';
+our %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
+ EX_IOERR => 74, # input/output error
+ EX_TEMPFAIL => 75, # temp failure; user is invited to retry
+ EX_PROTOCOL => 76, # remote error in protocol
+ EX_NOPERM => 77, # permission denied
+ EX_CONFIG => 78, # configuration error
+ EX_TIMEOUT => 79, # read timeout
+);
+
+=head1 NAME
+
+Mail::SpamAssassin::Spamd
+
+=head1 SYNOPSIS
+
+ use base qw(Mail::SpamAssassin::Spamd);
+ sub ... { ... }
+ ...
+
+=head1 DESCRIPTION
+
+This module contains a skeleton for handling client request in spamd
+implementation. Must not be used directly, but subclassed.
+
+An instance should have lifetime of a single request.
+
+Interface is likely to change.
+
+See the source code of L<spamd(1)> and L<Mail::SpamAssassin::Spamd::Apache2(3)>.
+
+=head2 METHODS
+
+=over
+
+=item C<log_connection()>
+
+Call as soon as the connection is accepted.
+
+=cut
+
+sub log_connection {
+ my ($self) = @_;
+ info(sprintf "connection from %s [%s] at port %s\n",
+ $self->_remote_host, $self->_remote_ip, $self->_remote_port);
+}
+
+=item C<log_start_work()>
+
+Call after C<parse_msgids()>.
+
+=cut
+
+sub log_start_work {
+ my ($self) = @_;
+ info(
+ sprintf "%s message %s%s for %s:%d\n",
+ ($self->{method} eq 'PROCESS' ? 'processing' : 'checking'),
+ (defined $self->{msgid} ? $self->{msgid} : '(unknown)'),
+ (defined $self->{rmsgid} ? 'aka ' . $self->{rmsgid} : ''),
+ $self->user,
+ $>,
+ );
+}
+
+=item C<log_end_work()>
+
+Call after C<pass_through_sa()>.
+
+=cut
+
+sub log_end_work {
+ my ($self) = @_;
+ if ($self->{method} eq 'TELL') {
+ my $info_str;
+ $info_str .= 'Setting' . join ',', @{ $self->{did_set} }
+ if @{ $self->{did_set} };
+ $info_str .= 'Removing' . join ',', @{ $self->{did_remove} }
+ if @{ $self->{did_remove} };
+ info(
+ sprintf 'spamd: Tell: %s for $current_user:%d in'
+ . ' %.1f seconds, %d bytes',
+ (defined $info_str ? $info_str : 'Did nothing'),
+ $>,
+ $self->{scan_time},
+ $self->{actual_length},
+ );
+ }
+ else {
+ info(
+ sprintf "%s (%.1f/%.1f) for %s:%d in %.1f seconds, %d bytes.\n",
+ ($self->status->is_spam ? 'identified spam' : 'clean message'),
+ $self->status->get_score,
+ $self->status->get_required_score,
+ $self->user,
+ $>,
+ $self->{scan_time},
+ $self->{actual_length},
+ );
+ }
+}
+
+=item C<log_result()>
+
+Call as late as possible, after sending response to the client.
+
+=cut
+
+sub log_result {
+ my ($self) = @_;
+ my @extra = (
+ 'scantime=' . sprintf('%.1f', $_[0]->{scan_time}),
+ 'size=' . $self->{actual_length},
+ 'user=' . $self->user,
+ 'uid=' . $>,
+ 'required_score=' . $self->status->get_required_score,
+ 'rhost=' . $self->_remote_host,
+ 'raddr=' . $self->_remote_ip,
+ 'rport=' . $self->_remote_port,
+ );
+ {
+ (my $safe = defined $self->{msgid} ? $self->{msgid} : '(unknown)') =~
+ s/[\x00-\x20\s,]/_/gs;
+ push @extra, "mid=$safe";
+ }
+ if ($self->{rmsgid}) {
+ (my $safe = $self->{rmsgid}) =~ s/[\x00-\x20\s,]/_/gs;
+ push @extra, "rmid=$safe";
+ }
+ push @extra, "bayes=" . $self->status->{bayes_score}
+ if defined $self->status->{bayes_score};
+ push @extra, "autolearn=" . $self->status->get_autolearn_status;
+ my $yorn = $self->status->is_spam ? 'Y' : '.';
+ my $tests = join ",", sort grep length, $self->status->get_names_of_tests_hit;
+ access_info(sprintf "result: %s %2d - %s %s\n",
+ $yorn, $self->status->get_score, $tests, join ',', @extra);
+}
+
+
+=item C<check_headers()>
+
+Sanity checks on headers sent by the client.
+Sends status line indicating error to the client and returns false on
+first problem found.
+
+=cut
+
+sub check_headers {
+ my $self = shift;
+
+ if ($self->cfg->{auth_ident}) {
+ unless (exists $self->headers_in->{user}) {
+ $self->service_unavailable_error('User header required');
+ return 0;
+ }
+ $self->auth_ident($self->headers_in->{user})
+ or return 0;
+ }
+
+ my $content_length = $self->headers_in->{content_length};
+ if (defined $content_length) { # sanity check
+ if ( $content_length !~ /^\d{1,15}$/
+ || $content_length == 0)
+ {
+ $self->protocol_error('Content-Length too ugly');
+ return 0;
+ }
+ elsif ($self->cfg->{msg_size_limit}
+ && $content_length > $self->cfg->{msg_size_limit})
+ {
+ $self->service_unavailable_error('Content-Length exceeds limit');
+ return 0;
+ }
+ }
+
+
+ if ($self->cfg->{allow_tell} && $self->{method} eq 'TELL') {
+ my ($set_local, $set_remote, $remove_local, $remove_remote) = (
+ $self->headers_in->{set} =~ /local/,
+ $self->headers_in->{set} =~ /remote/,
+ $self->headers_in->{remove} =~ /local/,
+ $self->headers_in->{remove} =~ /remote/,
+ );
+
+ if ($set_local && $remove_local) {
+ $self->protocol_error(
+ "Unable to set local and remove local in the same operation.");
+ return 0;
+ }
+
+ if ($set_remote && $remove_remote) {
+ $self->protocol_error(
+ "Unable to set remote and remove remote in the same operation.");
+ return 0;
+ }
+ }
+
+ 1;
+}
+
+
+=item C<parse_msgids()>
+
+Extract the Message-Id(s) for logging purposes.
+
+=cut
+
+sub parse_msgids {
+ my $self = shift;
+
+ # Extract the Message-Id(s) for logging purposes.
+ $self->{msgid} = $self->{parsed}->get_pristine_header("Message-Id");
+ $self->{rmsgid} = $self->{parsed}->get_pristine_header("Resent-Message-Id");
+
+ foreach my $id (grep $self->{$_}, qw(msgid rmsgid)) {
+ 1 while $self->{$id} =~ s/\([^\(\)]*\)//; # remove comments and
+ $self->{$id} =~ s/^\s+|\s+$//g; # leading and trailing spaces
+ $self->{$id} =~ s/\s+/ /g; # collapse whitespaces
+ $self->{$id} =~ s/^.*?<(.*?)>.*$/$1/; # keep only the id itself
+ $self->{$id} =~ s/[^\x21-\x7e]/?/g; # replace all weird chars
+ $self->{$id} =~ s/[<>]/?/g; # plus all dangling angle brackets
+ $self->{$id} =~ s/^(.+)$/<$1>/; # re-bracket the id (if not empty)
+ }
+}
+
+
+=item C<service_unavailable_error('error message')>
+
+=item C<protocol_error('error message')>
+
+=item C<service_timeout('error message')>
+
+Send appropiate status line to the client and log the error.
+
+=cut
+
+sub service_unavailable_error {
+ my $self = shift;
+ my $msg = join '', @_;
+ $self->send_status_line('EX_UNAVAILABLE', $msg);
+ warn "spamd: service unavailable: $msg\n";
+}
+
+sub protocol_error {
+ my $self = shift;
+ my $msg = join '', @_;
+ $self->send_status_line('EX_PROTOCOL', $msg);
+ warn "spamd: bad protocol: header error: $msg\n";
+}
+
+sub service_timeout {
+ my $self = shift;
+ my $msg = join '', @_;
+ $self->send_status_line('EX_TIMEOUT', $msg);
+ warn "spamd: timeout: $msg\n";
+}
+
+=item C<send_status_line('EX_FOO', 'message')>
+
+EX_error constant defaults to C<EX_OK>.
+Message defaults to the name of the constant.
+
+=cut
+
+sub send_status_line {
+ my $self = shift;
+ my ($resp, $msg) = @_;
+ $resp = defined $resp ? $resp : 'EX_OK';
+ $msg = defined $msg ? $msg : $resp;
+ $self->send_buffer("SPAMD/$SPAMD_VER $resphash{$resp} $msg\r\n");
+}
+
+
+=item C<send_response()>
+
+Generates response (headers and body, no status line) to the request and sends
+it to the client.
+
+=cut
+
+sub send_response {
+ my $self = shift;
+ my $msg_resp = '';
+
+ if ($self->{method} eq 'PROCESS') {
+ $self->status->set_tag('REMOTEHOSTNAME', $self->_remote_host);
+ $self->status->set_tag('REMOTEHOSTADDR', $self->_remote_ip);
+
+ # Build the message to send back and measure it
+ $msg_resp = $self->status->rewrite_mail;
+ #$self->status->finish;
+ #delete $self->{status};
+
+ # Spamc protocol 1.3 means multi hdrs are OK
+ $self->send_buffer($self->spamhdr)
+ if $self->{client_version} >= 1.3;
+
+ # Spamc protocol 1.2 means it accepts content-length
+ # Earlier than 1.2 didn't accept content-length
+ $self->send_buffer('Content-length: ' . length($msg_resp) . "\r\n\r\n")
+ if $self->{client_version} >= 1.2;
+ }
+ elsif ($self->{method} eq 'TELL') {
+ my $response;
+ $response .= 'DidSet: ' . join(',', @{ $self->{did_set} }) . "\r\n"
+ if @{ $self->{did_set} };
+ $response .= 'DidRemove: ' . join(',', @{ $self->{did_remove} }) . "\r\n"
+ if @{ $self->{did_remove} };
+ $self->send_buffer($response, "Content-Length: 0\r\n", "\r\n");
+ }
+ else { # $method eq 'CHECK' et al
+ if ($self->{method} eq 'CHECK') {
+ ## just headers
+ }
+ elsif ($self->{method} eq 'REPORT'
+ or $self->{method} eq 'REPORT_IFSPAM' && $self->status->is_spam)
+ {
+ $msg_resp = $self->status->get_report;
+ }
+ elsif ($self->{method} eq 'REPORT_IFSPAM') {
+ ## message is ham, $msg_resp remains empty
+ }
+ elsif ($self->{method} eq 'SYMBOLS') {
+ $msg_resp = $self->status->get_names_of_tests_hit;
+ $msg_resp .= "\r\n" if $self->{client_version} < 1.3;
+ }
+ else { # FIXME: this should *never* happen, yet it does...
+ die "spamd: unknown method '$self->{method}'";
+ }
+
+ # Spamc protocol 1.3 means multi hdrs are OK
+ $self->send_buffer('Content-length: ' . length($msg_resp) . "\r\n")
+ if $self->{client_version} >= 1.3;
+ $self->send_buffer($self->spamhdr, "\r\n");
+ }
+
+ $self->send_buffer($msg_resp);
+
+ # any better place to do it?
+ $self->{scan_time} = time - $self->{start_time};
+}
+
+=item C<pass_through_sa()>
+
+Runs the actual tests. Wrap it with C<eval()> to implement timeout.
+
+=cut
+
+sub pass_through_sa {
+ my $self = shift;
+
+ if ($self->{method} eq 'TELL') {
+
+ # bleh, three copies of the message here... :-/
+ # do it in read_body?
+ if ($self->{parsed}->get_header("X-Spam-Checker-Version")) {
+ my $new_mail =
+ $self->spamtest->parse(
+ $self->spamtest->remove_spamassassin_markup($self->{parsed}), 1);
+ $self->{parsed}->finish;
+ $self->{parsed} = $new_mail;
+ }
+
+ my ($set_local, $set_remote, $remove_local, $remove_remote) = (
+ $self->headers_in->{set} =~ /local/,
+ $self->headers_in->{set} =~ /remote/,
+ $self->headers_in->{remove} =~ /local/,
+ $self->headers_in->{remove} =~ /remote/,
+ );
+
+ if ($set_local) {
+ my $status =
+ $self->spamtest->learn($mail, undef,
+ ($self->headers_in->{message_class} eq 'spam' ? 1 : 0), 0);
+ push @{ $self->{did_set} }, 'local' if $status->did_learn;
+ $status->finish;
+ }
+
+ if ($remove_local) {
+ my $status = $self->spamtest->learn($mail, undef, undef, 1);
+ push @{ $self->{did_remove} }, 'local' if $status->did_learn;
+ $status->finish;
+ }
+
+ if ($set_remote) {
+ require Mail::SpamAssassin::Reporter;
+ my $msgrpt =
+ Mail::SpamAssassin::Reporter->new($self->spamtest, $self->{parsed});
+ push @{ $self->{did_set} }, 'remote' if $msgrpt->report;
+ }
+
+ if ($remove_remote) {
+ require Mail::SpamAssassin::Reporter;
+ my $msgrpt =
+ Mail::SpamAssassin::Reporter->new($self->spamtest, $self->{parsed});
+ push @{ $self->{did_remove} }, 'remote' if $msgrpt->revoke;
+ }
+ }
+ else {
+ $self->{status} = $self->spamtest->check($self->{parsed})
+ unless $self->{method} eq 'TELL';
+ }
+
+ # we don't access this object anymore, but can't destroy
+ # it yet or something will complain... a lot.
+ $self->{parsed}->finish;
+}
+
+
+=item C<spamhdr()>
+
+Generates the C<Spam: status ; score / threshold> response header.
+
+=cut
+
+sub spamhdr {
+ my $self = shift;
+
+ my $msg_score = sprintf('%.1f', $self->status->get_score);
+ my $msg_threshold = sprintf('%.1f', $self->status->get_required_score);
+
+ my $response_spam_status;
+ if ($self->status->is_spam) {
+ $response_spam_status =
+ $self->{method} eq 'REPORT_IFSPAM' ? 'Yes' : 'True';
+ }
+ else {
+ $response_spam_status =
+ $self->{method} eq 'REPORT_IFSPAM' ? 'No' : 'False';
+ }
+
+ return "Spam: $response_spam_status ; $msg_score / $msg_threshold\r\n";
+}
+
+
+
+=item C<read_user_config()>
+
+Read config for the current user and register a cleanup handler to
+restore state of the SA object later. This is a wrapper around the
+handle_user_* methods.
+
+=cut
+
+# Yes, I could have made %mapping non-lexical, so one could add something
+# there. But I don't think it would be the right way to provide this
+# functionality; contact the dev list if you need it.
+{
+ my %mapping = (
+ 'local' => 'handle_user_local',
+ 'sql' => 'handle_user_sql',
+ 'ldap' => 'handle_user_ldap',
+ );
+
+ # This function should run only once per connection (reason: cleanup_register).
+ sub read_user_config {
+ my $self = shift;
+ return unless defined $self->headers_in->{user};
+ for my $src (
+ grep $self->can($_),
+ map { exists $mapping{$_} ? $mapping{$_} : $_ }
+ @{ $self->cfg->{sa_users} }
+ )
+ {
+ my $ret = $self->$src($self->headers_in->{user});
+ next unless $ret;
+ $self->cleanup_register(\&restore_config, $self->spamtest);
+ return $ret;
+ }
+ return 0;
+ }
+}
+
+=item C<handle_user_sql('username')>
+
+load_scoreonly_sql for the given user.
+Do not call this directly.
+
+=cut
+
+sub handle_user_sql {
+ my $self = shift;
+ my ($username) = @_;
+ $self->spamtest->load_scoreonly_sql($username)
+ or return 0;
+ $self->spamtest->signal_user_changed({ username => $username, user_dir => undef, });
+ return 1;
+}
+
+=item C<handle_user_ldap()>
+
+load_scoreonly_ldap for the given user.
+Do not call this directly.
+
+=cut
+
+sub handle_user_ldap {
+ my $self = shift;
+ my ($username) = @_;
+ dbg("ldap: entering handle_user_ldap($username)");
+ $self->spamtest->load_scoreonly_ldap($username)
+ or return 0;
+ $self->spamtest->signal_user_changed({ username => $username, user_dir => undef, });
+ return 1;
+}
+
+
+=item C<status()>
+
+Returns the Mail::SpamAssassin::PerMsgStatus object. Only valid after
+C<pass_through_sa()>.
+
+=item C<spamtest()>
+
+Returns the Mail::SpamAssassin object.
+
+=cut
+
+sub status { $_[0]->{status} }
+sub spamtest { $_[0]->{spamtest} }
+
+=item C<access_info()>
+
+=cut
+
+sub access_info { info(@_) }
+
+=item C<user()>
+
+Returns username as supplied by client in the User header or string
+'(unknown)'. Use for logging purposes.
+
+=cut
+
+# FIXME: tidy this one, might contain trash
+sub user {
+ defined $_[0]->headers_in->{user} ? $_[0]->headers_in->{user} : '(unknown)';
+}
+
+=item C<cfg()>
+
+Returns Mail::SpamAssassin::Spamd::Config object (or hash reference with
+resembling values).
+
+=cut
+
+sub cfg { $_[0]->{cfg} }
+
+=item C<headers_in()>
+
+Hash ref containing headers sent by the client.
+
+=cut
+
+sub headers_in { $_[0]->{headers_in} }
+
+=item C<cleanup_register(sub { ... }, $argument)>
+
+APR::Pool functionality -- call a piece of code when the object is
+destroyed.
+
+=cut
+
+sub cleanup_register {
+ my $self = shift;
+ $self->{pool} ||= Mail::SpamAssassin::Pool->new;
+ $self->{pool}->cleanup_register(@_);
+}
+
+
+
+
+
+=back
+
+The following methods must be overloaded:
+
+=over
+
+=cut
+
+=item C<_remote_host()>
+
+=item C<_remote_ip()>
+
+=item C<_remote_port()>
+
+Information about the client.
+
+=item C<new( spamtest => $sa_object, foo => 'bar', ... )>
+
+Creates new object; C<shift && bless { @_ }>, basically.
+
+=item C<handle_user_local('username')>
+
+read_scoreonly_config for the given user. You might want to change uid,
+chdir, set $ENV, etc. Do not call this directly.
+
+=item C<read_body()>
+
+Read body from the client, run $self->spamtest->parse and store result
+as the C<parsed> key.
+
+=item C<read_headers()>
+
+Read method and headers from the client. Set various properties
+accordingly.
+
+=item C<send_buffer('list of', 'buffers to send')>
+
+Send buffers to the client.
+
+=item C<auth_ident()>
+
+XXX
+
+=cut
+
+
+
+
+#
+# we need these two functions until SA has some sort of config namespace
+#
+
+# called in Config/Apache2.pm
+# (yuck, at least 500K wasted memory... for each interpreter)
+sub backup_config { # -: a
+ my $spamtest = shift;
+ for my $key (qw(username user_dir userstate_dir learn_to_journal)) {
+ $msa_backup{$key} = $spamtest->{$key} if exists $spamtest->{$key};
+ }
+ $spamtest->copy_config(undef, \%conf_backup)
+ || die "spamd: error returned from copy_config\n";
+}
+
+# this should be registered as $c->pool->cleanup_register if we add some user
+# config; warning: if we'll ever support persistent connections, this should
+# be done in the request pool (or behaviour defined in some other way)
+sub restore_config { # -: a
+ my $spamtest = shift;
+ for my $key (keys %msa_backup) {
+ $spamtest->{$key} = $msa_backup{$key};
+ }
+ $spamtest->copy_config(\%conf_backup, undef)
+ || die "spamd: error returned from copy_config\n";
+}
+
+
+
+
+# simulate APR::Pool
+package Mail::SpamAssassin::Pool;
+{
+ local $@;
+ eval { require APR::Pool; };
+}
+
+sub new {
+ $INC{'APR/Pool.pm'} ? APR::Pool->new : bless [], shift;
+}
+
+sub cleanup_register {
+ my $self = shift;
+ push @$self, [@_];
+}
+
+sub DESTROY {
+ my $self = shift;
+ for my $cleaner (@$self) {
+ (shift @$cleaner)->(@$cleaner);
+ }
+}
+
+1;
+
+# vim: ts=2 sw=2 et

Added: spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2.pm?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2.pm (added)
+++ spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2.pm Tue Aug 29 10:09:31 2006
@@ -0,0 +1,386 @@
+package Mail::SpamAssassin::Spamd::Apache2;
+use strict;
+
+use Apache2::Const -compile =>
+ qw(OK FORBIDDEN NOT_FOUND MODE_GETLINE MODE_READBYTES SERVER_ERROR);
+use Apache2::Connection ();
+use Apache2::Filter ();
+use Apache2::Module ();
+use Apache2::ServerRec ();
+use Apache2::ServerUtil ();
+
+use APR::Const -compile => qw(SUCCESS SO_NONBLOCK BLOCK_READ);
+use APR::Brigade ();
+use APR::Bucket ();
+use APR::Error ();
+use APR::Pool (); # cleanup_register
+use APR::SockAddr ();
+use APR::Socket ();
+use APR::Status ();
+
+eval { use Time::HiRes qw(time); };
+
+use vars qw($spamtest);
+
+use Mail::SpamAssassin ();
+use Mail::SpamAssassin::Message ();
+use Mail::SpamAssassin::PerMsgStatus ();
+use Mail::SpamAssassin::Logger;
+
+use base qw(Mail::SpamAssassin::Spamd);
+
+=head1 NAME
+
+Mail::SpamAssassin::Spamd::Apache2 -- spamd protocol handler for Apache2
+
+=head1 SYNOPSIS
+
+ SetHandler modperl
+ PerlProcessConnectionHandler Mail::SpamAssassin::Spamd::Apache2
+
+=head1 DESCRIPTION
+
+What is this obsession with documentation? Don't you have the source?
+ -- Michael G Schwern on makemaker@perl.org
+
+This is a protocol handler, to be run as C<PerlProcessConnectionHandler>. It's
+different from regular HTTP handlers (C<PerlResponseHandler>) -- we don't have
+the C<$r> object (unless we create it) and the only other run-time Apache hook
+which will run is C<PerlPreConnectionHandler>.
+
+This means you can't use modules which hook themselves in, for example,
+C<PerlAccessHandler>. If there is a clean way to enable it, don't hesitate to
+drop me an e-mail.
+
+=head1 INTERNALS
+
+handler() runs read_headers(), then check_headers(). If the User header has
+been provided by the client and user configuration has been enabled, it runs
+read_user_config(). Then it reads body, passes it through SA and sends reply.
+
+=cut
+
+sub handler { # -: c
+ my ($c) = @_; # Apache2::Connection
+ $c->client_socket->opt_set(APR::Const::SO_NONBLOCK => 0); # ?
+
+ my $self = __PACKAGE__->new(c => $c, spamtest => $spamtest, pool => $c->pool);
+ $self->log_connection;
+
+ # we might be done after this in case of client error or SKIP / PING
+ if (defined(my $ret = $self->read_headers)) {
+ return $ret;
+ }
+
+ $self->check_headers
+ or return Apache2::Const::FORBIDDEN;
+
+ # should we complain if returns 0 and --paranoid?
+ $self->read_user_config;
+
+ if (defined(my $ret = $self->read_body)) {
+ return $ret;
+ }
+
+ $self->parse_msgids;
+
+ $self->log_start_work;
+
+ eval {
+ if ($self->cfg->{satimeout}) {
+ local $SIG{ALRM} = sub { die 'child processing timeout' };
+ alarm $self->cfg->{satimeout};
+ $self->pass_through_sa; # do the checking
+ alarm 0;
+ }
+ else {
+ $self->pass_through_sa; # do the checking
+ }
+ };
+
+ if ($@) {
+ if ( $@ =~ /child processing timeout/ ) {
+ $self->service_timeout(
+ sprintf '(%d second timeout while trying to %s)',
+ $self->cfg->{satimeout},
+ $self->{method}
+ );
+ }
+ else {
+ warn "spamd: $@";
+ }
+ return Apache2::Const::SERVER_ERROR;
+ }
+
+ $self->send_status_line('EX_OK');
+ $self->send_response;
+ $self->log_end_work;
+ $self->log_result;
+
+ return Apache2::Const::OK;
+}
+
+
+
+sub new { # -: A
+ my $class = shift;
+ my $self = {@_}; # requires: c, spamtest
+ $self->{start_time} ||= time;
+ bless $self, (ref $class || $class);
+ ##$self->{c} ||= $self->r->connection if $self->r;
+ $self->{in} ||= APR::Brigade->new($self->c->pool, $self->c->bucket_alloc);
+ $self->{out} ||= APR::Brigade->new($self->c->pool, $self->c->bucket_alloc);
+ $self->{cfg} ||=
+ Apache2::Module::get_config('Mail::SpamAssassin::Spamd::Apache2::Config',
+ $self->_server);
+ $self->{headers_in} ||= {};
+ $self;
+}
+
+
+sub DESTROY { # -: a
+ my $self = shift;
+ $self->status->finish if $self->status;
+ $self->{parsed}->finish if $self->{parsed};
+ $self->in->destroy;
+ $self->out->destroy;
+}
+
+
+sub c { $_[0]->{c} } # -: A
+sub in { $_[0]->{in} } # -: a
+sub out { $_[0]->{out} } # -: a
+
+sub _server { $_[0]->c->base_server } # -: a
+sub _remote_host { $_[0]->c->get_remote_host } # -: a
+sub _remote_ip { $_[0]->c->remote_ip } # -: a
+sub _remote_port { $_[0]->c->remote_addr->port } # -: a
+
+
+sub send_buffer { # -: A
+ my $self = shift;
+ for my $buffer (@_) {
+ $self->out->insert_tail(APR::Bucket->new($self->out->bucket_alloc, $buffer));
+ }
+ $self->c->output_filters->fflush($self->out);
+}
+
+
+sub auth_ident { # -:
+ my $self = shift;
+ my ($username) = @_;
+ my $ident_username =
+ Mail::SpamAssassin::Spamd::Apache2::AclRFC1413::get_ident($username);
+ my $dn = $ident_username || 'NONE'; # display name
+ # we might also log $c->remote_addr->ip_get(), $c->remote_addr->port()
+ # dbg("ident: ident_username = $dn, spamc_username = $username\n");
+ if (!defined($ident_username) || $username ne $ident_username) {
+ info( "ident username ($dn) does not match "
+ . "spamc username ($username)");
+ return 0;
+ }
+ 1;
+}
+
+
+#sub read_line { # -: A
+# my $self = shift;
+#}
+
+
+sub getline {
+ my $self = shift;
+ my $rc =
+ $self->c->input_filters->get_brigade($self->in,
+ Apache2::Const::MODE_GETLINE);
+ last if APR::Status::is_EOF($rc);
+ die APR::Error::strerror($rc) unless $rc == APR::Const::SUCCESS;
+ next unless $self->in->flatten(my $line);
+ $self->in->cleanup;
+ $line =~ y/\r\n//d;
+ return $line;
+}
+
+
+
+sub read_headers { # -: A
+ my $self = shift;
+ my $line_num;
+ while (my $line = $self->getline) {
+
+ # XXX: lower this to 10?
+ if (++$line_num > 255) {
+ $self->protocol_error('(too many headers)');
+ return Apache2::Const::FORBIDDEN;
+ }
+
+ if (length $line > 200) {
+ $self->protocol_error('(line too long)' . length $line);
+ return Apache2::Const::FORBIDDEN;
+ }
+
+ # get method name
+ unless ($self->{method}) {
+ if ($line =~ /^(SKIP|PING|PROCESS|CHECK|SYMBOLS|REPORT|REPORT_IFSPAM|TELL)
+ \ SPAMC\/(\d{1,2}\.\d{1,3})\b/x) {
+ $self->{method} = $1;
+ $self->{client_version} = $2;
+ if ($self->{method} eq 'PING') {
+ $self->send_status_line('EX_OK', 'PONG');
+ return Apache2::Const::OK;
+ }
+ elsif ($self->{method} eq 'SKIP') {
+ return Apache2::Const::OK;
+ }
+ elsif ($self->{method} eq 'TELL' && !$self->cfg->{allow_tell}) {
+ $self->service_unavailable_error('TELL commands have not been enabled.');
+ return Apache2::Const::FORBIDDEN;
+ }
+ next;
+ }
+ elsif ($line =~ /^GET /) { # treat this like ping
+ $self->send_buffer(
+ join "\r\n",
+ 'HTTP/1.0 200 SA running',
+ 'Content-Type: text/plain',
+ 'Content-Length: 0', ''
+ );
+ return Apache2::Const::OK;
+ }
+ $self->protocol_error('method required' . ": '$line'");
+ return Apache2::Const::NOT_FOUND; # something more reasonable?
+ }
+
+ last unless length $line; # end of headers
+
+ # get headers, ignore unknown
+ my ($header, $value) = split /:\s+/, $line, 2;
+ unless (defined $header && length $header
+ && defined $value && length $value) {
+ $self->protocol_error("(header not in 'Name: value' format)");
+ return Apache2::Const::FORBIDDEN;
+ }
+
+ return Apache2::Const::FORBIDDEN
+ if $header =~ /[^a-z\d_-]/i || $value =~ /[^\x20-\xFF]/; # naughty
+
+ if ($header =~ /^(?:Content-[Ll]ength|User|Message-[Cc]lass|Set|Remove)$/) {
+ $header =~ y/A-Z-/a-z_/;
+ $self->headers_in->{$header} = $value;
+ }
+ else { # FIXME: remove
+ warn "unknown header: '$header'='$value'";
+ }
+ }
+ undef;
+}
+
+
+sub read_body { # -: A
+ my $self = shift;
+ my ($message, $len) = ('', 0);
+ my $content_length = $self->headers_in->{content_length};
+
+ while (1) {
+ my $rc =
+ $self->c->input_filters->get_brigade($self->in, Apache2::Const::MODE_READBYTES,
+ APR::Const::BLOCK_READ,
+ ($content_length ? $content_length - $len : ()));
+ last if APR::Status::is_EOF($rc);
+ die APR::Error::strerror($rc) unless $rc == APR::Const::SUCCESS; # timeout
+ next unless $self->in->flatten(my $chunk);
+ $self->in->cleanup;
+
+ my $chlen = length $chunk;
+ $len += $chlen;
+
+ # this is never true, actually... get_brigade ensures we won't get
+ # more bytes... well, at least it's logically correct. ;-)
+ # we could check if $message ends with "\n" to detect weird cases.
+ # XXX: remove this block?
+ if ($content_length && $len > $content_length) {
+ $self->protocol_error('(Content-Length mismatch: Expected'
+ . " $content_length bytes, got $len bytes");
+ return Apache2::Const::FORBIDDEN;
+ }
+
+ $message .= $chunk;
+ last if $content_length && $len == $content_length;
+ }
+
+ $self->{actual_length} = $len;
+ $self->{parsed} = $self->spamtest->parse($message, 0);
+
+ undef;
+}
+
+
+
+
+#
+# Code to deal with user configuration.
+#
+# Run handle_* directly (ie. not from read_user_config) only if you know
+# what you are doing.
+#
+# Change handle_* to return undef if not found and 0 if something's wrong?
+#
+
+
+sub handle_user_local { # -: a
+ require File::Spec;
+ my $self = shift;
+ my($username) = @_;
+ my ($name, $uid, $gid, $dir) = (getpwnam $username)[0, 2, 3, 7];
+
+ unless (defined $uid) {
+ my $errmsg = "handle_user unable to find user: '$username'";
+ if ($self->spamtest->{'paranoid'}) { # FIXME: return something? die? whatever?
+ $self->service_unavailable_error($errmsg);
+ }
+ else {
+ # if we are given a username, but can't look it up, maybe name
+ # services are down? let's break out here to allow them to get
+ # 'defaults' when we are not running paranoid
+ info($errmsg);
+ }
+ return 0;
+ }
+
+ my $cf_dir = File::Spec->catdir($dir, '.spamassassin');
+ my $cf_file = File::Spec->catfile($cf_dir, 'user_prefs');
+ if (!-l $cf_dir && -d _ && !-d $cf_file && -f _ && -s _) {
+ $self->spamtest->read_scoreonly_config($cf_file);
+
+ # if the $cf_dir group matches ours, assume we can write there
+ my $user_dir = $) == (stat $cf_dir)[5] ? $dir : undef;
+
+ $self->spamtest->signal_user_changed(
+ { username => $username, user_dir => $user_dir, });
+ }
+ return 1;
+}
+
+
+=head1 TODO
+
+Timeout...
+
+NetSet
+
+=head1 BUGS
+
+See <http://bugzilla.spamassassin.org/>.
+
+=head1 SEE ALSO
+
+L<httpd(8)>,
+L<spamd(1)>,
+L<apache-spamd(1)>,
+L<Mail::SpamAssassin::Spamd::Apache2::Config(3)>
+
+=cut
+
+1;
+
+# vim: ts=2 sw=2 et

Added: spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclIP.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclIP.pm?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclIP.pm (added)
+++ spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclIP.pm Tue Aug 29 10:09:31 2006
@@ -0,0 +1,77 @@
+package Mail::SpamAssassin::Spamd::Apache2::AclIP;
+use strict;
+use Apache2::Connection ();
+use Apache2::Const -compile => qw(OK FORBIDDEN SERVER_ERROR);
+
+use Apache2::Module ();
+use Apache2::ServerRec ();
+
+use Mail::SpamAssassin::Logger;
+
+=head1 NAME
+
+Mail::SpamAssassin::Spamd::Apache2::AclIP - host-based spamd access control
+
+=head1 SYNOPSIS
+
+ ##### in httpd.conf:
+ PerlLoadModule Mail::SpamAssassin::Spamd::Apache2::Config
+ SAallow from 127.0.0.1 192.168.0.0/24
+
+=head1 DESCRIPTION
+
+Allows / denies access to spamd basing on client's network address.
+This is a simple version of C<mod_authz_host> (which, unfortunately,
+is too HTTP-centric to use here).
+
+Should be before C<Mail::SpamAssassin::Spamd::Apache2::AclRFC1413>
+in the handler chain.
+
+=head1 NOTE
+
+This module doesn't prevent Apache from accepting a connection; child
+(and therefore we) get control after client actually sends something.
+It's possible to open C<$toomany> connections to the parent server and
+DoS this way.
+
+=head1 BUGS
+
+See <http://bugzilla.spamassassin.org/>
+
+=head1 SEE ALSO
+
+L<Mail::SpamAssassin::Spamd::Apache2::Config(3)>
+
+=cut
+
+use APR::IpSubnet ();
+
+sub handler {
+ my ($c) = @_;
+
+ my $srv_cfg =
+ Apache2::Module::get_config('Mail::SpamAssassin::Spamd::Apache2::Config',
+ $c->base_server);
+
+ # TODO: log it somewhere (or not?) -- means all denied
+ return Apache2::Const::SERVER_ERROR
+ unless $srv_cfg && exists $srv_cfg->{allowed_ips};
+
+ # use NetAddr::IP::Lite ();
+ # my $ip = NetAddr::IP::Lite->new($c->remote_ip)
+ # or return Apache2::Const::SERVER_ERROR; # log it, shouldn't happen
+
+ my $remote = $c->remote_addr;
+ for my $allowed (@{ $srv_cfg->{allowed_networks} }) {
+ # depends on allowed_ips format; TODO; if NetAddr::IP::Lite:
+ # return Apache2::Const::OK if $allowed->contains($ip);
+ return Apache2::Const::OK if $allowed->test($remote);
+ }
+
+ info(sprintf "access denied for '%s'", $c->remote_ip);
+ return Apache2::Const::FORBIDDEN;
+}
+
+1;
+
+# vim: ts=8 sw=2 et

Added: spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclRFC1413.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclRFC1413.pm?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclRFC1413.pm (added)
+++ spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/AclRFC1413.pm Tue Aug 29 10:09:31 2006
@@ -0,0 +1,135 @@
+package Mail::SpamAssassin::Spamd::Apache2::AclRFC1413;
+use strict;
+
+use Apache2::Const -compile => qw(OK FORBIDDEN SERVER_ERROR);
+use Apache2::Connection ();
+use Apache2::RequestUtil (); # RequestRec->new
+use Apache2::RequestRec ();
+use Apache2::Access (); # $r->get_remote_logname
+
+use APR::SockAddr (); # $c->remote_addr->...
+use APR::Table (); # $c->notes
+
+=head1 NAME
+
+Mail::SpamAssassin::Spamd::Apache2::AclRFC1413 - check spamd's client ident
+
+=head1 SYNOPSIS
+
+ ##### in httpd.conf:
+ # engine; module has been separated in Apache 2.1
+ LoadModule ident_module modules/mod_ident.so
+ IdentityCheck on
+ IdentityTimeout 4
+
+ # enable check
+ PerlLoadModule Mail::SpamAssassin::Spamd::Apache2::Config
+ SAident on
+
+ ##### in PerlProcessConnectionHandler:
+ Mail::SpamAssassin::Spamd::Apache2::AclRFC1413::check_ident($c, "user")
+ or return Apache2::Const::FORBIDDEN;
+
+ # or like this:
+ my $remote_logname =
+ Mail::SpamAssassin::Spamd::Apache2::AclRFC1413::get_ident($c)
+
+=head1 DESCRIPTION
+
+Queries remote ident server using mod_ident.so, saves result in
+C<$c->notes()>.
+
+Returns C<Apache2::Const::FORBIDDEN> on failure.
+
+The C<SAident On> directive actually does this:
+ PerlPreConnectionHandler Mail::SpamAssassin::Spamd::Apache2::AclRFC1413
+
+=head1 NOTE
+
+Doing ident for non-localhost users is rather pointless. Unless you
+know what you're doing, listen only on C<127.0.0.1> and/or C<::1>, if
+you want to prevent users from lying about their identity. Or use SSL
+with client certificates (refer to C<mod_ssl> documentation for details).
+
+=head1 FUNCTIONS
+
+=cut
+
+sub handler {
+ my ($c) = @_;
+
+ # is there a point in doing ident for remote users?
+ #$c->remote_ip eq $c->local_ip
+ # or return Apache2::Const::FORBIDDEN;
+
+ my $r = Apache2::RequestRec->new($c)
+ or die 'Apache2::RequestRec->new($c) failed';
+
+ my $remote_user = $r->get_remote_logname;
+
+ unless (defined $remote_user && length $remote_user) {
+ warn 'rfc1413 check: failed to obtain info for '
+ . $c->remote_addr->ip_get() . ':'
+ . $c->remote_addr->port() . "\n";
+ return Apache2::Const::FORBIDDEN;
+ }
+
+ my $notes = $c->notes # APR::Table
+ or die '$c->notes failed';
+ $notes->{remote_user} = $remote_user;
+ $c->notes($notes);
+
+ return Apache2::Const::OK;
+}
+
+=head2 check_ident($c, $username)
+
+Returns remote username (might be "0"), as returned by the ident server, if it
+matches supplied $username; undef otherwise.
+
+=cut
+
+sub check_ident {
+ my ($c, $user) = @_;
+ my $remote_user = $c->notes->{remote_user};
+ die "rfc1413 check: no query result for user=$user ip="
+ . $c->remote_addr->ip_get()
+ . ' port='
+ . $c->remote_addr->port()
+ unless defined $remote_user && length $remote_user;
+ return $remote_user if $user eq $remote_user;
+ warn "ident mismatch for [$user] from "
+ . $c->remote_addr->ip_get() . ':'
+ . $c->remote_addr->port()
+ . "; remote identd returned [$remote_user]\n";
+ 0;
+}
+
+=head2 get_ident($c)
+
+Returns remote username (might be "0"), as returned by the ident server.
+
+=cut
+
+sub get_ident {
+ my ($c) = @_;
+ $c->notes->{remote_user};
+}
+
+=head1 EXPORTS
+
+Nothing.
+
+=head1 BUGS
+
+See <http://bugzilla.spamassassin.org/>
+
+=head1 SEE ALSO
+
+L<Mail::SpamAssassin::Spamd::Apache2::Config(3)>
+
+=cut
+
+1;
+
+# vim: ts=8 sw=2 et

Added: spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/Config.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/Config.pm?rev=438116&view=auto
==============================================================================
--- spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/Config.pm (added)
+++ spamassassin/trunk/spamd-apache2/lib/Mail/SpamAssassin/Spamd/Apache2/Config.pm Tue Aug 29 10:09:31 2006
@@ -0,0 +1,556 @@
+package Mail::SpamAssassin::Spamd::Apache2::Config;
+use strict;
+
+use Apache2::ServerUtil ();
+my $server = Apache2::ServerUtil->server() or die 'serverutil->server';
+$server->push_handlers(
+ PerlPostConfigHandler => [\&post_config, \&add_version_string,],);
+
+=head1 NAME
+
+Mail::SpamAssassin::Spamd::Apache2::Config -- configure Apache with SpamAssassin
+
+=head1 SYNOPSIS
+
+ LoadModule perl_module modules/mod_perl.so
+ PerlLoadModule Mail::SpamAssassin::Spamd::Apache2::Config
+ SAEnabled On # default off
+
+ SAAllow from 127.0.0.1 192.168.0.0/24 ::1
+ SAIdent Off
+ SATell Off
+ SATimeout 300 # reasonable: around 30s
+ SADebug info
+ SAMsgSizeLimit 512000
+
+=head1 DESCRIPTION
+
+Provides Apache config directives for configuring spamd. Initializes the
+L<Mail::SpamAssassin> object.
+
+Note, that the defaults here apply to *this* code; L<apache-spamd.pl(1)>
+sets different ones to be compatible with L<spamd(1)>.
+
+=head1 DIRECTIVES
+
+=over
+
+=cut
+
+use Apache2::Module ();
+use Apache2::CmdParms ();
+use Apache2::Const -compile =>
+ qw(OK RSRC_CONF ITERATE ITERATE2 FLAG TAKE1 TAKE2 :log SERVER_ERROR);
+
+{
+ my @directives;
+
+=item C<SAEnabled { On | Off }>
+
+Enables / disables SA for given vhost. Adds two handlers:
+
+ SetHandler modperl
+ PerlProcessConnectionHandler Mail::SpamAssassin::Spamd::Apache2
+ PerlPreConnectionHandler Mail::SpamAssassin::Spamd::Apache2::AclIP
+
+Defaults to Off.
+
+=cut
+
+push @directives, { # not inherited
+ name => 'SAEnabled',
+ args_how => Apache2::Const::FLAG,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SAEnable { On | Off }',
+};
+
+=item C<SAAllow from 127.0.0.1 192.168/16 ::1 ...>
+
+Similar to C<Allow from ...> directive from C<mod_authz_vhost>. Spamd's
+C<--allowed-ips> arguments should go here.
+
+Default is empty, meaning access is denied.
+
+=cut
+
+push @directives, { # inherited
+ name => 'SAAllow',
+ args_how => Apache2::Const::ITERATE2,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SAAllow from 127.0.0.1 192.168/16 ::1 ...',
+};
+
+=item C<SAIdent { On | Off }>
+
+Enables RFC 1413 (ident) checks incoming connections. Note, that checking
+if a *remote* login matches a *local* one is usually pointless. See
+L<Mail::SpamAssassin::Apache2::AclRFC1413(3)> for more details.
+
+Adds a handler:
+
+ PerlPreConnectionHandler Mail::SpamAssassin::Spamd::Apache2::AclRFC1413
+
+Requires C<IdentityCheck on> in current configuration scope. This directive
+is provided by the C<mod_ident> module, separated from core in Apache 2.1.
+
+Default off.
+
+=cut
+
+push @directives, { # inherited
+ name => 'SAIdent',
+ args_how => Apache2::Const::FLAG,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SAIdent { On | Off }',
+};
+
+=item C<SATell { On | Off }>
+
+Allow clients to issue the C<TELL> command. Default off.
+
+=cut
+
+push @directives, { # inherited
+ name => 'SATell',
+ args_how => Apache2::Const::FLAG,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SATell { On | Off }',
+};
+
+=item C<SATimeout 300>
+
+Timeout for SpamAssassin checks. 25 seconds is a reasonable value.
+
+Default C<0> (unlimited).
+
+=cut
+
+push @directives, { # inherited
+ name => 'SATimeout',
+ args_how => Apache2::Const::TAKE1,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SATimeout 300 # unit: seconds',
+};
+
+=item C<SADebug debug_level>
+
+Debug level for SpamAssassin.
+
+=cut
+
+push @directives, { # inherited
+ name => 'SADebug',
+ args_how => Apache2::Const::TAKE1,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SADebug { debug_level | 0 }',
+};
+
+=item C<SAMsgSizeLimit 512000>
+
+Maximum message size which will be processed. You're strongly encouraged to
+set this value. Unit: bytes.
+
+=cut
+
+push @directives, { # inherited
+ name => 'SAMsgSizeLimit',
+ args_how => Apache2::Const::TAKE1,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SAMsgSizeLimit limit_in_bytes',
+};
+
+=item C<SANew key "value">
+
+Additional arguments to C<Mail::SpamAssassin->new()>. Refer to
+L<Mail::SpamAssassin(3)>.
+
+=cut
+
+push @directives, {
+ name => 'SANew',
+ args_how => Apache2::Const::TAKE2,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SANew rules_filename "/some/path"',
+};
+
+=item C<SAUsers { none | local | sql | ldap }>
+
+Databases which should be checked for user information.
+Will be checked in the order specified.
+
+Default C<none>.
+
+=cut
+
+push @directives, { # inherited
+ name => 'SAUsers',
+ args_how => Apache2::Const::ITERATE,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SAUsers { none | local | sql | ldap }',
+};
+
+=item C<SALocale xx_XX>
+
+Value of the LANG environment variable SpamAssassin should run with.
+
+Default C<none>, unless you set Apache otherwise somehow.
+
+=cut
+
+push @directives, { # inherited
+ name => 'SALocale',
+ args_how => Apache2::Const::TAKE1,
+ req_override => Apache2::Const::RSRC_CONF,
+ errmsg => 'SALocale xx_XX',
+};
+
+ Apache2::Module::add(__PACKAGE__, \@directives);
+}
+
+=back
+
+=cut
+
+
+# executed whenever directive is seen
+sub SAEnabled {
+ my ($self, $parms, $arg) = @_;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ $srv_cfg->{saenabled} = $arg;
+}
+
+sub SAAllow { # can't use mod_authz_host; it is HTTP-centric
+ my ($self, $parms, $key, $val) = @_;
+ die 'usage: SAAllow from ... ... ...' unless $key eq 'from';
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ push @{ $srv_cfg->{allowed_ips} }, $val;
+}
+
+sub SAIdent {
+ my ($self, $parms, $arg) = @_;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ $srv_cfg->{auth_ident} = $arg;
+}
+
+sub SATell {
+ my ($self, $parms, $arg) = @_;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ $srv_cfg->{allow_tell} = $arg;
+}
+
+sub SATimeout {
+ my ($self, $parms, $arg) = @_;
+ die "SATimeout accepts *seconds*\n" if $arg !~ /^\d+$/;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ $srv_cfg->{satimeout} = $arg;
+}
+
+sub SADebug {
+ my ($self, $parms, $arg) = @_;
+ die "SADebug can't be used in vhost, see bug #4963\n"
+ if $parms->server->is_virtual;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ $srv_cfg->{sa_debug} = $arg;
+}
+
+sub SAMsgSizeLimit {
+ my ($self, $parms, $arg) = @_;
+ die "MsgSizeLimit accepts *number*\n" if $arg !~ /^\d+$/;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ $srv_cfg->{msg_size_limit} = $arg;
+}
+
+sub SANew {
+ my ($self, $parms, $key, $val) = @_;
+ die "SANew can't be used in vhost, see bug #4963\n"
+ if $parms->server->is_virtual;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ $srv_cfg->{sa_args_to_new}->{$key} = $val;
+}
+
+sub SAUsers {
+ my ($self, $parms, $arg) = @_;
+ $arg = lc $arg;
+ die "SAUsers: bad value\n" unless $arg =~ /^(?:none|local|sql|ldap)$/;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ push @{ $srv_cfg->{sa_users} }, $arg;
+}
+
+
+sub SALocale {
+ my ($self, $parms, $arg) = @_;
+ die "SALocale can't be used in vhost, see bug #4963\n"
+ if $parms->server->is_virtual;
+ my $srv_cfg = Apache2::Module::get_config($self, $parms->server);
+ $srv_cfg->{sa_locale} = $arg;
+}
+
+
+# executed after (XXX: not before?) SA* for every server (vhost or main)
+sub SERVER_CREATE {
+ my ($class, $parms) = @_;
+ bless { saenabled => 0, satimeout => 300, }, #msg_size_limit => 500*1024, },
+ $class;
+}
+
+# executed for every vhost, after processing SAOptions and SERVER_CREATE
+sub SERVER_MERGE {
+ my ($base, $add) = @_;
+ my $new = { saenabled => $add->{saenabled}, };
+
+ # SAallow in vhost completely overrides SAAllow in base, otherwise
+ # inherit; maybe not very intuitive, but will do until better idea
+ $new->{allowed_ips} =
+ exists $add->{allowed_ips} ? [@{ $add->{allowed_ips} }]
+ : exists $base->{allowed_ips} ? [@{ $base->{allowed_ips} }]
+ : [warn('warning: access denied for everyone in vhost') && ()];
+
+ for my $opt (
+ qw(auth_ident ident_timeout allow_tell
+ sa_debug sa_args_to_new sa_users sa_locale)
+ )
+ {
+ $new->{$opt} =
+ exists $add->{$opt} ? $add->{$opt}
+ : exists $base->{$opt} ? $base->{$opt}
+ : 0;
+ }
+
+ $new->{satimeout} =
+ exists $add->{satimeout} ? $add->{satimeout}
+ : exists $base->{satimeout} ? $base->{satimeout}
+ : die 'should not happen';
+
+ bless $new, ref $base;
+}
+
+use APR::Const -compile => qw(:error SUCCESS);
+use Apache2::ServerRec (); # $s->is_virtual
+use Apache2::Log ();
+use File::Temp (); # tempdir
+use File::Path (); # rmpath
+
+# PerlPostConfigHandler
+sub post_config {
+ my ($conf_pool, $log_pool, $temp_pool, $serv) = @_;
+ my ($num_vhosts, $num_configured);
+ my $hackish_tmp_ref;
+
+ for (my $s = $serv; $s; $s = $s->next) {
+ die "\$num_vhosts>5000; loop?" if ++$num_vhosts > 1000;
+ my $srv_cfg = Apache2::Module::get_config(__PACKAGE__, $s) || '';
+
+ # hack: if default server is configured with SAEnabled On, and a vhost
+ # is not, the vhost inherits On value. I don't know how to prevent it
+ # other way... check $hackish_tmp_ref use later. --radek
+ $hackish_tmp_ref = $srv_cfg unless $s->is_virtual;
+
+ # is SA enabled for this vhost?
+ if (!$srv_cfg->{saenabled}
+ or $s->is_virtual && $srv_cfg eq $hackish_tmp_ref)
+ {
+ my $msg = 'SAEnabled off for ' . _vhost_id($s);
+
+ # it inherits handler too
+ $msg .= ' and on in default server; it probably won\'t work as'
+ . ' you intend it to -- either Apache or this code is broken'
+ if $hackish_tmp_ref->{saenabled} && $srv_cfg && !$srv_cfg->{saenabled};
+
+ $s->log_serror(Apache2::Log::LOG_MARK(),
+ Apache2::Const::LOG_DEBUG | Apache2::Const::LOG_STARTUP,
+ APR::Const::SUCCESS, $msg);
+ next;
+ }
+
+ # check options
+ if (ref $srv_cfg->{sa_users}
+ && grep { $_ eq 'none' } @{ $srv_cfg->{sa_users} })
+ {
+ if (@{ $srv_cfg->{sa_users} } > 1) {
+ die "if you add 'none' to SAUsers, it's pointless to add anything else\n";
+ }
+ else {
+ delete $srv_cfg->{sa_users};
+ }
+ }
+
+ # create list of allowed networks
+ use APR::IpSubnet ();
+ for my $net (@{ $srv_cfg->{allowed_ips} }) {
+ my $ais = APR::IpSubnet->new($conf_pool, split m#/#, $net, 2)
+ or die "APR::IpSubnet->new($net) failed";
+ push @{ $srv_cfg->{allowed_networks} }, $ais;
+ }
+
+ my @cfg = (
+ 'SetHandler modperl',
+ 'PerlProcessConnectionHandler Mail::SpamAssassin::Spamd::Apache2',
+ 'PerlPreConnectionHandler Mail::SpamAssassin::Spamd::Apache2::AclIP',
+ );
+
+ require Mail::SpamAssassin::Spamd::Apache2;
+ require Mail::SpamAssassin::Spamd::Apache2::AclIP;
+
+ if ($srv_cfg->{auth_ident}) {
+ require Mail::SpamAssassin::Spamd::Apache2::AclRFC1413;
+ push @cfg, 'PerlPreConnectionHandler '
+ . 'Mail::SpamAssassin::Spamd::Apache2::AclRFC1413';
+ }
+
+ $s->add_config(\@cfg);
+
+ if (!$Mail::SpamAssassin::Spamd::Apache2::spamtest) {
+ require Mail::SpamAssassin;
+ local $/ = $/; # Razor resets this
+
+ # Is there a way to toggle these settings in handler? See bug #4963.
+ # Problem: if other vhost defined eg. SALocal, it would be silently
+ # ignored, as this block executes only for the first SAEnabled seen.
+ # Workaround: forcing these settings to be unavailable in vhosts
+ # until the bug is resolved.
+ my $sa = Mail::SpamAssassin->new({
+## dont_copy_prefs => $dontcopy,
+## rules_filename => ($srv_cfg->{configpath} || 0),
+## site_rules_filename => ($srv_cfg->{siteconfigpath} || 0),
+ debug => ($srv_cfg->{sa_debug} || 0),
+## paranoid => ($srv_cfg->{paranoid} || 0),
+## PREFIX => $PREFIX,
+## DEF_RULES_DIR => $DEF_RULES_DIR,
+## LOCAL_RULES_DIR => $LOCAL_RULES_DIR,
+## LOCAL_STATE_DIR => $LOCAL_STATE_DIR,
+ ($srv_cfg->{sa_args_to_new} ? %{ $srv_cfg->{sa_args_to_new} } : ()),
+ }) or die 'Mail::SpamAssassin->new() failed';
+
+ # initialize SA configuration
+ my $tmphome = File::Temp::tempdir()
+ or die "creating temp directory failed: $!";
+ my $tmpsadir = File::Spec->catdir($tmphome, '.spamassassin');
+ mkdir $tmpsadir, 0700 or die "spamd: cannot create $tmpsadir: $!";
+ $ENV{HOME} = $tmphome;
+ $sa->compile_now(0, 1);
+ delete $ENV{HOME};
+ File::Path::rmtree($tmphome);
+ $Mail::SpamAssassin::Spamd::Apache2::spamtest = $sa;
+ Mail::SpamAssassin::Spamd::backup_config($sa);
+ }
+
+ $num_configured++;
+ $s->log_serror(Apache2::Log::LOG_MARK(),
+ Apache2::Const::LOG_DEBUG | Apache2::Const::LOG_STARTUP,
+ APR::Const::SUCCESS,
+ 'spamd handler configured for ',
+ _vhost_id($s)
+ );
+ }
+
+ if (!$num_configured) {
+ $serv->log_serror(Apache2::Log::LOG_MARK(),
+ Apache2::Const::LOG_NOTICE | Apache2::Const::LOG_STARTUP,
+ APR::Const::EGENERAL, 'no spamd handlers configured');
+ }
+
+ return Apache2::Const::OK;
+}
+
+sub _vhost_id {
+ my $s = shift; # ServerRec
+ $s->is_virtual()
+ ? 'vhost ' . $s->server_hostname() . ':' . $s->port()
+ : 'default server';
+}
+
+# PerlPostConfigHandler
+sub add_version_string {
+ my ($conf_pool, $log_pool, $temp_pool, $serv) = @_;
+ my $version = Mail::SpamAssassin->VERSION || '?';
+ $serv->add_version_component("SpamAssassin/$version");
+ return Apache2::Const::OK;
+}
+
+
+=head1 EXAMPLES
+
+You'll need some basic Apache directives in each configuration; that should be
+obvious.
+
+ PidFile "/var/run/apache-spamd.pid"
+ ServerName localhost
+ TimeOut 30
+
+ StartServers 1
+ MinSpareServers 1
+ MaxSpareServers 2
+ MaxClients 5
+ MaxRequestsPerChild 200
+
+If the Mail::SpamAssassin::* perl modules are installed somewhere outside of
+C<@INC>, you can use something like:
+
+ PerlSwitches -I/home/users/someuser/lib
+
+=head2 simple
+
+ Listen 127.0.0.1:30783
+ LoadModule perl_module /usr/lib/apache/mod_perl.so
+ PerlLoadModule Mail::SpamAssassin::Spamd::Apache2::Config
+ SAenabled on
+ SAAllow from 127.0.0.1
+ SAtimeout 25
+ SAdebug info
+ SANew DEF_RULES_DIR "/usr/share/spamassassin"
+ SANew LOCAL_RULES_DIR "/etc/mail/spamassassin"
+ SANew LOCAL_STATE_DIR "/var/lib"
+ SAUsers local sql
+
+=head2 vhosts with different config
+
+ Listen 127.0.0.1:30783
+ Listen 30784
+ LoadModule perl_module /usr/lib/apache/mod_perl.so
+ PerlLoadModule Mail::SpamAssassin::Spamd::Apache2::Config
+ SAenabled off
+ SAtimeout 25
+ SAdebug info
+ SANew DEF_RULES_DIR "/usr/share/spamassassin"
+ SANew LOCAL_RULES_DIR "/etc/mail/spamassassin"
+ SANew LOCAL_STATE_DIR "/var/lib"
+
+ LoadModule ident_module /usr/lib/apache/mod_ident.so
+
+ # local, ident-authenticated users only; search in /etc/passwd,
+ # if that fails, try SQL
+ <VirtualHost _default_:30783>
+ IdentityCheck on
+ IdentityCheckTimeout 4
+ SAenabled on
+ SAident on
+ SAAllow from 127.0.0.1
+ SAUsers local sql
+ </VirtualHost>
+
+ # serve for whole LAN, but don't read user configuration
+ <VirtualHost _default_:30784>
+ SAenabled on
+ SAtimeout 30
+ SAAllow from 127.0.0.1 192.168.0.0/24
+ SAUsers none
+ </VirtualHost>
+
+=head1 BUGS
+
+See <http://bugzilla.spamassassin.org/>.
+
+=head1 SEE ALSO
+
+L<httpd(8)>,
+L<spamd(1)>,
+L<apache-spamd(1)>,
+L<Mail::SpamAssassin::Spamd::Apache2(3)>,
+L<Mail::SpamAssassin::Spamd::Apache2::AclIP(3)>,
+L<Mail::SpamAssassin::Spamd::Apache2::AclRFC1413(3)>
+
+=cut
+
+1;
+
+# vim: ts=2 sw=2 et