diff --git a/tcl/_s3.tcl b/tcl/_s3.tcl index 80193732..fa173c51 100644 --- a/tcl/_s3.tcl +++ b/tcl/_s3.tcl @@ -375,7 +375,7 @@ proc qc::_s3_put { args } { -amz_headers $amz_headers \ -encrypted $encrypted \ PUT $object_key $bucket] - lappend headers x-amz-copy-source $s3_copy + lappend headers {*}$amz_headers lappend headers Content-Type {} return [qc::http_put \ -header $header \ diff --git a/tcl/s3.tcl b/tcl/s3.tcl index bfffb23a..84b0862b 100644 --- a/tcl/s3.tcl +++ b/tcl/s3.tcl @@ -83,14 +83,24 @@ proc qc::s3 { args } { } exists { # usage: - # qc::s3 exists s3_uri - if { [llength $args] == 2 } { + # qc::s3 exists s3_uri {encrypted false} + if { [llength $args] == 3 } { + lassign $args -> arg0 arg1 + set s3_uri [qc::cast s3_uri $arg0] + lassign [qc::s3 uri_bucket_object_key $s3_uri] bucket object_key + if { [qc::castable boolean $arg1] } { + set encrypted $arg1 + } else { + set encrypted false + } + } elseif { [llength $args] == 2 } { set s3_uri [qc::cast s3_uri [lindex $args 1]] lassign [qc::s3 uri_bucket_object_key $s3_uri] bucket object_key + set encrypted false } else { error "qc::s3 exists: Wrong number of args. Usage \"qc::s3 exists s3_uri\"." } - qc::_s3_exists $bucket $object_key + qc::_s3_exists $bucket $object_key $encrypted } head { # usage: @@ -117,9 +127,22 @@ proc qc::s3 { args } { } copy { # usage: - # qc::s3 copy s3_uri_from s3_uri_to + # qc::s3 copy s3_uri_from s3_uri_to {encrypted false} - if {[llength $args] == 3} { + if { [llength $args] == 4 } { + lassign $args -> s3_uri_to_copy s3_uri_copy encrypted + lassign [qc::s3 uri_bucket_object_key $s3_uri_to_copy] bucket object_key + set file_to_copy "${bucket}/${object_key}" + lassign [qc::s3 uri_bucket_object_key $s3_uri_copy] bucket_to object_key_copy + if { $bucket ne $bucket_to } { + error "qc::s3 copy: The s3_uri to copy to must be in the same bucket as the s3_uri to copy from." + } + if { [qc::castable boolean $encrypted] } { + set encrypted $encrypted + } else { + set encrypted false + } + } elseif { [llength $args] == 3 } { lassign $args -> s3_uri_to_copy s3_uri_copy lassign [qc::s3 uri_bucket_object_key $s3_uri_to_copy] bucket object_key set file_to_copy "${bucket}/${object_key}" @@ -127,11 +150,12 @@ proc qc::s3 { args } { if { $bucket ne $bucket_to } { error "qc::s3 copy: The s3_uri to copy to must be in the same bucket as the s3_uri to copy from." } + set encrypted false } else { error "qc::s3 copy: Wrong number of args. Usage \"qc::s3 copy s3_uri_from s3_uri_to\"." } - qc::_s3_put -s3_copy $file_to_copy $bucket $object_key_copy + qc::_s3_put -encrypted $encrypted -s3_copy $file_to_copy $bucket $object_key_copy } put { # usage: diff --git a/test/s3.test b/test/s3.test index 627dcb18..be0f300f 100644 --- a/test/s3.test +++ b/test/s3.test @@ -179,6 +179,33 @@ test s3-delete-1.0 {qc::s3 delete: s3_url} -constraints { return 1 } -result {1} +test s3-delete-1.1 {qc::s3 delete: s3_url - encrypted s3 file} -constraints { + requires_s3 + requires_test_bucket + requires_s3_lsbucket + requires_s3_put +} -body { + set s3_url "s3://${bucket}/s3_tools_test-delete-1.1-test" + set local_filename [qc::file_temp "1234"] + ::try { + qc::s3 put $s3_url $local_filename true + } finally { + file delete $local_filename + } + + # Delete + qc::s3 delete $s3_url + + # Confirm deleted + lassign [qc::s3 uri_bucket_object_key $s3_url] . object_key + set results [qc::s3 lsbucket $bucket $object_key] + if { $object_key in [qc::ldict_values results Key] } { + return 0 + } + + return 1 +} -result {1} + # get - Get an object from s3 test s3-get-1.0 {qc::s3 get: s3_url local_filename} -constraints { requires_s3 @@ -444,6 +471,102 @@ test s3-copy-1.0 {qc::s3 copy: s3_uri_from s3_uri_to} -constraints { return 0 } -result {1} +test s3-copy-1.1 {qc::s3 copy: s3_uri_from s3_uri_to encrypted} -constraints { + requires_s3 + requires_test_bucket + requires_s3_put + requires_s3_lsbucket +} -body { + set local_filename [qc::file_temp "abcdefg"] + set object_key "s3_tools_test-copy-1.1-test" + set object_copy "${object_key}_copy" + set s3_url "s3://${bucket}/${object_key}" + ::try { + qc::s3 put $s3_url $local_filename true + } finally { + file delete $local_filename + } + + # qc::s3 copy + set s3_url_to_copy $s3_url + set s3_url_copy "${s3_url}_copy" + qc::s3 copy $s3_url_to_copy $s3_url_copy true + + # Check result + lassign [qc::s3 uri_bucket_object_key $s3_url_copy] . object_key + set results [qc::s3 lsbucket $bucket $object_copy] + if { $object_copy in [qc::ldict_values results Key] } { + return 1 + } + return 0 +} -result {1} + +test s3-copy-1.2 {qc::s3 copy: s3_uri_from s3_uri_to encrypted - copy unencrypted file to encrypted file} -constraints { + requires_s3 + requires_test_bucket + requires_s3_put + requires_s3_lsbucket +} -body { + set local_filename [qc::file_temp "abcdefg"] + set object_key "s3_tools_test-copy-1.2-test" + set object_copy "${object_key}_copy" + set s3_url "s3://${bucket}/${object_key}" + ::try { + qc::s3 put $s3_url $local_filename + } finally { + file delete $local_filename + } + + # qc::s3 copy + set s3_url_to_copy $s3_url + set s3_url_copy "${s3_url}_copy" + qc::s3 copy $s3_url_to_copy $s3_url_copy true + + # Check result + lassign [qc::s3 uri_bucket_object_key $s3_url_copy] . object_key + set results [qc::s3 lsbucket $bucket $object_copy] + if { $object_copy in [qc::ldict_values results Key] } { + return 1 + } + return 0 +} -returnCodes { + error +} -result "RESPONSE 400 while contacting\ + https://${bucket}.s3.eu-west-1.amazonaws.com/s3_tools_test-copy-1.2-test_copy" + +test s3-copy-1.3 {qc::s3 copy: s3_uri_from s3_uri_to - copy encrypted file to unencrypted file} -constraints { + requires_s3 + requires_test_bucket + requires_s3_put + requires_s3_lsbucket +} -body { + set local_filename [qc::file_temp "abcdefg"] + set object_key "s3_tools_test-copy-1.3-test" + set object_copy "${object_key}_copy" + set s3_url "s3://${bucket}/${object_key}" + ::try { + qc::s3 put $s3_url $local_filename true + } finally { + file delete $local_filename + } + + # qc::s3 copy + set s3_url_to_copy $s3_url + set s3_url_copy "${s3_url}_copy" + qc::s3 copy $s3_url_to_copy $s3_url_copy + + # Check result + lassign [qc::s3 uri_bucket_object_key $s3_url_copy] . object_key + set results [qc::s3 lsbucket $bucket $object_copy] + if { $object_copy in [qc::ldict_values results Key] } { + return 1 + } + return 0 +} -returnCodes { + error +} -result "RESPONSE 400 while contacting\ + https://${bucket}.s3.eu-west-1.amazonaws.com/s3_tools_test-copy-1.3-test_copy" + # upload - Multipart uploads test s3-upload-1.0 {qc::s3 upload: Testing `init`, `send`, and `complete` v1} -constraints { requires_s3 @@ -737,6 +860,70 @@ test s3-exists-1.2 {qc::s3 exists: s3://bucket/remote_filename permissions failu error } -result "RESPONSE 403 while contacting\ https://${bucket}.s3.eu-west-1.amazonaws.com/s3_tools_test-exists-1.2-test" + +test s3-exists-1.3 {qc::s3 exists: s3://bucket/remote_filename encrypted} -constraints { + requires_s3 + requires_test_bucket + requires_s3_put +} -body { + set file_string "Test file contents" + set local_filename [qc::file_temp $file_string] + set remote_filename "/s3_tools_test-exists-1.3-test" + ::try { + qc::s3 put "s3://${bucket}${remote_filename}" $local_filename true + } finally { + file delete $local_filename + } + return [qc::s3 exists "s3://${bucket}${remote_filename}" true] +} -result {true} + +# exists - Check an object exists on S3 +test s3-exists-1.4 {qc::s3 exists: s3://bucket/remote_filename encrypted} -constraints { + requires_s3 + requires_test_bucket + requires_s3_put +} -body { + set remote_filename "/s3_tools_test-exists-1.4-test" + return [qc::s3 exists "s3://${bucket}${remote_filename}" true] +} -result {false} + +test s3-exists-1.5 {qc::s3 exists: s3://bucket/remote_filename encrypted - request unencrypted file} -constraints { + requires_s3 + requires_test_bucket + requires_s3_put +} -body { + set file_string "Test file contents" + set local_filename [qc::file_temp $file_string] + set remote_filename "/s3_tools_test-exists-1.5-test" + ::try { + qc::s3 put "s3://${bucket}${remote_filename}" $local_filename + } finally { + file delete $local_filename + } + return [qc::s3 exists "s3://${bucket}${remote_filename}" true] +} -returnCodes { + error +} -result "RESPONSE 400 while contacting\ + https://${bucket}.s3.eu-west-1.amazonaws.com/s3_tools_test-exists-1.5-test" + +test s3-exists-1.6 {qc::s3 exists: s3://bucket/remote_filename - request encrypted file} -constraints { + requires_s3 + requires_test_bucket + requires_s3_put +} -body { + set file_string "Test file contents" + set local_filename [qc::file_temp $file_string] + set remote_filename "/s3_tools_test-exists-1.6-test" + ::try { + qc::s3 put "s3://${bucket}${remote_filename}" $local_filename true + } finally { + file delete $local_filename + } + return [qc::s3 exists "s3://${bucket}${remote_filename}"] +} -returnCodes { + error +} -result "RESPONSE 400 while contacting\ + https://${bucket}.s3.eu-west-1.amazonaws.com/s3_tools_test-exists-1.6-test" # Cleanup test s3-cleanup {Remove files from S3 uploaded by the s3_tools tests} -constraints {