Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
39 changes: 30 additions & 9 deletions tcl/s3.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -45,24 +45,35 @@ proc qc::s3 { args } {
}
get {
# usage:
# qc::s3 get s3_uri local_filename
if { [llength $args] == 3 } {
# qc::s3 get s3_uri local_filename {encrypted false}
if { [llength $args] == 4 } {
lassign $args -> arg0 arg1 arg2
set s3_uri $arg0
lassign [qc::s3 uri_bucket_object_key $s3_uri] bucket object_key
set local_filename $arg1
if { [qc::castable boolean $arg2] } {
set encrypted $arg2
} else {
set encrypted false
}
} elseif { [llength $args] == 3 } {
lassign $args -> arg0 arg1
set s3_uri $arg0
lassign [qc::s3 uri_bucket_object_key $s3_uri] bucket object_key
set local_filename $arg1
set local_filename $arg1
set encrypted false
} else {
error "Wrong number of arguments. Usage: \"qc::s3 get s3_uri local_filename\"."
}
if { [file exists $local_filename] } {
error "File $local_filename already exists."
}
set head_dict [qc::s3 head $s3_uri]
set head_dict [qc::s3 head $s3_uri $encrypted]
set file_size [dict get $head_dict Content-Length]
# set timeout - allow 1Mb/s
set timeout_secs [expr {max( (${file_size}*8)/1000000 , 60)} ]
log Debug "Timeout set at $timeout_secs seconds"
qc::_s3_save -timeout $timeout_secs $bucket $object_key $local_filename
qc::_s3_save -encrypted $encrypted -timeout $timeout_secs $bucket $object_key $local_filename

if { $file_size != [file size $local_filename] } {
set local_file_size [file size $local_filename]
Expand All @@ -83,17 +94,27 @@ proc qc::s3 { args } {
}
head {
# usage:
# qc::s3 head s3_uri
# qc::s3 head s3_uri {encrypted false}

if { [llength $args] == 2 } {
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 head: Wrong number of args. Usage \"qc::s3 head s3_uri\"."
}

qc::_s3_head $bucket $object_key
}
qc::_s3_head $bucket $object_key $encrypted
}
copy {
# usage:
# qc::s3 copy s3_uri_from s3_uri_to
Expand Down
159 changes: 159 additions & 0 deletions test/s3.test
Original file line number Diff line number Diff line change
Expand Up @@ -210,6 +210,102 @@ test s3-get-1.0 {qc::s3 get: s3_url local_filename} -constraints {
return 1
} -result {1}

test s3-get-1.1 {qc::s3 get: s3_url local_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 s3_url "s3://${bucket}/s3_tools_test-get-1.1-test"
::try {
qc::s3 put $s3_url $local_filename true
} finally {
file delete $local_filename
}

# Get file
set local_filename [join [list "/tmp/" [qc::uuid]] ""]
set get_file_string ""
::try {
qc::s3 get $s3_url $local_filename true
set get_file_string [qc::cat $local_filename]
} finally {
file delete $local_filename
}

if { $file_string ne $get_file_string } {
return 0
}
return 1
} -result {1}

test s3-get-1.2 {qc::s3 get: s3_url local_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 s3_url "s3://${bucket}/s3_tools_test-get-1.2-test"
::try {
qc::s3 put $s3_url $local_filename true
} finally {
file delete $local_filename
}

# Get file
set local_filename [join [list "/tmp/" [qc::uuid]] ""]
set get_file_string ""
::try {
qc::s3 get $s3_url $local_filename
set get_file_string [qc::cat $local_filename]
} finally {
file delete $local_filename
}

if { $file_string ne $get_file_string } {
return 0
}
return 1
} -returnCodes {
error
} -result "RESPONSE 400 while contacting\
https://${bucket}.s3.eu-west-1.amazonaws.com/s3_tools_test-get-1.2-test"

test s3-get-1.3 {qc::s3 get: s3_url local_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 s3_url "s3://${bucket}/s3_tools_test-get-1.3-test"
::try {
qc::s3 put $s3_url $local_filename
} finally {
file delete $local_filename
}

# Get file
set local_filename [join [list "/tmp/" [qc::uuid]] ""]
set get_file_string ""
::try {
qc::s3 get $s3_url $local_filename true
set get_file_string [qc::cat $local_filename]
} finally {
file delete $local_filename
}

if { $file_string ne $get_file_string } {
return 0
}
return 1
} -returnCodes {
error
} -result "RESPONSE 400 while contacting\
https://${bucket}.s3.eu-west-1.amazonaws.com/s3_tools_test-get-1.3-test"

# head - Get
test s3-head-1.0 {qc::s3 head: s3_url} -constraints {
requires_s3
Expand Down Expand Up @@ -254,6 +350,69 @@ test s3-head-1.1 {qc::s3 head: s3_url} -constraints {
}
} -result {1}

test s3-head-1.2 {qc::s3 head: s3_url encrypted} -constraints {
requires_s3
requires_test_bucket
requires_s3_put
} -body {
set local_filename [qc::file_temp "1234"]
set s3_url "s3://${bucket}/s3_tools_test-head-1.2-test"
::try {
qc::s3 put $s3_url $local_filename true
} finally {
file delete $local_filename
}

# qc::s3 head
set result [qc::s3 head $s3_url true]
return [regexp {200 OK$} [dict get $result http]]
} -result {1}

# Test we can cast an accurate mtime from S3 head Last-Modified
test s3-head-1.3 {qc::s3 head: s3_url encrypted} -constraints {
requires_s3
requires_test_bucket
requires_s3_put
} -body {
set local_filename [qc::file_temp "1234"]
set s3_url "s3://${bucket}/s3_tools_test-head-1.3-test"
::try {
qc::s3 put $s3_url $local_filename true
} finally {
file delete $local_filename
}

after 2000
set result [qc::s3 head $s3_url true]
set mtime [clock scan [dict get $result Last-Modified] -gmt 1]
set now [qc::cast epoch [qc::cast timestamp "now"]]
if { [expr {$now - $mtime}] <= 2 && [expr {$now - $mtime}] > 0 } {
return 1
} else {
return 0
}
} -result {1}

test s3-head-1.4 {qc::s3 head: request without encryption for an encrypted file} -constraints {
requires_s3
requires_test_bucket
requires_s3_put
} -body {
set local_filename [qc::file_temp "1234"]
set s3_url "s3://${bucket}/s3_tools_test-head-1.4-test"
::try {
qc::s3 put $s3_url $local_filename true
} finally {
file delete $local_filename
}

after 2000
set result [qc::s3 head $s3_url]
} -returnCodes {
error
} -result "RESPONSE 400 while contacting\
https://${bucket}.s3.eu-west-1.amazonaws.com/s3_tools_test-head-1.4-test"

# copy
test s3-copy-1.0 {qc::s3 copy: s3_uri_from s3_uri_to} -constraints {
requires_s3
Expand Down
Loading