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

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

[Andy Wingo]

On Sat 29 Oct 2016 18:38, Christopher Allan Webber  
writes:

> In light of the recent security vulnerability on using localhost + port,
> I've been using socket files for live hacking.  Unfortunately, these
> socket files stay around after closing guile, which means this can happen:
>
>   $ guile --listen=/tmp/guile-socket
>   scheme@(guile-user)> ,q
>   $ guile --listen=/tmp/guile-socket
>   ERROR: In procedure bind:
>   ERROR: In procedure bind: Address already in use
>
> That's not very nice!  I really don't like having to clean up these
> files by hand Guile should do it for me.

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?  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.)

Andy

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

[Christopher Allan Webber]

In light of the recent security vulnerability on using localhost + port,
I've been using socket files for live hacking.  Unfortunately, these
socket files stay around after closing guile, which means this can happen:

  $ guile --listen=/tmp/guile-socket
  scheme@(guile-user)> ,q
  $ guile --listen=/tmp/guile-socket
  ERROR: In procedure bind:
  ERROR: In procedure bind: Address already in use

That's not very nice!  I really don't like having to clean up these
files by hand Guile should do it for me.

Fortunately, here's a patch that does just that!  It uses dynamic-wind
and cleans up the socket file, if it exists.  (But it doesn't break if
it doesn't!)

From 12a1c24890448ec9a2d33cabff7f70f6332dbb4f Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber 
Date: Sat, 29 Oct 2016 11:28:05 -0500
Subject: [PATCH] Clean up socket file set up by --listen

* module/ice-9/command-line.scm (compile-shell-switches):
  Clean up socket file set up by --listen on exit, if it exists.
---
 module/ice-9/command-line.scm | 80 ---
 1 file changed, 44 insertions(+), 36 deletions(-)

diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm
index 98d3855..cdc5427 100644
--- a/module/ice-9/command-line.scm
+++ b/module/ice-9/command-line.scm
@@ -199,6 +199,7 @@ If FILE begins with `-' the -s switch is mandatory.
 (user-load-compiled-path '())
 (user-extensions '())
 (interactive? #t)
+(clean-socket-file #f)
 (inhibit-user-init? #f)
 (turn-on-debugging? #f)
 (turn-off-debugging? #f))
@@ -387,6 +388,7 @@ If FILE begins with `-' the -s switch is mandatory.
  ((@@ (system repl server) make-tcp-server-socket) #:port ,port))
(error "invalid port for --listen"
  ((string-prefix? "/" where) ; --listen=/PATH/TO/SOCKET
+  (set! clean-socket-file where)
   `((@@ (system repl server) spawn-server)
 ((@@ (system repl server) make-unix-domain-server-socket) #:path ,where)))
  (else
@@ -430,42 +432,48 @@ If FILE begins with `-' the -s switch is mandatory.
   `(;; It would be nice not to load up (ice-9 control), but the
 ;; default-prompt-handler is nontrivial.
 (@ (ice-9 control) %)
-(begin
-  ;; If we didn't end with a -c or a -s and didn't supply a -q, load
-  ;; the user's customization file.
-  ,@(if (and interactive? (not inhibit-user-init?))
-'((load-user-init))
-'())
-
-  ;; Use-specified extensions.
-  ,@(map (lambda (ext)
-   `(set! %load-extensions (cons ,ext %load-extensions)))
- user-extensions)
-
-  ;; Add the user-specified load paths here, so they won't be in
-  ;; effect during the loading of the user's customization file.
-  ,@(map (lambda (path)
-   `(set! %load-path (cons ,path %load-path)))
- user-load-path)
-  ,@(map (lambda (path)
-   `(set! %load-compiled-path
-  (cons ,path %load-compiled-path)))
- user-load-compiled-path)
-
-  ;; Put accumulated actions in their correct order.
-  ,@(reverse! out)
-
-  ;; Handle the `-e' switch, if it was specified.
-  ,@(if entry-point
-`((,entry-point (command-line)))
-'())
-  ,(if interactive?
-   ;; If we didn't end with a -c or a -s, start the
-   ;; repl.
-   '((@ (ice-9 top-repl) top-repl))
-   ;; Otherwise, after doing all the other actions
-   ;; prescribed by the command line, quit.
-   '(quit)
+(dynamic-wind
+  (const #f) ; no-op
+  (lambda ()
+;; If we didn't end with a -c or a -s and didn't supply a -q, load
+;; the user's customization file.
+,@(if (and interactive? (not inhibit-user-init?))
+  '((load-user-init))
+  '())
+
+;; Use-specified extensions.
+,@(map (lambda (ext)
+ `(set! %load-extensions (cons ,ext %load-extensions)))
+   user-extensions)
+
+;; Add the user-specified load paths here, so they won't be in
+;; effect during the loading of the user's customization file.
+,@(map (lambda (path)
+ `(set! %load-path (cons ,path %load-path)))
+   user-load-path)
+,@(map (lambda (path)
+ `(set! %load-compiled-path
+(cons ,path %load-compiled-path)))
+   user-load-compiled-path)
+
+;; Put accumulated actions in their correct order.
+,@(reverse! out)
+
+;; Handle the