Commit bf4f26d58c332369fab9e5020154b8d0fa2da3ea
1 parent
08e3d89e
fix cookies read values. Now read all allowed char like :/= etc...
Showing
2 changed files
with
755 additions
and
757 deletions
Show diff stats
web/CXM_cookies.anubis
| 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
| @@ -2348,11 +2348,11 @@ define (List(Web_arg) lwa, HTTP_Info info) -> Separated_Web_Args($State) | @@ -2348,11 +2348,11 @@ define (List(Web_arg) lwa, HTTP_Info info) -> 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, |