[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-204-g5ecc5
From: |
Mark H Weaver |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-204-g5ecc581 |
Date: |
Wed, 12 Feb 2014 16:24:32 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=5ecc58113a0a50d7a5840e9bfccce25b4f8b30ce
The branch, stable-2.0 has been updated
via 5ecc58113a0a50d7a5840e9bfccce25b4f8b30ce (commit)
from b61025ce0f6f14541b23d93f14dfc60022b91ad6 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 5ecc58113a0a50d7a5840e9bfccce25b4f8b30ce
Author: Mark H Weaver <address@hidden>
Date: Tue Feb 4 12:18:22 2014 -0500
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.
* doc/ref/api-evaluation.texi (REPL Servers): Add a caveat to the manual
entry for 'stop-servers-and-clients!'.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-evaluation.texi | 4 ++
module/system/repl/server.scm | 98 +++++++++++++++++++++++++++++++----------
2 files changed, 78 insertions(+), 24 deletions(-)
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 7d67d9a..d3e6c8c 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -1279,6 +1279,10 @@ with no arguments.
@deffn {Scheme Procedure} stop-server-and-clients!
Closes the connection on all running server sockets.
+
+Please note that in the current implementation, the REPL threads are
+cancelled without unwinding their stacks. If any of them are holding
+mutexes or are within a critical section, the results are unspecified.
@end deffn
@c Local Variables:
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index 4f3391c..5fefa77 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -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)
#:export (make-tcp-server-socket
make-unix-domain-server-socket
run-server
spawn-server
stop-server-and-clients!))
+;; 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)
(with-mutex sockets-lock
- (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.
(close-port s))
-(define (add-open-socket! s)
+(define (add-open-socket! s force-close)
(with-mutex sockets-lock
- (set! *open-sockets* (cons s *open-sockets*))))
+ (set! *open-sockets* (acons s force-close *open-sockets*))))
(define (stop-server-and-clients!)
(cond
((with-mutex sockets-lock
- (and (pair? *open-sockets*)
- (car *open-sockets*)))
- => (lambda (s)
- (close-socket! s)
+ (match *open-sockets*
+ (() #f)
+ (((s . force-close) . rest)
+ (set! *open-sockets* rest)
+ force-close)))
+ => (lambda (force-close)
+ (force-close)
(stop-server-and-clients!)))))
(define* (make-tcp-server-socket #:key
@@ -67,37 +76,79 @@
(bind sock AF_UNIX path)
sock))
+;; List of errno values from 'select' or 'accept' that should lead to a
+;; retry in 'run-server'.
+(define errs-to-retry
+ (delete-duplicates
+ (filter-map (lambda (name)
+ (and=> (module-variable the-root-module name)
+ variable-ref))
+ '(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
+ shutdown-read-pipe))
+
(define (accept-new-client)
(catch #t
- (lambda () (accept server-socket))
- (lambda (k . args)
- (cond
- ((port-closed? server-socket)
- ;; Shutting down.
- #f)
- (else
- (warn "Error accepting client" k args)
- ;; Retry after a timeout.
- (sleep 1)
- (accept-new-client))))))
-
+ (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)))
+ (cond
+ ((memv err errs-to-retry)
+ (accept-new-client))
+ (else
+ (warn "Error accepting client" k-args)
+ ;; Retry after a timeout.
+ (sleep 1)
+ (accept-new-client)))))))
+
+ ;; 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.
(if client
(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))))
+
(with-continuation-barrier
(lambda ()
(parameterize ((current-input-port client)
@@ -105,5 +156,4 @@
(current-error-port client)
(current-warning-port client))
(with-fluids ((*repl-stack* '()))
- (start-repl)))))
- (close-socket! client))
+ (start-repl))))))
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-204-g5ecc581,
Mark H Weaver <=