20bab0
From b01291bf88dd84529c93973da7c275e0ffe5cc1f Mon Sep 17 00:00:00 2001
20bab0
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
20bab0
Date: Fri, 3 Aug 2018 14:30:22 +0200
20bab0
Subject: [PATCH] Adapt to OpenSSL 1.1.1
20bab0
MIME-Version: 1.0
20bab0
Content-Type: text/plain; charset=UTF-8
20bab0
Content-Transfer-Encoding: 8bit
20bab0
20bab0
OpenSSL 1.1.1 defaults to TLS 1.3 that handles session tickets and
20bab0
session shutdowns differently. This leads to failing various Net-SSLeay
20bab0
tests that exhibits use cases that are not possible with OpenSSL 1.1.1
20bab0
anymore or where the library behaves differently.
20bab0
20bab0
Since Net-SSLeay is a low-level wrapper, Net-SSLeay will be corrected
20bab0
in tests. Higher-level code as IO::Socket::SSL and other Net::SSLeay
20bab0
applications need to be adjusted on case-to-case basis.
20bab0
20bab0
This patche changes:
20bab0
20bab0
- Retry SSL_read() and SSL_write() (by sebastian [...] breakpoint.cc)
20bab0
- Disable session tickets in t/local/07_sslecho.t.
20bab0
- Adaps t/local/36_verify.t to a session end when Net::SSLeay::read()
20bab0
  returns undef.
20bab0
20bab0
https://rt.cpan.org/Public/Bug/Display.html?id=125218
20bab0
https://github.com/openssl/openssl/issues/5637
20bab0
https://github.com/openssl/openssl/issues/6904
20bab0
Signed-off-by: Petr Písař <ppisar@redhat.com>
20bab0
---
20bab0
 SSLeay.xs            | 56 ++++++++++++++++++++++++++++++++++++++++++++++++----
20bab0
 lib/Net/SSLeay.pod   | 46 ++++++++++++++++++++++++++++++++++++++++++
20bab0
 t/local/07_sslecho.t | 15 ++++++++++++--
20bab0
 t/local/36_verify.t  |  2 +-
20bab0
 4 files changed, 112 insertions(+), 7 deletions(-)
20bab0
20bab0
diff --git a/SSLeay.xs b/SSLeay.xs
20bab0
index bf148c0..5aed4d7 100644
20bab0
--- a/SSLeay.xs
20bab0
+++ b/SSLeay.xs
20bab0
@@ -1999,7 +1999,17 @@ SSL_read(s,max=32768)
20bab0
 	int got;
20bab0
     PPCODE:
20bab0
 	New(0, buf, max, char);
20bab0
-	got = SSL_read(s, buf, max);
20bab0
+
20bab0
+	do {
20bab0
+		int err;
20bab0
+
20bab0
+		got = SSL_read(s, buf, max);
20bab0
+		if (got > 0)
20bab0
+			break;
20bab0
+		err = SSL_get_error(s, got);
20bab0
+		if (err != SSL_ERROR_WANT_READ && err != SSL_ERROR_WANT_WRITE)
20bab0
+			break;
20bab0
+	} while (1);
20bab0
 
20bab0
 	/* If in list context, return 2-item list:
20bab0
 	 *   first return value:  data gotten, or undef on error (got<0)
20bab0
@@ -2051,10 +2061,20 @@ SSL_write(s,buf)
20bab0
      SSL *   s
20bab0
      PREINIT:
20bab0
      STRLEN len;
20bab0
+     int err;
20bab0
+     int ret;
20bab0
      INPUT:
20bab0
      char *  buf = SvPV( ST(1), len);
20bab0
      CODE:
20bab0
-     RETVAL = SSL_write (s, buf, (int)len);
20bab0
+     do {
20bab0
+	     ret = SSL_write (s, buf, (int)len);
20bab0
+	     if (ret > 0)
20bab0
+		     break;
20bab0
+	     err = SSL_get_error(s, ret);
20bab0
+	     if (err != SSL_ERROR_WANT_READ && err != SSL_ERROR_WANT_WRITE)
20bab0
+		     break;
20bab0
+     } while (1);
20bab0
+     RETVAL = ret;
20bab0
      OUTPUT:
20bab0
      RETVAL
20bab0
 
20bab0
@@ -2083,8 +2103,20 @@ SSL_write_partial(s,from,count,buf)
20bab0
      if (len < 0) {
20bab0
        croak("from beyound end of buffer");
20bab0
        RETVAL = -1;
20bab0
-     } else
20bab0
-       RETVAL = SSL_write (s, &(buf[from]), (count<=len)?count:len);
20bab0
+     } else {
20bab0
+	     int ret;
20bab0
+	     int err;
20bab0
+
20bab0
+	     do {
20bab0
+		     ret = SSL_write (s, &(buf[from]), (count<=len)?count:len);
20bab0
+		     if (ret > 0)
20bab0
+			     break;
20bab0
+		     err = SSL_get_error(s, ret);
20bab0
+		     if (err != SSL_ERROR_WANT_READ && err != SSL_ERROR_WANT_WRITE)
20bab0
+			     break;
20bab0
+	     } while (1);
20bab0
+	     RETVAL = ret;
20bab0
+     }
20bab0
      OUTPUT:
20bab0
      RETVAL
20bab0
 
20bab0
@@ -6957,4 +6989,20 @@ SSL_export_keying_material(ssl, outlen, label, p)
20bab0
 
20bab0
 #endif
20bab0
 
20bab0
+#if OPENSSL_VERSION_NUMBER >= 0x1010100fL
20bab0
+
20bab0
+int
20bab0
+SSL_CTX_set_num_tickets(SSL_CTX *ctx,size_t num_tickets)
20bab0
+
20bab0
+size_t
20bab0
+SSL_CTX_get_num_tickets(SSL_CTX *ctx)
20bab0
+
20bab0
+int
20bab0
+SSL_set_num_tickets(SSL *ssl,size_t num_tickets)
20bab0
+
20bab0
+size_t
20bab0
+SSL_get_num_tickets(SSL *ssl)
20bab0
+
20bab0
+#endif
20bab0
+
20bab0
 #define REM_EOF "/* EOF - SSLeay.xs */"
20bab0
diff --git a/lib/Net/SSLeay.pod b/lib/Net/SSLeay.pod
20bab0
index 2e1aae3..bca7be4 100644
20bab0
--- a/lib/Net/SSLeay.pod
20bab0
+++ b/lib/Net/SSLeay.pod
20bab0
@@ -4437,6 +4437,52 @@ getticket($ssl,$ticket,$data) -> $return_value
20bab0
 
20bab0
 This function is based on the OpenSSL function SSL_set_session_ticket_ext_cb.
20bab0
 
20bab0
+=item * CTX_set_num_tickets
20bab0
+
20bab0
+B<COMPATIBILITY:> not available in Net-SSLeay-1.85 and before; requires at least OpenSSL 1.1.1
20bab0
+
20bab0
+Set number of session tickets that will be sent to a client.
20bab0
+
20bab0
+ my $rv = Net::SSLeay::CTX_set_num_tickets($ctx, $number_of_tickets);
20bab0
+ # $ctx  - value corresponding to openssl's SSL_CTX structure
20bab0
+ # $number_of_tickets - number of tickets to send
20bab0
+ # returns: 1 on success, 0 on failure
20bab0
+
20bab0
+Set to zero if you do not no want to support a session resumption.
20bab0
+
20bab0
+=item * CTX_get_num_tickets
20bab0
+
20bab0
+B<COMPATIBILITY:> not available in Net-SSLeay-1.85 and before; requires at least OpenSSL 1.1.1
20bab0
+
20bab0
+Get number of session tickets that will be sent to a client.
20bab0
+
20bab0
+ my $number_of_tickets = Net::SSLeay::CTX_get_num_tickets($ctx);
20bab0
+ # $ctx  - value corresponding to openssl's SSL_CTX structure
20bab0
+ # returns: number of tickets to send
20bab0
+
20bab0
+=item * set_num_tickets
20bab0
+
20bab0
+B<COMPATIBILITY:> not available in Net-SSLeay-1.85 and before; requires at least OpenSSL 1.1.1
20bab0
+
20bab0
+Set number of session tickets that will be sent to a client.
20bab0
+
20bab0
+ my $rv = Net::SSLeay::set_num_tickets($ssl, $number_of_tickets);
20bab0
+ # $ssl  - value corresponding to openssl's SSL structure
20bab0
+ # $number_of_tickets - number of tickets to send
20bab0
+ # returns: 1 on success, 0 on failure
20bab0
+
20bab0
+Set to zero if you do not no want to support a session resumption.
20bab0
+
20bab0
+=item * get_num_tickets
20bab0
+
20bab0
+B<COMPATIBILITY:> not available in Net-SSLeay-1.85 and before; requires at least OpenSSL 1.1.1
20bab0
+
20bab0
+Get number of session tickets that will be sent to a client.
20bab0
+
20bab0
+ my $number_of_tickets = Net::SSLeay::get_num_tickets($ctx);
20bab0
+ # $ctx  - value corresponding to openssl's SSL structure
20bab0
+ # returns: number of tickets to send
20bab0
+
20bab0
 =item * set_shutdown
20bab0
 
20bab0
 Sets the shutdown state of $ssl to $mode.
20bab0
diff --git a/t/local/07_sslecho.t b/t/local/07_sslecho.t
20bab0
index 5e16b04..5dc946a 100644
20bab0
--- a/t/local/07_sslecho.t
20bab0
+++ b/t/local/07_sslecho.t
20bab0
@@ -13,7 +13,8 @@ BEGIN {
20bab0
   plan skip_all => "fork() not supported on $^O" unless $Config{d_fork};
20bab0
 }
20bab0
 
20bab0
-plan tests => 78;
20bab0
+plan tests => 79;
20bab0
+$SIG{'PIPE'} = 'IGNORE';
20bab0
 
20bab0
 my $sock;
20bab0
 my $pid;
20bab0
@@ -61,6 +62,16 @@ Net::SSLeay::library_init();
20bab0
     ok(Net::SSLeay::CTX_set_cipher_list($ctx, 'ALL'), 'CTX_set_cipher_list');
20bab0
     my ($dummy, $errs) = Net::SSLeay::set_cert_and_key($ctx, $cert_pem, $key_pem);
20bab0
     ok($errs eq '', "set_cert_and_key: $errs");
20bab0
+    SKIP: {
20bab0
+        skip 'Disabling session tickets requires OpenSSL >= 1.1.1', 1
20bab0
+            unless (&Net::SSLeay::OPENSSL_VERSION_NUMBER >= 0x1010100f);
20bab0
+        # TLS 1.3 server sends session tickets after a handhake as part of
20bab0
+        # the SSL_accept(). If a client finishes all its job including closing
20bab0
+        # TCP connectino before a server sends the tickets, SSL_accept() fails
20bab0
+        # with SSL_ERROR_SYSCALL and EPIPE errno and the server receives
20bab0
+        # SIGPIPE signal. <https://github.com/openssl/openssl/issues/6904>
20bab0
+        ok(Net::SSLeay::CTX_set_num_tickets($ctx, 0), 'Session tickets disabled');
20bab0
+    }
20bab0
 
20bab0
     $pid = fork();
20bab0
     BAIL_OUT("failed to fork: $!") unless defined $pid;
20bab0
@@ -351,7 +362,7 @@ waitpid $pid, 0;
20bab0
 push @results, [ $? == 0, 'server exited with 0' ];
20bab0
 
20bab0
 END {
20bab0
-    Test::More->builder->current_test(51);
20bab0
+    Test::More->builder->current_test(52);
20bab0
     for my $t (@results) {
20bab0
         ok( $t->[0], $t->[1] );
20bab0
     }
20bab0
diff --git a/t/local/36_verify.t b/t/local/36_verify.t
20bab0
index 92afc52..e55b138 100644
20bab0
--- a/t/local/36_verify.t
20bab0
+++ b/t/local/36_verify.t
20bab0
@@ -282,7 +282,7 @@ sub run_server
20bab0
 
20bab0
 	# Termination request or other message from client
20bab0
 	my $msg = Net::SSLeay::read($ssl);
20bab0
-	if ($msg eq 'end')
20bab0
+	if (defined $msg and $msg eq 'end')
20bab0
 	{
20bab0
 	    Net::SSLeay::write($ssl, 'end');
20bab0
 	    exit (0);
20bab0
-- 
20bab0
2.14.4
20bab0