[OCaml] High Intensity Training Online
fix throttle sign-in and hide account existence from timing
Two hardenings of /login. Sign-in attempts are throttled per client address to ten a minute. The eleventh answers 429 before any credential check, so online password guessing is bounded and the refusal itself does no hashing work. The throttle is per handler instance and in memory; a restart forgets it, which is acceptable for a throttle. The service now verifies a candidate password against a decoy verifier whenever the username is malformed or unknown, then discards the answer. Previously an unknown name short-circuited before hashing, so the fast refusal told an attacker which usernames exist. Every refusal now costs the same work.
lib/app/service.ml
@@ -1,9 +1,14 @@
1
1
module Make (R : Repository.S) (H : Password_hash.S) = struct
2
2
open Lwt.Infix
3
3
4
Removed:
type t = { repo : R.t }
4
Added:
(* [decoy] is a real verifier for a throwaway password. When sign-in names an
5
Added:
unknown account, the service verifies the candidate against it and discards
6
Added:
the answer, so an unknown name costs the same hashing work as a wrong
7
Added:
password. Otherwise the fast refusal would tell an attacker which usernames
8
Added:
exist. Built once, since hashing is deliberately slow. *)
9
Added:
type t = { repo : R.t; decoy : string }
5
10
6
Removed:
let make ~repo = { repo }
11
Added:
let make ~repo = { repo; decoy = H.hash "hito-decoy-credential" }
7
12
8
13
(* Error types are part of the flat public interface, so they live at the top
9
14
level of the functor. The implementation below is grouped into focused
@@ -122,17 +127,27 @@
122
127
(fun `Username_taken -> `Username_taken)
123
128
(R.create_trainee t.repo ~username ~credential)
124
129
130
Added:
(* Every refusal does the same hashing work. A malformed or unknown username
131
Added:
still verifies the candidate against the decoy, so timing does not reveal
132
Added:
which accounts exist. Only a known account with a verified password
133
Added:
signs in. *)
125
134
let authenticate t ~username ~password =
135
Added:
let refuse () =
136
Added:
ignore (H.verify ~hash:t.decoy password);
137
Added:
None
138
Added:
in
126
139
match Trainee.username username with
127
Removed:
| Error _ -> Lwt.return None
140
Added:
| Error _ -> Lwt.return (refuse ())
128
141
| Ok username -> (
129
142
R.find_trainee_by_username t.repo username >|= function
130
Removed:
| Some trainee
131
Removed:
when H.verify
132
Removed:
~hash:(Trainee.credential_to_hash trainee.Trainee.credential)
133
Removed:
password ->
134
Removed:
Some trainee
135
Removed:
| _ -> None)
143
Added:
| Some trainee ->
144
Added:
if
145
Added:
H.verify
146
Added:
~hash:(Trainee.credential_to_hash trainee.Trainee.credential)
147
Added:
password
148
Added:
then Some trainee
149
Added:
else None
150
Added:
| None -> refuse ())
136
151
137
152
let find_trainee t id = R.find_trainee t.repo id
138
153
lib/web/handlers_auth.ml
@@ -42,17 +42,26 @@
42
42
html ~status:`Bad_Request
43
43
(Pages.register request ~error:(Present.registration err) ()))
44
44
45
Added:
(* Every sign-in attempt, valid or not, counts against the client's throttle
46
Added:
before the credentials are checked, so a guessing client is refused early
47
Added:
and the refusal itself does no hashing work. *)
45
48
let login t request =
46
Removed:
read_credentials request >>= function
47
Removed:
| Error _ ->
48
Removed:
html ~status:`Bad_Request
49
Removed:
(Pages.login request ~error:Present.form_invalid ())
50
Removed:
| Ok (username, password) -> (
51
Removed:
Service.authenticate t.service ~username ~password >>= function
52
Removed:
| Some trainee -> establish request trainee
53
Removed:
| None ->
54
Removed:
html ~status:`Unauthorized
55
Removed:
(Pages.login request ~error:Present.sign_in_failed ()))
49
Added:
let client = Dream.client request in
50
Added:
let now = Recovery.timestamp_to_unix_seconds (t.now ()) in
51
Added:
if Sign_in_limiter.attempt t.sign_in_limiter ~client ~now then
52
Added:
html ~status:`Too_Many_Requests
53
Added:
(Pages.login request ~error:Present.sign_in_throttled ())
54
Added:
else
55
Added:
read_credentials request >>= function
56
Added:
| Error _ ->
57
Added:
html ~status:`Bad_Request
58
Added:
(Pages.login request ~error:Present.form_invalid ())
59
Added:
| Ok (username, password) -> (
60
Added:
Service.authenticate t.service ~username ~password >>= function
61
Added:
| Some trainee -> establish request trainee
62
Added:
| None ->
63
Added:
html ~status:`Unauthorized
64
Added:
(Pages.login request ~error:Present.sign_in_failed ()))
56
65
57
66
let logout _t request =
58
67
guard_csrf request >>= function
lib/web/handlers_kit.ml
@@ -12,17 +12,51 @@
12
12
module Make (R : Repository.S) (H : Password_hash.S) = struct
13
13
module Service = Service.Make (R) (H)
14
14
15
Added:
(* A sliding-window throttle on sign-in attempts, keyed by the client's
16
Added:
address. It bounds online password guessing to [limit] attempts per
17
Added:
[window] seconds per client. State is per handler instance and in memory:
18
Added:
a restart forgets it, which is acceptable for a throttle. Timestamps come
19
Added:
from the injected clock, so tests can drive it. *)
20
Added:
module Sign_in_limiter = struct
21
Added:
type t = {
22
Added:
attempts : (string, int list) Hashtbl.t;
23
Added:
limit : int;
24
Added:
window : int;
25
Added:
}
26
Added:
27
Added:
let make ?(limit = 10) ?(window = 60) () =
28
Added:
{ attempts = Hashtbl.create 64; limit; window }
29
Added:
30
Added:
(* Record an attempt for [client] at [now] and report whether it is over the
31
Added:
limit. Attempts older than the window fall away as they age out. *)
32
Added:
let attempt t ~client ~now =
33
Added:
let fresh =
34
Added:
List.filter
35
Added:
(fun at -> now - at < t.window)
36
Added:
(Option.value ~default:[] (Hashtbl.find_opt t.attempts client))
37
Added:
in
38
Added:
let recent = now :: fresh in
39
Added:
Hashtbl.replace t.attempts client recent;
40
Added:
List.length recent > t.limit
41
Added:
end
42
Added:
15
43
type t = {
16
44
service : Service.t;
17
45
now : unit -> Recovery.timestamp;
18
46
registration_open : bool;
47
Added:
sign_in_limiter : Sign_in_limiter.t;
19
48
}
20
49
21
50
let default_now () =
22
51
Recovery.timestamp_of_unix_seconds (int_of_float (Unix.gettimeofday ()))
23
52
24
53
let make ~repo ?(now = default_now) ?(registration_open = false) () =
25
Removed:
{ service = Service.make ~repo; now; registration_open }
54
Added:
{
55
Added:
service = Service.make ~repo;
56
Added:
now;
57
Added:
registration_open;
58
Added:
sign_in_limiter = Sign_in_limiter.make ();
59
Added:
}
26
60
27
61
let flash_key = "hito.flash"
28
62
let html ?status page = Dream_html.respond ?status page
@@ -86,6 +120,9 @@
86
120
| `Username_taken -> "That username is already registered."
87
121
88
122
let sign_in_failed = "That username and password do not match."
123
Added:
124
Added:
let sign_in_throttled =
125
Added:
"Too many sign-in attempts. Wait a minute, then try again."
89
126
90
127
let routine : Service.error -> string = function
91
128
| Service.Unknown_routine -> "That routine is not in the catalogue."
test/web/auth.ml
@@ -58,6 +58,47 @@
58
58
Alcotest.(check bool)
59
59
"the session identifier changed on sign-in" true (before <> after)
60
60
);
61
Added:
( "repeated sign-in attempts from one client are throttled",
62
Added:
`Quick,
63
Added:
fun () ->
64
Added:
(* Online password guessing is bounded per client: ten attempts a
65
Added:
minute. The eleventh is refused with 429 before any credential
66
Added:
check, and a wrong password never becomes a right one by
67
Added:
repetition. *)
68
Added:
let c = client () in
69
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
70
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
71
Added:
let _ = post c "/logout" [ ("dream.csrf", token) ] in
72
Added:
let attempt () =
73
Added:
let token = Option.get (csrf_token (body (get c "/login"))) in
74
Added:
post c "/login"
75
Added:
[
76
Added:
("dream.csrf", token);
77
Added:
("username", "lifter");
78
Added:
("password", "wrong");
79
Added:
]
80
Added:
in
81
Added:
for _ = 1 to 10 do
82
Added:
Alcotest.(check int)
83
Added:
"a wrong password is refused" 401
84
Added:
(status (attempt ()))
85
Added:
done;
86
Added:
Alcotest.(check int)
87
Added:
"the eleventh attempt is throttled" 429
88
Added:
(status (attempt ()));
89
Added:
(* Even the right password is refused while throttled. *)
90
Added:
let token = Option.get (csrf_token (body (get c "/login"))) in
91
Added:
let right =
92
Added:
post c "/login"
93
Added:
[
94
Added:
("dream.csrf", token);
95
Added:
("username", "lifter");
96
Added:
("password", "heavyduty1");
97
Added:
]
98
Added:
in
99
Added:
Alcotest.(check int)
100
Added:
"a correct password is also refused while throttled" 429
101
Added:
(status right) );
61
102
( "every page carries the copyright and deployment version banner",
62
103
`Quick,
63
104
fun () ->