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,11 +2348,11 @@ define (List(Web_arg) lwa, HTTP_Info info) -&gt; Separated_Web_Args($State)
2348 if find_cookie("state_"+website_name, server_get_cookies(http_headers(info))) is 2348 if find_cookie("state_"+website_name, server_get_cookies(http_headers(info))) is
2349 { 2349 {
2350 failure then 2350 failure then
2351 - /*println("find_cookie(\"state_"+website_name+"\" failure");*/ 2351 + //println("find_cookie(\"state_"+website_name+"\" failure");
2352 swa(not_found,failure,[]), 2352 swa(not_found,failure,[]),
2353 2353
2354 success(cookie) then 2354 success(cookie) then
2355 - /*println("find_cookie(\"state_"+website_name+"\" success");*/ 2355 + //println("find_cookie(\"state_"+website_name+"\" success");
2356 swa(retrieve_state(value(cookie)),failure,[]) 2356 swa(retrieve_state(value(cookie)),failure,[])
2357 }, 2357 },
2358 2358
@@ -2614,11 +2614,11 @@ public define Web_Site @@ -2614,11 +2614,11 @@ public define Web_Site
2614 }, 2614 },
2615 2615
2616 out_of_date(state) then 2616 out_of_date(state) then
2617 - //println("out_of_date"); 2617 + //println("previous out_of_date");
2618 ticket_expired_state(state, mb_action_name, http_info,operands,is_https), 2618 ticket_expired_state(state, mb_action_name, http_info,operands,is_https),
2619 2619
2620 still_valid(state) then 2620 still_valid(state) then
2621 - //println("still_valid"); 2621 + //println("previous still_valid");
2622 if mb_action_name is 2622 if mb_action_name is
2623 { 2623 {
2624 failure then state, 2624 failure then state,