bug#24819: Intermittent 00-repl-server.test failure in 2.0.13

[Rob Browning]

merge 24819 24769
thanks

Rob Browning  writes:

> I noticed that 00-repl-server.test had failed on some of the debian
> buildds like this:
>
>   Running 00-initial-env.test
>   Running 00-repl-server.test
>   FAIL: 00-repl-server.test: repl-server: simple expression - arguments: 
> (expected-value "scheme@(repl-server)> $1 = 42\n" actual-value "$1 = 42\n")

Looks like these two bugs refer to the same problem.

Thanks
-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

bug#24819: Intermittent 00-repl-server.test failure in 2.0.13

[Rob Browning]

I noticed that 00-repl-server.test had failed on some of the debian
buildds like this:

  Running 00-initial-env.test
  Running 00-repl-server.test
  FAIL: 00-repl-server.test: repl-server: simple expression - arguments: 
(expected-value "scheme@(repl-server)> $1 = 42\n" actual-value "$1 = 42\n")

After suspecting some kind of race, it turns out that I can reproduce
the failure locally (eventually) like this:

  cd test-suite
  while GUILE_LOAD_PATH=. \
./guile-test tests/00-initial-env.test tests/00-repl-server.test
  do
:
  done

I don't know what's causing the trouble yet, but I augmented
read-until-prompt to print every line it reads to stderr, and nothing
appeared amiss there, at least.

Thanks
-- 
Rob Browning
rlb @defaultvalue.org and @debian.org
GPG as of 2011-07-10 E6A9 DA3C C9FD 1FF8 C676 D2C4 C0F0 39E9 ED1B 597A
GPG as of 2002-11-03 14DD 432F AE39 534D B592 F9A0 25C8 D377 8C7E 73A4

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 

bug#24816: Bug in (rnrs io ports) procedure open-string-output-port

[Freja Nordsiek]

The "open-string-output-port" procedure in (rnrs io ports) returns two
values, a string port and a thunk that returns a string of the
characters written to the port so far. In the R6RS standard documents,
the reading procedure is destructive, in that it clears all the
characters written to the port so far (though, it does not close it,
so it can still be used). However, in Guile 2.1.4, the characters are
not cleared and so running the thunk again immediately afterwards will
produce the same output, which is a bug.

This can be tested running the following script


(import (rnrs base (6))
(rnrs io ports (6))
(rnrs io simple (6)))

(let-values (((p get-output) (open-string-output-port)))
  (display "hello" p)
  (flush-output-port p)
  (let ((out-first (get-output)))
(let ((out-second (get-output)))
  (display (string-append "Follows R6RS: "
  (if (string=? out-first out-second)
  "no"
  "yes")))
  (newline)
  (display (string-append "out-first: " out-first))
  (newline)
  (display (string-append "out-second: " out-second))
  (newline


which produces the following output in guile


Follows R6RS: no
out-first: hello
out-second: hello


when it should output



Follows R6RS: yes
out-first: hello
out-second:


instead.




Freja Nordsiek