diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/examples/bare-bones.tmpl | 4 | ||||
| -rw-r--r-- | gnu/system/examples/desktop.tmpl | 6 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 50 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 5 |
4 files changed, 17 insertions, 48 deletions
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index dc5cfc81a4..87e8d1e93c 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -10,11 +10,11 @@ (timezone "Europe/Berlin") (locale "en_US.UTF-8") - ;; Assuming /dev/sdX is the target hard disk, and "root" is + ;; Assuming /dev/sdX is the target hard disk, and "my-root" is ;; the label of the target root file system. (bootloader (grub-configuration (device "/dev/sdX"))) (file-systems (cons (file-system - (device "root") + (device "my-root") (title 'label) (mount-point "/") (type "ext4")) diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl index ee660e0589..07183a533b 100644 --- a/gnu/system/examples/desktop.tmpl +++ b/gnu/system/examples/desktop.tmpl @@ -10,11 +10,11 @@ (timezone "Europe/Paris") (locale "en_US.UTF-8") - ;; Assuming /dev/sdX is the target hard disk, and "root" is - ;; the label of the target root file system. + ;; Assuming /dev/sdX is the target hard disk, and "my-root" + ;; is the label of the target root file system. (bootloader (grub-configuration (device "/dev/sdX"))) (file-systems (cons (file-system - (device "root") + (device "my-root") (title 'label) (mount-point "/") (type "ext4")) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 0a4b385fe3..d93044ce04 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,13 +18,13 @@ (define-module (gnu system file-systems) #:use-module (ice-9 match) - #:use-module (ice-9 regex) #:use-module (guix gexp) #:use-module (guix records) #:use-module (guix store) - #:use-module (rnrs bytevectors) - #:use-module ((gnu build file-systems) #:select (uuid->string)) - #:re-export (uuid->string) + #:use-module ((gnu build file-systems) + #:select (string->uuid uuid->string)) + #:re-export (string->uuid + uuid->string) #:export (<file-system> file-system file-system? @@ -35,12 +35,12 @@ file-system-needed-for-boot? file-system-flags file-system-options + file-system-mount? file-system-check? file-system-create-mount-point? file-system-dependencies file-system->spec - string->uuid uuid %fuse-control-file-system @@ -93,6 +93,8 @@ (default '())) (options file-system-options ; string or #f (default #f)) + (mount? file-system-mount? ; Boolean + (default #t)) (needed-for-boot? %file-system-needed-for-boot? ; Boolean (default #f)) (check? file-system-check? ; Boolean @@ -112,43 +114,9 @@ file system." "Return a list corresponding to file-system FS that can be passed to the initrd code." (match fs - (($ <file-system> device title mount-point type flags options _ check?) + (($ <file-system> device title mount-point type flags options _ _ check?) (list device title mount-point type flags options check?)))) -(define %uuid-rx - ;; The regexp of a UUID. - (make-regexp "^([[:xdigit:]]{8})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{4})-([[:xdigit:]]{12})$")) - -(define (string->uuid str) - "Parse STR as a DCE UUID (see <https://tools.ietf.org/html/rfc4122>) and -return its contents as a 16-byte bytevector. Return #f if STR is not a valid -UUID representation." - (and=> (regexp-exec %uuid-rx str) - (lambda (match) - (letrec-syntax ((hex->number - (syntax-rules () - ((_ index) - (string->number (match:substring match index) - 16)))) - (put! - (syntax-rules () - ((_ bv index (number len) rest ...) - (begin - (bytevector-uint-set! bv index number - (endianness big) len) - (put! bv (+ index len) rest ...))) - ((_ bv index) - bv)))) - (let ((time-low (hex->number 1)) - (time-mid (hex->number 2)) - (time-hi (hex->number 3)) - (clock-seq (hex->number 4)) - (node (hex->number 5)) - (uuid (make-bytevector 16))) - (put! uuid 0 - (time-low 4) (time-mid 2) (time-hi 2) - (clock-seq 2) (node 6))))))) - (define-syntax uuid (lambda (s) "Return the bytevector corresponding to the given UUID representation." diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 1492a0bb1c..3cba400a57 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -391,7 +391,8 @@ environment with the store shared with the host. MAPPINGS is a list of (source (file-system-device fs))) (or (string=? target (%store-prefix)) (string=? target "/") - (string-prefix? "/dev/" source)))) + (and (eq? 'device (file-system-title fs)) + (string-prefix? "/dev/" source))))) (operating-system-file-systems os))) (operating-system (inherit os) |