#!/usr/bin/perl

use strict;
use Fcntl;

# this is a sample cgi script to accept darcs patches via POST
# it simply takes patches and places them in a Maildir style
# mailbox.

# set this to the maildir you wish patches to be sent to.
my $maildir = "/tmp/maildir";

sub error_page {
    my ($m) = @_;
    print "Status: 500 Error accepting patch\n";
    print "Content-Type: text/plain\n\n";
    print($m || "There was an error processing your request");
    print "\n";
    exit 0;
}

sub success_page {
    print "Content-Type: text/plain\n\n";
    print "Thank you for your contribution!\n";
    exit 0;
}


if($ENV{CONTENT_TYPE} eq 'message/rfc822') {
        my $m = start_message($maildir) or error_page("could not open maildir: $maildir");
        my $fh = $m->{fh};
        my ($totalbytes,$bytesread,$buffer);
        do {
            $bytesread=read(STDIN,$buffer,1024);
            print $fh $buffer;
            $totalbytes += $bytesread;
        } while($bytesread);
        my $r = end_message($m);
        $r ? error_page($r) : success_page();
} elsif($ENV{CONTENT_TYPE}) {
    error_page("invalid content type, I expect something of message/rfc822");
} else {
    error_page("This url is for accepting darcs patches");
}



sub temp_file {
    my ($temp_dir) = @_;
    my $base_name = sprintf("patch-%d-%d-0000", $temp_dir, $$, time());
    local *FH;
    my $count = 0;
    until (defined(fileno(FH)) || $count++ > 100) {
        $base_name =~ s/-(\d+)$/"-" . (1 + $1)/e;
        sysopen(FH, "$temp_dir/$base_name", O_WRONLY|O_EXCL|O_CREAT);
    }
    defined(fileno(FH)) ? return (*FH, $base_name) : return ();
}

sub start_message {
    my ($maildir) = @_;
    my ($fh,$fname) = temp_file("$maildir/tmp") or return undef;
    return { maildir => $maildir, fh => $fh, filename => $fname };
}

sub end_message {
    my ($m) = @_;
    close $m->{fh} or return "$!: $m->{filename} - Could not close filehandle";
    link "$m->{maildir}/tmp/$m->{filename}", "$m->{maildir}/new/$m->{filename}" or return "$@: $m->{filename} - could not link to new";
    unlink "$m->{maildir}/tmp/$m->{filename}";
    return 0;
}