Todd Zullinger | d13a73e | 2023-11-16 14:30:10 -0500 | [diff] [blame] | 1 | use 5.008001; |
Max Kirillov | 6c213e8 | 2018-07-27 06:48:59 +0300 | [diff] [blame] | 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 | |
Max Kirillov | 6c213e8 | 2018-07-27 06:48:59 +0300 | [diff] [blame] | 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 | |
Jeff King | e8f5556 | 2021-09-09 18:57:57 -0400 | [diff] [blame] | 27 | $SIG{ALRM} = sub { |
| 28 | kill 'KILL', $pid; |
Max Kirillov | 6c213e8 | 2018-07-27 06:48:59 +0300 | [diff] [blame] | 29 | die "Command did not exit after reading whole body"; |
Jeff King | e8f5556 | 2021-09-09 18:57:57 -0400 | [diff] [blame] | 30 | }; |
| 31 | alarm 60; |
| 32 | |
| 33 | my $ret = waitpid($pid, 0); |
| 34 | if ($ret != $pid) { |
| 35 | die "confusing return from waitpid: $ret"; |
Max Kirillov | 6c213e8 | 2018-07-27 06:48:59 +0300 | [diff] [blame] | 36 | } |