From 5e5d6613a3837586ccab51cd988b44c7df99253b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 23 Apr 2018 14:33:11 +0200 Subject: download: Use ungrafted tools in 'url-fetch/tarbomb' and 'url-fetch/zipbomb'. Fixes . Reported by Diego Nicola Barbato . * guix/download.scm (url-fetch/tarbomb): Pass #:graft? #f to 'gexp->derivation'. (url-fetch/zipbomb): Likewise. --- guix/download.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index 5044534bf5..7aa6c03665 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2013, 2014, 2015 Andreas Enge ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2016 Alex Griffin @@ -509,6 +509,8 @@ own. This helper makes it easier to deal with \"tar bombs\"." #:system system #:guile guile))) ;; Take the tar bomb, and simply unpack it as a directory. + ;; Use ungrafted tar/gzip so that the resulting tarball doesn't depend on + ;; whether grafts are enabled. (gexp->derivation (or name file-name) #~(begin (mkdir #$output) @@ -516,6 +518,7 @@ own. This helper makes it easier to deal with \"tar bombs\"." (chdir #$output) (zero? (system* (string-append #$tar "/bin/tar") "xf" #$drv))) + #:graft? #f #:local-build? #t))) (define* (url-fetch/zipbomb url hash-algo hash @@ -539,12 +542,15 @@ own. This helper makes it easier to deal with \"zip bombs\"." #:system system #:guile guile))) ;; Take the zip bomb, and simply unpack it as a directory. + ;; Use ungrafted unzip so that the resulting tarball doesn't depend on + ;; whether grafts are enabled. (gexp->derivation (or name file-name) #~(begin (mkdir #$output) (chdir #$output) (zero? (system* (string-append #$unzip "/bin/unzip") #$drv))) + #:graft? #f #:local-build? #t))) (define* (download-to-store store url #:optional (name (basename url)) -- cgit v1.2.3 From 6ddb59607be810caa1aa40b402b38564d8d9a6bc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Apr 2018 15:31:37 +0200 Subject: guix system: Report wrong file system 'device' fields. Previously, if you wrote (device "my-label") without (title 'label), you'd get: guix system: error: stat: No such file or directory: "my-label" Now you get a proper error and a hint. Reported by Pierre-Antoine Rouby. * guix/scripts/system.scm (check-file-system-availability)[literal]: New variable. Loop over LITERAL. * gnu/system/file-systems.scm (%pseudo-file-system-types): New variable. * guix/ui.scm (display-hint): Make public. --- gnu/system/file-systems.scm | 9 ++++++++- guix/scripts/system.scm | 24 +++++++++++++++++++++++- guix/ui.scm | 1 + 3 files changed, 32 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 7f5afb00fe..c0c635508c 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,6 +47,7 @@ spec->file-system specification->file-system-mapping + %pseudo-file-system-types %fuse-control-file-system %binary-format-file-system %shared-memory-file-system @@ -203,6 +204,12 @@ TARGET in the other system." ;;; Common file systems. ;;; +(define %pseudo-file-system-types + ;; List of know pseudo file system types. This is used when validating file + ;; system definitions. + '("binfmt_misc" "cgroup" "devpts" "devtmpfs" "fusectl" + "proc" "sysfs" "tmpfs")) + (define %fuse-control-file-system ;; Control file system for Linux' file systems in user-space (FUSE). (file-system diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index b50cabcd1a..af501eb8f7 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -583,7 +583,8 @@ any, are available. Raise an error if they're not." (define relevant (filter (lambda (fs) (and (file-system-mount? fs) - (not (string=? "tmpfs" (file-system-type fs))) + (not (member (file-system-type fs) + %pseudo-file-system-types)) (not (memq 'bind-mount (file-system-flags fs))))) file-systems)) @@ -592,6 +593,11 @@ any, are available. Raise an error if they're not." (eq? (file-system-title fs) 'label)) relevant)) + (define literal + (filter (lambda (fs) + (eq? (file-system-title fs) 'device)) + relevant)) + (define uuid (filter (lambda (fs) (eq? (file-system-title fs) 'uuid)) @@ -610,6 +616,22 @@ any, are available. Raise an error if they're not." (set! fail? #t) (format (current-error-port) args ...)))))) + (for-each (lambda (fs) + (catch 'system-error + (lambda () + (stat (file-system-device fs))) + (lambda args + (let ((errno (system-error-errno args)) + (device (file-system-device fs))) + (error (G_ "~a: error: device '~a' not found: ~a~%") + (file-system-location* fs) device + (strerror errno)) + (unless (string-prefix? "/" device) + (display-hint (format #f (G_ "If '~a' is a file system +label, you need to add @code{(title 'label)} to your @code{file-system} +definition.") + device))))))) + literal) (for-each (lambda (fs) (unless (find-partition-by-label (file-system-device fs)) (error (G_ "~a: error: file system with label '~a' not found~%") diff --git a/guix/ui.scm b/guix/ui.scm index cb49a15c4d..536c36e3fe 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -60,6 +60,7 @@ #:use-module (texinfo string-utils) #:re-export (G_ N_ P_) ;backward compatibility #:export (report-error + display-hint leave make-user-module load* -- cgit v1.2.3