;; This file is part of ybackup. ;; Copyright (C) 2023 Piotr Szarmański ;; ybackup is free software: you can redistribute it and/or modify it under the ;; terms of the GNU Lesser General Public License as published by the Free ;; Software Foundation, either version 3 of the License, or (at your option) any ;; later version. ;; ybackup 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 ;; ybackup. If not, see . (in-package :ybackup) #| (defun fetch-configuration () (let ((xdg (uiop:getenv "XDG_CONFIG_DIR"))) (if xdg (setf xdg (concatenate 'string xdg "/ybackup.lisp")) (setf xdg (concatenate 'string (uiop:getenv "HOME") "/.config/ybackup.lisp"))) (ensure-directories-exist xdg) (with-open-file (file xdg :if-does-not-exist :create) (uiop:with-safe-io-syntax (uiop:slurp-stream-form :at nil))))) |# (opts:define-opts (:name :help :description "Print this text" :short #\h :long "help") (:name :backup :description "Directory to backup" :short #\b :long "backup" :arg-parser #'identity :meta-var "DIRECTORY") (:name :read :description "Read a backup to a directory" :short #\r :long "read" :arg-parser #'identity :meta-var "DIRECTORY") (:name :list-files :description "List the files in the repository." :short #\l :long "list") (:name :file-backend :description "Use this for a file-based local backup. The argument is the directory that will contain the ERIS chunks." :long "file-backend" :arg-parser #'identity :meta-var "DIRECTORY") (:name :http-backend :description "Use this for an HTTP-based backup. The argument is the URL which will accept the ERIS chunks." :long "http" :arg-parser #'identity :meta-var "URL") (:name :backend :description "An S-expression that returns a valid eris:backend object." :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 returns nil if the file is to be read or t if it is to be skipped." :long "filter" :meta-var "SEXP" :arg-parser #'read-from-string) (:name :overwrite :description "Set if the program should overwrite existing files when writing from backup. " :long "overwrite") (:name :repo :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. 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 #'(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) (: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) "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 repo secret metadata search extract debug vers incremental) (opts:get-opts) ;; some sanity checks ;; exclusive options (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)) (when vers (print version)) (let ((backend (cond (file-backend (make-instance 'eris:file-backend :directory file-backend)) (http-backend (error "Unimplemented http-backend.")) (backend (eval backend)) (t (error "Choose backend."))))) (cond ;; list files (list-files (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))))