blob: 658690f26d3eb183d56ab441f0109d619498e9ff (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
;; 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 <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))))
|
