diff --git a/web/CXM_cookies.anubis b/web/CXM_cookies.anubis index e4db40b..7e2ca0c 100644 --- a/web/CXM_cookies.anubis +++ b/web/CXM_cookies.anubis @@ -1,753 +1,751 @@ - - *Project* The Anubis Project - - *Title* Managing Cookies. - - *Copyright* Copyright (c) Alain Prouté 2001. - - - *Author* Alain Prouté - - - - -read tools/basis.anubis -read system/string.anubis -read CXM_common.anubis -read CXM_http_get_common.anubis - - - *Overview* - Cookies are defined in RFC 2109. Here is the corresponding Anubis type: - - Each cookie has an server name (the name of the server who constructed the cookie), a - name, a value, and several attributes. - -public type Cookie: - cookie(String server_name, // of the server who sent the cookie - String name, // of the cookie - String value, // of the cookie - // attributes: - Maybe(String) comment, // cookies may have human readable comments - Maybe(String) domain, // domain name as sent by the server - Int validity, // cookie still valid if this is > now - Maybe(String) path, // server path for which the cookie is valid - Bool secure, // if true, do not send this cookie over an insecure link - Int version). // Cookie version (normally 1: rfc 2109) - - - Cookies are sent by servers through 'Set-Cookie' HTTP headers. The function - 'get_cookies' retrieves a list of cookies from a list of HTTP headers. - -public define List(Cookie) - get_cookies - ( - String server_name, // name of server who sent the cookies - List(HTTP_header) headers // HTTP headers sent by this server - ). - -public define Maybe(Cookie) - find_cookie - ( - String name, - List(Cookie) cookies - ). - - - - - - Normally, this function is used on the list of HTTP headers returned by either - 'http_get' of 'https_get'. - - - Before they can be sent back to their origin server, cookies must be reformated, in - order to produce 'Cookie' HTTP headers: - -public define List(HTTP_header) - reformat_cookies - ( - String server_name, - String uri, - List(Cookie) cookies - ). - - The result of 'reformat_cookies' may be appended to the list of headers given as - argument to 'http_get' or to 'https_get'. - - In the meantime, you may examine and maybe discard cookies, you may 'save' them into a - file, and 'retrieve' them later. - - - - - ------- That all for the public part. ------------------------------------------------- - - - Here is the syntax of a 'Set-Cookie' header (according to RFC 2109): - - set-cookie = "Set-Cookie:" cookies - cookies = 1#cookie - cookie = NAME "=" VALUE *(";" cookie-av) - NAME = token - VALUE = value - value = token | quoted-string - cookie-av = "Comment" "=" value - | "Domain" "=" value - | "Max-Age" "=" value - | "Path" "=" value - | "Secure" - | "Version" "=" 1*DIGIT - - - According to RFC 2616 (obsolating RFC 2068) defining HTTP 1.1, 'control characters' are - 0 to 31 and DEL (127). A 'separator' is one of: - - ( ) < > @ , ; : \ " / [ ] ? = { } 32(space) and 9(tab) " - - Now, a token is a non empty sequence of ASCII characters (0 to 127), but not including - any control character or any separator. As a consequence, characters admissible in a - 'RFC 2616 token' are: - - 33 ! - 35 to 39 # $ & ' - 42 43 * + - 45 46 - . - 48 to 57 0 ... 9 - 65 to 90 A ... Z - 94 to 122 ^ _ ` a ... z - 124 126 | ~ - -define Bool - is_token_char - ( - Word8 c - ) = - if c +< 33 then false else - if c +< 34 then true else - if c +< 35 then false else - if c +< 40 then true else - if c +< 42 then false else - if c +< 44 then true else - if c +< 45 then false else - if c +< 47 then true else - if c +< 48 then false else - if c +< 58 then true else - if c +< 65 then false else - if c +< 91 then true else - if c +< 94 then false else - if c +< 123 then true else - if c +< 124 then false else - if c = 124 then true else - c = 126. - - value char are token added of =, (, ) - -define Bool - is_value_char - ( - Word8 c - ) = - if c +< 33 then false else - if c +< 34 then true else - if c +< 35 then false else - if c +< 44 then true else - if c +< 45 then false else - if c +< 47 then true else - if c +< 48 then false else - if c +< 58 then true else - if c +< 61 then false else - if c +< 62 then true else - if c +< 65 then false else - if c +< 91 then true else - if c +< 94 then false else - if c +< 123 then true else - if c +< 124 then false else - if c = 124 then true else - c = 126. - - From the grammar, it is clear that atomic entities (called 'tokens' by YACC) are: - - - tokens (in the sens of RFC 2616) some of which have to be recognized as keywords - - quoted strings - - equal sign - - colon - - semi-colon - - Hence, the following type: - -public type Atom: - end_of_input, - error, - comment, - domain, - max_age, - path, - secure, - version, - token(String), - quoted_string(String), - equals, - colon, - semi_colon. - - - variable List(Atom) unput_atoms = []. - -type CookieToolBox: - tool_box(Var(List(Atom)) unput_atoms, - Var(String) input, - Var(Int) index, - Var(String) server_name - ). - -define One - unput_atom - ( - CookieToolBox tbx, - Atom a - ) = - unput_atoms(tbx) <- [a . *unput_atoms(tbx)]. - -define Atom - recognize_keyword - ( - String s - ) = - with l = to_lower(s), - if l = "comment" then comment else - if l = "domain" then domain else - if l = "max-age" then max_age else - if l = "path" then path else - if l = "secure" then secure else - if l = "version" then version else - token(s). - - - variable String input = "". From which cookies will be read. - variable Int index = 0. Current position within 'input'. - -define Maybe(Word8) - next_char - ( - CookieToolBox tbx - ) = - if tbx is tool_box(_, input, index, _) then - if nth(*index,*input) is - { - failure then failure, - success(c) then - index <- *index+1; - success(c) - }. - -define One - unput_char - ( - CookieToolBox tbx - ) = - if tbx is tool_box(_, _, index, _) then - index <- *index-1. - -define Atom - read_token - ( - CookieToolBox tbx, - List(Word8) so_far, // contains at least 1 character - (Word8) -> Bool is_valid_char - ) = - if next_char(tbx) is - { - failure then recognize_keyword(implode(reverse(so_far))), - success(c) then - if is_valid_char(c) - then read_token(tbx,[c . so_far], is_valid_char) - else unput_char(tbx); recognize_keyword(implode(reverse(so_far))) - }. - -define Atom - read_quoted_string - ( - CookieToolBox tbx, - List(Word8) so_far - ) = - if next_char(tbx) is - { - failure then quoted_string(implode(reverse(so_far))), - success(c) then - if c = '\"' - then quoted_string(implode(reverse(so_far))) - else read_quoted_string(tbx,[c . so_far]) - }. - -define Bool - is_blank - ( - Word8 c - ) = - c +=< ' '. - - Reading an atom from the input: - -define Atom - read_atom - ( - CookieToolBox tbx, - ) = - if *unput_atoms(tbx) is - { - [ ] then - if next_char(tbx) is - { - failure then end_of_input, - success(c) then - if is_blank(c) then read_atom(tbx) else // skip blanks - if is_token_char(c) then read_token(tbx,[c], is_token_char) else - if c = '\"' then read_quoted_string(tbx,[]) else - if c = '=' then equals else - if c = ':' then colon else - if c = ';' then semi_colon else - error - }, - [h . t] then - unput_atoms(tbx) <- t; h - }. - -define Atom - read_value - ( - CookieToolBox tbx - ) = - if *unput_atoms(tbx) is - { - [ ] then - if next_char(tbx) is - { - failure then end_of_input, - success(c) then - if is_blank(c) then read_value(tbx) else // skip blanks - if is_value_char(c) then read_token(tbx,[c], is_value_char) else - if c = '\"' then read_quoted_string(tbx,[]) else - if c = ';' then semi_colon else - error - }, - [h . t] then - unput_atoms(tbx) <- t; h - }. - - Reading an attribute-value pair. - -type AttrVal: - comment(String), - domain(String), - max_age(String), - path(String), - secure, - version(String). - -define String - read_eq_value - ( - CookieToolBox tbx - ) = - with e = read_atom(tbx), - if e is equals then - ( - with a = read_atom(tbx), - if a is token(n) then n else - if a is quoted_string(s) then s else - unput_atom(tbx,a); "" - ) - else unput_atom(tbx,e); "". - - -define Maybe(AttrVal) - read_attr_val - ( - CookieToolBox tbx - ) = - if read_atom(tbx) is semi_colon then - with a = read_atom(tbx), - if a is - { - end_of_input then failure, - error then failure, - comment then success(comment(read_eq_value(tbx))), - domain then success(domain(read_eq_value(tbx))), - max_age then success(max_age(read_eq_value(tbx))), - path then success(path(read_eq_value(tbx))), - secure then success(secure), - version then success(version(read_eq_value(tbx))), - token(_) then unput_atom(tbx,a); failure, - quoted_string(_) then unput_atom(tbx,a); failure, - equals then unput_atom(tbx,a); failure, - colon then unput_atom(tbx,a); failure, - semi_colon then unput_atom(tbx,a); failure, - } - else failure. - - - Getting attributes from a List(AttrVal). - -define Maybe(String) - get_comment - ( - List(AttrVal) l - ) = - if l is - { - [ ] then failure, - [h . t] then if h is comment(c) - then success(c) - else get_comment(t) - }. - -define Maybe(String) - get_domain - ( - List(AttrVal) l - ) = - if l is - { - [ ] then failure, - [h . t] then if h is domain(s) - then success(s) - else get_domain(t) - }. - -define Int - get_validity - ( - List(AttrVal) l - ) = - if l is - { - [ ] then 0, - [h . t] then if h is max_age(a) - then if decimal_scan(a) is - { - failure then 0, - success(n) then n+now - } - else get_validity(t) - }. - -define Maybe(String) - get_path - ( - List(AttrVal) l - ) = - if l is - { - [ ] then failure, - [h . t] then if h is path(p) - then success(p) - else get_path(t) - }. - -define Bool - get_secure - ( - List(AttrVal) l - ) = - if l is - { - [ ] then false, - [h . t] then if h is secure - then true - else get_secure(t) - }. - -define Int - get_version - ( - List(AttrVal) l - ) = - if l is - { - [ ] then 0, - [h . t] then if h is version(v) - then if decimal_scan(v) is - { - failure then 0, - success(n) then n - } - else get_version(t) - }. - - - Reading a cookie: - - variable String server_name = "". - -define Maybe(Cookie) - read_cookie_n_e_v - ( - CookieToolBox tbx, - String name, - String value, - List(AttrVal) so_far - ) = - if read_attr_val(tbx) is - { - failure then - success(cookie( - *server_name(tbx), - name, - value, - get_comment(so_far), - get_domain(so_far), - get_validity(so_far), - get_path(so_far), - get_secure(so_far), - get_version(so_far) - )), - - success(av) then read_cookie_n_e_v(tbx,name,value,[av . so_far]) - }. - -define Maybe(Cookie) - read_cookie_n_e - ( - CookieToolBox tbx, - String name - ) = - with a = read_value(tbx), - if a is token(value) then read_cookie_n_e_v(tbx,name,value,[]) else - if a is quoted_string(value) then read_cookie_n_e_v(tbx,name,value,[]) else - unput_atom(tbx,a); failure. - -define Maybe(Cookie) - read_cookie_n - ( - CookieToolBox tbx, // bis repetita placent - String name - ) = - with a = read_atom(tbx), - if a is equals - then read_cookie_n_e(tbx,name) - else unput_atom(tbx,a); failure. - - -define Maybe(Cookie) - read_cookie - ( - CookieToolBox tbx - ) = - with a = read_atom(tbx), - if a is token(name) - then read_cookie_n(tbx,name) - else unput_atom(tbx,a); failure. - - -define List(Cookie) - read_cookies - ( - CookieToolBox tbx, - List(Cookie) so_far - ) = - if read_cookie(tbx) is - { - failure then so_far, - success(c) then read_cookies(tbx,[c . so_far]) - }. - - -define List(Cookie) - get_cookies - ( - String svn, - HTTP_header h - ) = - if h is http_header(n,v) then - if to_lower(n) = "set-cookie" - then read_cookies(tool_box(var([]),var(v),var(0),var(svn)),[]) - else []. - -public define List(Cookie) - get_cookies - ( - String server_name, - List(HTTP_header) headers - ) = - if headers is - { - [ ] then [ ], - [h . t] then - append(get_cookies(server_name,h),get_cookies(server_name,t)) - }. - -define List(Cookie) - server_get_cookies - ( - HTTP_header h - ) = - if h is http_header(n,v) then - if to_lower(n) = "cookie" - then read_cookies(tool_box(var([]),var(v),var(0),var("")),[]) - else []. - -public define List(Cookie) - server_get_cookies - ( - // String server_name, - List(HTTP_header) headers - ) = - if headers is - { - [ ] then [ ], - [h . t] then - append(server_get_cookies(h), server_get_cookies(t)) - }. - -public define Maybe(Cookie) - find_cookie - ( - String name, - List(Cookie) cookies - ) - = - if cookies is - { - [] then failure, - [h . t] then - if h is cookie(s, n, v, _, _, _, _, _, _) then - if name = n then success(h) - else find_cookie(name, t) - }. - -public define String - get_cookie_value - ( - String name, - List(Cookie) cookies - ) - = - if find_cookie(name, cookies) is - { - failure then "", - success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v - }. - - *** Reformating cookies. ************************************************************** - - Cookies should be resent reformated according to the following grammar (copy-pasted - from RFC 2109): - - cookie = "Cookie:" cookie-version - 1*((";" | ",") cookie-value) - cookie-value = NAME "=" VALUE [";" path] [";" domain] - cookie-version = "$Version" "=" value - NAME = attr - VALUE = value - path = "$Path" "=" value - domain = "$Domain" "=" value - - -define HTTP_header - reformat_cookie - ( - Cookie c - ) = - if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then - http_header("Cookie", - "$Version=" + to_decimal(ver) + - ";" + n + "=\"" + v + "\"" + - if mbp is - { - failure then "", - success(p) then ";$Path=\"" + p + "\"" - } + - if mbd is - { - failure then "", - success(d) then ";$Domain=\"" + d + "\"" - } - ). - - - According to RFC 2109, a cookie may be sent to a server if: - - (1) server name in the cookie is the name of the server, - (2) if 'Path' attribute is present, its value must match the URI, - (3) the cookie is still valid (validity = 0 means indefinitely valid). - - define Bool - path_match - ( - Maybe(String) cookie_path, - String uri - ) = - if cookie_path is - { - failure then true, - success(p) then - - }. - - - Checking if the path matches: - - -define Bool - path_match - ( - Maybe(String) mbp, - String uri - ) = - true. - - - The next function verifies if a cookie satisfies the rules. - -define Bool - may_resend_cookie - ( - String server_name, - String uri, - Cookie c - ) = - if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then - if sn = server_name - then ( - if path_match(mbp,uri) - then ( - if vld = 0 then true else vld > now - ) - else false - ) - else false. - - - The next function reformat all cookies which satisfy the 'resend' rules. - -public define List(HTTP_header) - reformat_cookies - ( - String server_name, - String uri, - List(Cookie) cookies - ) = - if cookies is - { - [ ] then [ ], - [h . t] then - if may_resend_cookie(server_name,uri,h) - then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)] - else reformat_cookies(server_name,uri,t) - }. - - - - - - See test_cookies.anubis for a test of this program. - - - - - - - - - + + *Project* The Anubis Project + + *Title* Managing Cookies. + + *Copyright* Copyright (c) Alain Prouté 2001. + + + *Author* Alain Prouté + + + + +read tools/basis.anubis +read system/string.anubis +read CXM_common.anubis +read CXM_http_get_common.anubis + + + *Overview* + Cookies are defined in RFC 2109. Here is the corresponding Anubis type: + + Each cookie has an server name (the name of the server who constructed the cookie), a + name, a value, and several attributes. + +public type Cookie: + cookie(String server_name, // of the server who sent the cookie + String name, // of the cookie + String value, // of the cookie + // attributes: + Maybe(String) comment, // cookies may have human readable comments + Maybe(String) domain, // domain name as sent by the server + Int validity, // cookie still valid if this is > now + Maybe(String) path, // server path for which the cookie is valid + Bool secure, // if true, do not send this cookie over an insecure link + Int version). // Cookie version (normally 1: rfc 2109) + + + Cookies are sent by servers through 'Set-Cookie' HTTP headers. The function + 'get_cookies' retrieves a list of cookies from a list of HTTP headers. + +public define List(Cookie) + get_cookies + ( + String server_name, // name of server who sent the cookies + List(HTTP_header) headers // HTTP headers sent by this server + ). + +public define Maybe(Cookie) + find_cookie + ( + String name, + List(Cookie) cookies + ). + + + + + + Normally, this function is used on the list of HTTP headers returned by either + 'http_get' of 'https_get'. + + + Before they can be sent back to their origin server, cookies must be reformated, in + order to produce 'Cookie' HTTP headers: + +public define List(HTTP_header) + reformat_cookies + ( + String server_name, + String uri, + List(Cookie) cookies + ). + + The result of 'reformat_cookies' may be appended to the list of headers given as + argument to 'http_get' or to 'https_get'. + + In the meantime, you may examine and maybe discard cookies, you may 'save' them into a + file, and 'retrieve' them later. + + + + + ------- That all for the public part. ------------------------------------------------- + + + Here is the syntax of a 'Set-Cookie' header (according to RFC 2109): + + set-cookie = "Set-Cookie:" cookies + cookies = 1#cookie + cookie = NAME "=" VALUE *(";" cookie-av) + NAME = token + VALUE = value + value = token | quoted-string + cookie-av = "Comment" "=" value + | "Domain" "=" value + | "Max-Age" "=" value + | "Path" "=" value + | "Secure" + | "Version" "=" 1*DIGIT + + + According to RFC 2616 (obsolating RFC 2068) defining HTTP 1.1, 'control characters' are + 0 to 31 and DEL (127). A 'separator' is one of: + + ( ) < > @ , ; : \ " / [ ] ? = { } 32(space) and 9(tab) " + + Now, a token is a non empty sequence of ASCII characters (0 to 127), but not including + any control character or any separator. As a consequence, characters admissible in a + 'RFC 2616 token' are: + + 33 ! + 35 to 39 # $ & ' + 42 43 * + + 45 46 - . + 48 to 57 0 ... 9 + 65 to 90 A ... Z + 94 to 122 ^ _ ` a ... z + 124 126 | ~ + +define Bool + is_token_char + ( + Word8 c + ) = + if c +< 33 then false else + if c +< 34 then true else + if c +< 35 then false else + if c +< 40 then true else + if c +< 42 then false else + if c +< 44 then true else + if c +< 45 then false else + if c +< 47 then true else + if c +< 48 then false else + if c +< 58 then true else + if c +< 65 then false else + if c +< 91 then true else + if c +< 94 then false else + if c +< 123 then true else + if c +< 124 then false else + if c = 124 then true else + c = 126. + + value char are token added of =, (, ) + +define Bool + is_value_char + ( + Word8 c + ) = + if c +< 33 then false else // space in not allowed in value + if c +< 34 then true else + if c +< 35 then false else // " is not allowed in value + if c +< 44 then true else + if c +< 45 then false else // , is not allowed in value + //if c +< 47 then true else + //if c +< 48 then false else + if c +< 59 then true else + if c +< 60 then false else // ; not allowed in value + //if c +< 62 then true else + //if c +< 65 then false else + //if c +< 91 then true else + //if c +< 94 then false else + //if c +< 123 then true else + //if c +< 124 then false else + //if c = 124 then true else + //c = 126. + if c +< 127 then true + else + false. + + From the grammar, it is clear that atomic entities (called 'tokens' by YACC) are: + + - tokens (in the sens of RFC 2616) some of which have to be recognized as keywords + - quoted strings + - equal sign + - colon + - semi-colon + + Hence, the following type: + +public type Atom: + end_of_input, + error, + comment, + domain, + max_age, + path, + secure, + version, + token(String), + quoted_string(String), + equals, + colon, + semi_colon. + + + variable List(Atom) unput_atoms = []. + +type CookieToolBox: + tool_box(Var(List(Atom)) unput_atoms, + Var(String) input, + Var(Int) index, + Var(String) server_name + ). + +define One + unput_atom + ( + CookieToolBox tbx, + Atom a + ) = + unput_atoms(tbx) <- [a . *unput_atoms(tbx)]. + +define Atom + recognize_keyword + ( + String s + ) = + with l = to_lower(s), + if l = "comment" then comment else + if l = "domain" then domain else + if l = "max-age" then max_age else + if l = "path" then path else + if l = "secure" then secure else + if l = "version" then version else + token(s). + + + variable String input = "". From which cookies will be read. + variable Int index = 0. Current position within 'input'. + +define Maybe(Word8) + next_char + ( + CookieToolBox tbx + ) = + if tbx is tool_box(_, input, index, _) then + if nth(*index,*input) is + { + failure then failure, + success(c) then + index <- *index+1; + success(c) + }. + +define One + unput_char + ( + CookieToolBox tbx + ) = + if tbx is tool_box(_, _, index, _) then + index <- *index-1. + +define Atom + read_token + ( + CookieToolBox tbx, + List(Word8) so_far, // contains at least 1 character + (Word8) -> Bool is_valid_char + ) = + if next_char(tbx) is + { + failure then recognize_keyword(implode(reverse(so_far))), + success(c) then + if is_valid_char(c) + then read_token(tbx,[c . so_far], is_valid_char) + else unput_char(tbx); recognize_keyword(implode(reverse(so_far))) + }. + +define Atom + read_quoted_string + ( + CookieToolBox tbx, + List(Word8) so_far + ) = + if next_char(tbx) is + { + failure then quoted_string(implode(reverse(so_far))), + success(c) then + if c = '\"' + then quoted_string(implode(reverse(so_far))) + else read_quoted_string(tbx,[c . so_far]) + }. + +define Bool + is_blank + ( + Word8 c + ) = + c +=< ' '. + + Reading an atom from the input: + +define Atom + read_atom + ( + CookieToolBox tbx, + ) = + if *unput_atoms(tbx) is + { + [ ] then + if next_char(tbx) is + { + failure then end_of_input, + success(c) then + if is_blank(c) then read_atom(tbx) else // skip blanks + if is_token_char(c) then read_token(tbx,[c], is_token_char) else + if c = '\"' then read_quoted_string(tbx,[]) else + if c = '=' then equals else + if c = ':' then colon else + if c = ';' then semi_colon else + error + }, + [h . t] then + unput_atoms(tbx) <- t; h + }. + +define Atom + read_value + ( + CookieToolBox tbx + ) = + if *unput_atoms(tbx) is + { + [ ] then + if next_char(tbx) is + { + failure then end_of_input, + success(c) then + if is_blank(c) then read_value(tbx) else // skip blanks + if is_value_char(c) then read_token(tbx,[c], is_value_char) else + if c = '\"' then read_quoted_string(tbx,[]) else + if c = ';' then semi_colon else + //println("cookie read value char ["+c+"] is an error"); + error + }, + [h . t] then + unput_atoms(tbx) <- t; h + }. + + Reading an attribute-value pair. + +type AttrVal: + comment(String), + domain(String), + max_age(String), + path(String), + secure, + version(String). + +define String + read_eq_value + ( + CookieToolBox tbx + ) = + with e = read_atom(tbx), + if e is equals then + ( + with a = read_atom(tbx), + if a is token(n) then n else + if a is quoted_string(s) then s else + unput_atom(tbx,a); "" + ) + else unput_atom(tbx,e); "". + + +define Maybe(AttrVal) + read_attr_val + ( + CookieToolBox tbx + ) = + if read_atom(tbx) is semi_colon then + with a = read_atom(tbx), + if a is + { + end_of_input then failure, + error then failure, + comment then success(comment(read_eq_value(tbx))), + domain then success(domain(read_eq_value(tbx))), + max_age then success(max_age(read_eq_value(tbx))), + path then success(path(read_eq_value(tbx))), + secure then success(secure), + version then success(version(read_eq_value(tbx))), + token(_) then unput_atom(tbx,a); failure, + quoted_string(_) then unput_atom(tbx,a); failure, + equals then unput_atom(tbx,a); failure, + colon then unput_atom(tbx,a); failure, + semi_colon then unput_atom(tbx,a); failure, + } + else failure. + + + Getting attributes from a List(AttrVal). + +define Maybe(String) + get_comment + ( + List(AttrVal) l + ) = + if l is + { + [ ] then failure, + [h . t] then if h is comment(c) + then success(c) + else get_comment(t) + }. + +define Maybe(String) + get_domain + ( + List(AttrVal) l + ) = + if l is + { + [ ] then failure, + [h . t] then if h is domain(s) + then success(s) + else get_domain(t) + }. + +define Int + get_validity + ( + List(AttrVal) l + ) = + if l is + { + [ ] then 0, + [h . t] then if h is max_age(a) + then if decimal_scan(a) is + { + failure then 0, + success(n) then n+now + } + else get_validity(t) + }. + +define Maybe(String) + get_path + ( + List(AttrVal) l + ) = + if l is + { + [ ] then failure, + [h . t] then if h is path(p) + then success(p) + else get_path(t) + }. + +define Bool + get_secure + ( + List(AttrVal) l + ) = + if l is + { + [ ] then false, + [h . t] then if h is secure + then true + else get_secure(t) + }. + +define Int + get_version + ( + List(AttrVal) l + ) = + if l is + { + [ ] then 0, + [h . t] then if h is version(v) + then if decimal_scan(v) is + { + failure then 0, + success(n) then n + } + else get_version(t) + }. + + + Reading a cookie: + + variable String server_name = "". + +define Maybe(Cookie) + read_cookie_n_e_v + ( + CookieToolBox tbx, + String name, + String value, + List(AttrVal) so_far + ) = + if read_attr_val(tbx) is + { + failure then + success(cookie( + *server_name(tbx), + name, + value, + get_comment(so_far), + get_domain(so_far), + get_validity(so_far), + get_path(so_far), + get_secure(so_far), + get_version(so_far) + )), + + success(av) then read_cookie_n_e_v(tbx,name,value,[av . so_far]) + }. + +define Maybe(Cookie) + read_cookie_n_e + ( + CookieToolBox tbx, + String name + ) = + with a = read_value(tbx), + if a is token(value) then + //println("read_cookie_n_e name["+name+"] value ["+value+"]"); + read_cookie_n_e_v(tbx,name,value,[]) else + if a is quoted_string(value) then read_cookie_n_e_v(tbx,name,value,[]) else + unput_atom(tbx,a); failure. + +define Maybe(Cookie) + read_cookie_n + ( + CookieToolBox tbx, // bis repetita placent + String name + ) = + with a = read_atom(tbx), + if a is equals + then read_cookie_n_e(tbx,name) + else unput_atom(tbx,a); failure. + + +define Maybe(Cookie) + read_cookie + ( + CookieToolBox tbx + ) = + with a = read_atom(tbx), + if a is token(name) + then read_cookie_n(tbx,name) + else unput_atom(tbx,a); failure. + + +define List(Cookie) + read_cookies + ( + CookieToolBox tbx, + List(Cookie) so_far + ) = + if read_cookie(tbx) is + { + failure then so_far, + success(c) then read_cookies(tbx,[c . so_far]) + }. + + +define List(Cookie) + get_cookies + ( + String svn, + HTTP_header h + ) = + if h is http_header(n,v) then + if to_lower(n) = "set-cookie" + then read_cookies(tool_box(var([]),var(v),var(0),var(svn)),[]) + else []. + +public define List(Cookie) + get_cookies + ( + String server_name, + List(HTTP_header) headers + ) = + if headers is + { + [ ] then [ ], + [h . t] then + append(get_cookies(server_name,h),get_cookies(server_name,t)) + }. + +define List(Cookie) + server_get_cookies + ( + HTTP_header h + ) = + if h is http_header(n,v) then + if to_lower(n) = "cookie" + then read_cookies(tool_box(var([]),var(v),var(0),var("")),[]) + else []. + +public define List(Cookie) + server_get_cookies + ( + // String server_name, + List(HTTP_header) headers + ) = + if headers is + { + [ ] then [ ], + [h . t] then + append(server_get_cookies(h), server_get_cookies(t)) + }. + +public define Maybe(Cookie) + find_cookie + ( + String name, + List(Cookie) cookies + ) + = + if cookies is + { + [] then failure, + [h . t] then + if h is cookie(s, n, v, _, _, _, _, _, _) then + if name = n then success(h) + else find_cookie(name, t) + }. + +public define String + get_cookie_value + ( + String name, + List(Cookie) cookies + ) + = + if find_cookie(name, cookies) is + { + failure then "", + success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v + }. + + *** Reformating cookies. ************************************************************** + + Cookies should be resent reformated according to the following grammar (copy-pasted + from RFC 2109): + + cookie = "Cookie:" cookie-version + 1*((";" | ",") cookie-value) + cookie-value = NAME "=" VALUE [";" path] [";" domain] + cookie-version = "$Version" "=" value + NAME = attr + VALUE = value + path = "$Path" "=" value + domain = "$Domain" "=" value + + +define HTTP_header + reformat_cookie + ( + Cookie c + ) = + if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then + http_header("Cookie", + "$Version=" + to_decimal(ver) + + ";" + n + "=\"" + v + "\"" + + if mbp is + { + failure then "", + success(p) then ";$Path=\"" + p + "\"" + } + + if mbd is + { + failure then "", + success(d) then ";$Domain=\"" + d + "\"" + } + ). + + + According to RFC 2109, a cookie may be sent to a server if: + + (1) server name in the cookie is the name of the server, + (2) if 'Path' attribute is present, its value must match the URI, + (3) the cookie is still valid (validity = 0 means indefinitely valid). + + define Bool + path_match + ( + Maybe(String) cookie_path, + String uri + ) = + if cookie_path is + { + failure then true, + success(p) then + + }. + + + Checking if the path matches: + + +define Bool + path_match + ( + Maybe(String) mbp, + String uri + ) = + true. + + + The next function verifies if a cookie satisfies the rules. + +define Bool + may_resend_cookie + ( + String server_name, + String uri, + Cookie c + ) = + if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then + if sn = server_name + then ( + if path_match(mbp,uri) + then ( + if vld = 0 then true else vld > now + ) + else false + ) + else false. + + + The next function reformat all cookies which satisfy the 'resend' rules. + +public define List(HTTP_header) + reformat_cookies + ( + String server_name, + String uri, + List(Cookie) cookies + ) = + if cookies is + { + [ ] then [ ], + [h . t] then + if may_resend_cookie(server_name,uri,h) + then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)] + else reformat_cookies(server_name,uri,t) + }. + + + + + + See test_cookies.anubis for a test of this program. + diff --git a/web/CXM_making_a_web_site.anubis b/web/CXM_making_a_web_site.anubis index 4083b3b..127d7ae 100644 --- a/web/CXM_making_a_web_site.anubis +++ b/web/CXM_making_a_web_site.anubis @@ -2348,11 +2348,11 @@ define (List(Web_arg) lwa, HTTP_Info info) -> Separated_Web_Args($State) if find_cookie("state_"+website_name, server_get_cookies(http_headers(info))) is { failure then - /*println("find_cookie(\"state_"+website_name+"\" failure");*/ + //println("find_cookie(\"state_"+website_name+"\" failure"); swa(not_found,failure,[]), success(cookie) then - /*println("find_cookie(\"state_"+website_name+"\" success");*/ + //println("find_cookie(\"state_"+website_name+"\" success"); swa(retrieve_state(value(cookie)),failure,[]) }, @@ -2614,11 +2614,11 @@ public define Web_Site }, out_of_date(state) then - //println("out_of_date"); + //println("previous out_of_date"); ticket_expired_state(state, mb_action_name, http_info,operands,is_https), still_valid(state) then - //println("still_valid"); + //println("previous still_valid"); if mb_action_name is { failure then state, -- libgit2 0.21.4