http-backend: respect CONTENT_LENGTH for receive-pack
[git/debian.git] / t / t5562 / invoke-with-content-length.pl
blob6c2aae7692b23f8afb98ec7b682d8d7529504499
1 #!/usr/bin/perl
2 use 5.008;
3 use strict;
4 use warnings;
6 my $body_filename = $ARGV[0];
7 my @command = @ARGV[1 .. $#ARGV];
9 # read data
10 my $body_size = -s $body_filename;
11 $ENV{"CONTENT_LENGTH"} = $body_size;
12 open(my $body_fh, "<", $body_filename) or die "Cannot open $body_filename: $!";
13 my $body_data;
14 defined read($body_fh, $body_data, $body_size) or die "Cannot read $body_filename: $!";
15 close($body_fh);
17 my $exited = 0;
18 $SIG{"CHLD"} = sub {
19 $exited = 1;
22 # write data
23 my $pid = open(my $out, "|-", @command);
25 # disable buffering at $out
26 my $old_selected = select;
27 select $out;
28 $| = 1;
29 select $old_selected;
31 print $out $body_data or die "Cannot write data: $!";
33 sleep 60; # is interrupted by SIGCHLD
34 if (!$exited) {
35 close($out);
36 die "Command did not exit after reading whole body";