view release on metacpan or  search on metacpan

t/truncated_response.t  view on Meta::CPAN

# exec/start, which is every raw-stream endpoint there is.

my $client = API::Docker->new(
  host        => 'unix:///nonexistent.sock',
  api_version => '1.41',
);

# The peer writes and then half-closes: we see the end of the response, and a
# request written afterwards still lands rather than raising SIGPIPE. Both
# ends are handed back so the caller can close them when it is done.
sub pair_with {
  my ($bytes) = @_;
  socketpair(my $ours, my $theirs, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
    or plan skip_all => "socketpair unavailable: $!";
  syswrite $theirs, $bytes;
  shutdown $theirs, 1;
  return ($ours, $theirs);
}

# Drive a reader over such a pair and report which of the two happened.
sub over_pair {
  my ($bytes, $drive) = @_;
  my ($ours, $theirs) = pair_with($bytes);
  my @out = eval { $drive->($ours) };
  my $err = $@;
  close $ours;
  close $theirs;
  return ($err, \@out);
}

# A handle that hands over at most $step bytes per sysread, for the two
# assertions a socketpair cannot make. Everything written to a socketpair
# before it is read is already in the kernel's buffer, so one sysread takes
# the lot and a chunk is always complete by the time the callback sees any of
# it -- which is exactly the state the `stopped` guard is about not being in.
{
  package Test::Truncated::Stepped;

  sub TIEHANDLE {
    my ($class, $data, $step) = @_;
    return bless { data => $data, pos => 0, step => $step }, $class;
  }

  sub READ {
    my $self = $_[0];
    my $left = length($self->{data}) - $self->{pos};
    return 0 unless $left;
    my $n = $self->{step} < $left ? $self->{step} : $left;
    $n = $_[2] if defined $_[2] && $_[2] < $n;
    $_[1] = substr($self->{data}, $self->{pos}, $n);
    $self->{pos} += $n;
    return $n;
  }

  sub CLOSE { 1 }
}

sub stepped {
  my ($data, $step) = @_;
  no warnings 'once';
  my $glob = \do { local *HANDLE };
  tie *$glob, 'Test::Truncated::Stepped', $data, $step;
  return $glob;
}

sub truncated_ok {
  my ($err, %want) = @_;

  isa_ok $err, 'API::Docker::Error::Truncated' or return;
  is $err->phase, $want{phase}, 'phase: ' . $want{phase};
  is $err->partial, $want{partial}, 'the bytes that did arrive';
  is $err->expected, $want{expected}, 'the count the response announced';
  is $err->received, $want{received}, 'and how many of them came';
  like "$err", $want{message}, 'the message says what was cut short';
  return;
}

# ---------------------------------------------------------------------------
# The four shapes, measured exactly as karr k64 measured them
# ---------------------------------------------------------------------------
subtest 'Content-Length announces 11, 9 bytes arrive' => sub {
  my ($err) = over_pair(
    "HTTP/1.1 200 OK\r\nContent-Length: 11\r\n\r\nhello wor",
    sub { $client->_read_response($_[0], 'GET', {}) });

  truncated_ok $err,
    phase   => 'content-length',
    partial => 'hello wor',
    expected => 11,
    received => 9,
    message  => qr/the body stopped 2 bytes short of the 11 it announced; 9 bytes arrived/;
};

subtest 'a chunk announces 11 (b), 5 bytes arrive' => sub {
  my ($err) = over_pair(
    "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\nb\r\nhello",
    sub { $client->_read_response($_[0], 'GET', {}) });

  truncated_ok $err,
    phase    => 'chunk-data',
    partial  => 'hello',
    expected => 11,
    received => 5,
    message  => qr/a chunk stopped 6 bytes short of the 11 it announced/;
};

subtest 'a complete chunk with no terminating zero chunk' => sub {
  my ($err) = over_pair(
    "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n5\r\nhello\r\n",
    sub { $client->_read_response($_[0], 'GET', {}) });

  truncated_ok $err,
    phase    => 'chunk-header',
    partial  => 'hello',
    expected => undef,
    received => undef,
    message  => qr/no terminating zero chunk/;
};

subtest 'a chunk header cut in half' => sub {
  my ($err) = over_pair(
    "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n5\r\nhello\r\n1",
    sub { $client->_read_response($_[0], 'GET', {}) });