1:- module(http_date, 2 [decode/2, 3 encode/2, 4 is_imf_fixdate/1, 5 is_rfc850/1, 6 is_asctime/1, 7 valid_date/1, 8 valid_time/1, 9 valid_http_date/1, 10 consistent_dayname/1, 11 strict_http_date/1, 12 http_date_stamp/2, 13 stamp_http_date/3, 14 http_date//2]). 15 16day(mon, 1, `Mon`, `Monday`). 17day(tue, 2, `Tue`, `Tuesday`). 18day(wed, 3, `Wed`, `Wednesday`). 19day(thu, 4, `Thu`, `Thursday`). 20day(fri, 5, `Fri`, `Friday`). 21day(sat, 6, `Sat`, `Saturday`). 22day(sun, 7, `Sun`, `Sunday`). 23 24month(1, `Jan`, 31). 25month(2, `Feb`, 28). 26month(3, `Mar`, 31). 27month(4, `Apr`, 30). 28month(5, `May`, 31). 29month(6, `Jun`, 30). 30month(7, `Jul`, 31). 31month(8, `Aug`, 31). 32month(9, `Sep`, 30). 33month(10, `Oct`, 31). 34month(11, `Nov`, 30). 35month(12, `Dec`, 31). 36 37leap_year(Y) :- 38 0 is Y mod 4, 39 ( 0 is Y mod 100 -> 0 is Y mod 400 ; true ). 40 41days_in_month(Y, M, N) :- 42 month(M, _, N0), 43 ( M =:= 2, leap_year(Y) -> N is N0 + 1 ; N = N0 ). 44 45literal([]) --> []. 46literal([C|Cs]) --> [C], literal(Cs). 47 48day_name(D, short) --> { day(D, _, Cs, _) }, literal(Cs). 49day_name(D, long) --> { day(D, _, _, Cs) }, literal(Cs). 50 51month_name(M) --> { month(M, Cs, _) }, literal(Cs). 52 53ndigits(0, []) --> []. 54ndigits(N, [C|Cs]) --> 55 { N > 0, N0 is N - 1 }, 56 [C], 57 { code_type(C, digit) }, 58 ndigits(N0, Cs). 59 60digits(N, V) --> { var(V) }, !, ndigits(N, Cs), { number_codes(V, Cs) }. 61digits(N, V) --> { format(codes(Cs), '~|~`0t~d~*|', [V, N]) }, ndigits(N, Cs). 62 63time(time(H, Mi, S)) --> 64 digits(2, H), `:`, digits(2, Mi), `:`, digits(2, S). 65 66asctime_day(D) --> ` `, digits(1, D), { D < 10 }. 67asctime_day(D) --> digits(2, D). 68 69date1(date(Y, M, D)) --> 70 digits(2, D), ` `, month_name(M), ` `, digits(4, Y). 71 72date2(date(Y, M, D)) --> 73 digits(2, D), `-`, month_name(M), `-`, digits(2, Y). 74 75http_date(imf_fixdate, datetime(Day, Date, Time)) --> 76 day_name(Day, short), `, `, date1(Date), ` `, time(Time), ` GMT`. 77 78http_date(rfc850, datetime(Day, Date, Time)) --> 79 day_name(Day, long), `, `, date2(Date), ` `, time(Time), ` GMT`. 80 81http_date(asctime, datetime(Day, date(Y, M, D), Time)) --> 82 day_name(Day, short), ` `, month_name(M), ` `, asctime_day(D), ` `, 83 time(Time), ` `, digits(4, Y).
86decode(Text, http_date(Format, DateTime)) :- 87 string_codes(Text, Codes), 88 once(phrase(http_date(Format, DateTime), Codes)). 89 90encode(http_date(Format, DateTime), Text) :- 91 once(phrase(http_date(Format, DateTime), Codes)), 92 string_codes(Text, Codes). 93 94is_imf_fixdate(http_date(imf_fixdate, _)). 95is_rfc850(http_date(rfc850, _)). 96is_asctime(http_date(asctime, _)). 97 98valid_date(date(Y, M, D)) :- 99 between(0, 9999, Y), 100 days_in_month(Y, M, Max), 101 between(1, Max, D). 102 103valid_time(time(H, Mi, S)) :- 104 between(0, 23, H), 105 between(0, 59, Mi), 106 between(0, 59, S). 107 108valid_http_date(http_date(_, datetime(_, Date, Time))) :- 109 valid_date(Date), 110 valid_time(Time). 111 112consistent_dayname(http_date(_, datetime(Day, date(Y, M, D), _))) :- 113 day_of_the_week(date(Y, M, D), N), 114 day(Day, N, _, _). 115 116strict_http_date(http_date(Format, DateTime)) :- 117 valid_http_date(http_date(Format, DateTime)), 118 ( Format == rfc850 -> true 119 ; consistent_dayname(http_date(Format, DateTime)) 120 ). 121 122http_date_stamp(http_date(_, datetime(_, date(Y, M, D), time(H, Mi, S))), Stamp) :- 123 date_time_stamp(date(Y, M, D, H, Mi, S, 0, -, -), Stamp). 124 125stamp_http_date(Stamp, Format, http_date(Format, datetime(Day, date(Y, M, D), time(H, Mi, S)))) :- 126 stamp_date_time(Stamp, date(Y, M, D, H, Mi, Sf, _, _, _), 0), 127 S is truncate(Sf), 128 day_of_the_week(date(Y, M, D), N), 129 day(Day, N, _, _). 130 131:- begin_tests(http_date). 132 133test(imf) :- 134 decode("Sun, 06 Nov 1994 08:49:37 GMT", D), 135 assertion(D == http_date(imf_fixdate, datetime(sun, date(1994,11,6), time(8,49,37)))). 136 137test(rfc850) :- 138 decode("Sunday, 06-Nov-94 08:49:37 GMT", D), 139 assertion(D == http_date(rfc850, datetime(sun, date(94,11,6), time(8,49,37)))). 140 141test(asctime_padded) :- 142 decode("Sun Nov 6 08:49:37 1994", D), 143 assertion(D == http_date(asctime, datetime(sun, date(1994,11,6), time(8,49,37)))). 144 145test(asctime_two_digit) :- 146 decode("Wed Nov 16 08:49:37 1994", D), 147 assertion(D == http_date(asctime, datetime(wed, date(1994,11,16), time(8,49,37)))). 148 149test(trailing_data, [fail]) :- decode("Sun, 06 Nov 1994 08:49:37 GMTx", _). 150test(garbage, [fail]) :- decode("not a date", _). 151test(feb_31_rejected, [fail]) :- decode("Sun, 31 Feb 1994 08:49:37 GMT", D), valid_http_date(D). 152test(feb_29_leap) :- decode("Tue, 29 Feb 2000 08:49:37 GMT", D), valid_http_date(D). 153test(feb_29_century_not_leap, [fail]) :- decode("Thu, 29 Feb 1900 08:49:37 GMT", D), valid_http_date(D). 154test(dayname_matches) :- decode("Sun, 06 Nov 1994 08:49:37 GMT", D), consistent_dayname(D). 155test(dayname_mismatch, [fail]) :- decode("Mon, 06 Nov 1994 08:49:37 GMT", D), consistent_dayname(D). 156test(leap_years, [forall(member(Y-Is, [1992-true, 1900-false, 2000-true, 1994-false]))]) :- 157 (leap_year(Y) -> Got = true ; Got = false), 158 assertion(Got == Is). 159test(time_out_of_range, 160 [forall(member(S, ["Sun, 06 Nov 1994 25:49:37 GMT", 161 "Sun, 06 Nov 1994 08:99:37 GMT", 162 "Sun, 06 Nov 1994 08:49:99 GMT"])), 163 fail]) :- 164 decode(S, D), 165 valid_http_date(D). 166test(time_out_of_range_still_parses, 167 [forall(member(S, ["Sun, 06 Nov 1994 25:49:37 GMT", 168 "Sun, 06 Nov 1994 08:99:37 GMT", 169 "Sun, 06 Nov 1994 08:49:99 GMT"]))]) :- 170 decode(S, _). 171 172test(rfc850_rejects_four_digit_year, [fail]) :- 173 encode(http_date(rfc850, datetime(sun, date(1994,11,6), time(8,49,37))), _). 174 175test(roundtrip, [forall(member(S, ["Sun, 06 Nov 1994 08:49:37 GMT", 176 "Sunday, 06-Nov-94 08:49:37 GMT", 177 "Sun Nov 6 08:49:37 1994", 178 "Wed Nov 16 08:49:37 1994"]))]) :- 179 decode(S, D), encode(D, S2), assertion(S2 == S). 180 181test(asctime_zero_padded_day_normalize) :- 182 decode("Sun Nov 06 08:49:37 1994", D), 183 encode(D, S), 184 assertion(S == "Sun Nov 6 08:49:37 1994"). 185 186test(every_day_and_month, [forall((day(Day,_,_,_), month(M,_,_)))]) :- 187 Date = http_date(imf_fixdate, datetime(Day, date(1994, M, 6), time(8,49,37))), 188 encode(Date, S), decode(S, Back), assertion(Back == Date). 189 190test(strict_checks_dayname_for_imf) :- 191 strict_http_date(http_date(imf_fixdate, datetime(sun, date(1994,11,6), time(8,49,37)))). 192 193test(strict_rejects_wrong_dayname_for_imf, [fail]) :- 194 strict_http_date(http_date(imf_fixdate, datetime(mon, date(1994,11,6), time(8,49,37)))). 195 196test(strict_skips_dayname_for_rfc850_two_digit_year) :- 197 strict_http_date(http_date(rfc850, datetime(mon, date(94,11,6), time(8,49,37)))). 198 199test(stamp_epoch) :- 200 stamp_http_date(0, imf_fixdate, D), 201 assertion(D == http_date(imf_fixdate, datetime(thu, date(1970,1,1), time(0,0,0)))). 202 203test(stamp_from_known_date) :- 204 decode("Sun, 06 Nov 1994 08:49:37 GMT", D), 205 http_date_stamp(D, Stamp), 206 assertion(Stamp =:= 784111777.0). 207 208test(long_dayname_not_imf, [fail]) :- decode("Sunday, 06 Nov 1994 08:49:37 GMT", _). 209test(short_dayname_not_rfc850, [fail]) :- decode("Sun, 06-Nov-94 08:49:37 GMT", _). 210 211test(format_predicate_accepts_own_format, 212 [forall( member(Format-Check, [imf_fixdate-is_imf_fixdate, 213 rfc850-is_rfc850, 214 asctime-is_asctime]))]) :- 215 call(Check, http_date(Format, datetime(sun, date(1994,11,6), time(8,49,37)))). 216 217test(format_predicate_rejects_other_formats, 218[forall(( member(Format-Check, [imf_fixdate-is_imf_fixdate, 219 rfc850-is_rfc850, 220 asctime-is_asctime]), 221 member(Other, [imf_fixdate, rfc850, asctime]), 222 Other \== Format ))]) :- 223 \+ call(Check, http_date(Other, datetime(sun, date(1994,11,6), time(8,49,37)))). 224 225:- end_tests(http_date).