tests: Test network access from fixed-output derivations.

* tests/derivations.scm ("fixed-output derivation, network access, localhost")
("fixed-output derivation, network access, external host"): New tests.

Change-Id: Iec164981a12ffef1bcb6a63ed9c2f1f363c53d80
Signed-off-by: John Kehayias <john.kehayias@protonmail.com>
This commit is contained in:
Ludovic Courtès 2025-04-15 14:38:27 +02:00 committed by John Kehayias
parent 6f1c5aed8a
commit a183afa8e2
No known key found for this signature in database
GPG key ID: 499097AE5EA815D9

View file

@ -502,6 +502,69 @@
#:hash #vu8(1 2 3)) #:hash #vu8(1 2 3))
#f)) #f))
(test-assert "fixed-output derivation, network access, localhost"
;; Test a fixed-output derivation connecting to "localhost".
(let ((text (random-text)))
(with-http-server `((200 ,text))
(let* ((drv (build-expression->derivation
%store
"fixed-output-download"
`(begin
(use-modules (web client)
(srfi srfi-11)
(rnrs io ports))
;; Neutralize 'set-port-encoding!' because
;; guile-bootstrap cannot open iconv descriptors
;; contrary to what 'read-response' expects.
(set! (@ (guile) set-port-encoding!) (const #t))
(let-values (((response body)
(http-get ,(%local-url)
#:decode-body? #f)))
(format #t "response: ~s~%body: ~s~%"
response body)
(call-with-output-file %output
(lambda (port)
(put-bytevector port body)))))
#:hash-algo 'sha256
#:hash (gcrypt:sha256 (string->utf8 text)))))
(and (build-derivations %store (list drv))
(string=? (call-with-input-file (derivation->output-path drv)
get-string-all)
text))))))
(unless (network-reachable?) (test-skip 1))
(test-assert "fixed-output derivation, network access, external host"
;; Test a fixed-output derivation connecting to an external server.
(let* ((drv (build-expression->derivation
%store
(string-append (number->string (random (expt 2 64) (%seed))
16)
"-gplv3.txt")
'(begin
(use-modules (web client)
(srfi srfi-11)
(rnrs io ports))
;; DNS working?
(pk 'addr (getaddrinfo "www.gnu.org" "https"))
;; Neutralize 'set-port-encoding!' because
;; guile-bootstrap cannot open iconv descriptors
;; contrary to what 'read-response' expects.
(set! (@ (guile) set-port-encoding!) (const #t))
(let-values (((response body)
(http-get "http://www.gnu.org/licenses/gpl-3.0.txt"
#:decode-body? #f)))
(call-with-output-file %output
(lambda (port)
(put-bytevector port body)))))
#:hash-algo 'sha256
#:hash (base32 "11k9nggwk1mgsrkdwgdjz65avrradxlpdgrdkc7ryjgn8jbxqwir"))))
(build-derivations %store (list drv))))
(test-assert "derivation with a fixed-output input" (test-assert "derivation with a fixed-output input"
;; A derivation D using a fixed-output derivation F doesn't has the same ;; A derivation D using a fixed-output derivation F doesn't has the same
;; output path when passed F or F', as long as F and F' have the same output ;; output path when passed F or F', as long as F and F' have the same output