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
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
