perl-test-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From rj...@apache.org
Subject svn commit: r1844473 - /perl/Apache-Test/trunk/lib/Apache/TestRequest.pm
Date Sun, 21 Oct 2018 09:19:44 GMT
Author: rjung
Date: Sun Oct 21 09:19:44 2018
New Revision: 1844473

URL: http://svn.apache.org/viewvc?rev=1844473&view=rev
Log:
IO::Socket::SSL has getline() which reads decoded
lines, but the handling of the complex SSL read/write
method is incomplete.

So revert r1844425 and add another impl of getline()
that is motivated (mostly copied) from Net::SSLeay::ssl_read_all().

Unfortunately for that we need access to the internal
$ssl field in IO::Socket::SSL which can only be gotten
via the internal method _get_ssl_object().

Probably time for an enhancement request for
IO::Socket::SSL.

Modified:
    perl/Apache-Test/trunk/lib/Apache/TestRequest.pm

Modified: perl/Apache-Test/trunk/lib/Apache/TestRequest.pm
URL: http://svn.apache.org/viewvc/perl/Apache-Test/trunk/lib/Apache/TestRequest.pm?rev=1844473&r1=1844472&r2=1844473&view=diff
==============================================================================
--- perl/Apache-Test/trunk/lib/Apache/TestRequest.pm (original)
+++ perl/Apache-Test/trunk/lib/Apache/TestRequest.pm Sun Oct 21 09:19:44 2018
@@ -304,9 +304,44 @@ sub vhost_socket {
     }
 }
 
+#IO::Socket::SSL::getline does not correctly handle OpenSSL *_WANT_*.
+#Could care less about performance here, just need a getline()
+#that returns the same results with or without ssl.
+#Inspired from Net::SSLeay::ssl_read_all().
+my %getline = (
+    'IO::Socket::SSL' => sub {
+        my $self = shift;
+        # _get_ssl_object in IO::Socket::SSL only meant for internal use!
+        # But we need to compensate for unsufficient getline impl there.
+        my $ssl = $self->_get_ssl_object;
+        my ($got, $rv, $errs);
+        my $reply = '';
+    
+        while (1) {
+            ($got, $rv) = Net::SSLeay::read($ssl, 1);
+            if (! defined $got) {
+                my $err = Net::SSLeay::get_error($ssl, $rv);
+                if ($err != Net::SSLeay::ERROR_WANT_READ() and
+                    $err != Net::SSLeay::ERROR_WANT_WRITE()) {
+                    $errs = Net::SSLeay::print_errs('SSL_read');
+                    last;
+                }
+                next;
+            }
+            last if $got eq '';  # EOF
+            $reply .= $got;
+            last if $got eq "\n";
+        }
+
+        wantarray ? ($reply, $errs) : $reply;
+    },
+);
+
 sub getline {
     my $sock = shift;
-    $sock->getline();
+    my $class = ref $sock;
+    my $method = $getline{$class} || 'getline';
+    $sock->$method();
 }
 
 sub socket_trace {



Mime
View raw message