Simplify http date parser according to RFC 7231

Before the date has been parsed according to RFC 1123.  However, as
pointed out by issue inhabitedtype#91, RFC 7231 defines a subset of this format
for HTTP dates (IMF-fixdate).  This change simplifies the parser,
assuming the IMF-fixdate format according to RFC 7231.  In violence
to RFC 7231 the legacy RFC 850 and asctime() formats are
intentionally not handled, as before.

Closes inhabitedtype#91

lib/webmachine.ml

@@ -702,7 +702,7 @@ module Make(IO:IO)(Clock:CLOCK) = struct
       match d with
       | None -> self#v3i12
       | Some d' ->
-         match (Util.Date.parse_rfc1123_date d') with
+         match (Util.Date.parse_http_date d') with
          | None -> self#v3i12
          | Some _ -> self#v3h12
 
@@ -714,7 +714,7 @@ module Make(IO:IO)(Clock:CLOCK) = struct
         >>~ fun l_mod ->
         match (u_mod, l_mod) with
         | (Some u_mod', Some l_mod') ->
-           (match (Util.Date.parse_rfc1123_date_exn l_mod') > (Util.Date.parse_rfc1123_date_exn u_mod') with
+           (match (Util.Date.parse_http_date_exn l_mod') > (Util.Date.parse_http_date_exn u_mod') with
            | false -> self#v3i12
            | true -> self#halt 412)
         | (_, _) -> self#v3i12
@@ -807,7 +807,7 @@ module Make(IO:IO)(Clock:CLOCK) = struct
       match (self#get_request_header "if-modified-since") with
       | None -> self#v3m16
       | Some date ->
-         match (Util.Date.parse_rfc1123_date date) with
+         match (Util.Date.parse_http_date date) with
          | Some _ -> self#v3l15
          | None ->  self#v3m16
 
@@ -817,7 +817,7 @@ module Make(IO:IO)(Clock:CLOCK) = struct
       match (self#get_request_header "if-modified-since") with
       | None -> self#v3l17
       | Some date ->
-         match (Util.Date.parse_rfc1123_date date) with
+         match (Util.Date.parse_http_date date) with
          | None -> self#v3l17
          | Some d -> match (d > now) with
                      | true -> self#v3m16
@@ -831,7 +831,7 @@ module Make(IO:IO)(Clock:CLOCK) = struct
         >>~ fun l_mod ->
             match (u_mod, l_mod) with
             | (Some l_mod', Some u_mod') ->
-               (match (Util.Date.parse_rfc1123_date_exn l_mod') > (Util.Date.parse_rfc1123_date_exn u_mod') with
+               (match (Util.Date.parse_http_date_exn l_mod') > (Util.Date.parse_http_date_exn u_mod') with
                 | true -> self#v3m16
                 | false -> self#halt 304)
             | (_, _) -> self#halt 304

lib/wm_util.ml

@@ -112,31 +112,21 @@ module MediaType = struct
 end
 
 module Date = struct
-  let parse_rfc1123_date_exn s =
-    try Scanf.sscanf s "%3s, %d %s %4d %d:%d:%d %s" (
-      fun _wday mday mon year hour min sec tz ->
+  let parse_http_date_exn s =
+    try Scanf.sscanf s "%3s, %2u %3s %4u %2u:%2u:%2u GMT%!" (
+      fun _wday mday mon year hour min sec ->
         let months = [
           "Jan", 1; "Feb", 2; "Mar", 3; "Apr", 4; "May", 5; "Jun", 6;
           "Jul", 7; "Aug", 8; "Sep", 9; "Oct", 10; "Nov", 11; "Dec", 12
         ] in
-        let parse_tz = function
-          | "" | "Z" | "GMT" | "UTC" | "UT" -> 0
-          | "PST" -> -480
-          | "MST" | "PDT" -> -420
-          | "CST" | "MDT" -> -360
-          | "EST" | "CDT" -> -300
-          | "EDT" -> -240
-          | s -> Scanf.sscanf s "%c%02d%_[:]%02d" (fun sign hour min ->
-              min + hour * (if sign = '-' then -60 else 60))
-        in
         let mon = List.assoc mon months in
         let year =
           if year < 50 then year + 2000
           else if year < 1000 then year + 1900
           else year
         in
         let date = (year, mon, mday) in
-        let time = ((hour, min, sec), (parse_tz tz)*60) in
+        let time = ((hour, min, sec), 0) in
         let ptime = Ptime.of_date_time (date, time) in
         match ptime with
           | None -> raise (Invalid_argument "Invalid date string")
@@ -149,7 +139,7 @@ module Date = struct
       | Scanf.Scan_failure e -> raise (Invalid_argument e)
       | Not_found -> raise (Invalid_argument "Invalid date string")
 
-  let parse_rfc1123_date s =
-    try (Some (parse_rfc1123_date_exn s)) with
+  let parse_http_date s =
+    try (Some (parse_http_date_exn s)) with
     | Invalid_argument _ -> None
 end