1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2007-2019. 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%%----------------------------------------------------------------------
22%% Purpose: Bloom Filter implementation for anti-replay protection
23%%          in TLS 1.3 (stateless tickets)
24%%----------------------------------------------------------------------
25
26-module(tls_bloom_filter).
27
28-export([add_elem/2,
29         contains/2,
30         new/2,
31         rotate/1]).
32
33%%--------------------------------------------------------------------
34%% API ---------------------------------------------------------------
35%%--------------------------------------------------------------------
36
37%% Create new Bloom Filter with k hashes, m bits in the filter
38new(K, M) ->
39    Size = round(math:ceil(M / 8)),
40    BitField = binary:copy(<<0>>, Size),
41    #{k => K,
42      m => M,
43      current => BitField,
44      old => BitField
45     }.
46
47
48%% Add new element to Bloom Filter
49add_elem(#{k := K,
50           m := M,
51           current := BitField0} = BloomFilter,
52         Elem) ->
53    Hash = hash(Elem, K, M),
54    BitField = set_bits(BitField0, Hash),
55    BloomFilter#{current => BitField}.
56
57
58%% Check if Bloom Filter contains element.
59contains(#{k := K,
60           m := M,
61           current := BFCurrent,
62           old := BFOld},
63         Elem) ->
64    Hash = hash(Elem, K, M),
65    lists:all(fun (Pos) -> bit_is_set(BFCurrent, Pos) end, Hash) orelse
66        lists:all(fun (Pos) -> bit_is_set(BFOld, Pos) end, Hash).
67
68
69rotate(#{m := M,
70         current := BFCurrent} = BloomFilter) ->
71    Size = round(math:ceil(M / 8)),
72    BFNew = binary:copy(<<0>>, Size),
73    BloomFilter#{current := BFNew,
74                 old := BFCurrent}.
75
76
77%%--------------------------------------------------------------------
78%% Internal functions ------------------------------------------------
79%%--------------------------------------------------------------------
80bit_is_set(<<1:1,_/bitstring>>, 0) ->
81    true;
82bit_is_set(BitField, N) ->
83    case BitField of
84	<<_:N,1:1,_/bitstring>> ->
85	    true;
86	_ ->
87	    false
88    end.
89
90
91set_bits(BitField, []) ->
92    BitField;
93set_bits(BitField, [H|T]) ->
94    set_bits(set_bit(BitField, H), T).
95
96
97set_bit(BitField, 0) ->
98    <<_:1,Rest/bitstring>> = BitField,
99    <<1:1,Rest/bitstring>>;
100set_bit(BitField, B) ->
101    <<Front:B,_:1,Rest/bitstring>>  = BitField,
102    <<Front:B,1:1,Rest/bitstring>>.
103
104
105%% Kirsch-Mitzenmacher-Optimization
106hash(Elem, K, M) ->
107    hash(Elem, K, M, []).
108%%
109hash(_, 0, _, Acc) ->
110    Acc;
111hash(Elem, K, M, Acc) ->
112    H = (erlang:phash2({Elem, 0}, M) + (K - 1) * erlang:phash2({Elem, 1}, M)) rem M,
113    hash(Elem, K - 1, M, [H|Acc]).
114