diff options
Diffstat (limited to 'src/backup.lisp')
| -rw-r--r-- | src/backup.lisp | 77 |
1 files changed, 55 insertions, 22 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))) |