jon.recoil.org
forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** HTTP-date parsing per RFC 9110 Section 5.6.7 *)
7
8let src = Logs.Src.create "requests.http_date" ~doc:"HTTP Date Parsing"
9module Log = (val Logs.src_log src : Logs.LOG)
10
11(** Parse HTTP-date (RFC 9110 Section 5.6.7) to Ptime.t *)
12let parse s =
13 (* HTTP-date format: "Sun, 06 Nov 1994 08:49:37 GMT" (RFC 1123) *)
14 (* Also supports obsolete formats per RFC 9110 *)
15 let s = String.trim s in
16
17 (* Helper to parse month name *)
18 let parse_month month_str =
19 match String.lowercase_ascii month_str with
20 | "jan" -> 1 | "feb" -> 2 | "mar" -> 3 | "apr" -> 4
21 | "may" -> 5 | "jun" -> 6 | "jul" -> 7 | "aug" -> 8
22 | "sep" -> 9 | "oct" -> 10 | "nov" -> 11 | "dec" -> 12
23 | _ -> failwith "invalid month"
24 in
25
26 (* Try different date formats in order of preference *)
27 let parsers = [
28 (* RFC 1123 format: "Sun, 06 Nov 1994 08:49:37 GMT" *)
29 (fun () ->
30 Scanf.sscanf s "%_s %d %s %d %d:%d:%d GMT"
31 (fun day month_str year hour min sec ->
32 let month = parse_month month_str in
33 Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0))));
34
35 (* RFC 850 format: "Sunday, 06-Nov-94 08:49:37 GMT" *)
36 (fun () ->
37 Scanf.sscanf s "%_s %d-%s@-%d %d:%d:%d GMT"
38 (fun day month_str year2 hour min sec ->
39 let year = if year2 >= 70 then 1900 + year2 else 2000 + year2 in
40 let month = parse_month month_str in
41 Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0))));
42
43 (* ANSI C asctime() format: "Sun Nov 6 08:49:37 1994" *)
44 (fun () ->
45 Scanf.sscanf s "%_s %s %d %d:%d:%d %d"
46 (fun month_str day hour min sec year ->
47 let month = parse_month month_str in
48 Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0))));
49 ] in
50
51 (* Try each parser until one succeeds *)
52 List.find_map (fun parser ->
53 try parser () with _ -> None
54 ) parsers