1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
#!/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;
}
|
