guix system: 'docker-image' honors '--network'.

[jackhill/guix/guix.git] / gnu / system / uuid.scm

diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index e422e06..225959e 100644 (file)
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -42,7 +43,8 @@
             string->ext3-uuid
             string->ext4-uuid
             string->btrfs-uuid
-            string->fat32-uuid
+            string->fat-uuid
+            string->jfs-uuid
             iso9660-uuid->string
 
             ;; XXX: For lack of a better place.
@@ -164,25 +166,25 @@ ISO9660 UUID representation."
 
 \f
 ;;;
-;;; FAT32.
+;;; FAT32/FAT16.
 ;;;
 
-(define-syntax %fat32-endianness
-  ;; Endianness of FAT file systems.
+(define-syntax %fat-endianness
+  ;; Endianness of FAT32/FAT16 file systems.
   (identifier-syntax (endianness little)))
 
-(define (fat32-uuid->string uuid)
-  "Convert fat32 UUID, a 4-byte bytevector, to its string representation."
-  (let ((high  (bytevector-uint-ref uuid 0 %fat32-endianness 2))
-        (low (bytevector-uint-ref uuid 2 %fat32-endianness 2)))
-    (format #f "~:@(~x-~x~)" low high)))
+(define (fat-uuid->string uuid)
+  "Convert FAT32/FAT16 UUID, a 4-byte bytevector, to its string representation."
+  (let ((high  (bytevector-uint-ref uuid 0 %fat-endianness 2))
+        (low (bytevector-uint-ref uuid 2 %fat-endianness 2)))
+    (format #f "~:@(~4,'0x-~4,'0x~)" low high)))
 
-(define %fat32-uuid-rx
+(define %fat-uuid-rx
   (make-regexp "^([[:xdigit:]]{4})-([[:xdigit:]]{4})$"))
 
-(define (string->fat32-uuid str)
-  "Parse STR, which is in FAT32 format, and return a bytevector or #f."
-  (match (regexp-exec %fat32-uuid-rx str)
+(define (string->fat-uuid str)
+  "Parse STR, which is in FAT32/FAT16 format, and return a bytevector or #f."
+  (match (regexp-exec %fat-uuid-rx str)
     (#f
      #f)
     (rx-match
@@ -190,7 +192,7 @@ ISO9660 UUID representation."
                                    (match:substring rx-match 2) 16)
                                   (string->number
                                    (match:substring rx-match 1) 16))
-                            %fat32-endianness
+                            %fat-endianness
                             2))))
 
 \f
@@ -202,6 +204,7 @@ ISO9660 UUID representation."
 (define string->ext3-uuid string->dce-uuid)
 (define string->ext4-uuid string->dce-uuid)
 (define string->btrfs-uuid string->dce-uuid)
+(define string->jfs-uuid string->dce-uuid)
 
 (define-syntax vhashq
   (syntax-rules (=>)
@@ -215,15 +218,15 @@ ISO9660 UUID representation."
 
 (define %uuid-parsers
   (vhashq
-   ('dce 'ext2 'ext3 'ext4 'btrfs 'luks => string->dce-uuid)
-   ('fat32 'fat => string->fat32-uuid)
+   ('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => string->dce-uuid)
+   ('fat32 'fat16 'fat => string->fat-uuid)
    ('iso9660 => string->iso9660-uuid)))
 
 (define %uuid-printers
   (vhashq
-   ('dce 'ext2 'ext3 'ext4 'btrfs 'luks => dce-uuid->string)
+   ('dce 'ext2 'ext3 'ext4 'btrfs 'jfs 'luks => dce-uuid->string)
    ('iso9660 => iso9660-uuid->string)
-   ('fat32 'fat => fat32-uuid->string)))
+   ('fat32 'fat16 'fat => fat-uuid->string)))
 
 (define* (string->uuid str #:optional (type 'dce))
   "Parse STR as a UUID of the given TYPE.  On success, return the
@@ -237,7 +240,7 @@ corresponding bytevector; otherwise return #f."
 ;; This is necessary to serialize bytevectors with the right printer in some
 ;; circumstances.  For instance, GRUB "search --fs-uuid" command compares the
 ;; string representation of UUIDs, not the raw bytes; thus, when emitting a
-;; GRUB 'search' command, we need to procedure the right string representation
+;; GRUB 'search' command, we need to produce the right string representation
 ;; (see <https://debbugs.gnu.org/cgi/bugreport.cgi?msg=52;att=0;bug=27735>).
 (define-record-type <uuid>
   (make-uuid type bv)
@@ -251,7 +254,8 @@ corresponding bytevector; otherwise return #f."
 
 (define-syntax uuid
   (lambda (s)
-    "Return the UUID object corresponding to the given UUID representation."
+    "Return the UUID object corresponding to the given UUID representation or
+#f if the string could not be parsed."
     (syntax-case s (quote)
       ((_ str (quote type))
        (and (string? (syntax->datum #'str))
@@ -266,9 +270,11 @@ corresponding bytevector; otherwise return #f."
        (string? (syntax->datum #'str))
        #'(uuid str 'dce))
       ((_ str)
-       #'(make-uuid 'dce (string->uuid str 'dce)))
+       #'(let ((bv (string->uuid str 'dce)))
+           (and bv (make-uuid 'dce bv))))
       ((_ str type)
-       #'(make-uuid type (string->uuid str type))))))
+       #'(let ((bv (string->uuid str type)))
+           (and bv (make-uuid type bv)))))))
 
 (define uuid->string
   ;; Convert the given bytevector or UUID object, to the corresponding UUID