1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2015-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19
20%----------------------------------------------------------------------
21%% Purpose: Simple default CRL cache
22%%----------------------------------------------------------------------
23
24-module(ssl_crl_cache).
25
26-include("ssl_internal.hrl").
27-include_lib("public_key/include/public_key.hrl").
28
29-behaviour(ssl_crl_cache_api).
30
31-export_type([crl_src/0, uri/0]).
32-type crl_src() :: {file, file:filename()} | {der,  public_key:der_encoded()}.
33-type uri()     :: uri_string:uri_string().
34
35-export([lookup/3, select/2, fresh_crl/2]).
36-export([insert/1, insert/2, delete/1]).
37
38%%====================================================================
39%% Cache callback API
40%%====================================================================
41
42lookup(#'DistributionPoint'{distributionPoint = {fullName, Names}},
43       _Issuer,
44       CRLDbInfo) ->
45    get_crls(Names, CRLDbInfo);
46lookup(_,_,_) ->
47    not_available.
48
49select(GenNames, CRLDbHandle) when is_list(GenNames) ->
50    lists:flatmap(fun({directoryName, Issuer}) ->
51                          select(Issuer, CRLDbHandle);
52                     (_) ->
53                          []
54                  end, GenNames);
55select(Issuer, {{_Cache, Mapping},_}) ->
56    case ssl_pkix_db:lookup(Issuer, Mapping) of
57	undefined ->
58	    [];
59	CRLs ->
60	    CRLs
61    end.
62
63fresh_crl(#'DistributionPoint'{distributionPoint = {fullName, Names}}, CRL) ->
64    case get_crls(Names, undefined) of
65	not_available ->
66	    CRL;
67	[NewCRL] ->
68	    NewCRL
69    end.
70
71%%====================================================================
72%% API
73%%====================================================================
74
75insert(CRLs) ->
76    insert(?NO_DIST_POINT, CRLs).
77
78insert(URI, {file, File}) when is_list(URI) ->
79    case file:read_file(File) of
80	{ok, PemBin} ->
81	    PemEntries = public_key:pem_decode(PemBin),
82	    CRLs = [ CRL || {'CertificateList', CRL, not_encrypted}
83				<- PemEntries],
84	    do_insert(URI, CRLs);
85	Error ->
86	    Error
87    end;
88insert(URI, {der, CRLs}) ->
89    do_insert(URI, CRLs).
90
91delete({file, File}) ->
92    case file:read_file(File) of
93	{ok, PemBin} ->
94	    PemEntries = public_key:pem_decode(PemBin),
95	    CRLs = [ CRL || {'CertificateList', CRL, not_encrypted}
96				<- PemEntries],
97	    ssl_manager:delete_crls({?NO_DIST_POINT, CRLs});
98	Error ->
99	    Error
100    end;
101delete({der, CRLs}) ->
102    ssl_manager:delete_crls({?NO_DIST_POINT, CRLs});
103
104delete(URI) ->
105    case uri_string:normalize(URI, [return_map]) of
106	#{scheme := "http", path := Path} ->
107	    ssl_manager:delete_crls(string:trim(Path, leading, "/"));
108	_ ->
109	    {error, {only_http_distribution_points_supported, URI}}
110    end.
111
112%%--------------------------------------------------------------------
113%%% Internal functions
114%%--------------------------------------------------------------------
115do_insert(URI, CRLs) ->
116    case uri_string:normalize(URI, [return_map]) of
117	#{scheme := "http", path := Path} ->
118	    ssl_manager:insert_crls(string:trim(Path, leading, "/"), CRLs);
119	_ ->
120	    {error, {only_http_distribution_points_supported, URI}}
121    end.
122
123get_crls([], _) ->
124    not_available;
125get_crls([{uniformResourceIdentifier, "http"++_ = URL} | Rest],
126	 CRLDbInfo) ->
127    case cache_lookup(URL, CRLDbInfo) of
128	[] ->
129	   handle_http(URL, Rest, CRLDbInfo);
130	CRLs ->
131	    CRLs
132    end;
133get_crls([ _| Rest], CRLDbInfo) ->
134    %% unsupported CRL location
135    get_crls(Rest, CRLDbInfo).
136
137http_lookup(URL, Rest, CRLDbInfo, Timeout) ->
138    case application:ensure_started(inets) of
139	ok ->
140	    http_get(URL, Rest, CRLDbInfo, Timeout);
141	_ ->
142	    get_crls(Rest, CRLDbInfo)
143    end.
144
145http_get(URL, Rest, CRLDbInfo, Timeout) ->
146    case httpc:request(get, {URL, [{"connection", "close"}]},
147		       [{timeout, Timeout}], [{body_format, binary}]) of
148        {ok, {_Status, _Headers, Body}} ->
149            case Body of
150                <<"-----BEGIN", _/binary>> ->
151                    Pem = public_key:pem_decode(Body),
152		    lists:filtermap(fun({'CertificateList',
153					 CRL, not_encrypted}) ->
154					    {true, CRL};
155				       (_) ->
156					    false
157				    end, Pem);
158		_ ->
159		    try public_key:der_decode('CertificateList', Body) of
160			_ ->
161			    [Body]
162		    catch
163			_:_ ->
164			    get_crls(Rest, CRLDbInfo)
165		    end
166	    end;
167        {error, _Reason} ->
168            get_crls(Rest, CRLDbInfo)
169    end.
170
171cache_lookup(_, undefined) ->
172    [];
173cache_lookup(URL, {{Cache, _}, _}) ->
174    #{path :=  Path} = uri_string:normalize(URL, [return_map]),
175    case ssl_pkix_db:lookup(string:trim(Path, leading, "/"), Cache) of
176	undefined ->
177	    [];
178	CRLs ->
179	    CRLs
180    end.
181
182handle_http(URI, Rest, {_,  [{http, Timeout}]} = CRLDbInfo) ->
183    CRLs = http_lookup(URI, Rest, CRLDbInfo, Timeout),
184    %% Uncomment to improve performance, but need to
185    %% implement cache limit and or cleaning to prevent
186    %% DoS attack possibilities
187    %%insert(URI, {der, CRLs}),
188    CRLs;
189handle_http(_, Rest, CRLDbInfo) ->
190    get_crls(Rest, CRLDbInfo).
191
192