From 57bdd79e485801ccf405ca7389bd099809fe5d67 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 3 Oct 2016 23:02:46 +0200 Subject: grafts: Allow the replacement to have a different name. * guix/build/graft.scm (replace-store-references): REPLACEMENT is now the full string, not just the hash. (rewrite-directory)[hash-mapping](valid-suffix?): Remove. (hash+suffix): Rename to... (hash+rest): ... this. Change to return the whole string as the second element of the list. Adjust 'match-lambda' expression accordingly; check whether the string length of the origin and replacement match. * tests/grafts.scm ("graft-derivation, grafted item uses a different name"): New test. * doc/guix.texi (Security Updates): Update sentence on the name/version restriction. --- tests/grafts.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'tests') diff --git a/tests/grafts.scm b/tests/grafts.scm index 13c56750ed..f2ff839fd8 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -80,6 +80,25 @@ (string=? (readlink (string-append grafted "/self")) grafted)))))) +(test-assert "graft-derivation, grafted item uses a different name" + (let* ((build `(begin + (mkdir %output) + (chdir %output) + (symlink %output "self") + (symlink ,%bash "sh"))) + (orig (build-expression->derivation %store "grafted" build + #:inputs `(("a" ,%bash)))) + (repl (add-text-to-store %store "BaSH" "fake bash")) + (grafted (graft-derivation %store orig + (list (graft + (origin %bash) + (replacement repl)))))) + (and (build-derivations %store (list grafted)) + (let ((grafted (derivation->output-path grafted))) + (and (string=? (readlink (string-append grafted "/sh")) repl) + (string=? (readlink (string-append grafted "/self")) + grafted)))))) + ;; Make sure 'derivation-file-name' always gets to see an absolute file name. (fluid-set! %file-port-name-canonicalization 'absolute) -- cgit v1.2.3 From 9bee2bd1b02c7ef91cc7232e8647bd07525d3382 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 3 Oct 2016 23:30:49 +0200 Subject: lint: 'cve' checker reports the replacement's vulnerabilities. Before, 'guix lint -c cve' would report the vulnerabilities of the original package while pretending they are the vulnerabilities of the replacement. * guix/scripts/lint.scm (check-vulnerabilities): Consider the package replacement before calling 'package-vulnerabilities'. * tests/lint.scm ("cve: vulnerability fixed in replacement version"): New test. --- guix/scripts/lint.scm | 38 +++++++++++++++++++------------------- tests/lint.scm | 23 +++++++++++++++++++++++ 2 files changed, 42 insertions(+), 19 deletions(-) (limited to 'tests') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index eac3214bbf..b3ec6d628e 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -683,25 +683,25 @@ from ~s: ~a (~s)~%") (define (check-vulnerabilities package) "Check for known vulnerabilities for PACKAGE." - (match (package-vulnerabilities package) - (() - #t) - ((vulnerabilities ...) - (let* ((package (or (package-replacement package) package)) - (patches (filter-map patch-file-name - (or (and=> (package-source package) - origin-patches) - '()))) - (unpatched (remove (lambda (vuln) - (find (cute string-contains - <> (vulnerability-id vuln)) - patches)) - vulnerabilities))) - (unless (null? unpatched) - (emit-warning package - (format #f (_ "probably vulnerable to ~a") - (string-join (map vulnerability-id unpatched) - ", ")))))))) + (let ((package (or (package-replacement package) package))) + (match (package-vulnerabilities package) + (() + #t) + ((vulnerabilities ...) + (let* ((patches (filter-map patch-file-name + (or (and=> (package-source package) + origin-patches) + '()))) + (unpatched (remove (lambda (vuln) + (find (cute string-contains + <> (vulnerability-id vuln)) + patches)) + vulnerabilities))) + (unless (null? unpatched) + (emit-warning package + (format #f (_ "probably vulnerable to ~a") + (string-join (map vulnerability-id unpatched) + ", "))))))))) ;;; diff --git a/tests/lint.scm b/tests/lint.scm index df69d2b4b1..d692b42f93 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -36,6 +36,7 @@ #: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)) @@ -613,6 +614,28 @@ string) on HTTP requests." (patches (list "/a/b/pi-CVE-2015-1234.patch")))))))))) +(test-assert "cve: vulnerability fixed in replacement version" + (mock ((guix scripts lint) package-vulnerabilities + (lambda (package) + (match (package-version package) + ("0" + (list (make-struct (@@ (guix cve) ) 0 + "CVE-2015-1234" + (list (cons (package-name package) + (package-version package)))))) + ("1" + '())))) + (and (not (string-null? + (with-warnings + (check-vulnerabilities + (dummy-package "foo" (version "0")))))) + (string-null? + (with-warnings + (check-vulnerabilities + (dummy-package + "foo" (version "0") + (replacement (dummy-package "foo" (version "1")))))))))) + (test-assert "cve: patched vulnerability in replacement" (mock ((guix scripts lint) package-vulnerabilities (lambda (package) -- cgit v1.2.3