04/05: file-systems: 'disk-partitions' detected partitions from mapped devices.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 49baaff4d2995cc4455843d7249894cb7456d8d5
Author: Ludovic Courtès <address@hidden>
Date:   Thu Oct 27 13:44:13 2016 +0200

    file-systems: 'disk-partitions' detected partitions from mapped devices.
    
    Previously, partitions of mdadm- or cryptsetup-produced block devices
    would not be returned by 'disk-partitions'.
    
    * gnu/build/file-systems.scm (disk-partitions)[last-character]: New
    procedure.
    [partition?]: Add 'name' parameter and rewrite.  Adjust caller.
    * gnu/build/file-systems.scm (ENOENT-safe): Silently ignore ENOMEDIUM.
---
 gnu/build/file-systems.scm |   35 +++++++++++++++++++----------------
 1 file changed, 19 insertions(+), 16 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index f1fccbd..bfc353a 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -192,15 +192,15 @@ not valid header was found."
 
 (define (disk-partitions)
   "Return the list of device names corresponding to valid disk partitions."
-  (define (partition? major minor)
-    (let ((marker (format #f "/sys/dev/block/~a:~a/partition" major minor)))
-      (catch 'system-error
-        (lambda ()
-          (not (zero? (call-with-input-file marker read))))
-        (lambda args
-          (if (= ENOENT (system-error-errno args))
-              #f
-              (apply throw args))))))
+  (define (last-character str)
+    (string-ref str (- (string-length str) 1)))
+
+  (define (partition? name major minor)
+    ;; Select device names that end in a digit, like libblkid's 'probe_all'
+    ;; function does.  Checking for "/sys/dev/block/MAJOR:MINOR/partition"
+    ;; doesn't work for partitions coming from mapped devices.
+    (and (char-set-contains? char-set:digit (last-character name))
+         (> major 2)))                      ;ignore RAM disks and floppy disks
 
   (call-with-input-file "/proc/partitions"
     (lambda (port)
@@ -217,7 +217,7 @@ not valid header was found."
               (match (string-tokenize line)
                 (((= string->number major) (= string->number minor)
                   blocks name)
-                 (if (partition? major minor)
+                 (if (partition? name major minor)
                      (loop (cons name parts))
                      (loop parts))))))))))
 
@@ -232,12 +232,15 @@ warning and #f as the result."
         ;; When running on the hand-made /dev,
         ;; 'disk-partitions' could return partitions for which
         ;; we have no /dev node.  Handle that gracefully.
-        (if (= ENOENT (system-error-errno args))
-            (begin
-              (format (current-error-port)
-                      "warning: device '~a' not found~%" device)
-              #f)
-            (apply throw args))))))
+        (let ((errno (system-error-errno args)))
+          (cond ((= ENOENT errno)
+                 (format (current-error-port)
+                         "warning: device '~a' not found~%" device)
+                 #f)
+                ((= ENOMEDIUM errno)              ;for removable media
+                 #f)
+                (else
+                 (apply throw args))))))))
 
 (define (partition-predicate read field =)
   "Return a predicate that returns true if the FIELD of partition header that