bug#24818: Clean up socket files set up by --listen=/path/to/socket-file

[Christopher Allan Webber]

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 <address@hidden>
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