Rebol [
Title: "Amazon S3 Protocol"
Author: "Christopher Ross-Gill"
Date: 20-Mar-2013
File: %s3.r
Version: 0.1.0
License: 'BSD
Purpose: {Basic retrieve and upload protocol for Amazon S3.}
Example: [
do/args http://reb4.me/r3/s3 [args (see settings)]
write s3://<bucket>/file/foo.txt "Foo"
read s3://<bucket>/file/foo.txt
]
History: [
23-Nov-2008 ["Graham Chiu" "Maarten Koopmans" "Gregg Irwin"]
]
Settings: [
AWSAccessKeyId: <AWSAccessKeyId>
AWSSecretAccessKey: <AWSSecretAccessKey>
Secure: false ; optional
]
]
sys/make-scheme bind [
title: "Amazon S3 Protocol"
name: 's3
actor: [
open: funct [port [port!]] [
port/spec/path: any [port/spec/path "/"]
subport: make port! rejoin [
either settings/secure [https://][http://]
any [select port/spec 'user settings/awsaccesskeyid] ":"
any [select port/spec 'pass settings/awssecretaccesskey] "@"
port/spec/host ".s3.amazonaws.com" port/spec/path
]
subport/locals: context [
parent: port
response: none
]
port/locals: context compose [
subport: (subport)
response: none
]
port
]
open?: func [port [port!]][
all [
port/locals
open? port/locals/subport
]
]
read: func [port [port!]][
open port
send "GET" port/locals/subport none
]
write: func [port [port!] content [none! string! binary! block!]][
case/all [
none? content [content: #{}]
not block? content [content: join [body:] content]
block? content [content: make request content]
]
open port
send "PUT" port/locals/subport content
]
delete: func [port [port!]][
open port
send "DELETE" port/locals/subport none
]
query: func [port /local headers][
open port
if headers: send "HEAD" port/locals/subport none [
context [
name: port/spec/ref
size: any [headers/content-length 0]
date: headers/last-modified
type: either dir? port/spec/ref ['dir]['file]
content-type: headers/content-type
]
]
]
close: func [port][
close port/locals/subport
]
]
] context [
settings: make context [
awsaccesskeyid: awssecretaccesskey: ""
secure: false
] any [
system/script/args
bind system/script/header/settings system/contexts/user
]
request: context [body: size: type: md5: access: none]
send: use [timestamp detect-mime sign compose-request response][
timestamp: func [/for date [date!]][
date: any [date now]
date/time: date/time - date/zone
rejoin [
copy/part pick system/locale/days date/weekday 3
", " next form 100 + date/day " "
copy/part pick system/locale/months date/month 3
" " date/year " "
next form 100 + date/time/hour ":"
next form 100 + date/time/minute ":"
next form 100 + to-integer date/time/second " GMT"
]
]
detect-mime: use [types][
types: [
application/octet-stream
text/html %.html %.htm
image/jpeg %.jpg %.jpeg
image/png %.png
image/tiff %.tif %.tiff
application/pdf %.pdf
text/plain %.txt %.r
application/xml %.xml
video/mpeg %.mpg %.mpeg
video/x-m4v %.m4v
]
func [file [file! url! string! none!]][
if file [
file: any [find types suffix? file next types]
first find/reverse file path!
]
]
]
sign: func [verb [string!] spec [object!] request [object!]][
rejoin [
"AWS " spec/user ":" enbase/base checksum/secure/key rejoin [
#{} verb newline
newline ; any [port/locals/md5 ""] newline
any [request/type ""] newline
timestamp newline
either request/access [join "x-amz-acl:" [request/access "^/"]][""]
"/" copy/part spec/host find/last spec/host ".s3.amazonaws.com" spec/path
] spec/pass 64
]
]
compose-request: func [
method [string!] port [port!] content [object! none!]
/local prefix
][
content: any [content make request []]
content/size: all [content/body length? content/body]
content/type: all [content/body form any [content/type detect-mime port/spec/path]]
content/access: all [
content/body switch/default content/access [
read ["public-read"] write ["public-read-write"]
][content/access]
]
port/spec/method: method
port/spec/content: content/body
if parse port/spec/path [skip thru #"/"][
prefix: remove port/spec/path
port/spec/path: copy "/"
]
port/spec/headers: collect [
foreach [header value][
Date: [timestamp]
Content-Type: [content/type]
Content-Length: [content/size]
Authorization: [sign method port/spec content]
x-amz-acl: [content/access]
Pragma: ["no-cache"]
Cache-Control: ["no-cache"]
][
if value: all :value [
keep header
keep form value
]
]
]
if prefix [append port/spec/path join "?prefix=" prefix]
]
send: func [[catch] method [string!] port [port!] content [any-type!]][
compose-request method port content
port/awake: func [event][
switch event/type [
connect [read event/port false]
done [true]
]
]
open port
response: query port
; unless port?
wait [port 1]
; [make error! "No Response from Port"]
port/locals/parent/data: switch/default response/response-parsed [
ok [
switch method [
"GET" [
either dir? response/name [
collect [
parse decode 'markup port/data use [name][
[any [thru <key> copy name string! (keep to file! name)]]
]
]
][port/data]
]
"PUT" [content/body]
"HEAD" [response/headers]
]
]
no-content [port/locals/parent] ; DELETE
][
make error! rejoin collect [
parse decode 'markup port/data use [message][
[
thru <Error> thru <Message> set message string!
(keep [message " (" skip response/response-line 9 ")"])
]
]
]
]
]
]
]