Add allow_expired_certs option

Author: sylane

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}
 ]}
 ```
 

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"]},

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}.