view release on metacpan or  search on metacpan

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

  return () unless defined $dir && length $dir;

  # cert_path defaults from DOCKER_CERT_PATH, so it can arrive from a machine's
  # 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);

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

  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) {
      return 'eof' unless $n;
      $$buf .= $got;
      return 'data';
    }

    # A signal is not an answer. perl's read() retried here of its own accord
    # (PerlIOUnix_read loops while errno is EINTR), so retrying keeps the
    # behaviour this replaces rather than introducing one.
    next if $errno == EINTR;

    return 'timeout' if $self->_timed_out($ctx, $errno);

    # Anything else -- a reset connection, a handle that cannot be read at
    # all -- ends the response, which is what it did before this too: every
    # reader answered a failed read with `last unless $n`. Whether the
    # response was complete when it ended is a question about its structure,
    # and is asked by the readers that know the structure.
    return 'eof';
  }
}

# The two reads every reader below is built out of. Both serve from the buffer
# and pull only when it is empty, so both hand back what has arrived rather
# than waiting for what was asked for.
sub _read_line {
  my ($self, $sock, $ctx) = @_;
  $ctx ||= {};

  my $buf = $self->_read_buffer($sock);
  my $idx = index($$buf, "\n");