Andy Wingo writes: > I agree :) Thanks for the patch! > > The patch goes in a direction that I'm a bit hesitant about though -- > this command-line processing is getting a bit intense. Would it be > possible to add a #:cleanup? argument to the spawn-server function > instead?
I agree that my previous patch makes things more complicated, so I tried the route you suggested, but... > My only doubt would be whether all threads unwind when the program > ends. (And if they don't, is that a bug? I am not sure but I would > guess so; dunno.) ... and it doesn't seem to work for that reason. The thread never seems to unwind. I put a print statement (not in this patch) at the very part of the out guard but it never seems to run. Too bad... So I guess the question is whether or not addressing the thread issue as a potential bug should be done or applying the previous patch version which worked but made the command line processing more complex? Or something else?
From 79ab483a872638abe311c521c3467c060566b39c Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <cweb...@dustycloud.org>
Date: Wed, 8 Mar 2017 12:04:55 -0600
Subject: [PATCH] Clean up socket file set up by --listen
[Unfortunately, this patch does not work because the thread doesn't seem
to unwind. Submitted for demonstrative purposes, or in the hope that
could be fixed.]
* module/ice-9/command-line.scm (compile-shell-switches):
* module/system/repl/server.scm (run-server, run-server*, spawn-server):
Clean up socket file set up by --listen on exit, if it exists.
---
module/ice-9/command-line.scm | 3 ++-
module/system/repl/server.scm | 44 +++++++++++++++++++++++++++----------------
2 files changed, 30 insertions(+), 17 deletions(-)
diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm
index 98d385569..3305c671d 100644
--- a/module/ice-9/command-line.scm
+++ b/module/ice-9/command-line.scm
@@ -388,7 +388,8 @@ If FILE begins with `-' the -s switch is mandatory.
(error "invalid port for --listen"))))
((string-prefix? "/" where) ; --listen=/PATH/TO/SOCKET
`((@@ (system repl server) spawn-server)
- ((@@ (system repl server) make-unix-domain-server-socket) #:path ,where)))
+ ((@@ (system repl server) make-unix-domain-server-socket) #:path ,where)
+ #:cleanup? #t))
(else
(error "unknown argument to --listen"))))
out)))
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index 725eb4eda..1ced8e8d1 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -21,6 +21,7 @@
(define-module (system repl server)
#:use-module (system repl repl)
+ #:use-module (ice-9 and-let-star)
#:use-module (ice-9 threads)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
@@ -84,11 +85,12 @@
(bind sock AF_UNIX path)
sock))
-(define* (run-server #:optional (server-socket (make-tcp-server-socket)))
- (run-server* server-socket serve-client))
+(define* (run-server #:optional (server-socket (make-tcp-server-socket))
+ #:key (cleanup? #f))
+ (run-server* server-socket serve-client #:cleanup? cleanup?))
;; Note: although not exported, this is used by (system repl coop-server)
-(define (run-server* server-socket serve-client)
+(define* (run-server* server-socket serve-client #:key (cleanup? #f))
;; We use a pipe to notify the server when it should shut down.
(define shutdown-pipes (pipe))
(define shutdown-read-pipe (car shutdown-pipes))
@@ -122,19 +124,29 @@
(sigaction SIGPIPE SIG_IGN)
(add-open-socket! server-socket shutdown-server)
(listen server-socket 5)
- (let lp ()
- (match (accept-new-client)
- (#f
- ;; If client is false, we are shutting down.
- (close shutdown-write-pipe)
- (close shutdown-read-pipe)
- (close server-socket))
- ((client-socket . client-addr)
- (make-thread serve-client client-socket client-addr)
- (lp)))))
-
-(define* (spawn-server #:optional (server-socket (make-tcp-server-socket)))
- (make-thread run-server server-socket))
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (let lp ()
+ (match (accept-new-client)
+ (#f
+ ;; If client is false, we are shutting down.
+ (close shutdown-write-pipe)
+ (close shutdown-read-pipe)
+ (close server-socket))
+ ((client-socket . client-addr)
+ (make-thread serve-client client-socket client-addr)
+ (lp)))))
+ (lambda ()
+ (and-let* (cleanup?
+ (sa (getsockname server-socket))
+ (path (sockaddr:path sa))
+ ((file-exists? path)))
+ (delete-file path)))))
+
+(define* (spawn-server #:optional (server-socket (make-tcp-server-socket))
+ #:key (cleanup? #f))
+ (make-thread run-server server-socket #:cleanup? cleanup?))
(define (serve-client client addr)
--
2.11.0
signature.asc
Description: PGP signature
