# -*- tcl -*-
# S3.test: tests for the S3 access package.
# This file contains a collection of tests for the S3
# package. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
# Copyright (c) 2006,2008 Darren New. All Rights Reserved.
# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net>
# (Boilerplate stuff (header, footer))
# All rights reserved.
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
testsNeedTcl 8.5
testsNeedTcltest 2.0
support {
use uri/uri.tcl uri
}
testsNeed xml ; # aka TclXML, author Steve Ball, of Zveno (Australia)
# Put your own keys into test-assets/aws-access-id, aws-secret-access_key
# -------------------------------------------------------------------------
if {![file exists [localPath test-assets/aws-access-id]] ||
![file exists [localPath test-assets/aws-secret-access-key]]
} {
if {[file exists [localPath test-assets/no-aws]]} {
puts " Skipping the tests found in \"[file tail [info script]]\""
puts " AWS not configured by user choice."
} else {
puts " Aborting the tests found in \"[file tail [info script]]\""
puts " AWS configuration required, missing."
puts " Place access id and secret key into the files"
puts " - [localPath test-assets/aws-access-id], and"
puts " - [localPath test-assets/aws-secret-access-key]"
}
return
}
# -------------------------------------------------------------------------
support {
# Requires xml (TclXML)
useLocal xsxp.tcl xsxp ;# Here we need (tcl)xml
}
testing {
useLocal S3.tcl S3
}
# -------------------------------------------------------------------------
# I normally leave BucketDeletion false, because Amazon gets cranky
# if you delete a bucket and then try to recreate it any time soon.
# This may clobber files starting with the characers "S3T". Don't
# run it in a directory with such files you want.
# Put your own keys in test-assets/test-S3.config.
tcltest::customMatch S3err S3ErrorMatch
tcltest::testConstraint BucketDeletion false
tcltest::testConstraint REST true
tcltest::testConstraint BucketIO true
tcltest::testConstraint ItemIO true
tcltest::testConstraint Put true
tcltest::testConstraint Get true
tcltest::testConstraint Acl true
tcltest::testConstraint Head true
tcltest::testConstraint Directory true
tcltest::testConstraint Delete true
tcltest::configure -verbose {body error pass skip start}
tcltest::configure -debug 1
# Allow easy testing of S3-style errorCode returns.
proc S3expectErr {code} {
global errorCode
set errorCode {}
set x [catch $code result]
return [concat $x $errorCode]
}
proc S3ErrorMatch {expected actual} {
if {$expected eq [lrange $actual 0 [expr {[llength $expected]-1}]]} {
return true
} else {
return false
}
}
# Allow easy testing of background tasks.
proc S3expectBackgroundREST {req} {
# Might be done better, tho...
set ::S3::afterResult {}
set ::S3::afterRan 0
set y [after 1 {set ::S3::afterRan 1}]
S3::REST $req
vwait [dict get $req resultvar]
set x [set [dict get $req resultvar]]
after cancel $y
#if {$::S3::afterResult eq "AFTER-FAILURE"} {
#error "Background task never returned value" "" [after info $x]
#}
if {[string match "BGERROR*" $::S3::afterResult]} {
error "BGError triggered: $::S3::afterResult" "" $::S3::afterResult
}
if {0 == $::S3::afterRan} {
error "Concurrent events did not run" "" "S3 test afterRan"
}
return $x
}
proc S3expectBackground {code} {
# Might be done better, tho...
set ::S3::afterResult {}
set ::S3::afterRan 0
set y [after 1 {set ::S3::afterRan 1}]
set x [eval $code]
after cancel $y
#if {$::S3::afterResult eq "AFTER-FAILURE"} {
#error "Background task never returned value" "" [after info $x]
#}
if {[string match "BGERROR*" $::S3::afterResult]} {
error "BGError triggered: $::S3::afterResult" "" $::S3::afterResult
}
if {0 == $::S3::afterRan} {
error "Concurrent events did not run" "" "S3 test afterRan"
}
return $x
}
proc bgerror {args} {set ::S3::afterResult [list "BGERROR" $args $::errorInfo]}
# Allow easy incorporation of user's AccessID and SecretKey
proc S3loadKeys {} {
source [localPath test-assets test-S3.config]
}
namespace import ::tcltest::test
proc CleanUpBuckets {{buckets 0}} {
S3loadKeys
set bucket [S3::SuggestBucket TclTestS3b]
for {set i 0} {$i < 25} {incr i} {
puts "Deleting $i of 25"
for {set j 0} {$j < 10} {incr j} {
set q [format %02d $i]
set d [S3::REST \
[dict create verb DELETE resource /$bucket/thing/$q/$j]]
S3::throwhttp $d
}
}
S3::REST [dict create verb DELETE resource /$bucket/fred ]
S3::REST [dict create verb DELETE resource /$bucket/barney ]
S3::REST [dict create verb DELETE resource /$bucket/wilma ]
S3::REST [dict create verb DELETE resource /$bucket/betty ]
S3::REST [dict create verb DELETE resource /$bucket/cartman ]
S3::REST [dict create verb DELETE resource /$bucket/cartoon/tweety ]
S3::REST [dict create verb DELETE resource /$bucket/cartoon/sylvester ]
S3::REST [dict create verb DELETE resource "/$bucket/cartoon/road runner" ]
S3::REST [dict create verb DELETE \
resource "/$bucket/cartoon/wile e. coyote" ]
if {$buckets} {S3::REST [dict create verb DELETE resource /$bucket]}
}
# CleanUpBuckets 0 ; exit
# Test URL encoding
test S3-1.10 {URL encoding no parameters} -body {
S3::to_url /quotes/nelson {}
} -result {/quotes/nelson}
test S3-1.20 {URL encoding with parameters} -body {
S3::to_url /quotes/nelson {alpha one beta two}
} -result {/quotes/nelson?alpha=one&beta=two}
test S3-1.30 {URL encoding with parameters and query} -body {
S3::to_url /quotes/nelson?acl {alpha one beta two}
} -result {/quotes/nelson?acl&alpha=one&beta=two}
test S3-1.40 {URL with non-ASCII characters} -body {
set funky "/xyzzy/zz+fun\(\)good?junk space"
append funky "&and_utf-8\u2211Sigma\u5927Da"
S3::encode_url $funky
} -result {/xyzzy/zz%2bfun%28%29good%3fjunk%20space%26and_utf-8%e2%88%91Sigma%e5%a4%a7Da}
test S3-1.50 {Check out content types A} -setup {
tcltest::makeFile "This is just text" "S3junk.txt"
} -body {
S3::contenttype S3junk.txt
} -cleanup {
tcltest::removeFile "S3junk.txt"
} -result "text/plain"
test S3-1.60 {Check out content types A} -body {
# May be unhappy under UNIX?
S3::contenttype origT1.jpg
} -result "image/jpeg"
test S3-2.10 {Config no args} -body {
array set x [S3::Configure]
foreach key [lsort [array names x]] {
puts $key ; puts $x($key)
}
} -cleanup {unset x} -output "-accesskeyid\n\n-bucket-prefix\nTclS3\n-default-acl\n\n-default-bucket\n\n-default-compare\nalways\n-default-separator\n/\n-reset\nfalse\n-retries\n3\n-secretaccesskey\n\n-service-access-point\ns3.amazonaws.com\n-slop-seconds\n3\n-use-tls\nfalse\n"
test S3-2.20 {Config, one arg} -body {
S3::Configure -bucket-prefix
} -result {TclS3}
test S3-2.30 {Config, set bucket prefix} -body {
S3::Configure -bucket-prefix TclTestS3
S3::Configure -bucket-prefix
} -result {TclTestS3}
test S3-2.40 {Config, bad first argument} -body {
S3expectErr {S3::Configure -xyzzy}
} -result "1 S3 usage -xyzzy" -match S3err
test S3-2.50 {Config, wrong number of pairs} -body {
set ::errorCode {}
S3::Configure -bucket-prefix TclTestS3
set x [catch {S3::Configure -bucket-prefix 1234 -use-tls}]
set y [S3::Configure -bucket-prefix]
return [concat $x [lrange $::errorCode 0 1] $y]
} -result {1 S3 usage TclTestS3} -cleanup {unset x ; unset y}
test S3-2.60 {Config, test reset} -body {
S3::Configure -bucket-prefix XYZZY -reset true
return [S3::Configure -bucket-prefix]
} -result TclS3
test S3-2.70 {Suggest bucket name} -body {
S3::Configure -accesskeyid 44CF9590006BF252F707 \
-secretaccesskey OtxrzxIsfpFjA7SwPzILwy8Bw21TLhquhboDYROV
set x [S3::SuggestBucket Bloop]
return [concat [string match *Bloop* $x] \
[string match *44CF9590006BF252F707* $x] \
[string match *OtxrzxIsfpFjA7SwPzILwy8Bw21TLhquhboDYROV* $x]]
} -result {1 1 0}
# Now test the stuff from the manual
test S3-3.10 {First documentation example of AUTH} -body {
S3::Configure -accesskeyid 44CF9590006BF252F707 \
-secretaccesskey OtxrzxIsfpFjA7SwPzILwy8Bw21TLhquhboDYROV
set verb put
set resource /quotes/nelson
set content-type text/html
set headers {
date "Thu, 17 Nov 2005 18:49:58 GMT"
content-md5 c8fdb181845a4ca6b8fec737b3581d76
x-amz-meta-author foo@bar.com
x-amz-magic abracadabra
}
set res [S3::authREST $verb $resource ${content-type} $headers]
dict get $res authorization
} -result {AWS 44CF9590006BF252F707:jZNOcbfWmD/A/f3hSvVzXZjM2HU=}
test S3-3.20 {Second documentation example of AUTH} -body {
S3::Configure -accesskeyid 44CF9590006BF252F707 \
-secretaccesskey OtxrzxIsfpFjA7SwPzILwy8Bw21TLhquhboDYROV
set verb GET
set resource /quotes/nelson
set headers {
date XXXXXXX
x-amz-magic abracadabra
x-amz-date "Thu, 17 Nov 2005 18:49:58 GMT"
}
set res [S3::authREST $verb $resource "" $headers]
dict get $res authorization
} -result {AWS 44CF9590006BF252F707:5m+HAmc5JsrgyDelh9+a2dNrzN8=}
test S3-4.10 {REST Blocking list of buckets} -constraints "BucketIO REST" \
-setup S3loadKeys -body {
set req [dict create verb GET resource /]
set res [S3::REST $req]
return [list [lsort [dict keys $res]] [dict get $res httpstatus] \
[expr {0<[string length [dict get $res outbody]]}]]
} -result {{httpmessage httpstatus outbody outheaders resource verb} 200 1}
test S3-4.20 {REST Nonblocking list of buckets} -constraints "BucketIO REST" \
-setup S3loadKeys -body {
set req [dict create verb GET resource / resultvar ::S3RES]
set res [S3expectBackgroundREST $req]
return [list [lsort [dict keys $res]] [dict get $res httpstatus] \
[expr {0<[string length [dict get $res outbody]]}]]
} -result {{httpmessage httpstatus outbody outheaders resource resultvar verb} 200 1}
test S3-4.30 {REST blocking create bucket} -constraints "BucketIO REST" \
-setup S3loadKeys -body {
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b headers {x-amz-acl public-read}]
set res [S3::REST $req]
return [dict get $res httpstatus]
} -result 200
test S3-4.40 {REST get bucket acl} -constraints "BucketIO REST" \
-setup S3loadKeys -body {
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb GET resource /$b rtype acl]
set res [S3::REST $req]
set lookfor {<URI>http://acs.amazonaws.com/groups/global/AllUsers</URI></Grantee><Permission>READ</Permission>}
set found [expr {-1 != [string first $lookfor $res]}]
return [list $found [dict get $res httpstatus]]
} -result "1 200"
test S3-4.50 {REST blocking put,get,compare contents} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "This is a test. This is only a test.\nHad this been a real emergency, you would be dead.\n"
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t1.txt inbody $body \
headers {x-amz-acl public-read}]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb GET resource /$b/t1.txt rtype acl]
set res [S3::REST $req]
set lookfor {<URI>http://acs.amazonaws.com/groups/global/AllUsers</URI></Grantee><Permission>READ</Permission>}
set r2 [expr {-1 != [string first $lookfor $res]}]
set req [dict create verb GET resource /$b/t1.txt]
set res [S3::REST $req]
set r3 [string compare $body [dict get $res outbody]]
return [list $r1 $r2 $r3]
} -result "200 1 0"
test S3-4.60 {REST nonblocking put,get,compare contents} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "This is a test. This is only a test.\nHad this been a real emergency, you would be dead.\n"
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t1.txt inbody $body \
headers {x-amz-acl public-read} resultvar ::S3REST]
set res [S3expectBackgroundREST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb GET resource /$b/t1.txt rtype acl resultvar ::S3REST]
set res [S3expectBackgroundREST $req]
set lookfor {<URI>http://acs.amazonaws.com/groups/global/AllUsers</URI></Grantee><Permission>READ</Permission>}
set r2 [expr {-1 != [string first $lookfor $res]}]
set req [dict create verb GET resource /$b/t1.txt resultvar ::S3REST]
set res [S3expectBackgroundREST $req]
set r3 [string compare $body [dict get $res outbody]]
return [list $r1 $r2 $r3]
} -result "200 1 0"
test S3-4.70 {REST blocking put,delete} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "This is a test. This is only a test.\nHad this been a real emergency, you would be dead.\n"
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t1.txt inbody $body]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb DELETE resource /$b/t1.txt]
set res [S3::REST $req]
set r2 [dict get $res httpstatus]
return [list $r1 $r2]
} -result "200 204" ; # Delete returns "no content"
test S3-4.80 {REST nonblocking put,delete} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "This is a test. This is only a test.\nHad this been a real emergency, you would be dead.\n"
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t1.txt inbody $body \
resultvar ::S3RES]
set res [S3expectBackgroundREST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb DELETE resource /$b/t1.txt resultvar ::S3RES]
set res [S3expectBackgroundREST $req]
set r2 [dict get $res httpstatus]
return [list $r1 $r2]
} -result "200 204" ; # Delete returns "no content"
test S3-4.90 {REST blocking put,head,delete} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "This is a test. This is only a test.\nHad this been a real emergency, you would be dead.\n"
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t1.txt inbody $body]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t1.txt]
set res [S3::REST $req]
set r2 [dict get $res httpstatus]
set r3 [string length [dict get $res outbody]]
set req [dict create verb DELETE resource /$b/t1.txt]
set res [S3::REST $req]
set r4 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t1.txt]
set res [S3::REST $req]
set r5 [dict get $res httpstatus]
return [list $r1 $r2 $r3 $r4 $r5]
} -result "200 200 0 204 404"
test S3-4.100 {REST blocking put,head,delete from big body} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "0123456789"
set body [string repeat $body 50000] ; # Make body 500,000 bytes.
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t1.txt inbody $body]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t1.txt]
set res [S3::REST $req]
set r2 [dict get $res httpstatus]
set r3 [string length [dict get $res outbody]]
set r4 [dict get $res outheaders content-length]
set req [dict create verb DELETE resource /$b/t1.txt]
set res [S3::REST $req]
set r5 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t1.txt]
set res [S3::REST $req]
set r6 [dict get $res httpstatus]
return [list $r1 $r2 $r3 $r4 $r5 $r6]
} -result "200 200 0 500000 204 404"
test S3-4.110 {REST nonblocking put,head,delete from big body} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "0123456789"
set body [string repeat $body 50000] ; # Make body 500,000 bytes.
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t2.txt inbody $body resultvar ::S3RES]
set res [S3expectBackgroundREST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t2.txt]
set res [S3::REST $req]
set r2 [dict get $res httpstatus]
set r3 [string length [dict get $res outbody]]
set r4 [dict get $res outheaders content-length]
set req [dict create verb DELETE resource /$b/t2.txt]
set res [S3::REST $req]
set r5 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t2.txt]
set res [S3::REST $req]
set r6 [dict get $res httpstatus]
return [list $r1 $r2 $r3 $r4 $r5 $r6]
} -result "200 200 0 500000 204 404"
test S3-4.120 {REST nonblocking put,head,delete from big file} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "0123456789"
set body [string repeat $body 50000] ; # Make body 500,000 bytes.
tcltest::makeFile "XXX" S3Tone.txt
set x [open S3Tone.txt w] ; puts -nonewline $x $body ; close $x
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t3.txt infile S3Tone.txt resultvar ::S3RES]
set res [S3expectBackgroundREST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t3.txt]
set res [S3::REST $req]
set r2 [dict get $res httpstatus]
set r3 [string length [dict get $res outbody]]
set r4 [dict get $res outheaders content-length]
set req [dict create verb DELETE resource /$b/t3.txt]
set res [S3::REST $req]
set r5 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t3.txt]
set res [S3::REST $req]
set r6 [dict get $res httpstatus]
tcltest::removeFile S3Tone.txt
return [list $r1 $r2 $r3 $r4 $r5 $r6]
} -result "200 200 0 500000 204 404"
test S3-4.130 {REST blocking put,head,delete from big file} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "0123456789"
set body [string repeat $body 50000] ; # Make body 500,000 bytes.
tcltest::makeFile "XXX" S3Tone.txt
set x [open S3Tone.txt w] ; puts -nonewline $x $body ; close $x
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t3.txt infile S3Tone.txt]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t3.txt]
set res [S3::REST $req]
set r2 [dict get $res httpstatus]
set r3 [string length [dict get $res outbody]]
set r4 [dict get $res outheaders content-length]
set req [dict create verb DELETE resource /$b/t3.txt]
set res [S3::REST $req]
set r5 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t3.txt]
set res [S3::REST $req]
set r6 [dict get $res httpstatus]
tcltest::removeFile S3Tone.txt
return [list $r1 $r2 $r3 $r4 $r5 $r6]
} -result "200 200 0 500000 204 404"
test S3-4.140 {REST nonblocking put,get,delete into file} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "0123456789"
set body [string repeat $body 50000] ; # Make body 500,000 bytes.
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t5.txt inbody $body resultvar ::S3RES]
set res [S3expectBackgroundREST $req]
set r1 [dict get $res httpstatus]
tcltest::makeFile "blah" S3Ttwo.txt
set x [open S3Ttwo.txt w] ; fconfigure $x -translation binary -encoding binary
set req [dict create verb GET resource /$b/t5.txt outchan $x]
set res [S3::REST $req]
close $x
set r2 [dict get $res httpstatus]
set r3 [file size S3Ttwo.txt]
tcltest::removeFile S3Ttwo.txt
set req [dict create verb DELETE resource /$b/t3.txt]
set res [S3::REST $req]
set r4 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t3.txt]
set res [S3::REST $req]
set r5 [dict get $res httpstatus]
return [list $r1 $r2 $r3 $r4 $r5]
} -result "200 200 500000 204 404"
test S3-4.150 {REST blocking put,get,delete into file} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "0123456789"
set body [string repeat $body 50000] ; # Make body 500,000 bytes.
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b/t5.txt inbody $body]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
tcltest::makeFile "blah" S3Ttwo.txt
set x [open S3Ttwo.txt w] ; fconfigure $x -translation binary -encoding binary
set req [dict create verb GET resource /$b/t5.txt outchan $x]
set res [S3::REST $req]
close $x
set r2 [dict get $res httpstatus]
set r3 [file size S3Ttwo.txt]
tcltest::removeFile S3Ttwo.txt
set req [dict create verb DELETE resource /$b/t5.txt]
set res [S3::REST $req]
set r4 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$b/t5.txt]
set res [S3::REST $req]
set r5 [dict get $res httpstatus]
return [list $r1 $r2 $r3 $r4 $r5]
} -result "200 200 500000 204 404"
test S3-4.160 {REST blocking put,get,delete of file with encoded name} \
-constraints "ItemIO REST" \
-setup S3loadKeys -body {
set body "0123456789"
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set funky "/$b/zz+fun\(\)good?junk space"
append funky "&and_utf-8\u2211Sigma\u5927Da"
set req [dict create verb PUT resource $funky inbody $body]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb GET resource $funky]
set res [S3::REST $req]
set r2 [dict get $res httpstatus]
set req [dict create verb DELETE resource $funky]
set res [S3::REST $req]
set r3 [dict get $res httpstatus]
set req [dict create verb HEAD resource $funky]
set res [S3::REST $req]
set r4 [dict get $res httpstatus]
return [list $r1 $r2 $r3 $r4]
} -result "200 200 204 404"
test S3-4.170 {REST delete bucket} \
-constraints "BucketDeletion REST" \
-setup S3loadKeys -body {
# Bucket ought to be empty by now.
# Of course, if a delete fails for some reason...
set b "TclTestS3.REST.[S3::Configure -accesskeyid]"
set req [dict create verb PUT resource /$b headers {x-amz-acl public-read}]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
after 5000 ; # Give AWS a chance to remember it.
set req [dict create verb DELETE resource /$b]
set res [S3::REST $req]
after 5000 ; # Give AWS a chance to remember it.
set r2 [dict get $res httpstatus]
set req [dict create verb GET resource /$b]
set res [S3::REST $req]
set r3 [dict get $res httpstatus]
return [list $r1 $r2 $r3]
} -result "200 204 404"
test S3-10.10 {ListAllMyBuckets auth failure} -constraints BucketIO \
-body {
S3expectErr {
S3::Configure -accesskeyid 44CF9590006BF252F707 \
-secretaccesskey OtxrzxIsfpFjA7SwPzILwy8Bw21TLhquhboDYROV
S3::ListAllMyBuckets
}
} -result "1 S3 remote 403" -match S3err
test S3-10.20 {ListAllMyBuckets usage params} -body {
S3expectErr {
S3::ListAllMyBuckets -blocking false -parse-xml {} -result-type REST
}
} -result "1 S3 usage -parse-xml" -match S3err
test S3-10.30 {ListAllMyBuckets bad params two} -body {
S3expectErr {S3::ListAllMyBuckets -xyz hello}
} -result "1 S3 usage -xyz" -match S3err
test S3-10.40 {ListAllMyBuckets bad params three} -body {
S3expectErr {S3::ListAllMyBuckets -blocking false -parse-xml}
} -result "1 S3 usage -parse-xml" -match S3err
set testLAMB {<?xml version="1.0" encoding="UTF-8"?>
<ListAllMyBucketsResult xmlns="http://s3.amazonaws.com/doc/2006-03-01/"><Owner><ID>9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd</ID><DisplayName>dnew@san.rr.com</DisplayName></Owner><Buckets><Bucket><Name>darren</Name><CreationDate>2006-10-29T07:04:48.000Z</CreationDate></Bucket><Bucket><Name>darren-test</Name><CreationDate>2006-10-29T07:04:48.000Z</CreationDate></Bucket><Bucket><Name>darren3</Name><CreationDate>2006-10-30T22:45:34.000Z</CreationDate></Bucket></Buckets></ListAllMyBucketsResult>}
test S3-10.50 {ListAllMyBuckets result parsing RAW} -body {
S3::ListAllMyBuckets -parse-xml $testLAMB -result-type xml
} -result $testLAMB
test S3-10.60 {ListAllMyBuckets result parsing REST} -constraints BucketIO -body {
set dict [S3::ListAllMyBuckets -result-type REST]
dict get $dict httpstatus
} -result "403"
test S3-10.70 {ListAllMyBuckets result parsing PXML} -body {
set pxml [S3::ListAllMyBuckets -result-type pxml -parse-xml $testLAMB]
concat [lindex $pxml 0] [llength $pxml]
} -result "ListAllMyBucketsResult 4"
test S3-10.80 {ListAllMyBuckets result parsing NAMES} -body {
# Note these are defined to be alphabetical, so no sorting needed
S3::ListAllMyBuckets -result-type names -parse-xml $testLAMB
} -result "darren darren-test darren3"
test S3-10.90 {ListAllMyBuckets result parsing DICT} -body {
set dict [S3::ListAllMyBuckets -result-type dict -parse-xml $testLAMB]
puts [llength $dict]
puts [dict get $dict Owner/ID]
puts [dict get $dict Owner/DisplayName]
puts [dict get $dict Bucket/Name]
puts [dict get $dict Bucket/Date]
} -output {8
9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd
dnew@san.rr.com
darren darren-test darren3
2006-10-29T07:04:48.000Z 2006-10-29T07:04:48.000Z 2006-10-30T22:45:34.000Z
}
test S3-10.100 {ListAllMyBuckets result parsing OWNER} -body {
S3::ListAllMyBuckets -result-type owner -parse-xml $testLAMB
} -result {9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd dnew@san.rr.com}
test S3-10.110 {ListAllMyBuckets result parsing error} -body {
S3expectErr [list S3::ListAllMyBuckets -result-type xyzzy \
-parse-xml $testLAMB]
} -result "1 S3 usage -result-type" -match S3err
test S3-10.120 {ListAllMyBuckets result parsing error} -body {
S3expectErr {S3::ListAllMyBuckets -result-type xyzzy -parse-xml "<Hello"}
} -result "1 S3 usage xml" -match S3err
test S3-10.130 {ListAllMyBuckets background good} -constraints BucketIO -body {
S3loadKeys
set x [S3expectBackground {S3::ListAllMyBuckets -result-type REST -blocking false}]
dict get $x httpstatus
} -result "200"
test S3-10.140 {ListAllMyBuckets background bad} -constraints BucketIO -body {
S3loadKeys
S3expectErr {
S3expectBackground {
S3::ListAllMyBuckets -result-type REST -blocking true
}
}
} -result "1 S3 test afterRan" -match S3err
test S3-20.10 {PutBucket your own bucket} -constraints BucketIO -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
S3::PutBucket -bucket $b
}
test S3-20.20 {PutBucket someone else's bucket} -constraints BucketIO -body {
S3loadKeys
S3expectErr {S3::PutBucket -bucket /test/}
} -result "1 S3 remote 409" -match S3err
test S3-20.30 {PutBucket background failure} -constraints BucketIO -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
S3expectErr [list S3expectBackground [list S3::PutBucket -bucket $b]]
} -result "1 S3 test afterRan" -match S3err
test S3-20.40 {PutBucket background success} -constraints BucketIO -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
S3expectBackground [list S3::PutBucket -bucket $b -blocking false]
}
test S3-20.50 {PutBucket test no acl} -constraints BucketIO -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
S3::PutBucket -bucket $b
set d1 [dict create verb GET resource /$b rtype acl]
set d2 [S3::REST $d1]
set d3 [string first "READ" $d2]
return [expr -1 == $d3]
} -result 1
test S3-20.60 {PutBucket test pubread acl} -constraints BucketIO -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
S3::PutBucket -bucket $b -acl public-read
set d1 [dict create verb GET resource /$b rtype acl]
set d2 [S3::REST $d1]
set d3 [string first "AllUsers" $d2]
set d4 [string first "READ" $d2]
return [expr 0 < $d3 && $d3 < $d4]
} -result 1
test S3-20.70 {PutBucket test given overrides default acl} \
-constraints BucketIO -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
S3::Configure -default-acl public-read-write
S3::PutBucket -bucket $b -acl public-read
S3::Configure -reset true
S3loadKeys
set d1 [dict create verb GET resource /$b rtype acl]
set d2 [S3::REST $d1]
set d3 [string first "AllUsers" $d2]
set d4 [string first "READ" $d2]
set d5 [string first "WRITE" $d2]
return [expr 0 < $d3 && $d3 < $d4 && $d5 == -1]
} -result 1
test S3-20.80 {PutBucket test default acl} -constraints BucketIO -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
S3::Configure -default-acl public-read-write
S3::PutBucket -bucket $b
S3::Configure -reset true
S3loadKeys
set d1 [dict create verb GET resource /$b rtype acl]
set d2 [S3::REST $d1]
set d3 [string first "AllUsers" $d2]
set d4 [string first "READ" $d2]
set d5 [string first "WRITE" $d2]
return [expr 0 < $d3 && $d3 < $d4 && $d3 < $d5]
} -result 1
test S3-30.10 {DeleteBucket error} \
-constraints "BucketIO BucketDeletion" -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
after 10000 ; # Wait for amazon to catch up
S3expectErr {S3::DeleteBucket}
} -result "1 S3 usage -bucket" -match S3err
test S3-30.20 {DeleteBucket good} \
-constraints "BucketIO BucketDeletion" -body {
S3loadKeys
set b [S3::SuggestBucket TclTestS3]
after 10000 ; # Wait for amazon to catch up
set x [S3::DeleteBucket -bucket $b]
after 10000 ; # Wait for amazon to catch up
return $x
}
test S3-30.30 {DeleteBucket fails on someone else's bucket} \
-constraints "BucketIO BucketDeletion" -body {
S3loadKeys
set b "test"
after 10000 ; # Wait for amazon to catch up
S3expectErr [list S3::DeleteBucket -bucket $b]
} -result "1 S3 remote 403" -match S3err
# Since bucket create/delete is high overhead for Amazon,
# and it's flakey as well, don't test the background version,
# since it uses the same code.
# OK, since we need a bucket to test stuff, let's continue on.
S3loadKeys
set bucket [S3::SuggestBucket TclTestS3b]
set req [dict create verb HEAD resource /$bucket]
set res [S3::REST $req]
set r1 [dict get $res httpstatus]
set req [dict create verb HEAD resource /$bucket/fred]
set res [S3::REST $req]
set r2 [dict get $res httpstatus]
if {200 != $r1 || 200 != $r2} {
S3::PutBucket -bucket $bucket
if {[tcltest::testConstraint Directory]} {
for {set i 0} {$i < 25} {incr i} {
puts "Creating $i of 25"
for {set j 0} {$j < 10} {incr j} {
set q [format %02d $i]
set d [S3::REST \
[dict create verb PUT resource /$bucket/thing/$q/$j \
inbody "This is $j inside $i"]]
S3::throwhttp $d
}
}
}
S3::REST [dict create verb PUT resource /$bucket/fred inbody "Fred"]
S3::REST [dict create verb PUT resource /$bucket/barney inbody "Barney"]
S3::REST [dict create verb PUT resource /$bucket/wilma inbody "Wilma"]
S3::REST [dict create verb PUT resource /$bucket/betty inbody "Betty"]
S3::REST [dict create verb PUT resource /$bucket/cartman inbody "Cartman" ]
S3::REST [dict create verb PUT resource /$bucket/cartoon/tweety \
inbody "Tweety"]
S3::REST [dict create verb PUT resource /$bucket/cartoon/sylvester \
inbody "Sylvester"]
S3::REST [dict create verb PUT resource "/$bucket/cartoon/road runner" \
inbody "RoadRunner"]
S3::REST [dict create verb PUT resource "/$bucket/cartoon/wile e. coyote" \
inbody "Coyote"]
}
# Note that -result-type REST or xml or pxml without a maxcount all
# return lists of results of that type, since they don't really merge well.
test S3-40.10 {GetBucket basic call} -constraints BucketIO -body {
set res [S3::GetBucket -bucket $bucket -result-type REST]
set x1 [llength $res]
set x2 [dict get [lindex $res 0] httpstatus]
return "$x1 $x2"
} -result "1 200"
test S3-40.20 {GetBucket get xml} -constraints BucketIO -body {
set res [S3::GetBucket -bucket $bucket -result-type xml]
set x1 [llength $res]
set x2 [lindex $res 0]
set x3 [lindex [::xsxp::parse $x2] 0]
return "$x1 $x3"
} -result "1 ListBucketResult"
test S3-40.30 {GetBucket get pxml} -constraints BucketIO -body {
set res [S3::GetBucket -bucket $bucket -result-type pxml]
set x1 [llength $res]
set x2 [lindex $res 0]
set x3 [lindex $x2 0]
return "$x1 $x3"
} -result "1 ListBucketResult"
test S3-40.40 {GetBucket names} -constraints BucketIO -body {
set r1 [S3::GetBucket -bucket $bucket -result-type names]
set r2 [lsort $r1]
set r3 [lsort -unique $r1]
return [list [llength $r1] [expr {$r1 eq $r2}] [expr {$r2 eq $r3}]]
} -result "259 1 1"
test S3-40.50 {GetBucket simple looping} -constraints BucketIO -body {
set res [S3::GetBucket -bucket $bucket -result-type REST -TEST 50]
return [llength $res]
} -result "6" ; # 259, 50 at a time.
test S3-40.60 {GetBucket looping, return names} -constraints BucketIO -body {
set r1 [S3::GetBucket -bucket $bucket -result-type names -TEST 50]
set r2 [lsort $r1]
set r3 [lsort -unique $r1]
return [list [llength $r1] [expr {$r1 eq $r2}] [expr {$r2 eq $r3}]]
return [llength $res]
} -result "259 1 1"; # Shouldn't see the inners here.
test S3-40.70 {GetBucket looping, return dict} -constraints BucketIO -body {
set res [S3::GetBucket -bucket $bucket -result-type dict -TEST 50]
set r1 [llength [dict get $res Key]]
set r2 [string compare [dict get $res Key] [lsort [dict get $res Key]]]
set r3 [llength [dict get $res LastModified]]
set r4 [llength [dict get $res ETag]]
set r5 [llength [dict get $res Size]]
set r6 [llength [dict get $res Owner/ID]]
set r7 [llength [dict get $res Owner/DisplayName]]
set r8 [llength [dict get $res CommonPrefixes/Prefix]]
return "$r1 $r2 $r3 $r4 $r5 $r6 $r7 $r8"
} -result "259 0 259 259 259 259 259 0"
test S3-40.80 {GetBucket non-looping, return dict} -constraints BucketIO -body {
set res [S3::GetBucket -bucket $bucket -result-type dict]
set r1 [llength [dict get $res Key]]
set r2 [string compare [dict get $res Key] [lsort [dict get $res Key]]]
set r3 [llength [dict get $res LastModified]]
set r4 [llength [dict get $res ETag]]
set r5 [llength [dict get $res Size]]
set r6 [llength [dict get $res Owner/ID]]
set r7 [llength [dict get $res Owner/DisplayName]]
set r8 [llength [dict get $res CommonPrefixes/Prefix]]
return "$r1 $r2 $r3 $r4 $r5 $r6 $r7 $r8"
} -result "259 0 259 259 259 259 259 0"
test S3-40.90 {GetBucket looping, prefix} -constraints BucketIO -body {
set r [S3::GetBucket -bucket $bucket \
-result-type names -TEST 50 -prefix "car"]
join $r \n
} -result {cartman
cartoon/road runner
cartoon/sylvester
cartoon/tweety
cartoon/wile e. coyote}
test S3-40.100 {GetBucket delimiter, prefix} -constraints BucketIO -body {
S3::GetBucket -bucket $bucket -result-type names -TEST 50 \
-prefix /thing/ -delimiter /
} -result {thing/00/ thing/01/ thing/02/ thing/03/ thing/04/ thing/05/ thing/06/ thing/07/ thing/08/ thing/09/ thing/10/ thing/11/ thing/12/ thing/13/ thing/14/ thing/15/ thing/16/ thing/17/ thing/18/ thing/19/ thing/20/ thing/21/ thing/22/ thing/23/ thing/24/}
test S3-40.110 {GetBucket delimiter, prefix again} -constraints BucketIO -body {
S3::GetBucket -bucket $bucket -result-type names -TEST 50 \
-prefix thing -delimiter /
} -result {thing/}
test S3-40.120 {GetBucket delimiter, no prefix} -constraints BucketIO -body {
S3::GetBucket -bucket $bucket -result-type names -TEST 50 -delimiter /
} -result {barney betty cartman cartoon/ fred thing/ wilma}
test S3-40.130 {GetBucket no default bucket} -constraints BucketIO -body {
S3expectErr {
S3::GetBucket -result-type names -TEST 50 -delimiter /
}
} -result "1 S3 usage -bucket" -match S3err
test S3-40.140 {GetBucket with default bucket} -constraints BucketIO -body {
S3::Configure -default-bucket $bucket
set res [S3::GetBucket -result-type names -TEST 50 -delimiter /]
S3::Configure -default-bucket ""
return $res
} -result {barney betty cartman cartoon/ fred thing/ wilma}
set bucket [S3::SuggestBucket TclTestS3] ; # Maybe delete later.
proc getbody {resource} {
set req [dict create verb GET resource $resource]
set res [S3::REST $req]
S3::throwhttp $res
set body [dict get $res outbody]
return $body
}
proc delbody {resource} {
set req [dict create verb DELETE resource $resource]
set res [S3::REST $req]
S3::throwhttp $res
}
proc existsbody {resource} {
set req [dict create verb HEAD resource $resource]
set res [S3::REST $req]
return [expr {[dict get $res httpstatus] eq "200"}]
}
# Make a setup/cleanup pair for checking constraints on PUT and GET
set pgsu {
# Create an old file, and a new file, with different contents
tcltest::makeFile "FILEONE" S3Tone.txt
tcltest::makeFile "FILETWO" S3Ttwo.txt
tcltest::makeFile "FILETHREE" S3Tthree.txt
tcltest::makeFile "This is some random content" S3Talpha.txt
tcltest::makeFile "This is some random content" S3Tbeta.txt
tcltest::makeFile "This is some random content" S3Tgamma.txt
tcltest::makeFile "Junk contents" S3junk.txt
set now [clock seconds]
file mtime S3Tone.txt [expr $now-300]
file mtime S3Ttwo.txt [expr $now+300]
file mtime S3Tbeta.txt [expr $now+300]
S3::REST [dict create verb PUT resource /$bucket/ABC inbody "ABC HERE" \
headers {x-amz-meta-thing stuff} content-type application/tcltest]
if {[file exists S3junk.txt]} {file delete S3junk.txt}
}
set pgcu {
tcltest::removeFile S3Tone.txt
tcltest::removeFile S3Ttwo.txt
tcltest::removeFile S3Tthree.txt
tcltest::removeFile S3Talpha.txt
tcltest::removeFile S3Tbeta.txt
tcltest::removeFile S3Tgamma.txt
if {[file exists S3junk.txt]} {file delete S3junk.txt}
if {[existsbody /$bucket/XYZ]} {delbody /$bucket/XYZ}
if {[existsbody /$bucket/PDQ]} {delbody /$bucket/PDQ}
if {[existsbody /$bucket/ABC]} {delbody /$bucket/ABC}
}
test S3-50.10 {Put, basic content} -constraints "Put ItemIO" -body {
set c "This is a test\n"
set x [S3::Put -bucket $bucket -content $c -resource "XYZ"]
set y [getbody /$bucket/XYZ]
set z [expr {$y eq $c}]
return "$x $z"
} -cleanup {
delbody /$bucket/XYZ
} -result "1 1"
test S3-50.20 {Put, with a file} -constraints "Put ItemIO" -setup {
set c "This is the second test.\nIt is still a test.\n"
tcltest::makeFile $c "S3junk.txt"
} -body {
set x [S3::Put -bucket $bucket -file "S3junk.txt" -resource "XYZ"]
set y [getbody /$bucket/XYZ]
set z [expr {$y eq $c}]
return "$x $z"
} -cleanup {
delbody /$bucket/XYZ
tcltest::removeFile "S3junk.txt"
} -result "1 1"
test S3-50.30 {Put with ACL, content-type, meta} \
-constraints "Put ItemIO" -setup {
set c "This is the third test.\nIt is still a test.\n"
tcltest::makeFile $c "S3junk.txt"
} -body {
set x [S3::Put -bucket $bucket -file "S3junk.txt" -resource "XYZ" \
-content-type "application/frobulate" -acl "public-read" \
-x-amz-meta-one ONE -x-amz-meta-two TWO]
set y {} ; set z {}
set req [dict create verb GET resource /$bucket/XYZ]
set res [S3::REST $req]
S3::throwhttp $res
set headers [dict get $res outheaders]
set y [dict get $headers content-type]
set w1 [dict get $headers x-amz-meta-one]
set w2 [dict get $headers x-amz-meta-two]
set d1 [dict create verb GET resource /$bucket/XYZ rtype acl]
set d2 [S3::REST $d1]
set d3 [string first "AllUsers" $d2]
set d4 [string first "READ" $d2]
set z [expr 0 < $d3 && $d3 < $d4]
return [list $x $y $z $w1 $w2]
} -cleanup {
delbody /$bucket/XYZ
tcltest::removeFile "S3junk.txt"
} -result "1 application/frobulate 1 ONE TWO"
test S3-50.40 {Put -compare never} -constraints "Put ItemIO" -body {
set x [S3::Put -file S3junk.txt -bucket $bucket -resource "XYZ" \
-compare never]
set y [existsbody /$bucket/XYZ]
return "$x $y"
} -cleanup {
if {[existsbody /$bucket/XYZ]} {delbody /$bucket/XYZ}
} -result "0 0"
test S3-50.50 {Put -compare always} \
-setup $pgsu -cleanup $pgcu -constraints "Put ItemIO" -body {
set x [S3::Put -file S3Talpha.txt -bucket $bucket -resource "XYZ" \
-compare always]
set y [existsbody /$bucket/XYZ]
set z [S3::Put -file S3Talpha.txt -bucket $bucket -resource "XYZ" \
-compare always]
return "$x $y $z"
} -result "1 1 1"
test S3-50.60 {Put -compare exists} \
-setup $pgsu -cleanup $pgcu -constraints "Put ItemIO" -body {
set x1 [S3::Put -file S3Tone.txt -bucket $bucket -resource "XYZ" \
-compare exists]
set x2 [existsbody /$bucket/XYZ]
S3::Put -file S3Tone.txt -bucket $bucket -resource "XYZ" ; # really make it
set y1 [S3::Put -file S3Ttwo.txt -bucket $bucket -resource "XYZ" \
-compare exists]
set y2 [existsbody /$bucket/XYZ]
set y3 [string trim [getbody /$bucket/XYZ]]
return [list $x1 $x2 $y1 $y2 $y3]
} -result "0 0 1 1 FILETWO"
test S3-50.70 {Put -compare missing} \
-setup $pgsu -cleanup $pgcu -constraints "Put ItemIO" -body {
set x1 [S3::Put -file S3Tone.txt -bucket $bucket -resource "XYZ" \
-compare missing]
set x2 [existsbody /$bucket/XYZ]
set y1 [S3::Put -file S3Ttwo.txt -bucket $bucket -resource "XYZ" \
-compare missing]
set y2 [existsbody /$bucket/XYZ]
set y3 [string trim [getbody /$bucket/XYZ]]
return [list $x1 $x2 $y1 $y2 $y3]
} -result "1 1 0 1 FILEONE"
test S3-50.80 {Put -compare newer} \
-setup $pgsu -cleanup $pgcu -constraints "Put ItemIO" -body {
# Create the file with the current date
S3::Put -file S3Tthree.txt -bucket $bucket -resource "XYZ"
# Make sure ONE (old) doesn't overwrite it.
set x1 [S3::Put -file S3Tone.txt -bucket $bucket -resource "XYZ" \
-compare newer]
set x2 [string trim [getbody /$bucket/XYZ]]
set y1 [S3::Put -file S3Ttwo.txt -bucket $bucket -resource "XYZ" \
-compare newer]
set y2 [string trim [getbody /$bucket/XYZ]]
return [list $x1 $x2 $y1 $y2]
} -result "0 FILETHREE 1 FILETWO"
test S3-50.90 {Put -compare date} \
-setup $pgsu -cleanup $pgcu -constraints "Put ItemIO" -body {
S3::Configure -slop-seconds 60
S3::Put -file S3Tthree.txt -bucket $bucket -resource "XYZ"
set x1 [S3::Put -file S3Tone.txt -bucket $bucket -resource "XYZ" \
-compare date]
set x2 [string trim [getbody /$bucket/XYZ]]
set y1 [S3::Put -file S3Tthree.txt -bucket $bucket -resource "XYZ" \
-compare date]
set y2 [string trim [getbody /$bucket/XYZ]]
set z1 [S3::Put -file S3Tthree.txt -bucket $bucket -resource "PDQ" \
-compare date]
set z2 [string trim [getbody /$bucket/PDQ]]
return [list $x1 $x2 $y1 $y2 $z1 $z2]
} -result "1 FILEONE 0 FILEONE 1 FILETHREE"
test S3-50.100 {Put -compare checksum} \
-setup $pgsu -cleanup $pgcu -constraints "Put ItemIO" -body {
S3::Put -file S3Talpha.txt -bucket $bucket -resource "XYZ"
set x1 [S3::Put -file S3Tbeta.txt -bucket $bucket -resource "XYZ" \
-compare checksum]
set x2 [S3::Put -file S3Tbeta.txt -bucket $bucket -resource "PDQ" \
-compare checksum]
set x3 [S3::Put -content "This is some random content\n" \
-bucket $bucket -resource "XYZ" \
-compare checksum]
set funky "One\u2211Sigma\u5927Da"
S3::Put -content $funky -bucket $bucket -resource "XYZ"
set x4 [S3::Put -content $funky -bucket $bucket -resource "XYZ" \
-compare checksum]
return [list $x1 $x2 $x3 $x4]
} -result "0 1 0 0"
test S3-50.110 {Put -compare different} \
-setup $pgsu -cleanup $pgcu -constraints "Put ItemIO" -body {
S3::Configure -slop-seconds 60
S3::Put -file S3Talpha.txt -bucket $bucket -resource "XYZ"
set x1 [S3::Put -file S3Tbeta.txt -bucket $bucket -resource "XYZ" \
-compare different]
set x2 [S3::Put -file S3Tgamma.txt -bucket $bucket -resource "XYZ" \
-compare different]
set x3 [S3::Put -file S3Tthree.txt -bucket $bucket -resource "XYZ" \
-compare different]
set x4 [string trim [getbody /$bucket/XYZ]]
set x5 [S3::Put -content "FILETHREE\n" -bucket $bucket -resource "XYZ" \
-compare different]
return [list $x1 $x2 $x3 $x4 $x5]
} -result "1 0 1 FILETHREE 0"
test S3-50.120 {Put -compare error} -constraints "Put ItemIO" -body {
S3expectErr [list S3::Put -content "STUFF" \
-bucket $bucket -resource "XYZ" \
-compare other]
} -result "1 S3 usage -compare" -match S3err
test S3-50.130 {Put -file nonexistant} -constraints "Put ItemIO" -body {
S3expectErr [list S3::Put -file nonexistant.txt \
-bucket $bucket -resource "XYZ"]
} -result "1 S3 usage -file" -match S3err
test S3-60.10 {Get, basic content} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
set x [S3::Get -bucket $bucket -content abc -resource "ABC"]
set y [getbody /$bucket/ABC]
set z [expr {$y eq $abc}]
return "$x $z"
} -result "1 1"
test S3-60.20 {Get, with a file} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
set x [S3::Get -bucket $bucket -file "S3junk.txt" -resource "ABC"]
set y [tcltest::viewFile S3junk.txt]
set z [expr {$y eq "ABC HERE"}]
return "$x $z"
} -result "1 1"
test S3-60.30 {Get with meta} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
set x [S3::Get -bucket $bucket -file "S3junk.txt" -resource "ABC" \
-headers thishead]
set y [dict get $thishead content-type]
set z [dict get $thishead x-amz-meta-thing]
return [list $x $y $z]
} -result "1 application/tcltest stuff"
test S3-60.40 {Get -compare never} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
set x [S3::Get -file S3junk.txt -bucket $bucket -resource "ABC" \
-compare never]
set y [file exists S3junk.txt]
return "$x $y"
} -result "0 0"
test S3-60.50 {Get -compare always} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
set x [S3::Get -file S3junk.txt -bucket $bucket -resource "ABC" \
-compare always]
set y [file exists S3junk.txt]
set z [S3::Get -file S3junk.txt -bucket $bucket -resource "ABC" \
-compare always]
set q [S3::Get -content plover -bucket $bucket -resource "ABC" \
-compare always]
return "$x $y $z $q $plover"
} -result "1 1 1 1 ABC HERE"
test S3-60.60 {Get -compare exists} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
set x0 [file exists S3junk.txt]
set x1 [S3::Get -file S3junk.txt -bucket $bucket -resource "ABC" \
-compare exists]
set x2 [file exists S3junk.txt]
set y1 [S3::Get -file S3Tone.txt -bucket $bucket -resource "ABC" \
-compare exists]
set y2 [file exists S3Tone.txt]
set y3 [tcltest::viewFile S3Tone.txt]
return [list $x0 $x1 $x2 $y1 $y2 $y3]
} -result "0 0 0 1 1 {ABC HERE}"
test S3-60.70 {Get -compare missing} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
set x1 [S3::Get -file S3Tone.txt -bucket $bucket -resource "ABC" \
-compare missing]
set x2 [file exists S3Tone.txt]
set y1 [S3::Get -file S3junk.txt -bucket $bucket -resource "ABC" \
-compare missing]
set y2 [file exists S3junk.txt]
set y3 [tcltest::viewFile S3junk.txt]
return [list $x1 $x2 $y1 $y2 $y3]
} -result "0 1 1 1 {ABC HERE}"
test S3-60.80 {Get -compare newer} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
set x1 [S3::Get -file S3Tone.txt -bucket $bucket -resource "ABC" \
-compare newer]
set x2 [tcltest::viewFile S3Tone.txt]
set y1 [S3::Get -file S3Ttwo.txt -bucket $bucket -resource "ABC" \
-compare newer]
set y2 [tcltest::viewFile S3Ttwo.txt]
set z1 [S3::Get -file S3junk.txt -bucket $bucket -resource "ABC" \
-compare newer]
set z2 [tcltest::viewFile S3junk.txt]
set w1 [S3::Get -content w2 -bucket $bucket -resource "ABC" \
-compare newer]
return [list $x1 $x2 $y1 $y2 $z1 $z2 $w1 $w2]
} -result "1 {ABC HERE} 0 FILETWO 1 {ABC HERE} 1 {ABC HERE}"
test S3-60.90 {Get -compare date} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
S3::Configure -slop-seconds 60
set x1 [S3::Get -file S3Tone.txt -bucket $bucket -resource "ABC" \
-compare date]
set x2 [tcltest::viewFile S3Tone.txt]
set y1 [S3::Get -file S3Ttwo.txt -bucket $bucket -resource "ABC" \
-compare date]
set y2 [tcltest::viewFile S3Ttwo.txt]
set z1 [S3::Get -file S3Tthree.txt -bucket $bucket -resource "ABC" \
-compare date]
set z2 [tcltest::viewFile S3Tthree.txt]
set w1 [S3::Get -content w2 -bucket $bucket -resource "ABC" \
-compare date]
return [list $x1 $x2 $y1 $y2 $z1 $z2 $w1 $w2]
} -result "1 {ABC HERE} 1 {ABC HERE} 0 FILETHREE 1 {ABC HERE}"
test S3-60.100 {Get -compare checksum} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
S3::Put -file S3Talpha.txt -bucket $bucket -resource "XYZ"
set x1 [S3::Get -file S3Tbeta.txt -bucket $bucket -resource "XYZ" \
-compare checksum]
set x2 [S3::Get -file S3Tbeta.txt -bucket $bucket -resource "ABC" \
-compare checksum]
set x3 [tcltest::viewFile S3Tbeta.txt]
set x4 [S3::Get -content x5 -bucket $bucket -resource "ABC" \
-compare checksum]
return [list $x1 $x2 $x3 $x4 $x5]
} -result "0 1 {ABC HERE} 1 {ABC HERE}"
test S3-60.110 {Get -compare different} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
S3::Configure -slop-seconds 60
S3::Put -file S3Talpha.txt -bucket $bucket -resource "XYZ"
set x0 [S3::Get -file S3junk.txt -bucket $bucket -resource "XYZ" \
-compare different] ; # Yes, file nonexistant
set x1 [S3::Get -file S3Talpha.txt -bucket $bucket -resource "XYZ" \
-compare different] ; # no, same date, same contents
set x2 [S3::Get -file S3Tbeta.txt -bucket $bucket -resource "XYZ" \
-compare different] ; # Yes, diff date, same contents.
set x3 [S3::Get -file S3Tbeta.txt -bucket $bucket -resource "ABC" \
-compare different] ; # Yes, diff contents, same date
set x4 [S3::Get -content x5 -bucket $bucket -resource "ABC" \
-compare different] ; # Yes, variable
set x6 [tcltest::viewFile S3Tbeta.txt]
return [list $x0 $x1 $x2 $x3 $x4 $x5 $x6]
} -result "1 0 1 1 1 {ABC HERE} {ABC HERE}"
test S3-60.120 {Get -compare error} -constraints "Get ItemIO" -body {
S3expectErr [list S3::Get -file S3Tone.txt \
-bucket $bucket -resource "XYZ" \
-compare other]
} -result "1 S3 usage -compare" -match S3err
test S3-60.130 {Get resource nonexistant, file nonexistant A} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
S3expectErr [list S3::Get -file nonexistant.txt \
-bucket $bucket -resource "XYZ"]
} -result "1 S3 remote 404" -match S3err
test S3-60.131 {Get resource nonexistant, file nonexistant B} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
catch {S3::Get -file nonexistant.txt -bucket $bucket -resource "XYZ"}
file exists nonexistant.txt
} -result "0"
test S3-60.132 {Get resource nonexistant, file existant B} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
S3expectErr [list S3::Get -file S3Talpha.txt \
-bucket $bucket -resource "XYZ"]
} -result "1 S3 remote 404" -match S3err
test S3-60.133 {Get resource nonexistant, file existant A} \
-setup $pgsu -cleanup $pgcu -constraints "Get ItemIO" -body {
catch {S3::Get -file S3Talpha.txt -bucket $bucket -resource "XYZ"}
file exists S3Talpha.txt
} -result "1"
test S3-60.140 {Get with -timestamp options} \
-constraints "Get ItemIO" -body {
# This test assumes your clock and amazon's clock are within 10 seconds
tcltest::makeFile "RandomJunk" ts1.txt
tcltest::makeFile "RandomJunk" ts2.txt
after 10000
S3::Put -content "More random junk" -bucket $bucket -resource "TIMESTAMP"
after 5000
set tick [clock seconds]
after 5000
S3::Get -file ts1.txt -timestamp aws -bucket $bucket -resource "TIMESTAMP"
S3::Get -file ts2.txt -timestamp now -bucket $bucket -resource "TIMESTAMP"
set x1 [file mtime ts1.txt]
set x2 [file mtime ts2.txt]
return [list [expr $x1 < $tick] [expr $x2 < $tick]]
} -cleanup {
tcltest::removeFile ts1.txt
tcltest::removeFile ts2.txt
if {[existsbody /$bucket/TIMESTAMP]} {delbody /$bucket/TIMESTAMP}
} -result "1 0"
test S3-70.10 {Head, resource exists} \
-setup $pgsu -cleanup $pgcu -constraints "Head ItemIO" -body {
set x1 [S3::Head -bucket $bucket -resource "ABC" -dict dict \
-headers headers -status status]
return [list $x1 [dict get $dict httpmessage] [dict exists $headers last-modified] $status]
} -result "1 OK 1 {200 OK}"
test S3-70.20 {Head, resource does not exist} \
-setup $pgsu -cleanup $pgcu -constraints "Head ItemIO" -body {
set x1 [S3::Head -bucket $bucket -resource "XYZ" -dict dict \
-headers headers -status status]
return [list $x1 $status]
} -result "0 {404 {Not Found}}"
test S3-80.10 {Delete, resource exists} \
-setup $pgsu -cleanup $pgcu -constraints "Delete ItemIO" -body {
set x1 [S3::Delete -bucket $bucket -resource "ABC" -status status]
return [list $x1 $status]
} -result "1 {204 {No Content}}"
test S3-80.20 {Delete, resource nonexistant} \
-setup $pgsu -cleanup $pgcu -constraints "Delete ItemIO" -body {
set x1 [S3::Delete -bucket $bucket -resource "XYZ" -status status]
return [list $x1 $status]
} -result "1 {204 {No Content}}"
test S3-80.30 {Delete, resource not mine} \
-setup $pgsu -cleanup $pgcu -constraints "Delete ItemIO" -body {
# Note that ami.prizecapital.net is also mine, but owned by a client.
set x1 [S3::Delete -bucket "ami.prizecapital.net" \
-resource "README.txt" -status status]
return [list $x1 $status]
} -result "0 {403 Forbidden}"
test S3-90.10 {GetAcl REST} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
#set x1 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type xml]
#puts "\n\n$x1\n\n"
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type REST]
return [list [dict get $x2 httpstatus] [string index [dict get $x2 outbody] 0]]
} -result "200 <"
#test S3-90.11 {GetAcl XML} \
#-setup $pgsu -constraints "Zap" -body {
#set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type xml]
#set x3 [open xyzzy.xml w]
#fconfigure $x3 -translation binary -encoding binary
#puts $x3 $x2
#close $x3
#exit
#set x2 [S3::PutAcl -bucket $bucket -resource "ABC" -acl \
#[string trim [read [open xyzzy.xml]]]]
#puts $x2 ; exit
#} -result 1
test S3-90.20 {GetAcl pxml} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type pxml]
return [list [lindex $x2 0] [lindex $x2 2 0]]
} -result "AccessControlPolicy Owner"
test S3-90.30 {GetAcl dict} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set owner [dict get $x2 owner]
set acl [dict get $x2 acl]
set z1 [dict get $acl FULL_CONTROL]
set z2 [expr {$owner == $z1}]
return $z2
} -result "1"
test S3-90.40 {GetAcl -parse-xml} \
-constraints "Acl" -body {
set xml {<?xml version="1.0" encoding="UTF-8"?>
<AccessControlPolicy xmlns="http://s3.amazonaws.com/doc/2006-03-01/"><Owner><ID>9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd</ID><DisplayName>dnew@san.rr.com</DisplayName></Owner><AccessControlList><Grant><Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="Group"><URI>http://acs.amazonaws.com/groups/global/AllUsers</URI></Grantee><Permission>FULL_CONTROL</Permission></Grant><Grant><Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="CanonicalUser"><ID>9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd</ID><DisplayName>dnew@san.rr.com</DisplayName></Grantee><Permission>FULL_CONTROL</Permission></Grant><Grant><Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="CanonicalUser"><ID>a5ee16f393707820a7f2d58631351fe839972d25865f8fc423a754d77523e6d4</ID><DisplayName>darren</DisplayName></Grantee><Permission>READ</Permission></Grant><Grant><Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="CanonicalUser"><ID>a1bf9e3c79a243e04e31bf3d1f532aca94646ab917c188831241bf5d575fee92</ID><DisplayName>Darren</DisplayName></Grantee><Permission>WRITE</Permission></Grant></AccessControlList></AccessControlPolicy>}
set x2 [S3::GetAcl -parse-xml $xml -result-type dict]
return $x2
} -result "owner 9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd acl {READ a5ee16f393707820a7f2d58631351fe839972d25865f8fc423a754d77523e6d4 WRITE a1bf9e3c79a243e04e31bf3d1f532aca94646ab917c188831241bf5d575fee92 FULL_CONTROL {http://acs.amazonaws.com/groups/global/AllUsers 9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd}}"
test S3-90.50 {PutAcl private} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set x1 [S3::PutAcl -bucket $bucket -resource "ABC" -acl private]
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set x3 [dict get $x2 acl]
set x4 [llength $x3]
return [list [string range $x1 0 19] $x4 [lindex $x3 0]]
} -result "<AccessControlPolicy 2 FULL_CONTROL"
test S3-90.60 {PutAcl nonexistant get} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
S3expectErr [list S3::PutAcl -bucket $bucket -resource XYZ -acl private]
} -result "1 S3 remote 404" -match S3err
test S3-90.70 {PutAcl nonexistant put} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set owner [dict get $x2 owner]
S3expectErr [list S3::PutAcl -owner $owner \
-bucket $bucket -resource XYZ -acl private]
} -result "1 S3 remote 404" -match S3err
test S3-90.80 {PutAcl from xml} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set x0 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type xml]
set x1 [S3::PutAcl -bucket $bucket -resource "ABC" -acl $x0]
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set x3 [dict get $x2 acl]
set x4 [llength $x3]
if {"<?xml" == [string range $x1 0 4]} {
set x1 [string range $x1 [expr 1+[string first "\n" $x1]] end]
}
return [list [string range $x1 0 19] $x4 [lindex $x3 0]]
} -result "<AccessControlPolicy 2 FULL_CONTROL"
test S3-90.90 {PutAcl public} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
S3expectErr [list S3::PutAcl -bucket $bucket -resource "ABC" -acl public]
} -result "1 S3 usage -acl public" -match S3err
test S3-90.100 {PutAcl public-read} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set x1 [S3::PutAcl -bucket $bucket -resource "ABC" -acl public-read]
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set x3 [dict get $x2 acl]
set x4 [llength $x3]
set x5 [lsort [dict keys $x3]]
return [list [string range $x1 0 19] $x4 $x5]
} -result "<AccessControlPolicy 4 {FULL_CONTROL READ}"
test S3-90.110 {PutAcl public-read-write} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set x1 [S3::PutAcl -bucket $bucket -resource "ABC" -acl public-read-write]
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set x3 [dict get $x2 acl]
set x4 [llength $x3]
set x5 [lsort [dict keys $x3]]
return [list [string range $x1 0 19] $x4 $x5]
} -result "<AccessControlPolicy 6 {FULL_CONTROL READ WRITE}"
test S3-90.120 {PutAcl authenticated-read} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set x1 [S3::PutAcl -bucket $bucket -resource "ABC" -acl authenticated-read]
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set x3 [dict get $x2 acl]
set x4 [llength $x3]
set x5 [lsort [dict keys $x3]]
return [list [string range $x1 0 19] $x4 $x5]
} -result "<AccessControlPolicy 4 {FULL_CONTROL READ}"
test S3-90.130 {PutAcl complex} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set dict [dict create \
FULL_CONTROL {9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd AuthenticatedUsers} \
WRITE darren@prizecapital.net \
READ http://acs.amazonaws.com/groups/global/AllUsers ]
set x1 [S3::PutAcl -bucket $bucket -resource "ABC" -acl $dict]
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set x3 [dict get $x2 acl]
set x4 [llength $x3]
return [list [string range $x1 0 19] [lsort [dict keys $x3]]]
} -result "<AccessControlPolicy {FULL_CONTROL READ WRITE}"
test S3-90.140 {Put with keep on existing object} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
set dict [dict create \
FULL_CONTROL {9fb13c24488e3d7556693247d5a463c1837c3c8ede28f4094228e6c4eb5d70bd AuthenticatedUsers} \
WRITE darren@prizecapital.net \
READ http://acs.amazonaws.com/groups/global/AllUsers ]
set x1 [S3::PutAcl -bucket $bucket -resource "ABC" -acl $dict]
S3::Put -bucket $bucket -resource "ABC" -file "S3Tone.txt" -acl keep
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set x3 [dict get $x2 acl]
set x4 [llength $x3]
return [list [string range $x1 0 19] [lsort [dict keys $x3]]]
} -result "<AccessControlPolicy {FULL_CONTROL READ WRITE}"
test S3-90.150 {Put with keep on new object} \
-setup $pgsu -cleanup $pgcu -constraints "Acl" -body {
S3::Put -bucket $bucket -resource "XYZ" -file "S3Tone.txt" -acl keep
set x2 [S3::GetAcl -bucket $bucket -resource "ABC" -result-type dict]
set x3 [dict get $x2 acl]
set x4 [llength $x3]
return [list [string range $x1 0 19] [lsort [dict keys $x3]]]
} -result "<AccessControlPolicy FULL_CONTROL"
test S3-100.10 {Pull} \
-setup S3loadKeys -constraints "Directory ItemIO" -body {
# I actually tested this manually much more extensively,
# but some of the tests are difficult, due to needing to
# set up a bunch of directories with different permissions, etc.
set bucket [S3::SuggestBucket TclTestS3b]
set dir S3Tdir
catch {file delete -force -- $dir}
file mkdir $dir
set res [S3::Pull -bucket $bucket -prefix thing \
-directory $dir -compare always -delete true]
set r1 [dict get $res {} filescopied]
set r2 [dict get $res {} errorskipped]
set r3 [dict get $res {} filesdeleted]
set r4 [file exists [file join $dir 00/6]]
return [list $r1 $r2 $r3 $r4]
} -cleanup {
file delete -force -- $dir
} -result {250 0 0 1}
test S3-100.20 {Push} \
-setup S3loadKeys -constraints "Directory ItemIO" -body {
set bucket [S3::SuggestBucket TclTestS3b]
set dir S3Tdir
catch {file delete -force -- $dir}
file mkdir $dir
set res [S3::Pull -bucket $bucket -prefix thing \
-directory $dir -compare always -delete true]
set r1 [dict get $res {} filescopied]
set r2 [dict get $res {} errorskipped]
set r3 [dict get $res {} filesdeleted]
set r4 [file exists [file join $dir 00/6]]
# Now the rest of the test... :-)
set bucket [S3::SuggestBucket TclTestS3] ; # different bucket
set res [S3::Push -bucket $bucket -prefix hither/yon \
-directory $dir -compare always -delete true]
set r5 [dict get $res {} filescopied]
set r6 [dict get $res {} errorskipped]
set r7 [dict get $res {} filesdeleted]
set res [S3::REST [dict create verb HEAD resource /$bucket/hither/yon/00/6]]
set r8 [dict get $res httpstatus]
return [list $r1 $r2 $r3 $r4 $r5 $r6 $r7 $r8]
} -cleanup {
file delete -force -- $dir
set bucket [S3::SuggestBucket TclTestS3]
set names [S3::GetBucket -bucket $bucket -prefix hither/yon \
-result-type names]
foreach name $names {
S3::Delete -bucket $bucket -resource $name
}
} -result {250 0 0 1 250 0 0 200}
test S3-100.30 {Push with deletes and stuff} \
-setup S3loadKeys -constraints "Directory ItemIO" -body {
set bucket [S3::SuggestBucket TclTestS3b]
set dir S3Tdir
catch {file delete -force -- $dir}
file mkdir $dir
set res [S3::Pull -bucket $bucket -prefix thing \
-directory $dir -compare always -delete true]
set r1 [dict get $res {} filescopied]
set r2 [dict get $res {} errorskipped]
set r3 [dict get $res {} filesdeleted]
set r4 [file exists [file join $dir 00/6]]
set bucket [S3::SuggestBucket TclTestS3] ; # different bucket
set res [S3::Push -bucket $bucket -prefix hither/yon \
-directory $dir -compare always -delete true]
set r5 [dict get $res {} filescopied]
set r6 [dict get $res {} errorskipped]
set r7 [dict get $res {} filesdeleted]
set res [S3::REST [dict create verb HEAD resource /$bucket/hither/yon/00/6]]
set r8 [dict get $res httpstatus]
# Now the rest of the test... :-)
file delete -force [file join $dir 03]
tcltest::makeFile "xxx" [file join $dir "j1.txt"]
tcltest::makeFile "xxx" [file join $dir "j2.txt"]
# Sadly, makefile insists on adding newlines
set x [open [file join $dir j1.txt] w];puts -nonewline $x "123456";close $x
set x [open [file join $dir j2.txt] w];puts -nonewline $x "678901";close $x
set res [S3::Push -bucket $bucket -prefix hither/yon \
-directory $dir -compare missing -delete true]
set r9 [dict get $res {} filescopied]
set r10 [dict get $res {} errorskipped]
set r11 [dict get $res {} filesdeleted]
set r12 [dict get $res {} bytescopied]
set res [S3::REST [dict create verb HEAD resource /$bucket/hither/yon/08/7]]
set r13 [dict get $res httpstatus]
set res [S3::REST [dict create verb HEAD resource /$bucket/hither/yon/j1.txt]]
set r14 [dict get $res httpstatus]
return [list $r1 $r2 $r3 $r4 $r5 $r6 $r7 $r8 $r9 $r10 $r11 $r12 $r13 $r14]
} -cleanup {
file delete -force -- $dir
set bucket [S3::SuggestBucket TclTestS3]
set names [S3::GetBucket -bucket $bucket -prefix hither/yon \
-result-type names]
foreach name $names {
S3::Delete -bucket $bucket -resource $name
}
} -result {250 0 0 1 250 0 0 200 2 0 10 12 200 200}
test S3-100.40 {Pull with deletes and stuff} \
-setup S3loadKeys -constraints "Directory ItemIO" -body {
set bucket [S3::SuggestBucket TclTestS3b]
set dir S3Tdir
catch {file delete -force -- $dir}
file mkdir $dir
set res [S3::Pull -bucket $bucket -prefix thing \
-directory $dir -compare always -delete true]
set r1 [dict get $res {} filescopied]
set r2 [dict get $res {} errorskipped]
set r3 [dict get $res {} filesdeleted]
set r4 [file exists [file join $dir 00/6]]
set bucket [S3::SuggestBucket TclTestS3] ; # different bucket
set res [S3::Push -bucket $bucket -prefix hither/yon \
-directory $dir -compare always -delete true]
set r5 [dict get $res {} filescopied]
set r6 [dict get $res {} errorskipped]
set r7 [dict get $res {} filesdeleted]
set res [S3::REST [dict create verb HEAD resource /$bucket/hither/yon/00/6]]
set r8 [dict get $res httpstatus]
file delete -force [file join $dir 03]
tcltest::makeFile "xxx" [file join $dir "j1.txt"]
tcltest::makeFile "xxx" [file join $dir "j2.txt"]
# Sadly, makefile insists on adding newlines
set x [open [file join $dir j1.txt] w];puts -nonewline $x "123456";close $x
set x [open [file join $dir j2.txt] w];puts -nonewline $x "678901";close $x
set res [S3::Push -bucket $bucket -prefix hither/yon \
-directory $dir -compare missing -delete true]
set r9 [dict get $res {} filescopied]
set r10 [dict get $res {} errorskipped]
set r11 [dict get $res {} filesdeleted]
set r12 [dict get $res {} bytescopied]
set res [S3::REST [dict create verb HEAD resource /$bucket/hither/yon/08/7]]
set r13 [dict get $res httpstatus]
set res [S3::REST [dict create verb HEAD resource /$bucket/hither/yon/j1.txt]]
set r14 [dict get $res httpstatus]
# Now the rest of the test... :-)
file mkdir [file join $dir ToDelete]
set x [open [file join $dir ToDelete T1.txt] w];puts $x "Hello";close $x
set x [open [file join $dir ToDelete T2.txt] w];puts $x "World";close $x
set bucket [S3::SuggestBucket TclTestS3b]
set res [S3::Pull -bucket $bucket -prefix thing \
-directory $dir -compare missing -delete true]
set r15 [dict get $res {} filescopied] ; # The 03 directory
set r16 [dict get $res {} compareskipped] ; # The rest.
set r17 [dict get $res {} filesdeleted] ; # j1, j2, T1, T2, ToDelete
return [list $r1 $r2 $r3 $r4 $r5 $r6 $r7 $r8 $r9 $r10 $r11 $r12 $r13 $r14 $r15 $r16 $r17]
} -cleanup {
file delete -force -- $dir
set bucket [S3::SuggestBucket TclTestS3]
set names [S3::GetBucket -bucket $bucket -prefix hither/yon \
-result-type names]
foreach name $names {
S3::Delete -bucket $bucket -resource $name
}
} -result {250 0 0 1 250 0 0 200 2 0 10 12 200 200 10 240 5}
test S3-100.50 {Push and Pull with -compare never -delete true} \
-setup S3loadKeys -constraints "Directory ItemIO" -body {
# This test creates 00 thru 09 in a bucket and a local dir.
# It then deletes 07 from the bucket and 03 locally.
# It then pushes and pulls with -compare never -delete true.
# It expects 0 files copied and 10/11 deleted.
# It then checks the deletes happened.
set bucket [S3::SuggestBucket TclTestS3b]
set dir S3Tdir
catch {file delete -force -- $dir}
file mkdir $dir
set res [S3::Pull -bucket $bucket -prefix thing \
-directory $dir -compare always -delete true]
set bucket [S3::SuggestBucket TclTestS3] ; # different bucket
set res [S3::Push -bucket $bucket -prefix hither/yon \
-directory $dir -compare always -delete true]
for {set i 0} {$i <= 9} {incr i} {
S3::Delete -bucket $bucket -resource hither/yon/07/$i
}
file delete -force [file join $dir 03]
set res [S3::Push -bucket $bucket -prefix hither/yon \
-directory $dir -compare never -delete true]
set r1 [dict get $res {} filescopied]
set r2 [dict get $res {} errorskipped]
set r3 [dict get $res {} filesdeleted]
set res [S3::REST [dict create verb HEAD resource /$bucket/hither/yon/03/7]]
set r4 [dict get $res httpstatus]
set res [S3::Pull -bucket $bucket -prefix hither/yon \
-directory $dir -compare never -delete true]
set r5 [dict get $res {} filescopied]
set r6 [dict get $res {} errorskipped]
set r7 [dict get $res {} filesdeleted]
set r8 [file exists [file join $dir 07 4]]
set r9 [file exists [file join $dir 07]]
return [list $r1 $r2 $r3 $r4 $r5 $r6 $r7 $r8 $r9]
} -cleanup {
file delete -force -- $dir
set bucket [S3::SuggestBucket TclTestS3]
set names [S3::GetBucket -bucket $bucket -prefix hither/yon \
-result-type names]
foreach name $names {
S3::Delete -bucket $bucket -resource $name
}
} -result {0 0 10 404 0 0 11 0 0}
test S3-100.60 {Toss} \
-setup S3loadKeys -constraints "Directory ItemIO" -body {
set bucket [S3::SuggestBucket TclTestS3b]
set dir S3Tdir
catch {file delete -force -- $dir}
file mkdir $dir
set res [S3::Pull -bucket $bucket -prefix thing \
-directory $dir -compare missing -delete true]
set bucket [S3::SuggestBucket TclTestS3] ; # different bucket
set res [S3::Push -bucket $bucket -prefix hither/yon \
-directory $dir -compare missing -delete true]
set res [S3::Toss -bucket $bucket -prefix /hither]
set r1 [dict get $res {} filesdeleted]
set r2 [dict get $res {} filesnotdeleted]
return [list $r1 $r2]
} -cleanup {
file delete -force -- $dir
set bucket [S3::SuggestBucket TclTestS3]
set names [S3::GetBucket -bucket $bucket -prefix hither/yon \
-result-type names]
foreach name $names {
S3::Delete -bucket $bucket -resource $name
}
} -result {250 0}
# set res [S3::REST {resource /darren/xyzzyplover verb HEAD}]
# puts $res\n\n\n ; after 3000
# set res [S3::REST [list resource /$bucket/fred verb HEAD]]
# puts $res\n\n\n ; after 3000
# set res [dict get $res outheaders]
# set remote_length [dict get $res content-length]
# set remote_etag [string trim [dict get $res etag] \"]
# set remote_date [clock scan [dict get $res last-modified]]
# puts "remote_length=$remote_length"
# puts "remote_etag=$remote_etag"
# puts "remote_date=$remote_date"
# puts "\n\n"
# set body "ABC\u2211S\u5927D"
# set res [S3::REST [list resource /darren/plover verb PUT inbody $body]]
# set res [S3::REST [list resource /darren/plover verb HEAD]]
# puts $res\n\n\n ; after 3000
CleanUpBuckets [tcltest::testConstraint BucketDeletion]
#----------------------------------------------------------------------
testsuiteCleanup
puts "(If anything failed, check all test buckets got cleaned up!)"
puts "Done!" ; after 5000