s3: Fix get-object to allow signing. Add sorted-bucket to sort by time.
parent
a33128a4b3
commit
042bbccd1a
|
@ -1,26 +1,9 @@
|
||||||
! Copyright (C) 2009 Chris Double. All Rights Reserved.
|
! Copyright (C) 2009 Chris Double. All Rights Reserved.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING:
|
USING: accessors assocs base64 calendar calendar.format
|
||||||
accessors
|
calendar.parser checksums.hmac checksums.sha combinators http
|
||||||
assocs
|
http.client kernel make math.order namespaces sequences
|
||||||
base64
|
sequences.extras sorting sorting.slots strings xml xml.traversal ;
|
||||||
calendar
|
|
||||||
calendar.format
|
|
||||||
checksums.hmac
|
|
||||||
checksums.sha
|
|
||||||
combinators
|
|
||||||
http
|
|
||||||
http.client
|
|
||||||
kernel
|
|
||||||
make
|
|
||||||
math.order
|
|
||||||
namespaces
|
|
||||||
sequences
|
|
||||||
sorting
|
|
||||||
strings
|
|
||||||
xml
|
|
||||||
xml.traversal
|
|
||||||
;
|
|
||||||
IN: s3
|
IN: s3
|
||||||
|
|
||||||
SYMBOL: key-id
|
SYMBOL: key-id
|
||||||
|
@ -100,6 +83,9 @@ PRIVATE>
|
||||||
: buckets ( -- seq )
|
: buckets ( -- seq )
|
||||||
f "/" H{ } clone s3-get nip >string string>xml (buckets) ;
|
f "/" H{ } clone s3-get nip >string string>xml (buckets) ;
|
||||||
|
|
||||||
|
: sorted-buckets ( -- seq )
|
||||||
|
buckets { { date>> rfc3339>timestamp <=> } } sort-by ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
: bucket-url ( bucket -- string )
|
: bucket-url ( bucket -- string )
|
||||||
[ "http://" % % ".s3.amazonaws.com/" % ] "" make ;
|
[ "http://" % % ".s3.amazonaws.com/" % ] "" make ;
|
||||||
|
@ -122,10 +108,7 @@ PRIVATE>
|
||||||
nip >string string>xml (keys) ;
|
nip >string string>xml (keys) ;
|
||||||
|
|
||||||
: get-object ( bucket key -- response data )
|
: get-object ( bucket key -- response data )
|
||||||
s3-request new
|
"/" prepend H{ } clone s3-get ;
|
||||||
swap "/" prepend >>path
|
|
||||||
swap >>bucket
|
|
||||||
s3-url http-get ;
|
|
||||||
|
|
||||||
: create-bucket ( bucket -- )
|
: create-bucket ( bucket -- )
|
||||||
"" swap "/" H{ } clone "PUT" <s3-request>
|
"" swap "/" H{ } clone "PUT" <s3-request>
|
||||||
|
@ -151,3 +134,7 @@ PRIVATE>
|
||||||
: delete-object ( bucket key -- )
|
: delete-object ( bucket key -- )
|
||||||
"/" prepend H{ } clone "DELETE" <s3-request>
|
"/" prepend H{ } clone "DELETE" <s3-request>
|
||||||
dup s3-url <delete-request> sign-http-request http-request 2drop ;
|
dup s3-url <delete-request> sign-http-request http-request 2drop ;
|
||||||
|
|
||||||
|
: bucket>alist ( bucket -- alist )
|
||||||
|
dup keys
|
||||||
|
[ name>> get-object nip ] with map-zip ;
|
Loading…
Reference in New Issue