[bug#46668] [PATCH]: tests: do not hard code HTTP ports

[Maxime Devos]

On Mon, 2021-03-01 at 16:46 +0100, Ludovic Courtès wrote:
> [...]
> Maxime Devos <maximedevos@telenet.be> skribis: 
> > [...]
> 
> Nice!
> 
> Some comments below.
> 
> > +  #:use-module (ice-9 receive)
> Please use (srfi srfi-71) instead, or (srfi srfi-11).

Sure, will do.

You made some comments about ‘Hunks that shouldn't be here’ below.
I disagree.  As my explanation is exactly the same for almost all hunks,
I've numbered them and the explanations.

Explanations:

A.  (Hunk 2--12, i.e. all hunks except the first)
    In some tests, the port number is hardcoded.
    E.g., you'll see (test-equal "Some string http://localhost:9999"; 
expression).
    Removing the hard-coding is the whole point of this patch.
B.  See later (hunk #1).
C.  See later (hunk #2).

Hunk #1.
> > -(unless (http-server-can-listen?)
> > -  (test-skip 1))
> >  (test-assert "'download' built-in builder, check mode"
> >    ;; Make sure rebuilding the 'builtin:download' derivation in check mode
> >    ;; works.  See <http://bugs.gnu.org/25089>;.
> > -  (let* ((text (random-text))
> > -         (drv (derivation %store "world"
> > -                          "builtin:download" '()
> > -                          #:env-vars `(("url"
> > -                                        . ,(object->string (%local-url))))
> > -                          #:hash-algo 'sha256
> > -                          #:hash (gcrypt:sha256 (string->utf8 text)))))
> > -    (and (with-http-server `((200 ,text))
> > -           (build-derivations %store (list drv)))
> > -         (with-http-server `((200 ,text))
> > -           (build-derivations %store (list drv)
> > -                              (build-mode check)))
> > -         (string=? (call-with-input-file (derivation->output-path drv)
> > -                     get-string-all)
> > -                   text))))
> > +  (let* ((text (random-text)))
> > +    (with-http-server `((200 ,text))
> > +      (let ((drv (derivation %store "world"
> > +                             "builtin:download" '()
> > +                             #:env-vars `(("url"
> > +                                           . ,(object->string 
> > (%local-url))))
> > +                             #:hash-algo 'sha256
> > +                             #:hash (gcrypt:sha256 (string->utf8 text)))))
> > +        (and drv (build-derivations %store (list drv))
> > +             (with-http-server `((200 ,text))
> > +               (build-derivations %store (list drv)
> > +                                  (build-mode check)))
> > +             (string=? (call-with-input-file (derivation->output-path drv)
> > +                         get-string-all)
> > +                       text))))))
> 
> This hunk shouldn’t be here.

Explanation #B: If the hunk wasn't applied, then the first %local-url won't
work, as no web server is running yet (so we cannot yet know the port to
include in %local-url).  I've added a check to %local-url to throw an
exception when %http-server-port is 0 to prevent silently returning
"http://localhost:0/foo/bar";, which is rather meaningless.

The "let" and "with-http-server" forms needed to be restructured,
and the %local-url of the first server needed to be saved with a "let",
to use the URL of the correct HTTP server.  There are two HTTP servers
in this test ...

Hunk #2.
> > -(test-equal "home-page: Connection refused"
> > -  "URI http://localhost:9999/foo/bar unreachable: Connection refused"
> > -  (let ((pkg (package
> > -               (inherit (dummy-package "x"))
> > -               (home-page (%local-url)))))
> > -    (single-lint-warning-message
> > -     (check-home-page pkg))))
> > +(parameterize ((%http-server-port 9999))
> > +  ;; TODO skip this test if some process is currently listening at 9999
> > +  (test-equal "home-page: Connection refused"
> > +    "URI http://localhost:9999/foo/bar unreachable: Connection refused"
> > +    (let ((pkg (package
> > +                 (inherit (dummy-package "x"))
> > +                 (home-page (%local-url)))))
> > +      (single-lint-warning-message
> > +       (check-home-page pkg)))))
> 
> Likewise.

Explanation #A.  Also, explanation #C:

The "(parameterize ((%http-server-port 9999)) ...)"
form is required I think, as otherwise this test will try to connect to port 0,
which doesn't make much sense IMHO.  However, a quick test in Guile on Linux
shows:

> (socket AF_INET SOCK_STREAM 0)
$1 = #<input-output: socket 13>
> (connect $1 AF_INET INADDR_LOOPBACK 0)
ice-9/boot-9.scm:1669:16: In procedure raise-exception:
In procedure connect: Connection refused

It seems like connecting to port 0 results in ‘Connection refused’, but this
connecting to port 0 seems a rather obscure to me, so I would rather not rely
on this, though your opinion could vary.  (If we drop the parameterize,
then (%local-url) would need to be replaced with "http://localhost:0";.)

-- And why hardcode the port in the first case?  Well, there isn't exactly
a procedure for asking the OS to reserve a port, but not bind to it.  Perhaps
something to figure out in a future patch ...

Hunk #3.
> > -(test-equal "home-page: 200 but short length"
> > -  "URI http://localhost:9999/foo/bar returned suspiciously small file (18 
> > bytes)"
> > -  (with-http-server `((200 "This is too small."))
> > +(with-http-server `((200 "This is too small."))
> > +  (test-equal "home-page: 200 but short length"
> > +    (format #f "URI ~a returned suspiciously small file (18 bytes)"
> > +            (%local-url))
> 
> Likewise.

Explanation #A.

Hunk #4.
> > -(test-equal "home-page: 404"
> > -  "URI http://localhost:9999/foo/bar not reachable: 404 (\"Such is life\")"
> > -  (with-http-server `((404 ,%long-string))
> > +(with-http-server `((404 ,%long-string))
> > +  (test-equal "home-page: 404"
> > +    (format #f "URI ~a not reachable: 404 (\"Such is life\")" (%local-url))
> 
> Likewise.

Explanation #A.

Hunk #5.
> > -(test-equal "home-page: 301, invalid"
> > -  "invalid permanent redirect from http://localhost:9999/foo/bar";
> > -  (with-http-server `((301 ,%long-string))
> > +(with-http-server `((301 ,%long-string))
> > +  (test-equal "home-page: 301, invalid"
> > +    (format #f "invalid permanent redirect from ~a" (%local-url))
> 
> Likewise.

Explanation #A.

Hunk #6.
> > -(test-equal "home-page: 301 -> 200"
> > -  "permanent redirect from http://localhost:10000/foo/bar to 
> > http://localhost:9999/foo/bar";
> > -  (with-http-server `((200 ,%long-string))
> > -    (let* ((initial-url (%local-url))
> > -           (redirect    (build-response #:code 301
> > -                                        #:headers
> > -                                        `((location
> > -                                           . ,(string->uri 
> > initial-url))))))
> > -      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
> > -        (with-http-server `((,redirect ""))
> > +(with-http-server `((200 ,%long-string))
> > +  (let* ((initial-url (%local-url))
> > +         (redirect (build-response #:code 301
> > +                                   #:headers
> > +                                   `((location
> > +                                      . ,(string->uri initial-url))))))
> 
> Likewise.

Explanation #A.

Hunk #7.
> > -(test-equal "home-page: 301 -> 404"
> > -  "URI http://localhost:10000/foo/bar not reachable: 404 (\"Such is 
> > life\")"
> > -  (with-http-server '((404 "booh!"))
> > -    (let* ((initial-url (%local-url))
> > -           (redirect    (build-response #:code 301
> > -                                        #:headers
> > -                                        `((location
> > -                                           . ,(string->uri 
> > initial-url))))))
> > -      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
> > -        (with-http-server `((,redirect ""))
> > +(with-http-server `((404 "booh!"))
> 
> Likewise.

Explanation #A.

Hunk #8.
> > -(test-equal "source: 200 but short length"
> > -  "URI http://localhost:9999/foo/bar returned suspiciously small file (18 
> > bytes)"
> > -  (with-http-server '((200 "This is too small."))
> > +(with-http-server '((200 "This is too small."))
> > +  (test-equal "source: 200 but short length"
> > +    (format #f "URI ~a returned suspiciously small file (18 bytes)"
> > +            (%local-url))
> 
> Likewise.

Explanation #A.

Hunk #9.
> > -(test-equal "source: 404"
> > -  "URI http://localhost:9999/foo/bar not reachable: 404 (\"Such is life\")"
> > -  (with-http-server `((404 ,%long-string))
> > +(with-http-server `((404 ,%long-string))
> > +  (test-equal "source: 404"
> > +    (format #f "URI ~a not reachable: 404 (\"Such is life\")"
> > +            (%local-url))
> 
> Likewise.

Explanation #A.

Hunk #10.
> > -(test-equal "source: 301 -> 200"
> > -  "permanent redirect from http://localhost:10000/foo/bar to 
> > http://localhost:9999/foo/bar";
> > -  (with-http-server `((200 ,%long-string))
> > -    (let* ((initial-url (%local-url))
> > -           (redirect    (build-response #:code 301
> > -                                        #:headers
> > -                                        `((location
> > -                                           . ,(string->uri 
> > initial-url))))))
> > -      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
> > -        (with-http-server `((,redirect ""))
> > +(with-http-server `((200 ,%long-string))
> 
> Likewise.

Explanation #A.

Hunk #11.
> > -(test-equal "source, git-reference: 301 -> 200"
> > -  "permanent redirect from http://localhost:10000/foo/bar to 
> > http://localhost:9999/foo/bar";
> > -  (with-http-server `((200 ,%long-string))
> > -    (let* ((initial-url (%local-url))
> > -           (redirect    (build-response #:code 301
> > -                                        #:headers
> > -                                        `((location
> > -                                           . ,(string->uri 
> > initial-url))))))
> > -      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
> > -        (with-http-server `((,redirect ""))
> > +(with-http-server `((200 ,%long-string))
> 
> Likewise.

Explanation #A.

Hunk #12.
> > -(test-equal "source: 301 -> 404"
> > -  "URI http://localhost:10000/foo/bar not reachable: 404 (\"Such is 
> > life\")"
> > -  (with-http-server '((404 "booh!"))
> > -    (let* ((initial-url (%local-url))
> > -           (redirect    (build-response #:code 301
> > -                                        #:headers
> > -                                        `((location
> > -                                           . ,(string->uri 
> > initial-url))))))
> > -      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
> > -        (with-http-server `((,redirect ""))
> > +(with-http-server '((404 "booh!"))
> 
> Likewise.

Explanation #A.

> Could you send an updated patch?

Is explanation #A clear, and does explanation #B make sense to you?
What do you think of explanation #C?

If you remove these hunks, you should see that the tests will fail
(make check TESTS=$tests).

Thanks,
Maxime.

signature.asc
Description: This is a digitally signed message part