-
Notifications
You must be signed in to change notification settings - Fork 125
/
cookie.ml
144 lines (121 loc) · 4.2 KB
/
cookie.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(*
@author Laurent Le Brun
**)
(* This module provides a way to have secure cookies. Each time a client
* comes on the webpage, a new cookie is generated, and the old cookie
* will expire a few seconds later. This way, it's quite difficult to
*)
(* ic: internal cookie, doesn't change, the server can use it to identify someone *)
(* ec: external cookie, change often, given to the browser *)
(* depends *)
module String = BaseString
let (|>) = InfixOperator.(|>)
(* FIXME: use String.random instead? *)
(* let random() = *)
(* let randN()= Random.int64 Int64.max_int in *)
(* (Digest.to_hex (Digest.string( sprintf "%Ld %Ld %f" (randN()) (randN()) (Unix.time ())))) *)
let chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
let nchars = 26*2 + 10
let cookie_len = 32
let random() =
Base.String.init cookie_len (fun _ -> chars.[Random.int nchars])
let to_internal = Hashtbl.create 1000
let to_external = Hashtbl.create 1000
let expire_time = ref 50 (* in seconds *)
let set_expire_time t = expire_time := t
(* Remove expired cookies *)
let remove_expired now li =
List.filter (fun (c, date) ->
assert (date > 0);
if date + !expire_time < now then (
Hashtbl.remove to_internal c;
false)
else
true) li
(* Check if the given external cookie is expired *)
let check_date ic ec =
try
let now = truncate (Unix.time()) in
match Hashtbl.find to_external ic with
| (fst, _date)::li ->
assert (_date < 0); (* negative value means "not expired" *)
(* Set expire date for the last cookie *)
let li = (fst, _date) :: remove_expired now li in
let res = List.exists (fun (c, _) -> c = ec) li in
Hashtbl.replace to_external ic li;
if not res then Logger.warning "Invalid cookie! ic:%s ec:%s" ic ec;
res
| [] -> assert false
with Not_found ->
false
let create() =
let ic = random() in
let ec = random() in
Hashtbl.add to_external ic [];
Hashtbl.add to_internal ec ic;
ic
let id_of_cookie str =
(* let () = prerr_endline str in *)
let cookies = String.slice ';' str |>
List.map
(fun x ->
let a, b = String.split_char '=' x in
(String.trim a), b)
in
(* let () = List.iter (fun (name, value) -> prerr_endline (Printf.sprintf "%s -> %s" name value)) cookies in *)
let out = List.fold_left (fun acc (name, val') ->
if name = "ec" then Some(val') else acc
) None cookies
|> Option.default str
(*in let () = prerr_endline out *)
in out
(* Check the cookie given by the browser *)
(* Return the internal cookie *)
let get_internal ec =
let ec = id_of_cookie ec in
try
let ic = Hashtbl.find to_internal ec in
if check_date ic ec then
ic
else
create()
with Not_found -> create()
let get_internal ec =
let ec = id_of_cookie ec in
let res = get_internal ec in
res
(* Return the external cookie *)
let get_external ic =
let now = truncate (Unix.time()) in
let ec = match Hashtbl.find to_external ic with
| (c, -1) :: li ->
let rnd = random() in
let li = (rnd, -1) :: (c, now) :: li in
Hashtbl.replace to_external ic li;
Hashtbl.add to_internal rnd ic;
rnd
| [] ->
let rnd = random() in
Hashtbl.replace to_external ic [rnd, -1];
Hashtbl.add to_internal rnd ic;
rnd
| _ -> assert false
in
(Printf.sprintf "ec=%s; path=/" ec), (Printf.sprintf "ic=%s; path=/" ic)
(* Check if internal and external cookies match *)
let check ic ec =
try Hashtbl.find to_internal ec = ic
with Not_found -> false