anil.recoil.org
A batteries included HTTP/1.1 client in OCaml
-cohttp
+3
-3
lib/body.ml
+3
-3
lib/body.ml
···
203
203
let ops = Eio.Flow.Pi.source (module Strings_source) in
204
204
(t, Eio.Resource.T (t, ops))
205
205
206
-
let to_cohttp_body ~sw = function
206
+
let to_flow_source ~sw = function
207
207
| Empty -> None
208
-
| String { content; _ } -> Some (Cohttp_eio.Body.of_string content)
208
+
| String { content; _ } -> Some (Eio.Flow.string_source content)
209
209
| Stream { source; _ } -> Some source
210
210
| File { file; _ } ->
211
211
(* Open file and stream it directly without loading into memory *)
···
263
263
264
264
(* Private module *)
265
265
module Private = struct
266
-
let to_cohttp_body = to_cohttp_body
266
+
let to_flow_source = to_flow_source
267
267
268
268
let to_string = function
269
269
| Empty -> ""
+2
-2
lib/body.mli
+2
-2
lib/body.mli
···
137
137
(** Internal functions exposed for use by other modules in the library.
138
138
These are not part of the public API and may change between versions. *)
139
139
module Private : sig
140
-
val to_cohttp_body : sw:Eio.Switch.t -> t -> Cohttp_eio.Body.t option
141
-
(** [to_cohttp_body ~sw body] converts the body to cohttp-eio format.
140
+
val to_flow_source : sw:Eio.Switch.t -> t -> Eio.Flow.source_ty Eio.Resource.t option
141
+
(** [to_flow_source ~sw body] converts the body to an Eio flow source.
142
142
Uses the switch to manage resources like file handles.
143
143
This function is used internally by the Client module. *)
144
144
-291
lib/digest_auth.ml
-291
lib/digest_auth.ml
···
1
-
(** RFC 2617 HTTP Digest Authentication implementation *)
2
-
3
-
module Log = (val Logs.src_log (Logs.Src.create "requests.digest_auth" ~doc:"HTTP Digest Authentication") : Logs.LOG)
4
-
5
-
(** Digest auth challenge parameters from WWW-Authenticate header *)
6
-
type challenge = {
7
-
realm : string;
8
-
domain : string option;
9
-
nonce : string;
10
-
opaque : string option;
11
-
stale : bool;
12
-
algorithm : [`MD5 | `MD5_sess | `SHA256 | `SHA256_sess];
13
-
qop : [`Auth | `Auth_int] list option; (* quality of protection *)
14
-
charset : string option;
15
-
userhash : bool;
16
-
}
17
-
18
-
(** Client's chosen parameters for response *)
19
-
type client_data = {
20
-
username : string;
21
-
password : string;
22
-
nc : int; (* nonce count *)
23
-
cnonce : string; (* client nonce *)
24
-
qop_chosen : [`Auth | `Auth_int] option;
25
-
}
26
-
27
-
(** Parse WWW-Authenticate header for Digest challenge *)
28
-
let parse_challenge header_value =
29
-
(* Remove "Digest " prefix if present *)
30
-
let value =
31
-
if String.starts_with ~prefix:"Digest " header_value then
32
-
String.sub header_value 7 (String.length header_value - 7)
33
-
else header_value
34
-
in
35
-
36
-
(* Parse comma-separated key=value pairs *)
37
-
let parse_params str =
38
-
let rec parse_one pos acc =
39
-
if pos >= String.length str then acc
40
-
else
41
-
(* Skip whitespace *)
42
-
let pos = ref pos in
43
-
while !pos < String.length str && str.[!pos] = ' ' do incr pos done;
44
-
if !pos >= String.length str then acc
45
-
else
46
-
(* Find key *)
47
-
let key_start = !pos in
48
-
while !pos < String.length str && str.[!pos] <> '=' do incr pos done;
49
-
if !pos >= String.length str then acc
50
-
else
51
-
let key = String.trim (String.sub str key_start (!pos - key_start)) in
52
-
incr pos; (* Skip '=' *)
53
-
54
-
(* Parse value - may be quoted *)
55
-
let value, next_pos =
56
-
if !pos < String.length str && str.[!pos] = '"' then begin
57
-
(* Quoted value *)
58
-
incr pos;
59
-
let value_start = !pos in
60
-
while !pos < String.length str && str.[!pos] <> '"' do
61
-
if str.[!pos] = '\\' && !pos + 1 < String.length str then
62
-
pos := !pos + 2 (* Skip escaped character *)
63
-
else
64
-
incr pos
65
-
done;
66
-
let value = String.sub str value_start (!pos - value_start) in
67
-
if !pos < String.length str then incr pos; (* Skip closing quote *)
68
-
(* Skip to next comma *)
69
-
while !pos < String.length str && str.[!pos] <> ',' do incr pos done;
70
-
if !pos < String.length str then incr pos; (* Skip comma *)
71
-
(value, !pos)
72
-
end else begin
73
-
(* Unquoted value *)
74
-
let value_start = !pos in
75
-
while !pos < String.length str && str.[!pos] <> ',' do incr pos done;
76
-
let value = String.trim (String.sub str value_start (!pos - value_start)) in
77
-
if !pos < String.length str then incr pos; (* Skip comma *)
78
-
(value, !pos)
79
-
end
80
-
in
81
-
parse_one next_pos ((key, value) :: acc)
82
-
in
83
-
List.rev (parse_one 0 [])
84
-
in
85
-
86
-
let params = parse_params value in
87
-
88
-
(* Extract required and optional parameters *)
89
-
let get_param name = List.assoc_opt name params in
90
-
let get_param_req name =
91
-
match get_param name with
92
-
| Some v -> v
93
-
| None -> failwith (Printf.sprintf "Missing required Digest parameter: %s" name)
94
-
in
95
-
96
-
try
97
-
let realm = get_param_req "realm" in
98
-
let nonce = get_param_req "nonce" in
99
-
100
-
let algorithm = match get_param "algorithm" with
101
-
| Some "MD5" | None -> `MD5
102
-
| Some "MD5-sess" -> `MD5_sess
103
-
| Some "SHA-256" -> `SHA256
104
-
| Some "SHA-256-sess" -> `SHA256_sess
105
-
| Some a ->
106
-
Log.warn (fun m -> m "Unknown digest algorithm: %s, using MD5" a);
107
-
`MD5
108
-
in
109
-
110
-
let qop = match get_param "qop" with
111
-
| None -> None
112
-
| Some qop_str ->
113
-
let qops = String.split_on_char ',' qop_str |> List.map String.trim in
114
-
Some (List.filter_map (function
115
-
| "auth" -> Some `Auth
116
-
| "auth-int" -> Some `Auth_int
117
-
| _ -> None
118
-
) qops)
119
-
in
120
-
121
-
Some {
122
-
realm;
123
-
domain = get_param "domain";
124
-
nonce;
125
-
opaque = get_param "opaque";
126
-
stale = (match get_param "stale" with
127
-
| Some "true" | Some "TRUE" -> true
128
-
| _ -> false);
129
-
algorithm;
130
-
qop;
131
-
charset = get_param "charset";
132
-
userhash = (match get_param "userhash" with
133
-
| Some "true" | Some "TRUE" -> true
134
-
| _ -> false);
135
-
}
136
-
with
137
-
| Failure msg ->
138
-
Log.warn (fun m -> m "Failed to parse Digest challenge: %s" msg);
139
-
None
140
-
| Not_found -> None
141
-
142
-
(** Generate client nonce *)
143
-
let generate_cnonce () =
144
-
let rand_bytes = Mirage_crypto_rng.generate 16 in
145
-
Base64.encode_string rand_bytes
146
-
147
-
(** Hash function based on algorithm *)
148
-
let hash_function = function
149
-
| `MD5 | `MD5_sess ->
150
-
fun s -> Digestif.MD5.(to_hex (digest_string s))
151
-
| `SHA256 | `SHA256_sess ->
152
-
fun s -> Digestif.SHA256.(to_hex (digest_string s))
153
-
154
-
(** Calculate H(A1) according to RFC 2617 *)
155
-
let calculate_ha1 ~algorithm ~username ~realm ~password ~nonce ~cnonce =
156
-
let hash = hash_function algorithm in
157
-
match algorithm with
158
-
| `MD5 | `SHA256 ->
159
-
hash (Printf.sprintf "%s:%s:%s" username realm password)
160
-
| `MD5_sess | `SHA256_sess ->
161
-
let ha1_base = hash (Printf.sprintf "%s:%s:%s" username realm password) in
162
-
hash (Printf.sprintf "%s:%s:%s" ha1_base nonce cnonce)
163
-
164
-
(** Calculate H(A2) according to RFC 2617 *)
165
-
let calculate_ha2 ~algorithm ~meth ~uri ~qop ~body =
166
-
let hash = hash_function algorithm in
167
-
let method_str = match meth with
168
-
| `GET -> "GET" | `POST -> "POST" | `PUT -> "PUT"
169
-
| `DELETE -> "DELETE" | `HEAD -> "HEAD" | `OPTIONS -> "OPTIONS"
170
-
| `PATCH -> "PATCH" | `TRACE -> "TRACE" | `CONNECT -> "CONNECT"
171
-
| `Other s -> s
172
-
in
173
-
match qop with
174
-
| None | Some `Auth ->
175
-
hash (Printf.sprintf "%s:%s" method_str (Uri.path_and_query uri))
176
-
| Some `Auth_int ->
177
-
(* For auth-int, include hash of entity body *)
178
-
let body_hash = match body with
179
-
| None -> hash ""
180
-
| Some b -> hash b
181
-
in
182
-
hash (Printf.sprintf "%s:%s:%s" method_str (Uri.path_and_query uri) body_hash)
183
-
184
-
(** Calculate the response hash *)
185
-
let calculate_response ~ha1 ~ha2 ~nonce ~nc ~cnonce ~qop =
186
-
let hash = hash_function `MD5 in (* Response always uses the same hash as HA1 *)
187
-
match qop with
188
-
| None ->
189
-
hash (Printf.sprintf "%s:%s:%s" ha1 nonce ha2)
190
-
| Some qop_value ->
191
-
let qop_str = match qop_value with
192
-
| `Auth -> "auth"
193
-
| `Auth_int -> "auth-int"
194
-
in
195
-
let nc_str = Printf.sprintf "%08x" nc in
196
-
hash (Printf.sprintf "%s:%s:%s:%s:%s:%s" ha1 nonce nc_str cnonce qop_str ha2)
197
-
198
-
(** Generate Authorization header value for Digest auth *)
199
-
let generate_auth_header ~challenge ~client_data ~meth ~uri ~body =
200
-
let { username; password; nc; cnonce; qop_chosen } = client_data in
201
-
let { realm; nonce; opaque; algorithm; _ } = challenge in
202
-
203
-
(* Calculate hashes *)
204
-
let ha1 = calculate_ha1 ~algorithm ~username ~realm ~password ~nonce ~cnonce in
205
-
let ha2 = calculate_ha2 ~algorithm ~meth ~uri ~qop:qop_chosen ~body in
206
-
let response = calculate_response ~ha1 ~ha2 ~nonce ~nc ~cnonce ~qop:qop_chosen in
207
-
208
-
(* Build Authorization header *)
209
-
let params = [
210
-
("username", Printf.sprintf "\"%s\"" username);
211
-
("realm", Printf.sprintf "\"%s\"" realm);
212
-
("nonce", Printf.sprintf "\"%s\"" nonce);
213
-
("uri", Printf.sprintf "\"%s\"" (Uri.path_and_query uri));
214
-
("response", Printf.sprintf "\"%s\"" response);
215
-
] in
216
-
217
-
let params = match algorithm with
218
-
| `MD5 -> params (* MD5 is default, don't need to specify *)
219
-
| `MD5_sess -> ("algorithm", "MD5-sess") :: params
220
-
| `SHA256 -> ("algorithm", "SHA-256") :: params
221
-
| `SHA256_sess -> ("algorithm", "SHA-256-sess") :: params
222
-
in
223
-
224
-
let params = match opaque with
225
-
| Some o -> ("opaque", Printf.sprintf "\"%s\"" o) :: params
226
-
| None -> params
227
-
in
228
-
229
-
let params = match qop_chosen with
230
-
| None -> params
231
-
| Some qop ->
232
-
let qop_str = match qop with `Auth -> "auth" | `Auth_int -> "auth-int" in
233
-
let nc_str = Printf.sprintf "%08x" nc in
234
-
("qop", qop_str) ::
235
-
("nc", nc_str) ::
236
-
("cnonce", Printf.sprintf "\"%s\"" cnonce) ::
237
-
params
238
-
in
239
-
240
-
"Digest " ^ String.concat ", " (List.map (fun (k, v) -> k ^ "=" ^ v) params)
241
-
242
-
(** Nonce counter storage - in production should be persistent *)
243
-
module NonceCounter = struct
244
-
let table = Hashtbl.create 16
245
-
246
-
let get_and_increment ~nonce =
247
-
let current = try Hashtbl.find table nonce with Not_found -> 0 in
248
-
Hashtbl.replace table nonce (current + 1);
249
-
current + 1
250
-
251
-
let reset ~nonce =
252
-
Hashtbl.remove table nonce
253
-
end
254
-
255
-
(** Apply Digest authentication to a request *)
256
-
let apply_digest_auth ~username ~password ~meth ~uri ~headers ~body ~challenge_header =
257
-
match parse_challenge challenge_header with
258
-
| None ->
259
-
Log.warn (fun m -> m "Failed to parse Digest challenge");
260
-
headers
261
-
| Some challenge ->
262
-
(* Choose QOP if server offers options *)
263
-
let qop_chosen = match challenge.qop with
264
-
| None -> None
265
-
| Some qops ->
266
-
(* Prefer auth over auth-int for simplicity *)
267
-
if List.mem `Auth qops then Some `Auth
268
-
else if List.mem `Auth_int qops then Some `Auth_int
269
-
else None
270
-
in
271
-
272
-
(* Get or generate client nonce *)
273
-
let cnonce = generate_cnonce () in
274
-
275
-
(* Get and increment nonce counter *)
276
-
let nc = NonceCounter.get_and_increment ~nonce:challenge.nonce in
277
-
278
-
let client_data = { username; password; nc; cnonce; qop_chosen } in
279
-
let auth_value = generate_auth_header ~challenge ~client_data ~meth ~uri ~body in
280
-
281
-
Cohttp.Header.add headers "Authorization" auth_value
282
-
283
-
(** Check if a response requires digest auth *)
284
-
let is_digest_challenge response =
285
-
let status = Cohttp.Response.status response in
286
-
match Cohttp.Code.code_of_status status with
287
-
| 401 ->
288
-
(match Cohttp.Header.get (Cohttp.Response.headers response) "www-authenticate" with
289
-
| Some header when String.starts_with ~prefix:"Digest" header -> Some header
290
-
| _ -> None)
291
-
| _ -> None