]>
Commit | Line | Data |
---|---|---|
d13a73e3 | 1 | use 5.008001; |
6c213e86 MK |
2 | use strict; |
3 | use warnings; | |
4 | ||
5 | my $body_filename = $ARGV[0]; | |
6 | my @command = @ARGV[1 .. $#ARGV]; | |
7 | ||
8 | # read data | |
9 | my $body_size = -s $body_filename; | |
10 | $ENV{"CONTENT_LENGTH"} = $body_size; | |
11 | open(my $body_fh, "<", $body_filename) or die "Cannot open $body_filename: $!"; | |
12 | my $body_data; | |
13 | defined read($body_fh, $body_data, $body_size) or die "Cannot read $body_filename: $!"; | |
14 | close($body_fh); | |
15 | ||
6c213e86 MK |
16 | # write data |
17 | my $pid = open(my $out, "|-", @command); | |
18 | { | |
19 | # disable buffering at $out | |
20 | my $old_selected = select; | |
21 | select $out; | |
22 | $| = 1; | |
23 | select $old_selected; | |
24 | } | |
25 | print $out $body_data or die "Cannot write data: $!"; | |
26 | ||
e8f55568 JK |
27 | $SIG{ALRM} = sub { |
28 | kill 'KILL', $pid; | |
6c213e86 | 29 | die "Command did not exit after reading whole body"; |
e8f55568 JK |
30 | }; |
31 | alarm 60; | |
32 | ||
33 | my $ret = waitpid($pid, 0); | |
34 | if ($ret != $pid) { | |
35 | die "confusing return from waitpid: $ret"; | |
6c213e86 | 36 | } |