Add encryption to s3::exists, s3::copy and s3::delete commands

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 \

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,21 +127,35 @@ 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}"
                 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."
                 }
+                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:

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 {