#!/usr/bin/perl -w
# Part of stubmail to manage outbound mail for sender and recipient
# anyone with right msgid can retrieve and remove messages
# only signed requests can list msgids
# starts udp server from cgi if not already running

# (c) 2006 Julian Haight,           http://www.julianhaight.com/
# All Rights Reserved under GPL:    http://www.gnu.org/licenses/gpl.txt

# Version history
# V1 4/14/2006

use strict; 
use CGI;
use Digest::MD5 qw(md5);
use File::Path qw(mkpath);
use Convert::Bencode;
use Socket;
use Stubmail;
use Sys::Hostname;
use POSIX;

# recipient, sender and filename parts of path as well full filename/path and
# CGI object
my($r, $s, $f, $fname, $cgi);
my($ROOT) = '/var/spool/stubmail';
my($SRV_PIDF) = $ROOT . '/daemon.pid';

post_manager();
exit 0;

sub post_manager {
    my($mode);

#    if ((defined($ARGV[0])) && ($ARGV[0] eq 'udpserve')) {
    udpServe();
#    } else {
    parsePath();
    $cgi = new CGI;
    $mode = $cgi->param('mode');
    $ENV{HOME}=$ROOT;
    
    if ($mode eq 'rm') {
	rm();
    } elsif ($mode eq 'put') {
	put();
    } elsif ($mode eq 'get') {
	get();
    } elsif ($mode eq 'signedrequest') {
	signedRequest();
    } else {
	die "unrecognized mode: $mode";
    }
#    }
}

sub signedRequest {
    my($request, $sig, $params, $mode, $time);
    $request = $cgi->param('request');
    $sig = $cgi->param('sig');
    $params = Convert::Bencode::bdecode($request);

    unless (Stubmail::checkSig($request, $sig, 
			       $params->{rkid}, $params->{recip})) {
	die "checkSig failed during signedRequest\n";
    }
    $time = $params->{time};
    unless (checkReqTime($time)) {
	die "checkReqTime failed during signedRequest\n";
    }
    $mode = $params->{mode};
#    print STDERR ("params: " . join(":", keys(%$params)) . "\n");
    Stubmail::cookie($params->{cookie}, 
		     $params->{skid} . ' ' . $params->{rkid});
    if ($mode eq 'getMessageIDs') {
	getMessageIDs();
    } else {
	die "Unknown mode in signedRequest";
    }
}

sub getMessageIDs {
    print "Content-type: text/plain\n\n";
    # if dir can't be opened, I guess we don't have any mail, no error
    print join("\n", getFiles($r, $s)) . "\n";
}

sub getFiles {
    my($dir, $file, @files, $s, $r);
    ($r, $s) = @_;
    $dir = "$ROOT/$r/$s";
    
    opendir (DIR, $dir) || return;
    while ($file = readdir(DIR)) {
	if (($file ne '.') && ($file ne '..')) {
	    push(@files, $file);
	}
    }
    closedir(DIR);
    return (@files);
}    

sub checkReqTime {
    my($time) = @_;
    $time = time() - $time;
    return (($time < 60) && ($time > -60));
}

sub udpServe {
    my($pid, $sock, $client, $msg, $s, $r);
    if (-e $SRV_PIDF) {
	open(PID, $SRV_PIDF);
	chop($pid = <PID>);
	close(PID);
#	print STDERR "is previous post_manager pid $pid still running?\n";
	if (kill(0, $pid)) { 
#	    print STDERR "$pid is already running.\n";
	    return; # another server already runs 
	}
    }
    if (my $i_am_grandparent = fork()) {
	print STDERR "apache forked child $i_am_grandparent; reaping immediately\n";
	wait;
	return;
    } else {
	if (my $i_am_parent = fork()) {
	    print STDERR "child $$ forked grandchild $i_am_parent\n";
	    exit;
	}
    }

    POSIX::setsid();

    $ENV{HOME}=$ROOT;
    
    print STDERR "Child $$ starting to listen on udp\n";
    close STDOUT; close STDIN; close STDERR;
    # make lock file
    open(PID, ">$SRV_PIDF");
    print PID "$$\n";
    close(PID);
    
    unless ($sock = new IO::Socket::INET (LocalPort => Stubmail::srvPort(),
					  Proto     => 'udp')) {
	die "Cannot create socket: $!";
    }

    # XXX mengwong 20060718 there are better ways to daemonize than this.

    while ($client = $sock->recv($msg, 4096)) {
	if (($s, $r) = split(/\s/, Stubmail::cookie($msg))) {
	    if (getFiles($r, $s)) {
		$sock->send($msg . ':1', 0, $client); # we have mail
	    } else {
		$sock->send($msg . ':0', 0, $client); # no mail
	    }
	} else {
	    $sock->send($msg . ':e', 0, $client); # lost the cookie
	}
    }
}

sub get {
    my($line);
    open(IN, $fname) || die ("Error during get $fname: $!");
    print "Content-type: application/pgp-encrypted\n\n";
    while($line = <IN>) {
	print $line;
    }
    close(IN);
}

sub put {
    my($data, $md5) = ($cgi->param('data'), $cgi->param('md5'));

    if ($md5 ne md5($data)) {
	die "Refusing to write $fname: MD5 does not agree";
    }
    mkpath(["$ROOT/$r/$s"]);
    unless ((open(OUT, ">$fname")) &&
	    (print OUT $data) &&
	    (close OUT)) {
	die "Cannot write to $fname: $!";
    }
    print "Content-type: text/plain\n\nok\n";
}

sub rm {
    unless (-e $fname) { die "Cannot remove $fname: does not exist"; }
    unless (-f $fname) { die "Cannot remove $fname: not a regular file"; }
    unless (unlink($fname)) { die "Cannot remove $fname: $!"; }
    print "Content-type: text/plain\n\nok\n";
}

sub parsePath {
    my($path) = $ENV{PATH_INFO};
    ($_, $r, $s, $f) = split(/\//, $path);
    foreach ($r, $s, $f) { s/[^a-zA-Z0-9]+//g; }
    $fname = "$ROOT/$r/$s/$f";
}