From 6f25c632f17313270a1c5a912e24bd59882bb8c1 Mon Sep 17 00:00:00 2001
From: craff <christophe@raffalli.eu>
Date: Sun, 19 Dec 2021 20:59:43 -1000
Subject: [PATCH] Use Unix.tm for date

---
 src/Tiny_httpd.ml       | 17 +++++++++--------
 src/Tiny_httpd.mli      |  3 +--
 src/Tiny_httpd_util.ml  | 30 ++++++++++++++++++++++++++++++
 src/Tiny_httpd_util.mli |  6 ++++++
 4 files changed, 46 insertions(+), 10 deletions(-)

diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml
index 31112dc5..e41bb429 100644
--- a/src/Tiny_httpd.ml
+++ b/src/Tiny_httpd.ml
@@ -1,3 +1,5 @@
+module U = Tiny_httpd_util
+
 type byte_stream = {
   bs_fill_buf: unit -> (bytes * int * int);
   bs_consume: int -> unit;
@@ -380,8 +382,7 @@ module SetCookie = struct
   type sameSite = Strict | Lax | None
   type t =
     | MaxAge of int
-    | Expires of string (** FIXME: format date, but need computation
-                            of days of week *)
+    | Expires of Unix.tm
     | Domain of string
     | Path of string
     | Secure
@@ -390,7 +391,7 @@ module SetCookie = struct
 
   let pp fmt = function
     | MaxAge s -> Format.fprintf fmt "Max-Age=%d" s
-    | Expires d -> Format.fprintf fmt "Expires=%s" d
+    | Expires d -> Format.fprintf fmt "Expires=%a" U.pp_date d
     | Domain d -> Format.fprintf fmt "Domain=%s" d
     | Path p -> Format.fprintf fmt "Path=%s" p
     | Secure -> Format.fprintf fmt "Secure"
@@ -566,10 +567,10 @@ module Request = struct
         | None -> bad_reqf 400 "No 'Host' header in request"
         | Some h -> h
       in
-      let path_components, query = Tiny_httpd_util.split_query path in
-      let path_components = Tiny_httpd_util.split_on_slash path_components in
+      let path_components, query = U.split_query path in
+      let path_components = U.split_on_slash path_components in
       let query =
-        match Tiny_httpd_util.(parse_query query) with
+        match U.(parse_query query) with
         | Ok l -> l
         | Error e -> bad_reqf 400 "invalid query: %s" e
       in
@@ -819,7 +820,7 @@ module Route = struct
         let whole_path = String.concat "/" path in
         begin match
             if url_encoded
-            then match Tiny_httpd_util.percent_decode whole_path with
+            then match U.percent_decode whole_path with
               | Some s -> s
               | None -> raise_notrace Exit
             else whole_path
@@ -838,7 +839,7 @@ module Route = struct
           | String ->
             eval path' route' (f c1)
           | String_urlencoded ->
-            begin match Tiny_httpd_util.percent_decode c1 with
+            begin match U.percent_decode c1 with
               | None -> None
               | Some s -> eval path' route' (f s)
             end
diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli
index 31a9cd76..fb74acfe 100644
--- a/src/Tiny_httpd.mli
+++ b/src/Tiny_httpd.mli
@@ -221,8 +221,7 @@ module SetCookie : sig
   type sameSite = Strict | Lax | None
   type t =
     | MaxAge of int
-    | Expires of string (** FIXME: format date, but need computation
-                            of days of week *)
+    | Expires of Unix.tm (** assume UTC/GMT *)
     | Domain of string
     | Path of string
     | Secure
diff --git a/src/Tiny_httpd_util.ml b/src/Tiny_httpd_util.ml
index 2e614c91..703bc329 100644
--- a/src/Tiny_httpd_util.ml
+++ b/src/Tiny_httpd_util.ml
@@ -161,3 +161,33 @@ let parse_query s : (_ list, string) result=
             (List.map (fun (x,y) -> percent_encode x ^"="^percent_encode y) l) in
         eq_sorted (Ok l) (parse_query s))
 *)
+
+let pp_date fmt date =
+  let open Unix in
+  let day = match date.tm_wday with
+    | 0 -> "Sun"
+    | 1 -> "Mon"
+    | 2 -> "Tue"
+    | 3 -> "Wed"
+    | 4 -> "Thu"
+    | 5 -> "Fri"
+    | 6 -> "Sat"
+    | _ -> invalid_arg "print_date"
+  in
+  let month = match date.tm_mon with
+    | 0 -> "Jan"
+    | 1 -> "Feb"
+    | 2 -> "Mar"
+    | 3 -> "Apr"
+    | 4 -> "May"
+    | 5 -> "Jun"
+    | 6 -> "Jul"
+    | 7 -> "Aug"
+    | 8 -> "Sep"
+    | 9 -> "Oct"
+    |10 -> "Nov"
+    |11 -> "Dec"
+    | _ -> invalid_arg "print_date"
+  in
+  Format.fprintf fmt "%s, %02d %s %04d %02d:%02d:%02d GMT"
+    day date.tm_mday month (date.tm_year+1900) date.tm_hour date.tm_min date.tm_sec
diff --git a/src/Tiny_httpd_util.mli b/src/Tiny_httpd_util.mli
index 025d6519..d53ae32e 100644
--- a/src/Tiny_httpd_util.mli
+++ b/src/Tiny_httpd_util.mli
@@ -34,3 +34,9 @@ val parse_query : string -> ((string*string) list, string) result
     The order might not be preserved.
     @since 0.3
 *)
+
+val pp_date : Format.formatter -> Unix.tm -> unit
+(** Print date (given in GMT) in the expected format for http (for instance
+    for expiration date of cookies.
+    @since 0.12
+*)