Test failures when networking is disabled

  • Open
  • quality assurance status badge
Details
3 participants
  • Cyprien Nicolas
  • Ludovic Courtès
  • Michael Gran
Owner
unassigned
Submitted by
Cyprien Nicolas
Severity
normal

Debbugs page

Cyprien Nicolas wrote 6 years ago
(address . bug-guile@gnu.org)
52873187-7898-41ff-be3c-fd9fe2a8802b@nicolas.tf
Hello,

Guile's configure script offers an option to disable networking support,
but when disabled, some test won't pass.

-----8<-----8<-----8<-----8<-----8<-----
Running 00-repl-server.test
ERROR: 00-repl-server.test: repl-server: simple expression - arguments:
((unbound-variable #f "Unbound variable: ~S" (make-socket-address) #f))
ERROR: 00-repl-server.test: repl-server: HTTP inter-protocol attack -
arguments: ((unbound-variable #f "Unbound variable: ~S"
(make-socket-address) #f))
----->8----->8----->8----->8----->8-----

The error is obviously related to the configure option. I have a patch
for catching unbound-variable and throw unresolved instead, tested on
2.2 and 2.0 branches. Reference: https://bugs.gentoo.org/629004

That patch is enough for stable-2.0 but there is another failure in
suspendable-ports in 2.2.5, as the suspendable-ports ice-9 module
overrides accept and connect functions, missing when networking is disabled.

-----8<-----8<-----8<-----8<-----8<-----
$ guile-2.2
GNU Guile 2.2.5
Copyright (C) 1995-2019 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> (use-modules (ice-9 suspendable-ports))
While compiling expression:
In procedure public-lookup: No variable bound to accept in module (guile)
----->8----->8----->8----->8----->8-----

Is guile configured with --disable-networking still a supported
configuration?

Thanks,
Cyprien
Ludovic Courtès wrote 6 years ago
(name . Cyprien Nicolas)(address . cyprien@nicolas.tf)(address . 36340@debbugs.gnu.org)
878strb1pk.fsf@gnu.org
Hi Cyprien! :-)

Cyprien Nicolas <cyprien@nicolas.tf> skribis:

Toggle quote (3 lines)
> Is guile configured with --disable-networking still a supported
> configuration?

In theory yes, but as you found out, it’s not well tested.

The way we’d normally addressing in the test suite is by testing:

(provided? 'socket)

and/or:

(provided? 'net-db)

and throwing to unresolved or skipping tests altogether.

Would you like to propose a patch that does that for all the instances
that you found?

Thanks!

Ludo’.
Cyprien Nicolas wrote 6 years ago
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 36340@debbugs.gnu.org)
7983c7cd-8c1c-3d8e-f35e-6204880ffb4f@nicolas.tf
On 24/06/2019 14:35, Ludovic Courtès wrote:
Toggle quote (22 lines)
> Hi Cyprien! :-)
>
> Cyprien Nicolas <cyprien@nicolas.tf> skribis:
>
>> Is guile configured with --disable-networking still a supported
>> configuration?
>
> In theory yes, but as you found out, it’s not well tested.
>
> The way we’d normally addressing in the test suite is by testing:
>
> (provided? 'socket)
>
> and/or:
>
> (provided? 'net-db)
>
> and throwing to unresolved or skipping tests altogether.
>
> Would you like to propose a patch that does that for all the instances
> that you found?

Do you mean also harmonizing current tests that uses

(memq 'socket *features*) ; web-uri.test

and/or

(defined? 'AF_INET) ; 00-socket.test

or only fixing failing ones?

The attached path mimics net-db.test style for skipping tests for
00-repl-server.test (I hope the indentation is correct).

However, we still have the ice-9 suspendable-ports module issue which
compiles fine but fails to load (actually not related to tests).

Thanks,
--- guile-2.2.6/test-suite/tests/00-repl-server.test.old 2017-04-14 23:26:40.000000000 +0200
+++ guile-2.2.6/test-suite/tests/00-repl-server.test 2019-07-07 15:14:59.681831790 +0200
@@ -105,47 +105,48 @@
;;; Since we call 'primitive-fork', these tests must run before any
;;; tests that create threads.
-(with-test-prefix "repl-server"
+(if (provided? 'socket)
+ (with-test-prefix "repl-server"
- (pass-if-equal "simple expression"
- "scheme@(repl-server)> $1 = 42\n"
- (with-repl-server socket
- (read-until-prompt socket %last-line-before-prompt)
-
- ;; Wait until 'repl-reader' in boot-9 has written the prompt.
- ;; Otherwise, if we write too quickly, 'repl-reader' checks for
- ;; 'char-ready?' and doesn't print the prompt.
- (match (select (list socket) '() (list socket) 3)
- (((_) () ())
- (display "(+ 40 2)\n(quit)\n" socket)
- (read-string socket)))))
-
- (pass-if "HTTP inter-protocol attack" ;CVE-2016-8606
- (with-repl-server socket
- ;; Avoid SIGPIPE when the server closes the connection.
- (sigaction SIGPIPE SIG_IGN)
-
- (read-until-prompt socket %last-line-before-prompt)
-
- ;; Simulate an HTTP inter-protocol attack.
- (write-request (build-request (string->uri "http://localhost"))
- socket)
-
- ;; Make sure the server reacts by closing the connection. If it
- ;; fails to do that, this test hangs.
- (catch 'system-error
- (lambda ()
- (let loop ((n 0))
- (display "(+ 40 2)\n(quit)\n" socket) ;trigger EPIPE
- (read-string socket)
- (if (> n 5)
- #f ;failure
- (begin
- (sleep 1)
- (loop (+ 1 n))))))
- (lambda args
- (->bool (memv (system-error-errno args)
- (list ECONNRESET EPIPE ECONNABORTED))))))))
+ (pass-if-equal "simple expression"
+ "scheme@(repl-server)> $1 = 42\n"
+ (with-repl-server socket
+ (read-until-prompt socket %last-line-before-prompt)
+
+ ;; Wait until 'repl-reader' in boot-9 has written the prompt.
+ ;; Otherwise, if we write too quickly, 'repl-reader' checks for
+ ;; 'char-ready?' and doesn't print the prompt.
+ (match (select (list socket) '() (list socket) 3)
+ (((_) () ())
+ (display "(+ 40 2)\n(quit)\n" socket)
+ (read-string socket)))))
+
+ (pass-if "HTTP inter-protocol attack" ;CVE-2016-8606
+ (with-repl-server socket
+ ;; Avoid SIGPIPE when the server closes the connection.
+ (sigaction SIGPIPE SIG_IGN)
+
+ (read-until-prompt socket %last-line-before-prompt)
+
+ ;; Simulate an HTTP inter-protocol attack.
+ (write-request (build-request (string->uri "http://localhost"))
+ socket)
+
+ ;; Make sure the server reacts by closing the connection. If it
+ ;; fails to do that, this test hangs.
+ (catch 'system-error
+ (lambda ()
+ (let loop ((n 0))
+ (display "(+ 40 2)\n(quit)\n" socket) ;trigger EPIPE
+ (read-string socket)
+ (if (> n 5)
+ #f ;failure
+ (begin
+ (sleep 1)
+ (loop (+ 1 n))))))
+ (lambda args
+ (->bool (memv (system-error-errno args)
+ (list ECONNRESET EPIPE ECONNABORTED)))))))))
;;; Local Variables:
;;; eval: (put 'with-repl-server 'scheme-indent-function 1)
Michael Gran wrote 7 days ago
[PATCH 0/2] bug#36340 Fixes to --disable-networking
(address . 36340@debbugs.gnu.org)(name . Michael Gran)(address . spk121@yahoo.com)
20250309235523.713401-1-spk121@yahoo.com
These are fixes for Guile when built with the --disable-networking
option.

Michael Gran (2):
Fixes export of suspendable-ports socket funcs when networking
disabled
Disable some socket tests when sockets not provided

module/ice-9/suspendable-ports.scm | 46 ++++++++++++++++------------
test-suite/tests/00-repl-server.test | 3 +-
test-suite/tests/web-server.test | 6 ++--
3 files changed, 32 insertions(+), 23 deletions(-)

--
2.48.1
Michael Gran wrote 7 days ago
[PATCH 1/2] bug#36340: Fixes suspendable-ports networking disabled
(address . 36340@debbugs.gnu.org)(name . Michael Gran)(address . spk121@yahoo.com)
20250309235523.713401-2-spk121@yahoo.com
When guile is built with --disable-networking, (ice-9 suspendable-ports)
will attempt to re-export non-existent accept and socket functions.

* module/ice-9/suspendable-ports.scm (accept, connect): set to #f when
(guile) module does not have accept or connect
(guile-port-bindings): new variable
(port-bindings): don't include accept or connect when not defined
---
module/ice-9/suspendable-ports.scm | 46 ++++++++++++++++++------------
1 file changed, 27 insertions(+), 19 deletions(-)

Toggle diff (64 lines)
diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm
index 9fac1df62..00fd26049 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -727,30 +727,38 @@
(flush-output port))))
(define accept
- (let ((%accept (@ (guile) accept)))
- (lambda* (port #:optional (flags 0))
- (let lp ()
- (or (%accept port flags)
- (begin
- (wait-for-readable port)
- (lp)))))))
+ (let ((%accept (false-if-exception (@ (guile) accept))))
+ (if %accept
+ (lambda* (port #:optional (flags 0))
+ (let lp ()
+ (or (%accept port flags)
+ (begin
+ (wait-for-readable port)
+ (lp)))))
+ #f)))
(define connect
- (let ((%connect (@ (guile) connect)))
- (lambda (port sockaddr . args)
- (unless (apply %connect port sockaddr args)
- ;; Clownshoes semantics; see connect(2).
- (wait-for-writable port)
- (let ((err (getsockopt port SOL_SOCKET SO_ERROR)))
- (unless (zero? err)
- (scm-error 'system-error "connect" "~A"
- (list (strerror err)) #f)))))))
+ (let ((%connect (false-if-exception (@ (guile) connect))))
+ (if %connect
+ (lambda (port sockaddr . args)
+ (unless (apply %connect port sockaddr args)
+ ;; Clownshoes semantics; see connect(2).
+ (wait-for-writable port)
+ (let ((err (getsockopt port SOL_SOCKET SO_ERROR)))
+ (unless (zero? err)
+ (scm-error 'system-error "connect" "~A"
+ (list (strerror err)) #f)))))
+ #f)))
(define saved-port-bindings #f)
+(define guile-port-bindings
+ (append
+ '(read-char peek-char force-output close-port)
+ (if accept '(accept) '())
+ (if connect '(connect) '())))
+
(define port-bindings
- '(((guile)
- read-char peek-char force-output close-port
- accept connect)
+ `(((guile) ,@guile-port-bindings)
((ice-9 binary-ports)
get-u8 lookahead-u8 get-bytevector-n get-bytevector-n!
get-bytevector-some get-bytevector-some!
--
2.48.1
Michael Gran wrote 7 days ago
[PATCH 2/2] bug#36340: Disable tests when sockets not provided
(address . 36340@debbugs.gnu.org)(name . Michael Gran)(address . spk121@yahoo.com)
20250309235523.713401-3-spk121@yahoo.com
* test-suite/tests/00-repl-server.test (call-with-repl-server): throw
unsupported when sockets not provided
* test-suite/tests/web-server.test (expect, "server is listening"):
throw unresolved when socket not provided
---
test-suite/tests/00-repl-server.test | 3 ++-
test-suite/tests/web-server.test | 6 +++---
2 files changed, 5 insertions(+), 4 deletions(-)

Toggle diff (47 lines)
diff --git a/test-suite/tests/00-repl-server.test b/test-suite/tests/00-repl-server.test
index 433181ee6..d90da4faa 100644
--- a/test-suite/tests/00-repl-server.test
+++ b/test-suite/tests/00-repl-server.test
@@ -28,7 +28,8 @@
"Set up a REPL server in a separate process and call PROC with a
socket connected to that server."
;; The REPL server requires thread. The test requires fork.
- (unless (and (provided? 'threads) (provided? 'fork) (defined? 'mkdtemp))
+ (unless (and (provided? 'threads) (provided? 'fork) (defined? 'mkdtemp)
+ (provided? 'socket))
(throw 'unsupported))
(let* ((tmpdir (mkdtemp "/tmp/repl-server-test-XXXXXX"))
diff --git a/test-suite/tests/web-server.test b/test-suite/tests/web-server.test
index d84c47d18..f0458eb3f 100644
--- a/test-suite/tests/web-server.test
+++ b/test-suite/tests/web-server.test
@@ -66,7 +66,7 @@
(run-server handle-request 'http `(#:port ,%port-number)))))
(define-syntax-rule (expect method path code args ...)
- (if (provided? 'threads)
+ (if (and (provided? 'threads) (provided? 'socket))
(let-values (((response body)
(method (string-append %server-base-uri path)
#:decode-body? #t
@@ -78,7 +78,7 @@
(pass-if "server is listening"
;; First, wait until the server is listening, up to a few seconds.
- (if (provided? 'threads)
+ (if (and (provided? 'threads) (provided? 'socket))
(let ((socket (socket AF_INET SOCK_STREAM 0)))
(let loop ((n 1))
(define success?
@@ -122,7 +122,7 @@
'("Hello, λ world!"
"Écrit comme ça en Latin-1."
"GNU Guile")
- (if (provided? 'threads)
+ (if (and (provided? 'threads) (provided? 'socket))
(let ((port (open-socket-for-uri %server-base-uri)))
(define result
(map (lambda (path)
--
2.48.1
?
Your comment

Commenting via the web interface is currently disabled.

To comment on this conversation send an email to 36340@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 36340
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch
You may also tag this issue. See list of standard tags. For example, to set the confirmed and easy tags
mumi command -t +confirmed -t +easy
Or, remove the moreinfo tag and set the help tag
mumi command -t -moreinfo -t +help