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
8#   This code is Copyright (C) 2001 Morgan Stanley Dean Witter, and
9#   is distributed according to the terms of the GNU Public License
10#   as found at <URL:http://www.fsf.org/copyleft/gpl.html>.
11#
12#
13#   This program is distributed in the hope that it will be useful,
14#   but WITHOUT ANY WARRANTY; without even the implied warranty of
15#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16#   GNU General Public License for more details.
17#
18# Written by Bennett Todd <bet@rahul.net>
19
20use strict;
21use warnings;
22
23use Getopt::Long;
24use Pod::Usage;
25use IO::File;
26use Sys::Syslog;
27
28use DKMessage;
29use MySmtpServer;
30
31my $hostname;
32my $reject_fail = 0;
33my $reject_error = 0;
34my $setuser;
35my $setgroup;
36my $daemonize;
37my $pidfile;
38my $debug;
39my $help;
40GetOptions(
41		"reject-fail" => \$reject_fail,
42		"reject-error" => \$reject_error,
43		"hostname=s" => \$hostname,
44		"user=s" => \$setuser,
45		"group=s" => \$setgroup,
46		"daemonize" => \$daemonize,
47		"pidfile=s" => \$pidfile,
48		"debug" => \$debug,
49		"help|?" => \$help)
50	or pod2usage(2);
51pod2usage(1) if $help;
52pod2usage("Error: one or more required arguments are missing")
53	unless @ARGV == 2;
54
55my ($srcaddr, $srcport) = split /:/, $ARGV[0];
56my ($dstaddr, $dstport) = split /:/, $ARGV[1];
57unless (defined($srcport) and defined($dstport))
58{
59	pod2usage("Error: source or destination port is missing");
60}
61
62if (defined $hostname)
63{
64	DKMessage::use_hostname($hostname);
65}
66
67use base "MySmtpProxyServer";
68main->run(
69		host => $srcaddr,
70		port => $srcport,
71		server_type => "PreFork",
72		user => $setuser,
73		group => $setgroup,
74		setsid => $daemonize,
75		pid_file => $pidfile,
76	);
77
78sub setup_client_socket
79{
80	# create an object for sending the outgoing SMTP commands
81	#  (and the signed message)
82    my $client = MSDW::SMTP::Client->new(
83			interface => $dstaddr,
84			port => $dstport);
85	return $client;
86}
87
88sub process_request
89{
90	my $self = shift;
91
92	# initialize syslog
93	openlog("dkfilter.in", "cons,pid", "mail");
94	$self->{debug} = $debug;
95
96	$self->SUPER::process_request;
97}
98
99# handle_end_of_data
100#
101# Called when the source finishes transmitting the message. This method
102# may filter the message and if desired, transmit the message to
103# $client. Alternatively, this method can respond to the server with
104# some sort of rejection (temporary or permanent).
105#
106# Usage: $result = handle_end_of_data($server, $client);
107#
108# Returns:
109#   nonzero if a message was transmitted to the next server and its response
110#     returned to the source server
111#   zero if the message was rejected and the connection to the next server
112#     should be dropped
113#
114sub handle_end_of_data
115{
116	my $self = shift;
117	my $server = $self->{smtp_server};
118	my $client = $self->{smtp_client};
119
120	my $fh = $server->{data};
121	my $mess;
122	my $result;
123	my $result_detail;
124	eval
125	{
126		$mess = DKMessage->new_from_handle($fh);
127		$result = $mess->verify;
128		$result_detail = $mess->result_detail;
129
130		syslog("info", '%s',
131			"DomainKeys verification - $result_detail; "
132			. join(", ", $mess->info));
133	};
134	if ($@)
135	{
136		my $E = $@;
137		chomp $E;
138		syslog("warning", '%s', "verification error: $E");
139		$result = "temperror";
140		$result_detail = "$result ($E)";
141	}
142
143	# check validation result
144	if ($result eq "fail" && $reject_fail)
145	{
146		# failed
147		$server->fail("550 5.7.1 DomainKeys - $result_detail");
148		return 0;
149	}
150	elsif ($result =~ /error$/ && $reject_error)
151	{
152		# temporary or permanent error
153		$server->fail(
154			($result eq "permerror" ? "550" : "450")
155			. " DomainKeys - $result_detail");
156		return 0;
157	}
158
159	$fh->seek(0,0);
160
161	if ($mess)
162	{
163		# send the message as modified by the verification process
164		while (my $line = $mess->readline)
165		{
166			$client->write_data_line($line);
167			#DEBUGGING:
168			#$line =~ s/[\015\012]+$//;
169			#print "--> $line\n";
170		}
171		$client->{sock}->print(".\015\012")
172			or die "write error: $!";
173	}
174	else
175	{
176		# send the message unaltered
177		$client->yammer($fh);
178	}
179	return 1;
180
181}
182
183__END__
184
185=head1 NAME
186
187  dkfilter.in -- SMTP proxy for verifying Yahoo! DomainKeys signatures
188
189=head1 SYNOPSIS
190
191  dkfilter.in [options] listen.addr:port talk.addr:port
192    options:
193      --reject-fail
194      --reject-error
195      --hostname=HOSTNAME
196      --user=USER
197      --group=GROUP
198      --daemonize
199      --pidfile=PIDFILE
200
201  dkfilter.in --help
202    to see a full description of the various options
203
204=head1 OPTIONS
205
206=over
207
208=item B<--reject-fail>
209
210This option specifies what to do if verification fails and the sender
211signing policy says to reject the message. If this option is specified,
212the message will be rejected with an SMTP error code.
213This will result in the sending MTA to
214bounce the message back to the sender. If this option is not specified,
215the message will pass through as normal.
216
217=item B<--reject-error>
218
219This option specifies what to do if an error occurs during verification
220of a message. If this option is specified, the message will be rejected
221with an SMTP error code. This will result in the MTA sending the message
222to try again later, or bounce it back to the sender (depending on the
223exact error code used). If this option is not specified, the message
224will be passed through with an error listed in the Authentication-Results
225header instead of the verification results.
226
227The most common error will probably be a DNS error when trying to retrieve
228the public key or sender policy.
229
230=item B<--hostname=HOSTNAME>
231
232Overrides the hostname used in the Authentication-Results header.
233Use this if the hostname that appears is not fully qualified or you
234want to use an alternate name.
235
236=item B<--user=USER>
237
238Userid or username to become after the bind process has occured.
239
240=item B<--group=GROUP>
241
242Groupid or groupname to become after the bind process has occured.
243
244=item B<--daemonize>
245
246Specifies whether the server should fork to release itself from the
247command line and daemonize.
248
249=item B<--pidfile=PIDFILE>
250
251Filename to store pid of server process. No pid file is generated by
252default.
253
254=back
255
256=head1 DESCRIPTION
257
258dkfilter.in listens on the addr and port specified by its first arg,
259and sends the traffic mostly unmodified to the SMTP server whose addr and
260port are listed as its second arg. The SMTP protocol is propogated
261literally, but message bodies are analyzed for a DomainKeys signature
262and authentication results are inserted into the message by prepending
263a Authentication-Results header.
264
265=head1 EXAMPLE
266
267  dkfilter.in --hostname=mx1.example.org 127.0.0.1:10025 127.0.0.1:10026
268
269=cut
270