;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:renamer (lambda (name)
(cond ((eq? name 'location) 'make-location)
(else name))))
- #:use-module (guix hash)
+ #:use-module (gcrypt hash)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix grafts)
(unless (network-reachable?) (test-skip 1))
(test-equal "package-source-derivation, snippet"
"OK"
- (let* ((file (search-bootstrap-binary (match (%current-system)
- ("armhf-linux"
- "guile-2.0.11.tar.xz")
- ("aarch64-linux"
- "guile-2.0.14.tar.xz")
- (_
- "guile-2.0.9.tar.xz"))
- (%current-system)))
- (sha256 (call-with-input-file file port-sha256))
- (fetch (lambda* (url hash-algo hash
- #:optional name #:key system)
- (pk 'fetch url hash-algo hash name system)
- (interned-file url)))
- (source (bootstrap-origin
+ (let* ((source (bootstrap-origin
(origin
- (method fetch)
- (uri file)
- (sha256 sha256)
+ (inherit (bootstrap-guile-origin (%current-system)))
(patch-inputs
`(("tar" ,%bootstrap-coreutils&co)
("xz" ,%bootstrap-coreutils&co)
(%current-system)))))
(arguments
`(#:guile ,%bootstrap-guile
+ #:modules ((guix build utils))
#:builder
- (let ((tar (assoc-ref %build-inputs "tar"))
- (xz (assoc-ref %build-inputs "xz"))
- (source (assoc-ref %build-inputs "source")))
- (and (zero? (system* tar "xvf" source
- "--use-compress-program" xz))
- (string=? "guile" (readlink "bin/guile-rocks"))
- (file-exists? "bin/scripts/compile.scm")
- (let ((out (assoc-ref %outputs "out")))
- (call-with-output-file out
- (lambda (p)
- (display "OK" p))))))))))
+ (begin
+ (use-modules (guix build utils))
+ (let ((tar (assoc-ref %build-inputs "tar"))
+ (xz (assoc-ref %build-inputs "xz"))
+ (source (assoc-ref %build-inputs "source")))
+ (invoke tar "xvf" source
+ "--use-compress-program" xz)
+ (unless (and (string=? "guile" (readlink "bin/guile-rocks"))
+ (file-exists? "bin/scripts/compile.scm"))
+ (error "the snippet apparently failed"))
+ (let ((out (assoc-ref %outputs "out")))
+ (call-with-output-file out
+ (lambda (p)
+ (display "OK" p))))
+ #t))))))
(drv (package-derivation %store package))
(out (derivation->output-path drv)))
(and (build-derivations %store (list (pk 'snippet-drv drv)))
(mkdir %output)
(call-with-output-file (string-append %output "/test")
(lambda (p)
- (display '(hello guix) p))))))))
+ (display '(hello guix) p)))
+ #t)))))
(d (package-derivation %store p)))
(and (build-derivations %store (list d))
(let ((p (pk 'drv d (derivation->output-path d))))
(source #f)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (copy-file (assoc-ref %build-inputs "input")
- %output)))
+ #:builder (begin
+ (copy-file (assoc-ref %build-inputs "input")
+ %output)
+ #t)))
(inputs `(("input" ,i)))))
(d (package-derivation %store p)))
(and (build-derivations %store (list d))
(source i)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (copy-file (assoc-ref %build-inputs "source")
- %output)))))
+ #:builder (begin
+ (copy-file (assoc-ref %build-inputs "source")
+ %output)
+ #t)))))
(d (package-derivation %store p)))
(and (build-derivations %store (list d))
(let ((p (derivation->output-path d)))
(source #f)
(arguments
`(#:guile ,%bootstrap-guile
+ #:modules ((guix build utils))
#:builder
- (let ((out (assoc-ref %outputs "out"))
- (bash (assoc-ref %build-inputs "bash")))
- (zero? (system* bash "-c"
- (format #f "echo hello > ~a" out))))))
+ (begin
+ (use-modules (guix build utils))
+ (let ((out (assoc-ref %outputs "out"))
+ (bash (assoc-ref %build-inputs "bash")))
+ (invoke bash "-c"
+ (format #f "echo hello > ~a" out))))))
(inputs `(("bash" ,(search-bootstrap-binary "bash"
(%current-system)))))))
(d (package-derivation %store p)))
(let ((p (pk 'drv d (derivation->output-path d))))
(eq? 'hello (call-with-input-file p read))))))
+(test-assert "trivial with #:allowed-references"
+ (let* ((p (package
+ (inherit (dummy-package "trivial"))
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:allowed-references (,%bootstrap-guile)
+ #:builder
+ (begin
+ (mkdir %output)
+ ;; The reference to itself isn't allowed so building it
+ ;; should fail.
+ (symlink %output (string-append %output "/self"))
+ #t)))))
+ (d (package-derivation %store p)))
+ (guard (c ((nix-protocol-error? c) #t))
+ (build-derivations %store (list d))
+ #f)))
+
(test-assert "search paths"
(let* ((p (make-prompt-tag "return-search-paths"))
(s (build-system
;; (package-cross-derivation %store p "mips64el-linux-gnu"
;; #:graft? #t)))
-;; It doesn't make sense for 'package-grafts' to look at native inputs since,
-;; by definition, they are not referenced at run time. Make sure
-;; 'package-grafts' respects this.
-(test-equal "package-grafts, grafts of native inputs ignored"
- '()
- (let* ((new (dummy-package "native-dep"
- (version "0.1")
- (arguments '(#:implicit-inputs? #f))))
- (ndep (package (inherit new) (version "0.0")
- (replacement new)))
- (dep (dummy-package "dep"
- (arguments '(#:implicit-inputs? #f))))
- (dummy (dummy-package "dummy"
- (arguments '(#:implicit-inputs? #f))
- (native-inputs `(("ndep" ,ndep)))
- (inputs `(("dep" ,dep))))))
- (package-grafts %store dummy)))
-
(test-assert "package-grafts, indirect grafts"
(let* ((new (dummy-package "dep"
(arguments '(#:implicit-inputs? #f))))
(inherit p1r) (name "p1") (replacement p1r)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (mkdir (assoc-ref %outputs "out"))))))
+ #:builder (begin
+ (mkdir (assoc-ref %outputs "out"))
+ #t)))))
(p2r (dummy-package "P2"
(build-system trivial-build-system)
(inputs `(("p1" ,p1)))
(mkdir out)
(chdir out)
(symlink (assoc-ref %build-inputs "p1")
- "p1"))))))
+ "p1")
+ #t)))))
(p3 (dummy-package "p3"
(build-system trivial-build-system)
(inputs `(("p2" ,p2)))
(mkdir out)
(chdir out)
(symlink (assoc-ref %build-inputs "p2")
- "p2")))))))
+ "p2")
+ #t))))))
(lset= equal?
(package-grafts %store p3)
(list (graft
((("x" dep))
(eq? dep findutils)))))))))
+(test-equal "package-patched-vulnerabilities"
+ '(("CVE-2015-1234")
+ ("CVE-2016-1234" "CVE-2018-4567")
+ ())
+ (let ((p1 (dummy-package "pi"
+ (source (dummy-origin
+ (patches (list "/a/b/pi-CVE-2015-1234.patch"))))))
+ (p2 (dummy-package "pi"
+ (source (dummy-origin
+ (patches (list
+ "/a/b/pi-CVE-2016-1234-CVE-2018-4567.patch"))))))
+ (p3 (dummy-package "pi" (source (dummy-origin)))))
+ (map package-patched-vulnerabilities
+ (list p1 p2 p3))))
+
(test-eq "fold-packages" hello
(fold-packages (lambda (p r)
(if (string=? (package-name p) "hello")
(call-with-output-file
(string-append out "/xml/bar/baz/catalog.xml")
(lambda (port)
- (display "xml? wat?!" port)))))))
+ (display "xml? wat?!" port)))
+ #t))))
(synopsis #f) (description #f)
(home-page #f) (license #f)))
(p2 (package
(build-system trivial-build-system)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (mkdir (assoc-ref %outputs "out"))))
+ #:builder (begin
+ (mkdir (assoc-ref %outputs "out"))
+ #t)))
(native-search-paths (package-native-search-paths libxml2))
(synopsis #f) (description #f)
(home-page #f) (license #f)))
(build-system trivial-build-system)
(arguments
`(#:guile ,%bootstrap-guile
- #:builder (mkdir (assoc-ref %outputs "out"))))
+ #:builder (begin
+ (mkdir (assoc-ref %outputs "out"))
+ #t)))
(native-search-paths (package-native-search-paths git))))
(prof1 (run-with-store %store
(profile-derivation