[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] REPL Server: Fix 'stop-server-and-clients!'
Mark H Weaver
[PATCH] REPL Server: Fix 'stop-server-and-clients!'
Wed, 05 Feb 2014 03:02:55 -0500
David Thompson discovered that 'stop-server-and-clients!' can easily
lead to segfaults. That's because it closes sockets that other threads
This patch changes the way 'stop-server-and-clients!' works. Instead of
closing ports, it calls registered 'force-close' procedures for each
open socket, to close the sockets down cleanly.
For REPLs, the 'force-close' procedure calls 'cancel-thread' on the REPL
thread, and the thread cleanup handler closes the socket.
For the server socket listener, the 'force-close' procedure writes to a
pipe that's monitored by the listener thread. The server socket is put
into non-blocking mode, and 'select' is used to monitor both the socket
and the pipe. When data comes in on the pipe, the listener is shut down
Comments and suggestions welcome.
>From dfa53cef01474dfe19c977e22c4297f42c26c879 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Tue, 4 Feb 2014 12:18:22 -0500
Subject: [PATCH] REPL Server: Fix 'stop-server-and-clients!'.
* module/system/repl/server.scm: Import (ice-9 match) and (srfi srfi-1).
(*open-sockets*): Add comment. This is now a list of pairs with a
'force-close' procedure in the cdr.
(close-socket!): Add comment noting that it is unsafe to call this
from another thread.
(add-open-socket!): Add 'force-close' argument, and put it in the cdr
of the '*open-sockets*' entry.
(stop-server-and-clients!): Use 'match'. Remove the first element
from *open-sockets* immediately. Call the 'force-close' procedure
instead of 'close-socket!'.
(errs-to-retry): New variable.
(run-server): Add a pipe, used in the 'force-close' procedure to
cleanly shut down the server. Put the server socket into non-blocking
mode. Use 'select' to monitor both the server socket and the pipe.
Don't call 'add-open-socket!' on the client-socket. Close the pipe
and the server socket cleanly when we're asked to shut down.
(serve-client): Call 'add-open-socket!' with a 'force-close' procedure
that cancels the thread. Set the thread cleanup handler to call
'close-socket!', instead of calling it in the main body.
module/system/repl/server.scm | 98 +++++++++++++++++++++++++++++++----------
1 files changed, 74 insertions(+), 24 deletions(-)
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index 4f3391c..5fefa77 100644
@@ -22,34 +22,43 @@
(define-module (system repl server)
#:use-module (system repl repl)
#:use-module (ice-9 threads)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+;; List of pairs of the form (SOCKET . FORCE-CLOSE), where SOCKET is a
+;; socket port, and FORCE-CLOSE is a thunk that forcefully shuts down
+;; the socket.
(define *open-sockets* '())
(define sockets-lock (make-mutex))
+;; WARNING: it is unsafe to call 'close-socket!' from another thread.
(define (close-socket! s)
- (set! *open-sockets* (delq! s *open-sockets*)))
+ (set! *open-sockets* (assq-remove! *open-sockets* s)))
;; Close-port could block or raise an exception flushing buffered
;; output. Hmm.
-(define (add-open-socket! s)
+(define (add-open-socket! s force-close)
- (set! *open-sockets* (cons s *open-sockets*))))
+ (set! *open-sockets* (acons s force-close *open-sockets*))))
- (and (pair? *open-sockets*)
- (car *open-sockets*)))
- => (lambda (s)
- (close-socket! s)
+ (match *open-sockets*
+ (() #f)
+ (((s . force-close) . rest)
+ (set! *open-sockets* rest)
+ => (lambda (force-close)
(define* (make-tcp-server-socket #:key
@@ -67,37 +76,79 @@
(bind sock AF_UNIX path)
+;; List of errno values from 'select' or 'accept' that should lead to a
+;; retry in 'run-server'.
+ (filter-map (lambda (name)
+ (and=> (module-variable the-root-module name)
+ '(EINTR EAGAIN EWOULDBLOCK))))
(define* (run-server #:optional (server-socket (make-tcp-server-socket)))
+ ;; We use a pipe to notify the server when it should shut down.
+ (define shutdown-pipes (pipe))
+ (define shutdown-read-pipe (car shutdown-pipes))
+ (define shutdown-write-pipe (cdr shutdown-pipes))
+ ;; 'shutdown-server' is called by 'stop-server-and-clients!'.
+ (define (shutdown-server)
+ (display #\! shutdown-write-pipe)
+ (force-output shutdown-write-pipe))
+ (define monitored-ports
+ (list server-socket
- (lambda () (accept server-socket))
- (lambda (k . args)
- ((port-closed? server-socket)
- ;; Shutting down.
- (warn "Error accepting client" k args)
- ;; Retry after a timeout.
- (sleep 1)
+ (lambda ()
+ (let ((ready-ports (car (select monitored-ports '() '()))))
+ ;; If we've been asked to shut down, return #f.
+ (and (not (memq shutdown-read-pipe ready-ports))
+ (accept server-socket))))
+ (lambda k-args
+ (let ((err (system-error-errno k-args)))
+ ((memv err errs-to-retry)
+ (warn "Error accepting client" k-args)
+ ;; Retry after a timeout.
+ (sleep 1)
+ ;; Put the socket into non-blocking mode.
+ (fcntl server-socket F_SETFL
+ (logior O_NONBLOCK
+ (fcntl server-socket F_GETFL)))
(sigaction SIGPIPE SIG_IGN)
- (add-open-socket! server-socket)
+ (add-open-socket! server-socket shutdown-server)
(listen server-socket 5)
(let lp ((client (accept-new-client)))
;; If client is false, we are shutting down.
(let ((client-socket (car client))
(client-addr (cdr client)))
- (add-open-socket! client-socket)
(make-thread serve-client client-socket client-addr)
- (lp (accept-new-client))))))
+ (lp (accept-new-client)))
+ (begin (close shutdown-write-pipe)
+ (close shutdown-read-pipe)
+ (close server-socket)))))
(define* (spawn-server #:optional (server-socket (make-tcp-server-socket)))
(make-thread run-server server-socket))
(define (serve-client client addr)
+ (let ((thread (current-thread)))
+ ;; Close the socket when this thread exits, even if canceled.
+ (set-thread-cleanup! thread (lambda () (close-socket! client)))
+ ;; Arrange to cancel this thread to forcefully shut down the socket.
+ (add-open-socket! client (lambda () (cancel-thread thread))))
(parameterize ((current-input-port client)
@@ -105,5 +156,4 @@
(with-fluids ((*repl-stack* '()))
- (close-socket! client))
|[Prev in Thread]
||[Next in Thread]|
- [PATCH] REPL Server: Fix 'stop-server-and-clients!',
Mark H Weaver <=