diff options
| -rw-r--r-- | README | 28 | ||||
| -rw-r--r-- | src/backup.lisp | 210 | ||||
| -rw-r--r-- | src/cli.lisp | 135 | ||||
| -rw-r--r-- | src/index.lisp | 137 | ||||
| -rw-r--r-- | src/package.lisp | 22 | ||||
| -rw-r--r-- | tests/package.lisp | 6 | ||||
| -rw-r--r-- | ybackup.asd | 24 |
7 files changed, 562 insertions, 0 deletions
@@ -0,0 +1,28 @@ +ybackup is an ERIS (http://eris.codeberg.page/)-based backup/archive system. It +takes a directory as an input, and packs all files in that hierarchy into ERIS +data. Each file receives an individual URN, which is recorded along the file +permissions, mtime and the filename in an index. The index reproduces the +file-hierarchy, by representing directories, files and symlinks as objects. + +Features: + ++ Thanks to ERIS, the data is automatically deduplicated. + ++ Convergent encryption by default (i.e. the files are encrypted based on their content) + ++ An additional secret can be used for encryption to protect against attacks on convergent encryption. + ++ Backups are specified by URNs and so are specific files within them, meaning +that you could e.g. share a file with anyone without much effort. + ++ It's transport and storage agnostic and could work on any medium permitting read/write access to 1/32kb blocks of binary data. + ++ Incremental backups. + +Anti-features: + ++ Backups cannot be trivially removed, which means that storage space +consumption will increase as more backups are made; + + + diff --git a/src/backup.lisp b/src/backup.lisp new file mode 100644 index 0000000..82de46e --- /dev/null +++ b/src/backup.lisp @@ -0,0 +1,210 @@ +;; This file is part of ybackup. +;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>. + +;; This file contains the code related to uploading and reading backups. The +;; make-backup, read-backup and list-files functions are the most important. + +(in-package :ybackup) + +(defun filename-last-part (filename) + (let* ((name (namestring filename)) + (end (1- (length name)))) + (loop while (eql #\/ (aref name end)) + do (decf end)) + (subseq name + (or (loop for i from end downto 0 + when (eql #\/ (aref name i)) + return (1+ i)) + 0) + (1+ end)))) + +(defvar *eris-secret* eris:null-secret) +(defvar *eris-backend* nil) + +(defun package-file (target-file &key incremental-record file-predicate) + (declare (ignore file-predicate)) + (ecase (osicat:file-kind target-file :follow-symlinks nil) + (:regular-file + ;; if incremental-record is set and the mtime matches, then ignore it + (if (and incremental-record + (eql (file-write-date target-file) (slot-value incremental-record 'date))) + incremental-record + (let ((read-capability + (eris:read-capability-to-octets + (with-open-file (file target-file :direction :input :element-type 'octet) + (eris:store-data file *eris-backend* :secret *eris-secret*))))) + (declare (type (octet-vector 66) read-capability)) + (make-instance 'file + :date (file-write-date target-file) + :name (filename-last-part target-file) + :permissions (osicat-file-permissions-to-integer (osicat:file-permissions target-file)) + :read-capability read-capability)))) + (:symbolic-link + (if (and incremental-record (eql (file-write-date target-file) (slot-value incremental-record 'date))) + incremental-record + (make-instance + 'symlink + :link (namestring (osicat:read-link target-file)) + :name (filename-last-part target-file) + ;; osicat:file-permissions cannot be used here because it resolves symlinks. Set it to 0 instead. + :permissions 0))) + (:directory + ;; Do not check incremental records here. + (make-instance + '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))) + (table (make-hash-table :size (+ 7 (length files)) :test #'equal))) + (map nil #'(lambda (file) + ;; Handle files that aren't in the ecase + (handler-case + (setf (serapeum:href table (filename-last-part file)) + (package-file + file + :incremental-record + (if incremental-record + (serapeum:href (slot-value incremental-record 'files) + (filename-last-part file)) + nil))) + (type-error () (format t "Warning: file ~a of type ~a ignored." file (osicat:file-kind file :follow-symlinks nil))))) + files) + table))))) + +(defun make-backup (directory backend + &key incremental + (secret eris:null-secret) + (name (local-time:format-rfc3339-timestring nil (local-time:now)))) + "Make a backup of DIRECTORY into BACKEND. + +If INCREMENTAL is a URN, then incrementally backup using that repository. +Otherwise, create a new repository. + +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) + (type octet-vector secret) + (type (or pathname string) directory)) + ;; check for existance of directory + ;; TODO: actual condition + (unless (uiop:directory-exists-p directory) + (error 'error)) + (let ((*eris-backend* backend) + (*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*))))) + + +;;; BACKUP READING + +(defun fetch-index (urn) + (cpk:with-named-index 'backup-index + (cpk:decode + (alexandria:read-stream-content-into-byte-vector + (eris:fetch-data (eris:urn-to-read-capability urn) *eris-backend*))))) + +(defgeneric unpack-file (file directory &key overwrite)) + +(defmethod unpack-file ((file file) directory &key overwrite) + (with-slots (read-capability name permissions) file + (let ((filename (merge-pathnames directory name))) + (with-open-file (stream filename + :direction :output + :if-does-not-exist :create + :if-exists (if overwrite :supersede :error) + :element-type 'octet) + (alexandria:copy-stream + (eris:fetch-data (eris:octets-to-read-capability read-capability) *eris-backend*) + stream)) + (setf (osicat:file-permissions filename) + (integer-to-file-permissions permissions))))) + +(defmethod unpack-file ((symlink symlink) directory &key overwrite) + (with-slots (name link) symlink + (when (and (osicat:file-exists-p (merge-pathnames directory name)) (not overwrite) + ;; TODO: actual error + (error 'error))) + (osicat:make-link (merge-pathnames directory name) + :target link))) + +(defmethod unpack-file ((dir dir) directory &key overwrite) + (with-slots (name permissions files) dir + (let ((next-dir (make-pathname :directory (append1 (pathname-directory directory) name) + :defaults directory))) + (ensure-directories-exist next-dir) + (setf (osicat:file-permissions next-dir) (integer-to-file-permissions permissions)) + (maphash #'(lambda (key value) + (declare (ignore key)) + (unpack-file value next-dir :overwrite overwrite)) + files)))) + +(defun read-backup (urn backend target-directory &key (overwrite nil)) + "Read/unpack the backup into TARGET-DIRECTORY. + +OVERWRITE keyword decides whether to overwrite files. By default, it errors on +encountering existing files. Set to T to overwrite existing files. + +TODO: Add an option to make it just ignore existing files." + (let ((*eris-backend* backend)) + (when (null (pathname-directory target-directory)) + (error 'error)) + (unpack-file (slot-value (fetch-index urn) 'files) target-directory :overwrite overwrite))) + +(defun read-specific-file (urn backend target-directory specific-file) + "Read a specific file from a backend. The file is given as a list containing the +successive directories and the file-name at the end, such as `(\"home\" \"user\" +\"images\" \"dog.png\")'. This does not respect symlinks whatsoever." + (let* ((*eris-backend* backend) + (index-files (slot-value (fetch-index urn) 'files))) + (unless (equal (first specific-file) (slot-value index-files 'name)) + (error 'cl:file-error :pathname specific-file)) + (unpack-file + (loop for i from 0 to (length specific-file) + for file = index-files + then (gethash (nth i specific-file) (slot-value file 'files)) + when (null file) + do (error 'cl:file-error :pathname specific-file) + if (null (nth (1+ i) specific-file)) + return file) + target-directory))) + +(defun list-files (urn backend) + (let ((*eris-backend* backend)) + (print-file (slot-value (fetch-index urn) 'files)))) + +(defun metadata (urn backend) + (let ((*eris-backend* backend)) + (print-repository (fetch-index urn)))) diff --git a/src/cli.lisp b/src/cli.lisp new file mode 100644 index 0000000..2f03425 --- /dev/null +++ b/src/cli.lisp @@ -0,0 +1,135 @@ +(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 :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 :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." + :long "repo" + :meta-var "FILE OR URN" + :arg-parser #'identity) + (:name :secret + :description "The secret used for encryption." + :long "secret" + :short #\s + :meta-var "SECRET" + :arg-parser #'identity) + (:name :metadata + :description "Print repository metadata when reading or listing files." + :long "metadata" + :short #\m)) + +(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)))) + +(defun main () + (restart-case (destructuring-bind (&key help backup read list-files + file-backend http-backend backend + filter overwrite incremental repo + secret metadata) + (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)) + (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."))|# + + (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."))))) + ;; TODO: + ;; ADD METADATA, SECRET HANDLING (!!!) + + (cond + (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))) + (opts:exit))) + (exit () (opts:exit)))) diff --git a/src/index.lisp b/src/index.lisp new file mode 100644 index 0000000..c3fea65 --- /dev/null +++ b/src/index.lisp @@ -0,0 +1,137 @@ +;; This file is part of ybackup. +;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>. + +;; This file contains code related to the repository format and indices. + +(in-package :ybackup) + +(defclass base-file () + ((permissions :initarg :permissions :type (unsigned-byte 16)) + (name :initarg :name :type string))) + +(defclass file (base-file) + ((read-capability :initarg :read-capability :type (simple-array (unsigned-byte 8) (66))) + (date :initarg :date :type (unsigned-byte 64) + :documentation "Modification time of the file."))) + +(defclass dir (base-file) + ((files :initarg :files :type hash-table))) + +(defclass symlink (base-file) + ((link :initarg :link :type string))) + +(defclass previous-repository () + ((date :initarg :date :type (unsigned-byte 64)) + (read-capability :initarg :read-capability :type (octet-vector 66)) + (name :initarg :name :type string))) + +(defclass repository () + ((files :initarg :files :type dir) + (date :initarg :date :type (unsigned-byte 64)) + (name :initarg :name :type string) + (previous-repository :initarg :previous-repository :type (or null (octet-vector 66))))) + +(conspack:defencoding file + permissions name read-capability date) + +(conspack:defencoding dir + permissions name files) + +(conspack:defencoding symlink + permissions name link) + +(conspack:defencoding previous-repository + date read-capability name) + +(conspack:defencoding repository + files date name previous-repository) + +(conspack:define-index backup-index + name permissions read-capability date files link file dir symlink repository previous-repository) + +(alexandria:define-constant permission-flags + '((:user-read 1) + (:user-write 2) + (:user-exec 3) + (:group-read 4) + (:group-write 5) + (:group-exec 6) + (:other-read 7) + (:other-write 8) + (:other-exec 9) + (:set-user-id 10) + (:set-group-id 11) + (:sticky 12) + (t 13)) + :test #'equalp) + + +(-> osicat-file-permissions-to-integer (list) (values (unsigned-byte 16) &optional)) +(-> integer-to-file-permissions ((unsigned-byte 16)) (values list &optional)) + +(defun osicat-file-permissions-to-integer (permissions) + "Convert a list of file permissions as returned by osicat:file-permissions to a +16-bit integer, represented as a set of bit flags." + (let ((flags (make-array 16 :element-type 'bit :initial-element 0))) + (declare (type (simple-bit-vector 16) flags) + (dynamic-extent flags)) + (map nil (lambda (perm) + #.`(ecase perm + ,@(map 'list (lambda (pair) `(,(first pair) (setf (sbit flags ,(second pair)) 1))) + permission-flags))) + permissions) + ;; always set the MSB and LSB so that the integer is always 16-bit + (setf (sbit flags 15) 1 + (sbit flags 0) 1) + (bit-smasher:bits->int flags))) + +(defun integer-to-file-permissions (integer) + (let ((flags (bit-smasher:int->bits integer))) + (declare (type bit-vector flags) + (dynamic-extent flags)) + (declare (type (simple-bit-vector 16) flags)) + (loop for i from 1 to 14 + if (eq 1 (sbit flags i)) + collecting (cdr + (assoc i '#.(loop for (x y) in permission-flags + collecting (cons y x))))))) + +(defgeneric print-file (file) + (:documentation "Return the file object as a S-expression.")) + +(defmethod print-file ((file file)) + (with-slots (permissions name read-capability date) file + (list :file name + (eris:read-capability-to-urn (eris:octets-to-read-capability read-capability)) + (local-time:format-timestring nil (local-time:universal-to-timestamp date)) + permissions))) + +(defmethod print-file ((file symlink)) + (with-slots (permissions name link) file + (list :symlink name :to link))) + +(defmethod print-file ((file dir)) + (with-slots (permissions name files) file + (list :directory name :files (loop for key being the hash-key using (hash-value file) of files + collect (print-file file))))) + +(defun print-repository (repo) + (with-slots (files date name previous-repository) repo + (list :name name :date (local-time:format-timestring nil (local-time:universal-to-timestamp date)) + :files files + :previous-repository (if previous-repository + (eris:read-capability-to-urn + (eris:octets-to-read-capability previous-repository)) + nil)))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..e6885e8 --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,22 @@ +;; This file is part of ybackup. +;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>. + +(defpackage :ybackup + (:use #:common-lisp #:eris #:serapeum) + (:export #:main #:read-backup #:make-backup #:list-files)) + +(in-package :ybackup) + +(alexandria:define-constant version '(0 1) :test #'equalp) diff --git a/tests/package.lisp b/tests/package.lisp new file mode 100644 index 0000000..8183edf --- /dev/null +++ b/tests/package.lisp @@ -0,0 +1,6 @@ +(defpackage :ybackup/test + (:use common-lisp fiveam)) + +(in-package :ybackup/test) +(def-suite ybackup-tests + :description "Root test suite for ybackup.") diff --git a/ybackup.asd b/ybackup.asd new file mode 100644 index 0000000..529c0a1 --- /dev/null +++ b/ybackup.asd @@ -0,0 +1,24 @@ +(defsystem "ybackup" + :author "mail@ykonai.net" + :license "LGPLv3 or later" + :depends-on ("eris" "serapeum" "alexandria" "cl-conspack" "osicat" "unix-opts" "bit-smasher" "local-time") + :components + ((:module "src" + :serial t + :components ((:file "package") + (:file "index") + (:file "backup") + (:file "cli")))) + :in-order-to ((test-op (test-op :ybackup/test)))) + +(defsystem "ybackup/test" + :name "ybackup/test":depends-on ("ybackup" "fiveam") + :perform (test-op (op c) + (symbol-call :fiveam :run! (find-symbol* :ybackup-tests :ybackup/test))) + :components + ((:module "tests" + :serial t + :components ((:file "package")))) + + :entry-point "ybackup:main" + :build-pathname "ybackup") |