;; @module amazon
;; @description Functions for the Amazon-AWS EC2, S3 REST API
;; @version 0.01 - initial development release
;; @version 0.02 - added EC2 API
;; @version 0.03 - clean-up documentation and amazon:url-encode
;; @author Lutz Mueller 2007, Martin Quiroga 2007
;;
;; <h2>Requirements</h2>
;; As a minimum newLISP version 9.2.8 is required for this module.
;; <br><br>
;; The module depends on crypto.lsp, which implements HMAC
;; RFC-2104 authentication and itself depends on the C library 'libcrypto'.
;; <br><br>
;; For a descripion of the Amazon Web Services (AWS) REST APIs implemented
;; see: @link http://developer.amazonwebservices.com/ http://developer.amazonwebservices.com/
;;
;; <h2>Usage</h2>
;; Call the 'amazon:set-AWS-credentials' function once after loading this module, then use
;; any of the other functions.
;;
;; Almost all functions allow for an optional timeout parameter in milliseconds. When no
;; timeout is given all functions assume 30 seconds timeout.
;;
;; The functions return either a header or a SXML list on success, or 'nil' on failure.
;; On failure the variable 'amazon:error' contains the text of the last error occured.
;;
(load (append (env "NEWLISPDIR") "/modules/crypto.lsp"))
(context 'amazon)
(define AWS-account-no)
(define AWS-access-key)
(define AWS-secret-key)
(define result) ; the last return from a REST call
(define AWS-ec2-version "2007-08-29")
(define AWS-ec2-url "https://ec2.amazonaws.com/")
;; @syntax (amazon:set-AWS-credentials <acount> <access-key> <secret-key>)
;; @param <account> The acount number to set.
;; @param <access-key> The AWS access-key-id to set.
;; @param <secret-key> The AWS secret access-key-id to set.
;; @return Returns 'true'
;;
;; The EC2 account number AWS-access-key and AWS secret-key credentials should be called
;; first, before calling any other function in the Amazon interface.
;;
;; @example
;; (amazon:set-AWS-credentials
;; "123456789012" ; EC2 account number (not used by S3)
;; "01234ABCDE56789GHIK" ; access key
;; "01ab23cd45EF56789+WXYZ987+abcdeLKJH789zz" ; secret access key
;; )
;;
(define (amazon:set-AWS-credentials account access-key secret-key)
(if (!= 12 (length account)) (throw-error "wrong format in Amazon account number"))
(if (!= 20 (length access-key)) (throw-error "wrong format in Amazon access key number"))
(if (!= 40 (length secret-key)) (throw-error "wrong format in Amazon secret key number"))
(set 'AWS-account-no account)
(set 'AWS-access-key access-key)
(set 'AWS-secret-key secret-key)
true
)
;; @syntax (amazon:create-bucket <str-bucket-name> [<int-timeout>])
;; @param <str-bucket-name> The name of the bucket i.e.: 'my-bucket'
;; @param <int-timeout> The number of milliseconds to wait.
;; @return Returns header information or 'nil' on failure.
;;
;; Creates an Amazon S3 bucket.
;;
;; @example
;; (amazon:create-bucket "my-bucket")
;; (amazon:create-bucket "my-bucket" 20000)
;; The first statement reates 'my-bucket' with a default timeout of 30 seconds.
;; On the second statement carries 20 second timeout limit.
(define (amazon:create-bucket bucket-name (timeout 30000), sign-str date-stamp)
(set 'date-stamp (amazon:date))
(set 'sign-str (append "PUT\n\ntext/html\n" date-stamp "\n" "/" bucket-name))
(set 'result (put-url
;(append "http://s3.amazonaws.com")
(append "http://s3.amazonaws.com" "/" bucket-name)
"" ; empty payload
"list"
timeout
(append ; add date and Authorization info to the string
"Content-type: text/html\r\n"
"Date: " date-stamp "\r\n"
"Authorization: " (authorization sign-str) "\r\n"
)
))
(if (empty? (result 1))
(result 0)
(begin
(set 'amazon:error (result 1))
nil)
)
)
;; @syntax (amazon:delete-bucket <str-bucket-name> [<int-timeout>])
;; @param <str-bucket-name> The name of the bucket i.e.: 'my-bucket'
;; @param <int-timeout> The number of milliseconds to wait.
;; @return Returns amzon header string or 'nil' on failure.
;;
;; Deletes an Amazon S3 bucket. Deleting a non-existing bucket will
;; fail with 'nil'.
;;
;; @example
;; (amazon:delete-bucket "my-bucket")
;; Deletes 'my-bucket'.
(define (amazon:delete-bucket bucket-name (timeout 30000), sign-str date-stamp)
(set 'date-stamp (amazon:date))
(set 'sign-str (append "DELETE\n\n\n" date-stamp "\n" "/" bucket-name))
(set 'result (delete-url
(append "http://s3.amazonaws.com" "/" bucket-name)
"list"
timeout
(append ; add date and Authorizatio info to the string
"Date: " date-stamp "\r\n"
"Authorization: " (authorization sign-str) "\r\n"
)
))
(if (empty? (result 1))
(result 0)
(begin
(set 'amazon:error (result 1))
nil)
)
)
;; @syntax (amazon:list-all-buckets [<int-timeout>])
;; @param <int-timeout> The number of milliseconds to wait.
;; @return Returns Amazon REST S3 SXML results or 'nil' on failure.
;;
;; Lists all the S3 buckets for the account, for which credentials
;; were given.
;;
;; @example
;; (amazon:list-all-buckets)
;; Lists all buckets.
(define (amazon:list-all-buckets (timeout 30000) , date-stamp str-sign)
(set 'date-stamp (amazon:date))
(set 'str-sign (append "GET\n\n\n" date-stamp "\n" "/" ))
(set 'result (get-url "http://s3.amazonaws.com"
timeout
(append ; add date and Authorization info to the string
"Date: " date-stamp "\r\n"
"Authorization: " (authorization str-sign) "\r\n"
)
))
(if (not (starts-with result "ERR:"))
(begin
(xml-type-tags nil nil nil nil)
(xml-parse result 31))
(begin
(set 'amazon:error result)
nil)
)
)
;; @syntax (amazon:list-bucket <str-bucket-name> [<str-query> [<int-timeout>]])
;; @param <str-bucket-name> The name of the bucket, i.e. 'my-bucket'
;; @param <str-query> The optional query string which by default is assumed to be the empty string.
;; @param <int-timeout> The number of milliseconds to wait.
;; @return Returns Amazon REST S3 SXML results or 'nil' on failure.
;;
;; Lists the contents of a bucket. Optionally a query string can be given
;; to list only a subset of buckets. The query string must be URL encoded
;; and has the usual form of key-value pairs separated by a '&' sign,
;; i.e. 'prefix=photos&marker=puppies' etc.
;;
;; @example
;; (amazon:list-bucket "my-bucket")
;;
;; (amazon:list-bucket "my-bucket" "prefix=photos" 10000)
;; In the first statement All objects in 'my-bucket' are listed (the query string is empty).
;; The second statement lists all objects in 'photos' and allows a timeout of 10 seconds.
(define (amazon:list-bucket bucket-name (query "") (timeout 30000) , date-stamp str-sign url)
(set 'date-stamp (amazon:date))
(set 'str-sign (append "GET\n\n\n" date-stamp "\n" "/" bucket-name "/"))
(set 'url (append "http://" bucket-name ".s3.amazonaws.com"))
(if (!= "" query)
(set 'url (append url "/?" query)))
(set 'result (get-url url
timeout
(append ; add date and Authorization info to the string
"Date: " date-stamp "\r\n"
"Authorization: " (authorization str-sign) "\r\n"
)
))
(if (not (starts-with result "ERR:"))
(begin
(xml-type-tags nil nil nil nil)
(xml-parse result 31))
(begin
(set 'amazon:error result)
nil)
)
)
;; @syntax (amazon:put-bucket-object <str-bucket-name> <str-object-name> <str-content-type> <buff-pay-load> [<int-timeout>])
;; @param <str-bucket-name> The name of the bucket, i.e. 'my-bucket'.
;; @param <str-object-name> The name of the object, i.e. 'foo'.
;; @param <str-content-type> The content-type of the data, i.e. 'text/html'.
;; @param <buff-pay-load> The data of the object in a string buffer.
;; @param <int-timeout> The number of milliseconds to wait.
;;
;; Puts an object into a bucket. An exisiting object will get overwritten.
;; @example
;; (amazon:put-bucket-object "my-bucket" "puppy.jpg" "image/jpeg" (read-file "puppy.jpg") )
;;
;; Note that <str-object-name> can contains sub directory like prefixes separated by a forward slash:
;; @example
;; (amazon:put-bucket-object "my-bucket" "category/TheThing" "text/html" "The content" )
;;
;; The statement reads a file 'puppy.jpg' and uploads it to 'my-bucket'. In the second
;; example a sub directory 'category' will automatically be created.
(define (amazon:put-bucket-object bucket-name object-name content-type pay-load (timeout 30000) ,
date-stamp str-sign)
(set 'date-stamp (amazon:date))
(set 'str-sign (append "PUT\n\n" content-type "\n" date-stamp "\n" "/" bucket-name "/" object-name))
(set 'result (put-url (append "http://" bucket-name ".s3.amazonaws.com/" object-name)
pay-load
"list"
timeout
(append ; add date and Authorization info to the string
"Content-type: " content-type "\r\n"
"Date: " date-stamp "\r\n"
"Authorization: " (authorization str-sign) "\r\n"
)
))
(if (empty? (result 1))
(result 0)
(begin
(set 'amazon:error (result 1))
nil)
)
)
;; @syntax (amazon:get-bucket-object <str-bucket-name> <str-object-name> [<int-timeout>])
;; @param <str-bucket-name> The name of the bucket, i.e. 'my-bucket'.
;; @param <str-object-name> The name of the object, i.e. 'foo'.
;; @param <int-timeout> The number of milliseconds to wait.
;;
;; Gets an object from a bucket.
;;
;; @example
;; (amazon:get-bucket-object "my-bucket" "puppy.jpg")
;; Downloads 'puppy.jpg'.
;; Note that <str-object-name> can contain sub directory like prefixes, separated by a forward slash:
;; @example
;; (amazon:get-bucket-object "my-bucket" "category/TheThing") => "The content"
;;
(define (amazon:get-bucket-object bucket-name object-name (timeout 30000) , date-stamp str-sign)
(set 'date-stamp (amazon:date))
(set 'str-sign (append "GET\n\n\n" date-stamp "\n" "/" bucket-name "/" object-name))
(set 'result (get-url (append "http://" bucket-name ".s3.amazonaws.com/" object-name)
timeout
(append ; add date and Authorization info to the string
"Date: " date-stamp "\r\n"
"Authorization: " (authorization str-sign) "\r\n"
)
))
(if (not (starts-with result "ERR:"))
result
(begin
(set 'amazon:error result)
nil)
)
)
;; @syntax (amazon:delete-bucket-object <str-bucket-name> <str-object-name> [<int-timeout>])
;; @param <str-bucket-name> The name of the bucket, i.e. 'my-bucket'.
;; @param <str-object-name> The name of the object to be deleted, i.e. 'foo'.
;; @param <int-timeout> The number of milliseconds to wait.
;;
;; Deletes an object from a bucket. Note that deleting with a non-exisiting <str-object-name>
;; will not result in error, but a wrong <str-bucket-name> will result in error.
;;
;; @example
;; (amazon:delete-bucket-object "my-bucket" "puppy.jpg")
;; Deletes the file "puppy.jpg".
;; Note that <str-object-name> can contain sub directory like prefixes separated by a forward slash:
;; @example
;; (amazon:delete-bucket-object "my-bucket" "category/TheThing")
;;
(define (amazon:delete-bucket-object bucket-name object-name (timeout 30000) , date-stamp str-sign)
(set 'date-stamp (amazon:date))
(set 'str-sign (append "DELETE\n\n\n" date-stamp "\n" "/" bucket-name "/" object-name))
(set 'result (delete-url (append "http://s3.amazonaws.com/" bucket-name "/" object-name)
"list"
timeout
(append ; add date and Authorization info to the string
"Date: " date-stamp "\r\n"
"Authorization: " (authorization str-sign) "\r\n"
)
))
(if (empty? (result 1))
(result 0)
(begin
(set 'amazon:error (result 1))
nil)
)
)
;; @syntax (amazon:ec2-query <list-query-parameters>)
;; @param <list-query-parameters> Is an assoc-list of string key and value pairs corresponding to EC2 Actions and their respective parameters.
;; @return Returns an SXML list corresponding to the return XML of the query, or nil on failure.
;;
;; The full Amazon EC2 API documentation can be found here:
;; @link http://docs.amazonwebservices.com/AWSEC2/2007-08-29/DeveloperGuide/ EC2_Developer_Guide
;;
;; This API implementation is based on the EC2 Query API described in the documentation. For
;; any EC2 Operation the only required element of the query parameter list is the '"Action"'
;; element and can take the form of:
;;
;; For Image Actions:<br>
;; '"RegisterImage" "DescribeImages" "DeregisterImage"'
;;
;; For Instance Actions:<br>
;; '"RunInstances" "DescribeInstances" "TerminateInstances" "ConfirmProductInstance"'
;;
;; For Key Pair Actions:<br>
;; '"CreateKeyPair" "DescribeKeyPairs" "DeleteKeyPair"'
;;
;; For Image Attribute Actions:<br>
;; '"ModifyImageAttribute" "DescribeImageAttribute" "ResetImageAttribute"'
;;
;; For Security Group Actions:<br>
;; '"CreateSecurityGroup" "DescribeSecurityGroups" "DeleteSecurityGroup"'<br>
;; '"AuthorizeSecurityGroupIngress" "RevokeSecurityGroupIngress"'
;;
;; The full list of Actions and their corresponding parameters can be found here:
;; @link http://docs.amazonwebservices.com/AWSEC2/2007-08-29/DeveloperGuide/AESDG-query-by-function.html Operations_by_Function
;;
;; @example
;; (amazon:ec2-query (list
;; (list "Action" "DescribeInstances")
;; (list "InstanceId" (list "i-564fa43f" "i-e320c98a"))))
;; If a given Action handles multiple paramters of the same type, these can be provided as a list of values
(define (amazon:ec2-query param_list)
(set 'q_str "?")
(set 'cred_str "")
(unless (lookup "Version" param_list)
(push (list "Version" AWS-ec2-version) param_list -1)
)
(unless (lookup "Timestamp" param_list)
(push (list "Timestamp" (amazon:ec2-date)) param_list -1)
)
(unless (lookup "SignatureVersion" param_list)
(push (list "SignatureVersion" 1) param_list -1)
)
(unless (lookup "AWSAccessKeyId" param_list)
(unless AWS-access-key
(throw-error "You must first set you AWS credentials using the set-AWS-credentials function.")
(push (list "AWSAccessKeyId" AWS-access-key) param_list -1)
)
)
(unless (lookup "Action" param_list)
(throw-error "You must provide an Action.")
)
(dolist (p (sort param_list ;; sort the lower-cased list keys to get proper AWS ordering
(fn (a b)
(if (= (lower-case (first a)) (first (sort (list (lower-case (first a)) (lower-case (first b))))))
a
)
)))
(if (list? (set 'p_list (last p)))
(dotimes (i (length p_list))
(push (string (url-encode (first p)) "." i "=" (url-encode (string (p_list i))) "&") q_str -1)
(push (string (first p) "." i (p_list i)) cred_str -1)
)
(begin
(push (string (url-encode (first p)) "=" (url-encode (string (last p))) "&") q_str -1)
(push (string (first p) (last p)) cred_str -1)
)
)
)
(if (set 'get-return (get-url (string AWS-ec2-url (chop q_str) "&Signature=" (amazon:url-encode (amazon:authorization cred_str 1)))))
(begin
(xml-type-tags nil nil nil nil)
(xml-parse get-return (+ 1 2 4 8 16))
)
)
)
;; @syntax (amazon:authorization <str-sign> [<int-option>])
;; @param <str-sign> The string to sign.
;; @param <int-option> Integer value to toggle between the S3 and EC2 styles of signatures.
;;
;; The <int-option> parameter, when set to <tt>0</tt> is for the S3 style of signature and
;; <tt>1</tt> is for the EC2 style.If no value is provided, the default is S3 style.
;;
;; In the case of the S3 style, 'amazon:authorization' returns an authorization string of the form:
;; 'AWS access-key:signature' where access-key is a 20 byte long key given
;; by Amazon when signing up for Amazon Web Services (AWS) and signature is
;; a 28 byte long BASE64 encoded string resulting from an 'crypto:hmac' signing of
;; the <str-sign> with the <secret-access-key>.
;;
;; In the case of the EC2 style, 'amazon:authorization' simply returns
;; a 28 byte long BASE64 encoded string resulting from an 'crypto:hmac' signing of
;; the <str-sign> with the <secret-access-key>.
;;
;; This function is used by other functions in this API.
(define (amazon:authorization str-sign int-option)
(unless (or AWS-secret-key AWS-access-key)
(throw-error "You must first set you AWS credentials using the set-AWS-credentials function.")
(unless (or int-option (= int-option 0))
(append "AWS " AWS-access-key ":"
(base64-enc (crypto:hmac crypto:sha1 str-sign AWS-secret-key)))
(base64-enc (crypto:hmac crypto:sha1 str-sign AWS-secret-key))
)
)
)
;; @syntax (amazon:date [<offset>])
;; @param <offset> The offset in minutes from the local time.
;;
;; Returns the current time string in Internet format, i.e: 'Fri, 23 Nov 2007 12:06:39 +0000'
;; for signing HTTP requests in the Amazon AWS interface and usage in HTTP headers.
;; The <offset> parameter is optional, when no offset is given the date string returned
;; is based on GMT and finishes with the letters 'GMT', else the string is based on
;; the local time and finishes with the '+nnnn' or -nnnn' offset number given in <offset>.
;;
;; @example
;; (amazon:date) => "Mon, 26 Nov 2007 20:08:13 GMT"
;; (amazon:date 300) => "Mon, 26 Nov 2007 15:08:17 +0300"
;; This functions is also used by other functions in this API.
(define (amazon:date offset)
(if (not offset)
(MAIN:date (date-value) ((now) -2) "%a, %d %b %Y %H:%M:%S GMT")
(let (dfmt (MAIN:date (date-value) 0 "%a, %d %b %Y %H:%M:%S"))
(append dfmt (format " %+05d" offset)))
)
)
;; @syntax (amazon:ec2-date [<int-unix-time]>)
;; @param <int-unix-time> The time in seconds elapsed since midnight UTC of January 1, 1970.
;;
;; Returns a time string of the format '2007-12-04T14:04:24-0800' as specified in the ISO 8601
;; standard for signing EC2 Query API requests. The <int-unix-time> parameter is optional, when this
;; is not provided the current time is used as a default value.
;;
;; @example
;; (amazon:ec2-date) => "2007-12-04T16:15:00-0800"
;; (amazon:ec2-date (+ (date-value) 300)) => "2007-12-04T16:20:00-0800"
;; This functions is also used by other functions in this API.
(define (amazon:ec2-date (epoch (date-value)))
(MAIN:date epoch 0 "%Y-%m-%dT%H:%M:%S%z")
)
;; @syntax (amazon:url-encode <str>)
;; @param <str> The string to URL encode.
;;
;; @return Returns a url-encoded (e.g. percent-encoded) string of the input string.
;;
;; @example
;; (amazon:url-encode "2007-12-04T14:06:31-0800") => "2007-12-04T14%3a06%3a31-0800"
; note that space to plus translation is redundant on encode, because
; spaces are % escaped too
(define (amazon:url-encode str)
(replace {([^\w\-._])} str (format "%%%x" (char $1)) 0)
)
;; @syntax (amazon:url-decode <str>)
;; @param <str> The URL-encoded string to decode.
;;
;; Returns a decoded string of the url-encoded (e.g. percent-encoded) input string.
;;
;; @example
;; (amazon:url-decode "2007-12-04T14%3a06%3a31-0800") => "2007-12-04T14:06:31-0800"
(define (amazon:url-decode str)
(replace "+" str " ") ; translate for compatibility
(replace "%([0-9A-F][0-9A-F])" str (char (int (append "0x" $1))) 1)
)
; eof ;
syntax highlighting with newLISP and newLISPdoc