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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
#!/usr/bin/perl
use strict;
use File::Temp qw/ tempdir tempfile /;
# this is a sample cgi script to accept darcs patches via POST
# it simply takes patches and sends them using sendmail or
# places them in a Maildir style mailbox.
my $tmp_dir; # temporary directory, when placing patches to maildir
# files are linked from $tmp_dir to $maildir
$tmp_dir = "/tmp";
# target email addresses--leave blank to use To: header in patch contents.
my $target_email;
# target repository for patch testing. Leave blank to use DarcsURL header
# in patch contents.
my $target_repo;
my $sendmail_cmd; # command to send patches with
$sendmail_cmd = "/usr/sbin/sendmail -i -t $target_email";
my $maildir; # maildir to put patches to, replace sendmail
#$maildir = "/tmp/maildir";
my $patch_test_cmd; # command to test patches with
$patch_test_cmd = "darcs apply --dry-run --repodir 'TARGETREPO' 'TARGETPATCH'";
my $repo_clone_cmd; # command to clone testing repo
# used only when $target_repo is blank
$repo_clone_cmd = "darcs clone --lazy --repodir 'TARGETDIR' 'TARGETREPO'";
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() or error_page("could not create temporary file");
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 maildir_file {
my ($tmp_file) = @_;
my $base_name = sprintf("patch-%d-%d-0000", $$, time());
my $count = 0;
until (link("$tmp_file", "$maildir/$base_name")) {
$base_name =~ s/-(\d+)$/"-" . (1 + $1)/e;
return undef if $count++ > 100;
}
return "$maildir/$base_name";
}
sub start_message {
my ($fh, $fname) = tempfile("$tmp_dir/dpatch".'X'x8, UNLINK => 1) or
return undef;
return { fh => $fh, filename => $fname };
}
sub end_message {
my ($m) = @_;
close $m->{fh} or return "$!: $m->{filename} - Could not close filehandle";
unless ($target_repo) {
# Look for DarcsURL header
my $darcsurl;
open(MF,$m->{filename}) or return "$!: $m->{filename} - Could not open file";
while (<MF>) {
if (/^DarcsURL: (.+)$/) {
$darcsurl = $1;
last;
}
}
close(MF);
return "Could not find DarcsURL header" unless $darcsurl;
my $test_dir = tempdir(CLEANUP => 1).'/repo' or
return "$!: Could not create test directory";
$repo_clone_cmd =~ s/TARGETDIR/$test_dir/;
$repo_clone_cmd =~ s/TARGETREPO/$darcsurl/;
system("$repo_clone_cmd >/dev/null 2>/dev/null") == 0 or
return "Could not clone target repo: '$repo_clone_cmd' failed";
$target_repo = $test_dir;
}
$patch_test_cmd =~ s/TARGETREPO/$target_repo/;
$patch_test_cmd =~ s/TARGETPATCH/$m->{filename}/;
system("$patch_test_cmd >/dev/null 2>/dev/null") == 0 or
return "Patch is not valid: '$patch_test_cmd' failed";
if ($maildir) {
maildir_file("$m->{filename}") or
return "$!: Could not create a new file in maildir";
} else {
system("$sendmail_cmd < '$m->{filename}'") == 0 or
return "$!: Could not send mail";
}
return 0;
}
|
