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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
;; 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/>.
(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 :search
:description "Searches for the filename in the repository. Prints a URN on successful completion."
:long "search"
:short #\s
:meta-var "FILENAME"
:arg-parser #'identity)
(:name :extract
:description
"Extracts a file from the repository. Use with a urn: argument or with --search.
The file is non-destructively output to the current directory."
:long "extract"
:short #\e
:meta-var "URN")
(:name :incremental
:description "Set to enable incremental backup. Requires the --repo optio.."
:short #\i
:long "incremental")
(: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 :repo
:description
"The file that the URN will be written or read from. If set while using
--backup, will perform an incremental backup, i.e. non-modified files will not
be processed (based on mtime)."
:long "repo"
:meta-var "FILE OR URN"
:arg-parser #'identity)
(:name :secret
:description
"The secret used for encryption. Must be either NIL for a null-secret or a
32-long octet vector sexp. If not used, a random secret will be used. Note that
it is only useful when creating a backup."
:long "secret"
:short #\s
:meta-var "SECRET"
:arg-parser #'(lambda (arg)
(let ((obj (read-from-string arg)))
(if (null obj) eris:null-secret
(coerce obj 'octet-vector)))))
(:name :metadata
:description "Print repository metadata when reading or listing files."
:long "metadata"
:short #\m)
(:name :debug
:description "Enable debugger."
:long "debug")
(:name :vers
:description "Print version."
:long "version"
:short #\v))
;; Repo S-expression format. This gets printed/read to a file.
(defstruct repo-file
urn
(secret (crypto:random-data 32)))
(defun file-or-urn-to-urn (file-or-urn)
"This takes as an argument either an urn: link or a file that contains either a
\"urn:...\" string or the repo-file structure. Returns one value (urn) or two
values, urn and the secret (OCTET VECTOR). "
(cond
((null file-or-urn) nil)
((string-prefix-p "urn:" file-or-urn) file-or-urn)
((uiop:file-exists-p file-or-urn)
(let ((repo-file
(with-open-file (file file-or-urn :direction :input :if-does-not-exist :error)
(read file))))
(if (stringp repo-file) repo-file
(values (repo-file-urn repo-file)
(coerce (repo-file-secret repo-file) 'octet-vector)))))
(t nil)))
(defmacro only-one-of (symbols &body expr)
"Make sure that only one of the symbols is bound; otherwise run expr."
(alexandria:with-gensyms (v1)
`(let ((,v1 0))
,@(loop for i in symbols
collecting (list 'when i (list 'setf v1 (list '1+ v1))))
(when (> ,v1 1)
,@expr))))
(defun main ()
(restart-case (destructuring-bind (&key help backup read list-files
file-backend http-backend backend
filter overwrite repo secret metadata
search extract debug vers incremental)
(opts:get-opts)
;; some sanity checks
;; exclusive options
(only-one-of (backup read list-files search)
(error "Choose one of read, backup, list or search."))
(only-one-of (backup read list-files extract)
(error "Choose one of read, backup, list or extract."))
(only-one-of (backend http-backend file-backend)
(error "Choose one backend."))
(when help
(opts:describe :prefix #.(format nil "ybackup version ~a, licensed under the GPLv3" version))
(opts:exit))
(when vers
(print version))
(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.")))))
(cond
;; list files
(list-files
(pprint (list-files (file-or-urn-to-urn repo) backend))
(when metadata (pprint (metadata (file-or-urn-to-urn repo) backend)))
(terpri))
;; backup
(backup
;; repo being nil is permissible and simply results in
;; i-urn and repo-secret := nil
(mvlet* ((incremental-urn repo-secret (file-or-urn-to-urn repo))
(secret (cond
(secret secret)
(repo-secret repo-secret)
(t (crypto:random-data 32)))))
(let ((urn (make-backup
backup
backend
:incremental (and incremental incremental-urn)
:secret secret)))
;; rename here saves the previous file, at least on
;; SBCL
(if repo (with-open-file (file repo :direction :output :if-exists :rename)
(pprint (make-repo-file :urn urn :secret secret) file))
(pprint (make-repo-file :urn urn :secret secret)))
(terpri))))
(read (read-backup (file-or-urn-to-urn repo) backend read :overwrite overwrite))
(extract (print "TODO: make this work")
(opts:exit))
(search (pprint
(map 'list #'print-file
(search-regexp search (file-or-urn-to-urn repo) backend)))
(terpri)))
(opts:exit)))
(exit () (opts:exit))))
|
