view release on metacpan or  search on metacpan

lib/API/Docker/Role/HTTP.pm  view on Meta::CPAN

  # environment rather than from this caller -- but it is only looked at once
  # TLS was asked for, and at that point a path naming nothing is a mistake
  # worth stopping on rather than quietly connecting without the certificates
  # the caller believes are in use.
  my $path = path($dir);
  croak __PACKAGE__ . ": cert_path $dir is not a directory. TLS expects the "
    . 'layout the docker CLI writes -- ca.pem, cert.pem and key.pem in one '
    . 'directory -- and this names nothing that could hold it'
    unless $path->is_dir;

  my %ssl;

  # No ca.pem is not an error: verifying a daemon behind a terminator with a
  # publicly trusted certificate needs no private trust anchor, and the
  # default store is then the right one. See L</"TLS on a tcp:// connection">.
  my $ca = $path->child('ca.pem');
  $ssl{SSL_ca_file} = "$ca" if $ca->exists;

  my $cert = $path->child('cert.pem');
  my $key  = $path->child('key.pem');
  my @half = grep { !$_->[1]->exists }
    ( [ 'cert.pem', $cert ], [ 'key.pem', $key ] );

  # One of the two is never a mode, only ever an accident: a key with no
  # certificate proves nothing and a certificate with no key cannot be used.
  croak __PACKAGE__ . ': cert_path ' . $dir . ' has ' . $half[0][0]
    . ' missing while the other half of the client certificate is there. '
    . 'Both cert.pem and key.pem are needed, or neither'
    if @half == 1;

  if (!@half) {
    $ssl{SSL_cert_file} = "$cert";
    $ssl{SSL_key_file}  = "$key";
  }

  return %ssl;
}

sub _reconnect {
  my ($self, $pending) = @_;
  $self->_clear_socket;

  # Cleared on the way out whichever way the build went, so a later _socket
  # built by anything but a request -- a test subclass, a caller reaching for
  # it directly -- never picks up the last request's bound.
  $self->_pending_connect($pending);
  my $sock;
  my $ok  = eval { $sock = $self->_socket; 1 };
  my $err = $@;
  $self->_pending_connect(undef);
  die $err unless $ok;

  return $sock;
}

# Whether the connect that has just failed failed because the bound fired.
# Asked with nothing in between, because $@ and $! are the whole of the
# evidence and both are global.
#
# $@ rather than errno: IO::Socket writes 'connect: timeout' there, and only
# there, when its own select() ran out -- measured, against a host that drops
# SYNs, where $! is ETIMEDOUT, which the kernel also produces on its own after
# two minutes with no Timeout set at all.
#
# EAGAIN is the second shape and belongs to unix:// alone. Measured against a
# listener whose backlog is full: with no Timeout the connect blocks
# indefinitely (still blocked after 8s), and with one it fails at once with
# EAGAIN, because IO::Socket does the timed connect non-blocking and an
# AF_UNIX connect has no in-progress state to wait on. So on that transport
# the option does not wait, it refuses -- but a connect that failed with
# EAGAIN is still one the bound ended, and reporting it as anything else would
# name a cause the caller cannot act on.
sub _connect_expired {
  my ($self, $timeout) = @_;

  return 0 unless $timeout;
  return 1 if defined $@ && $@ =~ /connect: timeout\z/;
  return 1 if $! == EAGAIN || $! == EWOULDBLOCK;
  return 0;
}

sub _croak_connect_timeout {
  my ($self, $pending, $where) = @_;

  my $endpoint = $pending->{endpoint};
  # See _croak_timeout for why the object goes into a variable first and why
  # the location is captured by hand.
  my $error = API::Docker::Error::Timeout->new(
    message  => 'Docker API connect timeout'
      . (defined $endpoint && length $endpoint ? ' (' . $endpoint . ')' : '')
      . ': ' . $where . ' did not accept within ' . $pending->{timeout} . 's',
    location => shortmess(''),
    endpoint => defined $endpoint ? $endpoint : '',
    timeout  => $pending->{timeout},
    phase    => 'connect',
  );
  croak $error;
}

# undef for "no timeout", which is both the default and the explicit 0, so a
# client carrying a default can be opted out of for one request. Anything that
# is not a non-negative number is a caller mistake and is refused rather than
# rounded to something: silently reading a typo as "off" would hand back the
# hang the caller was asking to be protected from.
sub _timeout_value {
  my ($self, $name, $timeout) = @_;

  return undef unless defined $timeout;
  croak __PACKAGE__ . '->_request ' . $name . ' must be a non-negative number '
    . 'of seconds (0 or undef for none), not "' . $timeout . '"'
    unless !ref $timeout && looks_like_number($timeout) && $timeout >= 0;

  return $timeout > 0 ? $timeout : undef;
}

sub _read_timeout_value {
  my ($self, $timeout) = @_;
  return $self->_timeout_value('read_timeout', $timeout);
}

sub _connect_timeout_value {
  my ($self, $timeout) = @_;
  return $self->_timeout_value('connect_timeout', $timeout);
}

# Why SO_RCVTIMEO and not select(): a bound that reads the socket cannot see
# what is already buffered above it, and would fire while the data it was
# waiting for was in hand. That was true of PerlIO's read-ahead when this was
# written (measured: after one readline of a socket holding
# "one\ntwo\nthree\n", two whole lines sit in the PerlIO buffer and select()
# says the handle is not ready), and it is true of _read_buffer now. A
# select-based bound would have to be asked only when that buffer is empty,
# which is one more invariant to keep for no gain: SO_RCVTIMEO bounds the one
# syscall in _pull for one setsockopt, and gets idle-since-the-last-byte
# semantics for free, which is the semantics these endpoints need (karr k52:
# the buffered frames arrive, and *then* the socket stalls -- a
# time-to-first-byte bound would never fire).
sub _apply_read_timeout {
  my ($self, $sock, $timeout) = @_;

  return unless $timeout;

  my $packed;
  if ($^O eq 'MSWin32' || $^O eq 'cygwin') {
    # Winsock takes a DWORD of milliseconds here rather than a struct timeval,
    # and reads a zero as "wait forever" -- so a sub-millisecond request is
    # rounded up instead of becoming the hang it asked to avoid. Reasoned from
    # the Winsock documentation and NOT measured: there is no Windows here.
    # What makes that safe to ship is the croak below -- a shape the platform
    # rejects is reported rather than ignored.
    my $ms = int($timeout * 1000 + 0.5);
    $ms = 1 if $ms < 1;
    $packed = pack('L', $ms);
  }
  else {
    # struct timeval: two native longs, seconds then microseconds. Measured on
    # Linux x86_64 against unix://, plain tcp:// and TLS.
    my $sec  = int($timeout);
    my $usec = int(($timeout - $sec) * 1_000_000 + 0.5);
    if ($usec >= 1_000_000) { $sec++; $usec -= 1_000_000 }
    $packed = pack('l!l!', $sec, $usec);
  }

  # Never a warning and never a silent pass. A caller that asked for a bound
  # and did not get one is left waiting on exactly the hang the option exists
  # to end, and would have no way to tell that from a daemon being slow.
  setsockopt($sock, SOL_SOCKET, SO_RCVTIMEO, $packed)
    or croak __PACKAGE__ . ': cannot set a read timeout of ' . $timeout
      . 's on this socket: ' . $! . '. Refusing to continue without it -- a '
      . 'bound that is not in force is worse than no bound at all, because '
      . 'the caller is relying on it';

  return;
}

# A read that did not deliver did not deliver for one of two reasons, and they
# are not the same thing: the stream ended, or the clock ran out. errno is the
# only thing that separates them -- measured, both eof() and $fh->error are
# true after a timeout just as they are at a clean end, and asking eof() costs
# a second full timeout. So $! is zeroed immediately before the read in _pull
# and captured immediately after it, with nothing in between: it is only
# meaningful after a failure, and any operation in between would overwrite it.
#
# Without this the readers would take a timeout for the end of the response and
# return a truncated body as a whole one. That is the reason karr k59 is not
# just the setsockopt: switching the option on alone would turn a hang into
# silent data loss, which is the worse of the two.
sub _timed_out {
  my ($self, $ctx, $errno) = @_;

  return 0 unless $ctx->{timeout};
  return ($errno == EAGAIN || $errno == EWOULDBLOCK) ? 1 : 0;

lib/API/Docker/Role/HTTP.pm  view on Meta::CPAN

  # Empty when a reader is driven directly rather than through _request, which
  # is how t/role_http.t drives them: an endpoint nobody named is left out of
  # the message rather than interpolated as the empty string.
  my $endpoint = defined $ctx->{endpoint} ? $ctx->{endpoint} : '';

  # The two phases with an announced length say the same sentence about it, so
  # they name the piece and let this write it; the two without pass the whole
  # detail, there being no count to put in one.
  my $detail = $what{detail};
  unless (defined $detail) {
    my $short = $what{expected} - $what{received};
    $detail = $what{piece} . ' stopped ' . $short . ' byte'
      . ($short == 1 ? '' : 's') . ' short of the ' . $what{expected}
      . ' it announced';
  }

  # Carp hands a reference straight back rather than decorating it, so this
  # croak is a die with an object -- hence the location captured by hand,
  # which names the same frame a croak of a plain string would have named.
  # The object goes into a variable first: `croak CLASS->new(...)` is indirect
  # object syntax and parses as CLASS->croak(new(...)).
  my $error = API::Docker::Error::Truncated->new(
    message => 'Docker API response truncated'
      . (length $endpoint ? ' (' . $endpoint . ')' : '') . ': '
      . $detail . '; ' . $arrived,
    location => shortmess(''),
    endpoint => $endpoint,
    phase    => $what{phase},
    expected => $what{expected},
    received => $what{received},
    partial  => $partial,
    summary  => $summary,
  );
  croak $error;
}

# ---------------------------------------------------------------------------
# Reading, in one buffer regime
#
# Every byte of a response is taken off the handle by _pull and by nothing
# else, and every reader below is served out of the buffer _pull fills. That
# is not an optimisation, it is the only shape that works (karr k60).
#
# What forced it: perl's read() is fread-shaped. It loops until it has the
# LENGTH it was asked for or the stream ends -- it does not return what has
# arrived. Measured on an AF_UNIX socketpair whose peer writes 6 bytes, waits
# half a second, writes 6 more and closes: read($sock, $buf, 65536) came back
# with 12 after 0.90s, having waited for the close, while sysread came back
# with 6 in 0.00s. On the endpoints with neither a Content-Length nor chunked
# encoding -- attach, logs(follow), exec/start, all
# application/vnd.docker.raw-stream -- the reader asks for $READ_SIZE, so
# read() delivered nothing to an on_frame/on_chunk callback until 64K had
# piled up or the daemon hung up. On a stream that never ends it would deliver
# nothing at all. The POD promised those callbacks the bytes as they arrive,
# and that promise was not kept.
#
# Why it could not be fixed at the one site that had the bug: _read_head read
# the status line and the headers with <$sock>, and PerlIO reads ahead. The
# bytes past the header block were sitting in a buffer this code cannot reach
# -- there is no supported way to take them back out; ungetc is layer-
# dependent, seek does not work on a socket, and select/MSG_PEEK see the
# kernel's buffer rather than PerlIO's. So switching only the body reads to
# sysread would have silently dropped the start of every body. Either all read
# sites move together or none do.
#
# The buffer lives on the handle rather than on the client or in the context:
# it is the unconsumed bytes of *that* handle, its lifetime is the handle's,
# and a client that opens a socket per request therefore has nothing to reset.
# ${*$sock}{...} is the IO::Socket idiom for exactly this and was measured to
# work on a real socket, a lexical filehandle, a bareword glob and a tied
# handle alike.
my $RBUF = __PACKAGE__ . '/rbuf';

sub _read_buffer {
  my ($self, $sock) = @_;

  ${*$sock}{$RBUF} = '' unless defined ${*$sock}{$RBUF};
  return \${*$sock}{$RBUF};
}

# The one physical read. It answers with what happened rather than with a
# count, because a count makes every reader re-derive the same distinction and
# an undef quietly becoming an end of stream at any one of them is the silent
# truncation this transport must not have:
#
#   'data'     something was appended to the buffer -- however little
#   'eof'      the stream ended
#   'timeout'  the read_timeout expired with nothing to show for it
#
# What TLS does here, since it is not obvious from the call. IO::Socket::SSL
# ties the glob, so the builtin sysread reaches the same place -- SSL_HANDLE's
# READ delegates to the object's own sysread -- and the method form is written
# out only so that the dispatch is visible rather than accidental. What does
# matter is sysread rather than read: IO::Socket::SSL's sysread is a single
# Net::SSLeay::read, one record, while its read is ssl_read_all on a blocking
# socket, which is the same fill semantics this is here to get away from.
#
# A short positive read is never an end of stream and never an expiry. Over
# TLS it is the normal case, one plaintext record at a time; over a plain
# socket it is whatever the kernel had. Both are data.
#
# SSL_WANT_READ and SSL_WANT_WRITE are deliberately not retried. On a blocking
# socket they arrive as EWOULDBLOCK (IO::Socket::SSL's _skip_rw_error does
# `$! ||= EWOULDBLOCK`) and mean the underlying receive would have blocked --
# which, with SO_RCVTIMEO in force, is the bound firing and nothing else.
# Retrying would be a busy loop on WANT_READ and could not make progress on
# WANT_WRITE in any case, so they are reported as the timeout they are.
sub _pull {
  my ($self, $sock, $ctx) = @_;

  my $buf = $self->_read_buffer($sock);

  while (1) {
    # errno immediately before, errno immediately after, nothing in between:
    # it is only meaningful after a failure, and any operation at all would
    # overwrite it. See _timed_out.
    $! = 0;
    my $n = $sock->sysread(my $got, $READ_SIZE);
    my $errno = 0 + $!;

    if (defined $n) {