1#!/usr/local/bin/perl
2
3#
4# spfd: Simple forking SPF query service daemon
5#
6# (C) 2005-2012 Julian Mehnle <julian@mehnle.net>
7#     2003-2004 Meng Weng Wong <mengwong+spf@pobox.com>
8# $Id: spfd 148 2006-06-17 21:50:57Z Julian Mehnle $
9#
10##############################################################################
11
12=head1 NAME
13
14spfd - (Mail::SPF) - Simple forking daemon to provide SPF query services
15
16=head1 VERSION
17
182.000
19
20=head1 SYNOPSIS
21
22B<spfd> B<--port>|B<-p> I<port> [B<--set-user>|B<-u> I<uid>|I<username>]
23[B<--set-group>|B<-g> I<gid>|I<groupname>] [I<OPTIONS>]
24
25B<spfd> B<--socket>|B<-s> I<filename> [B<--socket-user> I<uid>|I<username>]
26[B<--socket-group> I<gid>|I<groupname>] [B<--socket-perms> I<octal-perms>]
27[B<--set-user>|B<-u> I<uid>|I<username>] [B<--set-group>|B<-g> I<gid>|I<groupname>]
28[I<OPTIONS>]
29
30B<spfd> B<--version|-V>
31
32B<spfd> B<--help>
33
34=head1 DESCRIPTION
35
36B<spfd> is a simple forking Sender Policy Framework (SPF) query server.  spfd
37receives and answers SPF requests on a TCP/IP or UNIX domain socket.  For more
38information on SPF see L<http://www.openspf.org>.
39
40The B<--port> form listens on a TCP/IP socket on the specified I<port>.  The
41default port is B<5970>.
42
43The B<--socket> form listens on a UNIX domain socket that is created with the
44specified I<filename>.  The socket can be assigned specific user and group
45ownership with the B<--socket-user> and B<--socket-group> options, and specific
46filesystem permissions with the B<--socket-perms> option.
47
48Generally, spfd can be instructed with the B<--set-user> and B<--set-group>
49options to drop root privileges and change to another user and group before it
50starts listening for requests.
51
52The B<--version> form prints version information of spfd.  The B<--help> form
53prints usage information for spfd.
54
55=head1 OPTIONS
56
57spfd takes any of the following I<OPTIONS>:
58
59=over
60
61=item B<--default-explanation> I<string>
62
63=item B<--def-exp> I<string>
64
65Use the specified I<string> as the default explanation if the authority domain
66does not specify an explanation string of its own.
67
68=item B<--hostname> I<hostname>
69
70Use I<hostname> as the host name of the local system instead of auto-detecting
71it.
72
73=item B<--debug>
74
75Print out debug information about spfd's operation, incoming requests, and the
76responses sent.
77
78=back
79
80=head1 REQUEST
81
82A request consists of a series of lines delimited by \x0A (LF) characters (or
83whatever your system considers a newline).  Each line must be of the form
84I<option>B<=>I<value>, where the following options are supported:
85
86=over
87
88=item B<versions>
89
90A comma-separated list of SPF version numbers of SPF records that may be used.
91B<1> means that C<v=spf1> records should be used.  B<2> means that C<spf2.0>
92records should be used.  Defaults to B<1,2>, i.e., uses any SPF records that
93are available.  Records of a higher version are preferred.
94
95=item B<scope>
96
97The authorization scope of the identity that should be checked.  Defaults to
98B<'mfrom'>.  The following scope values are supported: B<'helo'>, B<'mfrom'>,
99B<'pra'>.  See L<Mail::SPF::Request/new> for more information.
100
101=item B<identity>
102
103I<Required>.  The sender identity whose authorization should be checked.  This
104is a domain name for the C<helo> scope, and an e-mail address for the C<mfrom>
105and C<pra> scopes.
106
107=item B<ip_address>
108
109I<Required> for checks with the C<helo>, C<mfrom>, and C<pra> scopes.  The IP
110address of the host claiming the identity that is being checked.  Can be either
111an IPv4 or an IPv6 address.  An IPv4-mapped IPv6 address (e.g.
112'::ffff:192.168.0.1') is treated as an IPv4 address.
113
114=item B<helo_identity>
115
116The C<HELO> SMTP transaction parameter in the case that the main identity is of
117a scope other than C<helo>.  This identity is then used merely for the
118expansion of C<%{h}> macros during the policy evaluation of the main identity.
119If unspecified with a scope other than C<helo>, defaults to B<"unknown">.
120If the main identity is of the C<helo> scope, this option is unused.
121
122=back
123
124=head1 RESPONSE
125
126spfd responds to SPF requests with similar series of lines of the form
127I<key>B<=>I<value>.  The most important response keys are:
128
129=over
130
131=item B<result>
132
133The result code of the SPF check:
134
135=over 12
136
137=item B<pass>
138
139The specified IP address is an authorized SMTP sender for the identity.
140
141=item B<fail>
142
143The specified IP address is not an authorized SMTP sender for the identity.
144
145=item B<softfail>
146
147The specified IP address is not an authorized SMTP sender for the identity,
148however the authority domain is still testing out its SPF policy.
149
150=item B<neutral>
151
152The identity's authority domain makes no assertion about the status of the IP
153address.
154
155=item B<permerror>
156
157A permanent error occurred while evaluating the authority domain's policy
158(e.g., a syntax error in the SPF record).  Manual intervention is required
159from the authority domain.
160
161=item B<temperror>
162
163A temporary error occurred while evaluating the authority domain's policy
164(e.g., a DNS error).  Try again later.
165
166=item B<none>
167
168There is no applicable SPF policy for the identity domain.
169
170=back
171
172=item B<local_explanation>
173
174A locally generated explanation of the SPF result.
175
176=item B<authority_explanation>
177
178The authority domain's explanation for the SPF result.  Be aware that the
179authority domain may be a malicious party and thus the authority explanation
180should not be trusted blindly.  See RFC 4408, 10.5, for a detailed discussion
181of this issue.
182
183=item B<received_spf_header>
184
185An appropriate C<Received-SPF> header field for the SPF result.
186
187=item B<spf_record>
188
189The authority domain's SPF record that was used for the policy evaluation.
190
191=back
192
193=head1 EXAMPLE
194
195A running spfd could be tested using the C<netcat> utility like this (line
196breaks added for clarity):
197
198    $ echo -e "identity=user@example.com\nip_address=1.2.3.4\n" \
199        | nc localhost 5970
200    result=fail
201    local_explanation=example.com: Sender is not authorized by default to use
202        'user@example.com' in 'mfrom' identity (mechanism '-all' matched)
203    authority_explanation=Please see http://www.openspf.org/why.html?
204        sender=user%40example.com&ip=1.2.3.4&receiver=localhost
205    received_spf_header=Received-SPF: fail (example.com: Sender is not
206        authorized by default to use 'user@example.com' in 'mfrom' identity
207        (mechanism '-all' matched)) receiver=localhost; identity=mfrom;
208        envelope-from="user@example.com"; client-ip=1.2.3.4
209    spf_record=v=spf1 mx -all
210
211=head1 COMPATIBILITY
212
213B<spfd> has undergone the following interface changes compared to earlier
214versions:
215
216=over
217
218=item B<2.000>
219
220=over
221
222=item *
223
224A new preferred I<request> style has been introduced.  Instead of the old
225C<sender> request option, which is specific to the C<MAIL FROM> SMTP identity,
226a generic C<identity> option should now be specified.  In addition, a C<scope>
227option may be given to specify the identity's scope, otherwise a scope of
228C<mfrom> is assumed.  The old C<ip> and C<helo> options have been replaced by
229the C<ip_address> and C<helo_identity> options, respectively.
230
231This is how legacy requests with the C<mfrom> scope would translate to the new
232preferred request style:
233
234  Legacy request style       | New request style
235 ----------------------------+---------------------------------------
236                             | scope=mfrom
237  sender=<mfrom-identity>    | identity=<mfrom-identity>
238  ip=<ip-address>            | ip_address=<ip-address>
239  helo=<helo-identity>       | helo_identity=<helo-identity>
240
241A new I<response> style featuring new response values has also been introduced:
242
243  Legacy response style      | New response style
244 ----------------------------+---------------------------------------
245  result=<result-code>       | result=<result-code>
246  header_comment=<local-exp> | local_explanation=<local-exp>
247  smtp_comment=<local-exp    | authority_explanation=<authority-exp>
248    or authority-exp>        |
249  spf_record=<spf-record>    | spf_record=<spf-record>
250                             | received_spf_header=<header>
251
252The legacy request style is deprecated but still supported for backwards
253compatibility.  The legacy response values are still returned for backwards
254compatibility in addition to the new response values, but may be removed in the
255future.  Adjust your code to use the new request and response styles.
256
257=item *
258
259The former C<unknown> and C<error> result codes have been renamed to C<permerror>
260and C<temperror>, respectively, in order to comply with RFC 4408 terminology.
261
262=item *
263
264SPF checks with an empty identity are no longer supported.  In the case of an
265empty C<MAIL FROM> SMTP transaction parameter, perform a check with the C<helo>
266scope directly.
267
268=back
269
270=back
271
272=head1 SEE ALSO
273
274L<Mail::SPF>, L<spfquery(1)>
275
276L<http://tools.ietf.org/html/rfc4408>
277
278=head1 AUTHORS
279
280This version of B<spfd> is a complete rewrite by Julian Mehnle <julian@mehnle.net>,
281based on an earlier version written by Meng Weng Wong <mengwong+spf@pobox.com>.
282
283=cut
284
285our $VERSION = '2.000';
286
287use warnings;
288use strict;
289
290use Error ':try';
291use IO::Handle;
292use Getopt::Long qw(:config gnu_compat);
293use Socket;
294use Mail::SPF;
295
296use constant TRUE   => (0 == 0);
297use constant FALSE  => not TRUE;
298
299use constant default_port   => 5970;
300
301use constant deprecated_request_keys => {
302    sender      => 'identity',
303    ip          => 'ip_address',
304    helo        => 'helo_identity'
305};
306
307# Helper Functions
308##############################################################################
309
310sub usage {
311    STDERR->print(<<'EOT');
312Usage:
313    spfd --port|-p <port>
314        [--set-user|-u <uid>|<username>] [--set-group|-g <gid>|<groupname>]
315    spfd --socket|-s <filename> [--socket-user <uid>|<username>]
316        [--socket-group <gid>|<groupname>] [--socket-perms <octal-perms>]
317        [--set-user|-u <uid>|<username>] [--set-group|-g <gid>|<groupname>]
318EOT
319    return;
320}
321
322sub deprecated_option {
323    my ($old_option, $new_option, $options) = @_;
324    return FALSE if not exists($options->{$old_option});
325    STDERR->print(
326        "Warning: '$old_option' option is deprecated" .
327        ($new_option ? "; use '$new_option' instead" : '') .
328        ".\n"
329    );
330    $options->{$new_option} = delete($options->{$old_option});
331    return TRUE;
332}
333
334# Command-line Option Handling
335##############################################################################
336
337my $options = {};
338my $getopt_result = GetOptions(
339    $options,
340
341    'port|p=i',
342    'socket|s=s',
343    'socket-user=s',
344    'socket-group=s',
345    'socket-perms=s',
346    'set-user|u=s',
347    'set-group=s',
348
349    'default-explanation|def-exp=s',
350    'hostname=s',
351
352    'debug!',
353
354    # Black Magic options:
355    'enable-black-magic!',
356
357    # Meta actions:
358    'version|V!',
359    'help!',
360
361    # Deprecated options:
362    'path=s',       # Now 'socket'
363    'pathuser=s',   # Now 'socket-user'
364    'pathgroup=s',  # Now 'socket-group'
365    'pathmode=s',   # Now 'socket-perms'
366    'setuser=s',    # Now 'set-user'
367    'setgroup=s'    # Now 'set-group'
368);
369
370if (not $getopt_result) {
371    usage();
372    exit(255);
373}
374
375if ($options->{help}) {
376    usage();
377    exit(0);
378}
379
380if ($options->{version}) {
381    print("spfd version $VERSION (using Mail::SPF)\n");
382    exit(0);
383}
384
385my $enable_black_magic = $options->{'enable-black-magic'};
386
387if (
388    $enable_black_magic and
389    not defined(eval('require Mail::SPF::BlackMagic'))
390) {
391    STDERR->print("Error: Cannot enable black magic. Unable to load Mail::SPF::BlackMagic.\n");
392    exit(255);
393}
394elsif ($enable_black_magic) {
395    STDERR->print("Black magic enabled.\n");
396}
397
398deprecated_option('path',       'socket',       $options);
399deprecated_option('pathuser',   'socket-user',  $options);
400deprecated_option('pathgroup',  'socket-group', $options);
401deprecated_option('pathmode',   'socket-perms', $options);
402deprecated_option('setuser',    'set-user',     $options);
403deprecated_option('setgroup',   'set-group',    $options);
404
405my $port                = $options->{port};
406my $socket_path         = $options->{socket};
407my $socket_user         = $options->{'socket-user'};
408my $socket_group        = $options->{'socket-group'};
409my $socket_perms        = $options->{'socket-perms'};
410my $set_user            = $options->{'set-user'};
411my $set_group           = $options->{'set-group'};
412
413my $default_explanation = $options->{'default-explanation'};
414my $hostname            = $options->{hostname};
415
416my $debug               = defined($options->{debug}) ? $options->{debug} : $ENV{DEBUG};
417
418if (defined($port) and defined($socket_path)) {
419    usage();
420    exit(255);
421}
422
423if (not defined($port) and not defined($socket_path)) {
424    $port = default_port;
425    STDERR->print("Using default TCP/IP port ($port).  Run `spfd --help` for supported options.\n");
426}
427
428# Main Program
429##############################################################################
430
431STDOUT->autoflush(TRUE);
432
433my $listen_socket;
434
435if (defined($port)) {
436    require IO::Socket::INET;
437    $listen_socket = IO::Socket::INET->new(
438        Listen      => TRUE,
439        LocalAddr   => '127.0.0.1',
440        LocalPort   => $port,
441        ReuseAddr   => TRUE
442    );
443    print("spfd (PID $$): Listening on TCP/IP port $port.\n");
444    #$0 = "spfd listening on TCP port $port";
445}
446elsif (defined($socket_path)) {
447    require IO::Socket::UNIX;
448    unlink $socket_path
449        if -S $socket_path;
450    $listen_socket = IO::Socket::UNIX->new(
451        Listen      => TRUE,
452        Local       => $socket_path
453    );
454    print("spfd (PID $$): Listening on UNIX socket '$socket_path'.\n");
455    #$0 = "spfd listening on UNIX socket $socket_path";
456
457    $socket_user  = normalize_uid($socket_user);
458    $socket_group = normalize_gid($socket_group);
459    chown($socket_user, $socket_group, $socket_path)
460        or die("Unable to chown($socket_user, $socket_group) socket '$socket_path'")
461        if $socket_user != -1 or $socket_path != -1;
462
463    chmod(oct($socket_perms), $socket_path)
464        or die("Unable to chmod($socket_perms) socket '$socket_path': $!")
465        if defined($socket_perms);
466}
467
468if (defined($set_group)) {
469    $set_group = normalize_gid($set_group);
470    $( = $) = $set_group;
471    $( == $set_group and $) == $set_group
472        or die("Unable to setgid($set_group): $!");
473}
474
475if (defined($set_user)) {
476    $set_user = normalize_uid($set_user);
477    $< = $> = $set_user;
478    $< == $set_user and $> == $set_user
479        or die("Unable to setuid($set_user): $!");
480}
481
482my $spf_server = Mail::SPF::Server->new(
483    default_authority_explanation
484                    => $default_explanation,
485    hostname        => $hostname,
486
487    # Black Magic:
488    # TODO
489    # max-dns-interactive-terms
490    # max-name-lookups-per-term
491    # more?
492);
493
494# Handle Client Connections
495##############################################################################
496
497while (my $socket = $listen_socket->accept()) {
498    if (fork) {
499        # Parent process.
500        close($socket);
501        wait;  # Reap our immediate child (the grand-child will run on its own).
502        next;
503    }
504    elsif (fork) {
505        # Child process, parent of grand-child process.
506        # The child exits immediately in order to avoid zombies:
507        exit;
508    }
509
510    # Grand-child process.
511
512    my $time = gmtime;
513    if ($debug) {
514        my $peerinfo =
515            $listen_socket->isa('IO::Socket::INET') ?
516                sprintf(" from %s [%s]", scalar(gethostbyaddr($socket->peeraddr, AF_INET)), $socket->peerhost)
517            :   '';
518        print("\n");
519        print("[$time] Incoming connection" . $peerinfo . "\n");
520    }
521
522    try {
523        $socket->autoflush(TRUE);
524
525        my $request_values = {};
526        while (<$socket>) {
527            s/\s+$//;
528            last if /^$/;
529            my ($key, $value) = split(/=/, $_, 2);
530            $key = lc($key);
531            $key = deprecated_request_keys->{$key}
532                if defined(deprecated_request_keys->{$key});
533            $request_values->{$key} = $value;
534
535            print("[$time] R: $key=$value\n")
536                if $debug;
537        }
538
539        my @versions = split(',', $request_values->{versions} || '');
540
541        my $request = Mail::SPF::Request->new(
542            versions        => @versions ? [@versions] : undef,
543            scope           => $request_values->{scope},
544            identity        => $request_values->{identity},
545            ip_address      => $request_values->{ip_address},
546            helo_identity   => $request_values->{helo_identity}
547        );
548
549        my $result = $spf_server->process($request);
550
551        my $response_values = {};
552        $response_values->{result}                  = $result->code;
553        $response_values->{local_explanation}       = $result->local_explanation;
554        $response_values->{authority_explanation}   = $result->authority_explanation
555            if $result->can('authority_explanation');
556        $response_values->{received_spf_header}     = $result->received_spf_header;
557        $response_values->{spf_record}              = $result->request->root_request->record
558            if defined($result->request->root_request->record);
559
560        # Legacy response values:
561        $response_values->{smtp_comment}            =
562            defined($response_values->{authority_explanation}) ?
563                $response_values->{authority_explanation}
564            :   $response_values->{local_explanation};
565        $response_values->{header_comment}          = $response_values->{local_explanation};
566
567        foreach my $key (qw(
568            result local_explanation authority_explanation received_spf_header spf_record
569            smtp_comment header_comment
570        )) {
571            defined($response_values->{$key}) or next;
572            $socket->print("$key=$response_values->{$key}\n");
573            print("[$time] W: $key=$response_values->{$key}\n")
574                if $debug;
575        }
576    }
577    catch Mail::SPF::Exception with {
578        my ($e) = @_;
579        printf("[$time] An error occurred: %s\n", $e->text);
580    };
581
582    $socket->close();
583
584    exit;
585}
586
587# Helper Functions
588##############################################################################
589
590sub normalize_uid {
591    my ($uid) = @_;
592    return -1 if not defined($uid);
593    return getpwnam($uid)
594        or die("Unknown user '$uid'")
595        if $uid =~ /\D/;
596    return $uid;
597}
598
599sub normalize_gid {
600    my ($gid) = @_;
601    return -1 if not defined($gid);
602    return getgrnam($gid)
603        or die("Unknown group '$gid'")
604        if $gid =~ /\D/;
605    return $gid;
606}
607