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

Previous Next

To reply to this bug, email your comments to 24818 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Christopher Allan Webber <cwebber <at> dustycloud.org>
To: bug-guile <at> gnu.org
Subject: Clean up socket files set up by --listen=/path/to/socket-file
Date: Sat, 29 Oct 2016 11:38:23 -0500

[Message part 1 (text/plain, inline)]

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

[0001-Clean-up-socket-file-set-up-by-listen.patch (text/x-patch, inline)]

From 12a1c24890448ec9a2d33cabff7f70f6332dbb4f Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <cwebber <at> dustycloud.org>
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 `-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)))
+          (lambda ()
+            (when (and ,clean-socket-file
+                       (file-exists? ,clean-socket-file))
+              (delete-file ,clean-socket-file))))))
 
       (if (pair? args)
           (begin
-- 
2.10.1

[signature.asc (application/pgp-signature, inline)]

Message #10 received at 24818 <at> debbugs.gnu.org (full text, mbox):

From: Andy Wingo <wingo <at> pobox.com>
To: Christopher Allan Webber <cwebber <at> dustycloud.org>
Cc: 24818 <at> debbugs.gnu.org
Subject: Re: bug#24818: Clean up socket files set up by
 --listen=/path/to/socket-file
Date: Wed, 01 Mar 2017 14:34:29 +0100

On Sat 29 Oct 2016 18:38, Christopher Allan Webber <cwebber <at> dustycloud.org> 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

Message #13 received at 24818 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Allan Webber <cwebber <at> dustycloud.org>
To: Andy Wingo <wingo <at> pobox.com>
Cc: 24818 <at> debbugs.gnu.org
Subject: Re: bug#24818: Clean up socket files set up by
 --listen=/path/to/socket-file
Date: Wed, 08 Mar 2017 13:40:16 -0600

[Message part 1 (text/plain, inline)]

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?

[0001-Clean-up-socket-file-set-up-by-listen.patch (text/x-patch, inline)]

From 79ab483a872638abe311c521c3467c060566b39c Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <cwebber <at> 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 (application/pgp-signature, inline)]

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.