add DISK:SUBVOLUMES-OF-TYPE & DISK:MOUNT-OPTIONS, and update exports

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

3 files changed, 58 insertions, 25 deletions

diff --git a/consfigurator.asd b/consfigurator.asd
index a6fb562..e09c188 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -30,12 +30,12 @@
                (:file "src/property/cmd")
                (:file "src/property/file")
                (:file "src/property/os")
-               (:file "src/property/disk")
                (:file "src/property/mount")
                (:file "src/property/service")
                (:file "src/property/apt")
                (:file "src/property/chroot")
                (:file "src/property/live-build")
+               (:file "src/property/disk")
                (:file "src/property/user")
                (:file "src/property/git")
                (:file "src/property/gnupg")
diff --git a/src/package.lisp b/src/package.lisp
index 0d63fbf..41425f9 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -272,29 +272,6 @@
            #:required
            #:supports-arch-p))
 
-(defpackage :consfigurator.property.disk
-  (:use #:cl #:alexandria #:consfigurator)
-  (:local-nicknames (#:file    #:consfigurator.property.file)
-                    (#:os      #:consfigurator.property.os))
-  (:export #:volume
-           #:volume-label
-           #:volume-contents
-           #:volume-size
-
-           #:physical-disk
-           #:disk-image
-           #:partitioned-volume
-           #:partition
-           #:lvm-volume-group
-           #:lvm-logical-volume
-           #:lvm-physical-volume
-           #:ext4-filesystem
-           #:fat32-filesystem
-           #:luks-container
-           #:linux-swap
-
-           #:has-volumes))
-
 (defpackage :consfigurator.property.mount
   (:use #:cl #:alexandria #:consfigurator)
   (:local-nicknames (#:os    #:consfigurator.property.os)
@@ -368,6 +345,45 @@
            #:image-built
            #:image-built.))
 
+(defpackage :consfigurator.property.disk
+  (:use #:cl #:alexandria #:consfigurator)
+  (:local-nicknames (#:file    #:consfigurator.property.file)
+                    (#:os      #:consfigurator.property.os))
+  (:export #:volume
+           #:volume-label
+           #:volume-contents
+           #:volume-size
+           #:subvolumes-of-type
+
+           #:physical-disk
+           #:disk-image
+           #:image-file
+           #:raw-disk-image
+           #:opened-raw-disk-image
+           #:partitioned-volume
+           #:opened-partitioned-volume
+           #:partition
+           #:opened-partition
+
+           #:lvm-volume-group
+           #:lvm-logical-volume
+           #:lvm-physical-volume
+
+           #:filesystem
+           #:mount-point
+           #:mount-options
+           #:mounted-filesystem
+           #:ext4-filesystem
+           #:mounted-ext4-filesystem
+           #:fat32-filesystem
+           #:mounted-fat32-filesystem
+
+           #:luks-container
+           #:opened-luks-container
+           #:linux-swap
+
+           #:has-volumes))
+
 (defpackage :consfigurator.property.gnupg
   (:use #:cl #:consfigurator)
   (:export #:public-key-imported))
diff --git a/src/property/disk.lisp b/src/property/disk.lisp
index 7be1c61..2762449 100644
--- a/src/property/disk.lisp
+++ b/src/property/disk.lisp
@@ -60,6 +60,18 @@ plus any metadata (e.g. partition tables), this value will be ignored."))
 
 (define-print-object-for-structlike volume)
 
+(defmethod subvolumes-of-type ((type symbol) (volume volume))
+  "Recursively examine VOLUME and its VOLUME-CONTENTS and return a list of all
+volumes encountered whose type is a subtype of TYPE."
+  (labels ((walk (volume)
+             (let ((contents
+                     (and (slot-boundp volume 'volume-contents)
+                          (mapcan #'walk
+                                  (ensure-cons (volume-contents volume))))))
+               (if (subtypep (type-of volume) type)
+                   (cons volume contents) contents))))
+    (walk volume)))
+
 (defgeneric volume-contents-minimum-size (volume)
   (:documentation
    "Return the minimum size required to accommodate the VOLUME-CONTENTS of VOLUME."))
@@ -358,7 +370,12 @@ unmounted, since the actual mount point is not stored.")
   ((mount-point
     :type pathname
     :initarg :mount-point
-    :accessor mount-point))
+    :accessor mount-point)
+   (mount-options
+    :type list
+    :initform nil
+    :initarg :mount-options
+    :accessor mount-options))
   (:documentation
    "A block device containing a filesystem, which can be mounted."))