"Fossies" - the Fresh Open Source Software Archive

Member "Mail-SPF-Query-1.999.1/bin/spfd" (7 Feb 2006, 9397 Bytes) of package /linux/privat/old/Mail-SPF-Query-1.999.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl
    2 
    3 #
    4 # spfd: Simple forking daemon to provide SPF query services
    5 # 
    6 # (C) 2003-2004 Meng Weng Wong <mengwong+spf@pobox.com>
    7 #     2005-2006 Julian Mehnle <julian@mehnle.net>
    8 # 
    9 # If you're reading source code, you should probably be on
   10 # spf-devel@v2.listbox.com.
   11 #
   12 # $Id: spfd 141 2006-02-07 00:04:51Z julian $
   13 #
   14 ##############################################################################
   15 
   16 =head1 NAME
   17 
   18 spfd - simple forking daemon to provide SPF query services
   19 
   20 =head1 VERSION
   21 
   22 2006-02-07
   23 
   24 =head1 SYNOPSIS
   25 
   26 B<spfd> B<--port> I<port> [B<--set-user> I<uid>|I<username>] [B<--set-group>
   27 I<gid>|I<groupname>]
   28 
   29 B<spfd> B<--socket> I<filename> [B<--socket-user> I<uid>|I<username>]
   30 [B<--socket-group> I<gid>|I<groupname>] [B<--socket-perms> I<octal-perms>]
   31 [B<--set-user> I<uid>|I<username>] [B<--set-group> I<gid>|I<groupname>]
   32 
   33 B<spfd> B<--help>
   34 
   35 =head1 DESCRIPTION
   36 
   37 B<spfd> is a simple forking Sender Policy Framework (SPF) query proxy server.
   38 spfd receives and answers SPF query requests on a TCP/IP or UNIX domain
   39 socket.
   40 
   41 The B<--port> form listens on a TCP/IP socket on the specified I<port>.  The
   42 default port is B<5970>.
   43 
   44 The B<--socket> form listens on a UNIX domain socket that is created with the
   45 specified I<filename>.  The socket can be assigned specific user and group
   46 ownership with the B<--socket-user> and B<--socket-group> options, and specific
   47 filesystem permissions with the B<--socket-perms> option.
   48 
   49 Generally, spfd can be instructed with the B<--set-user> and B<--set-group>
   50 options to drop root privileges and change to another user and group before it
   51 starts listening for requests.
   52 
   53 The B<--help> form prints usage information for B<spfd>.
   54 
   55 =head1 REQUEST
   56 
   57 A request consists of a series of lines delimited by \x0A (LF) characters (or
   58 whatever your system considers a newline).  Each line must be of the form
   59 I<key>B<=>I<value>, where the following keys are required:
   60 
   61 =over
   62 
   63 =item B<ip>
   64 
   65 The sender IP address.
   66 
   67 =item B<sender>
   68 
   69 The envelope sender address (from the SMTP C<MAIL FROM> command).
   70 
   71 =item B<helo>
   72 
   73 The envelope sender hostname (from the SMTP C<HELO> command).
   74 
   75 =back
   76 
   77 =head1 RESPONSE
   78 
   79 spfd responds to query requests with similar series of lines of the form
   80 I<key>B<=>I<value>.  The most important response keys are:
   81 
   82 =over
   83 
   84 =item B<result>
   85 
   86 The result of the SPF query:
   87 
   88 =over 10
   89 
   90 =item I<pass>
   91 
   92 The specified IP address is an authorized mailer for the sender domain/address.
   93 
   94 =item I<fail>
   95 
   96 The specified IP address is not an authorized mailer for the sender
   97 domain/address.
   98 
   99 =item I<softfail>
  100 
  101 The specified IP address is not an authorized mailer for the sender
  102 domain/address, however the domain is still in the process of transitioning to
  103 SPF.
  104 
  105 =item I<neutral>
  106 
  107 The sender domain makes no assertion about the status of the IP address.
  108 
  109 =item I<unknown>
  110 
  111 The sender domain has a syntax error in its SPF record.
  112 
  113 =item I<error>
  114 
  115 A temporary DNS error occurred while resolving the sender policy.  Try again
  116 later.
  117 
  118 =item I<none>
  119 
  120 There is no SPF record for the sender domain.
  121 
  122 =back
  123 
  124 =item B<smtp_comment>
  125 
  126 The text that should be included in the receiver's SMTP response.
  127 
  128 =item B<header_comment>
  129 
  130 The text that should be included as a comment in the message's C<Received-SPF:>
  131 header.
  132 
  133 =item B<spf_record>
  134 
  135 The SPF record of the envelope sender domain.
  136 
  137 =back
  138 
  139 For the description of other response keys see L<Mail::SPF::Query>.
  140 
  141 For more information on SPF see L<http://www.openspf.org>.
  142 
  143 =head1 EXAMPLE
  144 
  145 A running spfd could be tested using the C<netcat> utility like this:
  146 
  147     $ echo -e "ip=11.22.33.44\nsender=user@pobox.com\nhelo=spammer.example.net\n" | nc localhost 5970
  148     result=neutral
  149     smtp_comment=Please see http://spf.pobox.com/why.html?sender=user%40pobox.com&ip=11.22.33.44&receiver=localhost
  150     header_comment=localhost: 11.22.33.44 is neither permitted nor denied by domain of user@pobox.com
  151     guess=neutral
  152     smtp_guess=
  153     header_guess=
  154     guess_tf=neutral
  155     smtp_tf=
  156     header_tf=
  157     spf_record=v=spf1 ?all
  158 
  159 =head1 SEE ALSO
  160 
  161 L<Mail::SPF::Query>, L<http://www.openspf.org>
  162 
  163 =head1 AUTHORS
  164 
  165 This version of B<spfd> was written by Meng Weng Wong <mengwong+spf@pobox.com>.
  166 Improved argument parsing was added by Julian Mehnle <julian@mehnle.net>.
  167 
  168 This man-page was written by Julian Mehnle <julian@mehnle.net>.
  169 
  170 =cut
  171 
  172 use warnings;
  173 use strict;
  174 
  175 use Mail::SPF::Query;
  176 use Getopt::Long qw(:config gnu_compat);
  177 use Socket;
  178 
  179 use constant DEBUG => $ENV{DEBUG};
  180 
  181 sub usage () {
  182   print STDERR <<'EOT';
  183 Usage:
  184     spfd --port <port>
  185         [--set-user <uid>|<username>] [--set-group <gid>|<groupname>]
  186     spfd --socket <filename> [--socket-user <uid>|<username>]
  187         [--socket-group <gid>|<groupname>] [--socket-perms <octal-perms>]
  188         [--set-user <uid>|<username>] [--set-group <gid>|<groupname>]
  189 EOT
  190 }
  191 
  192 my %opt;
  193 
  194 my $getopt_result = GetOptions(
  195   \%opt,
  196   'port=i',
  197   'socket|path=s',
  198   'socket-user|pathuser=s',
  199   'socket-group|pathgroup=s',
  200   'socket-perms|pathmode=s',
  201   'set-user|setuser=s',
  202   'set-group|setgroup=s',
  203   'help!'
  204 );
  205 
  206 if ($opt{help}) {
  207   usage;
  208   exit 0;
  209 }
  210 
  211 if ($opt{port} and $opt{socket}) {
  212   usage;
  213   exit 1;
  214 }
  215 
  216 if (not $opt{port} and not $opt{socket}) {
  217   print STDERR "Using default TCP/IP port.  Run `spfd --help` for possible options.\n";
  218   $opt{port} = 5970;
  219 }
  220 
  221 $| = 1;
  222 
  223 my @args;
  224 my $sock_type;
  225 
  226 if ($opt{port}) {
  227   $sock_type = 'inet';
  228   @args = (Listen    => 1,
  229            LocalAddr => '127.0.0.1',
  230            LocalPort => $opt{port},
  231            ReuseAddr => 1
  232            );
  233   print "$$: will listen on TCP port $opt{port}\n";
  234   $0 = "spfd listening on TCP port $opt{port}";
  235 } elsif ($opt{socket}) {
  236   $sock_type = 'unix';
  237   unlink $opt{socket} if -S $opt{socket};
  238   @args = (Listen => 1,
  239            Local => $opt{socket},
  240            );
  241   print "$$: will listen at UNIX socket $opt{socket}\n";
  242   $0 = "spfd listening at UNIX socket $opt{socket}";
  243 }
  244 
  245 print "$$: creating server with args @args\n";
  246 
  247 my $server = $sock_type eq 'inet' ? IO::Socket::INET->new(@args) : IO::Socket::UNIX->new(@args);
  248 
  249 if ($opt{socket}) {
  250   if (defined $opt{'socket-user'} or defined $opt{'socket-group'}) {
  251     $opt{'socket-user'}  = -1 if not defined($opt{'socket-user'});
  252     $opt{'socket-group'} = -1 if not defined($opt{'socket-group'});
  253 
  254     if ($opt{'socket-user'} =~ /\D/) {
  255       $opt{'socket-user'} = getpwnam($opt{'socket-user'}) || die "User: $opt{'socket-user'} not found\n";
  256     }
  257 
  258     if ($opt{'socket-group'} =~ /\D/) {
  259       $opt{'socket-group'} = getgrnam($opt{'socket-group'}) || die "Group: $opt{'socket-group'} not found\n";
  260     }
  261 
  262     chown $opt{'socket-user'}, $opt{'socket-group'}, $opt{socket} or die "chown call failed on $opt{socket}: $!\n";
  263   }
  264   if (defined $opt{'socket-perms'}) {
  265     chmod oct($opt{'socket-perms'}), $opt{socket} or die "Cannot fixup perms on $opt{socket}: $!\n";
  266   }
  267 }
  268 
  269 DEBUG and print "$$: server is $server\n";
  270 
  271 if ($opt{'set-group'}) {
  272   if ($opt{'set-group'} =~ /\D/) {
  273     $opt{'set-group'} = getgrnam($opt{'set-group'}) || die "Group: $opt{'set-group'} not found\n";
  274   }
  275   $( = $opt{'set-group'};
  276   $) = $opt{'set-group'};
  277   unless ($( == $opt{'set-group'} and $) == $opt{'set-group'}) {
  278     die( "setgid($opt{'set-group'}) call failed: $!\n" );
  279   }
  280 }
  281 
  282 if ($opt{'set-user'}) {
  283   if ($opt{'set-user'} =~ /\D/) {
  284     $opt{'set-user'} = getpwnam($opt{'set-user'}) || die "User: $opt{'set-user'} not found\n"; 
  285   }
  286   $< = $opt{'set-user'};
  287   $> = $opt{'set-user'};
  288   unless ($< == $opt{'set-user'} and $> == $opt{'set-user'}) {
  289     die( "setuid($opt{'set-user'}) call failed: $!\n" );
  290   }
  291 }
  292 
  293 while (my $sock = $server->accept()) {
  294   if    (fork) { close $sock; wait; next; } # this is the grandfather trick.
  295   elsif (fork) {                    exit; } # the child exits immediately, so no zombies.
  296 
  297   my $oldfh = select($sock); $| = 1; select($oldfh);
  298 
  299   my %in;
  300 
  301   while (<$sock>) {
  302     chomp; chomp;
  303     last if (/^$/);
  304     my ($lhs, $rhs) = split /=/, $_, 2;
  305     $in{lc $lhs} = $rhs;
  306   }
  307 
  308   my $peerinfo = $sock_type eq "inet" ? ($sock->peerhost . "/" . gethostbyaddr($sock->peeraddr, AF_INET)) : "";
  309 
  310   my $time = localtime;
  311   
  312   DEBUG and print "$time $peerinfo\n";
  313   foreach my $key (sort keys %in) { DEBUG and print "learned $key = $in{$key}\n" };
  314 
  315   my %q = map { exists $in{$_} ? ($_ => $in{$_}) : () } qw ( ip ipv4 ipv6 sender helo guess_mechs trusted local );
  316 
  317   my %a;
  318 
  319   my $query = eval { Mail::SPF::Query->new(%q); };
  320 
  321   my $error = $@; for ($error) { s/\n/ /; s/\s+$//; }
  322 
  323   if ($@) { @a{qw(result smtp_comment header_comment)} = ("unknown", $error, "SPF error: $error"); }
  324   else {
  325     @a{qw(result    smtp_comment header_comment spf_record)} = $query->result();
  326     @a{qw(guess     smtp_guess   header_guess  )} = $query->best_guess();
  327     @a{qw(guess_tf  smtp_tf      header_tf     )} = $query->trusted_forwarder();
  328   }
  329 
  330   if (DEBUG) {
  331     for (qw(result    smtp_comment header_comment
  332             guess     smtp_guess   header_guess
  333             guess_tf  smtp_tf      header_tf
  334             spf_record
  335             )) {
  336       print "moo!  $_=$a{$_}\n";
  337     }
  338   }
  339 
  340   for (qw(result    smtp_comment header_comment
  341           guess     smtp_guess   header_guess
  342           guess_tf  smtp_tf      header_tf
  343           spf_record
  344           )) {
  345     no warnings 'uninitialized';
  346     print $sock "$_=$a{$_}\n";
  347   }
  348 
  349   DEBUG and print "moo!  output all done.\n";
  350   print $sock "\n";
  351   DEBUG and print "\n";
  352 
  353   close $sock;
  354 
  355   exit;
  356 }