From d6d6a174d176d6fc78bbce8a18bddb17ec74ecc1 Mon Sep 17 00:00:00 2001
From: Piotr Szarmanski
Date: Thu, 3 Aug 2023 16:45:31 +0200
Subject: CLI interface.

---
 src/backup.lisp | 77 ++++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 55 insertions(+), 22 deletions(-)

(limited to 'src/backup.lisp')

diff --git a/src/backup.lisp b/src/backup.lisp
index 8efdaca..d0eee87 100644
--- a/src/backup.lisp
+++ b/src/backup.lisp
@@ -66,9 +66,8 @@
       'dir
       :permissions (osicat-file-permissions-to-integer (osicat:file-permissions target-file))
       :name (filename-last-part target-file)
-      :files (let* ((files (uiop:directory*
-                            (make-pathname :directory (namestring target-file)
-                                           :name :wild :type :wild :version :wild)))
+      :files (let* ((files (append (uiop:directory-files (namestring target-file))
+                                   (uiop:subdirectories (namestring target-file))))
                     (table (make-hash-table :size (+ 7 (length files)) :test #'equal)))
                (map nil #'(lambda (file)
                             ;; Handle files that aren't in the ecase
@@ -98,7 +97,7 @@ SECRET can be specified in order to use a specific secret for ERIS encryption.
 This secret is only necessary when writing. If an incremental backup is done,
 the secret used is always the same as in the original repository."
 
-  (declare (type string incremental name)
+  (declare (type (or null string) incremental name)
            (type octet-vector secret)
            (type (or pathname string) directory))
   ;; check for existance of directory
@@ -109,23 +108,25 @@ the secret used is always the same as in the original repository."
         (*eris-secret* secret))
 
     ;; fetch incremental index
-    (let ((incremental-index (when incremental (fetch-index incremental))))
-     (eris:read-capability-to-urn
-      (eris:store-data
-       (cpk:with-named-index 'backup-index
-         (cpk:encode
-          (make-instance 'repository
-                         :files (package-file directory
-                                              :incremental-record
-                                              (if incremental
-                                                  (slot-value incremental-index 'files)
-                                                  nil))
-                         :date (get-universal-time)
-                         :name name
-                         :previous-repository
-                         (eris:read-capability-to-octets (eris:urn-to-read-capability incremental)))))
-       *eris-backend*
-       :secret *eris-secret*)))))
+    (let ((incremental-index (if incremental (fetch-index incremental) nil)))
+      (eris:read-capability-to-urn
+       (eris:store-data
+        (cpk:with-named-index 'backup-index
+          (cpk:encode
+           (make-instance 'repository
+                          :files (package-file directory
+                                               :incremental-record
+                                               (if incremental
+                                                   (slot-value incremental-index 'files)
+                                                   nil))
+                          :date (get-universal-time)
+                          :name name
+                          :previous-repository
+                          (if incremental
+                              (eris:read-capability-to-octets (eris:urn-to-read-capability incremental))
+                              nil))))
+        *eris-backend*
+        :secret *eris-secret*)))))
 
 
 ;;; BACKUP READING
@@ -203,8 +204,40 @@ successive directories and the file-name at the end, such as `(\"home\" \"user\"
 
 (defun list-files (urn backend)
   (let ((*eris-backend* backend))
-    (print-file (slot-value (fetch-index urn) 'files))))
+    (let ((index (fetch-index urn)))
+      (print-file (slot-value index 'files)))))
 
 (defun metadata (urn backend)
   (let ((*eris-backend* backend))
     (print-repository (fetch-index urn))))
+
+(defun search-predicate (predicate urn backend)
+  "Return a list of files that return non-nil when applied to PREDICATE"
+  (let ((*eris-backend* backend))
+    (let ((index (fetch-index urn)))
+      (fmap-over-dir
+       (lambda (f) (if (funcall predicate f) f nil))
+       (slot-value index 'files)))))
+
+(defun search-regexp (regexp urn backend)
+  "Return a list of files whose names match REGEXP."
+  (let ((scanner (ppcre:create-scanner regexp)))
+    (search-predicate (lambda (file) (ppcre:scan scanner (slot-value file 'name)))
+                      urn backend)))
+
+
+(defmacro collect-if (expr collector)
+  (alexandria:with-gensyms (v)
+    `(let ((,v ,expr))
+       (if ,v (,collector ,v)))))
+
+(defun fmap-over-dir (fn dir)
+  "Apply FN to each file under DIR, excluding directories. A list of non-nil
+return values of FN is returned.."
+  (mvlet ((lfiles ldirs
+                  (with-collectors (cfiles cdirs)
+                    (loop for i being the hash-value of (slot-value dir 'files)
+                          do (typecase i
+                               (dir (collect-if (fmap-over-dir fn i) cdirs)) ;; makes a list of lists
+                               (t (collect-if (funcall fn i) cfiles)))))))
+    (apply #'concatenate 'list lfiles ldirs)))
-- 
cgit v1.2.3