[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/Handle.pm

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.241 by root, Fri Sep 5 22:17:26 2014 UTC vs.
Revision 1.256 by root, Wed Jul 29 15:58:58 2020 UTC

    $cv->recv;
 =head1 DESCRIPTION
-This is a helper module to make it easier to do event-based I/O on
+This is a helper module to make it easier to do event-based I/O
-stream-based filehandles (sockets, pipes, and other stream things).
+on stream-based filehandles (sockets, pipes, and other stream
+things). Specifically, it doesn't work as expected on files, packet-based
+sockets or similar things.
 The L<AnyEvent::Intro> tutorial contains some well-documented
 AnyEvent::Handle examples.
 In the following, where the documentation refers to "bytes", it means
 package AnyEvent::Handle;
 use Scalar::Util ();
 use List::Util ();
 use Carp ();
-use Errno qw(EAGAIN EINTR);
+use Errno qw(EAGAIN EWOULDBLOCK EINTR);
 use AnyEvent (); BEGIN { AnyEvent::common_sense }
 use AnyEvent::Util qw(WSAEWOULDBLOCK);
 our $VERSION = $AnyEvent::VERSION;
 =item fh => $filehandle     [C<fh> or C<connect> MANDATORY]
 The filehandle this L<AnyEvent::Handle> object will operate on.
 NOTE: The filehandle will be set to non-blocking mode (using
-C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
+C<AnyEvent::fh_unblock>) by the constructor and needs to stay in
 that mode.
 =item connect => [$host, $service]      [C<fh> or C<connect> MANDATORY]
 Try to connect to the specified host and service (port), using
 The peer's numeric host and port (the socket peername) are passed as
 parameters, together with a retry callback. At the time it is called the
 read and write queues, EOF status, TLS status and similar properties of
 the handle will have been reset.
-It is not allowed to use the read or write queues while the handle object
-is connecting.
 If, for some reason, the handle is not acceptable, calling C<$retry> will
 continue with the next connection target (in case of multi-homed hosts or
 SRV records there can be multiple connection endpoints). The C<$retry>
 callback can be invoked after the connect callback returns, i.e. one can
                   } else {
                      if ($self->{on_connect_error}) {
                         $self->{on_connect_error}($self, "$!");
                         $self->destroy if $self;
                      } else {
-                        $self->_error ($!, 1);
+                        $self->error ($!, 1);
                      }
                   }
                },
                sub {
                   local $self->{fh} = $_[0];
    # with AnyEvent::Handle, do them a favour.
    my $type = getsockopt $self->{fh}, Socket::SOL_SOCKET (), Socket::SO_TYPE ();
    Carp::croak "AnyEvent::Handle: only stream sockets supported, anything else will NOT work!"
       if Socket::SOCK_STREAM () != (unpack "I", $type) && defined $type;
-   AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
+   AnyEvent::fh_unblock $self->{fh};
    $self->{_activity}  =
    $self->{_ractivity} =
    $self->{_wactivity} = AE::now;
       if $self->{on_read} || @{ $self->{_queue} };
    $self->_drain_wbuf;
 }
+=item $handle->error ($errno[, $fatal[, $message]])
+Generates an error event, just like AnyEvent::Handle itself would do, i.e.
+calls the C<on_error> callback.
+The only rerquired parameter is C<$errno>, which sets C<$!>. C<$fatal>
+defaults to false and C<$message> defaults to the stringified version
+of C<$1>.
+Example: generate C<EIO> when you read unexpected data.
+   $handle->push_read (line => sub {
+      $_[1] eq "hello"
+         or return $handle->error (Errno::EIO);
+   });
+=cut
-sub _error {
+sub error {
    my ($self, $errno, $fatal, $message) = @_;
    $! = $errno;
    $message ||= "$!";
       setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_OOBINLINE (), int $_[1]
          if $_[0]{fh};
    };
 }
-=item $handle->keepalive ($boolean)
-Enables or disables the C<keepalive> setting (see constructor argument of
-the same name for details).
-=cut
-sub keepalive {
-   $_[0]{keepalive} = $_[1];
-   eval {
-      local $SIG{__DIE__};
-      setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
-         if $_[0]{fh};
-   };
-}
 =item $handle->on_starttls ($cb)
 Replace the current C<on_starttls> callback (see the C<on_starttls> constructor argument).
 =cut
             $self->{$activity} = $NOW;
             if ($self->{$on_timeout}) {
                $self->{$on_timeout}($self);
             } else {
-               $self->_error (Errno::ETIMEDOUT);
+               $self->error (Errno::ETIMEDOUT);
             }
             # callback could have changed timeout value, optimise
             return unless $self->{$timeout};
             $self->{on_drain}($self)
                if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf})
                   && $self->{on_drain};
             delete $self->{_ww} unless length $self->{wbuf};
-         } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
+         } elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) {
-            $self->_error ($!, 1);
+            $self->error ($!, 1);
          }
       };
       # try to write data immediately
       $cb->() unless $self->{autocork};
       if (
          defined $self->{wbuf_max}
          && $self->{wbuf_max} < length $self->{wbuf}
       ) {
-         $self->_error (Errno::ENOSPC, 1), return;
+         $self->error (Errno::ENOSPC, 1), return;
       }
    };
 }
 our %WH;
       if (my $cb = shift @{ $self->{_queue} }) {
          unless ($cb->($self)) {
             # no progress can be made
             # (not enough data and no data forthcoming)
-            $self->_error (Errno::EPIPE, 1), return
+            $self->error (Errno::EPIPE, 1), return
                if $self->{_eof};
             unshift @{ $self->{_queue} }, $cb;
             last;
          }
             && !@{ $self->{_queue} }     # and the queue is still empty
             && $self->{on_read}          # but we still have on_read
          ) {
             # no further data will arrive
             # so no progress can be made
-            $self->_error (Errno::EPIPE, 1), return
+            $self->error (Errno::EPIPE, 1), return
                if $self->{_eof};
             last; # more data might arrive
          }
       } else {
    }
    if ($self->{_eof}) {
       $self->{on_eof}
          ? $self->{on_eof}($self)
-         : $self->_error (0, 1, "Unexpected end-of-file");
+         : $self->error (0, 1, "Unexpected end-of-file");
       return;
    }
    if (
       defined $self->{rbuf_max}
       && $self->{rbuf_max} < length $self->{rbuf}
    ) {
-      $self->_error (Errno::ENOSPC, 1), return;
+      $self->error (Errno::ENOSPC, 1), return;
    }
    # may need to restart read watcher
    unless ($self->{_rw}) {
       $self->start_read
 };
 =item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
 Makes a regex match against the regex object C<$accept> and returns
-everything up to and including the match.
+everything up to and including the match. All the usual regex variables
+($1, %+ etc.) from the regex match are available in the callback.
 Example: read a single line terminated by '\n'.
    $handle->push_read (regex => qr<\n>, sub { ... });
          return 1;
       }
       # reject
       if ($reject && $$rbuf =~ $reject) {
-         $_[0]->_error (Errno::EBADMSG);
+         $_[0]->error (Errno::EBADMSG);
       }
       # skip
       if ($skip && $$rbuf =~ $skip) {
          $data .= substr $$rbuf, 0, $+[0], "";
    my ($self, $cb) = @_;
    sub {
       unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
          if ($_[0]{rbuf} =~ /[^0-9]/) {
-            $_[0]->_error (Errno::EBADMSG);
+            $_[0]->error (Errno::EBADMSG);
          }
          return;
       }
       my $len = $1;
          my $string = $_[1];
          $_[0]->unshift_read (chunk => 1, sub {
             if ($_[1] eq ",") {
                $cb->($_[0], $string);
             } else {
-               $_[0]->_error (Errno::EBADMSG);
+               $_[0]->error (Errno::EBADMSG);
             }
          });
       });
       1
          $json->incr_skip;
          $_[0]{rbuf} = $json->incr_text;
          $json->incr_text = "";
-         $_[0]->_error (Errno::EBADMSG);
+         $_[0]->error (Errno::EBADMSG);
          ()
       } else {
          $_[0]{rbuf} = "";
          1
       } elsif ($@) {
          # error case
          $cbor->incr_reset;
-         $_[0]->_error (Errno::EBADMSG);
+         $_[0]->error (Errno::EBADMSG);
          ()
       } else {
          ()
       }
       if ($format + $len <= length $_[0]{rbuf}) {
          my $data = substr $_[0]{rbuf}, $format, $len;
          substr $_[0]{rbuf}, 0, $format + $len, "";
          eval { $cb->($_[0], Storable::thaw ($data)); 1 }
-            or return $_[0]->_error (Errno::EBADMSG);
+            or return $_[0]->error (Errno::EBADMSG);
       } else {
          # remove prefix
          substr $_[0]{rbuf}, 0, $format, "";
          # read remaining chunk
          $_[0]->unshift_read (chunk => $len, sub {
             eval { $cb->($_[0], Storable::thaw ($_[1])); 1 }
-               or $_[0]->_error (Errno::EBADMSG);
+               or $_[0]->error (Errno::EBADMSG);
          });
       }
       1
    }
 is handled, up to the fictituous protocol 4.x (but both SSL3+ and
 SSL2-compatible framing is supported).
 If it detects that the input data is likely TLS, it calls the callback
 with a true value for C<$detect> and the (on-wire) TLS version as second
-and third argument (C<$major> is C<3>, and C<$minor> is 0..3 for SSL
+and third argument (C<$major> is C<3>, and C<$minor> is 0..4 for SSL
-3.0, TLS 1.0, 1.1 and 1.2, respectively).  If it detects the input to
+3.0, TLS 1.0, 1.1, 1.2 and 1.3, respectively).  If it detects the input
-be definitely not TLS, it calls the callback with a false value for
+to be definitely not TLS, it calls the callback with a false value for
 C<$detect>.
 The callback could use this information to decide whether or not to start
 TLS negotiation.
 accomodate protocol changes.
 This read type does not rely on L<AnyEvent::TLS> (and thus, not on
 L<Net::SSLeay>).
-=item tls_autostart => $tls[, $tls_ctx]
+=item tls_autostart => [$tls_ctx, ]$tls
 Tries to detect a valid SSL or TLS handshake. If one is detected, it tries
 to start tls by calling C<starttls> with the given arguments.
-In practise, C<$tls> must be C<accept>, or a Net::SSLeay context that has
+In practice, C<$tls> must be C<accept>, or a Net::SSLeay context that has
 been configured to accept, as servers do not normally send a handshake on
 their own and ths cannot be detected in this way.
 See C<tls_detect> above for more details.
 Example: give the client a chance to start TLS before accepting a text
 line.
-   $hdl->push_read (tls_detect => "accept");
+   $hdl->push_read (tls_autostart => "accept");
    $hdl->push_read (line => sub {
       print "received ", ($_[0]{tls} ? "encrypted" : "cleartext"), " <$_[1]>\n";
    });
 =cut
       ) {
          return if 3 != length $1; # partial match, can't decide yet
          # full match, valid TLS record
          my ($major, $minor) = unpack "CC", $1;
-         $cb->($self, "accept", $major + $minor * 0.1);
+         $cb->($self, "accept", $major, $minor);
       } else {
          # mismatch == guaranteed not TLS
          $cb->($self, undef);
       }
          } elsif (defined $len) {
             delete $self->{_rw};
             $self->{_eof} = 1;
             $self->_drain_rbuf;
-         } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
+         } elsif ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK) {
-            return $self->_error ($!, 1);
+            return $self->error ($!, 1);
          }
       };
    }
 }
 our $ERROR_WANT_READ;
 sub _tls_error {
    my ($self, $err) = @_;
-   return $self->_error ($!, 1)
+   return $self->error ($!, 1)
       if $err == Net::SSLeay::ERROR_SYSCALL ();
    my $err = Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ());
    # reduce error string to look less scary
    if ($self->{_on_starttls}) {
       (delete $self->{_on_starttls})->($self, undef, $err);
       &_freetls;
    } else {
       &_freetls;
-      $self->_error (Errno::EPROTO, 1, $err);
+      $self->error (Errno::EPROTO, 1, $err);
    }
 }
 # poll the write BIO and send the data if applicable
 # also decode read data if possible
-# this is basiclaly our TLS state machine
+# this is basically our TLS state machine
 # more efficient implementations are possible with openssl,
 # but not with the buggy and incomplete Net::SSLeay.
 sub _dotls {
    my ($self) = @_;
    unless (defined $AnyEvent::TLS::VERSION) {
       eval {
          require Net::SSLeay;
          require AnyEvent::TLS;
          1
-      } or return $self->_error (Errno::EPROTO, 1, "TLS support not available on this system");
+      } or return $self->error (Errno::EPROTO, 1, "TLS support not available on this system");
    }
    $self->{tls}     = $tls;
    $self->{tls_ctx} = $ctx if @_ > 2;
    $self->{tls}     = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername});
    # basically, this is deep magic (because SSL_read should have the same issues)
    # but the openssl maintainers basically said: "trust us, it just works".
    # (unfortunately, we have to hardcode constants because the abysmally misdesigned
-   # and mismaintained ssleay-module doesn't even offer them).
+   # and mismaintained ssleay-module didn't offer them for a decade or so).
    # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
    #
    # in short: this is a mess.
    #
    # note that we do not try to keep the length constant between writes as we are required to do.
    # we assume that most (but not all) of this insanity only applies to non-blocking cases,
    # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
    # have identity issues in that area.
-#   Net::SSLeay::CTX_set_mode ($ssl,
+#   Net::SSLeay::set_mode ($ssl,
 #      (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
 #      | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
-   Net::SSLeay::CTX_set_mode ($tls, 1|2);
+   Net::SSLeay::set_mode ($tls, 1|2);
    $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
    $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
    Net::SSLeay::BIO_write ($self->{_rbio}, $self->{rbuf});
    return unless $self->{tls};
    $self->{tls_ctx}->_put_session (delete $self->{tls})
       if $self->{tls} > 0;
    delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
 }
 =item $handle->resettls
       push @linger, AE::io $fh, 1, sub {
          my $len = syswrite $fh, $wbuf, length $wbuf;
          if ($len > 0) {
             substr $wbuf, 0, $len, "";
-         } elsif (defined $len || ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK)) {
+         } elsif (defined $len || ($! != EAGAIN && $! != EINTR && $! != EWOULDBLOCK && $! != WSAEWOULDBLOCK)) {
             @linger = (); # end
          }
       };
       push @linger, AE::timer $linger, 0, sub {
          @linger = ();

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents): Revision 1.241 by root, Fri Sep 5 22:17:26 2014 UTC vs. Revision 1.256 by root, Wed Jul 29 15:58:58 2020 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.241 by root, Fri Sep 5 22:17:26 2014 UTC vs.
Revision 1.256 by root, Wed Jul 29 15:58:58 2020 UTC