#!/usr/bin/perl -w # # umtp: # The Unreliable Mail Transfer Protocol. # # Small email messages may reasonably be compressed and transmitted in UDP # packets, short-circuiting long SMTP transaction delays. Obviously such a # protocol is unreliable, and must be shadowed by real delivery over SMTP, # with duplicates discarded at a higher protocol level. # # Usage: # umtp send host port recipient # Send a message supplied on standard input to the named recipient, # transmitting it to the given host:port. If the message is too large # (greater than 8k compressed) or if there is an error, returns failure. # # umtp receive host port # Receive email on the given host and port, and pass it to the local MTA. # # To prevent the possibility of unauthorised relaying, umtp employs a # shared-secret authentication mechanism. For transmission or reception, umtp # reads the secret from ~/.umtp/secret, which should not be readable or # writable by others. The shared secret is used to authenticate packets as # described below. # # umtp writes its PID in ~/.umtp/pid and logs messages in ~/.umtp/log. # # Packet structure: # # length element # ---------- ------------------------------------------------------------- # 2 length of whole packet, in network order # varies 0-terminated email address of recipient # varies gzip'd data for content of email # 16 MD5 checksum of secret followed by the content of the packet, # excluding the checksum # # Copyright (c) 2002 Chris Lightfoot. All rights reserved. # Email: chris@ex-parrot.com; WWW: http://www.ex-parrot.com/~chris/ # my $rcsid = '$Id: umtp,v 1.18 2002/07/23 13:05:15 chris Exp $'; $maxpktlen = 1472; # Fragmented UDP Packets Don't Work. $maxsecret = 8192; $sendmail = `which sendmail`; chomp $sendmail; $mode = ''; use FileHandle; use POSIX; use IO::File; use IO::Pipe; use IO::Socket; use Compress::Zlib; use Digest::MD5; use Fcntl ':flock'; @foo = uname; $pidfile = "$ENV{HOME}/.umtp/pid.$foo[1]"; $log = undef; # log_start: # Switch on logging. sub log_start () { $log = new IO::File("$ENV{HOME}/.umtp/log", O_WRONLY | O_CREAT | O_APPEND) or die "~/.umtp/log: $!"; $log->autoflush(1); } # log_print: # Print something to the log. sub log_print (@) { $log->print(scalar(localtime), " umtp $mode" ."[$$]: ", @_, "\n"); } # Get die to emit a normal Unixish error message. $SIG{__DIE__} = sub { my $a = shift; $a =~ s/ at .* line \d.*//; chomp $a; if ($log) { log_print("$a; aborting"); } else { print STDERR "umtp: $a\n"; } unlink $pidfile if ($mode eq 'receive'); exit(1); }; die "not enough arguments" unless (@ARGV); die "no ~/.umtp directory" unless (-d "$ENV{HOME}/.umtp"); $mode = shift(@ARGV); # obtain secret $g = new IO::File("$ENV{HOME}/.umtp/secret", O_RDONLY) or die "~/.umtp/secret: $!"; $secret = ''; $g->read($secret, $maxsecret); $g->close(); # my_open2 READ WRITE COMMAND # Fork and run COMMAND, returning its PID and making READ and WRITE into # IO objects for reading its standard output and writing its standard input # respectively. sub my_open2 ($$@) { my ($rd, $wr, $cmd) = @_; my $p1 = new IO::Pipe; my $p2 = new IO::Pipe; my $pid = fork(); if ($pid == 0) { # child. close(STDIN); close(STDOUT); $p1->writer; $p2->reader; POSIX::dup2($p1->fileno, 1); POSIX::dup2($p2->fileno, 0); exec("/bin/sh", "-c", $cmd); } elsif ($pid > 0) { # parent. $p1->reader; $_[0] = $p1; $p2->writer; $_[1] = $p2; return $pid; } else { return undef; } } # daemonise # Become a daemon process. From perlipc(3). sub daemonise { chdir '/' or die "chdir(/): $!"; open STDIN, '/dev/null' or die "/dev/null: $!"; open STDOUT, '>/dev/null' or die "/dev/null: $!"; defined(my $pid = fork) or die "fork: $!"; exit if $pid; setsid or die "Can't start a new session: $!"; open STDERR, '>/dev/null' or die "/dev/null: $!"; } # make_packet RECIPIENT DATA # Generate a packet to transmit, for sending to RECIPIENT. DATA is the # uncompressed form of the email. sub make_packet ($$) { my ($recip, $data) = @_; # Go through the email, ditching Received: lines. my (@lines) = split("\n", $data); my $cdata; my ($rflag, $bflag) = (0, 0); foreach (@lines) { if (/^Received:/i) { $rflag = 1; } elsif (/^[^\s]/) { $rflag = 0; } $bflag = 1 if (/^$/); # end of headers $cdata .= "$_\n" if ($bflag || !$rflag); } $cdata = Compress::Zlib::memGzip($cdata); my $pkt = ''; $pkt = pack('n', length($recip) + 1 + length($cdata) + 16); $pkt .= "$recip\0$cdata"; my $dig = Digest::MD5::md5($secret . $pkt); $pkt .= $dig; return $pkt; } # parse_packet PACKET # Break PACKET into its constituents, check its length and checksum, and if # they are OK, return the recipient and email data in list context. sub parse_packet ($) { my ($pkt) = @_; my $len = unpack('n', substr($pkt, 0, 2)); if ($len != length($pkt) - 2) { log_print("length in packet does not match"); return (); } # check digest my $dig = Digest::MD5::md5($secret . substr($pkt, 0, length($pkt) - 16)); if ($dig ne substr($pkt, length($pkt) - 16, 16)) { log_print("digest in packet does not match"); return (); } my ($recip) = (substr($pkt, 2) =~ /([^\0]+)/); my $cdata = substr($pkt, 2 + length($recip) + 1, length($pkt) - 2 - 1 - length($recip) - 16); my $data = "X-Via: umtp\n" . Compress::Zlib::memGunzip($cdata); return ($recip, $data); } if ($mode eq 'receive') { die "call as umtp receive host port" if (@ARGV != 2); ($host, $port) = @ARGV; daemonise; log_start; $f = new IO::File($pidfile, O_RDWR | O_CREAT) or die "$pidfile: $!"; if (!flock($f, LOCK_EX | LOCK_NB)) { $pid = $f->getline; chomp($pid); die "~/.umtp/pid: could not lock; probably umtp is already running with PID $pid"; } $f->autoflush(1); $f->seek(0, SEEK_SET); $f->truncate(0); $f->print("$$\n"); $s = new IO::Socket::INET(LocalAddr => "$host:$port", Proto => "udp") or die "$host:$port: $!"; do { $pkt = ''; $s->recv($pkt, $maxpktlen, 0); @foo = parse_packet($pkt); if (@foo) { log_print("received packet length " . length($pkt) . " deliver to $foo[0]; email length " . length($foo[1])); # Actually deliver the message. my_open2($rd, $wr, "$sendmail -i $foo[0]") or die "sendmail: $!"; $rd->close(); $wr->print($foo[1]); $wr->close(); wait; } else { log_print("received bogus packet length " . length($pkt)); } } while (1); $f->close; } elsif ($mode eq 'send') { die "call as umtp send host port recipient" if (@ARGV != 3); ($host, $port, $recip) = @ARGV; log_start; @lines = ; # Possibly discard BSD mail folder separator. shift @lines if ($lines[0] =~ /^From /); $data = join('', @lines); log_print("email length " . length($data) . " to send to $recip via $host:$port"); $pkt = make_packet($recip, $data); if (length($pkt) > $maxpktlen) { log_print("packet length " . length($pkt) . " is too long"); exit 1; } else { log_print("packet length is " . length($pkt)); $s = new IO::Socket::INET(PeerAddr => "$host:$port", Proto => "udp") or die "$host:$port: $!"; $s->print($pkt) or die "send: $!"; $s->close(); exit 0; } } else { die "unknown mode $mode"; }