Init.

1 files changed, 137 insertions, 0 deletions

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))))