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