diff options
-rw-r--r-- | NEWS | 9 | ||||
-rw-r--r-- | guile/modules/gnutls.in | 1 | ||||
-rw-r--r-- | guile/src/core.c | 104 | ||||
-rw-r--r-- | guile/tests/session-record-port.scm | 17 |
4 files changed, 122 insertions, 9 deletions
@@ -33,6 +33,15 @@ session termination. ** guile: Guile 1.8 is no longer supported +** guile: Session record ports can have a ‘close’ procedure. + + The ‘session-record-port’ procedure now takes an optional second + parameter, and a new ‘set-session-record-port-close!’ procedure is + provided to specify a ‘close’ procedure for a session record port. + This ‘close’ procedure lets users specify cleanup operations for when + the port is closed, such as closing the file descriptor or port that + backs the underlying session. + * Version 3.7.6 (released 2022-05-27) ** libgnutls: Fixed invalid write when gnutls_realloc_zero() diff --git a/guile/modules/gnutls.in b/guile/modules/gnutls.in index 7f59bbf401..67f0a29a02 100644 --- a/guile/modules/gnutls.in +++ b/guile/modules/gnutls.in @@ -96,6 +96,7 @@ ;; record layer record-send record-receive! session-record-port + set-session-record-port-close! ;; debugging set-log-procedure! set-log-level! diff --git a/guile/src/core.c b/guile/src/core.c index 03d3f833e8..6a35caecdf 100644 --- a/guile/src/core.c +++ b/guile/src/core.c @@ -842,7 +842,36 @@ static scm_t_port_type *session_record_port_type; /* Return the session associated with PORT. */ #define SCM_GNUTLS_SESSION_RECORD_PORT_SESSION(_port) \ - (SCM_PACK (SCM_STREAM (_port))) + (SCM_CAR (SCM_PACK (SCM_STREAM (_port)))) + +/* Return the 'close' procedure associated with PORT or #f if there is + none. */ +#define SCM_GNUTLS_SESSION_RECORD_PORT_CLOSE_PROCEDURE(_port) \ + (SCM_CDR (SCM_PACK (SCM_STREAM (_port)))) + +/* Set PROC as the 'close' procedure of PORT. */ +#define SCM_GNUTLS_SET_SESSION_RECORD_PORT_CLOSE(_port, _proc) \ + (SCM_SETCDR (SCM_PACK (SCM_STREAM (_port)), (_proc))) + +#if !USING_GUILE_BEFORE_2_2 + +/* Return true if PORT is a session record port. */ +# define SCM_GNUTLS_SESSION_RECORD_PORT_P(_port) \ + (SCM_PORTP (_port) \ + && SCM_PORT_TYPE (_port) == session_record_port_type) + +#else /* USING_GUILE_BEFORE_2_2 */ + +# define SCM_GNUTLS_SESSION_RECORD_PORT_P(_port) \ + (SCM_PORTP (_port) \ + && SCM_TYP16 (_port) == session_record_port_type) + +#endif + +/* Raise a wrong-type-arg exception if PORT is not a session record port. */ +#define SCM_VALIDATE_SESSION_RECORD_PORT(pos, port) \ + SCM_MAKE_VALIDATE_MSG (pos, port, GNUTLS_SESSION_RECORD_PORT_P, \ + "session record port") /* Size of a session port's input buffer. */ #define SCM_GNUTLS_SESSION_RECORD_PORT_BUFFER_SIZE 4096 @@ -977,7 +1006,7 @@ make_session_record_port (SCM session) SCM_SET_CELL_TYPE (port, session_record_port_type | mode_bits); /* Associate it with SESSION. */ - SCM_SETSTREAM (port, SCM_UNPACK (session)); + SCM_SETSTREAM (port, SCM_UNPACK (scm_cons (session, SCM_BOOL_F))); c_port->read_pos = c_port->read_end = c_port->read_buf = c_port_buf; c_port->read_buf_size = SCM_GNUTLS_SESSION_RECORD_PORT_BUFFER_SIZE; @@ -1088,18 +1117,51 @@ make_session_record_port (SCM session) { return scm_c_make_port (session_record_port_type, SCM_OPN | SCM_RDNG | SCM_WRTNG | SCM_BUF0, - SCM_UNPACK (session)); + SCM_UNPACK (scm_cons (session, SCM_BOOL_F))); } #endif /* !USING_GUILE_BEFORE_2_2 */ +/* Call PORT's close procedure, if any. */ +static +#if USING_GUILE_BEFORE_2_2 +int +#else +void +#endif +close_session_record_port (SCM port) +{ + SCM session = SCM_GNUTLS_SESSION_RECORD_PORT_SESSION (port); + SCM close = SCM_GNUTLS_SESSION_RECORD_PORT_CLOSE_PROCEDURE (port); -SCM_DEFINE (scm_gnutls_session_record_port, "session-record-port", 1, 0, 0, - (SCM session), + if (!scm_is_false (close)) + scm_call_1 (close, port); + + /* When called during finalization (as opposed to a 'close-port' call), + SESSION might be finalized already. Check whether this is the case. */ + if (scm_is_true (scm_gnutls_session_p (session))) + { + /* Detach SESSION from PORT. */ + gnutls_session_t c_session; + c_session = scm_to_gnutls_session (session, 1, __func__); + SCM_GNUTLS_SET_SESSION_RECORD_PORT (c_session, SCM_BOOL_F); + } + +#if USING_GUILE_BEFORE_2_2 + return 0; +#endif +} + +SCM_DEFINE (scm_gnutls_session_record_port, "session-record-port", 1, 1, 0, + (SCM session, SCM close), "Return a read-write port that may be used to communicate over " "@var{session}. All invocations of @code{session-port} on a " "given session return the same object (in the sense of " - "@code{eq?}).") + "@code{eq?}).\n\n" + "If @var{close} is provided, it must be a one-argument " + "procedure, and it will be called when the returned port is " + "closed. This is equivalent to setting it by calling " + "@code{set-session-record-port-close!}.") #define FUNC_NAME s_scm_gnutls_session_record_port { SCM port; @@ -1115,11 +1177,33 @@ SCM_DEFINE (scm_gnutls_session_record_port, "session-record-port", 1, 0, 0, SCM_GNUTLS_SET_SESSION_RECORD_PORT (c_session, port); } + if (!scm_is_eq (close, SCM_UNDEFINED)) + SCM_GNUTLS_SET_SESSION_RECORD_PORT_CLOSE (port, close); + return (port); } #undef FUNC_NAME +SCM_DEFINE (scm_gnutls_set_session_record_port_close_x, + "set-session-record-port-close!", 2, 0, 0, + (SCM port, SCM close), + "Set @var{close}, a one-argument procedure, as the procedure " + "called when @var{port} is closed. @var{close} will be passed " + "@var{port}. It may be called when @code{close-port} is " + "called on @var{port}, or when @var{port} is garbage-collected. " + "It is a useful way to free resources associated with @var{port} " + "such as the session's transport file descriptor or port.") +#define FUNC_NAME s_scm_gnutls_set_session_record_port_close_x +{ + SCM_VALIDATE_SESSION_RECORD_PORT (1, port); + SCM_VALIDATE_PROC (2, close); + + SCM_GNUTLS_SET_SESSION_RECORD_PORT_CLOSE (port, close); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + /* Create the session port type. */ static void scm_init_gnutls_session_record_port_type (void) @@ -1133,6 +1217,14 @@ scm_init_gnutls_session_record_port_type (void) #endif write_to_session_record_port); + scm_set_port_close (session_record_port_type, + close_session_record_port); + +#if !USING_GUILE_BEFORE_2_2 + /* Invoke the user-provided 'close' procedure on GC. */ + scm_set_port_needs_close_on_gc (session_record_port_type, 1); +#endif + #if !USING_GUILE_BEFORE_2_2 scm_set_port_read_wait_fd (session_record_port_type, session_record_port_fd); diff --git a/guile/tests/session-record-port.scm b/guile/tests/session-record-port.scm index 0b8ca9d47a..6a7ec035d0 100644 --- a/guile/tests/session-record-port.scm +++ b/guile/tests/session-record-port.scm @@ -1,5 +1,5 @@ ;;; GnuTLS --- Guile bindings for GnuTLS. -;;; Copyright (C) 2007-2012, 2014, 2016 Free Software Foundation, Inc. +;;; Copyright (C) 2007-2012, 2014, 2016, 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 @@ -60,7 +60,7 @@ (for-each session-record-port sessions) (gc)(gc)(gc)) - ;; Stress the GC. The session associated to each port in PORTS should + ;; Stress the GC. The session associated with each port in PORTS should ;; remain reachable. (let ((ports (map session-record-port (map (lambda (i) @@ -104,7 +104,18 @@ (= amount (u8vector-length %message)) (equal? buf %message) (eof-object? - (read-char (session-record-port server)))))) + (read-char (session-record-port server))) + + ;; Close the port and make sure its 'close' procedure is + ;; called. + (let* ((closed? #f) + (port (session-record-port server)) + (close (lambda (p) + (format #t "closing port ~s~%" p) + (set! closed? (eq? p port))))) + (set-session-record-port-close! port close) + (close-port port) + closed?)))) ;; client-side (child process) (let ((client (make-session connection-end/client))) |