diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/backup.lisp | 77 | ||||
| -rw-r--r-- | src/cli.lisp | 144 |
2 files changed, 165 insertions, 56 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)))) + |