diff options
Diffstat (limited to 'src/cli.lisp')
| -rw-r--r-- | src/cli.lisp | 144 |
1 files changed, 110 insertions, 34 deletions
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)))) + |