ray/scripts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Bug fixes, improvements, parallel download

Browse source
This commit is contained in:
Ray Miller 2025-06-15 15:03:13 +01:00
parent e0d897ec8d
commit 91b7c1b554
1 changed files with 43 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

78
guile/b2-pitr.scm Normal file → Executable file
View file

@ -8,12 +8,13 @@
(ice-9 exceptions)
((ice-9 iconv) #:select (string->bytevector))
(ice-9 match)
(ice-9 threads)
(json)
(oop goops)
(srfi srfi-1)
(srfi srfi-19)
(srfi srfi-26)
(srfi srfi-71)
(srfi srfi-1) ;; lists
(srfi srfi-19) ;; date/time
(srfi srfi-26) ;; cut
(srfi srfi-71) ;; extended let
(web client)
(web http)
(web response)
@ -115,12 +116,25 @@
(close-port body-port)
body))))
(define (list-buckets cli)
(assoc-ref (api-call cli
http-post
"/b2api/v4/b2_list_buckets"
#:payload `(("accountId" . ,(account-id cli))))
"buckets"))
(define* (list-buckets cli #:key bucket-id bucket-name bucket-types)
(let ((params `(("accountId" . ,(account-id cli)))))
(when bucket-id (set! params (assoc-set! params "bucketId" bucket-id)))
(when bucket-name (set! params (assoc-set! params "bucketName" bucket-name)))
(when bucket-types (set! params (assoc-set! params "bucketTypes" bucket-types)))
(assoc-ref (api-call cli
http-post
"/b2api/v4/b2_list_buckets"
#:payload params)
"buckets")))
(define (get-bucket-id cli bucket-name)
(let ((buckets (list-buckets cli #:bucket-name bucket-name)))
(when (zero? (vector-length buckets))
(raise-exception (make-exception
(make-external-error)
(make-exception-with-message "Bucket not found")
(make-exception-with-irritants bucket-name))))
(assoc-ref (vector-ref buckets 0) "bucketId")))
(define* (list-file-versions cli bucket-id #:key prefix delimiter start-file-name start-file-id max-file-count)
(api-call cli http-get "/b2api/v4/b2_list_file_versions"
@ -148,13 +162,6 @@
#:start-file-id next-file-id
#:max-file-count 10000))))))
(define (resolve-bucket-id cli bucket-name)
(let ((bucket (find (lambda (b) (string=? bucket-name (assoc-ref b "bucketName")))
(vector->list (list-buckets cli)))))
(if bucket
(assoc-ref bucket "bucketId")
#f)))
;; Borrowed from guix/build/utils.scm
(define (mkdir-p dir)
"Create directory DIR and all its ancestors."
@ -211,9 +218,9 @@ been deleted. The 'start' and 'folder' actions are not of interest here.
Backblaze creates a file called .bzEmpty in every directory. We never want to
resore these empty files."
(define (latest-before-cutoff files)
(find (lambda (f)
(< (assoc-ref f "uploadTimestamp") cutoff))
files))
(find (lambda (f) (< (assoc-ref f "uploadTimestamp") cutoff)) files))
(define (bz-empty? f)
(string=? ".bzEmpty" (basename (assoc-ref f "fileName"))))
(define (select-by-filename files result)
(if (null? files)
result
@ -224,24 +231,25 @@ resore these empty files."
(if (and batch-latest (string=? "upload" (assoc-ref batch-latest "action")))
(select-by-filename remainder (cons batch-latest result))
(select-by-filename remainder result)))))
(select-by-filename (remove (lambda (f) (string=? ".bzEmpty" (assoc-ref f "fileName"))) files) '()))
(select-by-filename (remove bz-empty? files) '()))
(define (restore cli files target-dir)
(for-each (lambda (f)
(download-file-by-id cli
(assoc-ref f "fileId")
(string-append target-dir "/" (assoc-ref f "fileName"))))
files))
(n-par-for-each 4 (lambda (f)
(download-file-by-id cli
(assoc-ref f "fileId")
(string-append target-dir "/" (assoc-ref f "fileName"))))
files))
(define* (recover-at-point-in-time cli #:key bucket-name cutoff-time target-dir prefix)
(let* ((bucket-id (get-bucket-id cli bucket-name))
(file-versions (list-all-file-versions cli bucket-id #:prefix prefix))
(to-recover (select-for-recovery file-versions cutoff-time)))
(restore cli to-recover target-dir)))
(define (main args)
;; TODO: parse command-line args for bucket name, prefix, cutoff, and target dir.
(define cli (make <b2-client> #:key-id (getenv "BB_KEY_ID") #:app-key (getenv "BB_APP_KEY")))
(define bucket-id (resolve-bucket-id cli "uk-org-1729-server-backups"))
(define bucket-name "uk-org-1729-backups")
(define cutoff (* 1000 (time-second (date->time-utc (string->date "2025-06-01 00:00:00+0000" "~Y-~m-~d ~H:~M:~S~z")))))
(define file-versions (list-all-file-versions cli bucket-id))
(define to-recover (select-for-recovery file-versions cutoff))
(define target-dir "/home/ray/Downloads/uk-org-1729-server-backups")
#f
)
(define target-dir "/home/ray/Downloads/uk-org-1729-backups")
(recover-at-point-in-time cli #:bucket-name bucket-name #:cutoff-time cutoff #:target-dir target-dir))