guile: Session record port treats premature termination as EOF.

* guile/src/core.c (do_fill_port) [USING_GUILE_BEFORE_2_2]: Treat
GNUTLS_E_PREMATURE_TERMINATION as EOF.
(read_from_session_record_port) [!USING_GUILE_BEFORE_2_2]: Likewise.
* guile/tests/premature-termination.scm: New file.
* guile/Makefile.am (TESTS): Add it.
* NEWS: Update.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

4 files changed, 112 insertions, 4 deletions

diff --git a/NEWS b/NEWS
index 0c0835e4f6..38356f4c70 100644
--- a/NEWS
+++ b/NEWS
@@ -16,6 +16,18 @@ See the end for copying conditions.
 ** API and ABI modifications:
 gnutls_fips140_run_self_tests: New function
 
+** guile: Session record port treats premature termination as EOF
+
+Previously, a ‘gnutls-error’ exception with the
+‘error/premature-termination’ value would be thrown while reading from a
+session record port when the underlying session was terminated
+prematurely.  This was inconvenient since users of the port may not be
+prepared to handle such an exception.
+
+Reading from the session record port now returns the end-of-file object
+instead of throwing an exception, just like it would for a proper
+session termination.
+
 * Version 3.7.6 (released 2022-05-27)
 
 ** libgnutls: Fixed invalid write when gnutls_realloc_zero()
diff --git a/guile/Makefile.am b/guile/Makefile.am
index 4f82a9fa9d..1b9c03a93a 100644
--- a/guile/Makefile.am
+++ b/guile/Makefile.am
@@ -1,5 +1,5 @@
 #  GnuTLS --- Guile bindings for GnuTLS.
-#  Copyright (C) 2007-2012, 2016, 2019 Free Software Foundation, Inc.
+#  Copyright (C) 2007-2012, 2016, 2019, 2022 Free Software Foundation, Inc.
 #
 #  GnuTLS is free software; you can redistribute it and/or
 #  modify it under the terms of the GNU Lesser General Public
@@ -109,6 +109,7 @@ TESTS =						\
   tests/x509-certificates.scm			\
   tests/x509-auth.scm				\
   tests/reauth.scm				\
+  tests/premature-termination.scm		\
   tests/priorities.scm
 
 if ENABLE_SRP
diff --git a/guile/src/core.c b/guile/src/core.c
index b1dad0777f..4f2e3e3f92 100644
--- a/guile/src/core.c
+++ b/guile/src/core.c
@@ -925,7 +925,7 @@ do_fill_port (void *data)
       c_port->read_end = c_port->read_buf + result;
       chr = (int) *c_port->read_buf;
     }
-  else if (result == 0)
+  else if (result == 0 || result == GNUTLS_E_PREMATURE_TERMINATION)
     chr = EOF;
   else
     scm_gnutls_error (result, "fill_session_record_port_input");
@@ -1066,8 +1066,11 @@ read_from_session_record_port (SCM port, SCM dst, size_t start, size_t count)
     /* Tell Guile that reading would block.  */
     return (size_t) -1;
 
-  if (EXPECT_FALSE (result < 0))
-    /* FIXME: Silently swallowed! */
+  if (result == GNUTLS_E_PREMATURE_TERMINATION)
+    /* Treat premature termination as EOF instead of throwing an exception
+       that users of the port may not be prepared to handle.  */
+    result = 0;
+  else if (EXPECT_FALSE (result < 0))
     scm_gnutls_error (result, FUNC_NAME);
 
   return result;
diff --git a/guile/tests/premature-termination.scm b/guile/tests/premature-termination.scm
new file mode 100644
index 0000000000..4c17da3ded
--- /dev/null
+++ b/guile/tests/premature-termination.scm
@@ -0,0 +1,92 @@
+;;; GnuTLS --- Guile bindings for GnuTLS.
+;;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;;
+;;; GnuTLS is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2.1 of the License, or (at your option) any later version.
+;;;
+;;; GnuTLS is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with GnuTLS; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+;;; Written by Ludovic Courtès <ludo@chbouib.org>.
+
+
+;;;
+;;; Test handling of premature session termination on the client side while
+;;; reading from a session record port.
+;;;
+
+(use-modules (gnutls)
+             (gnutls build tests)
+             (srfi srfi-4))
+
+;; TLS session settings.
+(define priorities
+  "NONE:+VERS-TLS1.2:+CIPHER-ALL:+MAC-ALL:+SIGN-ALL:+COMP-ALL:+ANON-DH")
+
+;; Message sent by the client.
+(define %message (apply u8vector (iota 256)))
+
+(define (import-something import-proc file fmt)
+  (let* ((path (search-path %load-path file))
+         (size (stat:size (stat path)))
+         (raw  (make-u8vector size)))
+    (uniform-vector-read! raw (open-input-file path))
+    (import-proc raw fmt)))
+
+(define (import-dh-params file)
+  (import-something pkcs3-import-dh-parameters file
+                    x509-certificate-format/pem))
+
+;; Debugging.
+;; (set-log-level! 100)
+;; (set-log-procedure! (lambda (level str)
+;;                       (format #t "[~a|~a] ~a" (getpid) level str)))
+
+(run-test
+ (lambda ()
+   (let ((socket-pair (socketpair PF_UNIX SOCK_STREAM 0)))
+     (with-child-process pid
+       ;; server-side
+       (let ((server (make-session connection-end/server)))
+         (close-port (car socket-pair))           ;close the client end
+         (set-session-priorities! server priorities)
+         (set-session-transport-fd! server (fileno (cdr socket-pair)))
+         (let ((cred (make-anonymous-server-credentials))
+               (dh-params (import-dh-params "dh-parameters.pem")))
+           ;; Note: DH parameter generation can take some time.
+           (set-anonymous-server-dh-parameters! cred dh-params)
+           (set-session-credentials! server cred))
+         (set-session-dh-prime-bits! server 1024)
+
+         (handshake server)
+
+         (alarm 60)                               ;time out after a while
+         (close-port (cdr socket-pair))           ;close prematurely
+         (zero? (cdr (waitpid pid))))
+
+       ;; client-side (child process)
+       (let ((client (make-session connection-end/client)))
+         (close-port (cdr socket-pair))           ;close the server end
+         (set-session-priorities! client priorities)
+         (set-session-server-name! client
+                                   server-name-type/dns (gethostname))
+         (set-session-transport-fd! client (port->fdes (car socket-pair)))
+         (set-session-credentials! client (make-anonymous-client-credentials))
+         (set-session-dh-prime-bits! client 1024)
+
+         (handshake client)
+
+         ;; Read from the session record port: instead of getting an
+         ;; 'error/premature-termination' exception, we expect to get EOF.
+         (let* ((port (session-record-port client))
+                (read (read port)))
+           (format #t "client received ~s~%" read)
+           (primitive-exit (if (eof-object? read) 0 1))))))))