CLI interface.

3 files changed, 167 insertions, 57 deletions

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)))
diff --git a/src/cli.lisp b/src/cli.lisp
index 54c8517..0c2a740 100644
--- a/src/cli.lisp
+++ b/src/cli.lisp
@@ -66,6 +66,23 @@ the ERIS chunks."
    :long "backend"
    :meta-var "SEXP"
    :arg-parser #'read-from-string)
+  (:name :search
+   :description "Searches for the filename in the repository. Prints a URN on successful completion."
+   :long "search"
+   :short #\s
+   :meta-var "FILENAME"
+   :arg-parser #'identity)
+  (:name :extract
+   :description
+   "Extracts a file from the repository. Use with a urn: argument or with --search.
+The file is non-destructively output to the current directory."
+   :long "extract"
+   :short #\e
+   :meta-var "URN")
+  (:name :incremental
+   :description "Set to enable incremental backup. Requires the --repo optio.."
+   :short #\i
+   :long "incremental")
   (:name :filter
    :description
    "A one-argument lambda S-expression that takes a filename as an argument and
@@ -76,56 +93,92 @@ returns nil if the file is to be read or t if it is to be skipped."
   (:name :overwrite
    :description "Set if the program should overwrite existing files when writing from backup. "
    :long "overwrite")
-  (:name :incremental
-   :description "Set to enable incremental backup. Requires the --repo optio.."
-   :short #\i
-   :long "incremental")
   (:name :repo
-   :description "The file that the URN will be written or read from."
+   :description
+   "The file that the URN will be written or read from. If set while using
+--backup, will perform an incremental backup, i.e. non-modified files will not
+be processed (based on mtime)."
    :long "repo"
    :meta-var "FILE OR URN"
    :arg-parser #'identity)
   (:name :secret
-   :description "The secret used for encryption."
+   :description
+   "The secret used for encryption. Must be either NIL for a null-secret or a
+32-long octet vector sexp. If not used, a random secret will be used. Note that
+it is only useful when creating a backup."
    :long "secret"
    :short #\s
    :meta-var "SECRET"
-   :arg-parser #'identity)
+   :arg-parser #'(lambda (arg)
+                   (let ((obj (read-from-string arg)))
+                     (if (null obj) eris:null-secret
+                         (coerce obj 'octet-vector)))))
   (:name :metadata
    :description "Print repository metadata when reading or listing files."
    :long "metadata"
-   :short #\m))
+   :short #\m)
+  (:name :debug
+   :description "Enable debugger."
+   :long "debug")
+  (:name :vers
+   :description "Print version."
+   :long "version"
+   :short #\v))
+
+
+;; Repo S-expression format. This gets printed/read to a file.
+(defstruct repo-file
+  urn
+  (secret (crypto:random-data 32)))
 
 (defun file-or-urn-to-urn (file-or-urn)
-  (if (string-prefix-p "urn:" file-or-urn)
-      file-or-urn
-      (with-open-file (file file-or-urn :direction :input :if-does-not-exist :error)
-        (read-line file))))
+  "This takes as an argument either an urn: link or a file that contains either a
+\"urn:...\" string or the repo-file structure. Returns one value (urn) or two
+values, urn and the secret (OCTET VECTOR). "
+  (cond
+    ((null file-or-urn) nil)
+    ((string-prefix-p "urn:" file-or-urn) file-or-urn)
+    ((uiop:file-exists-p file-or-urn)
+     (let ((repo-file
+             (with-open-file (file file-or-urn :direction :input :if-does-not-exist :error)
+               (read file))))
+       (if (stringp repo-file) repo-file
+           (values (repo-file-urn repo-file)
+                   (coerce (repo-file-secret repo-file) 'octet-vector)))))
+    (t nil)))
+
+(defmacro only-one-of (symbols &body expr)
+  "Make sure that only one of the symbols is bound; otherwise run expr."
+  (alexandria:with-gensyms (v1)
+    `(let ((,v1 0))
+       ,@(loop for i in symbols
+              collecting (list 'when i (list 'setf v1 (list '1+ v1))))
+       (when (> ,v1 1)
+         ,@expr))))
+
 
 (defun main ()
   (restart-case (destructuring-bind (&key help backup read list-files
                                        file-backend http-backend backend
-                                       filter overwrite incremental repo
-                                       secret metadata)
+                                       filter overwrite repo secret metadata
+                                       search extract debug vers incremental)
                     (opts:get-opts)
                   ;; some sanity checks
                   ;; exclusive options
-                  (when (or (and backup read) (and backup list-files) (and read list-files))
-                    (error "Choose one of read, backup, or list."))
-                  (when (or (and backend http-backend) (and backend file-backend) (and file-backend http-backend))
+                  (only-one-of (backup read list-files search)
+                    (error "Choose one of read, backup, list or search."))
+                  (only-one-of (backup read list-files extract)
+                    (error "Choose one of read, backup, list or extract."))
+
+                  (only-one-of (backend http-backend file-backend)
                     (error "Choose one backend."))
 
                   (when help
                     (opts:describe :prefix #.(format nil "ybackup version ~a" version))
                     (opts:exit))
 
-                  ;; repo argument necessary except for backup
-                  #|(when (and (not repo) backup)
-                    (error "Please provide --repo argument."))|#
-
-                  ;; don't save urns to files named urn:
-                  #|(when (and backup repo (string-prefix-p "urn:" repo))
-                    (error "No urns as filenames."))|#
+                  (when vers
+                    (print version))
 
                   (let ((backend
                           (cond
@@ -133,18 +186,41 @@ returns nil if the file is to be read or t if it is to be skipped."
                             (http-backend (error "Unimplemented http-backend."))
                             (backend (eval backend))
                             (t (error "Choose backend.")))))
-                    ;; TODO:
-                    ;; ADD METADATA, SECRET HANDLING (!!!)
                     
                     (cond
+                      ;; list files
                       (list-files
-                       (print (list-files (file-or-urn-to-urn repo) backend))
-                       ())
-                      (backup (let ((urn (make-backup backup backend :incremental incremental)))
-                                (if repo (with-open-file (file repo :direction :output :if-does-not-exist :create
-                                                               :if-exists :new-version)
-                                           (write-string urn file))
-                                    (princ urn))))
-                      (read (read-backup (file-or-urn-to-urn repo) backend read :overwrite overwrite)))
+                       (pprint (list-files (file-or-urn-to-urn repo) backend))
+                       (when metadata (pprint (metadata (file-or-urn-to-urn repo) backend)))
+                       (terpri))
+                      ;; backup
+                      (backup
+                       ;; repo being nil is permissible and simply results in
+                       ;; i-urn and repo-secret := nil
+                       (mvlet* ((incremental-urn repo-secret (file-or-urn-to-urn repo))
+                                (secret (cond
+                                          (secret secret)
+                                          (repo-secret repo-secret)
+                                          (t (crypto:random-data 32)))))
+                         (let ((urn (make-backup
+                                     backup
+                                     backend
+                                     :incremental (and incremental incremental-urn)
+                                     :secret secret)))
+                           ;; rename here saves the previous file, at least on
+                           ;; SBCL
+                           (if repo (with-open-file (file repo :direction :output :if-exists :rename)
+                                      (pprint (make-repo-file :urn urn :secret secret) file))
+                               (pprint (make-repo-file :urn urn :secret secret)))
+                           (terpri))))
+                      
+                      (read (read-backup (file-or-urn-to-urn repo) backend read :overwrite overwrite))
+                      (extract (print "TODO: make this work")
+                              (opts:exit))
+                      (search (pprint
+                               (map 'list #'print-file
+                                    (search-regexp search (file-or-urn-to-urn repo) backend)))
+                              (terpri)))
                     (opts:exit)))
     (exit () (opts:exit))))
+
diff --git a/ybackup.asd b/ybackup.asd
index 529c0a1..b2dd7b2 100644
--- a/ybackup.asd
+++ b/ybackup.asd
@@ -1,7 +1,8 @@
 (defsystem "ybackup"
   :author "mail@ykonai.net"
   :license "LGPLv3 or later"
-  :depends-on ("eris" "serapeum" "alexandria" "cl-conspack" "osicat" "unix-opts" "bit-smasher" "local-time")
+  :depends-on ("eris" "serapeum" "alexandria" "cl-conspack" "osicat" "unix-opts" "bit-smasher" "local-time"
+                      "ironclad" "cl-ppcre")
   :components
   ((:module "src"
     :serial t