From 0be77304e4a29a8b6eef9df8fc24857b5268256e Mon Sep 17 00:00:00 2001 From: Zach Beane Date: Tue, 26 Apr 2016 20:16:35 -0400 Subject: [PATCH] Pull together all aspects of a simple test request for new auth style. --- aws4-auth.lisp | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ crypto.lisp | 51 +++++++++++++++++++++++--- request.lisp | 17 ++++++--- utils.lisp | 3 ++ zs3.asd | 1 + 5 files changed, 175 insertions(+), 9 deletions(-) create mode 100644 aws4-auth.lisp diff --git a/aws4-auth.lisp b/aws4-auth.lisp new file mode 100644 index 0000000..732108e --- /dev/null +++ b/aws4-auth.lisp @@ -0,0 +1,112 @@ +;;;; aws4-auth.lisp + +(in-package #:zs3) + +;;; http://docs.aws.amazon.com/general/latest/gr/rande.html#s3_region +;;; can be used to map endpoint to region, maybe? + +(defun headers-for-signing (request) + (append (all-amazon-headers request) + (extra-http-headers request) + (parameters-alist "host" (host request) + "content-type" (content-type request)))) + +(defun canonical-headers (headers) + (flet ((trim (string) + (string-trim " " string))) + (let ((encoded + (loop for (name . value) in headers + collect (cons (string-downcase name) + (trim value))))) + (sort encoded #'string< :key 'car)))) + +(defun signed-headers (request) + (mapcar 'first (canonical-headers (headers-for-signing request)))) + +(defun parameters-for-signing (request) + (cond ((sub-resource request) + (list (cons (sub-resource request) ""))) + (t + (parameters request)))) + +(defun canonical-parameters (parameters) + (let ((encoded + (loop for (name . value) in parameters + collect (cons + (url-encode name) + (url-encode value))))) + (sort encoded #'string< :key 'car))) + +(defun canonical-parameters-string (request) + (format nil "~{~A=~A~^&~}" + (alist-plist (canonical-parameters + (parameters-for-signing request))))) + +(defun hashed-payload (request) + *empty-string-sha256*) + +(defun path-to-sign (request) + "Everything in the PATH of the request, up to the first ?" + (let ((path (request-path request))) + (subseq path 0 (position #\? path)))) + +(defun canonicalized-request-strings (request) + "Return a list of lines canonicalizing the request according to +http://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-header-based-auth.html." + (let* ((headers (headers-for-signing request)) + (canonical-headers (canonical-headers headers))) + (alexandria:flatten + (list (http-method request) + (path-to-sign request) + (canonical-parameters-string request) + (loop for (name . value) in canonical-headers + collect (format nil "~A:~A" name value)) + "" + (format nil "~{~A~^;~}" (mapcar 'first canonical-headers)) + (hashed-payload request))))) + +(defun string-to-sign-lines (request) + "Return a list of strings to sign to construc" + (list "AWS4-HMAC-SHA256" + (iso8601-basic-timestamp-string) + (with-output-to-string (s) + (format s "~A/~A/s3/aws4_request" + (iso8601-basic-date-string) + (region request))) + (strings-sha256/hex (canonicalized-request-strings request)))) + +(defun make-signing-key (credentials &key region service) + (let* ((k1 (format nil "AWS4~A" (secret-key credentials))) + (date-key (hmac-sha256 k1 (iso8601-basic-date-string))) + (region-key (hmac-sha256 date-key region)) + (service-key (hmac-sha256 region-key service))) + (hmac-sha256 service-key "aws4_request"))) + +(defclass aws4-auth-request (request) + ((region + :accessor region + :initarg :region)) + (:default-initargs + :region "us-east-1")) + +(defmethod authorization-header-value ((request aws4-auth-request)) + (let ((key (make-signing-key *credentials* + :region (region request) + :service "s3"))) + (with-output-to-string (s) + (write-string "AWS4-HMAC-SHA256" s) + (format s " Credential=~A/~A/~A/s3/aws4_request" + (access-key *credentials*) + (iso8601-basic-date-string) + (region request)) + (format s ",SignedHeaders=~{~A~^;~}" (signed-headers request)) + (format s ",Signature=~A" + (strings-hmac-sha256/hex key (string-to-sign-lines request)))))) + +(defun test-aws4 (&key (region "us-east-1")) + (let ((request (make-instance 'aws4-auth-request + :amz-headers + (parameters-alist :content-sha256 *empty-string-sha256* + :date (iso8601-basic-timestamp-string)) + :region region))) + request)) diff --git a/crypto.lisp b/crypto.lisp index 8030aca..ef217d9 100644 --- a/crypto.lisp +++ b/crypto.lisp @@ -33,6 +33,9 @@ (ironclad:byte-array-to-hex-string (ironclad:digest-sequence :sha256 (make-array 0 :element-type 'octet)))) +(defparameter *newline-vector* + (make-array 1 :element-type 'octet :initial-element 10)) + (defclass digester () ((hmac :initarg :hmac @@ -46,13 +49,13 @@ :accessor signed-stream)) (:default-initargs :signed-stream (make-string-output-stream) - :newline (make-array 1 :element-type '(unsigned-byte 8) - :initial-element 10))) + :newline *newline-vector*)) (defun make-digester (key &key (digest-algorithm :sha1)) - (let ((hmac (ironclad:make-hmac (string-octets key) digest-algorithm))) - (make-instance 'digester - :hmac hmac))) + (when (stringp key) + (setf key (string-octets key))) + (make-instance 'digester + :hmac (ironclad:make-hmac key digest-algorithm))) (defgeneric add-string (string digester) (:method (string digester) @@ -69,11 +72,17 @@ (add-string string digester) (add-newline digester))) +(defgeneric digest (digester) + (:method (digester) + (ironclad:hmac-digest (hmac digester)))) + (defgeneric digest64 (digester) (:method (digester) (base64:usb8-array-to-base64-string (ironclad:hmac-digest (hmac digester))))) + + (defun file-md5 (file) (ironclad:digest-file :md5 file)) @@ -95,6 +104,26 @@ (defun vector-sha256/hex (vector) (ironclad:byte-array-to-hex-string (vector-sha256 vector))) +(defun strings-sha256/hex (strings) + (when strings + (let ((digest (ironclad:make-digest :sha256))) + (ironclad:update-digest digest (string-octets (first strings))) + (dolist (string (rest strings)) + (ironclad:update-digest digest *newline-vector*) + (ironclad:update-digest digest (string-octets string))) + (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest))))) + +(defun strings-hmac-sha256/hex (key strings) + (when strings + (when (stringp key) + (setf key (string-octets key))) + (let ((digest (ironclad:make-hmac key :sha256))) + (ironclad:update-hmac digest (string-octets (first strings))) + (dolist (string (rest strings)) + (ironclad:update-hmac digest *newline-vector*) + (ironclad:update-hmac digest (string-octets string))) + (ironclad:byte-array-to-hex-string (ironclad:hmac-digest digest))))) + (defun vector-md5/b64 (vector) (base64:usb8-array-to-base64-string (ironclad:digest-sequence :md5 vector))) @@ -106,3 +135,15 @@ (let ((digester (make-digester key))) (add-string string digester) (digest64 digester))) + +(defun hmac-sha256 (key strings) + (let ((digester (make-digester key :digest-algorithm :sha256))) + (if (consp strings) + (dolist (s strings) + (add-string s digester)) + (add-string strings digester)) + (digest digester))) + + + + diff --git a/request.lisp b/request.lisp index c7c84e3..75f7ac4 100644 --- a/request.lisp +++ b/request.lisp @@ -155,6 +155,11 @@ (pathname (file-size content)) (vector (length content))))))) +(defgeneric host (request) + (:method ((request request)) + (or (redirected-endpoint (endpoint request) (bucket request)) + (endpoint request)))) + (defgeneric http-method (request) (:method (request) (string-upcase (method request)))) @@ -240,15 +245,19 @@ (setf (signed-string request) (get-output-stream-string (signed-stream digester))) (digest64 digester))))) - + +(defgeneric authorization-header-value (request) + (:method (request) + (format nil "AWS ~A:~A" + (access-key request) + (signature request)))) + (defgeneric drakma-headers (request) (:method (request) (let ((base (list* (cons "Date" (http-date-string (date request))) (cons "Authorization" - (format nil "AWS ~A:~A" - (access-key request) - (signature request))) + (authorization-header-value request)) (all-amazon-headers request)))) (when (content-md5 request) (push (cons "Content-MD5" (content-md5 request)) base)) diff --git a/utils.lisp b/utils.lisp index a7b930f..21839b3 100644 --- a/utils.lisp +++ b/utils.lisp @@ -328,3 +328,6 @@ supplied or is NIL, create a fresh buffer of length N and return it." (with-open-file (stream file :element-type 'octet) (stream-subset-vector stream start end))) +(defun alist-plist (alist) + (loop for (key . value) in alist + collect key collect value)) diff --git a/zs3.asd b/zs3.asd index d7d7e18..6ac7d66 100644 --- a/zs3.asd +++ b/zs3.asd @@ -45,6 +45,7 @@ (:file "xml-binding") (:file "xml-output") (:file "credentials") + (:file "aws4-auth") (:file "post") (:file "redirects") (:file "request") -- 2.11.4.GIT