Add chunked encrypted S3 sync
ober
8be2819d0d92d52edb66e89f01a4c3039846e817
--- a/Makefile +++ b/Makefile @@ -29,7 +29,7 @@ INSTALL_PREFIX ?= $(HOME)/.local INSTALL_BINDIR ?= $(INSTALL_PREFIX)/bin INSTALL_OPTDIR ?= $(INSTALL_PREFIX)/opt/jerboa-drive -.PHONY: help run test integration doctor binary bundle install linux linux-amd64 linux-arm64 freebsd freebsd-amd64 clean +.PHONY: help run test integration s3-integration doctor binary bundle install linux linux-amd64 linux-arm64 freebsd freebsd-amd64 clean .DEFAULT_GOAL := help help: @@ -40,6 +40,7 @@ help: @echo " make doctor Check native Jerboa implementation status" @echo " make test Run smoke tests" @echo " make integration Run opt-in live Drive test when enabled" + @echo " make s3-integration Run opt-in live encrypted S3 test when enabled" @echo " make clean Remove generated local artifacts" @echo "" @echo "Build:" @@ -81,6 +82,10 @@ integration: $(RUN_ENV) \ $(SCHEME) -q --libdirs $(LIBDIRS) --script test/integration-drive.ss +s3-integration: + $(RUN_ENV) \ + $(SCHEME) -q --libdirs $(LIBDIRS) --script test/integration-s3.ss + binary: $(RUN_ENV) BINARY_LIBDIRS='$(LIBDIRS)' \ JERBOA_CHEZ_PREFIX=$(JERBOA_HOME)/.chez \ --- a/README.md +++ b/README.md @@ -61,8 +61,11 @@ Daily operations: jdrive s3 mkdir /backups jdrive s3 cp ./notes.txt /backups/notes.txt jdrive s3 cp -r ./backup-dir /backups +jdrive s3 sync ./backup-dir /backups --delete +jdrive s3 check ./backup-dir /backups jdrive s3 ls /backups jdrive s3 cat /backups/notes.txt +jdrive s3 cat /backups/notes.txt --offset 0 --size 4096 jdrive s3 get /backups/notes.txt ./notes-restored.txt jdrive s3 rm -r /backups/backup-dir ``` @@ -71,6 +74,11 @@ Set `JDRIVE_VAULT_PASSWORD` or pass `--vault-password-env ENV_NAME` for automation. Set `JDRIVE_PIV_PIN` or pass `--piv-pin-env ENV_NAME` when the profile was initialized with `--yubikey-mode piv`. +Files are stored as independently encrypted chunks by default. Override the +64 MiB default with `--chunk-size N` for testing or provider tuning. `sync` and +`check` support simple `*` wildcards through repeated `--include PATTERN` and +`--exclude PATTERN`. + ## Runtime Status Current runtime code is Scheme/Jerboa only: @@ -107,8 +115,9 @@ Current runtime code is Scheme/Jerboa only: endpoint, credential, region, path-style, and object-key helpers. - [protonstorage/s3/drive.ss](protonstorage/s3/drive.ss) - encrypted S3 drive profile/vault, encrypted manifest, encrypted object upload/download/list, - checksum verification, retry wrappers, and optional YubiKey PIV unlock - material through `jerboa-yubikey`. + chunked encrypted storage, ranged reads, sync/check helpers, checksum + verification, retry wrappers, and optional YubiKey PIV unlock material + through `jerboa-yubikey`. The cloned Go/rclone/Proton client projects under `~/mine` are references only. They are used to map endpoint shapes and crypto behavior while porting. @@ -285,6 +294,7 @@ make linux-arm64 make freebsd-amd64 make test make integration +make s3-integration make doctor make bundle ``` @@ -295,15 +305,21 @@ disposable folder under `PROTONDRIVE_TEST_PARENT_PATH` or `/`, uploads one small file, moves it between two disposable folders, and trashes the disposable root during cleanup. +`make s3-integration` skips unless `JDRIVE_S3_INTEGRATION=1` is set. When +enabled, it requires `JDRIVE_S3_TEST_BUCKET`, uses standard AWS credentials or +`JDRIVE_S3_TEST_AWS_PROFILE`, writes under `JDRIVE_S3_TEST_PREFIX` or a +disposable prefix, syncs two encrypted chunked files, checks them, reads a +range, restores a file, and removes remote test entries. + `make bundle` builds the host binary and writes `dist/protonstorage-<os>-<arch>.tar.gz` with the binary, native Jerboa libraries, and a wrapper that sets the runtime library search path. ## Remaining Work -- Add live S3 integration tests gated by bucket/provider env vars. -- Add chunked streaming reads/writes and multipart encrypted uploads for very - large objects. +- Prove the encrypted S3 live integration against each target provider. +- Add true S3 multipart per encrypted chunk for provider-optimized very large + chunks. - Add full sync/check semantics, include/exclude filters, and conflict policy. - Finish daemon control socket/background lifecycle and durable operation queue. - Add richer metadata update operations beyond size-changing writes and --- a/docs/jerboa-drive-plan.md +++ b/docs/jerboa-drive-plan.md @@ -96,6 +96,8 @@ Completed so far: - `jdrive s3 unlock-test` - `jdrive s3 mkdir` - `jdrive s3 cp [-r]` + - `jdrive s3 sync` + - `jdrive s3 check` - `jdrive s3 ls` - `jdrive s3 cat` - `jdrive s3 get` @@ -105,16 +107,22 @@ Completed so far: - local drive-key vault with `scrypt` and `chacha20-poly1305` - optional built-in `jerboa-yubikey` PIV unlock material - encrypted remote manifest - - opaque encrypted file object keys + - opaque encrypted chunk object keys + - chunked streaming uploads with streaming SHA-256 + - ranged reads across encrypted chunks - recursive upload + - local-to-remote sync + - local-vs-remote check + - simple `*` include/exclude filters - plaintext SHA-256 verification after decrypt - retry wrappers around current S3 object operations + - opt-in live S3 integration hook via `make s3-integration` Remaining: -- Add optional live S3 integration tests gated by env vars. -- Add chunked streaming reads/writes and use S3 multipart for large encrypted - files. -- Prove multipart round-trip against a real S3-compatible bucket. +- Prove live S3 integration against each intended provider. +- Add true S3 multipart inside an encrypted chunk for provider-optimized very + large chunks. +- Add multi-writer conflict protection and richer sync conflict policy. Add or verify these `jerboa-aws` capabilities before building the drive layer: @@ -160,20 +168,20 @@ Acceptance gate: ## Phase 3: Encrypted Drive Data Model -Status: first milestone implemented with a simpler single-manifest, -single-writer layout. The current implementation stores: +Status: chunked encrypted storage is implemented with a simpler +single-manifest, single-writer layout. The current implementation stores: ```text ~/.jdrive/profiles/<profile>/s3.config.json ~/.jdrive/profiles/<profile>/s3.key.vault.json <prefix>/v1/manifest.bin -<prefix>/v1/objects/<hmac-path-id>.bin +<prefix>/v1/objects/<hmac-path-id>/<chunk-index>.bin ``` The manifest and file objects are encrypted with authenticated ChaCha20-Poly1305. The bucket sees opaque object names and encrypted bytes. The next model should evolve this toward generationed manifests, conditional -writes, and chunk objects. +writes, and provider-optimized multipart chunk objects. Object namespace inside bucket: --- a/docs/user-guide.md +++ b/docs/user-guide.md @@ -61,9 +61,9 @@ Implemented today: - Optional encrypted Proton username/password vault protected by a separate password you provide. - S3-compatible encrypted drive profile under `~/.jdrive` with encrypted - manifest, encrypted file objects, recursive upload, list, cat, get, rm, - checksum verification, retry wrappers, and optional built-in YubiKey PIV - unlock material. + manifest, chunked encrypted file objects, recursive upload, sync, check, + list, ranged cat/get, rm, checksum verification, retry wrappers, and optional + built-in YubiKey PIV unlock material. - Host binary build, host bundle build, and Linux/FreeBSD cross-build targets. Important current limitations: @@ -76,9 +76,9 @@ Important current limitations: - Token-only auth can call raw Proton API metadata endpoints. Decrypted Drive listing, reads, writes, and mounts need fresh login key material, so use `--username`, stored credentials, or password environment variables. -- The S3 backend currently has single-writer manifest semantics and whole-file - read/download behavior. Chunked streaming and multipart encrypted uploads are - planned for very large files. +- The S3 backend currently has single-writer manifest semantics. Files are + chunked and encrypted client-side, but true S3 multipart per encrypted chunk + and multi-writer conflict handling are still planned. ## Encrypted S3 Drive @@ -128,8 +128,11 @@ Copy, list, read, restore, and remove files: jdrive s3 mkdir /backups jdrive s3 cp ./notes.txt /backups/notes.txt jdrive s3 cp -r ./backup-dir /backups +jdrive s3 sync ./backup-dir /backups --delete +jdrive s3 check ./backup-dir /backups jdrive s3 ls /backups jdrive s3 cat /backups/notes.txt +jdrive s3 cat /backups/notes.txt --offset 0 --size 4096 jdrive s3 get /backups/notes.txt ./notes-restored.txt jdrive s3 rm -r /backups/backup-dir ``` @@ -137,6 +140,16 @@ jdrive s3 rm -r /backups/backup-dir The bucket sees opaque object keys and encrypted bytes. Filenames and directory structure live in the encrypted manifest. +Tuning and filters: + +```sh +jdrive s3 cp -r ./backup-dir /backups --chunk-size 67108864 +jdrive s3 sync ./backup-dir /backups --include '*.db' --exclude '*tmp*' +``` + +`check` compares local file size and streaming SHA-256 against the encrypted +manifest; it does not trust S3-side ETags or provider hashes. + ## Install Layout Expected source layout: --- a/protonstorage/cli.ss +++ b/protonstorage/cli.ss @@ -80,6 +80,8 @@ " s3 profile-status Show local encrypted S3 profile state\n" " s3 unlock-test Verify S3 profile password/YubiKey unlock\n" " s3 cp [-r] LOCAL REMOTE Upload a file/tree to encrypted S3\n" + " s3 sync LOCAL REMOTE Sync local tree to encrypted S3\n" + " s3 check LOCAL REMOTE Compare local tree to encrypted S3\n" " s3 ls [REMOTE] List encrypted S3 paths\n" " s3 mkdir REMOTE Create encrypted S3 directory marker\n" " s3 cat REMOTE Write decrypted remote bytes to stdout\n" @@ -188,6 +190,12 @@ " --vault-password-env ENV Read S3 drive vault password from env\n" " --yubikey-mode none|piv Optional PIV-backed vault unlock\n" " --piv-pin-env ENV Read YubiKey PIV PIN from env\n" + " --chunk-size N S3 encrypted chunk size, default 67108864\n" + " --offset N Byte offset for s3 cat/get\n" + " --size N Byte count for s3 cat/get, default all\n" + " --include PATTERN Include remote path glob for s3 sync/check\n" + " --exclude PATTERN Exclude remote path glob for s3 sync/check\n" + " --delete Delete remote files missing locally in s3 sync\n" " -r, --recursive Recursive S3 cp/rm\n")) (define (println s) @@ -222,6 +230,13 @@ (let ([p (assoc k opts)]) (and p (cdr p)))) + (define (opts-all opts k) + (let loop ([xs opts] [out '()]) + (cond + [(null? xs) (reverse out)] + [(string=? (caar xs) k) (loop (cdr xs) (cons (cdar xs) out))] + [else (loop (cdr xs) out)]))) + (define drive-flags '(("--uid" . #t) ("--access-token" . #t) @@ -277,6 +292,12 @@ ("--vault-password-env" . #t) ("--yubikey-mode" . #t) ("--piv-pin-env" . #t) + ("--chunk-size" . #t) + ("--offset" . #t) + ("--size" . #t) + ("--include" . #t) + ("--exclude" . #t) + ("--delete" . #f) ("-r" . #f) ("--recursive" . #f))) @@ -1122,7 +1143,7 @@ (define (cmd-s3 args) (if (null? args) - (die 2 "s3 requires a subcommand: status, target, init, profile-status, unlock-test, cp, ls, mkdir, cat, get, rm") + (die 2 "s3 requires a subcommand: status, target, init, profile-status, unlock-test, cp, sync, check, ls, mkdir, cat, get, rm") (let ([action (car args)]) (call-with-values (lambda () (split-opts (cdr args) s3-flags)) @@ -1239,7 +1260,46 @@ material (car pos) (cadr pos) - (recursive-upload? opts))))] + (recursive-upload? opts) + (option-number + opts + "--chunk-size" + jdrive-s3-default-chunk-size))))] + [(string=? action "check") + (unless (= (length pos) 2) + (die 2 "usage: jdrive s3 check LOCAL_PATH REMOTE_PATH")) + (let* ([password (s3-vault-password-from-opts opts)] + [material (s3-yubikey-material-for-profile opts)]) + (print-json + (jdrive-s3-check-local-path! + (profile-option opts) + (state-root-option opts) + password + material + (car pos) + (cadr pos) + (opts-all opts "--include") + (opts-all opts "--exclude"))))] + [(string=? action "sync") + (unless (= (length pos) 2) + (die 2 "usage: jdrive s3 sync LOCAL_PATH REMOTE_PATH [--delete]")) + (let* ([password (s3-vault-password-from-opts opts)] + [material (s3-yubikey-material-for-profile opts)]) + (print-json + (jdrive-s3-sync-local-to-remote! + (profile-option opts) + (state-root-option opts) + password + material + (car pos) + (cadr pos) + (opts-all opts "--include") + (opts-all opts "--exclude") + (and (opt opts "--delete") #t) + (option-number + opts + "--chunk-size" + jdrive-s3-default-chunk-size))))] [(string=? action "cat") (unless (= (length pos) 1) (die 2 "usage: jdrive s3 cat REMOTE_PATH")) @@ -1247,12 +1307,14 @@ [material (s3-yubikey-material-for-profile opts)]) (put-bytevector (current-output-port) - (jdrive-s3-cat-file-bytes + (jdrive-s3-cat-file-range-bytes (profile-option opts) (state-root-option opts) password material - (car pos))))] + (car pos) + (option-number opts "--offset" 0) + (option-number opts "--size" -1))))] [(string=? action "get") (unless (= (length pos) 2) (die 2 "usage: jdrive s3 get REMOTE_PATH LOCAL_PATH")) @@ -1265,7 +1327,9 @@ password material (car pos) - (cadr pos))))] + (cadr pos) + (option-number opts "--offset" 0) + (option-number opts "--size" -1))))] [(or (string=? action "rm") (string=? action "delete")) (unless (= (length pos) 1) (die 2 "usage: jdrive s3 rm [-r] REMOTE_PATH")) --- a/protonstorage/s3/drive.ss +++ b/protonstorage/s3/drive.ss @@ -13,14 +13,20 @@ jdrive-s3-object-id jdrive-s3-encrypt-file-bytes jdrive-s3-decrypt-file-bytes + jdrive-s3-encrypt-chunk-bytes + jdrive-s3-decrypt-chunk-bytes jdrive-s3-empty-manifest jdrive-s3-manifest-add-directory jdrive-s3-manifest-add-file jdrive-s3-manifest-list + jdrive-s3-default-chunk-size jdrive-s3-list! jdrive-s3-mkdir! jdrive-s3-put-local-path! + jdrive-s3-check-local-path! + jdrive-s3-sync-local-to-remote! jdrive-s3-cat-file-bytes + jdrive-s3-cat-file-range-bytes jdrive-s3-get-file! jdrive-s3-remove!) @@ -50,8 +56,10 @@ (define vault-scrypt-p 1) (define manifest-magic (string->utf8 "JDRIVE-MANIFEST-V1\n")) (define file-magic (string->utf8 "JDRIVE-FILE-V1\n")) + (define chunk-magic (string->utf8 "JDRIVE-CHUNK-V1\n")) (define file-content-type "application/octet-stream") (define s3-retry-count 3) + (define jdrive-s3-default-chunk-size (* 64 1024 1024)) (define (json-object . fields) (let ([ht (make-hashtable equal-hash equal?)]) @@ -244,6 +252,35 @@ (outer (cdr xs) (+ offset len))))) out)) + (define (bytevectors-concat bvs) + (apply bytevectors-append bvs)) + + (define (read-file-size path) + (call-with-port + (open-file-input-port path) + (lambda (p) (port-length p)))) + + (define (sha256-context-start) + (let ([ctx (make-digest-ctx)]) + (digest-init! ctx "sha256") + ctx)) + + (define (sha256-context-final-base64 ctx) + (u8vector->base64-string (digest-final! ctx))) + + (define (sha256-base64 bv) + (u8vector->base64-string (sha256 bv))) + + (define (bytevector-empty? bv) + (= (bytevector-length bv) 0)) + + (define (number-pad-left n width) + (let ([s (number->string n)]) + (let loop ([s s]) + (if (>= (string-length s) width) + s + (loop (string-append "0" s)))))) + (define hex-digits "0123456789abcdef") (define (bytevector->hex bv) @@ -360,6 +397,16 @@ (define (file-aad path object-id) (string->utf8 (string-append "jerboa-drive s3 file v1\n" path "\n" object-id))) + (define (chunk-aad path object-id index) + (string->utf8 + (string-append + "jerboa-drive s3 chunk v1\n" + path + "\n" + object-id + "\n" + (number->string index)))) + (define (config-object bucket prefix endpoint region aws-profile path-style?) (json-object "Version" profile-version @@ -453,6 +500,16 @@ (define (object-storage-key config object-id) (remote-object-key config (string-append "v1/objects/" object-id ".bin"))) + (define (chunk-storage-key config object-id index) + (remote-object-key + config + (string-append + "v1/objects/" + object-id + "/" + (number-pad-left index 8) + ".bin"))) + (define (remote-path-normalize path) (let ([path (nonempty-string 'remote-path-normalize 'path path)]) (let ([path @@ -488,6 +545,121 @@ (define (skip-directory-entry? name) (or (string=? name ".") (string=? name ".."))) + (define (inc-summary! summary key) + (hashtable-set! summary key (+ (hashtable-ref summary key 0) 1))) + + (define (add-summary! summary key amount) + (hashtable-set! summary key (+ (hashtable-ref summary key 0) amount))) + + (define (summary-list summary key) + (let ([value (hashtable-ref summary key '())]) + (if (list? value) value '()))) + + (define (record-stale-object-keys! summary old-entry new-keys) + (when old-entry + (for-each + (lambda (old-key) + (unless (string-list-member? old-key new-keys) + (hashtable-set! + summary + "StaleObjectKeys" + (cons old-key (summary-list summary "StaleObjectKeys"))))) + (entry-object-keys old-entry)))) + + (define (delete-summary-stale-objects! client bucket summary) + (let ([keys (summary-list summary "StaleObjectKeys")]) + (for-each + (lambda (object-key) + (with-s3-retry + 'delete-summary-stale-objects! + (lambda () (delete-object client bucket object-key))) + (inc-summary! summary "RemovedStaleObjects")) + keys) + (when (not (null? keys)) + (hashtable-delete! summary "StaleObjectKeys")))) + + (define (file-sha256-base64 path) + (let ([ctx (sha256-context-start)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (call-with-port + (open-file-input-port path) + (lambda (in) + (let loop () + (let ([chunk (get-bytevector-n in (* 1024 1024))]) + (unless (eof-object? chunk) + (digest-update! ctx chunk) + (loop)))))) + (sha256-context-final-base64 ctx)) + (lambda () (free-digest-ctx ctx))))) + + (define (glob-match? pattern text) + (let ([plen (string-length pattern)] + [tlen (string-length text)]) + (letrec + ([match + (lambda (pi ti) + (cond + [(= pi plen) (= ti tlen)] + [(char=? (string-ref pattern pi) #\*) + (or (match (+ pi 1) ti) + (and (< ti tlen) (match pi (+ ti 1))))] + [(and (< ti tlen) + (char=? (string-ref pattern pi) (string-ref text ti))) + (match (+ pi 1) (+ ti 1))] + [else #f]))]) + (match 0 0)))) + + (define (any-pattern-matches? patterns text) + (let loop ([xs patterns]) + (cond + [(null? xs) #f] + [(glob-match? (car xs) text) #t] + [else (loop (cdr xs))]))) + + (define (path-allowed? remote-path include-patterns exclude-patterns) + (and (or (null? include-patterns) + (any-pattern-matches? include-patterns remote-path)) + (not (any-pattern-matches? exclude-patterns remote-path)))) + + (define (walk-local-files local-path remote-root include-patterns exclude-patterns) + (define (walk-dir dir remote-dir out) + (let loop ([entries (directory-list dir)] [out out]) + (if (null? entries) + out + (let* ([name (car entries)] + [local-child (path-join dir name)] + [remote-child (remote-path-join remote-dir name)]) + (cond + [(skip-directory-entry? name) + (loop (cdr entries) out)] + [(file-symbolic-link? local-child) + (loop (cdr entries) out)] + [(file-directory? local-child) + (loop (cdr entries) (walk-dir local-child remote-child out))] + [(file-regular? local-child) + (loop + (cdr entries) + (if (path-allowed? remote-child include-patterns exclude-patterns) + (cons (cons local-child remote-child) out) + out))] + [else (loop (cdr entries) out)]))))) + (let ([remote-root (remote-dir-normalize remote-root)]) + (cond + [(file-directory? local-path) + (reverse (walk-dir local-path remote-root '()))] + [(file-regular? local-path) + (let ([remote-path + (if (path-looks-like-directory? remote-root) + (remote-path-join remote-root (path-basename local-path)) + (remote-path-normalize remote-root))]) + (if (path-allowed? remote-path include-patterns exclude-patterns) + (list (cons local-path remote-path)) + '()))] + [else + (error 'walk-local-files "unsupported local source type" local-path)]))) + (define (jdrive-s3-empty-manifest) (json-object "Version" 1 @@ -527,17 +699,29 @@ (loop (cdr xs) out)] [else (loop (cdr xs) (cons (car xs) out))]))) - (define (jdrive-s3-manifest-add-file manifest path object-key size sha256) + (define (jdrive-s3-manifest-add-file manifest path object-key size sha256 . chunk-options) (let* ([path (remote-path-normalize path)] [entry (json-object "Type" "file" "Path" path - "ObjectKey" object-key "Size" size "Sha256" sha256 "UploadedAt" (time-second (current-time 'time-utc)))] [entries (remove-entry-path (manifest-entries manifest) path)]) + (if (null? chunk-options) + (begin + (hashtable-set! entry "Storage" "single") + (hashtable-set! entry "ObjectKey" object-key)) + (let ([chunks (car chunk-options)] + [chunk-size + (if (and (pair? (cdr chunk-options)) + (cadr chunk-options)) + (cadr chunk-options) + jdrive-s3-default-chunk-size)]) + (hashtable-set! entry "Storage" "chunked") + (hashtable-set! entry "ChunkSize" chunk-size) + (hashtable-set! entry "Chunks" chunks))) (hashtable-set! manifest "Entries" (cons entry entries)) manifest)) @@ -598,6 +782,26 @@ (file-aad (remote-path-normalize remote-path) object-id) sealed)) + (define (jdrive-s3-encrypt-chunk-bytes drive-key remote-path object-id index plaintext) + (let* ([path (remote-path-normalize remote-path)] + [sealed + (seal-bytes + chunk-magic + drive-key + (chunk-aad path object-id index) + plaintext)]) + (values + sealed + (sha256-base64 plaintext)))) + + (define (jdrive-s3-decrypt-chunk-bytes drive-key remote-path object-id index sealed) + (open-sealed-bytes + 'jdrive-s3-decrypt-chunk-bytes + chunk-magic + drive-key + (chunk-aad (remote-path-normalize remote-path) object-id index) + sealed)) + (define (manifest->sealed drive-key manifest) (seal-bytes manifest-magic @@ -658,34 +862,99 @@ (raise e))]) (thunk)))) - (define (upload-one-file! client bucket config drive-key manifest local-path remote-path summary) - (let ([data (read-file-bytes local-path)] - [path (remote-path-normalize remote-path)]) - (call-with-values - (lambda () (jdrive-s3-encrypt-file-bytes drive-key path data)) - (lambda (object-id sealed sha256) - (let ([object-key (object-storage-key config object-id)]) - (with-s3-retry - 'upload-one-file! - (lambda () - (put-object-bytes - client - bucket - object-key - sealed - 'content-type: file-content-type))) - (jdrive-s3-manifest-add-file - manifest - path - object-key - (bytevector-length data) - sha256) - (hashtable-set! - summary - "UploadedFiles" - (+ (hashtable-ref summary "UploadedFiles" 0) 1))))))) + (define (normalize-chunk-size chunk-size) + (let ([chunk-size (or chunk-size jdrive-s3-default-chunk-size)]) + (unless (and (integer? chunk-size) (> chunk-size 0)) + (error 'normalize-chunk-size "chunk size must be a positive integer" chunk-size)) + chunk-size)) + + (define (chunk-entry index object-key size sealed-size sha256) + (json-object + "Index" index + "ObjectKey" object-key + "Size" size + "CipherSize" sealed-size + "Sha256" sha256)) - (define (upload-tree! client bucket config drive-key manifest local-dir remote-root summary) + (define (upload-one-file! client bucket config drive-key manifest local-path remote-path summary chunk-size) + (let* ([path (remote-path-normalize remote-path)] + [object-id (jdrive-s3-object-id drive-key path)] + [old-entry (manifest-find-file manifest path)] + [chunk-size (normalize-chunk-size chunk-size)] + [ctx (sha256-context-start)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (call-with-port + (open-file-input-port local-path) + (lambda (in) + (let loop ([index 0] [offset 0] [chunks '()]) + (let ([plain (get-bytevector-n in chunk-size)]) + (if (eof-object? plain) + (let ([sha256 (sha256-context-final-base64 ctx)]) + (jdrive-s3-manifest-add-file + manifest + path + #f + offset + sha256 + (reverse chunks) + chunk-size) + (record-stale-object-keys! + summary + old-entry + (map + (lambda (chunk) + (chunk-field chunk "ObjectKey" "")) + (reverse chunks))) + (hashtable-set! + summary + "UploadedFiles" + (+ (hashtable-ref summary "UploadedFiles" 0) 1)) + (hashtable-set! + summary + "UploadedBytes" + (+ (hashtable-ref summary "UploadedBytes" 0) offset)) + (hashtable-set! + summary + "UploadedChunks" + (+ (hashtable-ref summary "UploadedChunks" 0) + (length chunks)))) + (begin + (digest-update! ctx plain) + (call-with-values + (lambda () + (jdrive-s3-encrypt-chunk-bytes + drive-key + path + object-id + index + plain)) + (lambda (sealed chunk-sha256) + (let ([object-key (chunk-storage-key config object-id index)]) + (with-s3-retry + 'upload-one-file! + (lambda () + (put-object-bytes + client + bucket + object-key + sealed + 'content-type: file-content-type))) + (loop + (+ index 1) + (+ offset (bytevector-length plain)) + (cons + (chunk-entry + index + object-key + (bytevector-length plain) + (bytevector-length sealed) + chunk-sha256) + chunks)))))))))))) + (lambda () (free-digest-ctx ctx))))) + + (define (upload-tree! client bucket config drive-key manifest local-dir remote-root summary chunk-size) (jdrive-s3-manifest-add-directory manifest remote-root) (hashtable-set! summary @@ -712,7 +981,8 @@ manifest local-child remote-child - summary)] + summary + chunk-size)] [(file-regular? local-child) (upload-one-file! client @@ -722,7 +992,8 @@ manifest local-child remote-child - summary)] + summary + chunk-size)] [else (hashtable-set! summary @@ -743,9 +1014,115 @@ (define (jdrive-s3-put-local-path! profile state-root vault-password yubikey-material local-path - remote-destination recursive?) + remote-destination recursive? . maybe-chunk-size) (unless (file-exists? local-path) (error 'jdrive-s3-put-local-path! "local source does not exist" local-path)) + (let ([chunk-size + (normalize-chunk-size + (and (pair? maybe-chunk-size) (car maybe-chunk-size)))]) + (with-unlocked-profile + profile + state-root + vault-password + yubikey-material + (lambda (config vault drive-key client bucket) + (let* ([manifest (load-manifest client bucket config drive-key)] + [summary + (json-object + "Backend" "s3" + "Profile" (jdrive-s3-profile-name profile) + "Source" local-path + "Destination" (remote-path-normalize remote-destination) + "Recursive" (if recursive? #t #f) + "ChunkSize" chunk-size + "UploadedFiles" 0 + "UploadedBytes" 0 + "UploadedChunks" 0 + "RemovedStaleObjects" 0 + "CreatedDirectories" 0 + "SkippedOther" 0)]) + (cond + [(file-symbolic-link? local-path) + (error 'jdrive-s3-put-local-path! "refusing to upload symlink" local-path)] + [(file-directory? local-path) + (unless recursive? + (error 'jdrive-s3-put-local-path! + "local source is a directory; use -r or --recursive" + local-path)) + (upload-tree! + client + bucket + config + drive-key + manifest + local-path + (destination-for-local-directory local-path remote-destination) + summary + chunk-size)] + [(file-regular? local-path) + (upload-one-file! + client + bucket + config + drive-key + manifest + local-path + (destination-for-local-file local-path remote-destination) + summary + chunk-size)] + [else + (error 'jdrive-s3-put-local-path! "unsupported local source type" local-path)]) + (store-manifest! client bucket config drive-key manifest) + (delete-summary-stale-objects! client bucket summary) + summary))))) + + (define (remote-parent-path path) + (let* ([path (remote-path-normalize path)] + [slash (last-slash-index path)]) + (cond + [(or (not slash) (= slash 0)) "/"] + [else (substring path 0 slash)]))) + + (define (manifest-add-parent-dirs! manifest path) + (let ([parent (remote-parent-path path)]) + (unless (string=? parent "/") + (manifest-add-parent-dirs! manifest parent)) + (jdrive-s3-manifest-add-directory manifest parent))) + + (define (manifest-file-entries-under manifest remote-root include-patterns exclude-patterns) + (let ([root (remote-dir-normalize remote-root)]) + (let loop ([xs (manifest-entries manifest)] [out '()]) + (cond + [(null? xs) (reverse out)] + [else + (let ([path (entry-path (car xs))]) + (loop + (cdr xs) + (if (and (under-prefix? root path) + (path-allowed? path include-patterns exclude-patterns)) + (cons (car xs) out) + out)))])))) + + (define (entry-local-match? entry local-path) + (and (= (jmaybe entry "Size" -1) (read-file-size local-path)) + (let ([remote-sha (jmaybe entry "Sha256" "")]) + (and (string-present? remote-sha) + (string=? remote-sha (file-sha256-base64 local-path)))))) + + (define (path-list-member? path paths) + (string-list-member? path paths)) + + (define (remove-entries-by-paths entries paths) + (let loop ([xs entries] [out '()]) + (cond + [(null? xs) (reverse out)] + [(path-list-member? (entry-path (car xs)) paths) + (loop (cdr xs) out)] + [else (loop (cdr xs) (cons (car xs) out))]))) + + (define (jdrive-s3-check-local-path! + profile state-root vault-password yubikey-material local-path remote-root + include-patterns exclude-patterns) (with-unlocked-profile profile state-root @@ -753,48 +1130,138 @@ yubikey-material (lambda (config vault drive-key client bucket) (let* ([manifest (load-manifest client bucket config drive-key)] + [local-files + (walk-local-files + local-path + remote-root + include-patterns + exclude-patterns)] + [local-remote-paths (map cdr local-files)] [summary (json-object "Backend" "s3" "Profile" (jdrive-s3-profile-name profile) "Source" local-path - "Destination" (remote-path-normalize remote-destination) - "Recursive" (if recursive? #t #f) - "UploadedFiles" 0 - "CreatedDirectories" 0 - "SkippedOther" 0)]) - (cond - [(file-symbolic-link? local-path) - (error 'jdrive-s3-put-local-path! "refusing to upload symlink" local-path)] - [(file-directory? local-path) - (unless recursive? - (error 'jdrive-s3-put-local-path! - "local source is a directory; use -r or --recursive" - local-path)) - (upload-tree! - client - bucket - config - drive-key - manifest - local-path - (destination-for-local-directory local-path remote-destination) - summary)] - [(file-regular? local-path) - (upload-one-file! - client - bucket - config - drive-key - manifest - local-path - (destination-for-local-file local-path remote-destination) - summary)] - [else - (error 'jdrive-s3-put-local-path! "unsupported local source type" local-path)]) - (store-manifest! client bucket config drive-key manifest) + "Destination" (remote-dir-normalize remote-root) + "CheckedFiles" 0 + "MatchingFiles" 0 + "DifferentFiles" 0 + "MissingRemoteFiles" 0 + "MissingLocalFiles" 0)]) + (for-each + (lambda (pair) + (let* ([local (car pair)] + [remote (cdr pair)] + [entry (manifest-find-file manifest remote)]) + (if entry + (begin + (inc-summary! summary "CheckedFiles") + (if (entry-local-match? entry local) + (inc-summary! summary "MatchingFiles") + (inc-summary! summary "DifferentFiles"))) + (inc-summary! summary "MissingRemoteFiles")))) + local-files) + (for-each + (lambda (entry) + (unless (path-list-member? (entry-path entry) local-remote-paths) + (inc-summary! summary "MissingLocalFiles"))) + (manifest-file-entries-under + manifest + remote-root + include-patterns + exclude-patterns)) summary)))) + (define (jdrive-s3-sync-local-to-remote! + profile state-root vault-password yubikey-material local-path remote-root + include-patterns exclude-patterns delete-missing? chunk-size) + (let ([chunk-size (normalize-chunk-size chunk-size)]) + (with-unlocked-profile + profile + state-root + vault-password + yubikey-material + (lambda (config vault drive-key client bucket) + (let* ([manifest (load-manifest client bucket config drive-key)] + [local-files + (walk-local-files + local-path + remote-root + include-patterns + exclude-patterns)]