diff --git a/README.md b/README.md index 47717f8..5657512 100644 --- a/README.md +++ b/README.md @@ -43,6 +43,15 @@ Defaults to `grisp_keychain_filesystem`. {tls_verify, verify_peer} ``` +#### `allow_expired_certs` +**Type:** `boolean()` +**Default:** `false` +**Description:** Allow expired or future certificates. + +```erlang +{allow_expired_certs, true} +``` + ### Certificate and Key Paths #### `client_certs` @@ -174,7 +183,8 @@ DerCert = grisp_keychain:read_cert(primary, der). {client_certs, {priv, my_app, "certs/client.pem"}}, {client_key, {priv, my_app, "keys/client-key.pem"}}, {tls_client_trusted_certs, {priv, my_app, "certs/ca"}}, - {tls_server_trusted_certs, {priv, my_app, "certs/servers"}} + {tls_server_trusted_certs, {priv, my_app, "certs/servers"}}, + {allow_expired_certs, false} ]} ``` diff --git a/src/grisp_keychain.app.src b/src/grisp_keychain.app.src index 32ee4b5..e69948f 100644 --- a/src/grisp_keychain.app.src +++ b/src/grisp_keychain.app.src @@ -8,7 +8,8 @@ stdlib ]}, {env, [ - {api_module, grisp_keychain_filesystem} + {api_module, grisp_keychain_filesystem}, + {allow_expired_certs, false} ]}, {modules, []}, {licenses, ["Apache-2.0"]}, diff --git a/src/grisp_keychain.erl b/src/grisp_keychain.erl index 15e52ca..899412f 100644 --- a/src/grisp_keychain.erl +++ b/src/grisp_keychain.erl @@ -39,7 +39,11 @@ A property list of SSL/TLS client options compatible with `ssl:connect/3`. [ssl:tls_client_option()]. tls_options(Domain) -> - delegate_call(?FUNCTION_NAME, [Domain]). + TlsOpts0 = delegate_call(?FUNCTION_NAME, [Domain]), + case application:get_env(grisp_keychain, allow_expired_certs) of + {ok, true} -> wrap_verify_option(TlsOpts0, fun allow_expired_certs/3); + _ -> TlsOpts0 + end. -doc """ Read a certificate in DER format. @@ -73,3 +77,38 @@ read_cert(primary, der) -> delegate_call(Function, Args) -> {ok, Module} = application:get_env(grisp_keychain, api_module), erlang:apply(Module, Function, Args). + +%--- TLS verify chaining ------------------------------------------------------- + +-doc false. +wrap_verify_option(Opts0, Fun) when is_function(Fun, 3) -> + Existing = + case lists:keyfind(verify_fun, 1, Opts0) of + {verify_fun, {Fun, State}} when is_function(Fun, 3) -> + {Fun, State}; + {verify_fun, Fun} when is_function(Fun, 3) -> + {Fun, undefined}; + _ -> + undefined + end, + Opts1 = lists:keydelete(verify_fun, 1, Opts0), + [{verify_fun, {Fun, Existing}} | Opts1]. + +-doc false. +allow_expired_certs(_Cert, {bad_cert, cert_expired}, User) -> + {valid, User}; +allow_expired_certs(Cert, Event, {UserFun, UserState}) -> + case UserFun(Cert, Event, UserState) of + {valid, NewState} -> {valid, {UserFun, NewState}}; + {valid_peer, NewState} -> {valid_peer, {UserFun, NewState}}; + {unknown, NewState} -> {unknown, {UserFun, NewState}}; + {fail, Reason} -> {fail, Reason} + end; +allow_expired_certs(_Cert, valid, State) -> + {valid, State}; +allow_expired_certs(_Cert, valid_peer, State) -> + {valid_peer, State}; +allow_expired_certs(_Cert, {extension, _}, State) -> + {unknown, State}; +allow_expired_certs(_Cert, {bad_cert, Reason}, _State) -> + {fail, Reason}.