unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#41143] [PATCH 1/2] mapped-devices: Allow target to be list of strings
@ 2020-05-09  1:12 tsmish
  2020-05-09  1:22 ` [bug#41143] [PATCH 2/2] mapped-devices: Add 'lvm-device-mapping' tsmish
                   ` (4 more replies)
  0 siblings, 5 replies; 22+ messages in thread
From: tsmish @ 2020-05-09  1:12 UTC (permalink / raw)
  To: 41143

(let ...) stuff should be in function, but I don't know in which
module it should go.
Code is somewhat untested, proceed with caution.

---
 gnu/services/base.scm         |  5 ++++-
 gnu/system.scm                | 13 ++++++++-----
 gnu/system/mapped-devices.scm |  2 +-
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 0c154d1c4e..3d09e8220c 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -408,7 +408,10 @@ FILE-SYSTEM."
 (define (mapped-device->shepherd-service-name md)
   "Return the symbol that denotes the shepherd service of MD, a
<mapped-device>."
   (symbol-append 'device-mapping-
-                 (string->symbol (mapped-device-target md))))
+                 (string->symbol (string-join
+                                  (let ((t (mapped-device-target md)))
+                                    (if (list? t) t (list t)))
+                                  "-"))))

 (define dependency->shepherd-service-name
   (match-lambda
diff --git a/gnu/system.scm b/gnu/system.scm
index 01baa248a2..75632c5e8a 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -390,9 +390,10 @@ marked as 'needed-for-boot'."
     (let ((device (file-system-device fs)))
       (if (string? device)                        ;title is 'device
           (filter (lambda (md)
-                    (string=? (string-append "/dev/mapper/"
-                                             (mapped-device-target md))
-                              device))
+                    (any (cut string=? device <>)
+                         (map (cut string-append "/dev/mapper" <>)
+                              (let ((t (mapped-device-target md)))
+                                (if (list? t) t (list t))))))
                   (operating-system-mapped-devices os))
           '())))

@@ -412,11 +413,13 @@ marked as 'needed-for-boot'."

 (define (mapped-device-users device file-systems)
   "Return the subset of FILE-SYSTEMS that use DEVICE."
-  (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
+  (let ((targets (map (cut string-append "/dev/mapper/" <>)
+                      (let ((t (mapped-device-target device)))
+                        (if (list? t) t (list t))))))
     (filter (lambda (fs)
               (or (member device (file-system-dependencies fs))
                   (and (string? (file-system-device fs))
-                       (string=? (file-system-device fs) target))))
+                       (any (cut string=? (file-system-device fs) <>)
targets))))
             file-systems)))

 (define (operating-system-user-mapped-devices os)
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 7c58f876a3..3339e509e0 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -72,7 +72,7 @@
   make-mapped-device
   mapped-device?
   (source    mapped-device-source)                ;string | list of strings
-  (target    mapped-device-target)                ;string
+  (target    mapped-device-target)                ;string | list of strings
   (type      mapped-device-type)                  ;<mapped-device-kind>
   (location  mapped-device-location
              (default (current-source-location)) (innate)))
-- 
2.26.2




^ permalink raw reply related	[flat|nested] 22+ messages in thread

end of thread, other threads:[~2020-11-25 23:10 UTC | newest]

Thread overview: 22+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-05-09  1:12 [bug#41143] [PATCH 1/2] mapped-devices: Allow target to be list of strings tsmish
2020-05-09  1:22 ` [bug#41143] [PATCH 2/2] mapped-devices: Add 'lvm-device-mapping' tsmish
2020-09-09 20:48   ` Ludovic Courtès
2020-05-14 22:53 ` [bug#41143] Some clarification Mikhail Tsykalov
2020-05-15  1:17 ` [bug#41143] [PATCH] mapped-devices: Document lvm-mapping-device Mikhail Tsykalov
2020-06-06 13:40 ` [bug#41143] [PATCH 1/2] mapped-devices: Allow target to be list of strings Lars-Dominik Braun
2020-06-06 20:16   ` Mikhail Tsykalov
2020-06-07  6:48     ` Lars-Dominik Braun
2020-09-09 20:38 ` Ludovic Courtès
2020-09-24 16:09   ` Mikhail Tsykalov
2020-09-25  9:34     ` Ludovic Courtès
2020-09-25 13:36       ` Mikhail Tsykalov
2020-09-25 16:20         ` Ludovic Courtès
2020-10-01 22:48           ` [bug#41143] [PATCH v2 " Mikhail Tsykalov
2020-10-01 22:49             ` [bug#41143] [PATCH v2 2/2] mapped-devices: Add 'lvm-device-mapping' Mikhail Tsykalov
2020-10-04 10:34               ` Ludovic Courtès
2020-10-04 10:28             ` [bug#41143] [PATCH v2 1/2] mapped-devices: Allow target to be list of strings Ludovic Courtès
2020-11-05  9:48               ` Ludovic Courtès
2020-11-06  9:47                 ` [bug#41143] [PATCH v3 " Mikhail Tsykalov
2020-11-06  9:47                   ` [bug#41143] [PATCH v3 2/2] mapped-devices: Add 'lvm-device-mapping' Mikhail Tsykalov
2020-11-25 23:09                   ` bug#41143: [PATCH v3 1/2] mapped-devices: Allow target to be list of strings Ludovic Courtès
2020-10-01 23:15           ` [bug#41143] [PATCH " Mikhail Tsykalov

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).