Add S3 multipart and manifest conflict guard
ober
7e1e8977a003a6eafd871ba943b34e4ee6e79290
--- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ Jerboa-native encrypted remote drive and storage access. This project is intended to become a single deployable Jerboa application for remote storage, with YubiKey-gated access and no rclone or Go helper in the runtime path. The Proton Drive backend is currently experimental; the primary -next backend is S3-compatible storage with client-side encryption. +backend is S3-compatible storage with client-side encryption. ## User Documentation @@ -79,9 +79,14 @@ 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 -`cp` treats paths beginning with `/` as encrypted remote paths unless the source -is an existing local absolute path. That supports local-to-remote, +64 MiB default with `--chunk-size N` for testing or provider tuning. Encrypted +chunk objects larger than 16 MiB use S3 multipart upload internally, so the +bucket provider still only sees encrypted object parts. Manifest commits use +S3 conditional writes against the manifest ETag; concurrent writers fail with a +retryable conflict instead of silently overwriting each other. + +`sync` and `cp` treat paths beginning with `/` as encrypted remote paths unless +the source is an existing local absolute path. That supports local-to-remote, remote-to-local, and remote-to-remote encrypted copies. `check` and `sync` support simple `*` wildcards through repeated `--include PATTERN` and `--exclude PATTERN`. @@ -316,7 +321,9 @@ during cleanup. 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. +range, restores a file, and removes remote test entries. Set +`JDRIVE_S3_TEST_MULTIPART=1` to also upload a large encrypted object through +provider multipart upload. `make bundle` builds the host binary and writes `dist/protonstorage-<os>-<arch>.tar.gz` with the binary, native Jerboa @@ -325,9 +332,8 @@ libraries, and a wrapper that sets the runtime library search path. ## Remaining Work - Prove the encrypted S3 live integration against each target provider. -- Add true S3 multipart per encrypted chunk for provider-optimized very large - chunks. -- Add multi-writer conflict policy and provider-side conditional manifest writes. +- Add richer multi-writer merge/conflict-resolution policy beyond fail-fast + conditional manifest commits. - Finish daemon control socket/background lifecycle and durable operation queue. - Add richer metadata update operations beyond size-changing writes and rename/move. --- a/docs/jerboa-drive-plan.md +++ b/docs/jerboa-drive-plan.md @@ -15,8 +15,9 @@ reviewing results. - `S3Client` - `s3-get`, `s3-put`, `s3-delete`, `s3-head` - `list-objects-v2`, `put-object`, `get-object` -- `jerboa-aws` does not yet have the full S3 feature set needed for a robust - encrypted remote filesystem. +- `jerboa-aws` now has the S3 object APIs needed by the current encrypted + remote filesystem milestone, including bytevector I/O, ranged reads, and + multipart helper calls. ## Phase 0: Rename Repo and Preserve State @@ -119,14 +120,15 @@ Completed so far: - local-vs-remote check - simple `*` include/exclude filters - plaintext SHA-256 verification after decrypt + - provider multipart upload for encrypted objects larger than 16 MiB + - provider-side conditional manifest commits using `If-Match`/`If-None-Match` - retry wrappers around current S3 object operations - opt-in live S3 integration hook via `make s3-integration` Remaining: - 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 richer sync merge/conflict policy beyond fail-fast stale manifest + detection. Add or verify these `jerboa-aws` capabilities before building the drive layer: @@ -168,12 +170,13 @@ Add or verify these `jerboa-aws` capabilities before building the drive layer: Acceptance gate: - `jerboa-aws` tests pass. - `put-object-bytes` and `get-object-bytes` round-trip arbitrary binary data. -- multipart upload round-trips at least a 64 MiB test object. +- multipart upload round-trips at least a 64 MiB test object. `jdrive` also has + an opt-in `JDRIVE_S3_TEST_MULTIPART=1` live integration path. ## Phase 3: Encrypted Drive Data Model Status: chunked encrypted storage is implemented with a simpler -single-manifest, single-writer layout. The current implementation stores: +single-current-manifest layout. The current implementation stores: ```text ~/.jdrive/profiles/<profile>/s3.config.json @@ -184,8 +187,10 @@ single-manifest, single-writer layout. The current implementation stores: 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 provider-optimized multipart chunk objects. +Manifest updates carry a generation field and are committed with S3 conditional +writes against the current ETag. Encrypted objects larger than the multipart +threshold use provider multipart upload internally. The next model should evolve +this toward manifest history, repair, and richer multi-writer merge behavior. Object namespace inside bucket: @@ -239,8 +244,8 @@ Manifest integrity: - Each manifest is encrypted and authenticated. - `root.current` points to the latest manifest id. - Updates write new manifest first, then atomically update `root.current`. -- If S3 conditional writes are unavailable in `jerboa-aws`, emulate cautiously - and document single-writer semantics for v1. +- `root.current` updates must use S3 conditional writes; do not silently + replace another writer's current pointer. Acceptance gate: - Raw bucket listing reveals no filenames or directory structure. --- a/docs/user-guide.md +++ b/docs/user-guide.md @@ -62,8 +62,9 @@ Implemented today: password you provide. - S3-compatible encrypted drive profile under `~/.jdrive` with encrypted manifest, chunked encrypted file objects, recursive bidirectional copy, sync, - check, list, ranged cat/get, rm, checksum verification, retry wrappers, and - optional built-in YubiKey PIV unlock material. + check, list, ranged cat/get, rm, checksum verification, S3 multipart upload + for large encrypted objects, conditional manifest commits, 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 +77,10 @@ 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. Files are - chunked and encrypted client-side, but true S3 multipart per encrypted chunk - and multi-writer conflict handling are still planned. +- The S3 backend rejects stale manifest updates with provider-side conditional + writes, but it does not yet merge competing writers automatically. Retry the + command after another client commits, or keep one active writer per profile + until richer conflict resolution lands. ## Encrypted S3 Drive @@ -144,6 +146,12 @@ 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. +Files are split into encrypted chunks by default. Encrypted chunk objects larger +than 16 MiB use S3 multipart upload internally; the provider never receives +plaintext chunks, names, or metadata. Manifest updates are committed with S3 +`If-Match`/`If-None-Match` checks so a stale writer fails instead of replacing a +newer encrypted manifest. + For `s3 cp`, paths beginning with `/` are encrypted remote paths unless the source is an existing local absolute path. `sync` and `check` are intentionally local-to-remote tree operations. @@ -804,6 +812,18 @@ export PROTONDRIVE_TOTP_CODE='123456' The integration test creates a disposable folder, uploads a small file, moves it between disposable folders, and trashes the disposable root during cleanup. +Encrypted S3 integration is also opt-in: + +```sh +export JDRIVE_S3_INTEGRATION=1 +export JDRIVE_S3_TEST_BUCKET='bucket-name' +export JDRIVE_S3_TEST_PREFIX='disposable-prefix' +make s3-integration +``` + +Set `JDRIVE_S3_TEST_MULTIPART=1` to include a large encrypted object that uses +provider multipart upload. + ## Troubleshooting Show implementation and native backend status: --- a/protonstorage/s3/drive.ss +++ b/protonstorage/s3/drive.ss @@ -20,6 +20,7 @@ jdrive-s3-manifest-add-file jdrive-s3-manifest-list jdrive-s3-default-chunk-size + jdrive-s3-default-multipart-part-size jdrive-s3-list! jdrive-s3-mkdir! jdrive-s3-put-local-path! @@ -47,6 +48,11 @@ (yubikey auth) (jerboa-aws s3 api) (jerboa-aws s3 objects) + (only (jerboa-aws request) + request-status + request-text + request-headers + request-close) (protonstorage s3 config)) (define profile-version 1) @@ -62,6 +68,8 @@ (define file-content-type "application/octet-stream") (define s3-retry-count 3) (define jdrive-s3-default-chunk-size (* 64 1024 1024)) + (define jdrive-s3-min-multipart-part-size (* 5 1024 1024)) + (define jdrive-s3-default-multipart-part-size (* 16 1024 1024)) (define (json-object . fields) (let ([ht (make-hashtable equal-hash equal?)]) @@ -830,16 +838,121 @@ (sealed->manifest drive-key (get-object-bytes client bucket key)) (jdrive-s3-empty-manifest)))))) - (define (store-manifest! client bucket config drive-key manifest) - (with-s3-retry - 'store-manifest! - (lambda () - (put-object-bytes + (define (header-ref-ci headers name) + (let loop ([xs headers]) + (cond + [(null? xs) #f] + [(and (string? (caar xs)) + (string-ci=? (caar xs) name)) + (cdar xs)] + [else (loop (cdr xs))]))) + + (define (manifest-head-etag client bucket config) + (let ([key (manifest-object-key config)]) + (with-s3-retry + 'manifest-head-etag + (lambda () + (let* ([req + (s3-request + client + 'verb: "HEAD" + 'bucket: bucket + 'key: key)] + [status (request-status req)]) + (cond + [(and (>= status 200) (< status 300)) + (let ([etag (header-ref-ci (request-headers req) "etag")]) + (request-close req) + (unless etag + (error 'manifest-head-etag + "manifest object exists but S3 did not return ETag")) + etag)] + [(= status 404) + (request-close req) + #f] + [else + (let ([body (request-text req)]) + (request-close req) + (error 'manifest-head-etag + (string-append "S3 manifest HEAD failed: HTTP " + (number->string status)) + body))])))))) + + (define (load-manifest+etag client bucket config drive-key) + (let ([etag (manifest-head-etag client bucket config)]) + (values + (if etag + (sealed->manifest + drive-key + (with-s3-retry + 'load-manifest+etag + (lambda () + (get-object-bytes client bucket (manifest-object-key config))))) + (jdrive-s3-empty-manifest)) + etag))) + + (define (manifest-generation manifest) + (jmaybe manifest "Generation" 0)) + + (define (prepare-manifest-for-store! manifest) + (hashtable-set! manifest "Generation" (+ (manifest-generation manifest) 1)) + (hashtable-set! manifest "UpdatedAt" (time-second (current-time 'time-utc))) + manifest) + + (define (store-manifest-conditional! client bucket config drive-key manifest expected-etag) + (let* ([key (manifest-object-key config)] + [sealed (manifest->sealed drive-key (prepare-manifest-for-store! manifest))] + [headers + (if expected-etag + (list (cons "If-Match" expected-etag)) + (list (cons "If-None-Match" "*")))]) + (let* ([req + (s3-request + client + 'verb: "PUT" + 'bucket: bucket + 'key: key + 'body: sealed + 'content-type: file-content-type + 'extra-headers: headers)] + [status (request-status req)]) + (cond + [(and (>= status 200) (< status 300)) + (request-close req) + (void)] + [(or (= status 409) (= status 412)) + (let ([body (request-text req)]) + (request-close req) + (error 'store-manifest-conditional! + "encrypted S3 manifest changed during update; retry the command" + status + body))] + [else + (let ([body (request-text req)]) + (request-close req) + (error 'store-manifest-conditional! + (string-append "S3 manifest PUT failed: HTTP " + (number->string status)) + body))])))) + + (define (store-manifest! client bucket config drive-key manifest . maybe-expected-etag) + (if (null? maybe-expected-etag) + (with-s3-retry + 'store-manifest! + (lambda () + (put-object-bytes + client + bucket + (manifest-object-key config) + (manifest->sealed drive-key (prepare-manifest-for-store! manifest)) + 'content-type: file-content-type))) + (store-manifest-conditional! client bucket - (manifest-object-key config) - (manifest->sealed drive-key manifest) - 'content-type: file-content-type)))) + config + drive-key + manifest + (car maybe-expected-etag)))) (define (with-unlocked-profile profile state-root vault-password yubikey-material proc) (call-with-values @@ -870,6 +983,92 @@ (error 'normalize-chunk-size "chunk size must be a positive integer" chunk-size)) chunk-size)) + (define (normalize-multipart-part-size part-size) + (let ([part-size (or part-size jdrive-s3-default-multipart-part-size)]) + (cond + [(and (integer? part-size) (<= part-size 0)) #f] + [(not (integer? part-size)) + (error 'normalize-multipart-part-size + "multipart part size must be an integer" + part-size)] + [(< part-size jdrive-s3-min-multipart-part-size) + (error 'normalize-multipart-part-size + "multipart part size must be at least 5 MiB or 0 to disable" + part-size)] + [else part-size]))) + + (define (multipart-part-count size part-size) + (if (= size 0) + 1 + (quotient (+ size part-size -1) part-size))) + + (define (upload-object-bytes! client bucket object-key data summary) + (let* ([part-size + (normalize-multipart-part-size jdrive-s3-default-multipart-part-size)] + [size (bytevector-length data)]) + (if (or (not part-size) (<= size part-size)) + (begin + (with-s3-retry + 'upload-object-bytes! + (lambda () + (put-object-bytes + client + bucket + object-key + data + 'content-type: file-content-type))) + (inc-summary! summary "PutObjects")) + (let ([upload-id #f] + [completed? #f]) + (guard (e [#t + (when (and upload-id (not completed?)) + (guard (abort-error [#t #f]) + (abort-multipart-upload client bucket object-key upload-id))) + (raise e)]) + (let ([parts-total (multipart-part-count size part-size)]) + (when (> parts-total 10000) + (error 'upload-object-bytes! + "encrypted object needs more than 10000 S3 multipart parts" + object-key)) + (set! upload-id + (with-s3-retry + 'upload-object-bytes! + (lambda () + (create-multipart-upload + client + bucket + object-key + 'content-type: file-content-type)))) + (let loop ([part-number 1] [offset 0] [parts '()]) + (if (>= offset size) + (begin + (with-s3-retry + 'upload-object-bytes! + (lambda () + (complete-multipart-upload + client + bucket + object-key + upload-id + (reverse parts)))) + (set! completed? #t) + (inc-summary! summary "MultipartObjects") + (add-summary! summary "MultipartParts" (length parts))) + (let* ([end (min size (+ offset part-size))] + [part-data (jdrive-bytevector-slice data offset end)] + [part + (with-s3-retry + 'upload-object-bytes! + (lambda () + (upload-part + client + bucket + object-key + upload-id + part-number + part-data)))]) + (loop (+ part-number 1) end (cons part parts))))))))))) + (define (chunk-entry index object-key size sealed-size sha256) (json-object "Index" index @@ -934,15 +1133,12 @@ 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))) + (upload-object-bytes! + client + bucket + object-key + sealed + summary) (loop (+ index 1) (+ offset (bytevector-length plain)) @@ -1028,55 +1224,59 @@ 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))))) + (call-with-values + (lambda () (load-manifest+etag client bucket config drive-key)) + (lambda (manifest manifest-etag) + (let ([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 manifest-etag) + (delete-summary-stale-objects! client bucket summary) + summary))))))) (define (remote-parent-path path) (let* ([path (remote-path-normalize path)] @@ -1184,85 +1384,82 @@ 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)] - [local-remote-paths (map cdr local-files)] - [summary - (json-object - "Backend" "s3" - "Profile" (jdrive-s3-profile-name profile) - "Source" local-path - "Destination" (remote-dir-normalize remote-root) - "DeleteMissing" (if delete-missing? #t #f) - "ChunkSize" chunk-size - "UploadedFiles" 0 - "UploadedBytes" 0 - "UploadedChunks" 0 - "SkippedFiles" 0 - "DeletedFiles" 0 - "RemovedStaleObjects" 0 - "CreatedDirectories" 0 - "SkippedOther" 0)]) - (for-each - (lambda (pair) - (let* ([local (car pair)] - [remote (cdr pair)] - [entry (manifest-find-file manifest remote)]) - (manifest-add-parent-dirs! manifest remote) - (if (and entry (entry-local-match? entry local)) - (inc-summary! summary "SkippedFiles") - (upload-one-file! - client - bucket - config - drive-key - manifest - local - remote - summary - chunk-size)))) - local-files) - (when delete-missing? - (let* ([remote-extra - (let loop ([entries - (manifest-file-entries-under - manifest - remote-root - include-patterns - exclude-patterns)] - [out '()]) - (cond - [(null? entries) (reverse out)] - [(path-list-member? - (entry-path (car entries)) - local-remote-paths) - (loop (cdr entries) out)] - [else (loop (cdr entries) (cons (car entries) out))]))] - [remove-paths (map entry-path remote-extra)]) + (call-with-values + (lambda () (load-manifest+etag client bucket config drive-key)) + (lambda (manifest manifest-etag) + (let* ([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-dir-normalize remote-root) + "DeleteMissing" (if delete-missing? #t #f) + "ChunkSize" chunk-size + "UploadedFiles" 0 + "UploadedBytes" 0 + "UploadedChunks" 0 + "SkippedFiles" 0 + "DeletedFiles" 0 + "RemovedStaleObjects" 0 + "CreatedDirectories" 0 + "SkippedOther" 0)]) (for-each - (lambda (entry) + (lambda (pair) + (let* ([local (car pair)] + [remote (cdr pair)] + [entry (manifest-find-file manifest remote)]) + (manifest-add-parent-dirs! manifest remote) + (if (and entry (entry-local-match? entry local)) + (inc-summary! summary "SkippedFiles") + (upload-one-file! + client + bucket + config + drive-key + manifest + local + remote + summary + chunk-size)))) + local-files) + (when delete-missing? + (let* ([remote-extra + (let loop ([entries + (manifest-file-entries-under + manifest + remote-root + include-patterns + exclude-patterns)] + [out '()]) + (cond + [(null? entries) (reverse out)] + [(path-list-member? + (entry-path (car entries)) + local-remote-paths) + (loop (cdr entries) out)] + [else (loop (cdr entries) (cons (car entries) out))]))] + [remove-paths (map entry-path remote-extra)]) (for-each - (lambda (object-key) - (with-s3-retry - 'jdrive-s3-sync-local-to-remote! - (lambda () (delete-object client bucket object-key)))) - (entry-object-keys entry)) - (inc-summary! summary "DeletedFiles")) - remote-extra) - (hashtable-set! - manifest - "Entries" - (remove-entries-by-paths - (manifest-entries manifest) - remove-paths)))) - (store-manifest! client bucket config drive-key manifest) - (delete-summary-stale-objects! client bucket summary) - summary))))) + (lambda (entry) + (record-stale-object-keys! summary entry '()) + (inc-summary! summary "DeletedFiles")) + remote-extra) + (hashtable-set! + manifest + "Entries" + (remove-entries-by-paths + (manifest-entries manifest) + remove-paths)))) + (store-manifest! client bucket config drive-key manifest manifest-etag) + (delete-summary-stale-objects! client bucket summary) + summary))))))) (define (jdrive-s3-list! profile state-root vault-password yubikey-material path-prefix) (with-unlocked-profile @@ -1282,14 +1479,16 @@ vault-password yubikey-material (lambda (config vault drive-key client bucket) - (let ([manifest (load-manifest client bucket config drive-key)] - [path (remote-dir-normalize remote-path)]) - (jdrive-s3-manifest-add-directory manifest path) - (store-manifest! client bucket config drive-key manifest) - (json-object - "Backend" "s3" - "Profile" (jdrive-s3-profile-name profile) - "CreatedDirectory" path))))) + (call-with-values + (lambda () (load-manifest+etag client bucket config drive-key)) + (lambda (manifest manifest-etag) + (let ([path (remote-dir-normalize remote-path)]) + (jdrive-s3-manifest-add-directory manifest path) + (store-manifest! client bucket config drive-key manifest manifest-etag) + (json-object + "Backend" "s3" + "Profile" (jdrive-s3-profile-name profile) + "CreatedDirectory" path))))))) (define (manifest-find-file manifest remote-path) (let ([path (remote-path-normalize remote-path)]) @@ -1508,15 +1707,12 @@ (lambda (object-id sealed sha256) (let* ([object-key (object-storage-key config object-id)] [old-entry (manifest-find-file manifest dest-path)]) - (with-s3-retry - 'copy-single-entry-remote-to-remote! - (lambda () - (put-object-bytes - client - bucket - object-key - sealed - 'content-type: file-content-type))) + (upload-object-bytes! + client + bucket + object-key + sealed + summary) (jdrive-s3-manifest-add-file manifest dest-path @@ -1585,15 +1781,12 @@ plain)) (lambda (sealed chunk-sha256) (let ([object-key (chunk-storage-key config object-id index)]) - (with-s3-retry - 'copy-chunked-entry-remote-to-remote! - (lambda () - (put-object-bytes - client - bucket - object-key - sealed - 'content-type: file-content-type))) + (upload-object-bytes! + client + bucket + object-key + sealed + summary) (loop (cdr source-chunks) (+ index 1) @@ -1730,57 +1923,59 @@ summary)))] [(and source-remote? destination-remote?) (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)] - [source-path (remote-path-normalize source)] - [entry (manifest-find-file manifest source-path)] - [summary - (json-object - "Backend" "s3" - "Profile" (jdrive-s3-profile-name profile) - "Source" source-path - "Destination" (remote-path-normalize destination) - "Direction" "remote-to-remote" - "Recursive" (if recursive? #t #f) - "CopiedFiles" 0 - "CopiedBytes" 0 - "CopiedChunks" 0 - "RemovedStaleObjects" 0 - "CreatedDirectories" 0)]) - (cond - [entry - (copy-entry-remote-to-remote! - client - bucket - config - drive-key - manifest - source-path - (destination-for-remote-file source-path destination) - entry - summary)] - [(manifest-has-tree? manifest source-path) - (unless recursive? - (error 'jdrive-s3-copy! - "remote source is a directory; use -r or --recursive" - source-path)) - (copy-remote-tree-to-remote! - client - bucket - config - drive-key - manifest - source-path - destination - summary)] - [else (error 'jdrive-s3-copy! "remote source not found" source-path)]) - (store-manifest! client bucket config drive-key manifest) - (delete-summary-stale-objects! client bucket summary) - summary)))] + profile + state-root + vault-password + yubikey-material + (lambda (config vault drive-key client bucket) + (call-with-values + (lambda () (load-manifest+etag client bucket config drive-key)) + (lambda (manifest manifest-etag) + (let* ([source-path (remote-path-normalize source)] + [entry (manifest-find-file manifest source-path)] + [summary + (json-object + "Backend" "s3" + "Profile" (jdrive-s3-profile-name profile) + "Source" source-path + "Destination" (remote-path-normalize destination) + "Direction" "remote-to-remote" + "Recursive" (if recursive? #t #f) + "CopiedFiles" 0 + "CopiedBytes" 0 + "CopiedChunks" 0 + "RemovedStaleObjects" 0 + "CreatedDirectories" 0)]) + (cond + [entry + (copy-entry-remote-to-remote! + client + bucket + config + drive-key + manifest + source-path + (destination-for-remote-file source-path destination) + entry + summary)] + [(manifest-has-tree? manifest source-path) + (unless recursive? + (error 'jdrive-s3-copy! + "remote source is a directory; use -r or --recursive" + source-path)) + (copy-remote-tree-to-remote! + client + bucket + config + drive-key + manifest + source-path + destination + summary)] + [else (error 'jdrive-s3-copy! "remote source not found" source-path)]) + (store-manifest! client bucket config drive-key manifest manifest-etag) + (delete-summary-stale-objects! client bucket summary) + summary)))))] [else (error 'jdrive-s3-copy! "at least one s3 cp argument must be an encrypted remote path" @@ -1962,36 +2157,42 @@ vault-password yubikey-material (lambda (config vault drive-key client bucket) - (let* ([path (remote-path-normalize remote-path)] - [manifest (load-manifest client bucket config drive-key)]) - (call-with-values - (lambda () - (remove-file-entries - (manifest-entries manifest) - path - recursive?)) - (lambda (kept removed) - (for-each - (lambda (entry) - (for-each - (lambda (object-key) - (with-s3-retry - 'jdrive-s3-remove! - (lambda () - (delete-object client bucket object-key)))) - (entry-object-keys entry))) - removed) - (hashtable-set! manifest "Entries" kept) - (hashtable-set! - manifest - "Directories" - (remove-dir-path (manifest-directories manifest) path recursive?)) - (store-manifest! client bucket config drive-key manifest) - (json-object - "Backend" "s3" - "Profile" (jdrive-s3-profile-name profile) - "RemotePath" path - "Recursive" (if recursive? #t #f) - "RemovedFiles" (length removed)))))))) + (call-with-values + (lambda () (load-manifest+etag client bucket config drive-key)) + (lambda (manifest manifest-etag) + (let ([path (remote-path-normalize remote-path)]) + (call-with-values + (lambda () + (remove-file-entries + (manifest-entries manifest) + path + recursive?)) + (lambda (kept removed) + (let ([summary + (json-object + "Backend" "s3" + "Profile" (jdrive-s3-profile-name profile) + "RemotePath" path + "Recursive" (if recursive? #t #f) + "RemovedFiles" (length removed) + "RemovedStaleObjects" 0)]) + (for-each + (lambda (entry) + (record-stale-object-keys! summary entry '())) + removed) + (hashtable-set! manifest "Entries" kept) + (hashtable-set! + manifest + "Directories" + (remove-dir-path (manifest-directories manifest) path recursive?)) + (store-manifest! + client + bucket + config + drive-key + manifest + manifest-etag) + (delete-summary-stale-objects! client bucket summary) + summary))))))))) ) --- a/test/integration-s3.ss +++ b/test/integration-s3.ss @@ -83,6 +83,25 @@ [else (loop (- i 1))]))) (call-with-output-file path (lambda (p) (display text p)) 'replace)) +(define (write-pattern-file path size) + (ensure-directory! (let loop ([i (- (string-length path) 1)]) + (cond + [(< i 0) "."] + [(char=? (string-ref path i) #\/) + (if (= i 0) "/" (substring path 0 i))] + [else (loop (- i 1))]))) + (let ([chunk (make-bytevector (* 1024 1024) 65)]) + (call-with-port + (open-file-output-port path (file-options no-fail) (buffer-mode block)) + (lambda (p) + (let loop ([remaining size]) + (when (> remaining 0) + (let ([n (min remaining (bytevector-length chunk))])