4 use File
::Temp qw
/ tempdir tempfile /;
6 # this is a sample cgi script to accept darcs patches via POST
7 # it simply takes patches and sends them using sendmail or
8 # places them in a Maildir style mailbox.
10 my $tmp_dir; # temporary directory, when placing patches to maildir
11 # files are linked from $tmp_dir to $maildir
14 # target email addresses--leave blank to use To: header in patch contents.
17 # target repository for patch testing. Leave blank to use DarcsURL header
21 my $sendmail_cmd; # command to send patches with
22 $sendmail_cmd = "/usr/sbin/sendmail -i -t $target_email";
24 my $maildir; # maildir to put patches to, replace sendmail
25 #$maildir = "/tmp/maildir";
27 my $patch_test_cmd; # command to test patches with
28 $patch_test_cmd = "darcs apply --dry-run --repodir 'TARGETREPO' 'TARGETPATCH'";
30 my $repo_get_cmd; # command to get testing repo
31 # used only when $target_repo is blank
32 $repo_get_cmd = "darcs get --lazy --repodir 'TARGETDIR' 'TARGETREPO'";
37 print "Status: 500 Error accepting patch\n";
38 print "Content-Type: text/plain\n\n";
39 print($m || "There was an error processing your request");
45 print "Content-Type: text/plain\n\n";
46 print "Thank you for your contribution!\n";
51 if ($ENV{CONTENT_TYPE
} eq 'message/rfc822') {
52 my $m = start_message
() or error_page
("could not create temporary file");
54 my ($totalbytes, $bytesread, $buffer);
56 $bytesread = read(STDIN
, $buffer, 1024);
58 $totalbytes += $bytesread;
60 my $r = end_message
($m);
61 $r ? error_page
($r) : success_page
();
62 } elsif ($ENV{CONTENT_TYPE
}) {
63 error_page
("invalid content type, I expect something of message/rfc822");
65 error_page
("This url is for accepting darcs patches.");
72 my $base_name = sprintf("patch-%d-%d-0000", $$, time());
74 until (link("$tmp_file", "$maildir/$base_name")) {
75 $base_name =~ s/-(\d+)$/"-" . (1 + $1)/e;
76 return undef if $count++ > 100;
78 return "$maildir/$base_name";
82 my ($fh, $fname) = tempfile
("$tmp_dir/dpatch".'X'x8
, UNLINK
=> 1) or
84 return { fh
=> $fh, filename
=> $fname };
89 close $m->{fh
} or return "$!: $m->{filename} - Could not close filehandle";
91 unless ($target_repo) {
92 # Look for DarcsURL header
94 open(MF
,$m->{filename
}) or return "$!: $m->{filename} - Could not open file";
96 if (/^DarcsURL: (.+)$/) {
102 return "Could not find DarcsURL header" unless $darcsurl;
104 my $test_dir = tempdir
(CLEANUP
=> 1).'/repo' or
105 return "$!: Could not create test directory";
106 $repo_get_cmd =~ s/TARGETDIR/$test_dir/;
107 $repo_get_cmd =~ s/TARGETREPO/$darcsurl/;
108 system("$repo_get_cmd >/dev/null 2>/dev/null") == 0 or
109 return "Could not get target repo: '$repo_get_cmd' failed";
110 $target_repo = $test_dir;
112 $patch_test_cmd =~ s/TARGETREPO/$target_repo/;
113 $patch_test_cmd =~ s/TARGETPATCH/$m->{filename}/;
114 system("$patch_test_cmd >/dev/null 2>/dev/null") == 0 or
115 return "Patch is not valid: '$patch_test_cmd' failed";
118 maildir_file
("$m->{filename}") or
119 return "$!: Could not create a new file in maildir";
121 system("$sendmail_cmd < '$m->{filename}'") == 0 or
122 return "$!: Could not send mail";