From ad1ad2a2e3200a2de050a5a7560c7c806122e880 Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Fri, 30 Apr 2021 17:22:31 -0700
Subject: implement updating the newly installed system's fstab

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
---
 src/package.lisp            |  6 +++++-
 src/property/fstab.lisp     | 12 ++++++++++++
 src/property/installer.lisp | 17 +++++++++++------
 src/util.lisp               |  5 +++++
 4 files changed, 33 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/package.lisp b/src/package.lisp
index 2920958..112b648 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -6,6 +6,7 @@
   (:shadowing-import-from #:uiop
                           #:strcat
                           #:string-prefix-p
+                          #:string-suffix-p
                           #:split-string
                           #:last-char
                           #:escape-sh-command
@@ -32,6 +33,7 @@
   (:export ;; re-export from UIOP
            #:strcat
            #:string-prefix-p
+           #:string-suffix-p
            #:split-string
            #:last-char
            #:escape-sh-command
@@ -65,6 +67,7 @@
            #:plist-to-cmd-args
 	   #:with-local-temporary-directory
            #:pathname-file
+           #:drop-trailing-slash
            #:quote-nonselfeval
            #:define-print-object-for-structlike
            #:chroot-pathname
@@ -416,7 +419,8 @@
                     (#:file  #:consfigurator.property.file))
   (:export #:volume->entry
            #:entry-for-mountpoint
-           #:entries-for-volumes))
+           #:entries-for-volumes
+           #:entries-for-opened-volumes))
 
 (defpackage :consfigurator.property.gnupg
   (:use #:cl #:consfigurator)
diff --git a/src/property/fstab.lisp b/src/property/fstab.lisp
index fb23767..68bce6a 100644
--- a/src/property/fstab.lisp
+++ b/src/property/fstab.lisp
@@ -111,3 +111,15 @@ DISK:HAS-VOLUMES."
                  (mapcar #'volume->entry
                          (mapcan (curry #'subvolumes-of-type 'filesystem)
                                  (get-hostattrs :volumes))))))
+
+(defprop entries-for-opened-volumes :posix ()
+  "Add or update entries in /etc/fstab for currently open volumes.
+
+This is used when building disk images and installing operating systems."
+  (:desc "fstab entries for opened volumes")
+  (:hostattrs (os:required 'os:linux))
+  (:apply
+   (apply #'entries
+          (mapcar #'volume->entry
+                  (mapcan (curry #'subvolumes-of-type 'mounted-filesystem)
+                          (get-connattr :opened-volumes))))))
diff --git a/src/property/installer.lisp b/src/property/installer.lisp
index 11d7062..95f0fb5 100644
--- a/src/property/installer.lisp
+++ b/src/property/installer.lisp
@@ -31,22 +31,27 @@
         (strcat (unix-namestring chroot) "/")
         (strcat (unix-namestring target) "/"))))
 
-(defpropspec chroot-installed-to-volumes :posix (host chroot volumes)
+(defpropspec chroot-installed-to-volumes :lisp (host chroot volumes)
   "Where CHROOT contains the root filesystem of HOST and VOLUMES is a list of
 volumes, recursively open the volumes and rsync in the contents of CHROOT.
 Also update the fstab and crypttab, and try to install a bootloader."
   (:desc #?"${chroot} installed to volumes")
-  (let ((target (ensure-directory-pathname
-                 (strcat (unix-namestring chroot) ".target"))))
+  (let ((target
+          (ensure-directory-pathname
+           (strcat
+            (drop-trailing-slash
+             (unix-namestring (ensure-directory-pathname chroot)))
+            ".target"))))
     `(with-these-open-volumes (,volumes :mount-below ,target)
+       (%update-target-from-chroot ,chroot ,target)
        (chroot:deploys-these
-        ,chroot ,host
+        ,target ,host
         ,(make-propspec
           :systems nil
           :propspec
           '(eseqprops
-            ;; TODO (fstab:entries-for-opened-volumes)
+            (fstab:entries-for-opened-volumes)
             (file:lacks-lines "/etc/fstab" "# UNCONFIGURED FSTAB FOR BASE SYSTEM"))))
        ;; TODO Update /etc/crypttab
        ;; TODO Install bootloader
-       (%update-target-from-chroot ,chroot ,target))))
+       )))
diff --git a/src/util.lisp b/src/util.lisp
index a109720..d9a6e2c 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -149,6 +149,11 @@ one solution is to convert your property to a :LISP property."
   (namestring
    (enough-pathname pathname (pathname-directory-pathname pathname))))
 
+(defun drop-trailing-slash (namestring)
+  (if (string-suffix-p namestring "/")
+      (subseq namestring 0 (1- (length namestring)))
+      namestring))
+
 (defmacro quote-nonselfeval (x)
   (once-only (x)
     `(if (member (type-of ,x) '(cons symbol))
-- 
cgit v1.2.3