1#!/usr/bin/perl -I../lib
2#
3# Copyright (c) 2005-2006 Messiah College. This program is free software.
4# You can redistribute it and/or modify it under the terms of the
5# GNU Public License as found at http://www.fsf.org/copyleft/gpl.html.
6#
7# Written by Jason Long, jlong@messiah.edu.
8
9#
10#   This code is Copyright (C) 2001 Morgan Stanley Dean Witter, and
11#   is distributed according to the terms of the GNU Public License
12#   as found at <URL:http://www.fsf.org/copyleft/gpl.html>.
13#
14#
15#   This program is distributed in the hope that it will be useful,
16#   but WITHOUT ANY WARRANTY; without even the implied warranty of
17#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18#   GNU General Public License for more details.
19#
20# Written by Bennett Todd <bet@rahul.net>
21
22use strict;
23use warnings;
24
25use Getopt::Long;
26use Pod::Usage;
27use IO::File;
28use Sys::Syslog;
29
30use DKMessage;
31use MySmtpServer;
32
33use Sys::Hostname;
34my $hostname = hostname;
35
36my $reject_fail = 0;  # not actually used in this filter
37my $reject_error = 0;
38my $keyfile;
39my $selector;
40my $domain_arg;
41my $method = "simple";
42my $headers = 0;
43my $setuser;
44my $setgroup;
45my $daemonize;
46my $pidfile;
47my $debug;
48my $help;
49GetOptions(
50		"reject-fail" => \$reject_fail,
51		"reject-error" => \$reject_error,
52		"hostname=s" => \$hostname,
53		"keyfile=s" => \$keyfile,
54		"selector=s" => \$selector,
55		"domain=s" => \$domain_arg,
56		"method=s" => \$method,
57		"headers" => \$headers,
58		"user=s" => \$setuser,
59		"group=s" => \$setgroup,
60		"daemonize" => \$daemonize,
61		"pidfile=s" => \$pidfile,
62		"debug" => \$debug,
63		"help|?" => \$help)
64	or pod2usage(2);
65pod2usage(1) if $help;
66pod2usage("Error: one or more required arguments are missing")
67	unless @ARGV == 2;
68
69my ($srcaddr, $srcport) = split /:/, $ARGV[0];
70my ($dstaddr, $dstport) = split /:/, $ARGV[1];
71unless (defined($srcport) and defined($dstport))
72{
73	pod2usage("Error: source or destination port is missing");
74}
75
76unless (defined $keyfile)
77{
78	pod2usage("Error: no keyfile specified");
79}
80unless (-r $keyfile)
81{
82	pod2usage("Error: cannot read keyfile $keyfile");
83}
84unless (defined $selector)
85{
86	pod2usage("Error: selector not specified");
87}
88unless (defined $domain_arg)
89{
90	pod2usage("Error: domain not specified");
91}
92my @domains = split(/,\s*/, $domain_arg);
93unless (@domains)
94{
95	pod2usage("Error: domain not specified");
96}
97unless ($method eq "simple" || $method eq "nofws")
98{
99	die "Error: invalid method; must be simple or nofws\n";
100}
101
102use base "MySmtpProxyServer";
103main->run(
104		host => $srcaddr,
105		port => $srcport,
106		server_type => "PreFork",
107		user => $setuser,
108		group => $setgroup,
109		setsid => $daemonize,
110		pid_file => $pidfile,
111	);
112
113sub setup_client_socket
114{
115	# create an object for sending the outgoing SMTP commands
116	#  (and the signed message)
117    my $client = MSDW::SMTP::Client->new(
118			interface => $dstaddr,
119			port => $dstport);
120	return $client;
121}
122
123sub process_request
124{
125	my $self = shift;
126
127	# initialize syslog
128	openlog("dkfilter.out", "cons,pid", "mail");
129
130	$self->{debug} = $debug;
131	$self->SUPER::process_request;
132}
133
134# handle_end_of_data
135#
136# Called when the source finishes transmitting the message. This method
137# may filter the message and if desired, transmit the message to
138# $client. Alternatively, this method can respond to the server with
139# some sort of rejection (temporary or permanent).
140#
141# Usage: $result = handle_end_of_data($server, $client);
142#
143# Returns:
144#   nonzero if a message was transmitted to the next server and its response
145#     returned to the source server
146#   zero if the message was rejected and the connection to the next server
147#     should be dropped
148#
149sub handle_end_of_data
150{
151	my $self = shift;
152	my $server = $self->{smtp_server};
153	my $client = $self->{smtp_client};
154
155	my $fh = $server->{data};
156	my $mess;
157	my $result;
158	my $result_detail;
159	eval
160	{
161		$mess = DKMessage->new_from_handle($fh);
162
163		# determine what domain to use
164		my $domain;
165		if ($domain = lc $mess->senderdomain)
166		{
167			while ($domain)
168			{
169				if (grep { lc($_) eq $domain } @domains)
170				{
171					last;
172				}
173				# try the parent domain
174				(undef, $domain) = split(/\./, $domain, 2);
175			}
176		}
177		unless ($domain)
178		{
179			# message has no senderdomain
180			$domain = $domains[0];
181		}
182
183		$result = $mess->sign(
184			Method => $method,
185			Selector => $selector,
186			Domain => $domain,
187			KeyFile => $keyfile,
188			Headers => $headers
189			);
190		$result_detail = $mess->result_detail;
191
192		syslog("info", '%s',
193			"DomainKeys signing - $result_detail; "
194			. join(", ", $mess->info));
195	};
196	if ($@)
197	{
198		my $E = $@;
199		chomp $E;
200		syslog("warning", '%s', "signing error: $E");
201		$result = "temperror";
202		$result_detail = "$result ($E)";
203	}
204
205	# check signing result
206	if ($result =~ /error$/ && $reject_error)
207	{
208		# temporary or permanent error
209		$server->fail(
210			($result eq "permerror" ? "550" : "450")
211			. " DomainKeys - $result_detail");
212		return 0;
213	}
214
215	$fh->seek(0,0);
216
217	if ($mess)
218	{
219		# send the message as modified by the verification process
220		while (my $line = $mess->readline)
221		{
222			$client->write_data_line($line);
223			#DEBUGGING:
224			#$line =~ s/[\015\012]+$//;
225			#print "--> $line\n";
226		}
227		$client->{sock}->print(".\015\012")
228			or die "write error: $!";
229	}
230	else
231	{
232		# send the message unaltered
233		$client->yammer($fh);
234	}
235	return 1;
236}
237
238__END__
239
240=head1 NAME
241
242  dkfilter.out -- SMTP proxy for adding Yahoo! DomainKeys signatures
243
244=head1 SYNOPSIS
245
246  dkfilter.out [options] listen.addr:port talk.addr:port
247    options:
248      --reject-error
249      --keyfile=filename
250      --selector=SELECTOR
251      --domain=DOMAIN
252      --method=simple|nofws
253      --headers
254      --user=USER
255      --group=GROUP
256      --daemonize
257      --pidfile=PIDFILE
258
259  dkfilter.out --help
260    to see a full description of the various options
261
262=head1 OPTIONS
263
264=over
265
266=item B<--reject-error>
267
268This option specifies what to do if an error occurs during signing
269of a message. If this option is specified, the message will be rejected
270with an SMTP error code. This will result in the MTA sending the message
271to try again later, or bounce it back to the sender (depending on the
272exact error code used). If this option is not specified, the message
273will be passed through without modification, and the error will be logged.
274
275The most common error is a message parse error.
276
277=item B<--keyfile=FILENAME>
278
279This is a required argument. Use it to specify the filename containing
280the private key used in signing outgoing messages.
281
282=item B<--selector=SELECTOR>
283
284This is a required argument. Use it to specify the name of the key
285selector.
286
287=item B<--domain=DOMAIN>
288
289This is a required argument. Use it to specify what domain(s) emails
290are signed for. If you want to sign for multiple domains, specify the
291domains separated by commas. As messages are delivered through the filter,
292the filter will attempt to match the message to one of the domains
293specified in this argument. If it sees a match, it will sign the message
294using the matching domain.
295
296=item B<--method=simple|nofws>
297
298This option specifies the canonicalization algorithm to use for signing
299messages. Specify either C<simple> or C<nofws>. If not specified,
300the default is C<simple>.
301
302=item B<--headers>
303
304Specifying this will create signatures with an h tag, which lists all
305the header names found in the signed message.
306
307=item B<--user=USER>
308
309Userid or username to become after the bind process has occured.
310
311=item B<--group=GROUP>
312
313Groupid or groupname to become after the bind process has occured.
314
315=item B<--daemonize>
316
317Specifies whether the server should fork to release itself from the
318command line and daemonize.
319
320=item B<--pidfile=PIDFILE>
321
322Filename to store pid of server process. No pid file is generated by
323default.
324
325=back
326
327=head1 DESCRIPTION
328
329dkfilter.out listens on the addr and port specified by its first arg,
330and sends the traffic mostly unmodified to the SMTP server whose addr and
331port are listed as its second arg. The SMTP protocol is propogated
332literally, but message bodies are conditionally signed with the specified
333private key by prepending a DomainKey-Signature header to the message
334content.
335
336=head1 EXAMPLE
337
338  dkfilter.out --keyfile=private.key --selector=sydney \
339          --domain=example.org 127.0.0.1:10027 127.0.0.1:10028
340
341=cut
342