aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm74
-rw-r--r--tests/gexp.scm59
-rw-r--r--tests/guix-download.sh9
-rw-r--r--tests/lint.scm133
-rw-r--r--tests/syscalls.scm45
5 files changed, 192 insertions, 128 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm
index d8553b223e..2b5aa796d4 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -16,6 +16,8 @@
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+(unsetenv "http_proxy")
+
(define-module (test-derivations)
#:use-module (guix derivations)
#:use-module (guix grafts)
@@ -24,6 +26,7 @@
#:use-module (guix hash)
#:use-module (guix base32)
#:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module ((guix packages) #:select (package-derivation base32))
#:use-module ((guix build utils) #:select (executable-file?))
#:use-module ((gnu packages) #:select (search-bootstrap-binary))
@@ -75,6 +78,9 @@
(lambda (e1 e2)
(string<? (car e1) (car e2)))))
+;; Avoid collisions with other tests.
+(%http-server-port 10500)
+
(test-begin "derivations")
@@ -205,6 +211,74 @@
(= (stat:ino (lstat file1))
(stat:ino (lstat file2))))))))
+(test-equal "built-in-builders"
+ '("download")
+ (built-in-builders %store))
+
+(test-assert "unknown built-in builder"
+ (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
+ (guard (c ((nix-protocol-error? c)
+ (string-contains (nix-protocol-error-message c) "failed")))
+ (build-derivations %store (list drv))
+ #f)))
+
+(unless (force %http-server-socket)
+ (test-skip 1))
+(test-assert "'download' built-in builder"
+ (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 (sha256 (string->utf8 text)))))
+ (and (build-derivations %store (list drv))
+ (string=? (call-with-input-file (derivation->output-path drv)
+ get-string-all)
+ text))))))
+
+(unless (force %http-server-socket)
+ (test-skip 1))
+(test-assert "'download' built-in builder, invalid hash"
+ (with-http-server 200 "hello, world!"
+ (let* ((drv (derivation %store "world"
+ "builtin:download" '()
+ #:env-vars `(("url"
+ . ,(object->string (%local-url))))
+ #:hash-algo 'sha256
+ #:hash (sha256 (random-bytevector 100))))) ;wrong
+ (guard (c ((nix-protocol-error? c)
+ (string-contains (nix-protocol-error-message c) "failed")))
+ (build-derivations %store (list drv))
+ #f))))
+
+(unless (force %http-server-socket)
+ (test-skip 1))
+(test-assert "'download' built-in builder, not found"
+ (with-http-server 404 "not found"
+ (let* ((drv (derivation %store "will-never-be-found"
+ "builtin:download" '()
+ #:env-vars `(("url"
+ . ,(object->string (%local-url))))
+ #:hash-algo 'sha256
+ #:hash (sha256 (random-bytevector 100)))))
+ (guard (c ((nix-protocol-error? c)
+ (string-contains (nix-protocol-error-message (pk c)) "failed")))
+ (build-derivations %store (list drv))
+ #f))))
+
+(test-assert "'download' built-in builder, not fixed-output"
+ (let* ((source (add-text-to-store %store "hello" "hi!"))
+ (url (string-append "file://" source))
+ (drv (derivation %store "world"
+ "builtin:download" '()
+ #:env-vars `(("url" . ,(object->string url))))))
+ (guard (c ((nix-protocol-error? c)
+ (string-contains (nix-protocol-error-message c) "failed")))
+ (build-derivations %store (list drv))
+ #f)))
+
(test-equal "derivation-name"
"foo-0.0"
(let ((drv (derivation %store "foo-0.0" %bash '())))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 214e7a5302..354d28f014 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -375,7 +375,7 @@
(drv (gexp->file "foo" exp))
(out -> (derivation->output-path drv))
(done (built-derivations (list drv)))
- (refs ((store-lift references) out)))
+ (refs (references* out)))
(return (and (equal? sexp (call-with-input-file out read))
(equal? (list guile) refs)))))
@@ -386,7 +386,7 @@
(drv (gexp->file "foo" exp))
(out -> (derivation->output-path drv))
(done (built-derivations (list drv)))
- (refs ((store-lift references) out)))
+ (refs (references* out)))
(return (and (equal? (string-append guile "/bin/guile")
(call-with-input-file out read))
(equal? (list guile) refs)))))
@@ -407,8 +407,8 @@
(out -> (derivation->output-path drv))
(out2 -> (derivation->output-path drv "2nd"))
(done (built-derivations (list drv)))
- (refs ((store-lift references) out))
- (refs2 ((store-lift references) out2))
+ (refs (references* out))
+ (refs2 (references* out2))
(guile (package-file %bootstrap-guile "bin/guile")))
(return (and (string=? (readlink (string-append out "/foo")) guile)
(string=? (readlink out2) file)
@@ -481,7 +481,7 @@
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
#:target target))
- (refs ((store-lift references)
+ (refs (references*
(derivation-file-name xdrv)))
(xcu (package->cross-derivation coreutils
target))
@@ -506,7 +506,7 @@
(ungexp output))))
(xdrv (gexp->derivation "foo" exp
#:target target))
- (refs ((store-lift references)
+ (refs (references*
(derivation-file-name xdrv)))
(xglibc (package->cross-derivation glibc target))
(cu (package->derivation coreutils)))
@@ -808,34 +808,33 @@
(out -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
- (mlet %store-monad ((refs ((store-lift references) out)))
+ (mlet %store-monad ((refs (references* out)))
(return (and (equal? refs (list text))
(equal? `(list "foo" ,text)
(call-with-input-file out read)))))))))
(test-assert "text-file*"
- (let ((references (store-lift references)))
- (run-with-store %store
- (mlet* %store-monad
- ((drv (package->derivation %bootstrap-guile))
- (guile -> (derivation->output-path drv))
- (file (text-file "bar" "This is bar."))
- (text (text-file* "foo"
- %bootstrap-guile "/bin/guile "
- (gexp-input %bootstrap-guile "out") "/bin/guile "
- drv "/bin/guile "
- file))
- (done (built-derivations (list text)))
- (out -> (derivation->output-path text))
- (refs (references out)))
- ;; Make sure we get the right references and the right content.
- (return (and (lset= string=? refs (list guile file))
- (equal? (call-with-input-file out get-string-all)
- (string-append guile "/bin/guile "
- guile "/bin/guile "
- guile "/bin/guile "
- file)))))
- #:guile-for-build (package-derivation %store %bootstrap-guile))))
+ (run-with-store %store
+ (mlet* %store-monad
+ ((drv (package->derivation %bootstrap-guile))
+ (guile -> (derivation->output-path drv))
+ (file (text-file "bar" "This is bar."))
+ (text (text-file* "foo"
+ %bootstrap-guile "/bin/guile "
+ (gexp-input %bootstrap-guile "out") "/bin/guile "
+ drv "/bin/guile "
+ file))
+ (done (built-derivations (list text)))
+ (out -> (derivation->output-path text))
+ (refs (references* out)))
+ ;; Make sure we get the right references and the right content.
+ (return (and (lset= string=? refs (list guile file))
+ (equal? (call-with-input-file out get-string-all)
+ (string-append guile "/bin/guile "
+ guile "/bin/guile "
+ guile "/bin/guile "
+ file)))))
+ #:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assertm "mixed-text-file"
(mlet* %store-monad ((file -> (mixed-text-file "mixed"
@@ -847,7 +846,7 @@
(guile -> (derivation->output-path guile-drv)))
(mbegin %store-monad
(built-derivations (list drv))
- (mlet %store-monad ((refs ((store-lift references) out)))
+ (mlet %store-monad ((refs (references* out)))
(return (and (string=? (string-append "export PATH=" guile "/bin")
(call-with-input-file out get-string-all))
(equal? refs (list guile))))))))
diff --git a/tests/guix-download.sh b/tests/guix-download.sh
index 6283772c48..ebc853c7fa 100644
--- a/tests/guix-download.sh
+++ b/tests/guix-download.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2015 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -35,6 +35,13 @@ then false; else true; fi
# This one should succeed.
guix download "file://$abs_top_srcdir/README"
+# This one too, even if it cannot talk to the daemon.
+output="t-download-$$"
+trap 'rm -f "$output"' EXIT
+GUIX_DAEMON_SOCKET="/nowhere" guix download -o "$output" \
+ "file://$abs_top_srcdir/README"
+cmp "$output" "$abs_top_srcdir/README"
+
# This one should fail.
if guix download "file:///does-not-exist" "file://$abs_top_srcdir/README"
then false; else true; fi
diff --git a/tests/lint.scm b/tests/lint.scm
index fa2d19b2a6..0c534562a4 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -24,6 +24,7 @@
(define-module (test-lint)
#:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
@@ -33,101 +34,20 @@
#:use-module (gnu packages)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
- #:use-module (web server)
- #:use-module (web server http)
- #:use-module (web response)
#:use-module (ice-9 match)
- #:use-module (ice-9 threads)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-64))
;; Test the linter.
-(define %http-server-port
- ;; TCP port to use for the stub HTTP server.
- 9999)
-
-(define %local-url
- ;; URL to use for 'home-page' tests.
- (string-append "http://localhost:" (number->string %http-server-port)
- "/foo/bar"))
+;; Avoid collisions with other tests.
+(%http-server-port 9999)
(define %null-sha256
;; SHA256 of the empty string.
(base32
"0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"))
-(define %http-server-socket
- ;; Socket used by the Web server.
- (catch 'system-error
- (lambda ()
- (let ((sock (socket PF_INET SOCK_STREAM 0)))
- (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
- (bind sock
- (make-socket-address AF_INET INADDR_LOOPBACK
- %http-server-port))
- sock))
- (lambda args
- (let ((err (system-error-errno args)))
- (format (current-error-port)
- "warning: cannot run Web server for tests: ~a~%"
- (strerror err))
- #f))))
-
-(define (http-write server client response body)
- "Write RESPONSE."
- (let* ((response (write-response response client))
- (port (response-port response)))
- (cond
- ((not body)) ;pass
- (else
- (write-response-body response body)))
- (close-port port)
- (quit #t) ;exit the server thread
- (values)))
-
-;; Mutex and condition variable to synchronize with the HTTP server.
-(define %http-server-lock (make-mutex))
-(define %http-server-ready (make-condition-variable))
-
-(define (http-open . args)
- "Start listening for HTTP requests and signal %HTTP-SERVER-READY."
- (with-mutex %http-server-lock
- (let ((result (apply (@@ (web server http) http-open) args)))
- (signal-condition-variable %http-server-ready)
- result)))
-
-(define-server-impl stub-http-server
- ;; Stripped-down version of Guile's built-in HTTP server.
- http-open
- (@@ (web server http) http-read)
- http-write
- (@@ (web server http) http-close))
-
-(define (call-with-http-server code data thunk)
- "Call THUNK with an HTTP server running and returning CODE and DATA (a
-string) on HTTP requests."
- (define (server-body)
- (define (handle request body)
- (values (build-response #:code code
- #:reason-phrase "Such is life")
- data))
-
- (catch 'quit
- (lambda ()
- (run-server handle stub-http-server
- `(#:socket ,%http-server-socket)))
- (const #t)))
-
- (with-mutex %http-server-lock
- (let ((server (make-thread server-body)))
- (wait-condition-variable %http-server-ready %http-server-lock)
- ;; Normally SERVER exits automatically once it has received a request.
- (thunk))))
-
-(define-syntax-rule (with-http-server code data body ...)
- (call-with-http-server code data (lambda () body ...)))
-
(define %long-string
(make-string 2000 #\a))
@@ -423,28 +343,28 @@ string) on HTTP requests."
(check-home-page pkg)))
"domain not found")))
-(test-skip (if %http-server-socket 0 1))
+(test-skip (if (force %http-server-socket) 0 1))
(test-assert "home-page: Connection refused"
(->bool
(string-contains
(with-warnings
(let ((pkg (package
(inherit (dummy-package "x"))
- (home-page %local-url))))
+ (home-page (%local-url)))))
(check-home-page pkg)))
"Connection refused")))
-(test-skip (if %http-server-socket 0 1))
+(test-skip (if (force %http-server-socket) 0 1))
(test-equal "home-page: 200"
""
(with-warnings
(with-http-server 200 %long-string
(let ((pkg (package
(inherit (dummy-package "x"))
- (home-page %local-url))))
+ (home-page (%local-url)))))
(check-home-page pkg)))))
-(test-skip (if %http-server-socket 0 1))
+(test-skip (if (force %http-server-socket) 0 1))
(test-assert "home-page: 200 but short length"
(->bool
(string-contains
@@ -452,11 +372,11 @@ string) on HTTP requests."
(with-http-server 200 "This is too small."
(let ((pkg (package
(inherit (dummy-package "x"))
- (home-page %local-url))))
+ (home-page (%local-url)))))
(check-home-page pkg))))
"suspiciously small")))
-(test-skip (if %http-server-socket 0 1))
+(test-skip (if (force %http-server-socket) 0 1))
(test-assert "home-page: 404"
(->bool
(string-contains
@@ -464,7 +384,7 @@ string) on HTTP requests."
(with-http-server 404 %long-string
(let ((pkg (package
(inherit (dummy-package "x"))
- (home-page %local-url))))
+ (home-page (%local-url)))))
(check-home-page pkg))))
"not reachable: 404")))
@@ -545,7 +465,7 @@ string) on HTTP requests."
(check-source-file-name pkg)))
"file name should contain the package name"))))
-(test-skip (if %http-server-socket 0 1))
+(test-skip (if (force %http-server-socket) 0 1))
(test-equal "source: 200"
""
(with-warnings
@@ -554,11 +474,11 @@ string) on HTTP requests."
(inherit (dummy-package "x"))
(source (origin
(method url-fetch)
- (uri %local-url)
+ (uri (%local-url))
(sha256 %null-sha256))))))
(check-source pkg)))))
-(test-skip (if %http-server-socket 0 1))
+(test-skip (if (force %http-server-socket) 0 1))
(test-assert "source: 200 but short length"
(->bool
(string-contains
@@ -568,12 +488,12 @@ string) on HTTP requests."
(inherit (dummy-package "x"))
(source (origin
(method url-fetch)
- (uri %local-url)
+ (uri (%local-url))
(sha256 %null-sha256))))))
(check-source pkg))))
"suspiciously small")))
-(test-skip (if %http-server-socket 0 1))
+(test-skip (if (force %http-server-socket) 0 1))
(test-assert "source: 404"
(->bool
(string-contains
@@ -583,11 +503,30 @@ string) on HTTP requests."
(inherit (dummy-package "x"))
(source (origin
(method url-fetch)
- (uri %local-url)
+ (uri (%local-url))
(sha256 %null-sha256))))))
(check-source pkg))))
"not reachable: 404")))
+(test-assert "mirror-url"
+ (string-null?
+ (with-warnings
+ (let ((source (origin
+ (method url-fetch)
+ (uri "http://example.org/foo/bar.tar.gz")
+ (sha256 %null-sha256))))
+ (check-mirror-url (dummy-package "x" (source source)))))))
+
+(test-assert "mirror-url: one suggestion"
+ (string-contains
+ (with-warnings
+ (let ((source (origin
+ (method url-fetch)
+ (uri "http://ftp.gnu.org/pub/gnu/foo/foo.tar.gz")
+ (sha256 %null-sha256))))
+ (check-mirror-url (dummy-package "x" (source source)))))
+ "mirror://gnu/foo/foo.tar.gz"))
+
(test-assert "cve"
(mock ((guix scripts lint) package-vulnerabilities (const '()))
(string-null?
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 9eb19f9c80..e4ef32c522 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -326,6 +326,27 @@
;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32.
(memv (system-error-errno args) (list EPERM EACCES))))))
+(test-equal "network-interface-netmask lo"
+ (make-socket-address AF_INET (inet-pton AF_INET "255.0.0.0") 0)
+ (let* ((sock (socket AF_INET SOCK_STREAM 0))
+ (addr (network-interface-netmask sock "lo")))
+ (close-port sock)
+ addr))
+
+(test-skip (if (zero? (getuid)) 1 0))
+(test-assert "set-network-interface-netmask"
+ (let ((sock (socket AF_INET SOCK_STREAM 0)))
+ (catch 'system-error
+ (lambda ()
+ (set-network-interface-netmask sock "nonexistent"
+ (make-socket-address
+ AF_INET
+ (inet-pton AF_INET "255.0.0.0")
+ 0)))
+ (lambda args
+ (close-port sock)
+ (memv (system-error-errno args) (list EPERM EACCES))))))
+
(test-equal "network-interfaces returns one or more interfaces"
'(#t #t #t)
(match (network-interfaces)
@@ -353,6 +374,30 @@
(#f #f)
(lo (interface-address lo)))))))
+(test-skip (if (zero? (getuid)) 1 0))
+(test-assert "add-network-route/gateway"
+ (let ((sock (socket AF_INET SOCK_STREAM 0))
+ (gateway (make-socket-address AF_INET
+ (inet-pton AF_INET "192.168.0.1")
+ 0)))
+ (catch 'system-error
+ (lambda ()
+ (add-network-route/gateway sock gateway))
+ (lambda args
+ (close-port sock)
+ (memv (system-error-errno args) (list EPERM EACCES))))))
+
+(test-skip (if (zero? (getuid)) 1 0))
+(test-assert "delete-network-route"
+ (let ((sock (socket AF_INET SOCK_STREAM 0))
+ (destination (make-socket-address AF_INET INADDR_ANY 0)))
+ (catch 'system-error
+ (lambda ()
+ (delete-network-route sock destination))
+ (lambda args
+ (close-port sock)
+ (memv (system-error-errno args) (list EPERM EACCES))))))
+
(test-equal "tcgetattr ENOTTY"
ENOTTY
(catch 'system-error