add some fstab functions and properties

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

1 files changed, 113 insertions, 0 deletions

diff --git a/src/property/fstab.lisp b/src/property/fstab.lisp
new file mode 100644
index 0000000..a57f8ba
--- /dev/null
+++ b/src/property/fstab.lisp
@@ -0,0 +1,113 @@
+;;; Consfigurator -- Lisp declarative configuration management system
+
+;;; Copyright (C) 2021  Sean Whitton <spwhitton@spwhitton.name>
+
+;;; This file is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3, or (at your option)
+;;; any later version.
+
+;;; This file is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(in-package :consfigurator.property.fstab)
+(named-readtables:in-readtable :consfigurator)
+
+;;; Use of findmnt(1) makes much of this Linux-specific.
+
+;;;; Methods on volumes to get strings for fstab
+
+(defun get-findmnt-field (mountpoint field)
+  (stripln (run "findmnt" "-nro" field mountpoint)))
+
+(defmethod fs-spec ((volume filesystem))
+  "Default implementation: no known source.
+Other properties might fill it in."
+  "none")
+
+(defmethod fs-spec ((volume mounted-ext4-filesystem))
+  (strcat "UUID=" (get-findmnt-field (mount-point volume) "UUID")))
+
+(defmethod fs-spec ((volume mounted-fat32-filesystem))
+  (strcat "PARTUUID=" (get-findmnt-field (mount-point volume) "PARTUUID")))
+
+(defmethod fs-file ((volume filesystem))
+  (mount-point volume))
+
+(defmethod fs-vfstype ((volume ext4-filesystem))
+  "ext4")
+
+(defmethod fs-vfstype ((volume fat32-filesystem))
+  "vfat")
+
+(defmethod fs-mntops ((volume filesystem))
+  (or (mount-options volume) '("none")))
+
+(defmethod fs-freq ((volume filesystem))
+  0)
+
+(defmethod fs-passno ((volume filesystem))
+  (if (eql #P"/" (mount-point volume))
+      1 2))
+
+(defmethod volume->entry ((volume filesystem))
+  (format nil "~A ~A ~A ~{~A~^,~} ~A ~A"
+          (fs-spec volume) (fs-file volume)
+          (fs-vfstype volume) (fs-mntops volume)
+          (fs-freq volume) (fs-passno volume)))
+
+
+;;;; Properties
+
+(defun entry->source (entry)
+  (car (split-string entry)))
+
+(defun entry->mountpoint (entry)
+  (cadr (remove "" (split-string entry) :test #'string=)))
+
+(defprop entries :posix (&rest entries)
+  "Ensure that /etc/fstab contains each of ENTRIES, using a simple merge
+procedure: existing lines of the fstab with the same mount point as any of
+ENTRIES are updated to match the corresponding members of ENTRIES, except that
+if the first field of the existing entry is not \"none\" and the corresponding
+member of ENTRIES is \"none\", use the existing field value.
+
+This makes it easy to update mount options without having to specify the
+partition or filesystem UUID in your Consfig."
+  (:desc (format nil "fstab entries for ~{~A~^, ~}"
+                 (mapcar #'entry->mountpoint entries)))
+  (:apply
+   (file:map-file-lines
+    #P"/etc/fstab"
+    (lambda (lines)
+      (let ((pending (make-hash-table :test #'equal)))
+        (dolist (entry entries)
+          (setf (gethash (entry->mountpoint entry) pending) entry))
+        (loop for line in lines
+              for line-source = (entry->source line)
+              and line-mountpoint = (entry->mountpoint line)
+              for entry = (let ((entry (gethash line-mountpoint pending)))
+                            (if (and (string= (entry->source entry) "none")
+                                     (not (string= line-source "none")))
+                                (format nil "~A ~{~A~^ ~}"
+                                        line-source (cdr (split-string entry)))
+                                entry))
+              if entry
+                collect it into accum and do (remhash line-mountpoint pending)
+              else collect line into accum
+              finally (return (nconc accum (hash-table-values pending)))))))))
+
+(defprop entries-for-volumes :posix ()
+  "Add or update entries in /etc/fstab for the host's volumes, as specified with
+DISK:HAS-VOLUMES."
+  (:desc (strcat "fstab entries for host's volumes"))
+  (:hostattrs (os:required 'os:linux))
+  (:apply (apply #'entries
+                 (mapcar #'volume->entry
+                         (mapcan (curry #'subvolumes-of-type 'filesystem)
+                                 (get-hostattrs :volumes))))))