From bee5ae110f49b9b36b83b84a1eb338a6d8332ee0 Mon Sep 17 00:00:00 2001 From: Jan Rochel Date: Thu, 4 Mar 2021 11:13:58 +0100 Subject: [PATCH] support for authentification using temporary session tokens according to https://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html --- async/runtime.ml | 3 +++ async/runtime.mli | 1 + lib/aws.ml | 24 +++++++++++++++--------- lib/aws.mli | 2 ++ libraries/s3/lib_test/test_async.ml | 14 ++++++++++++++ libraries/s3/lib_test/test_lwt.ml | 14 ++++++++++++++ lwt/runtime.ml | 3 +++ lwt/runtime.mli | 1 + 8 files changed, 53 insertions(+), 9 deletions(-) create mode 100644 libraries/s3/lib_test/test_async.ml create mode 100644 libraries/s3/lib_test/test_lwt.ml diff --git a/async/runtime.ml b/async/runtime.ml index ab3e32f7e..9c2ba176c 100644 --- a/async/runtime.ml +++ b/async/runtime.ml @@ -44,6 +44,7 @@ let run_request ~region ~access_key ~secret_key + ?session_token (module M : Aws.Call with type input = input and type output = output @@ -55,6 +56,7 @@ let run_request Aws.Signing.sign_request ~access_key ~secret_key + ?session_token ~service:M.service ~region (M.to_http M.service region inp) @@ -62,6 +64,7 @@ let run_request Aws.Signing.sign_v2_request ~access_key ~secret_key + ?session_token ~service:M.service ~region (M.to_http M.service region inp) diff --git a/async/runtime.mli b/async/runtime.mli index 579d4c9dc..744137945 100644 --- a/async/runtime.mli +++ b/async/runtime.mli @@ -35,6 +35,7 @@ val run_request : region:string -> access_key:string -> secret_key:string + -> ?session_token:string -> ('input, 'output, 'error) Aws.call -> 'input -> [ `Ok of 'output | `Error of 'error Aws.Error.t ] Async.Deferred.t diff --git a/lib/aws.ml b/lib/aws.ml index ed467d70d..00a9e52a7 100644 --- a/lib/aws.ml +++ b/lib/aws.ml @@ -516,7 +516,7 @@ module Signing = struct (* NOTE(dbp 2015-01-13): This is a direct translation of reference implementation at: * http://docs.aws.amazon.com/general/latest/gr/sigv4-signed-request-examples.html *) - let sign_request ~access_key ~secret_key ~service ~region (meth, uri, headers) = + let sign_request ~access_key ~secret_key ?session_token ~service ~region (meth, uri, headers) = let host = Util.of_option_exn (Endpoints.endpoint_of service region) in let params = encode_query (Uri.query uri) in let sign key msg = Hash.sha256 ~key msg in @@ -534,6 +534,10 @@ module Signing = struct ; "x-amz-content-sha256", payload_hash ; "x-amz-date", amzdate ] + @ + match session_token with + | None -> [] + | Some token -> ["x-amz-security-token", token] in let signed_headers = String.concat ";" (List.map fst canonical_headers) in let canonical_headers_str = @@ -586,23 +590,25 @@ module Signing = struct ] in let headers = - ("x-amz-date", amzdate) - :: ("x-amz-content-sha256", payload_hash) - :: ("Authorization", authorization_header) - :: headers + canonical_headers + @ ["Authorization", authorization_header] + @ headers in meth, uri, headers - let sign_v2_request ~access_key ~secret_key ~service ~region (meth, uri, headers) = + let sign_v2_request ~access_key ~secret_key ?session_token ~service ~region (meth, uri, headers) = let host = Util.of_option_exn (Endpoints.endpoint_of service region) in let amzdate = Time.date_time_iso8601 (Time.now_utc ()) in - let query = Uri.add_query_params' uri - [ "Timestamp", amzdate + let query = + let params = [ "Timestamp", amzdate ; "AWSAccessKeyId", access_key ; "SignatureMethod", "HmacSHA256" ; "SignatureVersion", "2" - ] in + ] + @ match session_token with None -> [] | Some t -> ["SecurityToken", t] + in Uri.add_query_params' uri params + in let params = encode_query (Uri.query query) in let canonical_uri = "/" in diff --git a/lib/aws.mli b/lib/aws.mli index 0de14b5b5..8dc4dce53 100644 --- a/lib/aws.mli +++ b/lib/aws.mli @@ -301,6 +301,7 @@ module Signing : sig val sign_request : access_key:string -> secret_key:string + -> ?session_token:string -> service:string -> region:string -> Request.t @@ -322,6 +323,7 @@ module Signing : sig val sign_v2_request : access_key:string -> secret_key:string + -> ?session_token:string -> service:string -> region:string -> Request.t diff --git a/libraries/s3/lib_test/test_async.ml b/libraries/s3/lib_test/test_async.ml new file mode 100644 index 000000000..3f6a73a63 --- /dev/null +++ b/libraries/s3/lib_test/test_async.ml @@ -0,0 +1,14 @@ +open Aws_s3_test + +module T = TestSuite (struct + type 'a m = 'a Async.Deferred.t + + let access_key = Unix.getenv "AWS_ACCESS_KEY" + + let secret_key = Unix.getenv "AWS_SECRET_KEY" + + let run_request ~region call input = + Aws_async.Runtime.run_request ~region ~access_key ~secret_key call input + + let un_m v = Async.Thread_safe.block_on_async_exn (fun () -> v) +end) diff --git a/libraries/s3/lib_test/test_lwt.ml b/libraries/s3/lib_test/test_lwt.ml new file mode 100644 index 000000000..6b388cb59 --- /dev/null +++ b/libraries/s3/lib_test/test_lwt.ml @@ -0,0 +1,14 @@ +open Aws_s3_test + +module T = TestSuite (struct + type 'a m = 'a Lwt.t + + let access_key = Unix.getenv "AWS_ACCESS_KEY" + + let secret_key = Unix.getenv "AWS_SECRET_KEY" + + let run_request ~region call input = + Aws_lwt.Runtime.run_request ~region ~access_key ~secret_key call input + + let un_m = Lwt_main.run +end) diff --git a/lwt/runtime.ml b/lwt/runtime.ml index 8d572c4e0..aa32cfe41 100644 --- a/lwt/runtime.ml +++ b/lwt/runtime.ml @@ -38,6 +38,7 @@ let run_request ~region ~access_key ~secret_key + ?session_token (module M : Aws.Call with type input = input and type output = output @@ -49,6 +50,7 @@ let run_request Aws.Signing.sign_request ~access_key ~secret_key + ?session_token ~service:M.service ~region (M.to_http M.service region inp) @@ -56,6 +58,7 @@ let run_request Aws.Signing.sign_v2_request ~access_key ~secret_key + ?session_token ~service:M.service ~region (M.to_http M.service region inp) diff --git a/lwt/runtime.mli b/lwt/runtime.mli index e72eb344f..c38d1b6ab 100644 --- a/lwt/runtime.mli +++ b/lwt/runtime.mli @@ -37,6 +37,7 @@ val run_request : region:string -> access_key:string -> secret_key:string + -> ?session_token:string -> ('input, 'output, 'error) Aws.call -> 'input -> [ `Ok of 'output | `Error of 'error Aws.Error.t ] Lwt.t