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