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