Anubis / Xlib

Commit 0900ff937c8b35733c9e73bc526b7eb6ad82be92

Authored by totoro
2 parents e54117fa bf4f26d5

Merge branch 'release/ANUBIS_1_14' of ssh://gitlab.calexium.com:33022/calexium/c… 

…alexium_lib into release/ANUBIS_1_14
Showing 2 changed files with 755 additions and 757 deletions   Show diff stats
Inline Side-by-side
web/CXM_cookies.anubis
  Show/Hide comments   View file @0900ff9
1   -
2   - *Project* The Anubis Project
3   -
4   - *Title* Managing Cookies.
5   -
6   - *Copyright* Copyright (c) Alain Prouté 2001.
7   -
8   -
9   - *Author* Alain Prouté
10   -
11   -
12   -
13   -
14   -read tools/basis.anubis
15   -read system/string.anubis
16   -read CXM_common.anubis
17   -read CXM_http_get_common.anubis
18   -
19   -
20   - *Overview*
21   - Cookies are defined in RFC 2109. Here is the corresponding Anubis type:
22   -
23   - Each cookie has an server name (the name of the server who constructed the cookie), a
24   - name, a value, and several attributes.
25   -
26   -public type Cookie:
27   - cookie(String server_name, // of the server who sent the cookie
28   - String name, // of the cookie
29   - String value, // of the cookie
30   - // attributes:
31   - Maybe(String) comment, // cookies may have human readable comments
32   - Maybe(String) domain, // domain name as sent by the server
33   - Int validity, // cookie still valid if this is > now
34   - Maybe(String) path, // server path for which the cookie is valid
35   - Bool secure, // if true, do not send this cookie over an insecure link
36   - Int version). // Cookie version (normally 1: rfc 2109)
37   -
38   -
39   - Cookies are sent by servers through 'Set-Cookie' HTTP headers. The function
40   - 'get_cookies' retrieves a list of cookies from a list of HTTP headers.
41   -
42   -public define List(Cookie)
43   - get_cookies
44   - (
45   - String server_name, // name of server who sent the cookies
46   - List(HTTP_header) headers // HTTP headers sent by this server
47   - ).
48   -
49   -public define Maybe(Cookie)
50   - find_cookie
51   - (
52   - String name,
53   - List(Cookie) cookies
54   - ).
55   -
56   -
57   -
58   -
59   -
60   - Normally, this function is used on the list of HTTP headers returned by either
61   - 'http_get' of 'https_get'.
62   -
63   -
64   - Before they can be sent back to their origin server, cookies must be reformated, in
65   - order to produce 'Cookie' HTTP headers:
66   -
67   -public define List(HTTP_header)
68   - reformat_cookies
69   - (
70   - String server_name,
71   - String uri,
72   - List(Cookie) cookies
73   - ).
74   -
75   - The result of 'reformat_cookies' may be appended to the list of headers given as
76   - argument to 'http_get' or to 'https_get'.
77   -
78   - In the meantime, you may examine and maybe discard cookies, you may 'save' them into a
79   - file, and 'retrieve' them later.
80   -
81   -
82   -
83   -
84   - ------- That all for the public part. -------------------------------------------------
85   -
86   -
87   - Here is the syntax of a 'Set-Cookie' header (according to RFC 2109):
88   -
89   - set-cookie = "Set-Cookie:" cookies
90   - cookies = 1#cookie
91   - cookie = NAME "=" VALUE *(";" cookie-av)
92   - NAME = token
93   - VALUE = value
94   - value = token | quoted-string
95   - cookie-av = "Comment" "=" value
96   - | "Domain" "=" value
97   - | "Max-Age" "=" value
98   - | "Path" "=" value
99   - | "Secure"
100   - | "Version" "=" 1*DIGIT
101   -
102   -
103   - According to RFC 2616 (obsolating RFC 2068) defining HTTP 1.1, 'control characters' are
104   - 0 to 31 and DEL (127). A 'separator' is one of:
105   -
106   - ( ) < > @ , ; : \ " / [ ] ? = { } 32(space) and 9(tab) "
107   -
108   - Now, a token is a non empty sequence of ASCII characters (0 to 127), but not including
109   - any control character or any separator. As a consequence, characters admissible in a
110   - 'RFC 2616 token' are:
111   -
112   - 33 !
113   - 35 to 39 # $ & '
114   - 42 43 * +
115   - 45 46 - .
116   - 48 to 57 0 ... 9
117   - 65 to 90 A ... Z
118   - 94 to 122 ^ _ ` a ... z
119   - 124 126 | ~
120   -
121   -define Bool
122   - is_token_char
123   - (
124   - Word8 c
125   - ) =
126   - if c +< 33 then false else
127   - if c +< 34 then true else
128   - if c +< 35 then false else
129   - if c +< 40 then true else
130   - if c +< 42 then false else
131   - if c +< 44 then true else
132   - if c +< 45 then false else
133   - if c +< 47 then true else
134   - if c +< 48 then false else
135   - if c +< 58 then true else
136   - if c +< 65 then false else
137   - if c +< 91 then true else
138   - if c +< 94 then false else
139   - if c +< 123 then true else
140   - if c +< 124 then false else
141   - if c = 124 then true else
142   - c = 126.
143   -
144   - value char are token added of =, (, )
145   -
146   -define Bool
147   - is_value_char
148   - (
149   - Word8 c
150   - ) =
151   - if c +< 33 then false else
152   - if c +< 34 then true else
153   - if c +< 35 then false else
154   - if c +< 44 then true else
155   - if c +< 45 then false else
156   - if c +< 47 then true else
157   - if c +< 48 then false else
158   - if c +< 58 then true else
159   - if c +< 61 then false else
160   - if c +< 62 then true else
161   - if c +< 65 then false else
162   - if c +< 91 then true else
163   - if c +< 94 then false else
164   - if c +< 123 then true else
165   - if c +< 124 then false else
166   - if c = 124 then true else
167   - c = 126.
168   -
169   - From the grammar, it is clear that atomic entities (called 'tokens' by YACC) are:
170   -
171   - - tokens (in the sens of RFC 2616) some of which have to be recognized as keywords
172   - - quoted strings
173   - - equal sign
174   - - colon
175   - - semi-colon
176   -
177   - Hence, the following type:
178   -
179   -public type Atom:
180   - end_of_input,
181   - error,
182   - comment,
183   - domain,
184   - max_age,
185   - path,
186   - secure,
187   - version,
188   - token(String),
189   - quoted_string(String),
190   - equals,
191   - colon,
192   - semi_colon.
193   -
194   -
195   - variable List(Atom) unput_atoms = [].
196   -
197   -type CookieToolBox:
198   - tool_box(Var(List(Atom)) unput_atoms,
199   - Var(String) input,
200   - Var(Int) index,
201   - Var(String) server_name
202   - ).
203   -
204   -define One
205   - unput_atom
206   - (
207   - CookieToolBox tbx,
208   - Atom a
209   - ) =
210   - unput_atoms(tbx) <- [a . *unput_atoms(tbx)].
211   -
212   -define Atom
213   - recognize_keyword
214   - (
215   - String s
216   - ) =
217   - with l = to_lower(s),
218   - if l = "comment" then comment else
219   - if l = "domain" then domain else
220   - if l = "max-age" then max_age else
221   - if l = "path" then path else
222   - if l = "secure" then secure else
223   - if l = "version" then version else
224   - token(s).
225   -
226   -
227   - variable String input = "". From which cookies will be read.
228   - variable Int index = 0. Current position within 'input'.
229   -
230   -define Maybe(Word8)
231   - next_char
232   - (
233   - CookieToolBox tbx
234   - ) =
235   - if tbx is tool_box(_, input, index, _) then
236   - if nth(*index,*input) is
237   - {
238   - failure then failure,
239   - success(c) then
240   - index <- *index+1;
241   - success(c)
242   - }.
243   -
244   -define One
245   - unput_char
246   - (
247   - CookieToolBox tbx
248   - ) =
249   - if tbx is tool_box(_, _, index, _) then
250   - index <- *index-1.
251   -
252   -define Atom
253   - read_token
254   - (
255   - CookieToolBox tbx,
256   - List(Word8) so_far, // contains at least 1 character
257   - (Word8) -> Bool is_valid_char
258   - ) =
259   - if next_char(tbx) is
260   - {
261   - failure then recognize_keyword(implode(reverse(so_far))),
262   - success(c) then
263   - if is_valid_char(c)
264   - then read_token(tbx,[c . so_far], is_valid_char)
265   - else unput_char(tbx); recognize_keyword(implode(reverse(so_far)))
266   - }.
267   -
268   -define Atom
269   - read_quoted_string
270   - (
271   - CookieToolBox tbx,
272   - List(Word8) so_far
273   - ) =
274   - if next_char(tbx) is
275   - {
276   - failure then quoted_string(implode(reverse(so_far))),
277   - success(c) then
278   - if c = '\"'
279   - then quoted_string(implode(reverse(so_far)))
280   - else read_quoted_string(tbx,[c . so_far])
281   - }.
282   -
283   -define Bool
284   - is_blank
285   - (
286   - Word8 c
287   - ) =
288   - c +=< ' '.
289   -
290   - Reading an atom from the input:
291   -
292   -define Atom
293   - read_atom
294   - (
295   - CookieToolBox tbx,
296   - ) =
297   - if *unput_atoms(tbx) is
298   - {
299   - [ ] then
300   - if next_char(tbx) is
301   - {
302   - failure then end_of_input,
303   - success(c) then
304   - if is_blank(c) then read_atom(tbx) else // skip blanks
305   - if is_token_char(c) then read_token(tbx,[c], is_token_char) else
306   - if c = '\"' then read_quoted_string(tbx,[]) else
307   - if c = '=' then equals else
308   - if c = ':' then colon else
309   - if c = ';' then semi_colon else
310   - error
311   - },
312   - [h . t] then
313   - unput_atoms(tbx) <- t; h
314   - }.
315   -
316   -define Atom
317   - read_value
318   - (
319   - CookieToolBox tbx
320   - ) =
321   - if *unput_atoms(tbx) is
322   - {
323   - [ ] then
324   - if next_char(tbx) is
325   - {
326   - failure then end_of_input,
327   - success(c) then
328   - if is_blank(c) then read_value(tbx) else // skip blanks
329   - if is_value_char(c) then read_token(tbx,[c], is_value_char) else
330   - if c = '\"' then read_quoted_string(tbx,[]) else
331   - if c = ';' then semi_colon else
332   - error
333   - },
334   - [h . t] then
335   - unput_atoms(tbx) <- t; h
336   - }.
337   -
338   - Reading an attribute-value pair.
339   -
340   -type AttrVal:
341   - comment(String),
342   - domain(String),
343   - max_age(String),
344   - path(String),
345   - secure,
346   - version(String).
347   -
348   -define String
349   - read_eq_value
350   - (
351   - CookieToolBox tbx
352   - ) =
353   - with e = read_atom(tbx),
354   - if e is equals then
355   - (
356   - with a = read_atom(tbx),
357   - if a is token(n) then n else
358   - if a is quoted_string(s) then s else
359   - unput_atom(tbx,a); ""
360   - )
361   - else unput_atom(tbx,e); "".
362   -
363   -
364   -define Maybe(AttrVal)
365   - read_attr_val
366   - (
367   - CookieToolBox tbx
368   - ) =
369   - if read_atom(tbx) is semi_colon then
370   - with a = read_atom(tbx),
371   - if a is
372   - {
373   - end_of_input then failure,
374   - error then failure,
375   - comment then success(comment(read_eq_value(tbx))),
376   - domain then success(domain(read_eq_value(tbx))),
377   - max_age then success(max_age(read_eq_value(tbx))),
378   - path then success(path(read_eq_value(tbx))),
379   - secure then success(secure),
380   - version then success(version(read_eq_value(tbx))),
381   - token(_) then unput_atom(tbx,a); failure,
382   - quoted_string(_) then unput_atom(tbx,a); failure,
383   - equals then unput_atom(tbx,a); failure,
384   - colon then unput_atom(tbx,a); failure,
385   - semi_colon then unput_atom(tbx,a); failure,
386   - }
387   - else failure.
388   -
389   -
390   - Getting attributes from a List(AttrVal).
391   -
392   -define Maybe(String)
393   - get_comment
394   - (
395   - List(AttrVal) l
396   - ) =
397   - if l is
398   - {
399   - [ ] then failure,
400   - [h . t] then if h is comment(c)
401   - then success(c)
402   - else get_comment(t)
403   - }.
404   -
405   -define Maybe(String)
406   - get_domain
407   - (
408   - List(AttrVal) l
409   - ) =
410   - if l is
411   - {
412   - [ ] then failure,
413   - [h . t] then if h is domain(s)
414   - then success(s)
415   - else get_domain(t)
416   - }.
417   -
418   -define Int
419   - get_validity
420   - (
421   - List(AttrVal) l
422   - ) =
423   - if l is
424   - {
425   - [ ] then 0,
426   - [h . t] then if h is max_age(a)
427   - then if decimal_scan(a) is
428   - {
429   - failure then 0,
430   - success(n) then n+now
431   - }
432   - else get_validity(t)
433   - }.
434   -
435   -define Maybe(String)
436   - get_path
437   - (
438   - List(AttrVal) l
439   - ) =
440   - if l is
441   - {
442   - [ ] then failure,
443   - [h . t] then if h is path(p)
444   - then success(p)
445   - else get_path(t)
446   - }.
447   -
448   -define Bool
449   - get_secure
450   - (
451   - List(AttrVal) l
452   - ) =
453   - if l is
454   - {
455   - [ ] then false,
456   - [h . t] then if h is secure
457   - then true
458   - else get_secure(t)
459   - }.
460   -
461   -define Int
462   - get_version
463   - (
464   - List(AttrVal) l
465   - ) =
466   - if l is
467   - {
468   - [ ] then 0,
469   - [h . t] then if h is version(v)
470   - then if decimal_scan(v) is
471   - {
472   - failure then 0,
473   - success(n) then n
474   - }
475   - else get_version(t)
476   - }.
477   -
478   -
479   - Reading a cookie:
480   -
481   - variable String server_name = "".
482   -
483   -define Maybe(Cookie)
484   - read_cookie_n_e_v
485   - (
486   - CookieToolBox tbx,
487   - String name,
488   - String value,
489   - List(AttrVal) so_far
490   - ) =
491   - if read_attr_val(tbx) is
492   - {
493   - failure then
494   - success(cookie(
495   - *server_name(tbx),
496   - name,
497   - value,
498   - get_comment(so_far),
499   - get_domain(so_far),
500   - get_validity(so_far),
501   - get_path(so_far),
502   - get_secure(so_far),
503   - get_version(so_far)
504   - )),
505   -
506   - success(av) then read_cookie_n_e_v(tbx,name,value,[av . so_far])
507   - }.
508   -
509   -define Maybe(Cookie)
510   - read_cookie_n_e
511   - (
512   - CookieToolBox tbx,
513   - String name
514   - ) =
515   - with a = read_value(tbx),
516   - if a is token(value) then read_cookie_n_e_v(tbx,name,value,[]) else
517   - if a is quoted_string(value) then read_cookie_n_e_v(tbx,name,value,[]) else
518   - unput_atom(tbx,a); failure.
519   -
520   -define Maybe(Cookie)
521   - read_cookie_n
522   - (
523   - CookieToolBox tbx, // bis repetita placent
524   - String name
525   - ) =
526   - with a = read_atom(tbx),
527   - if a is equals
528   - then read_cookie_n_e(tbx,name)
529   - else unput_atom(tbx,a); failure.
530   -
531   -
532   -define Maybe(Cookie)
533   - read_cookie
534   - (
535   - CookieToolBox tbx
536   - ) =
537   - with a = read_atom(tbx),
538   - if a is token(name)
539   - then read_cookie_n(tbx,name)
540   - else unput_atom(tbx,a); failure.
541   -
542   -
543   -define List(Cookie)
544   - read_cookies
545   - (
546   - CookieToolBox tbx,
547   - List(Cookie) so_far
548   - ) =
549   - if read_cookie(tbx) is
550   - {
551   - failure then so_far,
552   - success(c) then read_cookies(tbx,[c . so_far])
553   - }.
554   -
555   -
556   -define List(Cookie)
557   - get_cookies
558   - (
559   - String svn,
560   - HTTP_header h
561   - ) =
562   - if h is http_header(n,v) then
563   - if to_lower(n) = "set-cookie"
564   - then read_cookies(tool_box(var([]),var(v),var(0),var(svn)),[])
565   - else [].
566   -
567   -public define List(Cookie)
568   - get_cookies
569   - (
570   - String server_name,
571   - List(HTTP_header) headers
572   - ) =
573   - if headers is
574   - {
575   - [ ] then [ ],
576   - [h . t] then
577   - append(get_cookies(server_name,h),get_cookies(server_name,t))
578   - }.
579   -
580   -define List(Cookie)
581   - server_get_cookies
582   - (
583   - HTTP_header h
584   - ) =
585   - if h is http_header(n,v) then
586   - if to_lower(n) = "cookie"
587   - then read_cookies(tool_box(var([]),var(v),var(0),var("")),[])
588   - else [].
589   -
590   -public define List(Cookie)
591   - server_get_cookies
592   - (
593   - // String server_name,
594   - List(HTTP_header) headers
595   - ) =
596   - if headers is
597   - {
598   - [ ] then [ ],
599   - [h . t] then
600   - append(server_get_cookies(h), server_get_cookies(t))
601   - }.
602   -
603   -public define Maybe(Cookie)
604   - find_cookie
605   - (
606   - String name,
607   - List(Cookie) cookies
608   - )
609   - =
610   - if cookies is
611   - {
612   - [] then failure,
613   - [h . t] then
614   - if h is cookie(s, n, v, _, _, _, _, _, _) then
615   - if name = n then success(h)
616   - else find_cookie(name, t)
617   - }.
618   -
619   -public define String
620   - get_cookie_value
621   - (
622   - String name,
623   - List(Cookie) cookies
624   - )
625   - =
626   - if find_cookie(name, cookies) is
627   - {
628   - failure then "",
629   - success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v
630   - }.
631   -
632   - *** Reformating cookies. **************************************************************
633   -
634   - Cookies should be resent reformated according to the following grammar (copy-pasted
635   - from RFC 2109):
636   -
637   - cookie = "Cookie:" cookie-version
638   - 1*((";" | ",") cookie-value)
639   - cookie-value = NAME "=" VALUE [";" path] [";" domain]
640   - cookie-version = "$Version" "=" value
641   - NAME = attr
642   - VALUE = value
643   - path = "$Path" "=" value
644   - domain = "$Domain" "=" value
645   -
646   -
647   -define HTTP_header
648   - reformat_cookie
649   - (
650   - Cookie c
651   - ) =
652   - if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
653   - http_header("Cookie",
654   - "$Version=" + to_decimal(ver) +
655   - ";" + n + "=\"" + v + "\"" +
656   - if mbp is
657   - {
658   - failure then "",
659   - success(p) then ";$Path=\"" + p + "\""
660   - } +
661   - if mbd is
662   - {
663   - failure then "",
664   - success(d) then ";$Domain=\"" + d + "\""
665   - }
666   - ).
667   -
668   -
669   - According to RFC 2109, a cookie may be sent to a server if:
670   -
671   - (1) server name in the cookie is the name of the server,
672   - (2) if 'Path' attribute is present, its value must match the URI,
673   - (3) the cookie is still valid (validity = 0 means indefinitely valid).
674   -
675   - define Bool
676   - path_match
677   - (
678   - Maybe(String) cookie_path,
679   - String uri
680   - ) =
681   - if cookie_path is
682   - {
683   - failure then true,
684   - success(p) then
685   -
686   - }.
687   -
688   -
689   - Checking if the path matches:
690   -
691   -
692   -define Bool
693   - path_match
694   - (
695   - Maybe(String) mbp,
696   - String uri
697   - ) =
698   - true.
699   -
700   -
701   - The next function verifies if a cookie satisfies the rules.
702   -
703   -define Bool
704   - may_resend_cookie
705   - (
706   - String server_name,
707   - String uri,
708   - Cookie c
709   - ) =
710   - if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
711   - if sn = server_name
712   - then (
713   - if path_match(mbp,uri)
714   - then (
715   - if vld = 0 then true else vld > now
716   - )
717   - else false
718   - )
719   - else false.
720   -
721   -
722   - The next function reformat all cookies which satisfy the 'resend' rules.
723   -
724   -public define List(HTTP_header)
725   - reformat_cookies
726   - (
727   - String server_name,
728   - String uri,
729   - List(Cookie) cookies
730   - ) =
731   - if cookies is
732   - {
733   - [ ] then [ ],
734   - [h . t] then
735   - if may_resend_cookie(server_name,uri,h)
736   - then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)]
737   - else reformat_cookies(server_name,uri,t)
738   - }.
739   -
740   -
741   -
742   -
743   -
744   - See test_cookies.anubis for a test of this program.
745   -
746   -
747   -
748   -
749   -
750   -
751   -
752   -
753   -
  1 +
  2 + *Project* The Anubis Project
  3 +
  4 + *Title* Managing Cookies.
  5 +
  6 + *Copyright* Copyright (c) Alain Prouté 2001.
  7 +
  8 +
  9 + *Author* Alain Prouté
  10 +
  11 +
  12 +
  13 +
  14 +read tools/basis.anubis
  15 +read system/string.anubis
  16 +read CXM_common.anubis
  17 +read CXM_http_get_common.anubis
  18 +
  19 +
  20 + *Overview*
  21 + Cookies are defined in RFC 2109. Here is the corresponding Anubis type:
  22 +
  23 + Each cookie has an server name (the name of the server who constructed the cookie), a
  24 + name, a value, and several attributes.
  25 +
  26 +public type Cookie:
  27 + cookie(String server_name, // of the server who sent the cookie
  28 + String name, // of the cookie
  29 + String value, // of the cookie
  30 + // attributes:
  31 + Maybe(String) comment, // cookies may have human readable comments
  32 + Maybe(String) domain, // domain name as sent by the server
  33 + Int validity, // cookie still valid if this is > now
  34 + Maybe(String) path, // server path for which the cookie is valid
  35 + Bool secure, // if true, do not send this cookie over an insecure link
  36 + Int version). // Cookie version (normally 1: rfc 2109)
  37 +
  38 +
  39 + Cookies are sent by servers through 'Set-Cookie' HTTP headers. The function
  40 + 'get_cookies' retrieves a list of cookies from a list of HTTP headers.
  41 +
  42 +public define List(Cookie)
  43 + get_cookies
  44 + (
  45 + String server_name, // name of server who sent the cookies
  46 + List(HTTP_header) headers // HTTP headers sent by this server
  47 + ).
  48 +
  49 +public define Maybe(Cookie)
  50 + find_cookie
  51 + (
  52 + String name,
  53 + List(Cookie) cookies
  54 + ).
  55 +
  56 +
  57 +
  58 +
  59 +
  60 + Normally, this function is used on the list of HTTP headers returned by either
  61 + 'http_get' of 'https_get'.
  62 +
  63 +
  64 + Before they can be sent back to their origin server, cookies must be reformated, in
  65 + order to produce 'Cookie' HTTP headers:
  66 +
  67 +public define List(HTTP_header)
  68 + reformat_cookies
  69 + (
  70 + String server_name,
  71 + String uri,
  72 + List(Cookie) cookies
  73 + ).
  74 +
  75 + The result of 'reformat_cookies' may be appended to the list of headers given as
  76 + argument to 'http_get' or to 'https_get'.
  77 +
  78 + In the meantime, you may examine and maybe discard cookies, you may 'save' them into a
  79 + file, and 'retrieve' them later.
  80 +
  81 +
  82 +
  83 +
  84 + ------- That all for the public part. -------------------------------------------------
  85 +
  86 +
  87 + Here is the syntax of a 'Set-Cookie' header (according to RFC 2109):
  88 +
  89 + set-cookie = "Set-Cookie:" cookies
  90 + cookies = 1#cookie
  91 + cookie = NAME "=" VALUE *(";" cookie-av)
  92 + NAME = token
  93 + VALUE = value
  94 + value = token | quoted-string
  95 + cookie-av = "Comment" "=" value
  96 + | "Domain" "=" value
  97 + | "Max-Age" "=" value
  98 + | "Path" "=" value
  99 + | "Secure"
  100 + | "Version" "=" 1*DIGIT
  101 +
  102 +
  103 + According to RFC 2616 (obsolating RFC 2068) defining HTTP 1.1, 'control characters' are
  104 + 0 to 31 and DEL (127). A 'separator' is one of:
  105 +
  106 + ( ) < > @ , ; : \ " / [ ] ? = { } 32(space) and 9(tab) "
  107 +
  108 + Now, a token is a non empty sequence of ASCII characters (0 to 127), but not including
  109 + any control character or any separator. As a consequence, characters admissible in a
  110 + 'RFC 2616 token' are:
  111 +
  112 + 33 !
  113 + 35 to 39 # $ & '
  114 + 42 43 * +
  115 + 45 46 - .
  116 + 48 to 57 0 ... 9
  117 + 65 to 90 A ... Z
  118 + 94 to 122 ^ _ ` a ... z
  119 + 124 126 | ~
  120 +
  121 +define Bool
  122 + is_token_char
  123 + (
  124 + Word8 c
  125 + ) =
  126 + if c +< 33 then false else
  127 + if c +< 34 then true else
  128 + if c +< 35 then false else
  129 + if c +< 40 then true else
  130 + if c +< 42 then false else
  131 + if c +< 44 then true else
  132 + if c +< 45 then false else
  133 + if c +< 47 then true else
  134 + if c +< 48 then false else
  135 + if c +< 58 then true else
  136 + if c +< 65 then false else
  137 + if c +< 91 then true else
  138 + if c +< 94 then false else
  139 + if c +< 123 then true else
  140 + if c +< 124 then false else
  141 + if c = 124 then true else
  142 + c = 126.
  143 +
  144 + value char are token added of =, (, )
  145 +
  146 +define Bool
  147 + is_value_char
  148 + (
  149 + Word8 c
  150 + ) =
  151 + if c +< 33 then false else // space in not allowed in value
  152 + if c +< 34 then true else
  153 + if c +< 35 then false else // " is not allowed in value
  154 + if c +< 44 then true else
  155 + if c +< 45 then false else // , is not allowed in value
  156 + //if c +< 47 then true else
  157 + //if c +< 48 then false else
  158 + if c +< 59 then true else
  159 + if c +< 60 then false else // ; not allowed in value
  160 + //if c +< 62 then true else
  161 + //if c +< 65 then false else
  162 + //if c +< 91 then true else
  163 + //if c +< 94 then false else
  164 + //if c +< 123 then true else
  165 + //if c +< 124 then false else
  166 + //if c = 124 then true else
  167 + //c = 126.
  168 + if c +< 127 then true
  169 + else
  170 + false.
  171 +
  172 + From the grammar, it is clear that atomic entities (called 'tokens' by YACC) are:
  173 +
  174 + - tokens (in the sens of RFC 2616) some of which have to be recognized as keywords
  175 + - quoted strings
  176 + - equal sign
  177 + - colon
  178 + - semi-colon
  179 +
  180 + Hence, the following type:
  181 +
  182 +public type Atom:
  183 + end_of_input,
  184 + error,
  185 + comment,
  186 + domain,
  187 + max_age,
  188 + path,
  189 + secure,
  190 + version,
  191 + token(String),
  192 + quoted_string(String),
  193 + equals,
  194 + colon,
  195 + semi_colon.
  196 +
  197 +
  198 + variable List(Atom) unput_atoms = [].
  199 +
  200 +type CookieToolBox:
  201 + tool_box(Var(List(Atom)) unput_atoms,
  202 + Var(String) input,
  203 + Var(Int) index,
  204 + Var(String) server_name
  205 + ).
  206 +
  207 +define One
  208 + unput_atom
  209 + (
  210 + CookieToolBox tbx,
  211 + Atom a
  212 + ) =
  213 + unput_atoms(tbx) <- [a . *unput_atoms(tbx)].
  214 +
  215 +define Atom
  216 + recognize_keyword
  217 + (
  218 + String s
  219 + ) =
  220 + with l = to_lower(s),
  221 + if l = "comment" then comment else
  222 + if l = "domain" then domain else
  223 + if l = "max-age" then max_age else
  224 + if l = "path" then path else
  225 + if l = "secure" then secure else
  226 + if l = "version" then version else
  227 + token(s).
  228 +
  229 +
  230 + variable String input = "". From which cookies will be read.
  231 + variable Int index = 0. Current position within 'input'.
  232 +
  233 +define Maybe(Word8)
  234 + next_char
  235 + (
  236 + CookieToolBox tbx
  237 + ) =
  238 + if tbx is tool_box(_, input, index, _) then
  239 + if nth(*index,*input) is
  240 + {
  241 + failure then failure,
  242 + success(c) then
  243 + index <- *index+1;
  244 + success(c)
  245 + }.
  246 +
  247 +define One
  248 + unput_char
  249 + (
  250 + CookieToolBox tbx
  251 + ) =
  252 + if tbx is tool_box(_, _, index, _) then
  253 + index <- *index-1.
  254 +
  255 +define Atom
  256 + read_token
  257 + (
  258 + CookieToolBox tbx,
  259 + List(Word8) so_far, // contains at least 1 character
  260 + (Word8) -> Bool is_valid_char
  261 + ) =
  262 + if next_char(tbx) is
  263 + {
  264 + failure then recognize_keyword(implode(reverse(so_far))),
  265 + success(c) then
  266 + if is_valid_char(c)
  267 + then read_token(tbx,[c . so_far], is_valid_char)
  268 + else unput_char(tbx); recognize_keyword(implode(reverse(so_far)))
  269 + }.
  270 +
  271 +define Atom
  272 + read_quoted_string
  273 + (
  274 + CookieToolBox tbx,
  275 + List(Word8) so_far
  276 + ) =
  277 + if next_char(tbx) is
  278 + {
  279 + failure then quoted_string(implode(reverse(so_far))),
  280 + success(c) then
  281 + if c = '\"'
  282 + then quoted_string(implode(reverse(so_far)))
  283 + else read_quoted_string(tbx,[c . so_far])
  284 + }.
  285 +
  286 +define Bool
  287 + is_blank
  288 + (
  289 + Word8 c
  290 + ) =
  291 + c +=< ' '.
  292 +
  293 + Reading an atom from the input:
  294 +
  295 +define Atom
  296 + read_atom
  297 + (
  298 + CookieToolBox tbx,
  299 + ) =
  300 + if *unput_atoms(tbx) is
  301 + {
  302 + [ ] then
  303 + if next_char(tbx) is
  304 + {
  305 + failure then end_of_input,
  306 + success(c) then
  307 + if is_blank(c) then read_atom(tbx) else // skip blanks
  308 + if is_token_char(c) then read_token(tbx,[c], is_token_char) else
  309 + if c = '\"' then read_quoted_string(tbx,[]) else
  310 + if c = '=' then equals else
  311 + if c = ':' then colon else
  312 + if c = ';' then semi_colon else
  313 + error
  314 + },
  315 + [h . t] then
  316 + unput_atoms(tbx) <- t; h
  317 + }.
  318 +
  319 +define Atom
  320 + read_value
  321 + (
  322 + CookieToolBox tbx
  323 + ) =
  324 + if *unput_atoms(tbx) is
  325 + {
  326 + [ ] then
  327 + if next_char(tbx) is
  328 + {
  329 + failure then end_of_input,
  330 + success(c) then
  331 + if is_blank(c) then read_value(tbx) else // skip blanks
  332 + if is_value_char(c) then read_token(tbx,[c], is_value_char) else
  333 + if c = '\"' then read_quoted_string(tbx,[]) else
  334 + if c = ';' then semi_colon else
  335 + //println("cookie read value char ["+c+"] is an error");
  336 + error
  337 + },
  338 + [h . t] then
  339 + unput_atoms(tbx) <- t; h
  340 + }.
  341 +
  342 + Reading an attribute-value pair.
  343 +
  344 +type AttrVal:
  345 + comment(String),
  346 + domain(String),
  347 + max_age(String),
  348 + path(String),
  349 + secure,
  350 + version(String).
  351 +
  352 +define String
  353 + read_eq_value
  354 + (
  355 + CookieToolBox tbx
  356 + ) =
  357 + with e = read_atom(tbx),
  358 + if e is equals then
  359 + (
  360 + with a = read_atom(tbx),
  361 + if a is token(n) then n else
  362 + if a is quoted_string(s) then s else
  363 + unput_atom(tbx,a); ""
  364 + )
  365 + else unput_atom(tbx,e); "".
  366 +
  367 +
  368 +define Maybe(AttrVal)
  369 + read_attr_val
  370 + (
  371 + CookieToolBox tbx
  372 + ) =
  373 + if read_atom(tbx) is semi_colon then
  374 + with a = read_atom(tbx),
  375 + if a is
  376 + {
  377 + end_of_input then failure,
  378 + error then failure,
  379 + comment then success(comment(read_eq_value(tbx))),
  380 + domain then success(domain(read_eq_value(tbx))),
  381 + max_age then success(max_age(read_eq_value(tbx))),
  382 + path then success(path(read_eq_value(tbx))),
  383 + secure then success(secure),
  384 + version then success(version(read_eq_value(tbx))),
  385 + token(_) then unput_atom(tbx,a); failure,
  386 + quoted_string(_) then unput_atom(tbx,a); failure,
  387 + equals then unput_atom(tbx,a); failure,
  388 + colon then unput_atom(tbx,a); failure,
  389 + semi_colon then unput_atom(tbx,a); failure,
  390 + }
  391 + else failure.
  392 +
  393 +
  394 + Getting attributes from a List(AttrVal).
  395 +
  396 +define Maybe(String)
  397 + get_comment
  398 + (
  399 + List(AttrVal) l
  400 + ) =
  401 + if l is
  402 + {
  403 + [ ] then failure,
  404 + [h . t] then if h is comment(c)
  405 + then success(c)
  406 + else get_comment(t)
  407 + }.
  408 +
  409 +define Maybe(String)
  410 + get_domain
  411 + (
  412 + List(AttrVal) l
  413 + ) =
  414 + if l is
  415 + {
  416 + [ ] then failure,
  417 + [h . t] then if h is domain(s)
  418 + then success(s)
  419 + else get_domain(t)
  420 + }.
  421 +
  422 +define Int
  423 + get_validity
  424 + (
  425 + List(AttrVal) l
  426 + ) =
  427 + if l is
  428 + {
  429 + [ ] then 0,
  430 + [h . t] then if h is max_age(a)
  431 + then if decimal_scan(a) is
  432 + {
  433 + failure then 0,
  434 + success(n) then n+now
  435 + }
  436 + else get_validity(t)
  437 + }.
  438 +
  439 +define Maybe(String)
  440 + get_path
  441 + (
  442 + List(AttrVal) l
  443 + ) =
  444 + if l is
  445 + {
  446 + [ ] then failure,
  447 + [h . t] then if h is path(p)
  448 + then success(p)
  449 + else get_path(t)
  450 + }.
  451 +
  452 +define Bool
  453 + get_secure
  454 + (
  455 + List(AttrVal) l
  456 + ) =
  457 + if l is
  458 + {
  459 + [ ] then false,
  460 + [h . t] then if h is secure
  461 + then true
  462 + else get_secure(t)
  463 + }.
  464 +
  465 +define Int
  466 + get_version
  467 + (
  468 + List(AttrVal) l
  469 + ) =
  470 + if l is
  471 + {
  472 + [ ] then 0,
  473 + [h . t] then if h is version(v)
  474 + then if decimal_scan(v) is
  475 + {
  476 + failure then 0,
  477 + success(n) then n
  478 + }
  479 + else get_version(t)
  480 + }.
  481 +
  482 +
  483 + Reading a cookie:
  484 +
  485 + variable String server_name = "".
  486 +
  487 +define Maybe(Cookie)
  488 + read_cookie_n_e_v
  489 + (
  490 + CookieToolBox tbx,
  491 + String name,
  492 + String value,
  493 + List(AttrVal) so_far
  494 + ) =
  495 + if read_attr_val(tbx) is
  496 + {
  497 + failure then
  498 + success(cookie(
  499 + *server_name(tbx),
  500 + name,
  501 + value,
  502 + get_comment(so_far),
  503 + get_domain(so_far),
  504 + get_validity(so_far),
  505 + get_path(so_far),
  506 + get_secure(so_far),
  507 + get_version(so_far)
  508 + )),
  509 +
  510 + success(av) then read_cookie_n_e_v(tbx,name,value,[av . so_far])
  511 + }.
  512 +
  513 +define Maybe(Cookie)
  514 + read_cookie_n_e
  515 + (
  516 + CookieToolBox tbx,
  517 + String name
  518 + ) =
  519 + with a = read_value(tbx),
  520 + if a is token(value) then
  521 + //println("read_cookie_n_e name["+name+"] value ["+value+"]");
  522 + read_cookie_n_e_v(tbx,name,value,[]) else
  523 + if a is quoted_string(value) then read_cookie_n_e_v(tbx,name,value,[]) else
  524 + unput_atom(tbx,a); failure.
  525 +
  526 +define Maybe(Cookie)
  527 + read_cookie_n
  528 + (
  529 + CookieToolBox tbx, // bis repetita placent
  530 + String name
  531 + ) =
  532 + with a = read_atom(tbx),
  533 + if a is equals
  534 + then read_cookie_n_e(tbx,name)
  535 + else unput_atom(tbx,a); failure.
  536 +
  537 +
  538 +define Maybe(Cookie)
  539 + read_cookie
  540 + (
  541 + CookieToolBox tbx
  542 + ) =
  543 + with a = read_atom(tbx),
  544 + if a is token(name)
  545 + then read_cookie_n(tbx,name)
  546 + else unput_atom(tbx,a); failure.
  547 +
  548 +
  549 +define List(Cookie)
  550 + read_cookies
  551 + (
  552 + CookieToolBox tbx,
  553 + List(Cookie) so_far
  554 + ) =
  555 + if read_cookie(tbx) is
  556 + {
  557 + failure then so_far,
  558 + success(c) then read_cookies(tbx,[c . so_far])
  559 + }.
  560 +
  561 +
  562 +define List(Cookie)
  563 + get_cookies
  564 + (
  565 + String svn,
  566 + HTTP_header h
  567 + ) =
  568 + if h is http_header(n,v) then
  569 + if to_lower(n) = "set-cookie"
  570 + then read_cookies(tool_box(var([]),var(v),var(0),var(svn)),[])
  571 + else [].
  572 +
  573 +public define List(Cookie)
  574 + get_cookies
  575 + (
  576 + String server_name,
  577 + List(HTTP_header) headers
  578 + ) =
  579 + if headers is
  580 + {
  581 + [ ] then [ ],
  582 + [h . t] then
  583 + append(get_cookies(server_name,h),get_cookies(server_name,t))
  584 + }.
  585 +
  586 +define List(Cookie)
  587 + server_get_cookies
  588 + (
  589 + HTTP_header h
  590 + ) =
  591 + if h is http_header(n,v) then
  592 + if to_lower(n) = "cookie"
  593 + then read_cookies(tool_box(var([]),var(v),var(0),var("")),[])
  594 + else [].
  595 +
  596 +public define List(Cookie)
  597 + server_get_cookies
  598 + (
  599 + // String server_name,
  600 + List(HTTP_header) headers
  601 + ) =
  602 + if headers is
  603 + {
  604 + [ ] then [ ],
  605 + [h . t] then
  606 + append(server_get_cookies(h), server_get_cookies(t))
  607 + }.
  608 +
  609 +public define Maybe(Cookie)
  610 + find_cookie
  611 + (
  612 + String name,
  613 + List(Cookie) cookies
  614 + )
  615 + =
  616 + if cookies is
  617 + {
  618 + [] then failure,
  619 + [h . t] then
  620 + if h is cookie(s, n, v, _, _, _, _, _, _) then
  621 + if name = n then success(h)
  622 + else find_cookie(name, t)
  623 + }.
  624 +
  625 +public define String
  626 + get_cookie_value
  627 + (
  628 + String name,
  629 + List(Cookie) cookies
  630 + )
  631 + =
  632 + if find_cookie(name, cookies) is
  633 + {
  634 + failure then "",
  635 + success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v
  636 + }.
  637 +
  638 + *** Reformating cookies. **************************************************************
  639 +
  640 + Cookies should be resent reformated according to the following grammar (copy-pasted
  641 + from RFC 2109):
  642 +
  643 + cookie = "Cookie:" cookie-version
  644 + 1*((";" | ",") cookie-value)
  645 + cookie-value = NAME "=" VALUE [";" path] [";" domain]
  646 + cookie-version = "$Version" "=" value
  647 + NAME = attr
  648 + VALUE = value
  649 + path = "$Path" "=" value
  650 + domain = "$Domain" "=" value
  651 +
  652 +
  653 +define HTTP_header
  654 + reformat_cookie
  655 + (
  656 + Cookie c
  657 + ) =
  658 + if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
  659 + http_header("Cookie",
  660 + "$Version=" + to_decimal(ver) +
  661 + ";" + n + "=\"" + v + "\"" +
  662 + if mbp is
  663 + {
  664 + failure then "",
  665 + success(p) then ";$Path=\"" + p + "\""
  666 + } +
  667 + if mbd is
  668 + {
  669 + failure then "",
  670 + success(d) then ";$Domain=\"" + d + "\""
  671 + }
  672 + ).
  673 +
  674 +
  675 + According to RFC 2109, a cookie may be sent to a server if:
  676 +
  677 + (1) server name in the cookie is the name of the server,
  678 + (2) if 'Path' attribute is present, its value must match the URI,
  679 + (3) the cookie is still valid (validity = 0 means indefinitely valid).
  680 +
  681 + define Bool
  682 + path_match
  683 + (
  684 + Maybe(String) cookie_path,
  685 + String uri
  686 + ) =
  687 + if cookie_path is
  688 + {
  689 + failure then true,
  690 + success(p) then
  691 +
  692 + }.
  693 +
  694 +
  695 + Checking if the path matches:
  696 +
  697 +
  698 +define Bool
  699 + path_match
  700 + (
  701 + Maybe(String) mbp,
  702 + String uri
  703 + ) =
  704 + true.
  705 +
  706 +
  707 + The next function verifies if a cookie satisfies the rules.
  708 +
  709 +define Bool
  710 + may_resend_cookie
  711 + (
  712 + String server_name,
  713 + String uri,
  714 + Cookie c
  715 + ) =
  716 + if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
  717 + if sn = server_name
  718 + then (
  719 + if path_match(mbp,uri)
  720 + then (
  721 + if vld = 0 then true else vld > now
  722 + )
  723 + else false
  724 + )
  725 + else false.
  726 +
  727 +
  728 + The next function reformat all cookies which satisfy the 'resend' rules.
  729 +
  730 +public define List(HTTP_header)
  731 + reformat_cookies
  732 + (
  733 + String server_name,
  734 + String uri,
  735 + List(Cookie) cookies
  736 + ) =
  737 + if cookies is
  738 + {
  739 + [ ] then [ ],
  740 + [h . t] then
  741 + if may_resend_cookie(server_name,uri,h)
  742 + then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)]
  743 + else reformat_cookies(server_name,uri,t)
  744 + }.
  745 +
  746 +
  747 +
  748 +
  749 +
  750 + See test_cookies.anubis for a test of this program.
  751 +
... ...
web/CXM_making_a_web_site.anubis
  Show/Hide comments   View file @0900ff9
... ... @@ -2348,11 +2348,11 @@ define (List(Web_arg) lwa, HTTP_Info info) -&gt; Separated_Web_Args($State)
2348 2348 if find_cookie("state_"+website_name, server_get_cookies(http_headers(info))) is
2349 2349 {
2350 2350 failure then
2351   - /*println("find_cookie(\"state_"+website_name+"\" failure");*/
  2351 + //println("find_cookie(\"state_"+website_name+"\" failure");
2352 2352 swa(not_found,failure,[]),
2353 2353  
2354 2354 success(cookie) then
2355   - /*println("find_cookie(\"state_"+website_name+"\" success");*/
  2355 + //println("find_cookie(\"state_"+website_name+"\" success");
2356 2356 swa(retrieve_state(value(cookie)),failure,[])
2357 2357 },
2358 2358  
... ... @@ -2614,11 +2614,11 @@ public define Web_Site
2614 2614 },
2615 2615  
2616 2616 out_of_date(state) then
2617   - //println("out_of_date");
  2617 + //println("previous out_of_date");
2618 2618 ticket_expired_state(state, mb_action_name, http_info,operands,is_https),
2619 2619  
2620 2620 still_valid(state) then
2621   - //println("still_valid");
  2621 + //println("previous still_valid");
2622 2622 if mb_action_name is
2623 2623 {
2624 2624 failure then state,
... ...