#!/usr/bin/perl

use strict;
use CGI qw/:standard/;
use CGI::Carp;
use HTML::Entities;

# mengwong 20060420: todo: maybe use Params::Validate

# mengwong 20060603: move this configuration shite to the Stubmail::Config module.
my ($STUB_CONFIG_DIR) = grep { length $_ && -d $_ } ($ENV{STUB_CONFIG_DIR},
						     "/etc/stubmail/",
						     "/usr/local/etc/stubmail",
						     "/usr/local/stubmail/etc",
						     "/home/stubmail/etc",
						     "/Users/stubmail/etc",
						     "$ENV{HOME}/.stubmail");

my $FILEROOT = `cat $STUB_CONFIG_DIR/fileroot`;

if (not -d $FILEROOT) { croak "sorry, unable to locate fileroot in config dir $STUB_CONFIG_DIR\n" }

my $path_info = $ENV{PATH_INFO};

my @path_parts = split /\//, $path_info;

if (not @path_parts) {
    print_homepage(); exit;
}

# defeat path escalation -- what if the bad guys enter "../../.."
for (@path_parts)  { s/\.\.//g; }
shift @path_parts if not length $path_parts[0];

my ($sender_part, $receiver_part, $file_part) = @path_parts;


# 
# handle CGI parameters
# ---------------------
# 
# The client may specify a "since" parameter which is a unix
# timestamp against UTC; we pretend that anything whose 
# mtime is less than "since" does not exist.


my $since = param("since");

# the client may specify a "format" parameter to request
# that the message index in some alternative format.


my $format = param("format") || "simple1";


# we DO NOT need to use SSL client side certificates to perform access control.



if ($sender_part and $receiver_part and $file_part and -d "$FILEROOT/$sender_part/$receiver_part/$file_part") {
    # client is requesting a message index of a directory.

    # XXX TODO: encrypt the listing against the receiver's public key.
    print (header (-type=>"application/pgp-encrypted"),
	   encrypt_for(target  => $receiver_part,
		       content => show_listing(since => $since,
					       dir => "$FILEROOT/$sender_part/$receiver_part/$file_part")));
}

elsif ($sender_part and $receiver_part and $file_part and -f "$FILEROOT/$sender_part/$receiver_part/$file_part") {
    # client is requesting a message file or an attachment file.

    # XXX TODO: encrypt the listing against the receiver's public key.
    print (header (-type=>"text/plain"),
	   encrypt_for(target  => $receiver_part,
		       content => show_file(file => "$FILEROOT/$sender_part/$receiver_part/$file_part")));
}

elsif ($sender_part and $receiver_part and -d "$FILEROOT/$sender_part/$receiver_part") {
    # client is requesting a message index of a directory.

    # XXX TODO: encrypt the listing against the receiver's public key.
    print (header (-type=>"text/plain"),
	   encrypt_for(target  => $receiver_part,
		       content => show_listing(since => $since, dir => "$FILEROOT/$sender_part/$receiver_part")));
}

elsif ($sender_part and not $receiver_part and -d "$FILEROOT/$sender_part") {
    # client is requesting a message index of a directory.

    # XXX TODO: encrypt the listing against the sender's public key
    print (header (-type=>"text/plain"),
	   encrypt_for(target  => $sender_part,
		       content => show_listing(since => $since,
					       dir => "$FILEROOT/$sender_part/$receiver_part")));
}

else {
    sorry_cant_help_ya();
}

sub encrypt_for {
    my %args = @_;

    my $pgp_public_key_id = get_public_key_id($args{target});

    my $encrypted = encrypt_content(public_key_id => $pgp_public_key_id,
				    content => $args{content});

    return $encrypted;
}

sub get_public_key_id { return @_ }

sub encrypt_content {
    my %args = @_;
    return $args{content};
}

sub show_listing {
    my %args = @_;

    # best way to defeat path escalation is to chroot, but we have to be root to do that.  wtf?
    # chroot ("/home/mengwong/stubmail");
    opendir TUPLEDIR, $args{dir} or unable_to_open($args{dir}, "$!");

    my $since = $args{since} || 0;

    my @contents;

    my $toreturn = "";

    foreach my $filename (readdir(TUPLEDIR)) {
	next if $filename eq "..";
	next if $filename eq ".";

	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks)
	    = stat("$args{dir}/$filename");
	
	next if $mtime <= $since;

	push @contents, { filename => $filename,
			  mtime => $mtime,
			  type => ( -d _ ? "directory" :
				    ( $filename =~ /\.2822$/ ? "message file" :
				      ( -f _ ? "attachment file" :
					"unknown" ) ) ) };
    }

    @contents = sort { $a->{mtime} <=> $b->{mtime} } @contents;

    if ($since) { $toreturn .= "found: " . scalar(@contents) . " entries older than $since\n"; }
    else        { $toreturn .= "found: " . scalar(@contents) . " entries in all\n"; }

    foreach my $file (@contents) {
	while (my ($key, $val) = each %$file) {
	    $toreturn .= "$key = $val\n";
	}
	$toreturn .= "\n";
    }

    return $toreturn;
}


sub show_file {
    my %args = @_;

    open FILE, $args{file} or unable_to_open($args{file}, "$!");
    return (join "", (<FILE>));
}


sub print_homepage {
    print header,
    start_html,
    "hello, world.  Welcome to StubEmail.",
    end_html;

}

sub unable_to_open {
    my ($dir, $error) = @_;

    print header,
    start_html,
    encode_entities("sorry, I was unable to open $dir: $error"),
    end_html;

}

sub sorry_cant_help_ya {
    my ($error) = @_;
    $error ||= "";
    print header,
    start_html,
    encode_entities("sorry, I can't help you.  $error"),
    end_html;

}