Read every date format an If-Modified-Since is allowed to carry

CHANGELOG.md

@@ -1,5 +1,14 @@
 # Changelog
 
+## Unreleased
+
+### Fixed
+- **An `If-Modified-Since` in either obsolete date format is understood.** A
+  client sending `Sunday, 06-Nov-94 08:49:37 GMT` or `Sun Nov  6 08:49:37 1994`
+  had its conditional request thrown away and got the whole body back instead
+  of a `304`. A malformed date is now rejected rather than shifted onto a real
+  instant: `31 Feb 1994` used to parse as 3 March.
+
 ## [0.10.0]
 
 ### Added

test/web.carp

@@ -165,6 +165,10 @@
 (defn inm-code [inm etag]
   (conditional-code "GET" etag &(fmt "If-None-Match: %s\r\n" inm)))
 
+; the unix seconds `s` parses to, or -1 for a value the parser rejects
+(defn date-secs [s]
+  (match (web-parse-http-date s) (Maybe.Just v) v (Maybe.Nothing) -1l))
+
 ; the code for a `verb` request carrying `hdrs` against a 200 whose ETag is
 ; "abc" and whose Last-Modified is older than every date used below
 (defn dated-code [verb hdrs]
@@ -1566,6 +1570,32 @@
     (dated-code "PUT" "If-Modified-Since: Fri, 31 Dec 2100 23:59:59 GMT\r\n")
     "If-Modified-Since is ignored on a method other than GET or HEAD")
 
+  ; -- an If-Modified-Since in either obsolete format drives the same 304 --
+  (assert-equal test
+    304
+    (dated-code "GET" "If-Modified-Since: Monday, 31-Dec-68 23:59:59 GMT\r\n")
+    "an rfc850 If-Modified-Since later than Last-Modified returns 304")
+  (assert-equal test
+    304
+    (dated-code "GET" "If-Modified-Since: Fri Dec 31 23:59:59 2100\r\n")
+    "an asctime If-Modified-Since later than Last-Modified returns 304")
+  (assert-equal test
+    200
+    (dated-code "GET" "If-Modified-Since: Wednesday, 01-Jan-97 00:00:00 GMT\r\n")
+    "an rfc850 If-Modified-Since older than Last-Modified returns 200")
+  (assert-equal test
+    200
+    (dated-code "GET" "If-Modified-Since: Thu Jan  1 00:00:00 1970\r\n")
+    "an asctime If-Modified-Since older than Last-Modified returns 200")
+  (assert-equal test
+    200
+    (dated-code "GET" "If-Modified-Since: Fri, 31 Dec 2100 23:59:59 UTC\r\n")
+    "an If-Modified-Since outside GMT is ignored")
+  (assert-equal test
+    200
+    (dated-code "GET" "If-Modified-Since: Fri, 31 Feb 2100 00:00:00 GMT\r\n")
+    "an If-Modified-Since whose day the month does not have is ignored")
+
   ; -- 304 Not Modified on matching ETag --
   (assert-equal test
     304
@@ -1753,14 +1783,74 @@
   ; -- IMF-fixdate parser --
   (assert-equal test
     1445412480l
-    (match (web-parse-http-date "Wed, 21 Oct 2015 07:28:00 GMT")
-      (Maybe.Just s) s
-      (Maybe.Nothing) -1l)
+    (date-secs "Wed, 21 Oct 2015 07:28:00 GMT")
     "parse-http-date inverts the formatter")
   (assert-true test
     (Maybe.nothing? &(web-parse-http-date "not a date"))
     "parse-http-date rejects a malformed value")
 
+  ; -- rfc850 and asctime dates name the same instant as the IMF-fixdate --
+  (assert-equal test
+    1445412480l
+    (date-secs "Wednesday, 21-Oct-15 07:28:00 GMT")
+    "parse-http-date reads an rfc850 date")
+  (assert-equal test
+    1445412480l
+    (date-secs "Wed Oct 21 07:28:00 2015")
+    "parse-http-date reads an asctime date")
+  (assert-equal test
+    784111777l
+    (date-secs "Sun Nov  6 08:49:37 1994")
+    "parse-http-date reads an asctime date whose day is space-padded")
+
+  ; -- the rfc850 two-digit year window --
+  (assert-equal test
+    (date-secs "Wed, 01 Jan 1969 00:00:00 GMT")
+    (date-secs "Wednesday, 01-Jan-69 00:00:00 GMT")
+    "an rfc850 year of 69 is 1969")
+  (assert-equal test
+    (date-secs "Fri, 31 Dec 1999 23:59:59 GMT")
+    (date-secs "Friday, 31-Dec-99 23:59:59 GMT")
+    "an rfc850 year of 99 is 1999")
+  (assert-equal test
+    (date-secs "Sat, 01 Jan 2000 00:00:00 GMT")
+    (date-secs "Saturday, 01-Jan-00 00:00:00 GMT")
+    "an rfc850 year of 00 is 2000")
+  (assert-equal test
+    (date-secs "Sun, 01 Jan 2068 00:00:00 GMT")
+    (date-secs "Sunday, 01-Jan-68 00:00:00 GMT")
+    "an rfc850 year of 68 is 2068")
+
+  ; -- separators, zone and day of the month --
+  (assert-equal test
+    -1l
+    (date-secs "Sun, 06 Nov 1994 08:49:37 UTC")
+    "a date outside GMT is malformed")
+  (assert-equal test
+    -1l
+    (date-secs "Sun; 06 Nov 1994 08:49:37 GMT")
+    "a date whose separator is not a comma is malformed")
+  (assert-equal test
+    -1l
+    (date-secs "Sun, 06 Nov 1994 08:49:37 GMT ")
+    "a date with trailing junk is malformed")
+  (assert-equal test
+    -1l
+    (date-secs "Sun, 06-Nov-94 08:49:37 GMT")
+    "an rfc850 date under an abbreviated day name is malformed")
+  (assert-equal test
+    -1l
+    (date-secs "Sun, 31 Feb 1994 08:49:37 GMT")
+    "a day the month does not have is malformed")
+  (assert-equal test
+    -1l
+    (date-secs "Thu, 29 Feb 1900 08:49:37 GMT")
+    "29 February of a common year is malformed")
+  (assert-equal test
+    951814177l
+    (date-secs "Tue, 29 Feb 2000 08:49:37 GMT")
+    "29 February of a leap year parses")
+
   ; -- Date header --
   (assert-true test
     (Map.contains?

web.carp

@@ -405,28 +405,82 @@ returns whatever `f` returns. If the key is missing, returns `default`.")
             (Long.+ (Long.* (Long.from-int hh) 3600l)
                     (Long.+ (Long.* (Long.from-int mi) 60l) (Long.from-int se))))))
 
-; an RFC 9110 IMF-fixdate string → unix seconds, or Nothing if malformed.
+; True when `bytes` from `off` on is exactly `pat`, where ‘.’ matches any byte.
+(hidden web-date-shaped?)
+(defn web-date-shaped? [bytes off pat]
+  (let-do [p (String.to-bytes pat)
+           ok (= (Array.length bytes) (+ off (Array.length &p)))]
+    (when ok
+      (for [i 0 (Array.length &p)]
+        (let [c @(Array.unsafe-nth &p i)]
+          (when (and (/= c (Char.to-byte \.))
+                     (/= c @(Array.unsafe-nth bytes (+ off i))))
+            (set! ok false)))))
+    ok))
+
+(hidden web-days-in-month)
+(defn web-days-in-month [y m]
+  (cond
+    (= m 2)
+      (if (and (= 0 (mod y 4)) (or (/= 0 (mod y 100)) (= 0 (mod y 400)))) 29 28)
+    (or (= m 4) (or (= m 6) (or (= m 9) (= m 11)))) 30
+    31))
+
+; the conventional rfc850 two-digit year window.
+(hidden web-date-year2)
+(defn web-date-year2 [yy] (cond (< yy 0) -1 (>= yy 69) (+ 1900 yy) (+ 2000 yy)))
+
+(hidden web-date-secs)
+(defn web-date-secs [y mon d hh mi se]
+  (if (or (< y 0)
+          (or (< mon 1)
+              (or (< d 1)
+                  (or (> d (web-days-in-month y mon))
+                      (or (< hh 0)
+                          (or (> hh 23)
+                              (or (< mi 0)
+                                  (or (> mi 59) (or (< se 0) (> se 60))))))))))
+    (Maybe.Nothing)
+    (Maybe.Just (web-epoch-of y mon d hh mi se))))
+
+; an HTTP date in any of the three formats RFC 9110 §5.6.7 obliges a recipient
+; to accept → unix seconds, or Nothing if malformed.
 (hidden web-parse-http-date)
 (defn web-parse-http-date [s]
-  (let [bytes (String.to-bytes s)]
-    (if (< (Array.length &bytes) 29)
-      (Maybe.Nothing)
-      (let [dd (web-date-uint &bytes 5 2)
-            mon (web-date-month &bytes 8)
-            yyyy (web-date-uint &bytes 12 4)
-            hh (web-date-uint &bytes 17 2)
-            mi (web-date-uint &bytes 20 2)
-            se (web-date-uint &bytes 23 2)]
-        (if (or (< dd 1)
-                (or (> dd 31)
-                    (or (< mon 1)
-                        (or (< yyyy 0)
-                            (or (< hh 0)
-                                (or (> hh 23)
-                                    (or (< mi 0)
-                                        (or (> mi 59) (or (< se 0) (> se 60))))))))))
-          (Maybe.Nothing)
-          (Maybe.Just (web-epoch-of yyyy mon dd hh mi se)))))))
+  (let [bytes (String.to-bytes s)
+        comma (String.index-of s \,)]
+    (cond
+      ; IMF-fixdate: Sun, 06 Nov 1994 08:49:37 GMT
+      (= comma 3)
+        (if (web-date-shaped? &bytes 0 "..., .. ... .... ..:..:.. GMT")
+          (web-date-secs (web-date-uint &bytes 12 4)
+                         (web-date-month &bytes 8)
+                         (web-date-uint &bytes 5 2)
+                         (web-date-uint &bytes 17 2)
+                         (web-date-uint &bytes 20 2)
+                         (web-date-uint &bytes 23 2))
+          (Maybe.Nothing))
+      ; rfc850-date: Sunday, 06-Nov-94 08:49:37 GMT
+      (> comma 3)
+        (if (web-date-shaped? &bytes comma ", ..-...-.. ..:..:.. GMT")
+          (web-date-secs (web-date-year2 (web-date-uint &bytes (+ comma 9) 2))
+                         (web-date-month &bytes (+ comma 5))
+                         (web-date-uint &bytes (+ comma 2) 2)
+                         (web-date-uint &bytes (+ comma 12) 2)
+                         (web-date-uint &bytes (+ comma 15) 2)
+                         (web-date-uint &bytes (+ comma 18) 2))
+          (Maybe.Nothing))
+      ; asctime-date: Sun Nov  6 08:49:37 1994
+      (if (web-date-shaped? &bytes 0 "... ... .. ..:..:.. ....")
+        (web-date-secs (web-date-uint &bytes 20 4)
+                       (web-date-month &bytes 4)
+                       (if (= @(Array.unsafe-nth &bytes 8) (Char.to-byte \space))
+                         (web-date-uint &bytes 9 1)
+                         (web-date-uint &bytes 8 2))
+                       (web-date-uint &bytes 11 2)
+                       (web-date-uint &bytes 14 2)
+                       (web-date-uint &bytes 17 2))
+        (Maybe.Nothing)))))
 
 (defmodule Response
   (doc text "creates a 200 OK response with a plain text body.")