SRP-6a Secure Remote Password protocol for OCaml
Squashed 'ocaml-srp/' content from commit a1b4496d git-subtree-split: a1b4496d9cd65510ff646ce13d53f0e1f7b6659a
+645
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version = 0.28.1
+25
dune-project
+25
dune-project
···
1
+
(lang dune 3.0)
2
+
3
+
(name srp)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license MIT)
8
+
(authors "Thomas Gazagnaire <thomas@gazagnaire.org>")
9
+
(maintainers "Thomas Gazagnaire <thomas@gazagnaire.org>")
10
+
(homepage "https://github.com/samoht/ocaml-srp")
11
+
(bug_reports "https://github.com/samoht/ocaml-srp/issues")
12
+
13
+
(package
14
+
(name srp)
15
+
(synopsis "SRP-6a Secure Remote Password protocol")
16
+
(description
17
+
"Implementation of the SRP-6a protocol (RFC 5054) for password-authenticated
18
+
key exchange. Includes support for the 3072-bit group used by HomeKit.")
19
+
(depends
20
+
(ocaml (>= 4.08))
21
+
(zarith (>= 1.12))
22
+
(digestif (>= 1.2.0))
23
+
(crypto-rng (>= 1.0.0))
24
+
(alcotest :with-test)
25
+
(crowbar :with-test)))
+15
fuzz/dune
+15
fuzz/dune
···
1
+
; Crowbar fuzz testing for srp
2
+
;
3
+
; To run: dune exec fuzz/fuzz_srp.exe
4
+
; With AFL: afl-fuzz -i fuzz/corpus -o fuzz/findings -- ./_build/default/fuzz/fuzz_srp.exe @@
5
+
6
+
(executable
7
+
(name fuzz_srp)
8
+
(modules fuzz_srp)
9
+
(libraries srp crowbar crypto-rng.unix))
10
+
11
+
(rule
12
+
(alias fuzz)
13
+
(deps fuzz_srp.exe)
14
+
(action
15
+
(run %{exe:fuzz_srp.exe})))
+43
fuzz/fuzz_srp.ml
+43
fuzz/fuzz_srp.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open Crowbar
7
+
8
+
let () = Crypto_rng_unix.use_default ()
9
+
10
+
(* Test that matching passwords produce matching session keys *)
11
+
let test_protocol_roundtrip username password salt =
12
+
if String.length username = 0 || String.length password = 0 then ()
13
+
else if String.length salt < 8 then ()
14
+
else
15
+
let salt = String.sub salt 0 (min 16 (String.length salt)) in
16
+
let verifier = Srp.compute_verifier ~salt ~username ~password in
17
+
let client = Srp.Client.create ~username ~password in
18
+
let big_a = Srp.Client.public_key client in
19
+
let server = Srp.Server.create ~username ~salt ~verifier in
20
+
let big_b = Srp.Server.public_key server in
21
+
match
22
+
( Srp.Client.compute_session_key client ~salt ~big_b,
23
+
Srp.Server.compute_session_key server ~big_a )
24
+
with
25
+
| Ok key_c, Ok key_s -> check_eq ~pp:Format.pp_print_string key_c key_s
26
+
| Error (`Msg e), _ -> failwith ("Client error: " ^ e)
27
+
| _, Error (`Msg e) -> failwith ("Server error: " ^ e)
28
+
29
+
(* Test that verifier computation is deterministic *)
30
+
let test_verifier_deterministic username password salt =
31
+
if String.length username = 0 || String.length password = 0 then ()
32
+
else if String.length salt < 8 then ()
33
+
else
34
+
let salt = String.sub salt 0 (min 16 (String.length salt)) in
35
+
let v1 = Srp.compute_verifier ~salt ~username ~password in
36
+
let v2 = Srp.compute_verifier ~salt ~username ~password in
37
+
check (Z.equal v1 v2)
38
+
39
+
let () =
40
+
add_test ~name:"srp: protocol roundtrip" [ bytes; bytes; bytes ] (fun u p s ->
41
+
test_protocol_roundtrip u p s);
42
+
add_test ~name:"srp: verifier deterministic" [ bytes; bytes; bytes ]
43
+
(fun u p s -> test_verifier_deterministic u p s)
+4
lib/dune
+4
lib/dune
+196
lib/srp.ml
+196
lib/srp.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** SRP-6a Secure Remote Password Protocol (RFC 5054)
7
+
8
+
This implementation uses the 3072-bit group from RFC 5054 with SHA-512 as
9
+
the hash function, as required by HomeKit.
10
+
11
+
{1 Security Notice}
12
+
13
+
{b WARNING: This implementation has known timing side-channel
14
+
vulnerabilities.}
15
+
16
+
The modular exponentiation uses Zarith for big integer arithmetic, which is
17
+
{e not constant-time}. For high-security deployments, consider using
18
+
hardware security modules or ensuring operations occur on trusted networks
19
+
only. *)
20
+
21
+
(** {1 Constants} *)
22
+
23
+
(** RFC 5054 3072-bit group prime N *)
24
+
let n_hex =
25
+
"FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A93AD2CAFFFFFFFFFFFFFFFF"
26
+
27
+
(** Generator g = 5 *)
28
+
let g = Z.of_int 5
29
+
30
+
(** Group prime N *)
31
+
let n = Z.of_string_base 16 n_hex
32
+
33
+
(** {1 Utility Functions} *)
34
+
35
+
(** Hash data using SHA-512 *)
36
+
let hash data =
37
+
Digestif.SHA512.digest_string data |> Digestif.SHA512.to_raw_string
38
+
39
+
(** Reverse a string (for endianness conversion) *)
40
+
let string_rev s =
41
+
let len = String.length s in
42
+
String.init len (fun i -> s.[len - 1 - i])
43
+
44
+
(** Convert bytes (big-endian) to Z *)
45
+
let z_of_bytes s =
46
+
(* Z.of_bits is little-endian, SRP uses big-endian *)
47
+
Z.of_bits (string_rev s)
48
+
49
+
(** Convert Z to bytes (big-endian), optionally padding to specified length *)
50
+
let bytes_of_z ?(pad = 0) z =
51
+
(* Z.to_bits is little-endian, SRP uses big-endian *)
52
+
let s = string_rev (Z.to_bits z) in
53
+
(* Remove leading zeros that Z.to_bits may have added *)
54
+
let s =
55
+
let rec skip i =
56
+
if i >= String.length s - 1 then String.length s - 1
57
+
else if s.[i] = '\x00' then skip (i + 1)
58
+
else i
59
+
in
60
+
String.sub s (skip 0) (String.length s - skip 0)
61
+
in
62
+
if pad > 0 && String.length s < pad then
63
+
String.make (pad - String.length s) '\x00' ^ s
64
+
else s
65
+
66
+
(** Compute k = H(N | PAD(g)) *)
67
+
let compute_k () =
68
+
let n_bytes = bytes_of_z n in
69
+
let g_bytes = bytes_of_z ~pad:(String.length n_bytes) g in
70
+
z_of_bytes (hash (n_bytes ^ g_bytes))
71
+
72
+
(** Compute x = H(salt | H(username | ":" | password)) *)
73
+
let compute_x ~salt ~username ~password =
74
+
let inner = hash (username ^ ":" ^ password) in
75
+
z_of_bytes (hash (salt ^ inner))
76
+
77
+
(** Compute verifier v = g^x mod N *)
78
+
let compute_verifier ~salt ~username ~password =
79
+
let x = compute_x ~salt ~username ~password in
80
+
Z.powm g x n
81
+
82
+
(** {1 Client} *)
83
+
84
+
module Client = struct
85
+
type t = {
86
+
username : string;
87
+
password : string;
88
+
a : Z.t; (* private random *)
89
+
big_a : Z.t; (* A = g^a mod N *)
90
+
}
91
+
92
+
let create ~username ~password =
93
+
let a_bytes = Crypto_rng.generate 32 in
94
+
let a = Z.(z_of_bytes a_bytes mod n) in
95
+
let big_a = Z.powm g a n in
96
+
{ username; password; a; big_a }
97
+
98
+
let public_key t = t.big_a
99
+
100
+
let compute_session_key t ~salt ~big_b =
101
+
if Z.(equal (big_b mod n) zero) then Error (`Msg "Invalid B value")
102
+
else
103
+
let k = compute_k () in
104
+
let n_len = (Z.numbits n + 7) / 8 in
105
+
let a_pad = bytes_of_z ~pad:n_len t.big_a in
106
+
let b_pad = bytes_of_z ~pad:n_len big_b in
107
+
let u = z_of_bytes (hash (a_pad ^ b_pad)) in
108
+
if Z.(equal u zero) then Error (`Msg "Invalid u value")
109
+
else
110
+
let x = compute_x ~salt ~username:t.username ~password:t.password in
111
+
(* S = (B - k * g^x)^(a + u * x) mod N *)
112
+
let base = Z.((big_b - (k * powm g x n)) mod n) in
113
+
let base = if Z.(lt base zero) then Z.(base + n) else base in
114
+
let exp = Z.((t.a + (u * x)) mod (n - one)) in
115
+
let s = Z.powm base exp n in
116
+
let session_key = hash (bytes_of_z s) in
117
+
Ok session_key
118
+
119
+
let compute_proof t ~salt ~big_b ~session_key =
120
+
let h_n = hash (bytes_of_z n) in
121
+
let h_g = hash (bytes_of_z g) in
122
+
let h_xor =
123
+
String.init (String.length h_n) (fun i ->
124
+
Char.chr (Char.code h_n.[i] lxor Char.code h_g.[i]))
125
+
in
126
+
let h_user = hash t.username in
127
+
let n_len = (Z.numbits n + 7) / 8 in
128
+
hash
129
+
(h_xor ^ h_user ^ salt
130
+
^ bytes_of_z ~pad:n_len t.big_a
131
+
^ bytes_of_z ~pad:n_len big_b
132
+
^ session_key)
133
+
134
+
let verify_proof t ~m1 ~m2 ~session_key =
135
+
let n_len = (Z.numbits n + 7) / 8 in
136
+
let expected = hash (bytes_of_z ~pad:n_len t.big_a ^ m1 ^ session_key) in
137
+
String.equal expected m2
138
+
end
139
+
140
+
(** {1 Server} *)
141
+
142
+
module Server = struct
143
+
type t = {
144
+
username : string;
145
+
salt : string;
146
+
verifier : Z.t;
147
+
b : Z.t; (* private random *)
148
+
big_b : Z.t; (* B = k*v + g^b mod N *)
149
+
}
150
+
151
+
let create ~username ~salt ~verifier =
152
+
let k = compute_k () in
153
+
let b_bytes = Crypto_rng.generate 32 in
154
+
let b = Z.(z_of_bytes b_bytes mod n) in
155
+
let big_b = Z.(((k * verifier) + powm g b n) mod n) in
156
+
{ username; salt; verifier; b; big_b }
157
+
158
+
let public_key t = t.big_b
159
+
let salt t = t.salt
160
+
161
+
let compute_session_key t ~big_a =
162
+
if Z.(equal (big_a mod n) zero) then Error (`Msg "Invalid A value")
163
+
else
164
+
let n_len = (Z.numbits n + 7) / 8 in
165
+
let a_pad = bytes_of_z ~pad:n_len big_a in
166
+
let b_pad = bytes_of_z ~pad:n_len t.big_b in
167
+
let u = z_of_bytes (hash (a_pad ^ b_pad)) in
168
+
if Z.(equal u zero) then Error (`Msg "Invalid u value")
169
+
else
170
+
(* S = (A * v^u)^b mod N *)
171
+
let s = Z.(powm (big_a * powm t.verifier u n) t.b n) in
172
+
let session_key = hash (bytes_of_z s) in
173
+
Ok session_key
174
+
175
+
let verify_proof t ~big_a ~m1 ~session_key =
176
+
let h_n = hash (bytes_of_z n) in
177
+
let h_g = hash (bytes_of_z g) in
178
+
let h_xor =
179
+
String.init (String.length h_n) (fun i ->
180
+
Char.chr (Char.code h_n.[i] lxor Char.code h_g.[i]))
181
+
in
182
+
let h_user = hash t.username in
183
+
let n_len = (Z.numbits n + 7) / 8 in
184
+
let expected =
185
+
hash
186
+
(h_xor ^ h_user ^ t.salt
187
+
^ bytes_of_z ~pad:n_len big_a
188
+
^ bytes_of_z ~pad:n_len t.big_b
189
+
^ session_key)
190
+
in
191
+
String.equal expected m1
192
+
193
+
let compute_proof _t ~big_a ~m1 ~session_key =
194
+
let n_len = (Z.numbits n + 7) / 8 in
195
+
hash (bytes_of_z ~pad:n_len big_a ^ m1 ^ session_key)
196
+
end
+166
lib/srp.mli
+166
lib/srp.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** SRP-6a Secure Remote Password Protocol (RFC 5054)
7
+
8
+
SRP is a password-authenticated key exchange protocol that allows a client
9
+
to authenticate to a server using a password without transmitting the
10
+
password over the network. The server stores only a verifier derived from
11
+
the password, not the password itself.
12
+
13
+
This implementation uses the 3072-bit group from RFC 5054 with SHA-512 as
14
+
the hash function, as required by Apple HomeKit.
15
+
16
+
{1 Security Notice}
17
+
18
+
{b WARNING: This implementation has known timing side-channel
19
+
vulnerabilities.}
20
+
21
+
The modular exponentiation uses Zarith for big integer arithmetic, which is
22
+
{e not constant-time}. For high-security deployments, consider using
23
+
hardware security modules or ensuring operations occur on trusted networks
24
+
only.
25
+
26
+
{1 Protocol Overview}
27
+
28
+
{2 Registration}
29
+
30
+
When a user registers:
31
+
+ Server generates a random salt
32
+
+ Verifier is computed: [v = g^(H(salt | H(username:password))) mod N]
33
+
+ Server stores [username], [salt], and [verifier]
34
+
35
+
{2 Authentication}
36
+
37
+
+ Client sends username and [A = g^a mod N]
38
+
+ Server looks up [salt] and [verifier], computes [B = k*v + g^b mod N]
39
+
+ Server sends [salt] and [B]
40
+
+ Both compute [u = H(A | B)] and session key [K]
41
+
+ Client computes proof [M1] and sends it
42
+
+ Server verifies [M1], computes proof [M2] and sends it
43
+
+ Client verifies [M2]
44
+
+ Both now share session key [K]
45
+
46
+
{1 Usage}
47
+
48
+
{[
49
+
(* Registration: compute verifier to store on server *)
50
+
let salt = Crypto_rng.generate 16 in
51
+
let verifier = Srp.compute_verifier ~salt ~username ~password in
52
+
(* Store username, salt, verifier on server *)
53
+
54
+
(* Authentication *)
55
+
let client = Srp.Client.create ~username ~password in
56
+
let big_a = Srp.Client.public_key client in
57
+
(* Send username and big_a to server *)
58
+
59
+
let server = Srp.Server.create ~username ~salt ~verifier in
60
+
let big_b = Srp.Server.public_key server in
61
+
let salt = Srp.Server.salt server in
62
+
(* Send salt and big_b to client *)
63
+
64
+
(* Both compute session key *)
65
+
let key_c = Srp.Client.compute_session_key client ~salt ~big_b in
66
+
let key_s = Srp.Server.compute_session_key server ~big_a in
67
+
(* key_c = key_s *)
68
+
]} *)
69
+
70
+
(** {1 Constants} *)
71
+
72
+
val n : Z.t
73
+
(** The 3072-bit group prime N from RFC 5054. *)
74
+
75
+
val g : Z.t
76
+
(** The generator g = 5. *)
77
+
78
+
(** {1 Byte Conversion}
79
+
80
+
SRP values are transmitted as big-endian byte strings. *)
81
+
82
+
val z_of_bytes : string -> Z.t
83
+
(** [z_of_bytes s] converts a big-endian byte string to a big integer. *)
84
+
85
+
val bytes_of_z : ?pad:int -> Z.t -> string
86
+
(** [bytes_of_z ?pad z] converts a big integer to a big-endian byte string. If
87
+
[pad] is specified, the result is left-padded with zeros to reach the
88
+
specified length. *)
89
+
90
+
(** {1 Verifier Computation} *)
91
+
92
+
val compute_verifier : salt:string -> username:string -> password:string -> Z.t
93
+
(** [compute_verifier ~salt ~username ~password] computes the verifier
94
+
[v = g^x mod N] where [x = H(salt | H(username:password))].
95
+
96
+
The verifier should be stored on the server along with the username and
97
+
salt. The password should never be stored. *)
98
+
99
+
(** {1 Client} *)
100
+
101
+
module Client : sig
102
+
type t
103
+
(** Client state for SRP authentication. *)
104
+
105
+
val create : username:string -> password:string -> t
106
+
(** [create ~username ~password] initializes a client for SRP authentication.
107
+
Generates a random private value [a] and computes [A = g^a mod N]. *)
108
+
109
+
val public_key : t -> Z.t
110
+
(** [public_key t] returns the client's public value [A] to send to the
111
+
server. *)
112
+
113
+
val compute_session_key :
114
+
t -> salt:string -> big_b:Z.t -> (string, [ `Msg of string ]) result
115
+
(** [compute_session_key t ~salt ~big_b] computes the shared session key after
116
+
receiving the server's [B] value and salt.
117
+
118
+
Returns [Error] if [B mod N = 0] (invalid server value) or if the computed
119
+
[u = 0]. *)
120
+
121
+
val compute_proof :
122
+
t -> salt:string -> big_b:Z.t -> session_key:string -> string
123
+
(** [compute_proof t ~salt ~big_b ~session_key] computes the client proof
124
+
[M1 = H(H(N) xor H(g) | H(username) | salt | A | B | K)] to send to the
125
+
server. *)
126
+
127
+
val verify_proof : t -> m1:string -> m2:string -> session_key:string -> bool
128
+
(** [verify_proof t ~m1 ~m2 ~session_key] verifies the server's proof [M2].
129
+
Returns [true] if the server has the correct verifier. *)
130
+
end
131
+
132
+
(** {1 Server} *)
133
+
134
+
module Server : sig
135
+
type t
136
+
(** Server state for SRP authentication. *)
137
+
138
+
val create : username:string -> salt:string -> verifier:Z.t -> t
139
+
(** [create ~username ~salt ~verifier] initializes a server for SRP
140
+
authentication. Generates a random private value [b] and computes
141
+
[B = k*v + g^b mod N]. *)
142
+
143
+
val public_key : t -> Z.t
144
+
(** [public_key t] returns the server's public value [B] to send to the
145
+
client. *)
146
+
147
+
val salt : t -> string
148
+
(** [salt t] returns the salt to send to the client. *)
149
+
150
+
val compute_session_key :
151
+
t -> big_a:Z.t -> (string, [ `Msg of string ]) result
152
+
(** [compute_session_key t ~big_a] computes the shared session key after
153
+
receiving the client's [A] value.
154
+
155
+
Returns [Error] if [A mod N = 0] (invalid client value) or if the computed
156
+
[u = 0]. *)
157
+
158
+
val verify_proof : t -> big_a:Z.t -> m1:string -> session_key:string -> bool
159
+
(** [verify_proof t ~big_a ~m1 ~session_key] verifies the client's proof [M1].
160
+
Returns [true] if the client knows the password. *)
161
+
162
+
val compute_proof :
163
+
t -> big_a:Z.t -> m1:string -> session_key:string -> string
164
+
(** [compute_proof t ~big_a ~m1 ~session_key] computes the server proof
165
+
[M2 = H(A | M1 | K)] to send to the client. *)
166
+
end
+35
srp.opam
+35
srp.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "SRP-6a Secure Remote Password protocol"
4
+
description: """
5
+
Implementation of the SRP-6a protocol (RFC 5054) for password-authenticated
6
+
key exchange. Includes support for the 3072-bit group used by HomeKit."""
7
+
maintainer: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
8
+
authors: ["Thomas Gazagnaire <thomas@gazagnaire.org>"]
9
+
license: "MIT"
10
+
homepage: "https://github.com/samoht/ocaml-srp"
11
+
bug-reports: "https://github.com/samoht/ocaml-srp/issues"
12
+
depends: [
13
+
"dune" {>= "3.0"}
14
+
"ocaml" {>= "4.08"}
15
+
"zarith" {>= "1.12"}
16
+
"digestif" {>= "1.2.0"}
17
+
"crypto-rng" {>= "1.0.0"}
18
+
"alcotest" {with-test}
19
+
"crowbar" {with-test}
20
+
"odoc" {with-doc}
21
+
]
22
+
build: [
23
+
["dune" "subst"] {dev}
24
+
[
25
+
"dune"
26
+
"build"
27
+
"-p"
28
+
name
29
+
"-j"
30
+
jobs
31
+
"@install"
32
+
"@runtest" {with-test}
33
+
"@doc" {with-doc}
34
+
]
35
+
]
+3
test/test.ml
+3
test/test.ml
+154
test/test_srp.ml
+154
test/test_srp.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: MIT
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Test basic SRP protocol flow *)
7
+
let test_basic_protocol () =
8
+
let username = "alice" in
9
+
let password = "password123" in
10
+
let salt = Crypto_rng.generate 16 in
11
+
12
+
(* Registration: compute verifier *)
13
+
let verifier = Srp.compute_verifier ~salt ~username ~password in
14
+
15
+
(* Client initiates *)
16
+
let client = Srp.Client.create ~username ~password in
17
+
let big_a = Srp.Client.public_key client in
18
+
19
+
(* Server responds *)
20
+
let server = Srp.Server.create ~username ~salt ~verifier in
21
+
let big_b = Srp.Server.public_key server in
22
+
let server_salt = Srp.Server.salt server in
23
+
24
+
Alcotest.(check string) "salt matches" salt server_salt;
25
+
26
+
(* Both compute session key *)
27
+
let key_c =
28
+
match Srp.Client.compute_session_key client ~salt ~big_b with
29
+
| Ok k -> k
30
+
| Error (`Msg e) -> Alcotest.fail ("Client session key: " ^ e)
31
+
in
32
+
let key_s =
33
+
match Srp.Server.compute_session_key server ~big_a with
34
+
| Ok k -> k
35
+
| Error (`Msg e) -> Alcotest.fail ("Server session key: " ^ e)
36
+
in
37
+
38
+
Alcotest.(check string) "session keys match" key_c key_s;
39
+
Alcotest.(check int)
40
+
"session key is 64 bytes (SHA-512)" 64 (String.length key_c)
41
+
42
+
(* Test client proof verification *)
43
+
let test_proof_exchange () =
44
+
let username = "bob" in
45
+
let password = "secret" in
46
+
let salt = Crypto_rng.generate 16 in
47
+
48
+
let verifier = Srp.compute_verifier ~salt ~username ~password in
49
+
let client = Srp.Client.create ~username ~password in
50
+
let big_a = Srp.Client.public_key client in
51
+
let server = Srp.Server.create ~username ~salt ~verifier in
52
+
let big_b = Srp.Server.public_key server in
53
+
54
+
let key_c =
55
+
match Srp.Client.compute_session_key client ~salt ~big_b with
56
+
| Ok k -> k
57
+
| Error (`Msg e) -> Alcotest.fail e
58
+
in
59
+
let key_s =
60
+
match Srp.Server.compute_session_key server ~big_a with
61
+
| Ok k -> k
62
+
| Error (`Msg e) -> Alcotest.fail e
63
+
in
64
+
65
+
(* Client computes and sends M1 *)
66
+
let m1 = Srp.Client.compute_proof client ~salt ~big_b ~session_key:key_c in
67
+
68
+
(* Server verifies M1 *)
69
+
Alcotest.(check bool)
70
+
"server verifies client proof" true
71
+
(Srp.Server.verify_proof server ~big_a ~m1 ~session_key:key_s);
72
+
73
+
(* Server computes and sends M2 *)
74
+
let m2 = Srp.Server.compute_proof server ~big_a ~m1 ~session_key:key_s in
75
+
76
+
(* Client verifies M2 *)
77
+
Alcotest.(check bool)
78
+
"client verifies server proof" true
79
+
(Srp.Client.verify_proof client ~m1 ~m2 ~session_key:key_c)
80
+
81
+
(* Test wrong password fails *)
82
+
let test_wrong_password () =
83
+
let username = "charlie" in
84
+
let password = "correct" in
85
+
let wrong_password = "incorrect" in
86
+
let salt = Crypto_rng.generate 16 in
87
+
88
+
let verifier = Srp.compute_verifier ~salt ~username ~password in
89
+
let client = Srp.Client.create ~username ~password:wrong_password in
90
+
let big_a = Srp.Client.public_key client in
91
+
let server = Srp.Server.create ~username ~salt ~verifier in
92
+
let big_b = Srp.Server.public_key server in
93
+
94
+
let key_c =
95
+
match Srp.Client.compute_session_key client ~salt ~big_b with
96
+
| Ok k -> k
97
+
| Error (`Msg e) -> Alcotest.fail e
98
+
in
99
+
let key_s =
100
+
match Srp.Server.compute_session_key server ~big_a with
101
+
| Ok k -> k
102
+
| Error (`Msg e) -> Alcotest.fail e
103
+
in
104
+
105
+
(* Keys should NOT match with wrong password *)
106
+
Alcotest.(check bool)
107
+
"session keys differ with wrong password" false (String.equal key_c key_s)
108
+
109
+
(* Test verifier is deterministic *)
110
+
let test_verifier_deterministic () =
111
+
let username = "dave" in
112
+
let password = "mypassword" in
113
+
let salt = "fixed_salt_value" in
114
+
115
+
let v1 = Srp.compute_verifier ~salt ~username ~password in
116
+
let v2 = Srp.compute_verifier ~salt ~username ~password in
117
+
118
+
Alcotest.(check bool) "verifiers are equal" true (Z.equal v1 v2)
119
+
120
+
(* Test different salts produce different verifiers *)
121
+
let test_different_salts () =
122
+
let username = "eve" in
123
+
let password = "samepassword" in
124
+
let salt1 = "salt_one" in
125
+
let salt2 = "salt_two" in
126
+
127
+
let v1 = Srp.compute_verifier ~salt:salt1 ~username ~password in
128
+
let v2 = Srp.compute_verifier ~salt:salt2 ~username ~password in
129
+
130
+
Alcotest.(check bool)
131
+
"different salts produce different verifiers" false (Z.equal v1 v2)
132
+
133
+
(* Test constants are valid *)
134
+
let test_constants () =
135
+
(* N should be a 3072-bit prime *)
136
+
Alcotest.(check int) "N is 3072 bits" 3072 (Z.numbits Srp.n);
137
+
(* g should be 5 *)
138
+
Alcotest.(check bool) "g is 5" true (Z.equal Srp.g (Z.of_int 5))
139
+
140
+
let suite =
141
+
[
142
+
( "Protocol",
143
+
[
144
+
Alcotest.test_case "basic protocol" `Quick test_basic_protocol;
145
+
Alcotest.test_case "proof exchange" `Quick test_proof_exchange;
146
+
Alcotest.test_case "wrong password" `Quick test_wrong_password;
147
+
] );
148
+
( "Verifier",
149
+
[
150
+
Alcotest.test_case "deterministic" `Quick test_verifier_deterministic;
151
+
Alcotest.test_case "salt affects verifier" `Quick test_different_salts;
152
+
] );
153
+
("Constants", [ Alcotest.test_case "valid constants" `Quick test_constants ]);
154
+
]