Commit e88c944b25a154d938edc31c91f017fa5c9660b7
1 parent
5ee747e8
update the calexium lib to be compatible with anubis compiler 1.12.2.0. especial…
…ly replace alert by should_not_happen and "connect to file" by file Remove obsolete file CXM_html.anubis
Showing
3 changed files
with
4731 additions
and
7127 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_html.anubis | ||
| 18 | -read CXM_http_get_common.anubis | ||
| 19 | - | ||
| 20 | - | ||
| 21 | - *Overview* | ||
| 22 | - Cookies are defined in RFC 2109. Here is the corresponding Anubis type: | ||
| 23 | - | ||
| 24 | - Each cookie has an server name (the name of the server who constructed the cookie), a | ||
| 25 | - name, a value, and several attributes. | ||
| 26 | - | ||
| 27 | -public type Cookie: | ||
| 28 | - cookie(String server_name, // of the server who sent the cookie | ||
| 29 | - String name, // of the cookie | ||
| 30 | - String value, // of the cookie | ||
| 31 | - // attributes: | ||
| 32 | - Maybe(String) comment, // cookies may have human readable comments | ||
| 33 | - Maybe(String) domain, // domain name as sent by the server | ||
| 34 | - Int validity, // cookie still valid if this is > now | ||
| 35 | - Maybe(String) path, // server path for which the cookie is valid | ||
| 36 | - Bool secure, // if true, do not send this cookie over an insecure link | ||
| 37 | - Int version). // Cookie version (normally 1: rfc 2109) | ||
| 38 | - | ||
| 39 | - | ||
| 40 | - Cookies are sent by servers through 'Set-Cookie' HTTP headers. The function | ||
| 41 | - 'get_cookies' retrieves a list of cookies from a list of HTTP headers. | ||
| 42 | - | ||
| 43 | -public define List(Cookie) | ||
| 44 | - get_cookies | ||
| 45 | - ( | ||
| 46 | - String server_name, // name of server who sent the cookies | ||
| 47 | - List(HTTP_header) headers // HTTP headers sent by this server | ||
| 48 | - ). | ||
| 49 | - | ||
| 50 | -public define Maybe(Cookie) | ||
| 51 | - find_cookie | ||
| 52 | - ( | ||
| 53 | - String name, | ||
| 54 | - List(Cookie) cookies | ||
| 55 | - ). | ||
| 56 | - | ||
| 57 | - | ||
| 58 | - | ||
| 59 | - | ||
| 60 | - | ||
| 61 | - Normally, this function is used on the list of HTTP headers returned by either | ||
| 62 | - 'http_get' of 'https_get'. | ||
| 63 | - | ||
| 64 | - | ||
| 65 | - Before they can be sent back to their origin server, cookies must be reformated, in | ||
| 66 | - order to produce 'Cookie' HTTP headers: | ||
| 67 | - | ||
| 68 | -public define List(HTTP_header) | ||
| 69 | - reformat_cookies | ||
| 70 | - ( | ||
| 71 | - String server_name, | ||
| 72 | - String uri, | ||
| 73 | - List(Cookie) cookies | ||
| 74 | - ). | ||
| 75 | - | ||
| 76 | - The result of 'reformat_cookies' may be appended to the list of headers given as | ||
| 77 | - argument to 'http_get' or to 'https_get'. | ||
| 78 | - | ||
| 79 | - In the meantime, you may examine and maybe discard cookies, you may 'save' them into a | ||
| 80 | - file, and 'retrieve' them later. | ||
| 81 | - | ||
| 82 | - | ||
| 83 | - | ||
| 84 | - | ||
| 85 | - ------- That all for the public part. ------------------------------------------------- | ||
| 86 | - | ||
| 87 | - | ||
| 88 | - Here is the syntax of a 'Set-Cookie' header (according to RFC 2109): | ||
| 89 | - | ||
| 90 | - set-cookie = "Set-Cookie:" cookies | ||
| 91 | - cookies = 1#cookie | ||
| 92 | - cookie = NAME "=" VALUE *(";" cookie-av) | ||
| 93 | - NAME = token | ||
| 94 | - VALUE = value | ||
| 95 | - value = token | quoted-string | ||
| 96 | - cookie-av = "Comment" "=" value | ||
| 97 | - | "Domain" "=" value | ||
| 98 | - | "Max-Age" "=" value | ||
| 99 | - | "Path" "=" value | ||
| 100 | - | "Secure" | ||
| 101 | - | "Version" "=" 1*DIGIT | ||
| 102 | - | ||
| 103 | - | ||
| 104 | - According to RFC 2616 (obsolating RFC 2068) defining HTTP 1.1, 'control characters' are | ||
| 105 | - 0 to 31 and DEL (127). A 'separator' is one of: | ||
| 106 | - | ||
| 107 | - ( ) < > @ , ; : \ " / [ ] ? = { } 32(space) and 9(tab) " | ||
| 108 | - | ||
| 109 | - Now, a token is a non empty sequence of ASCII characters (0 to 127), but not including | ||
| 110 | - any control character or any separator. As a consequence, characters admissible in a | ||
| 111 | - 'RFC 2616 token' are: | ||
| 112 | - | ||
| 113 | - 33 ! | ||
| 114 | - 35 to 39 # $ & ' | ||
| 115 | - 42 43 * + | ||
| 116 | - 45 46 - . | ||
| 117 | - 48 to 57 0 ... 9 | ||
| 118 | - 65 to 90 A ... Z | ||
| 119 | - 94 to 122 ^ _ ` a ... z | ||
| 120 | - 124 126 | ~ | ||
| 121 | - | ||
| 122 | -define Bool | ||
| 123 | - is_token_char | ||
| 124 | - ( | ||
| 125 | - Word8 c | ||
| 126 | - ) = | ||
| 127 | - if c +< 33 then false else | ||
| 128 | - if c +< 34 then true else | ||
| 129 | - if c +< 35 then false else | ||
| 130 | - if c +< 40 then true else | ||
| 131 | - if c +< 42 then false else | ||
| 132 | - if c +< 44 then true else | ||
| 133 | - if c +< 45 then false else | ||
| 134 | - if c +< 47 then true else | ||
| 135 | - if c +< 48 then false else | ||
| 136 | - if c +< 58 then true else | ||
| 137 | - if c +< 65 then false else | ||
| 138 | - if c +< 91 then true else | ||
| 139 | - if c +< 94 then false else | ||
| 140 | - if c +< 123 then true else | ||
| 141 | - if c +< 124 then false else | ||
| 142 | - if c = 124 then true else | ||
| 143 | - c = 126. | ||
| 144 | - | ||
| 145 | - value char are token added of =, (, ) | ||
| 146 | - | ||
| 147 | -define Bool | ||
| 148 | - is_value_char | ||
| 149 | - ( | ||
| 150 | - Word8 c | ||
| 151 | - ) = | ||
| 152 | - if c +< 33 then false else | ||
| 153 | - if c +< 34 then true else | ||
| 154 | - if c +< 35 then false else | ||
| 155 | - if c +< 44 then true else | ||
| 156 | - if c +< 45 then false else | ||
| 157 | - if c +< 47 then true else | ||
| 158 | - if c +< 48 then false else | ||
| 159 | - if c +< 58 then true else | ||
| 160 | - if c +< 61 then false else | ||
| 161 | - if c +< 62 then true else | ||
| 162 | - if c +< 65 then false else | ||
| 163 | - if c +< 91 then true else | ||
| 164 | - if c +< 94 then false else | ||
| 165 | - if c +< 123 then true else | ||
| 166 | - if c +< 124 then false else | ||
| 167 | - if c = 124 then true else | ||
| 168 | - c = 126. | ||
| 169 | - | ||
| 170 | - From the grammar, it is clear that atomic entities (called 'tokens' by YACC) are: | ||
| 171 | - | ||
| 172 | - - tokens (in the sens of RFC 2616) some of which have to be recognized as keywords | ||
| 173 | - - quoted strings | ||
| 174 | - - equal sign | ||
| 175 | - - colon | ||
| 176 | - - semi-colon | ||
| 177 | - | ||
| 178 | - Hence, the following type: | ||
| 179 | - | ||
| 180 | -public type Atom: | ||
| 181 | - end_of_input, | ||
| 182 | - error, | ||
| 183 | - comment, | ||
| 184 | - domain, | ||
| 185 | - max_age, | ||
| 186 | - path, | ||
| 187 | - secure, | ||
| 188 | - version, | ||
| 189 | - token(String), | ||
| 190 | - quoted_string(String), | ||
| 191 | - equals, | ||
| 192 | - colon, | ||
| 193 | - semi_colon. | ||
| 194 | - | ||
| 195 | - | ||
| 196 | -variable List(Atom) unput_atoms = []. | ||
| 197 | - | ||
| 198 | -define One | ||
| 199 | - unput_atom | ||
| 200 | - ( | ||
| 201 | - Atom a | ||
| 202 | - ) = | ||
| 203 | - unput_atoms <- [a . *unput_atoms]. | ||
| 204 | - | ||
| 205 | -define Atom | ||
| 206 | - recognize_keyword | ||
| 207 | - ( | ||
| 208 | - String s | ||
| 209 | - ) = | ||
| 210 | - with l = to_lower(s), | ||
| 211 | - if l = "comment" then comment else | ||
| 212 | - if l = "domain" then domain else | ||
| 213 | - if l = "max-age" then max_age else | ||
| 214 | - if l = "path" then path else | ||
| 215 | - if l = "secure" then secure else | ||
| 216 | - if l = "version" then version else | ||
| 217 | - token(s). | ||
| 218 | - | ||
| 219 | - | ||
| 220 | -variable String input = "". From which cookies will be read. | ||
| 221 | -variable Int index = 0. Current position within 'input'. | ||
| 222 | - | ||
| 223 | -define Maybe(Word8) | ||
| 224 | - next_char | ||
| 225 | - = | ||
| 226 | - if nth(*index,*input) is | ||
| 227 | - { | ||
| 228 | - failure then failure, | ||
| 229 | - success(c) then | ||
| 230 | - index <- *index+1; | ||
| 231 | - success(c) | ||
| 232 | - }. | ||
| 233 | - | ||
| 234 | -define One | ||
| 235 | - unput_char | ||
| 236 | - = | ||
| 237 | - index <- *index-1. | ||
| 238 | - | ||
| 239 | -define Atom | ||
| 240 | - read_token | ||
| 241 | - ( | ||
| 242 | - List(Word8) so_far, // contains at least 1 character | ||
| 243 | - (Word8) -> Bool is_valid_char | ||
| 244 | - ) = | ||
| 245 | - if next_char is | ||
| 246 | - { | ||
| 247 | - failure then recognize_keyword(implode(reverse(so_far))), | ||
| 248 | - success(c) then | ||
| 249 | - if is_valid_char(c) | ||
| 250 | - then read_token([c . so_far], is_valid_char) | ||
| 251 | - else unput_char; recognize_keyword(implode(reverse(so_far))) | ||
| 252 | - }. | ||
| 253 | - | ||
| 254 | -define Atom | ||
| 255 | - read_quoted_string | ||
| 256 | - ( | ||
| 257 | - List(Word8) so_far | ||
| 258 | - ) = | ||
| 259 | - if next_char is | ||
| 260 | - { | ||
| 261 | - failure then quoted_string(implode(reverse(so_far))), | ||
| 262 | - success(c) then | ||
| 263 | - if c = '\"' | ||
| 264 | - then quoted_string(implode(reverse(so_far))) | ||
| 265 | - else read_quoted_string([c . so_far]) | ||
| 266 | - }. | ||
| 267 | - | ||
| 268 | -define Bool | ||
| 269 | - is_blank | ||
| 270 | - ( | ||
| 271 | - Word8 c | ||
| 272 | - ) = | ||
| 273 | - c +=< ' '. | ||
| 274 | - | ||
| 275 | - Reading an atom from the input: | ||
| 276 | - | ||
| 277 | -define Atom | ||
| 278 | - read_atom | ||
| 279 | - = | ||
| 280 | - if *unput_atoms is | ||
| 281 | - { | ||
| 282 | - [ ] then | ||
| 283 | - if next_char is | ||
| 284 | - { | ||
| 285 | - failure then end_of_input, | ||
| 286 | - success(c) then | ||
| 287 | - if is_blank(c) then read_atom else // skip blanks | ||
| 288 | - if is_token_char(c) then read_token([c], is_token_char) else | ||
| 289 | - if c = '\"' then read_quoted_string([]) else | ||
| 290 | - if c = '=' then equals else | ||
| 291 | - if c = ':' then colon else | ||
| 292 | - if c = ';' then semi_colon else | ||
| 293 | - error | ||
| 294 | - }, | ||
| 295 | - [h . t] then | ||
| 296 | - unput_atoms <- t; h | ||
| 297 | - }. | ||
| 298 | - | ||
| 299 | -define Atom | ||
| 300 | - read_value | ||
| 301 | - = | ||
| 302 | - if *unput_atoms is | ||
| 303 | - { | ||
| 304 | - [ ] then | ||
| 305 | - if next_char is | ||
| 306 | - { | ||
| 307 | - failure then end_of_input, | ||
| 308 | - success(c) then | ||
| 309 | - if is_blank(c) then read_value else // skip blanks | ||
| 310 | - if is_value_char(c) then read_token([c], is_value_char) else | ||
| 311 | - if c = '\"' then read_quoted_string([]) else | ||
| 312 | - if c = ';' then semi_colon else | ||
| 313 | - error | ||
| 314 | - }, | ||
| 315 | - [h . t] then | ||
| 316 | - unput_atoms <- t; h | ||
| 317 | - }. | ||
| 318 | - | ||
| 319 | - Reading an attribute-value pair. | ||
| 320 | - | ||
| 321 | -type AttrVal: | ||
| 322 | - comment(String), | ||
| 323 | - domain(String), | ||
| 324 | - max_age(String), | ||
| 325 | - path(String), | ||
| 326 | - secure, | ||
| 327 | - version(String). | ||
| 328 | - | ||
| 329 | -define String | ||
| 330 | - read_eq_value | ||
| 331 | - = | ||
| 332 | - with e = read_atom, | ||
| 333 | - if e is equals then | ||
| 334 | - ( | ||
| 335 | - with a = read_atom, | ||
| 336 | - if a is token(n) then n else | ||
| 337 | - if a is quoted_string(s) then s else | ||
| 338 | - unput_atom(a); "" | ||
| 339 | - ) | ||
| 340 | - else unput_atom(e); "". | ||
| 341 | - | ||
| 342 | - | ||
| 343 | -define Maybe(AttrVal) | ||
| 344 | - read_attr_val | ||
| 345 | - = | ||
| 346 | - if read_atom is semi_colon then | ||
| 347 | - with a = read_atom, | ||
| 348 | - if a is | ||
| 349 | - { | ||
| 350 | - end_of_input then failure, | ||
| 351 | - error then failure, | ||
| 352 | - comment then success(comment(read_eq_value)), | ||
| 353 | - domain then success(domain(read_eq_value)), | ||
| 354 | - max_age then success(max_age(read_eq_value)), | ||
| 355 | - path then success(path(read_eq_value)), | ||
| 356 | - secure then success(secure), | ||
| 357 | - version then success(version(read_eq_value)), | ||
| 358 | - token(_) then unput_atom(a); failure, | ||
| 359 | - quoted_string(_) then unput_atom(a); failure, | ||
| 360 | - equals then unput_atom(a); failure, | ||
| 361 | - colon then unput_atom(a); failure, | ||
| 362 | - semi_colon then unput_atom(a); failure, | ||
| 363 | - } | ||
| 364 | - else failure. | ||
| 365 | - | ||
| 366 | - | ||
| 367 | - Getting attributes from a List(AttrVal). | ||
| 368 | - | ||
| 369 | -define Maybe(String) | ||
| 370 | - get_comment | ||
| 371 | - ( | ||
| 372 | - List(AttrVal) l | ||
| 373 | - ) = | ||
| 374 | - if l is | ||
| 375 | - { | ||
| 376 | - [ ] then failure, | ||
| 377 | - [h . t] then if h is comment(c) | ||
| 378 | - then success(c) | ||
| 379 | - else get_comment(t) | ||
| 380 | - }. | ||
| 381 | - | ||
| 382 | -define Maybe(String) | ||
| 383 | - get_domain | ||
| 384 | - ( | ||
| 385 | - List(AttrVal) l | ||
| 386 | - ) = | ||
| 387 | - if l is | ||
| 388 | - { | ||
| 389 | - [ ] then failure, | ||
| 390 | - [h . t] then if h is domain(s) | ||
| 391 | - then success(s) | ||
| 392 | - else get_domain(t) | ||
| 393 | - }. | ||
| 394 | - | ||
| 395 | -define Int | ||
| 396 | - get_validity | ||
| 397 | - ( | ||
| 398 | - List(AttrVal) l | ||
| 399 | - ) = | ||
| 400 | - if l is | ||
| 401 | - { | ||
| 402 | - [ ] then 0, | ||
| 403 | - [h . t] then if h is max_age(a) | ||
| 404 | - then if decimal_scan(a) is | ||
| 405 | - { | ||
| 406 | - failure then 0, | ||
| 407 | - success(n) then n+now | ||
| 408 | - } | ||
| 409 | - else get_validity(t) | ||
| 410 | - }. | ||
| 411 | - | ||
| 412 | -define Maybe(String) | ||
| 413 | - get_path | ||
| 414 | - ( | ||
| 415 | - List(AttrVal) l | ||
| 416 | - ) = | ||
| 417 | - if l is | ||
| 418 | - { | ||
| 419 | - [ ] then failure, | ||
| 420 | - [h . t] then if h is path(p) | ||
| 421 | - then success(p) | ||
| 422 | - else get_path(t) | ||
| 423 | - }. | ||
| 424 | - | ||
| 425 | -define Bool | ||
| 426 | - get_secure | ||
| 427 | - ( | ||
| 428 | - List(AttrVal) l | ||
| 429 | - ) = | ||
| 430 | - if l is | ||
| 431 | - { | ||
| 432 | - [ ] then false, | ||
| 433 | - [h . t] then if h is secure | ||
| 434 | - then true | ||
| 435 | - else get_secure(t) | ||
| 436 | - }. | ||
| 437 | - | ||
| 438 | -define Int | ||
| 439 | - get_version | ||
| 440 | - ( | ||
| 441 | - List(AttrVal) l | ||
| 442 | - ) = | ||
| 443 | - if l is | ||
| 444 | - { | ||
| 445 | - [ ] then 0, | ||
| 446 | - [h . t] then if h is version(v) | ||
| 447 | - then if decimal_scan(v) is | ||
| 448 | - { | ||
| 449 | - failure then 0, | ||
| 450 | - success(n) then n | ||
| 451 | - } | ||
| 452 | - else get_version(t) | ||
| 453 | - }. | ||
| 454 | - | ||
| 455 | - | ||
| 456 | - Reading a cookie: | ||
| 457 | - | ||
| 458 | -variable String server_name = "". | ||
| 459 | - | ||
| 460 | -define Maybe(Cookie) | ||
| 461 | - read_cookie_n_e_v | ||
| 462 | - ( | ||
| 463 | - String name, | ||
| 464 | - String value, | ||
| 465 | - List(AttrVal) so_far | ||
| 466 | - ) = | ||
| 467 | - if read_attr_val is | ||
| 468 | - { | ||
| 469 | - failure then | ||
| 470 | - success(cookie( | ||
| 471 | - *server_name, | ||
| 472 | - name, | ||
| 473 | - value, | ||
| 474 | - get_comment(so_far), | ||
| 475 | - get_domain(so_far), | ||
| 476 | - get_validity(so_far), | ||
| 477 | - get_path(so_far), | ||
| 478 | - get_secure(so_far), | ||
| 479 | - get_version(so_far) | ||
| 480 | - )), | ||
| 481 | - | ||
| 482 | - success(av) then read_cookie_n_e_v(name,value,[av . so_far]) | ||
| 483 | - }. | ||
| 484 | - | ||
| 485 | -define Maybe(Cookie) | ||
| 486 | - read_cookie_n_e | ||
| 487 | - ( | ||
| 488 | - String name | ||
| 489 | - ) = | ||
| 490 | - with a = read_value, | ||
| 491 | - | ||
| 492 | - if a is token(value) then read_cookie_n_e_v(name,value,[]) else | ||
| 493 | - if a is quoted_string(value) then read_cookie_n_e_v(name,value,[]) else | ||
| 494 | - unput_atom(a); failure. | ||
| 495 | - | ||
| 496 | -define Maybe(Cookie) | ||
| 497 | - read_cookie_n | ||
| 498 | - ( | ||
| 499 | - String name | ||
| 500 | - ) = | ||
| 501 | - with a = read_atom, | ||
| 502 | - if a is equals | ||
| 503 | - then read_cookie_n_e(name) | ||
| 504 | - else unput_atom(a); failure. | ||
| 505 | - | ||
| 506 | - | ||
| 507 | -define Maybe(Cookie) | ||
| 508 | - read_cookie | ||
| 509 | - = | ||
| 510 | - with a = read_atom, | ||
| 511 | - if a is token(name) | ||
| 512 | - then read_cookie_n(name) | ||
| 513 | - else unput_atom(a); failure. | ||
| 514 | - | ||
| 515 | - | ||
| 516 | -define List(Cookie) | ||
| 517 | - read_cookies | ||
| 518 | - ( | ||
| 519 | - List(Cookie) so_far | ||
| 520 | - ) = | ||
| 521 | - if read_cookie is | ||
| 522 | - { | ||
| 523 | - failure then so_far, | ||
| 524 | - success(c) then read_cookies([c . so_far]) | ||
| 525 | - }. | ||
| 526 | - | ||
| 527 | - | ||
| 528 | -define List(Cookie) | ||
| 529 | - get_cookies | ||
| 530 | - ( | ||
| 531 | - String svn, | ||
| 532 | - HTTP_header h | ||
| 533 | - ) = | ||
| 534 | - if h is http_header(n,v) then | ||
| 535 | - if to_lower(n) = "set-cookie" | ||
| 536 | - then ( | ||
| 537 | - unput_atoms <- []; | ||
| 538 | - input <- v; | ||
| 539 | - index <- 0; | ||
| 540 | - server_name <- svn; | ||
| 541 | - read_cookies([]) | ||
| 542 | - ) | ||
| 543 | - else []. | ||
| 544 | - | ||
| 545 | -public define List(Cookie) | ||
| 546 | - get_cookies | ||
| 547 | - ( | ||
| 548 | - String server_name, | ||
| 549 | - List(HTTP_header) headers | ||
| 550 | - ) = | ||
| 551 | - if headers is | ||
| 552 | - { | ||
| 553 | - [ ] then [ ], | ||
| 554 | - [h . t] then | ||
| 555 | - append(get_cookies(server_name,h),get_cookies(server_name,t)) | ||
| 556 | - }. | ||
| 557 | - | ||
| 558 | -define List(Cookie) | ||
| 559 | - server_get_cookies | ||
| 560 | - ( | ||
| 561 | - HTTP_header h | ||
| 562 | - ) = | ||
| 563 | - if h is http_header(n,v) then | ||
| 564 | - if to_lower(n) = "cookie" | ||
| 565 | - then ( | ||
| 566 | - unput_atoms <- []; | ||
| 567 | - input <- v; | ||
| 568 | - index <- 0; | ||
| 569 | - server_name <- ""; | ||
| 570 | - read_cookies([]) | ||
| 571 | - ) | ||
| 572 | - else []. | ||
| 573 | - | ||
| 574 | -public define List(Cookie) | ||
| 575 | - server_get_cookies | ||
| 576 | - ( | ||
| 577 | - // String server_name, | ||
| 578 | - List(HTTP_header) headers | ||
| 579 | - ) = | ||
| 580 | - if headers is | ||
| 581 | - { | ||
| 582 | - [ ] then [ ], | ||
| 583 | - [h . t] then | ||
| 584 | - append(server_get_cookies(h), server_get_cookies(t)) | ||
| 585 | - }. | ||
| 586 | - | ||
| 587 | -public define Maybe(Cookie) | ||
| 588 | - find_cookie | ||
| 589 | - ( | ||
| 590 | - String name, | ||
| 591 | - List(Cookie) cookies | ||
| 592 | - ) | ||
| 593 | - = | ||
| 594 | - if cookies is | ||
| 595 | - { | ||
| 596 | - [] then failure, | ||
| 597 | - [h . t] then | ||
| 598 | - if h is cookie(s, n, v, _, _, _, _, _, _) then | ||
| 599 | - if name = n then success(h) | ||
| 600 | - else find_cookie(name, t) | ||
| 601 | - }. | ||
| 602 | - | ||
| 603 | -public define String | ||
| 604 | - get_cookie_value | ||
| 605 | - ( | ||
| 606 | - String name, | ||
| 607 | - List(Cookie) cookies | ||
| 608 | - ) | ||
| 609 | - = | ||
| 610 | - if find_cookie(name, cookies) is | ||
| 611 | - { | ||
| 612 | - failure then "", | ||
| 613 | - success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v | ||
| 614 | - }. | ||
| 615 | - | ||
| 616 | - *** Reformating cookies. ************************************************************** | ||
| 617 | - | ||
| 618 | - Cookies should be resent reformated according to the following grammar (copy-pasted | ||
| 619 | - from RFC 2109): | ||
| 620 | - | ||
| 621 | - cookie = "Cookie:" cookie-version | ||
| 622 | - 1*((";" | ",") cookie-value) | ||
| 623 | - cookie-value = NAME "=" VALUE [";" path] [";" domain] | ||
| 624 | - cookie-version = "$Version" "=" value | ||
| 625 | - NAME = attr | ||
| 626 | - VALUE = value | ||
| 627 | - path = "$Path" "=" value | ||
| 628 | - domain = "$Domain" "=" value | ||
| 629 | - | ||
| 630 | - | ||
| 631 | -define HTTP_header | ||
| 632 | - reformat_cookie | ||
| 633 | - ( | ||
| 634 | - Cookie c | ||
| 635 | - ) = | ||
| 636 | - if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then | ||
| 637 | - http_header("Cookie", | ||
| 638 | - "$Version=" + to_decimal(ver) + | ||
| 639 | - ";" + n + "=\"" + v + "\"" + | ||
| 640 | - if mbp is | ||
| 641 | - { | ||
| 642 | - failure then "", | ||
| 643 | - success(p) then ";$Path=\"" + p + "\"" | ||
| 644 | - } + | ||
| 645 | - if mbd is | ||
| 646 | - { | ||
| 647 | - failure then "", | ||
| 648 | - success(d) then ";$Domain=\"" + d + "\"" | ||
| 649 | - } | ||
| 650 | - ). | ||
| 651 | - | ||
| 652 | - | ||
| 653 | - According to RFC 2109, a cookie may be sent to a server if: | ||
| 654 | - | ||
| 655 | - (1) server name in the cookie is the name of the server, | ||
| 656 | - (2) if 'Path' attribute is present, its value must match the URI, | ||
| 657 | - (3) the cookie is still valid (validity = 0 means indefinitely valid). | ||
| 658 | - | ||
| 659 | - define Bool | ||
| 660 | - path_match | ||
| 661 | - ( | ||
| 662 | - Maybe(String) cookie_path, | ||
| 663 | - String uri | ||
| 664 | - ) = | ||
| 665 | - if cookie_path is | ||
| 666 | - { | ||
| 667 | - failure then true, | ||
| 668 | - success(p) then | ||
| 669 | - | ||
| 670 | - }. | ||
| 671 | - | ||
| 672 | - | ||
| 673 | - Checking if the path matches: | ||
| 674 | - | ||
| 675 | - | ||
| 676 | -define Bool | ||
| 677 | - path_match | ||
| 678 | - ( | ||
| 679 | - Maybe(String) mbp, | ||
| 680 | - String uri | ||
| 681 | - ) = | ||
| 682 | - true. | ||
| 683 | - | ||
| 684 | - | ||
| 685 | - The next function verifies if a cookie satisfies the rules. | ||
| 686 | - | ||
| 687 | -define Bool | ||
| 688 | - may_resend_cookie | ||
| 689 | - ( | ||
| 690 | - String server_name, | ||
| 691 | - String uri, | ||
| 692 | - Cookie c | ||
| 693 | - ) = | ||
| 694 | - if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then | ||
| 695 | - if sn = server_name | ||
| 696 | - then ( | ||
| 697 | - if path_match(mbp,uri) | ||
| 698 | - then ( | ||
| 699 | - if vld = 0 then true else vld > now | ||
| 700 | - ) | ||
| 701 | - else false | ||
| 702 | - ) | ||
| 703 | - else false. | ||
| 704 | - | ||
| 705 | - | ||
| 706 | - The next function reformat all cookies which satisfy the 'resend' rules. | ||
| 707 | - | ||
| 708 | -public define List(HTTP_header) | ||
| 709 | - reformat_cookies | ||
| 710 | - ( | ||
| 711 | - String server_name, | ||
| 712 | - String uri, | ||
| 713 | - List(Cookie) cookies | ||
| 714 | - ) = | ||
| 715 | - if cookies is | ||
| 716 | - { | ||
| 717 | - [ ] then [ ], | ||
| 718 | - [h . t] then | ||
| 719 | - if may_resend_cookie(server_name,uri,h) | ||
| 720 | - then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)] | ||
| 721 | - else reformat_cookies(server_name,uri,t) | ||
| 722 | - }. | ||
| 723 | - | ||
| 724 | - | ||
| 725 | - | ||
| 726 | - | ||
| 727 | - | ||
| 728 | - See test_cookies.anubis for a test of this program. | ||
| 729 | - | ||
| 730 | - | ||
| 731 | - | ||
| 732 | - | ||
| 733 | - | ||
| 734 | - | ||
| 735 | - | ||
| 736 | - | ||
| 737 | - | 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 | +define One | ||
| 198 | + unput_atom | ||
| 199 | + ( | ||
| 200 | + Atom a | ||
| 201 | + ) = | ||
| 202 | + unput_atoms <- [a . *unput_atoms]. | ||
| 203 | + | ||
| 204 | +define Atom | ||
| 205 | + recognize_keyword | ||
| 206 | + ( | ||
| 207 | + String s | ||
| 208 | + ) = | ||
| 209 | + with l = to_lower(s), | ||
| 210 | + if l = "comment" then comment else | ||
| 211 | + if l = "domain" then domain else | ||
| 212 | + if l = "max-age" then max_age else | ||
| 213 | + if l = "path" then path else | ||
| 214 | + if l = "secure" then secure else | ||
| 215 | + if l = "version" then version else | ||
| 216 | + token(s). | ||
| 217 | + | ||
| 218 | + | ||
| 219 | +variable String input = "". From which cookies will be read. | ||
| 220 | +variable Int index = 0. Current position within 'input'. | ||
| 221 | + | ||
| 222 | +define Maybe(Word8) | ||
| 223 | + next_char | ||
| 224 | + = | ||
| 225 | + if nth(*index,*input) is | ||
| 226 | + { | ||
| 227 | + failure then failure, | ||
| 228 | + success(c) then | ||
| 229 | + index <- *index+1; | ||
| 230 | + success(c) | ||
| 231 | + }. | ||
| 232 | + | ||
| 233 | +define One | ||
| 234 | + unput_char | ||
| 235 | + = | ||
| 236 | + index <- *index-1. | ||
| 237 | + | ||
| 238 | +define Atom | ||
| 239 | + read_token | ||
| 240 | + ( | ||
| 241 | + List(Word8) so_far, // contains at least 1 character | ||
| 242 | + (Word8) -> Bool is_valid_char | ||
| 243 | + ) = | ||
| 244 | + if next_char is | ||
| 245 | + { | ||
| 246 | + failure then recognize_keyword(implode(reverse(so_far))), | ||
| 247 | + success(c) then | ||
| 248 | + if is_valid_char(c) | ||
| 249 | + then read_token([c . so_far], is_valid_char) | ||
| 250 | + else unput_char; recognize_keyword(implode(reverse(so_far))) | ||
| 251 | + }. | ||
| 252 | + | ||
| 253 | +define Atom | ||
| 254 | + read_quoted_string | ||
| 255 | + ( | ||
| 256 | + List(Word8) so_far | ||
| 257 | + ) = | ||
| 258 | + if next_char is | ||
| 259 | + { | ||
| 260 | + failure then quoted_string(implode(reverse(so_far))), | ||
| 261 | + success(c) then | ||
| 262 | + if c = '\"' | ||
| 263 | + then quoted_string(implode(reverse(so_far))) | ||
| 264 | + else read_quoted_string([c . so_far]) | ||
| 265 | + }. | ||
| 266 | + | ||
| 267 | +define Bool | ||
| 268 | + is_blank | ||
| 269 | + ( | ||
| 270 | + Word8 c | ||
| 271 | + ) = | ||
| 272 | + c +=< ' '. | ||
| 273 | + | ||
| 274 | + Reading an atom from the input: | ||
| 275 | + | ||
| 276 | +define Atom | ||
| 277 | + read_atom | ||
| 278 | + = | ||
| 279 | + if *unput_atoms is | ||
| 280 | + { | ||
| 281 | + [ ] then | ||
| 282 | + if next_char is | ||
| 283 | + { | ||
| 284 | + failure then end_of_input, | ||
| 285 | + success(c) then | ||
| 286 | + if is_blank(c) then read_atom else // skip blanks | ||
| 287 | + if is_token_char(c) then read_token([c], is_token_char) else | ||
| 288 | + if c = '\"' then read_quoted_string([]) else | ||
| 289 | + if c = '=' then equals else | ||
| 290 | + if c = ':' then colon else | ||
| 291 | + if c = ';' then semi_colon else | ||
| 292 | + error | ||
| 293 | + }, | ||
| 294 | + [h . t] then | ||
| 295 | + unput_atoms <- t; h | ||
| 296 | + }. | ||
| 297 | + | ||
| 298 | +define Atom | ||
| 299 | + read_value | ||
| 300 | + = | ||
| 301 | + if *unput_atoms is | ||
| 302 | + { | ||
| 303 | + [ ] then | ||
| 304 | + if next_char is | ||
| 305 | + { | ||
| 306 | + failure then end_of_input, | ||
| 307 | + success(c) then | ||
| 308 | + if is_blank(c) then read_value else // skip blanks | ||
| 309 | + if is_value_char(c) then read_token([c], is_value_char) else | ||
| 310 | + if c = '\"' then read_quoted_string([]) else | ||
| 311 | + if c = ';' then semi_colon else | ||
| 312 | + error | ||
| 313 | + }, | ||
| 314 | + [h . t] then | ||
| 315 | + unput_atoms <- t; h | ||
| 316 | + }. | ||
| 317 | + | ||
| 318 | + Reading an attribute-value pair. | ||
| 319 | + | ||
| 320 | +type AttrVal: | ||
| 321 | + comment(String), | ||
| 322 | + domain(String), | ||
| 323 | + max_age(String), | ||
| 324 | + path(String), | ||
| 325 | + secure, | ||
| 326 | + version(String). | ||
| 327 | + | ||
| 328 | +define String | ||
| 329 | + read_eq_value | ||
| 330 | + = | ||
| 331 | + with e = read_atom, | ||
| 332 | + if e is equals then | ||
| 333 | + ( | ||
| 334 | + with a = read_atom, | ||
| 335 | + if a is token(n) then n else | ||
| 336 | + if a is quoted_string(s) then s else | ||
| 337 | + unput_atom(a); "" | ||
| 338 | + ) | ||
| 339 | + else unput_atom(e); "". | ||
| 340 | + | ||
| 341 | + | ||
| 342 | +define Maybe(AttrVal) | ||
| 343 | + read_attr_val | ||
| 344 | + = | ||
| 345 | + if read_atom is semi_colon then | ||
| 346 | + with a = read_atom, | ||
| 347 | + if a is | ||
| 348 | + { | ||
| 349 | + end_of_input then failure, | ||
| 350 | + error then failure, | ||
| 351 | + comment then success(comment(read_eq_value)), | ||
| 352 | + domain then success(domain(read_eq_value)), | ||
| 353 | + max_age then success(max_age(read_eq_value)), | ||
| 354 | + path then success(path(read_eq_value)), | ||
| 355 | + secure then success(secure), | ||
| 356 | + version then success(version(read_eq_value)), | ||
| 357 | + token(_) then unput_atom(a); failure, | ||
| 358 | + quoted_string(_) then unput_atom(a); failure, | ||
| 359 | + equals then unput_atom(a); failure, | ||
| 360 | + colon then unput_atom(a); failure, | ||
| 361 | + semi_colon then unput_atom(a); failure, | ||
| 362 | + } | ||
| 363 | + else failure. | ||
| 364 | + | ||
| 365 | + | ||
| 366 | + Getting attributes from a List(AttrVal). | ||
| 367 | + | ||
| 368 | +define Maybe(String) | ||
| 369 | + get_comment | ||
| 370 | + ( | ||
| 371 | + List(AttrVal) l | ||
| 372 | + ) = | ||
| 373 | + if l is | ||
| 374 | + { | ||
| 375 | + [ ] then failure, | ||
| 376 | + [h . t] then if h is comment(c) | ||
| 377 | + then success(c) | ||
| 378 | + else get_comment(t) | ||
| 379 | + }. | ||
| 380 | + | ||
| 381 | +define Maybe(String) | ||
| 382 | + get_domain | ||
| 383 | + ( | ||
| 384 | + List(AttrVal) l | ||
| 385 | + ) = | ||
| 386 | + if l is | ||
| 387 | + { | ||
| 388 | + [ ] then failure, | ||
| 389 | + [h . t] then if h is domain(s) | ||
| 390 | + then success(s) | ||
| 391 | + else get_domain(t) | ||
| 392 | + }. | ||
| 393 | + | ||
| 394 | +define Int | ||
| 395 | + get_validity | ||
| 396 | + ( | ||
| 397 | + List(AttrVal) l | ||
| 398 | + ) = | ||
| 399 | + if l is | ||
| 400 | + { | ||
| 401 | + [ ] then 0, | ||
| 402 | + [h . t] then if h is max_age(a) | ||
| 403 | + then if decimal_scan(a) is | ||
| 404 | + { | ||
| 405 | + failure then 0, | ||
| 406 | + success(n) then n+now | ||
| 407 | + } | ||
| 408 | + else get_validity(t) | ||
| 409 | + }. | ||
| 410 | + | ||
| 411 | +define Maybe(String) | ||
| 412 | + get_path | ||
| 413 | + ( | ||
| 414 | + List(AttrVal) l | ||
| 415 | + ) = | ||
| 416 | + if l is | ||
| 417 | + { | ||
| 418 | + [ ] then failure, | ||
| 419 | + [h . t] then if h is path(p) | ||
| 420 | + then success(p) | ||
| 421 | + else get_path(t) | ||
| 422 | + }. | ||
| 423 | + | ||
| 424 | +define Bool | ||
| 425 | + get_secure | ||
| 426 | + ( | ||
| 427 | + List(AttrVal) l | ||
| 428 | + ) = | ||
| 429 | + if l is | ||
| 430 | + { | ||
| 431 | + [ ] then false, | ||
| 432 | + [h . t] then if h is secure | ||
| 433 | + then true | ||
| 434 | + else get_secure(t) | ||
| 435 | + }. | ||
| 436 | + | ||
| 437 | +define Int | ||
| 438 | + get_version | ||
| 439 | + ( | ||
| 440 | + List(AttrVal) l | ||
| 441 | + ) = | ||
| 442 | + if l is | ||
| 443 | + { | ||
| 444 | + [ ] then 0, | ||
| 445 | + [h . t] then if h is version(v) | ||
| 446 | + then if decimal_scan(v) is | ||
| 447 | + { | ||
| 448 | + failure then 0, | ||
| 449 | + success(n) then n | ||
| 450 | + } | ||
| 451 | + else get_version(t) | ||
| 452 | + }. | ||
| 453 | + | ||
| 454 | + | ||
| 455 | + Reading a cookie: | ||
| 456 | + | ||
| 457 | +variable String server_name = "". | ||
| 458 | + | ||
| 459 | +define Maybe(Cookie) | ||
| 460 | + read_cookie_n_e_v | ||
| 461 | + ( | ||
| 462 | + String name, | ||
| 463 | + String value, | ||
| 464 | + List(AttrVal) so_far | ||
| 465 | + ) = | ||
| 466 | + if read_attr_val is | ||
| 467 | + { | ||
| 468 | + failure then | ||
| 469 | + success(cookie( | ||
| 470 | + *server_name, | ||
| 471 | + name, | ||
| 472 | + value, | ||
| 473 | + get_comment(so_far), | ||
| 474 | + get_domain(so_far), | ||
| 475 | + get_validity(so_far), | ||
| 476 | + get_path(so_far), | ||
| 477 | + get_secure(so_far), | ||
| 478 | + get_version(so_far) | ||
| 479 | + )), | ||
| 480 | + | ||
| 481 | + success(av) then read_cookie_n_e_v(name,value,[av . so_far]) | ||
| 482 | + }. | ||
| 483 | + | ||
| 484 | +define Maybe(Cookie) | ||
| 485 | + read_cookie_n_e | ||
| 486 | + ( | ||
| 487 | + String name | ||
| 488 | + ) = | ||
| 489 | + with a = read_value, | ||
| 490 | + | ||
| 491 | + if a is token(value) then read_cookie_n_e_v(name,value,[]) else | ||
| 492 | + if a is quoted_string(value) then read_cookie_n_e_v(name,value,[]) else | ||
| 493 | + unput_atom(a); failure. | ||
| 494 | + | ||
| 495 | +define Maybe(Cookie) | ||
| 496 | + read_cookie_n | ||
| 497 | + ( | ||
| 498 | + String name | ||
| 499 | + ) = | ||
| 500 | + with a = read_atom, | ||
| 501 | + if a is equals | ||
| 502 | + then read_cookie_n_e(name) | ||
| 503 | + else unput_atom(a); failure. | ||
| 504 | + | ||
| 505 | + | ||
| 506 | +define Maybe(Cookie) | ||
| 507 | + read_cookie | ||
| 508 | + = | ||
| 509 | + with a = read_atom, | ||
| 510 | + if a is token(name) | ||
| 511 | + then read_cookie_n(name) | ||
| 512 | + else unput_atom(a); failure. | ||
| 513 | + | ||
| 514 | + | ||
| 515 | +define List(Cookie) | ||
| 516 | + read_cookies | ||
| 517 | + ( | ||
| 518 | + List(Cookie) so_far | ||
| 519 | + ) = | ||
| 520 | + if read_cookie is | ||
| 521 | + { | ||
| 522 | + failure then so_far, | ||
| 523 | + success(c) then read_cookies([c . so_far]) | ||
| 524 | + }. | ||
| 525 | + | ||
| 526 | + | ||
| 527 | +define List(Cookie) | ||
| 528 | + get_cookies | ||
| 529 | + ( | ||
| 530 | + String svn, | ||
| 531 | + HTTP_header h | ||
| 532 | + ) = | ||
| 533 | + if h is http_header(n,v) then | ||
| 534 | + if to_lower(n) = "set-cookie" | ||
| 535 | + then ( | ||
| 536 | + unput_atoms <- []; | ||
| 537 | + input <- v; | ||
| 538 | + index <- 0; | ||
| 539 | + server_name <- svn; | ||
| 540 | + read_cookies([]) | ||
| 541 | + ) | ||
| 542 | + else []. | ||
| 543 | + | ||
| 544 | +public define List(Cookie) | ||
| 545 | + get_cookies | ||
| 546 | + ( | ||
| 547 | + String server_name, | ||
| 548 | + List(HTTP_header) headers | ||
| 549 | + ) = | ||
| 550 | + if headers is | ||
| 551 | + { | ||
| 552 | + [ ] then [ ], | ||
| 553 | + [h . t] then | ||
| 554 | + append(get_cookies(server_name,h),get_cookies(server_name,t)) | ||
| 555 | + }. | ||
| 556 | + | ||
| 557 | +define List(Cookie) | ||
| 558 | + server_get_cookies | ||
| 559 | + ( | ||
| 560 | + HTTP_header h | ||
| 561 | + ) = | ||
| 562 | + if h is http_header(n,v) then | ||
| 563 | + if to_lower(n) = "cookie" | ||
| 564 | + then ( | ||
| 565 | + unput_atoms <- []; | ||
| 566 | + input <- v; | ||
| 567 | + index <- 0; | ||
| 568 | + server_name <- ""; | ||
| 569 | + read_cookies([]) | ||
| 570 | + ) | ||
| 571 | + else []. | ||
| 572 | + | ||
| 573 | +public define List(Cookie) | ||
| 574 | + server_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(server_get_cookies(h), server_get_cookies(t)) | ||
| 584 | + }. | ||
| 585 | + | ||
| 586 | +public define Maybe(Cookie) | ||
| 587 | + find_cookie | ||
| 588 | + ( | ||
| 589 | + String name, | ||
| 590 | + List(Cookie) cookies | ||
| 591 | + ) | ||
| 592 | + = | ||
| 593 | + if cookies is | ||
| 594 | + { | ||
| 595 | + [] then failure, | ||
| 596 | + [h . t] then | ||
| 597 | + if h is cookie(s, n, v, _, _, _, _, _, _) then | ||
| 598 | + if name = n then success(h) | ||
| 599 | + else find_cookie(name, t) | ||
| 600 | + }. | ||
| 601 | + | ||
| 602 | +public define String | ||
| 603 | + get_cookie_value | ||
| 604 | + ( | ||
| 605 | + String name, | ||
| 606 | + List(Cookie) cookies | ||
| 607 | + ) | ||
| 608 | + = | ||
| 609 | + if find_cookie(name, cookies) is | ||
| 610 | + { | ||
| 611 | + failure then "", | ||
| 612 | + success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v | ||
| 613 | + }. | ||
| 614 | + | ||
| 615 | + *** Reformating cookies. ************************************************************** | ||
| 616 | + | ||
| 617 | + Cookies should be resent reformated according to the following grammar (copy-pasted | ||
| 618 | + from RFC 2109): | ||
| 619 | + | ||
| 620 | + cookie = "Cookie:" cookie-version | ||
| 621 | + 1*((";" | ",") cookie-value) | ||
| 622 | + cookie-value = NAME "=" VALUE [";" path] [";" domain] | ||
| 623 | + cookie-version = "$Version" "=" value | ||
| 624 | + NAME = attr | ||
| 625 | + VALUE = value | ||
| 626 | + path = "$Path" "=" value | ||
| 627 | + domain = "$Domain" "=" value | ||
| 628 | + | ||
| 629 | + | ||
| 630 | +define HTTP_header | ||
| 631 | + reformat_cookie | ||
| 632 | + ( | ||
| 633 | + Cookie c | ||
| 634 | + ) = | ||
| 635 | + if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then | ||
| 636 | + http_header("Cookie", | ||
| 637 | + "$Version=" + to_decimal(ver) + | ||
| 638 | + ";" + n + "=\"" + v + "\"" + | ||
| 639 | + if mbp is | ||
| 640 | + { | ||
| 641 | + failure then "", | ||
| 642 | + success(p) then ";$Path=\"" + p + "\"" | ||
| 643 | + } + | ||
| 644 | + if mbd is | ||
| 645 | + { | ||
| 646 | + failure then "", | ||
| 647 | + success(d) then ";$Domain=\"" + d + "\"" | ||
| 648 | + } | ||
| 649 | + ). | ||
| 650 | + | ||
| 651 | + | ||
| 652 | + According to RFC 2109, a cookie may be sent to a server if: | ||
| 653 | + | ||
| 654 | + (1) server name in the cookie is the name of the server, | ||
| 655 | + (2) if 'Path' attribute is present, its value must match the URI, | ||
| 656 | + (3) the cookie is still valid (validity = 0 means indefinitely valid). | ||
| 657 | + | ||
| 658 | + define Bool | ||
| 659 | + path_match | ||
| 660 | + ( | ||
| 661 | + Maybe(String) cookie_path, | ||
| 662 | + String uri | ||
| 663 | + ) = | ||
| 664 | + if cookie_path is | ||
| 665 | + { | ||
| 666 | + failure then true, | ||
| 667 | + success(p) then | ||
| 668 | + | ||
| 669 | + }. | ||
| 670 | + | ||
| 671 | + | ||
| 672 | + Checking if the path matches: | ||
| 673 | + | ||
| 674 | + | ||
| 675 | +define Bool | ||
| 676 | + path_match | ||
| 677 | + ( | ||
| 678 | + Maybe(String) mbp, | ||
| 679 | + String uri | ||
| 680 | + ) = | ||
| 681 | + true. | ||
| 682 | + | ||
| 683 | + | ||
| 684 | + The next function verifies if a cookie satisfies the rules. | ||
| 685 | + | ||
| 686 | +define Bool | ||
| 687 | + may_resend_cookie | ||
| 688 | + ( | ||
| 689 | + String server_name, | ||
| 690 | + String uri, | ||
| 691 | + Cookie c | ||
| 692 | + ) = | ||
| 693 | + if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then | ||
| 694 | + if sn = server_name | ||
| 695 | + then ( | ||
| 696 | + if path_match(mbp,uri) | ||
| 697 | + then ( | ||
| 698 | + if vld = 0 then true else vld > now | ||
| 699 | + ) | ||
| 700 | + else false | ||
| 701 | + ) | ||
| 702 | + else false. | ||
| 703 | + | ||
| 704 | + | ||
| 705 | + The next function reformat all cookies which satisfy the 'resend' rules. | ||
| 706 | + | ||
| 707 | +public define List(HTTP_header) | ||
| 708 | + reformat_cookies | ||
| 709 | + ( | ||
| 710 | + String server_name, | ||
| 711 | + String uri, | ||
| 712 | + List(Cookie) cookies | ||
| 713 | + ) = | ||
| 714 | + if cookies is | ||
| 715 | + { | ||
| 716 | + [ ] then [ ], | ||
| 717 | + [h . t] then | ||
| 718 | + if may_resend_cookie(server_name,uri,h) | ||
| 719 | + then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)] | ||
| 720 | + else reformat_cookies(server_name,uri,t) | ||
| 721 | + }. | ||
| 722 | + | ||
| 723 | + | ||
| 724 | + | ||
| 725 | + | ||
| 726 | + | ||
| 727 | + See test_cookies.anubis for a test of this program. | ||
| 728 | + | ||
| 729 | + | ||
| 730 | + | ||
| 731 | + | ||
| 732 | + | ||
| 733 | + | ||
| 734 | + | ||
| 735 | + | ||
| 736 | + |
web/CXM_html.anubis deleted
| 1 | - | ||
| 2 | - *Project* The Anubis Project | ||
| 3 | - *Title* Producing HTML/Javascript code. | ||
| 4 | - | ||
| 5 | - *Copyright* Copyright (c) Alain Prouté 2001. | ||
| 6 | - | ||
| 7 | -read tools/basis.anubis | ||
| 8 | -read system/string.anubis | ||
| 9 | -read tools/printable_tree.anubis | ||
| 10 | - | ||
| 11 | - | ||
| 12 | - *** Managing Web Arguments. | ||
| 13 | - | ||
| 14 | - When a client submits a form, he sends informations to the server. This information is | ||
| 15 | - transformed by the server into a list of data of type 'Web_arg'. This is the reason why | ||
| 16 | - a 'web page' operation always has a unique argument of type 'List(Web_arg)'. | ||
| 17 | - | ||
| 18 | - The type 'Web_arg' is defined in 'web/common.anubis' as follows: | ||
| 19 | - | ||
| 20 | - public type Web_arg: | ||
| 21 | - web_arg(String name, | ||
| 22 | - String value), | ||
| 23 | - upload (String name, | ||
| 24 | - String value, | ||
| 25 | - String temp_file_path). | ||
| 26 | - | ||
| 27 | -read CXM_common.anubis | ||
| 28 | - | ||
| 29 | - In other words, a 'web argument' is just a pair made of the name of the argument, and | ||
| 30 | - the value of the argument, and both are character strings. 'upload' will be explained | ||
| 31 | - later. | ||
| 32 | - | ||
| 33 | - | ||
| 34 | - The next variable is a multipurpose counter (used to generate unique names). | ||
| 35 | - | ||
| 36 | -variable Int web_count = 0. | ||
| 37 | - | ||
| 38 | -define Int | ||
| 39 | - new_web_count | ||
| 40 | - = | ||
| 41 | - web_count <- *web_count+1; | ||
| 42 | - *web_count. | ||
| 43 | - | ||
| 44 | - | ||
| 45 | - Names for Web colors. | ||
| 46 | - | ||
| 47 | -public type Web_color_name: | ||
| 48 | - aliceblue, | ||
| 49 | - antiquewhite1, | ||
| 50 | - antiquewhite2, | ||
| 51 | - antiquewhite3, | ||
| 52 | - antiquewhite4, | ||
| 53 | - aquamarine1, | ||
| 54 | - aquamarine2, | ||
| 55 | - aquamarine3, | ||
| 56 | - aquamarine4, | ||
| 57 | - azure1, | ||
| 58 | - azure2, | ||
| 59 | - azure3, | ||
| 60 | - azure4, | ||
| 61 | - yellow. | ||
| 62 | - | ||
| 63 | - | ||
| 64 | - and so on ... (see below why I did not do more). | ||
| 65 | - | ||
| 66 | - | ||
| 67 | - | ||
| 68 | - Web colors. | ||
| 69 | - | ||
| 70 | -public type Web_color: | ||
| 71 | - rgb(Word8,Word8,Word8), /* give the color by its components */ | ||
| 72 | - _(Web_color_name). /* or by its name */ | ||
| 73 | - | ||
| 74 | - | ||
| 75 | - | ||
| 76 | - | ||
| 77 | - The following produces '<meta>' tags, which are put in the head of the document. | ||
| 78 | - | ||
| 79 | -public type WebMeta: | ||
| 80 | - keywords(List(String)), | ||
| 81 | - refresh(String url, Int delay), // in seconds | ||
| 82 | - meta(String name, String content), | ||
| 83 | - http_equiv(String name, String content). | ||
| 84 | - | ||
| 85 | - | ||
| 86 | - | ||
| 87 | - | ||
| 88 | - | ||
| 89 | - ******************************************************* | ||
| 90 | - * Web items * | ||
| 91 | - * (the many kinds of things one may put in a page) * | ||
| 92 | - ******************************************************* | ||
| 93 | - | ||
| 94 | - | ||
| 95 | -public type Web_item: | ||
| 96 | - [ ], /* empty (invisible) item */ | ||
| 97 | - ... this is a cross recursive type. | ||
| 98 | - | ||
| 99 | - | ||
| 100 | - | ||
| 101 | - | ||
| 102 | - Options for web page body. | ||
| 103 | - | ||
| 104 | -public type LayerDisposition: | ||
| 105 | - horizontal, | ||
| 106 | - vertical. | ||
| 107 | - | ||
| 108 | -public type FollowPathCommand: // this type is used by the Web_body_option 'follow_path'. | ||
| 109 | - pos(Int x, // x coordinate of position | ||
| 110 | - Int y, // y coordinate of position | ||
| 111 | - Int image_number, // the image to display at that position | ||
| 112 | - Int delay). // wait that milliseconds before leaving this position | ||
| 113 | - | ||
| 114 | -public type Web_body_option: | ||
| 115 | - background_color(Web_color), /* color for the background */ | ||
| 116 | - // | ||
| 117 | - // 'psychedelic_background' produces a background color which is continuously changing. | ||
| 118 | - // 'average' is the average luminosity of the color. 'amplitude' is the maximal variation | ||
| 119 | - // the luminosity around the average. 'delay' is the number of milliseconds between two | ||
| 120 | - // color changes. For example, you may try 'psychedelic_background(200,50,1000)', which | ||
| 121 | - // produces a background whose color changes very slowly (this is not tiring) among rather | ||
| 122 | - // light pastel colors. | ||
| 123 | - // | ||
| 124 | - psychedelic_background(Int average, /* average light (0 to 255) */ | ||
| 125 | - Int amplitude, /* amplitude of variation of light */ | ||
| 126 | - Int delay), /* in milliseconds */ | ||
| 127 | - background_image(String file_name), /* name of image file for the background */ | ||
| 128 | - // | ||
| 129 | - // 'scrolling_layer' produces a layer above the page which is scrolling continuously either | ||
| 130 | - // vertically or horizontally. The 'content' is indefinitly repeated. | ||
| 131 | - // | ||
| 132 | - scrolling_layer(LayerDisposition, | ||
| 133 | - Int steps, /* number of pixels of each move */ | ||
| 134 | - Int margin, /* measured from left or top in pixels */ | ||
| 135 | - Int delay, /* milliseconds for one move */ | ||
| 136 | - Web_item content, /* content of layer (will be repeated) */ | ||
| 137 | - Int period), /* number of pixels between two instances of 'content' */ | ||
| 138 | - // | ||
| 139 | - // 'bounce' shows its content above the page and let it move and bounce on the edges of a rectangle. | ||
| 140 | - // The rectangle is determined by the last 4 arguments. | ||
| 141 | - // | ||
| 142 | - bounce(Web_item content, | ||
| 143 | - Int left, | ||
| 144 | - Int right, | ||
| 145 | - Int top, | ||
| 146 | - Int bottom), | ||
| 147 | - // | ||
| 148 | - // put something over the page in any position you want: | ||
| 149 | - // | ||
| 150 | - over(Web_item content, | ||
| 151 | - Int left, | ||
| 152 | - Int top), | ||
| 153 | - // | ||
| 154 | - // follow_path: let a changing image follow a path on the screen. This gadget shows | ||
| 155 | - // an image following a polygonal path on the screen. The image may change at regular | ||
| 156 | - // intervals, thus providing extra animation. The images are displayed in the order | ||
| 157 | - // they are given in the first argument. When the last image has been displayed, the | ||
| 158 | - // first image is displayed again, and so on. The path is a sequence of absolute positions | ||
| 159 | - // on screen (actually in the browser's window or frame), which is followed in the | ||
| 160 | - // order given in the 'path' argument. If 'loop' is true, the path is followed again and again. | ||
| 161 | - // Otherwise, it is followed only once. If you want to make a closed loop, the last | ||
| 162 | - // position must be the same as the first one. 'steps' is the number of pixels of distance | ||
| 163 | - // between two successive positions of the image, and 'delay' the number of milliseconds | ||
| 164 | - // between two successive positions. 'change_every' is the number of steps (a 'step' is | ||
| 165 | - // passing from one position to the next one) after which the displayed image is replaced | ||
| 166 | - // by the next image. | ||
| 167 | - // | ||
| 168 | - // Each position 'pos(x,y,i,d)' has 4 parameters. 'x' and 'y' are the coordinates of the | ||
| 169 | - // position in the browser's window or frame. 'i' is the number of the image to display | ||
| 170 | - // at this position (i.e. the rank of the image in the list 'filename'. The first one has | ||
| 171 | - // rank 0). 'd' is the delay in milliseconds to wait before leaving that position. | ||
| 172 | - // | ||
| 173 | - follow_path(List(String) filenames, /* the changing images which follows the path */ | ||
| 174 | - Int change_every, /* number of steps betwen two changes */ | ||
| 175 | - List(FollowPathCommand) path, /* the polygonal path and commands */ | ||
| 176 | - Bool loop, /* if true do it repeatedly, otherwise only once */ | ||
| 177 | - Int steps, /* approximative distance (in pixels) between two | ||
| 178 | - successive positions */ | ||
| 179 | - Int delay), /* milliseconds between two successive positions */ | ||
| 180 | - | ||
| 181 | - load_image(String name), /* load an image (for next page), which is not displayed */ | ||
| 182 | - left_margin(Int), /* left margin for document */ | ||
| 183 | - top_margin(Int), /* top margin for document */ | ||
| 184 | - margin_width(Int), | ||
| 185 | - margin_height(Int), | ||
| 186 | - reload_frame(String name, /* name of target frame */ | ||
| 187 | - String url), /* url to load in this frame */ | ||
| 188 | - onload(String function_name). /* nom de la fonction javascript (sans les '()') */ | ||
| 189 | - | ||
| 190 | -public type BodyOnload: | ||
| 191 | - reload_frame(String name, String url). | ||
| 192 | - | ||
| 193 | -variable List(BodyOnload) body_onloads = [ ]. | ||
| 194 | - | ||
| 195 | -define One | ||
| 196 | - add_body_onload | ||
| 197 | - ( | ||
| 198 | - BodyOnload item | ||
| 199 | - ) = | ||
| 200 | - body_onloads <- [item . *body_onloads]. | ||
| 201 | - | ||
| 202 | -define Printable_tree | ||
| 203 | - format | ||
| 204 | - ( | ||
| 205 | - BodyOnload item | ||
| 206 | - ) = | ||
| 207 | - if item is | ||
| 208 | - { | ||
| 209 | - reload_frame(name,url) then (Printable_tree) | ||
| 210 | - [ " window.open('",url,"','",name,"');" ] | ||
| 211 | - }. | ||
| 212 | - | ||
| 213 | -define Printable_tree | ||
| 214 | - format | ||
| 215 | - ( | ||
| 216 | - List(BodyOnload) l | ||
| 217 | - ) = | ||
| 218 | - if l is | ||
| 219 | - { | ||
| 220 | - [ ] then (Printable_tree)[ ], | ||
| 221 | - [h . t] then (Printable_tree) | ||
| 222 | - [format(h) . format(t)] | ||
| 223 | - }. | ||
| 224 | - | ||
| 225 | - | ||
| 226 | ----- Body of a web page. -------------------------------------------- | ||
| 227 | -public type Page_body: | ||
| 228 | - body(List(Web_body_option), /* list of body options */ | ||
| 229 | - Web_item content). /* the content of the page */ | ||
| 230 | - | ||
| 231 | - | ||
| 232 | -public type VFrame: | ||
| 233 | - frame(Int height, | ||
| 234 | - Printable_tree url, | ||
| 235 | - String name). | ||
| 236 | - | ||
| 237 | ----- Web pages. ----------------------------------------------------- | ||
| 238 | -public type Web_page: | ||
| 239 | - web_page(String title, /* title appearing on top of browser */ | ||
| 240 | - List(WebMeta) meta_tags, | ||
| 241 | - Printable_tree head_scripts, /* scripts à placer dans la balise head */ | ||
| 242 | - Page_body body), /* body of page */ | ||
| 243 | - standard_frameset(String title, | ||
| 244 | - List(WebMeta) meta_tags, | ||
| 245 | - Int height, /* height of 'top menu' (pixels) */ | ||
| 246 | - Int width, /* width of 'left menu' (pixels) */ | ||
| 247 | - Printable_tree main). /* url for main */ | ||
| 248 | - | ||
| 249 | - +---------+--------------------------+ | ||
| 250 | - | | ^ | | ||
| 251 | - |<-width->| top height | | ||
| 252 | - | | v | | ||
| 253 | - | left +--------------------------+ | ||
| 254 | - | | | | ||
| 255 | - | | main | | ||
| 256 | - | | | | ||
| 257 | - | | | | ||
| 258 | - | | | | ||
| 259 | - +---------+--------------------------+ | ||
| 260 | - | ||
| 261 | - Note: top and left frames must be loaded through the Web_body_option 'reload_frame'. | ||
| 262 | - | ||
| 263 | - | ||
| 264 | -public define Web_page | ||
| 265 | - web_page | ||
| 266 | - ( | ||
| 267 | - String title, | ||
| 268 | - Page_body body | ||
| 269 | - ) = | ||
| 270 | - web_page(title,[],[], body). | ||
| 271 | - | ||
| 272 | -public define Web_page | ||
| 273 | - web_page | ||
| 274 | - ( | ||
| 275 | - String title, | ||
| 276 | - List(WebMeta) meta_tags, | ||
| 277 | - Page_body body | ||
| 278 | - ) = | ||
| 279 | - | ||
| 280 | - web_page(title, meta_tags, [], body). | ||
| 281 | - | ||
| 282 | - public define Web_page | ||
| 283 | -web_page | ||
| 284 | - ( | ||
| 285 | - String title, | ||
| 286 | - Printable_tree head_scripts, | ||
| 287 | - Page_body body | ||
| 288 | - ) = | ||
| 289 | - | ||
| 290 | - web_page(title, [], head_scripts, body). | ||
| 291 | - | ||
| 292 | -public define Web_page | ||
| 293 | -standard_frameset | ||
| 294 | - ( | ||
| 295 | - String title, | ||
| 296 | - Int height, | ||
| 297 | - Int width, | ||
| 298 | - Printable_tree main | ||
| 299 | - ) = | ||
| 300 | - | ||
| 301 | - standard_frameset(title, [], height, width, main). | ||
| 302 | - | ||
| 303 | - | ||
| 304 | -variable Printable_tree scripts = []. | ||
| 305 | - | ||
| 306 | -define One | ||
| 307 | - add_script | ||
| 308 | - ( | ||
| 309 | - Printable_tree script | ||
| 310 | - ) = | ||
| 311 | - scripts <- [*scripts . script]. | ||
| 312 | - | ||
| 313 | - | ||
| 314 | - | ||
| 315 | - ---- Non empty web items. ------------------------------------------- | ||
| 316 | - | ||
| 317 | - We have already seen the empty web item. Together with the following one, it enables to | ||
| 318 | - make (pseudo-)lists of web items, which will be presented one after the other (from | ||
| 319 | - left to right) in the browser's window. | ||
| 320 | - | ||
| 321 | -public type Web_item: | ||
| 322 | - [Web_item . Web_item],... | ||
| 323 | - | ||
| 324 | - | ||
| 325 | - A web item may be a simple string or a simple integer: | ||
| 326 | - | ||
| 327 | -public type Web_item: | ||
| 328 | - text(String), | ||
| 329 | - text_pt(Printable_tree), | ||
| 330 | - text_nowrap(String), | ||
| 331 | - text_nowrap_pt(Printable_tree), | ||
| 332 | - par(String), | ||
| 333 | - preformated_text(String text), | ||
| 334 | - integer(Int), | ||
| 335 | - float(Float,Int),... | ||
| 336 | - | ||
| 337 | - | ||
| 338 | - You may want to center a web item in a page. Just enclose it into | ||
| 339 | - 'center(...)': | ||
| 340 | - | ||
| 341 | -public type Web_item: | ||
| 342 | - center(Web_item),... | ||
| 343 | - | ||
| 344 | - | ||
| 345 | - You may want to write characters of a given item with a big font: | ||
| 346 | - | ||
| 347 | -public type Web_item: | ||
| 348 | - bigger(Int,Web_item), | ||
| 349 | - smaller(Int,Web_item), | ||
| 350 | - bold(Web_item), | ||
| 351 | - italic(Web_item), | ||
| 352 | - big(Web_item), | ||
| 353 | - very_big(Web_item),... | ||
| 354 | - | ||
| 355 | - | ||
| 356 | - Most of the previous are subsumed by 'style': | ||
| 357 | - | ||
| 358 | -public type WebStyle: | ||
| 359 | - background_image(String file_name), | ||
| 360 | - background_color(Web_color color), | ||
| 361 | - background_transparent, | ||
| 362 | - background_repeat_horizontal, // repeat the background image only horizontally | ||
| 363 | - background_repeat_vertical, | ||
| 364 | - background_no_repeat, | ||
| 365 | - color(Web_color color), | ||
| 366 | - float_to_left, // the web item will float to the left and text will wrap around | ||
| 367 | - float_to_right, | ||
| 368 | - font_family(String font_name), // "verdana" "helvetica" "times" etc... | ||
| 369 | - font_size(Int size), | ||
| 370 | - italic, | ||
| 371 | - oblique, | ||
| 372 | - small_capitals, | ||
| 373 | - bold, | ||
| 374 | - bolder, | ||
| 375 | - lighter, | ||
| 376 | - line_height(Int height), | ||
| 377 | - text_center, | ||
| 378 | - text_left, | ||
| 379 | - text_right, | ||
| 380 | - text_justify, | ||
| 381 | - text_underline, | ||
| 382 | - text_blink, | ||
| 383 | - text_line_through, | ||
| 384 | - width(Int n). | ||
| 385 | - | ||
| 386 | - | ||
| 387 | - | ||
| 388 | -public type Web_item: | ||
| 389 | - style(List(WebStyle) styles, Web_item content),... | ||
| 390 | - | ||
| 391 | - | ||
| 392 | -public type Web_item: | ||
| 393 | - spacer(Int width, Int height), | ||
| 394 | - image(String file_name), /* image */ | ||
| 395 | - image_d(String file_name, String description), | ||
| 396 | - image_pt(Printable_tree file_name), | ||
| 397 | - on_image(String file_name, Web_item content), | ||
| 398 | - turning_images(NonEmptyList(String) filenames, Int millisecs),... | ||
| 399 | - | ||
| 400 | - | ||
| 401 | - | ||
| 402 | - A 'rollover' has the same role as a submit button or link, but it is prettier. It is | ||
| 403 | - made of two images. The first one 'image_on' determines the aspect of the button when | ||
| 404 | - the mouse cursor is on it. The other one 'image_off' determines the aspect of the | ||
| 405 | - button when the mouse cursor is anywhere else. The two images should be of the same | ||
| 406 | - size, otherwise bad effects may occur. The last operand 'description' is a small text | ||
| 407 | - which describes the role of the button. It appears in a bubble in the browser's window. | ||
| 408 | - | ||
| 409 | -public type Web_item: | ||
| 410 | - rollover(List(String) preload_images, // images to preload before the rollover is effective | ||
| 411 | - String url, // URL with possible web arguments | ||
| 412 | - String target, | ||
| 413 | - String image_on, // file name of 'highlighted' image | ||
| 414 | - String image_off, // file name of 'non highlighted' image | ||
| 415 | - String description), // short behavior description | ||
| 416 | - rollover(List(String) preload_images, | ||
| 417 | - String url, | ||
| 418 | - String target, | ||
| 419 | - String image_on, | ||
| 420 | - String image_off, | ||
| 421 | - Int width, | ||
| 422 | - Int height, | ||
| 423 | - String description), ... | ||
| 424 | - | ||
| 425 | - | ||
| 426 | - Mouse sensitive images are images with predefined zones which are clickable. When | ||
| 427 | - clicking in a zone, the specified corresponding URL is loaded by the browser. If two | ||
| 428 | - zones overlap, the first one (in the order they are defined) is selected. | ||
| 429 | - | ||
| 430 | - Zones are of 3 sorts: rectangles, circles and polygons. Point's coordinates are | ||
| 431 | - specified as pairs of integers (of anonymous agglomeration type (Int,Int)). The | ||
| 432 | - first coordinate counts pixels from the left of the image. The second coordinate counts | ||
| 433 | - pixels from the top of the image. With polygons, you can construct zones which are | ||
| 434 | - almost as complicated as you want. You may also construct a zone as the overlapping of | ||
| 435 | - several zones with the same URL. | ||
| 436 | - | ||
| 437 | -public type Mouse_Sensitive_Zone: | ||
| 438 | - rectangle | ||
| 439 | - ( | ||
| 440 | - (Int,Int) left_top, | ||
| 441 | - (Int,Int) right_bottom, | ||
| 442 | - String url | ||
| 443 | - ), | ||
| 444 | - circle | ||
| 445 | - ( | ||
| 446 | - (Int,Int) center, | ||
| 447 | - Int radius, | ||
| 448 | - String url | ||
| 449 | - ), | ||
| 450 | - polygon | ||
| 451 | - ( | ||
| 452 | - List((Int,Int)) vertices, | ||
| 453 | - String url | ||
| 454 | - ). | ||
| 455 | - | ||
| 456 | -public type Web_item: | ||
| 457 | - mouse_sensitive_image(String image_file_name, // the image itself | ||
| 458 | - List(Mouse_Sensitive_Zone) zones),... | ||
| 459 | - | ||
| 460 | - | ||
| 461 | - In project: mouse sensitive images, whose zones behave like submission buttons (to be | ||
| 462 | - used within a form). | ||
| 463 | - | ||
| 464 | - | ||
| 465 | -public type Web_item: | ||
| 466 | - background_sound(String sound_file_name, | ||
| 467 | - Bool loop),... | ||
| 468 | - | ||
| 469 | - | ||
| 470 | - | ||
| 471 | - ************************* | ||
| 472 | - * FORMS * | ||
| 473 | - ************************* | ||
| 474 | - | ||
| 475 | - | ||
| 476 | - Use 'forms' in order to get informations back from the client. The constructor 'form' | ||
| 477 | - take 2 arguments: | ||
| 478 | - | ||
| 479 | - - the name of the form, which must be the name of an Anubis web | ||
| 480 | - page. Indeed, when the user will submit the form, this page will | ||
| 481 | - be sent to him. | ||
| 482 | - - the content of the form, which may be any web item, but which | ||
| 483 | - normally (amongh other things) contains input fields and a | ||
| 484 | - submit button. | ||
| 485 | - | ||
| 486 | -public type Web_item: | ||
| 487 | - form(Printable_tree name, | ||
| 488 | - Web_item content), | ||
| 489 | - form_target(Printable_tree name, | ||
| 490 | - Web_item content, | ||
| 491 | - String target), | ||
| 492 | - form(Printable_tree name, | ||
| 493 | - String label_name, | ||
| 494 | - Web_item content), | ||
| 495 | - form_name(String form_name, // option name de form | ||
| 496 | - Web_item content),... | ||
| 497 | - | ||
| 498 | - public define Web_item | ||
| 499 | -form | ||
| 500 | - ( | ||
| 501 | - Printable_tree name, | ||
| 502 | - Web_item content | ||
| 503 | - ) = | ||
| 504 | - | ||
| 505 | - form("", name, content). | ||
| 506 | - | ||
| 507 | - Within a form, you may put 'text input fields', that the client may | ||
| 508 | - edit. The constructor 'text_input' has the following arguments: | ||
| 509 | - | ||
| 510 | - - name of input field. This will be the name of the correponding | ||
| 511 | - web argument in the Anubis web page referred to by the form. | ||
| 512 | - - size of field (as it appears on client screen), | ||
| 513 | - - initial value of field (the text that appears in the field, when | ||
| 514 | - the client downloads the page). | ||
| 515 | - | ||
| 516 | - | ||
| 517 | - public type Text_Input_Option | ||
| 518 | - | ||
| 519 | -public type Web_item: | ||
| 520 | - text_input(String name, /* text field to be documented by user */ | ||
| 521 | - Int size, | ||
| 522 | - String initial_value),... | ||
| 523 | - | ||
| 524 | - public define Web_item | ||
| 525 | - text_input | ||
| 526 | - ( | ||
| 527 | - String name, | ||
| 528 | - Int size, | ||
| 529 | - String initial_value | ||
| 530 | - ) = | ||
| 531 | - | ||
| 532 | - | ||
| 533 | - text_input( (List(Text_Input_Option)) [], name, size, initial_value). | ||
| 534 | - | ||
| 535 | - | ||
| 536 | -public type Web_item: | ||
| 537 | - password_input(String name, | ||
| 538 | - Int size), | ||
| 539 | - text_area(String name, | ||
| 540 | - Int columns, | ||
| 541 | - Int rows, | ||
| 542 | - String initial_text), | ||
| 543 | - upload(String name, Int size),... | ||
| 544 | - | ||
| 545 | - | ||
| 546 | - | ||
| 547 | - | ||
| 548 | -public type Web_item: | ||
| 549 | - submit(String button_text), /* submit button with text on it */ | ||
| 550 | - submit_pt(Printable_tree button_text), | ||
| 551 | - submit(String name, String text), | ||
| 552 | - submit_close(String name, String text), | ||
| 553 | - submit_pt2(String name, Printable_tree text), | ||
| 554 | - image_submit(String name, String image_file_name), | ||
| 555 | - image_submit(String name, String value, String image_file, Web_item content), | ||
| 556 | - hl_image_submit(String action_name, | ||
| 557 | - String value, | ||
| 558 | - String image_name, | ||
| 559 | - String image_file, | ||
| 560 | - String hl_image_file), | ||
| 561 | - text_submit(String name, String value, String text), | ||
| 562 | - web_submit(String web_args, Web_item content), | ||
| 563 | - button(String name, String text, String on_click_fonction, Int width, Int height),... | ||
| 564 | - | ||
| 565 | - | ||
| 566 | -public type Web_item: /* mark the form with an information */ | ||
| 567 | - mark(String name, String value), | ||
| 568 | - mark_pt(String name, Printable_tree value),... | ||
| 569 | - | ||
| 570 | -public type Web_item: | ||
| 571 | - close_button, /* button that closes the window */ | ||
| 572 | - close_button(String image_file_name), ... | ||
| 573 | - | ||
| 574 | - | ||
| 575 | - | ||
| 576 | - ********************************* | ||
| 577 | - * LABELS * | ||
| 578 | - ********************************* | ||
| 579 | - | ||
| 580 | - | ||
| 581 | - A 'label' is just a name that you may give to a position in a document. Use the | ||
| 582 | - following invisible Web_item 'label' to this end. Now, you can also create links in | ||
| 583 | - the same document, which, when clicked by the user, scroll the document, so that the | ||
| 584 | - position whose name is the given label is shown just at the top of the browser's | ||
| 585 | - window. | ||
| 586 | - | ||
| 587 | -public type Web_item: | ||
| 588 | - label(String label_name), /* give a name to a position in the page */ | ||
| 589 | - go_to_label(String label_name, /* a link for jumping to a label */ | ||
| 590 | - Web_item content),... | ||
| 591 | - | ||
| 592 | - | ||
| 593 | - | ||
| 594 | - ******************************** | ||
| 595 | - * TABLES * | ||
| 596 | - ******************************** | ||
| 597 | - | ||
| 598 | - | ||
| 599 | - A web item may be a table. A table is produced by the constructor | ||
| 600 | - 'table' from the type 'Web_item'. This constructor takes 2 | ||
| 601 | - arguments: | ||
| 602 | - | ||
| 603 | - - a list of 'table options', | ||
| 604 | - - a list of 'table rows'. | ||
| 605 | - | ||
| 606 | - Of course, you use as many options as you want, including | ||
| 607 | - none (if you do not want any option, put the empty list '[ ]' as | ||
| 608 | - this argument). Some options have precedence over others. For example | ||
| 609 | - a background image will hide the background color. | ||
| 610 | - | ||
| 611 | - Table options are defined below: | ||
| 612 | - | ||
| 613 | -public type Table_option: | ||
| 614 | - | ||
| 615 | - /* use a color as a background for the table, if you want it to | ||
| 616 | - be different from the background of the page */ | ||
| 617 | - background_color(Web_color), | ||
| 618 | - | ||
| 619 | - /* or use an image as the background of the table */ | ||
| 620 | - background_image(String file_name), | ||
| 621 | - | ||
| 622 | - /* draw a border line around the table (and around each cell in | ||
| 623 | - the table). You may also specify a geometry (in pixels) for the | ||
| 624 | - border. This makes the 'in relief' part of the border appear | ||
| 625 | - more or less wide. You may also specify a color for the border. */ | ||
| 626 | - border, | ||
| 627 | - nude, /* equivalent to 'border(0,0,0)' (below) */ | ||
| 628 | - border(Int, /* width of exterior (pixels) */ | ||
| 629 | - Int, /* width of top */ | ||
| 630 | - Int), /* width of interior */ | ||
| 631 | - border_color(Web_color), | ||
| 632 | - absolute_width(Int). | ||
| 633 | - | ||
| 634 | - | ||
| 635 | - | ||
| 636 | - A 'table row' is made of a list of 'row options', and a list of | ||
| 637 | - 'cells'. A 'cell' itself has a list of 'cell options', and a web item, | ||
| 638 | - which is its content. We begin by the description of options. | ||
| 639 | - | ||
| 640 | - | ||
| 641 | -public type Row_option: | ||
| 642 | - /* following concerns the horizontal positions of items within the | ||
| 643 | - cells of the row */ | ||
| 644 | - left, | ||
| 645 | - h_center, | ||
| 646 | - right, | ||
| 647 | - /* the following concerns the vertical positions of items, within | ||
| 648 | - the cells of the row */ | ||
| 649 | - top, | ||
| 650 | - v_center, | ||
| 651 | - bottom, | ||
| 652 | - absolute_height(Int), | ||
| 653 | - base_line, | ||
| 654 | - /* set the background color of all cells in the row */ | ||
| 655 | - background_color(Web_color). | ||
| 656 | - | ||
| 657 | - | ||
| 658 | - | ||
| 659 | -public type Cell_option: | ||
| 660 | - /* all row options are available for individual cells, and apply | ||
| 661 | - here only to one cell. */ | ||
| 662 | - left, | ||
| 663 | - h_center, | ||
| 664 | - right, | ||
| 665 | - top, | ||
| 666 | - v_center, | ||
| 667 | - bottom, | ||
| 668 | - base_line, | ||
| 669 | - background_color(Web_color), | ||
| 670 | - /* you can set the width of the cell either absolutely (in pixels) | ||
| 671 | - or as a percentage of the width of the table. */ | ||
| 672 | - background_image(String file_name), | ||
| 673 | - absolute_width(Int), | ||
| 674 | - relative_width(Int), | ||
| 675 | - absolute_height(Int), | ||
| 676 | - relative_height(Int), | ||
| 677 | - /* a cell may span over several columns or rows in the table */ | ||
| 678 | - columns(Int), | ||
| 679 | - rows(Int), | ||
| 680 | - nowrap. | ||
| 681 | - | ||
| 682 | - | ||
| 683 | -public type Cell: | ||
| 684 | - cell(List(Cell_option), | ||
| 685 | - Web_item). | ||
| 686 | - | ||
| 687 | -public type Table_row: | ||
| 688 | - row(List(Row_option), | ||
| 689 | - List(Cell)). | ||
| 690 | - | ||
| 691 | -public define Table_row row(Web_item i) = row([],[cell([],i)]). | ||
| 692 | -public define Table_row row(Cell c) = row([],[c]). | ||
| 693 | -public define Table_row row(List(Cell) l) = row([],l). | ||
| 694 | - | ||
| 695 | - | ||
| 696 | -public type Web_item: | ||
| 697 | - table(List(Table_option), | ||
| 698 | - List(Table_row)),... | ||
| 699 | - | ||
| 700 | -public type Web_item: | ||
| 701 | - list(List(Web_item)),... | ||
| 702 | - | ||
| 703 | -public type Web_item: | ||
| 704 | - link(String name, Web_item), | ||
| 705 | - link(String name, String target, Web_item),... | ||
| 706 | - | ||
| 707 | -public type Web_item: | ||
| 708 | - link_for_download(String filename, Web_item),... // the filename is relative to the public directory | ||
| 709 | - | ||
| 710 | -public type Web_item: | ||
| 711 | - mail_to(String addr, Web_item),... | ||
| 712 | - | ||
| 713 | - | ||
| 714 | -public type Web_item: | ||
| 715 | - select(String name, | ||
| 716 | - Int size, | ||
| 717 | - List(String) choices), | ||
| 718 | - select(String name, | ||
| 719 | - Int size, | ||
| 720 | - List(String) choices, | ||
| 721 | - String selected), | ||
| 722 | - immediate_select(String name, // selection will immediately submit the form | ||
| 723 | - Int size, | ||
| 724 | - List(String) choices),... | ||
| 725 | - | ||
| 726 | - | ||
| 727 | -public type Web_item: | ||
| 728 | - radio_button (Printable_tree name, String value), | ||
| 729 | - checked_radio_button (Printable_tree name, String value), | ||
| 730 | - check_box (Printable_tree name, String value), | ||
| 731 | - checked_box (Printable_tree name, String value),... | ||
| 732 | - | ||
| 733 | - | ||
| 734 | -public type Web_item: | ||
| 735 | - link_to_window(Printable_tree name, Web_item), | ||
| 736 | - link_to_window(Printable_tree name, String window_name, Web_item), | ||
| 737 | - link_to_window_with_ticket(String name, | ||
| 738 | - String web_args, | ||
| 739 | - String window_name, | ||
| 740 | - Web_item content, | ||
| 741 | - Int width, | ||
| 742 | - Int height), | ||
| 743 | - link_to_window_with_ticket_and_scroll | ||
| 744 | - (String name, | ||
| 745 | - String web_args, | ||
| 746 | - String window_name, | ||
| 747 | - Web_item content, | ||
| 748 | - Int width, | ||
| 749 | - Int height), | ||
| 750 | - link_to_window_with_ticket_and_scroll | ||
| 751 | - (String name, | ||
| 752 | - String label_name, | ||
| 753 | - String web_args, | ||
| 754 | - String window_name, | ||
| 755 | - Web_item content, | ||
| 756 | - Int width, | ||
| 757 | - Int height), | ||
| 758 | - link_to_frame (Printable_tree name, String frame_name, Web_item). | ||
| 759 | - | ||
| 760 | - | ||
| 761 | - | ||
| 762 | ----- Formating operations (Anubis --> HTML/Javascript) --------------------------- | ||
| 763 | - | ||
| 764 | - Stupid operation formating a web color name. | ||
| 765 | - | ||
| 766 | -public define String | ||
| 767 | - format | ||
| 768 | - ( | ||
| 769 | - Web_color_name n | ||
| 770 | - ) = | ||
| 771 | - if n is | ||
| 772 | - { | ||
| 773 | - aliceblue then "aliceblue", | ||
| 774 | - antiquewhite1 then "antiquewhite1", | ||
| 775 | - antiquewhite2 then "antiquewhite2", | ||
| 776 | - antiquewhite3 then "antiquewhite3", | ||
| 777 | - antiquewhite4 then "antiquewhite4", | ||
| 778 | - aquamarine1 then "aquamarine1", | ||
| 779 | - aquamarine2 then "aquamarine2", | ||
| 780 | - aquamarine3 then "aquamarine3", | ||
| 781 | - aquamarine4 then "aquamarine4", | ||
| 782 | - azure1 then "azure1", | ||
| 783 | - azure2 then "azure2", | ||
| 784 | - azure3 then "azure3", | ||
| 785 | - azure4 then "azure4", | ||
| 786 | - yellow then "yellow", | ||
| 787 | - }. | ||
| 788 | - | ||
| 789 | - Anubis really needs some system of 'macros' to avoid this... | ||
| 790 | - | ||
| 791 | - | ||
| 792 | - Formating a web color. | ||
| 793 | - | ||
| 794 | -public define String | ||
| 795 | - format | ||
| 796 | - ( | ||
| 797 | - Web_color wc | ||
| 798 | - ) = | ||
| 799 | - if wc is | ||
| 800 | - { | ||
| 801 | - rgb(r,g,b) then "\"#" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "\"", | ||
| 802 | - _(c) then format(c) | ||
| 803 | - }. | ||
| 804 | - | ||
| 805 | -public define String | ||
| 806 | - format_without_quotes | ||
| 807 | - ( | ||
| 808 | - Web_color wc | ||
| 809 | - ) = | ||
| 810 | - if wc is | ||
| 811 | - { | ||
| 812 | - rgb(r,g,b) then "#" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "", | ||
| 813 | - _(c) then format(c) | ||
| 814 | - }. | ||
| 815 | - | ||
| 816 | -define Printable_tree | ||
| 817 | - format | ||
| 818 | - ( | ||
| 819 | - Web_color c | ||
| 820 | - ) = [(String)format(c)]. | ||
| 821 | - | ||
| 822 | -public define String | ||
| 823 | - format_without_sharp | ||
| 824 | - ( | ||
| 825 | - Web_color wc | ||
| 826 | - ) = | ||
| 827 | - if wc is | ||
| 828 | - { | ||
| 829 | - rgb(r,g,b) then "" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "", | ||
| 830 | - _(c) then format(c) | ||
| 831 | - }. | ||
| 832 | - | ||
| 833 | -define Printable_tree | ||
| 834 | - format_without_sharp | ||
| 835 | - ( | ||
| 836 | - Web_color c | ||
| 837 | - ) = [(String)format_without_sharp(c)]. | ||
| 838 | - | ||
| 839 | - | ||
| 840 | - define Printable_tree | ||
| 841 | - [Word32 x . Printable_tree t] | ||
| 842 | - = | ||
| 843 | - [to_Int(x) . t]. | ||
| 844 | - | ||
| 845 | -define Printable_tree | ||
| 846 | - psychedelic_bg | ||
| 847 | - ( | ||
| 848 | - Int average, | ||
| 849 | - Int amplitude, | ||
| 850 | - Int delay | ||
| 851 | - ) = | ||
| 852 | - with ampl = if amplitude >= 120 then 120 else | ||
| 853 | - if amplitude =< 1 then 1 else amplitude, | ||
| 854 | - with aver = if average+ampl >= 254 then 254-ampl | ||
| 855 | - else if average-ampl =< 1 then 1+ampl else average, | ||
| 856 | - [ "<script>", | ||
| 857 | - " var psy_t = 0;", | ||
| 858 | - " function do_psy_bg() { psy_t += 0.05;", | ||
| 859 | - " document.bgColor = '#' + ", | ||
| 860 | - " (Math.round(",aver,"+",ampl,"*Math.cos(psy_t))).toString(16) + ", | ||
| 861 | - " (Math.round(",aver,"+",ampl,"*Math.sin(psy_t))).toString(16) + ", | ||
| 862 | - " (Math.round(",aver,"-",ampl,"*Math.cos(2*psy_t))).toString(16); ", | ||
| 863 | - " setTimeout(\"do_psy_bg()\",",delay,"); }", | ||
| 864 | - " setTimeout(\"do_psy_bg()\",1000);", | ||
| 865 | - "</script>"]. | ||
| 866 | - | ||
| 867 | - | ||
| 868 | -define List(Web_body_option) | ||
| 869 | - replace_background_init | ||
| 870 | - ( | ||
| 871 | - List(Web_body_option) l, | ||
| 872 | - Int average, | ||
| 873 | - Int amplitude, | ||
| 874 | - Int delay | ||
| 875 | - ) = | ||
| 876 | - if l is | ||
| 877 | - { | ||
| 878 | - [ ] then [ ], | ||
| 879 | - [h . t] then | ||
| 880 | - if h is background_color(_) | ||
| 881 | - then [background_color(rgb(truncate_to_Word8(average+amplitude), | ||
| 882 | - truncate_to_Word8(average), | ||
| 883 | - truncate_to_Word8(average-amplitude))) | ||
| 884 | - . replace_background_init(t,average,amplitude,delay)] | ||
| 885 | - else [h . replace_background_init(t,average,amplitude,delay)] | ||
| 886 | - }. | ||
| 887 | - | ||
| 888 | -define Maybe((Int,Int,Int)) | ||
| 889 | - get_psy | ||
| 890 | - ( | ||
| 891 | - List(Web_body_option) l | ||
| 892 | - ) = | ||
| 893 | - if l is | ||
| 894 | - { | ||
| 895 | - [ ] then failure, | ||
| 896 | - [h . t] then | ||
| 897 | - if h is psychedelic_background(a,f,d) | ||
| 898 | - then success((a,f,d)) | ||
| 899 | - else get_psy(t) | ||
| 900 | - }. | ||
| 901 | - | ||
| 902 | -define List(Web_body_option) | ||
| 903 | - prepare | ||
| 904 | - ( | ||
| 905 | - List(Web_body_option) l | ||
| 906 | - ) = | ||
| 907 | - if get_psy(l) is | ||
| 908 | - { | ||
| 909 | - failure then l, | ||
| 910 | - success(op) then if op is (a,f,d) then | ||
| 911 | - replace_background_init(l,a,f,d) | ||
| 912 | - }. | ||
| 913 | - | ||
| 914 | - | ||
| 915 | -public define Printable_tree | ||
| 916 | - format | ||
| 917 | - ( | ||
| 918 | - String c_ticket, | ||
| 919 | - String s_ticket, | ||
| 920 | - Web_item i | ||
| 921 | - ). | ||
| 922 | - | ||
| 923 | -define Printable_tree | ||
| 924 | - move_layer_command | ||
| 925 | - ( | ||
| 926 | - String property, | ||
| 927 | - Int n, | ||
| 928 | - Int num, | ||
| 929 | - Int i, | ||
| 930 | - Int period | ||
| 931 | - ) = | ||
| 932 | - if i >= num then [ ] else | ||
| 933 | - [" if (document.layers)", | ||
| 934 | - " { document.nslay",n,"_",i,".",property,"=layp",n,"+(",((i-1)),"); } ", | ||
| 935 | - " else ", | ||
| 936 | - " { ielay",n,"_",i,".style.",property,"=layp",n,"+(",(i-1)*period,"); } " | ||
| 937 | - . move_layer_command(property,n,num,i+1,period)]. | ||
| 938 | - | ||
| 939 | -define Printable_tree | ||
| 940 | - format_layers | ||
| 941 | - ( | ||
| 942 | - LayerDisposition disp, | ||
| 943 | - Int margin, | ||
| 944 | - Web_item content, | ||
| 945 | - Int n, | ||
| 946 | - Int num, | ||
| 947 | - Int i, | ||
| 948 | - Int period | ||
| 949 | - ) = | ||
| 950 | - if i >= num then [ ] else | ||
| 951 | - ["<layer name=\"nslay",n,"_",i,"\" top=0", | ||
| 952 | - " left=0", ">", | ||
| 953 | - "<div id=ielay",n,"_",i," style=\"position:absolute;top:", | ||
| 954 | - if disp is vertical then (i-1)*period else margin, | ||
| 955 | - "px;left:", | ||
| 956 | - if disp is vertical then margin else (i-1)*period, | ||
| 957 | - "px\">", | ||
| 958 | - format("","",content), | ||
| 959 | - "</div></layer>" . format_layers(disp,margin,content,n,num,i+1,period)]. | ||
| 960 | - | ||
| 961 | -define Printable_tree | ||
| 962 | - s_layer | ||
| 963 | - ( | ||
| 964 | - LayerDisposition disp, | ||
| 965 | - Int steps, | ||
| 966 | - Int margin, | ||
| 967 | - Int delay, | ||
| 968 | - Web_item content, | ||
| 969 | - Int period, | ||
| 970 | - Int num | ||
| 971 | - ) = | ||
| 972 | - with n = new_web_count, | ||
| 973 | - [ "<script>", | ||
| 974 | - " var layp",n," = 0;", | ||
| 975 | - " function scroll_layer",n,"() {", | ||
| 976 | - " layp",n,"+=(",steps,"); if (layp",n," ",if steps > 0 then ">" else "<", | ||
| 977 | - "= ",if steps > 0 then period else 0, | ||
| 978 | - ") layp",n," = ",if steps > 0 then 0 else period,";", | ||
| 979 | - move_layer_command(if disp is vertical then "top" else "left",n,num,0,period), | ||
| 980 | - " setTimeout(\"scroll_layer",n,"()\",",delay,");", | ||
| 981 | - " }", | ||
| 982 | - " setTimeout(\"scroll_layer",n,"()\",1000);", | ||
| 983 | - "</script>", | ||
| 984 | - format_layers(disp,margin,content,n,num,0,period), | ||
| 985 | - ]. | ||
| 986 | - | ||
| 987 | - | ||
| 988 | -define Printable_tree | ||
| 989 | - over | ||
| 990 | - ( | ||
| 991 | - Web_item i, | ||
| 992 | - Int left, | ||
| 993 | - Int top | ||
| 994 | - ) = | ||
| 995 | - with n = new_web_count, | ||
| 996 | - [ "<layer name=\"nslay",n,"\" top=",top," left=",left,">", | ||
| 997 | - " <div id=\"ielay",n,"\" style=\"position:absolute;top=",top,"px;left=",left,"px\">", | ||
| 998 | - format("","",i), | ||
| 999 | - "</div></layer>" | ||
| 1000 | - ]. | ||
| 1001 | - | ||
| 1002 | -define Printable_tree | ||
| 1003 | - bnce | ||
| 1004 | - ( | ||
| 1005 | - Web_item i, | ||
| 1006 | - Int left, | ||
| 1007 | - Int right, | ||
| 1008 | - Int top, | ||
| 1009 | - Int bottom | ||
| 1010 | - ) = | ||
| 1011 | - with n = new_web_count, | ||
| 1012 | - [ "<script>", | ||
| 1013 | - " var bncx",n," = ",left,"; var bncy",n," = ",top,"; var bncdx",n," = 1; var bncdy",n," = 1;", | ||
| 1014 | - " function do_bnc",n,"() {", | ||
| 1015 | - " if (bncx",n," >= (",right,") || bncx",n," < ",left,") bncdx",n," = -bncdx",n,";", | ||
| 1016 | - " if (bncy",n," >= (",bottom,") || bncy",n," < ",top,") bncdy",n," = -bncdy",n,";", | ||
| 1017 | - " bncx",n," += bncdx",n,"; bncy",n," += bncdy",n,";", | ||
| 1018 | - " if (document.layers)", | ||
| 1019 | - " { document.nslay",n,".left = bncx",n,"; document.nslay",n,".top = bncy",n,"; } else", | ||
| 1020 | - " { ielay",n,".style.left = bncx",n,"; ielay",n,".style.top = bncy",n,"; }", | ||
| 1021 | - " setTimeout(\"do_bnc",n,"()\",40); }", | ||
| 1022 | - " setTimeout(\"do_bnc",n,"()\",1000);", | ||
| 1023 | - "</script>", | ||
| 1024 | - "<layer name=\"nslay",n,"\" top=",top," left=",left,">", | ||
| 1025 | - " <div id=\"ielay",n,"\" style=\"position:absolute;top=",top,"px;left=",left,"px\">", | ||
| 1026 | - format("","",i), | ||
| 1027 | - "</div></layer>" | ||
| 1028 | - ]. | ||
| 1029 | - | ||
| 1030 | - | ||
| 1031 | -define Printable_tree | ||
| 1032 | - folp_switch | ||
| 1033 | - ( | ||
| 1034 | - Int n, | ||
| 1035 | - Int i, | ||
| 1036 | - List(FollowPathCommand) path, | ||
| 1037 | - Bool loop, | ||
| 1038 | - Int steps | ||
| 1039 | - ) = | ||
| 1040 | - if path is | ||
| 1041 | - { | ||
| 1042 | - [ ] then [ ], | ||
| 1043 | - [p0 . t0] then if p0 is pos(x0,y0,i0,d0) then | ||
| 1044 | - if t0 is | ||
| 1045 | - { | ||
| 1046 | - [ ] then if loop | ||
| 1047 | - then [" default: ", | ||
| 1048 | - " folpx",n,"=",x0,"; folpy",n,"=",y0,"; ", | ||
| 1049 | - " folpseg",n,"=0; ", | ||
| 1050 | - " folpwait",n,"=",d0,";", | ||
| 1051 | - " if(document.layers)", | ||
| 1052 | - " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[",i0,"].src;", | ||
| 1053 | - " else document.folpim",n,".src=folpimages",n,"[",i0,"].src;", | ||
| 1054 | - " folpstpmax",n," = 0;", | ||
| 1055 | - " folpstp",n,"=0;", | ||
| 1056 | - " folpdx",n,"=0; ", | ||
| 1057 | - " folpdy",n,"=0; ", | ||
| 1058 | - " break;"] | ||
| 1059 | - else [" default: folpend",n,"=1; break; "], | ||
| 1060 | - [p1 . t1] then if p1 is pos(x1,y1,i1,d1) then | ||
| 1061 | - [ " case ",i,": ", | ||
| 1062 | - " folpx",n,"=",x0,"; folpy",n,"=",y0,"; ", | ||
| 1063 | - " folpseg",n,"=",i+1,"; ", | ||
| 1064 | - " folpwait",n,"=",d0,";", | ||
| 1065 | - " if(document.layers)", | ||
| 1066 | - " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[",i0,"].src;", | ||
| 1067 | - " else document.folpim",n,".src=folpimages",n,"[",i0,"].src;", | ||
| 1068 | - " folpstpmax",n," = ", | ||
| 1069 | - "Math.round(Math.sqrt(Math.pow(",x1,"-",x0,",2)+Math.pow(",y1,"-",y0,",2))/",steps,");", | ||
| 1070 | - " folpstp",n,"=0;", | ||
| 1071 | - " folpdx",n,"=((",x1,"-",x0,")/folpstpmax",n,"); ", | ||
| 1072 | - " folpdy",n,"=((",y1,"-",y0,")/folpstpmax",n,"); ", | ||
| 1073 | - " break; " | ||
| 1074 | - . folp_switch(n,i+1,t0,loop,steps) ] | ||
| 1075 | - }}. | ||
| 1076 | - | ||
| 1077 | -define Printable_tree | ||
| 1078 | - set_folpimages | ||
| 1079 | - ( | ||
| 1080 | - Int n, | ||
| 1081 | - List(String) filenames, | ||
| 1082 | - Int i, | ||
| 1083 | - ) = | ||
| 1084 | - if filenames is | ||
| 1085 | - { | ||
| 1086 | - [ ] then [ ], | ||
| 1087 | - [h . t] then | ||
| 1088 | - [ " folpimages",n,"[",i,"].src=\"",h,"\";" | ||
| 1089 | - . set_folpimages(n,t,i+1)] | ||
| 1090 | - }. | ||
| 1091 | - | ||
| 1092 | -define Printable_tree | ||
| 1093 | - follow_path | ||
| 1094 | - ( | ||
| 1095 | - List(String) filenames, | ||
| 1096 | - Int change_every, | ||
| 1097 | - List(FollowPathCommand) path, | ||
| 1098 | - Bool loop, | ||
| 1099 | - Int steps, | ||
| 1100 | - Int delay | ||
| 1101 | - ) = | ||
| 1102 | - if filenames is | ||
| 1103 | - { | ||
| 1104 | - [ ] then (print("Error in usage of 'follow_path': 'filenames' must be non empty."); []), | ||
| 1105 | - [im1 . other_ims] then | ||
| 1106 | - if steps < 1 then (print("Error in usage of 'follow_path': 'step' must be >= 1."); [ ]) else | ||
| 1107 | - if path is | ||
| 1108 | - { | ||
| 1109 | - [ ] then [ ], | ||
| 1110 | - [p0 . t0] then if p0 is pos(x0,y0,i0,d0) then | ||
| 1111 | - if t0 is | ||
| 1112 | - { | ||
| 1113 | - [ ] then | ||
| 1114 | - (print("Error in usage of 'follow_path': 'path' must have at least 2 positions."); []), | ||
| 1115 | - [p1 . t1] then if p1 is pos(x1,y1,i1,d1) then | ||
| 1116 | - with n = new_web_count, | ||
| 1117 | - [ | ||
| 1118 | - "<layer name=\"nslay",n,"\" top=",y0," left=",x0,">", | ||
| 1119 | - "<div id=\"ielay",n,"\" style=\"position:absolute;top=",y0,"px;left=",x0,"px\">", | ||
| 1120 | - "<img src=\"",im1,"\" name=\"folpim",n,"\" border=0>", | ||
| 1121 | - "</div></layer>", | ||
| 1122 | - "<script>", | ||
| 1123 | - " var folpimages",n,"=new Array(",length(filenames),");", | ||
| 1124 | - " var folpcurim",n,"=0;", | ||
| 1125 | - " var folpx",n," = ",x0,";", | ||
| 1126 | - " var folpy",n," = ",y0,";", | ||
| 1127 | - " var folpseg",n," = 1;", | ||
| 1128 | - " var folpstpmax",n," = ", | ||
| 1129 | - "Math.round(Math.sqrt(Math.pow(",x1,"-",x0,",2)+Math.pow(",y1,"-",y0,",2))/",steps,");", | ||
| 1130 | - " var folpdx",n,"=((",x1,"-",x0,")/folpstpmax",n,"); ", | ||
| 1131 | - " var folpdy",n,"=((",y1,"-",y0,")/folpstpmax",n,"); ", | ||
| 1132 | - " var folpstp",n," = 0;", | ||
| 1133 | - " var folpchgcnt",n," = 0;", | ||
| 1134 | - " var folpwait",n,"=",d0,";", | ||
| 1135 | - " var folpend",n,"=0;", | ||
| 1136 | - " for(var i = 0; i<",length(filenames),"; i++) {", | ||
| 1137 | - " folpimages",n,"[i]=new Image(); }", | ||
| 1138 | - set_folpimages(n,filenames,0), | ||
| 1139 | - " function dofolp",n,"() {", | ||
| 1140 | - " if (folpstp",n," >= folpstpmax",n,")", | ||
| 1141 | - " { switch(folpseg",n,") {", | ||
| 1142 | - folp_switch(n,0,path,loop,steps), | ||
| 1143 | - " }} else { folpstp",n,"++; folpx",n," += folpdx",n,"; folpy",n," += folpdy",n,"; };", | ||
| 1144 | - " if (document.layers)", | ||
| 1145 | - " { document.nslay",n,".left=folpx",n,"; document.nslay",n,".top=folpy",n,"; } else", | ||
| 1146 | - " { ielay",n,".style.left=folpx",n,"; ielay",n,".style.top=folpy",n,"; };", | ||
| 1147 | - | ||
| 1148 | - //--- change image if needed: | ||
| 1149 | - if change_every = 0 then [ ] else | ||
| 1150 | - if length(filenames) =< 1 then [ ] else | ||
| 1151 | - [" if (folpchgcnt",n,"==",change_every,") ", | ||
| 1152 | - " { ", | ||
| 1153 | - " folpchgcnt",n,"=0;", | ||
| 1154 | - " folpcurim",n,"++;", | ||
| 1155 | - " if (folpcurim",n,"==",length(filenames),") folpcurim",n,"=0;", | ||
| 1156 | - " if (document.layers) ", | ||
| 1157 | - " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[folpcurim",n,"].src;", | ||
| 1158 | - " else document.folpim",n,".src=folpimages",n,"[folpcurim",n,"].src;", | ||
| 1159 | - " }", | ||
| 1160 | - " else { folpchgcnt",n,"++; };"], | ||
| 1161 | - | ||
| 1162 | - " if (!folpend",n,")", | ||
| 1163 | - " if (folpstp",n,") setTimeout(\"dofolp",n,"()\",",delay,"); ", | ||
| 1164 | - " else setTimeout(\"dofolp",n,"()\",",delay,"+folpwait",n,"); ", | ||
| 1165 | - " }", | ||
| 1166 | - " setTimeout(\"dofolp",n,"()\",1000);", | ||
| 1167 | - "</script>", | ||
| 1168 | - ] | ||
| 1169 | - }}}. | ||
| 1170 | - | ||
| 1171 | - | ||
| 1172 | -public type ImageToLoad: | ||
| 1173 | - simple(String image_name), | ||
| 1174 | - with_rollover(String image_name, | ||
| 1175 | - String rollover_name). | ||
| 1176 | - | ||
| 1177 | -variable List(ImageToLoad) images_to_load = []. | ||
| 1178 | - | ||
| 1179 | -public define Printable_tree | ||
| 1180 | - format | ||
| 1181 | - ( | ||
| 1182 | - Web_body_option o | ||
| 1183 | - ) = | ||
| 1184 | - if o is | ||
| 1185 | - { | ||
| 1186 | - background_color(c) then [" bgcolor=" , (String)format(c)], | ||
| 1187 | - psychedelic_background(a,f,d) then add_script(psychedelic_bg(a,f,d)); [ ], | ||
| 1188 | - background_image(n) then [" background=", n], | ||
| 1189 | - scrolling_layer(disp,st,m,t,c,p) then add_script(s_layer(disp,st,m,t,c,p,2000\p)); [ ], | ||
| 1190 | - bounce(i,l,r,t,b) then add_script(bnce(i,l,r,t,b)); [ ], | ||
| 1191 | - over(i,l,t) then add_script(over(i,l,t)); [ ], | ||
| 1192 | - follow_path(li,ns,p,l,s,d) then add_script(follow_path(li,ns,p,l,s,d)); [ ], | ||
| 1193 | - load_image(n) then images_to_load <- [simple(n) . *images_to_load]; [ ], | ||
| 1194 | - left_margin(n) then [" leftmargin=", n], | ||
| 1195 | - top_margin(n) then [" topmargin=", n], | ||
| 1196 | - margin_width(n) then [" marginwidth=", n], | ||
| 1197 | - margin_height(n) then [" marginheight=", n], | ||
| 1198 | - reload_frame(n,url) then add_body_onload(reload_frame(n,url)); [ ], | ||
| 1199 | - onload(n) then [" onLoad=\"", n, "()\""] | ||
| 1200 | - }. | ||
| 1201 | - | ||
| 1202 | -define Printable_tree | ||
| 1203 | - preload_list | ||
| 1204 | - ( | ||
| 1205 | - List(ImageToLoad) images, | ||
| 1206 | - Int n, | ||
| 1207 | - ) = | ||
| 1208 | - if images is | ||
| 1209 | - { | ||
| 1210 | - [ ] then [ ], | ||
| 1211 | - [h . t] then | ||
| 1212 | - [" preloaded_images[",n,"].src = '",image_name(h),"';", | ||
| 1213 | - if h is | ||
| 1214 | - { | ||
| 1215 | - simple(_) then [], | ||
| 1216 | - with_rollover(n1,r) then | ||
| 1217 | - [" preloaded_images[",n1,"].onload = 'allow_rollover(\"",r,"\")';"] | ||
| 1218 | - } | ||
| 1219 | - . preload_list(t,n-1)] | ||
| 1220 | - }. | ||
| 1221 | - | ||
| 1222 | -define Printable_tree | ||
| 1223 | - load_image_script | ||
| 1224 | - ( | ||
| 1225 | - List(ImageToLoad) images | ||
| 1226 | - ) = | ||
| 1227 | - if images is | ||
| 1228 | - { | ||
| 1229 | - [ ] then [ ], | ||
| 1230 | - [_ . _] then | ||
| 1231 | - [ | ||
| 1232 | - "<script>", | ||
| 1233 | - " var preloaded_images = new Array(",length(images),");", | ||
| 1234 | - " var pi_i = 0;", | ||
| 1235 | - " for(pi_i = 0; pi_i < ",length(images),"; pi_i++) {", | ||
| 1236 | - " preloaded_images[pi_i] = new Image(); }", | ||
| 1237 | - " function preload_images() {", | ||
| 1238 | - preload_list(images,length(images)-1), | ||
| 1239 | - " }</script>" | ||
| 1240 | - ] | ||
| 1241 | - }. | ||
| 1242 | - | ||
| 1243 | - | ||
| 1244 | -public define Printable_tree format(String c_ticket, | ||
| 1245 | - String s_ticket, | ||
| 1246 | - Web_item i). | ||
| 1247 | - | ||
| 1248 | - | ||
| 1249 | -public define Printable_tree | ||
| 1250 | - format(List(Table_option) l) = | ||
| 1251 | - if l is | ||
| 1252 | - { | ||
| 1253 | - [ ] then [ ], | ||
| 1254 | - [h . t] then [if h is | ||
| 1255 | - { | ||
| 1256 | - background_color(c) then [" bgcolor=", (String)format(c)], | ||
| 1257 | - background_image(f) then [" background=",f], | ||
| 1258 | - border then [" border"], | ||
| 1259 | - nude then [" border=\"0\" cellspacing=\"0\" cellpadding=\"0\""], | ||
| 1260 | - border(e,top,i) then [" border=",e," cellspacing=",top," cellpadding=",i], | ||
| 1261 | - border_color(c) then [" bordercolor=", (String)format(c)], | ||
| 1262 | - absolute_width(n) then [" width=",n] | ||
| 1263 | - }, format(t)] | ||
| 1264 | - }. | ||
| 1265 | - | ||
| 1266 | - | ||
| 1267 | - | ||
| 1268 | -public define Printable_tree | ||
| 1269 | - format(List(Row_option) l) = | ||
| 1270 | - if l is | ||
| 1271 | - { | ||
| 1272 | - [ ] then [ ], | ||
| 1273 | - [first . others] then [if first is | ||
| 1274 | - { | ||
| 1275 | - left then [" align=left"], | ||
| 1276 | - h_center then [" align=center"], | ||
| 1277 | - right then [" align=right"], | ||
| 1278 | - top then [" valign=top"], | ||
| 1279 | - v_center then [" valign=center"], | ||
| 1280 | - bottom then [" valign=bottom"], | ||
| 1281 | - absolute_height(n) then [" height=\"",n,"\""], | ||
| 1282 | - base_line then [" valign=baseline"], | ||
| 1283 | - background_color(c) then [" bgcolor=",(String)format(c)] | ||
| 1284 | - }, | ||
| 1285 | - format(others)] | ||
| 1286 | - }. | ||
| 1287 | - | ||
| 1288 | - | ||
| 1289 | - | ||
| 1290 | - | ||
| 1291 | -public define Int | ||
| 1292 | - percentage(Int n) = | ||
| 1293 | - if n < 0 then 0 | ||
| 1294 | - else if n > 100 then 100 | ||
| 1295 | - else n. | ||
| 1296 | - | ||
| 1297 | - public define Int percentage(Int n) = n. | ||
| 1298 | - | ||
| 1299 | - | ||
| 1300 | - | ||
| 1301 | - | ||
| 1302 | -public define Printable_tree | ||
| 1303 | - format | ||
| 1304 | - ( | ||
| 1305 | - List(Web_body_option) l | ||
| 1306 | - ) = | ||
| 1307 | - if l is | ||
| 1308 | - { | ||
| 1309 | - [ ] then [ ], | ||
| 1310 | - [h . t] then [format(h) . format(t)] | ||
| 1311 | - }. | ||
| 1312 | - | ||
| 1313 | - | ||
| 1314 | - | ||
| 1315 | - | ||
| 1316 | -public define Printable_tree | ||
| 1317 | - format(List(Cell_option) l) = | ||
| 1318 | - if l is | ||
| 1319 | - { | ||
| 1320 | - [ ] then [ ], | ||
| 1321 | - [first . others] then | ||
| 1322 | - [if first is | ||
| 1323 | - { | ||
| 1324 | - left then (Printable_tree)[" align=left"], | ||
| 1325 | - h_center then (Printable_tree)[" align=center"], | ||
| 1326 | - right then (Printable_tree)[" align=right"], | ||
| 1327 | - top then (Printable_tree)[" valign=top"], | ||
| 1328 | - v_center then (Printable_tree)[" valign=center"], | ||
| 1329 | - bottom then (Printable_tree)[" valign=bottom"], | ||
| 1330 | - base_line then (Printable_tree)[" valign=baseline"], | ||
| 1331 | - background_color(c) then (Printable_tree)[" bgcolor=",(String)format(c)], | ||
| 1332 | - background_image(n) then (Printable_tree)[" style=\"background: url(",n,")\""], | ||
| 1333 | - absolute_width(w) then (Printable_tree)[" width=",w], | ||
| 1334 | - relative_width(r) then (Printable_tree)[" width=",percentage(r),""], | ||
| 1335 | - absolute_height(h) then (Printable_tree)[" height=",h], | ||
| 1336 | - relative_height(r) then (Printable_tree)[" height=",percentage(r),""], | ||
| 1337 | - columns(n) then (Printable_tree)[" colspan=",n], | ||
| 1338 | - rows(n) then (Printable_tree)[" rowspan=",n], | ||
| 1339 | - nowrap then (Printable_tree)[" nowrap"] | ||
| 1340 | - } | ||
| 1341 | - . format(others)] | ||
| 1342 | - }. | ||
| 1343 | - | ||
| 1344 | - | ||
| 1345 | - | ||
| 1346 | -public define Printable_tree | ||
| 1347 | - format | ||
| 1348 | - ( | ||
| 1349 | - String c_ticket, | ||
| 1350 | - String s_ticket, | ||
| 1351 | - List(Cell) l | ||
| 1352 | - ) = | ||
| 1353 | - if l is | ||
| 1354 | - { | ||
| 1355 | - [ ] then [ ], | ||
| 1356 | - [first . others] then | ||
| 1357 | - [if first is cell(options,item) then | ||
| 1358 | - ["<td",format(options),">", | ||
| 1359 | - format(c_ticket,s_ticket,item),"</td>"], | ||
| 1360 | - format(c_ticket,s_ticket,others)] | ||
| 1361 | - }. | ||
| 1362 | - | ||
| 1363 | - | ||
| 1364 | -public define Printable_tree | ||
| 1365 | - format | ||
| 1366 | - ( | ||
| 1367 | - String c_ticket, | ||
| 1368 | - String s_ticket, | ||
| 1369 | - List(Table_row) l | ||
| 1370 | - ) = | ||
| 1371 | - if l is | ||
| 1372 | - { | ||
| 1373 | - [ ] then [ ], | ||
| 1374 | - [first_row . other_rows] | ||
| 1375 | - then [if first_row is | ||
| 1376 | - { | ||
| 1377 | - row(options,cells) then | ||
| 1378 | - [ "<tr",format(options),">", | ||
| 1379 | - format(c_ticket,s_ticket,cells),"</tr>"] | ||
| 1380 | - }, | ||
| 1381 | - format(c_ticket,s_ticket,other_rows)] | ||
| 1382 | - }. | ||
| 1383 | - | ||
| 1384 | - | ||
| 1385 | -public define Printable_tree | ||
| 1386 | - format_choices | ||
| 1387 | - ( | ||
| 1388 | - List(String) l | ||
| 1389 | - ) = | ||
| 1390 | - if l is | ||
| 1391 | - { | ||
| 1392 | - [ ] then [ ], | ||
| 1393 | - [h . t] then ["<option>",h . format_choices(t)] | ||
| 1394 | - }. | ||
| 1395 | - | ||
| 1396 | - | ||
| 1397 | -public define Printable_tree | ||
| 1398 | - format_choices | ||
| 1399 | - ( | ||
| 1400 | - List(String) l, | ||
| 1401 | - String selected | ||
| 1402 | - ) = | ||
| 1403 | - if l is | ||
| 1404 | - { | ||
| 1405 | - [ ] then [ ], | ||
| 1406 | - [h . t] then if h = selected | ||
| 1407 | - then ["<option selected>",h . format_choices(t)] | ||
| 1408 | - else ["<option>",h . format_choices(t,selected)] | ||
| 1409 | - }. | ||
| 1410 | - | ||
| 1411 | - | ||
| 1412 | -public define Printable_tree | ||
| 1413 | - format_list | ||
| 1414 | - ( | ||
| 1415 | - String c_ticket, | ||
| 1416 | - String s_ticket, | ||
| 1417 | - List(Web_item) l | ||
| 1418 | - ) = | ||
| 1419 | - if l is | ||
| 1420 | - { | ||
| 1421 | - [ ] then [ ], | ||
| 1422 | - [h . t] then ["<li>",format(c_ticket,s_ticket,h), | ||
| 1423 | - format_list(c_ticket,s_ticket,t)] | ||
| 1424 | - }. | ||
| 1425 | - | ||
| 1426 | - | ||
| 1427 | -public define String | ||
| 1428 | - format | ||
| 1429 | - ( | ||
| 1430 | - WebStyle ws | ||
| 1431 | - ) = | ||
| 1432 | - if ws is | ||
| 1433 | - { | ||
| 1434 | - background_image(fn) then "background: url("+fn+")", | ||
| 1435 | - background_color(c) then "background: "+format(c), | ||
| 1436 | - background_transparent then "background: transparent", | ||
| 1437 | - background_repeat_horizontal then "background: repeat-x", | ||
| 1438 | - background_repeat_vertical then "background: repeat-y", | ||
| 1439 | - background_no_repeat then "background: no-repeat", | ||
| 1440 | - color(wc) then if wc is | ||
| 1441 | - { | ||
| 1442 | - rgb(r,g,b) then "color: rgb("+r+","+g+","+b+")", | ||
| 1443 | - _(c) then "color: "+format(c) | ||
| 1444 | - }, | ||
| 1445 | - float_to_left then "float: left", | ||
| 1446 | - float_to_right then "float: right", | ||
| 1447 | - font_family(n) then "font-family: "+n, | ||
| 1448 | - font_size(n) then "font-size: "+to_decimal(n)+"pt", | ||
| 1449 | - italic then "font-style: italic", | ||
| 1450 | - oblique then "font-style: oblique", | ||
| 1451 | - small_capitals then "font-variant: small-caps", | ||
| 1452 | - bold then "font-weight: bold", | ||
| 1453 | - bolder then "font-weight: bolder", | ||
| 1454 | - lighter then "font-weight: lighter", | ||
| 1455 | - line_height(h) then "line-height: "+to_decimal(h), | ||
| 1456 | - text_center then "text-align: center", | ||
| 1457 | - text_left then "text-align: left", | ||
| 1458 | - text_right then "text-align: right", | ||
| 1459 | - text_justify then "text-align: justify", | ||
| 1460 | - text_underline then "text-decoration: underline", | ||
| 1461 | - text_blink then "text-decoration: blink", | ||
| 1462 | - text_line_through then "text-decoration: line-through", | ||
| 1463 | - width(n) then "width: "+to_decimal(n), | ||
| 1464 | - }. | ||
| 1465 | - | ||
| 1466 | - | ||
| 1467 | -public define Printable_tree | ||
| 1468 | - format | ||
| 1469 | - ( | ||
| 1470 | - List(WebStyle) l | ||
| 1471 | - ) = | ||
| 1472 | - if l is | ||
| 1473 | - { | ||
| 1474 | - [ ] then [ ], | ||
| 1475 | - [h . t] then | ||
| 1476 | - if t is | ||
| 1477 | - { | ||
| 1478 | - [ ] then [format(h)], | ||
| 1479 | - [_ . _] then [format(h), "; " . format(t)] | ||
| 1480 | - } | ||
| 1481 | - }. | ||
| 1482 | - | ||
| 1483 | - | ||
| 1484 | -define Printable_tree | ||
| 1485 | - format_polygon_coordinates | ||
| 1486 | - ( | ||
| 1487 | - List((Int,Int)) vertices | ||
| 1488 | - ) = | ||
| 1489 | - if vertices is | ||
| 1490 | - { | ||
| 1491 | - [ ] then [ ], | ||
| 1492 | - [h . t] then | ||
| 1493 | - if h is (x,y) then | ||
| 1494 | - if t is [] | ||
| 1495 | - then [ x,",",y ] | ||
| 1496 | - else [ x,",",y,"," . format_polygon_coordinates(t)] | ||
| 1497 | - }. | ||
| 1498 | - | ||
| 1499 | - define Printable_tree | ||
| 1500 | - format | ||
| 1501 | - ( | ||
| 1502 | - List(Mouse_Sensitive_Zone) zones | ||
| 1503 | - ) = | ||
| 1504 | - if zones is | ||
| 1505 | - { | ||
| 1506 | - [ ] then [ ], | ||
| 1507 | - [h . t] then | ||
| 1508 | - [ | ||
| 1509 | - if h is | ||
| 1510 | - { | ||
| 1511 | - rectangle(lt,rb,url) then | ||
| 1512 | - if lt is (left,top) then | ||
| 1513 | - if rb is (right,bottom) then | ||
| 1514 | - [ "<area shape=rect coords=\"",left,",",top,",",right,",",bottom, | ||
| 1515 | - "\" href=\"",url,"\">" ], | ||
| 1516 | - circle(c,r,url) then | ||
| 1517 | - if c is (x,y) then | ||
| 1518 | - [ "<area shape=circle coords=\"",x,",",y,",",r, | ||
| 1519 | - "\" href=\"",url,"\">" ], | ||
| 1520 | - polygon(vs,url) then | ||
| 1521 | - [ "<area shape=poly coords=\"",format_polygon_coordinates(vs), | ||
| 1522 | - "\" href=\"",url,"\">" ] | ||
| 1523 | - } | ||
| 1524 | - . format(t)] | ||
| 1525 | - }. | ||
| 1526 | - | ||
| 1527 | -define Printable_tree | ||
| 1528 | - format | ||
| 1529 | - ( | ||
| 1530 | - List(Mouse_Sensitive_Zone) zones, | ||
| 1531 | - String c_ticket, | ||
| 1532 | - String s_ticket, | ||
| 1533 | - ) = | ||
| 1534 | - if zones is | ||
| 1535 | - { | ||
| 1536 | - [ ] then [ ], | ||
| 1537 | - [h . t] then | ||
| 1538 | - [ | ||
| 1539 | - if h is | ||
| 1540 | - { | ||
| 1541 | - rectangle(lt,rb,url) then | ||
| 1542 | - if lt is (left,top) then | ||
| 1543 | - if rb is (right,bottom) then | ||
| 1544 | - [ "<area shape=rect coords=\"",left,",",top,",",right,",",bottom, | ||
| 1545 | - "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ], | ||
| 1546 | - circle(c,r,url) then | ||
| 1547 | - if c is (x,y) then | ||
| 1548 | - [ "<area shape=circle coords=\"",x,",",y,",",r, | ||
| 1549 | - "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ], | ||
| 1550 | - polygon(vs,url) then | ||
| 1551 | - [ "<area shape=poly coords=\"",format_polygon_coordinates(vs), | ||
| 1552 | - "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ] | ||
| 1553 | - } | ||
| 1554 | - . format(t, c_ticket, s_ticket)] | ||
| 1555 | - }. | ||
| 1556 | - | ||
| 1557 | -variable Int map_number = 0. | ||
| 1558 | - | ||
| 1559 | -define Printable_tree | ||
| 1560 | - format_mouse_sensitive_image | ||
| 1561 | - ( | ||
| 1562 | - String image_file_name, | ||
| 1563 | - List(Mouse_Sensitive_Zone) zones, | ||
| 1564 | - String c_ticket, | ||
| 1565 | - String s_ticket, | ||
| 1566 | - ) = | ||
| 1567 | - map_number <- (*map_number)+1; | ||
| 1568 | - [ | ||
| 1569 | - "<img src=\"",image_file_name,"\" usemap=\"#imsensmap",*map_number,"\" border=0>", | ||
| 1570 | - "<map name=\"imsensmap",*map_number,"\">", | ||
| 1571 | - format(zones, c_ticket, s_ticket), | ||
| 1572 | - "</map>" | ||
| 1573 | - ]. | ||
| 1574 | - | ||
| 1575 | - | ||
| 1576 | - Find an 'upload' in a web item. | ||
| 1577 | - | ||
| 1578 | -define Bool | ||
| 1579 | - find_upload | ||
| 1580 | - ( | ||
| 1581 | - Web_item i | ||
| 1582 | - ). | ||
| 1583 | - | ||
| 1584 | -define Bool | ||
| 1585 | - find_upload | ||
| 1586 | - ( | ||
| 1587 | - List(Web_item) li | ||
| 1588 | - ) = | ||
| 1589 | - if li is | ||
| 1590 | - { | ||
| 1591 | - [ ] then false, | ||
| 1592 | - [h . t] then if find_upload(h) then true else find_upload(t) | ||
| 1593 | - }. | ||
| 1594 | - | ||
| 1595 | -define Bool | ||
| 1596 | - find_upload | ||
| 1597 | - ( | ||
| 1598 | - Cell c | ||
| 1599 | - ) = | ||
| 1600 | - if c is cell(lo,wi) then find_upload(wi). | ||
| 1601 | - | ||
| 1602 | -define Bool | ||
| 1603 | - find_upload | ||
| 1604 | - ( | ||
| 1605 | - List(Cell) lc | ||
| 1606 | - ) = | ||
| 1607 | - if lc is | ||
| 1608 | - { | ||
| 1609 | - [ ] then false, | ||
| 1610 | - [h . t] then if find_upload(h) then true else find_upload(t) | ||
| 1611 | - }. | ||
| 1612 | - | ||
| 1613 | - | ||
| 1614 | - | ||
| 1615 | -define Bool | ||
| 1616 | - find_upload | ||
| 1617 | - ( | ||
| 1618 | - Table_row tr | ||
| 1619 | - ) = | ||
| 1620 | - if tr is | ||
| 1621 | - { | ||
| 1622 | - row(lo,lc) then find_upload(lc) | ||
| 1623 | - }. | ||
| 1624 | - | ||
| 1625 | -define Bool | ||
| 1626 | - find_upload | ||
| 1627 | - ( | ||
| 1628 | - List(Table_row) l | ||
| 1629 | - ) = | ||
| 1630 | - if l is | ||
| 1631 | - { | ||
| 1632 | - [ ] then false, | ||
| 1633 | - [h . t] then | ||
| 1634 | - if find_upload(h) then true else find_upload(t) | ||
| 1635 | - }. | ||
| 1636 | - | ||
| 1637 | -define Bool | ||
| 1638 | - find_upload | ||
| 1639 | - ( | ||
| 1640 | - Web_item wi | ||
| 1641 | - ) = | ||
| 1642 | - if wi is | ||
| 1643 | - { | ||
| 1644 | - [ ] then (Bool)false, | ||
| 1645 | - [a . b] then (Bool)if find_upload(a) then true else find_upload(b), | ||
| 1646 | - text(_) then (Bool)false, | ||
| 1647 | - text_pt(_) then (Bool)false, | ||
| 1648 | - text_nowrap(_) then (Bool)false, | ||
| 1649 | - text_nowrap_pt(_) then (Bool)false, | ||
| 1650 | - par(_) then (Bool)false, | ||
| 1651 | - preformated_text(_) then (Bool)false, | ||
| 1652 | - integer(_) then (Bool)false, | ||
| 1653 | - float(_,_) then (Bool)false, | ||
| 1654 | - center(i) then (Bool)find_upload(i), | ||
| 1655 | - bigger(n,i) then (Bool)find_upload(i), | ||
| 1656 | - smaller(n,i) then (Bool)find_upload(i), | ||
| 1657 | - bold(i) then (Bool)find_upload(i), | ||
| 1658 | - italic(i) then (Bool)find_upload(i), | ||
| 1659 | - big(i) then (Bool)find_upload(i), | ||
| 1660 | - very_big(i) then (Bool)find_upload(i), | ||
| 1661 | - style(_,i) then (Bool)find_upload(i), | ||
| 1662 | - spacer(_,_) then (Bool)false, | ||
| 1663 | - image(_) then (Bool)false, | ||
| 1664 | - image_d(_,_) then (Bool)false, | ||
| 1665 | - image_pt(_) then (Bool)false, | ||
| 1666 | - on_image(_,_) then (Bool)false, | ||
| 1667 | - turning_images(_,_) then (Bool)false, | ||
| 1668 | - rollover(_,_,_,_,_,_) then (Bool)false, | ||
| 1669 | - rollover(_,_,_,_,_,_,_,_) then (Bool)false, | ||
| 1670 | - mouse_sensitive_image(_,_) then (Bool)false, | ||
| 1671 | - background_sound(_,_) then (Bool)false, | ||
| 1672 | - form(_,c) then (Bool)find_upload(c), | ||
| 1673 | - form_target(_,c,_) then (Bool)find_upload(c), | ||
| 1674 | - form(_,_,c) then (Bool)find_upload(c), | ||
| 1675 | - form_name(_,c) then (Bool)find_upload(c), | ||
| 1676 | - text_input(_,_,_) then (Bool)false, | ||
| 1677 | - password_input(_,_) then (Bool)false, | ||
| 1678 | - text_area(_,_,_,_) then (Bool)false, | ||
| 1679 | - upload(_,_) then (Bool)true, | ||
| 1680 | - submit(_) then (Bool)false, | ||
| 1681 | - submit_pt(_) then (Bool)false, | ||
| 1682 | - submit(_,_) then (Bool)false, | ||
| 1683 | - submit_close(_,_) then (Bool)false, | ||
| 1684 | - submit_pt2(_,_) then (Bool)false, | ||
| 1685 | - image_submit(_,_) then (Bool)false, | ||
| 1686 | - image_submit(_,_,_,_) then (Bool)false, | ||
| 1687 | - hl_image_submit(_,_,_,_,_) then (Bool)false, | ||
| 1688 | - text_submit(_,_,_) then (Bool)false, | ||
| 1689 | - web_submit(_,c) then (Bool)find_upload(c), | ||
| 1690 | - button(_,_,_,_,_) then (Bool)false, | ||
| 1691 | - mark(_,_) then (Bool)false, | ||
| 1692 | - mark_pt(_,_) then (Bool)false, | ||
| 1693 | - close_button then (Bool)false, | ||
| 1694 | - close_button(_) then (Bool)false, | ||
| 1695 | - label(_) then (Bool)false, | ||
| 1696 | - go_to_label(_,i) then (Bool)find_upload(i), | ||
| 1697 | - table(_,rows) then (Bool)find_upload(rows), | ||
| 1698 | - list(l) then (Bool)find_upload(l), | ||
| 1699 | - link(_,i) then (Bool)find_upload(i), | ||
| 1700 | - link(_,_,i) then (Bool)find_upload(i), | ||
| 1701 | - link_for_download(n,i) then (Bool)find_upload(i), | ||
| 1702 | - mail_to(_,i) then (Bool)find_upload(i), | ||
| 1703 | - select(_,_,_) then (Bool)false, | ||
| 1704 | - select(_,_,_,_) then (Bool)false, | ||
| 1705 | - immediate_select(_,_,_) then (Bool)false, | ||
| 1706 | - radio_button(_,_) then (Bool)false, | ||
| 1707 | - checked_radio_button(_,_) then (Bool)false, | ||
| 1708 | - check_box(_,_) then (Bool)false, | ||
| 1709 | - checked_box(_,_) then (Bool)false, | ||
| 1710 | - link_to_window(_,i) then (Bool)find_upload(i), | ||
| 1711 | - link_to_window(_,_,i) then (Bool)find_upload(i), | ||
| 1712 | - link_to_window_with_ticket(_,_,_,i,_,_) then (Bool)find_upload(i), | ||
| 1713 | - link_to_window_with_ticket_and_scroll(_,_,_,i,_,_) then (Bool)find_upload(i), | ||
| 1714 | - link_to_window_with_ticket_and_scroll(_,_,_,_,i,_,_) then (Bool)find_upload(i), | ||
| 1715 | - link_to_frame(_,_,i) then (Bool)find_upload(i), | ||
| 1716 | - }. | ||
| 1717 | - | ||
| 1718 | - | ||
| 1719 | - The next function generates "enctype=multipart/form-data" or "", depending on the presence of | ||
| 1720 | - an 'upload' in form-content. | ||
| 1721 | - | ||
| 1722 | -define String | ||
| 1723 | - enctype | ||
| 1724 | - ( | ||
| 1725 | - Web_item form_content | ||
| 1726 | - ) = | ||
| 1727 | - if find_upload(form_content) | ||
| 1728 | - then "enctype=multipart/form-data" | ||
| 1729 | - else "". | ||
| 1730 | - | ||
| 1731 | -define Printable_tree | ||
| 1732 | - set_turning_images_sources | ||
| 1733 | - ( | ||
| 1734 | - Int i, | ||
| 1735 | - String name, | ||
| 1736 | - List(String) filenames | ||
| 1737 | - ) = | ||
| 1738 | - if filenames is | ||
| 1739 | - { | ||
| 1740 | - [ ] then [ ], | ||
| 1741 | - [h . t] then | ||
| 1742 | - [" i",name,"[",i,"].src=\"",h,"\";" | ||
| 1743 | - . set_turning_images_sources(i+1,name,t)] | ||
| 1744 | - }. | ||
| 1745 | - | ||
| 1746 | -define Bool | ||
| 1747 | - member | ||
| 1748 | - ( | ||
| 1749 | - Word8 x, | ||
| 1750 | - Printable_tree t | ||
| 1751 | - ) = | ||
| 1752 | - if t is | ||
| 1753 | - { | ||
| 1754 | - [] then false, | ||
| 1755 | - str_pt(String _0,Printable_tree _1) then (member(x,_0) | member(x,_1)), | ||
| 1756 | - ba_pt(ByteArray _0,Printable_tree _1) then (member(x,to_string(_0)) | member(x,_1)), | ||
| 1757 | - int_pt(Int _0,Printable_tree _1) then (member(x,to_decimal(_0)) | member(x,_1)), | ||
| 1758 | - pt_pt(Printable_tree _0,Printable_tree _1) then (member(x,_0) | member(x,_1)) | ||
| 1759 | - }. | ||
| 1760 | - | ||
| 1761 | -public define Printable_tree | ||
| 1762 | - format | ||
| 1763 | - ( | ||
| 1764 | - String c_ticket, | ||
| 1765 | - String s_ticket, | ||
| 1766 | - Web_item wi | ||
| 1767 | - ) = | ||
| 1768 | - if wi is | ||
| 1769 | - { | ||
| 1770 | - [ ] then (Printable_tree)[ ], | ||
| 1771 | - | ||
| 1772 | - [a . b] then (Printable_tree)[format(c_ticket,s_ticket,a), " ", | ||
| 1773 | - format(c_ticket,s_ticket,b)], | ||
| 1774 | - | ||
| 1775 | - text(String s) then (Printable_tree)[s], | ||
| 1776 | - | ||
| 1777 | - text_pt(Printable_tree s) then (Printable_tree)s, | ||
| 1778 | - | ||
| 1779 | - text_nowrap(String s) then (Printable_tree)["<table><tr><td nowrap=\"nowrap>",s,"</td></tr></table>"], | ||
| 1780 | - | ||
| 1781 | - text_nowrap_pt(Printable_tree s) then | ||
| 1782 | - (Printable_tree)["<table><tr><td \"nowrap\">",s,"</td></tr></table>"], | ||
| 1783 | - | ||
| 1784 | - par(s) then (Printable_tree) | ||
| 1785 | - [ "<p align=\"justify\">", s, " </p>"], | ||
| 1786 | - | ||
| 1787 | - preformated_text(t) then (Printable_tree) ["<pre>",t,"</pre>"], | ||
| 1788 | - | ||
| 1789 | - integer(n) then (Printable_tree)[n], | ||
| 1790 | - | ||
| 1791 | - float(f,p) then (Printable_tree)[float_to_string(f,p)], | ||
| 1792 | - | ||
| 1793 | - center(item) then (Printable_tree)["<center>", format(c_ticket,s_ticket,item),"</center>"], | ||
| 1794 | - | ||
| 1795 | - bigger(n,item) then (Printable_tree)["<font size=\"+",n,"\">",format(c_ticket,s_ticket,item),"</font>"], | ||
| 1796 | - | ||
| 1797 | - smaller(n,item) then (Printable_tree)["<font size=\"-",n,"\">",format(c_ticket,s_ticket,item),"</font>"], | ||
| 1798 | - | ||
| 1799 | - bold(item) then | ||
| 1800 | - (Printable_tree)["<font style=\"font-weight: bold\">",format(c_ticket,s_ticket,item),"</font>"], | ||
| 1801 | - | ||
| 1802 | - italic(item) then | ||
| 1803 | - (Printable_tree)["<font style=\"font-style: italic\">",format(c_ticket,s_ticket,item),"</font>"], | ||
| 1804 | - | ||
| 1805 | - big(item) then (Printable_tree)["<font size=\"+1\">",format(c_ticket,s_ticket,item),"</font>"], | ||
| 1806 | - | ||
| 1807 | - very_big(item) then (Printable_tree)["<h1>",format(c_ticket,s_ticket,item),"</h1>"], | ||
| 1808 | - | ||
| 1809 | - style(l,i) then | ||
| 1810 | - (Printable_tree)["<span style=\"", format(l), "\">", format(c_ticket,s_ticket,i), "</span>"], | ||
| 1811 | - | ||
| 1812 | - spacer(w,h) then (Printable_tree) | ||
| 1813 | - ["<img src=\"spacer.gif\" width=\"",w,"\" height=\"",h,"\" border=\"0\">"], | ||
| 1814 | - | ||
| 1815 | - image(String f) then (Printable_tree)["<img src=\"", f,"\" border=\"0\">"], | ||
| 1816 | - | ||
| 1817 | - image_d(fn,desc) then (Printable_tree)["<img src=\"", fn,"\" alt=\"",desc,"\" border=\"0\">"], | ||
| 1818 | - | ||
| 1819 | - image_pt(Printable_tree l) then (Printable_tree)["<img src=\"", l,"\" border=\"0\">"], | ||
| 1820 | - | ||
| 1821 | - on_image(fn,x) then (Printable_tree) | ||
| 1822 | - ["<span style=\"background: url(",fn,")\">",format(c_ticket,s_ticket,x),"</span>"], | ||
| 1823 | - | ||
| 1824 | - turning_images(fns,msec) then if fns is [im0 . imo] then | ||
| 1825 | - with name = "trni"+to_decimal(new_web_count), n = 1+length(imo), (Printable_tree) | ||
| 1826 | - ["<script>", | ||
| 1827 | - "var i",name,"=new Array(",n,");", | ||
| 1828 | - "var n",name,"=0;", | ||
| 1829 | - "for(var i=0; i<",n,"; i++) {", | ||
| 1830 | - " i",name,"[i]=new Image(); }", | ||
| 1831 | - set_turning_images_sources(0,name,(List(String))[im0 . imo]), | ||
| 1832 | - | ||
| 1833 | - "function a",name,"() {", | ||
| 1834 | - "if (i",name,"[(n",name,"+1)%",n,"].complete)", | ||
| 1835 | - "{n",name,"=(n",name,"+1)%",n,";", | ||
| 1836 | - "document.",name,".src=i",name,"[n",name,"].src; }", | ||
| 1837 | - "setTimeout(\"a",name,"()\",",msec,"); }", | ||
| 1838 | - | ||
| 1839 | - "setTimeout(\"a",name,"()\",",msec,");", | ||
| 1840 | - "</script>", | ||
| 1841 | - "<img src=\"",im0,"\" name=\"",name,"\" border=\"0\">"], | ||
| 1842 | - | ||
| 1843 | - rollover(prlim,url,target,ion,ioff,descr) then (Printable_tree) | ||
| 1844 | - (images_to_load <- [simple(ion) . *images_to_load]; | ||
| 1845 | - with name = "ron_"+to_decimal(new_web_count), | ||
| 1846 | - ["<a target=\"",target,"\" href=\"",url, | ||
| 1847 | - (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',url) then "&" else "?")), | ||
| 1848 | - (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]), | ||
| 1849 | - (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]), | ||
| 1850 | - "\" onmouseout=\"",name,".src='",ioff, | ||
| 1851 | - "';\" onmouseover=\"",name,".src='",ion,"';\"><img src=\"",ioff, | ||
| 1852 | - "\" name=\"",name,"\" alt=\"",descr,"\" border=\"0\"></a>"]), | ||
| 1853 | - | ||
| 1854 | - rollover(prlim,url,target,ion,ioff,w,h,descr) then (Printable_tree) | ||
| 1855 | - (images_to_load <- [simple(ion) . *images_to_load]; | ||
| 1856 | - with name = "ron_"+to_decimal(new_web_count), | ||
| 1857 | - ["<a target=\"",target,"\" href=\"",url, | ||
| 1858 | - (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',url) then "&" else "?")), | ||
| 1859 | - (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]), | ||
| 1860 | - (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]), | ||
| 1861 | - "\" onmouseout=\"",name,".src='",ioff, | ||
| 1862 | - "';\" onmouseover=\"",name,".src='",ion,"';\"><img src=\"",ioff, | ||
| 1863 | - "\" name=\"",name,"\" width=\"",w,"\" height=\"",h,"\" alt=\"",descr,"\" border=\"0\"></a>"]), | ||
| 1864 | - | ||
| 1865 | - mouse_sensitive_image(fn,lz) then (Printable_tree) | ||
| 1866 | - format_mouse_sensitive_image(fn,lz, c_ticket, s_ticket), | ||
| 1867 | - | ||
| 1868 | - background_sound(sfn,loop) then (Printable_tree) | ||
| 1869 | - ["<embed src=\"", sfn, "\" autostart=\"true\" loop=\"", if loop then "true\">" else "false\">"], | ||
| 1870 | - | ||
| 1871 | - form(n,c) then (Printable_tree) | ||
| 1872 | - ["<form ",enctype(c)," method=\"post\" action=\"", n, "\">", | ||
| 1873 | - "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />", | ||
| 1874 | - "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />", | ||
| 1875 | - format(c_ticket,s_ticket,c),"</form>"], | ||
| 1876 | - | ||
| 1877 | - form_target(n,c,t) then (Printable_tree) | ||
| 1878 | - ["<form ",enctype(c)," method=\"post\" action=\"", n, "\" target=\"", t, "\">", | ||
| 1879 | - "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />", | ||
| 1880 | - "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />", | ||
| 1881 | - format(c_ticket,s_ticket,c),"</form>"], | ||
| 1882 | - | ||
| 1883 | - form(n,l,c) then (Printable_tree) | ||
| 1884 | - ["<form ",enctype(c)," method=\"post\" action=\"", n,"#", l, "\">", | ||
| 1885 | - "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />", | ||
| 1886 | - "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />", | ||
| 1887 | - format(c_ticket,s_ticket,c),"</form>"], | ||
| 1888 | - | ||
| 1889 | - form_name(fn,c) then (Printable_tree) | ||
| 1890 | - [ | ||
| 1891 | - // "<form ",enctype(c), "\" name=\"", fn, "\">", | ||
| 1892 | - "<form name=\"", fn, "\">", | ||
| 1893 | - "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />", | ||
| 1894 | - "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />", | ||
| 1895 | - format(c_ticket,s_ticket,c),"</form>"], | ||
| 1896 | - | ||
| 1897 | - text_input(n,s,v) then (Printable_tree) | ||
| 1898 | - [" <input type=\"text\" name=\"", n, "\" size=\"", s, "\" value=\"", v,"\" />"], | ||
| 1899 | - | ||
| 1900 | - password_input(n,s) then (Printable_tree) | ||
| 1901 | - [" <input type=\"password\" name=\"", n, "\" size=\"", s,"\" />"], | ||
| 1902 | - | ||
| 1903 | - text_area(name,c,r,i) then (Printable_tree) | ||
| 1904 | - ["<textarea name=\"",name,"\" cols=\"",c,"\" rows=\"",r,"\" wrap=\"physical\">",i,"</textarea>"], | ||
| 1905 | - | ||
| 1906 | - upload(n,size) then (Printable_tree) | ||
| 1907 | - ["<input type=\"file\" size=\"",size,"\" multiple=\"multiple\" name=\"",n,"\" />"], | ||
| 1908 | - | ||
| 1909 | - submit(String t) then (Printable_tree)["<input type=\"submit\" value=\"",t,"\" />"], | ||
| 1910 | - | ||
| 1911 | - submit_pt(Printable_tree t) then (Printable_tree)["<input type=\"submit\" value=\"",t,"\" />"], | ||
| 1912 | - | ||
| 1913 | - submit(n, String t) then (Printable_tree) | ||
| 1914 | - ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\">"], | ||
| 1915 | - | ||
| 1916 | - submit_close(n, String t) then (Printable_tree) | ||
| 1917 | - ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\" onclick=\"window.top.close();\" />"], | ||
| 1918 | - | ||
| 1919 | - submit_pt2(n, Printable_tree t) then (Printable_tree) | ||
| 1920 | - ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\" />"], | ||
| 1921 | - | ||
| 1922 | - image_submit(n,ifn) then (Printable_tree) | ||
| 1923 | - ["<input type=\"image\" name=\"",n,"\" src=\"",ifn,"\" border=\"0\" />"], | ||
| 1924 | - | ||
| 1925 | - image_submit(n,v,ifn,c) then (Printable_tree) | ||
| 1926 | - ["<img src=\"",ifn,"\" onmousedown=\"document.forms[0].action='", | ||
| 1927 | - n,"=",v,"'; document.forms[0].submit();\" />"], | ||
| 1928 | - | ||
| 1929 | - hl_image_submit(n,v,in,ifn,hlifn) then (Printable_tree) | ||
| 1930 | - ["<img src=\"",ifn,"\"", | ||
| 1931 | - //" name=\"",in,"\"", | ||
| 1932 | - " onmouseover=\"this.src='",hlifn,"'\"", | ||
| 1933 | - " onmouseout=\"this.src='",ifn,"'\"", | ||
| 1934 | - " onmousedown=\"document.forms[0].action='", | ||
| 1935 | - n,"=",v,"'; document.forms[0].submit();\" />"], | ||
| 1936 | - | ||
| 1937 | - text_submit(n,v,t) then (Printable_tree) | ||
| 1938 | - ["<a href=\"",n, | ||
| 1939 | - (if (s_ticket = "" & c_ticket = "" & v = "") then "" else "?"), | ||
| 1940 | - (if s_ticket = "" then [ ] else ["s_ticket=",s_ticket,"&"]), | ||
| 1941 | - (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]), | ||
| 1942 | - v,"\">",t,"</a>"], | ||
| 1943 | - | ||
| 1944 | - | ||
| 1945 | - web_submit(wa,i) then (Printable_tree) | ||
| 1946 | - ["<a href=\"javascript:document.forms[0].action='", | ||
| 1947 | - wa,"'; document.forms[0].submit();\">",format(c_ticket,s_ticket,i),"</a>"], | ||
| 1948 | - | ||
| 1949 | - button(n, String t, String o, Int w, Int h) then (Printable_tree) | ||
| 1950 | - ["<input type=button name=",n," value=\"",t, | ||
| 1951 | - "\"style=\"width=",w, ";height=", h, "\" ", "\" onclick=\"", o, "\";\" />"], | ||
| 1952 | - | ||
| 1953 | - mark(n, String v) then (Printable_tree) | ||
| 1954 | - ["<input type=\"hidden\" name=\"",n,"\" value=\"",v,"\" />"], | ||
| 1955 | - | ||
| 1956 | - mark_pt(n, Printable_tree v) then (Printable_tree) | ||
| 1957 | - ["<input type=\"hidden\" name=\"",n,"\" value=\"",v,"\" />"], | ||
| 1958 | - | ||
| 1959 | - close_button then (Printable_tree) | ||
| 1960 | - ["<form><input type=\"button\" value=\" Fermer \" onclick=\"window.top.close();\"></form>"], | ||
| 1961 | - | ||
| 1962 | - close_button(ifn) then (Printable_tree) | ||
| 1963 | - ["<form><input type=\"image\" name=\"close\" src=\"", ifn, | ||
| 1964 | - "\" onclick=\"window.top.close();\" /></form>"], | ||
| 1965 | - | ||
| 1966 | -/* | ||
| 1967 | - close_button(ifn) then (Printable_tree) | ||
| 1968 | - ["<form><input type=\"button\" name=\"close\" src=\"", ifn, | ||
| 1969 | - "\" onclick=\"window.top.close();\"></form>"], | ||
| 1970 | -*/ | ||
| 1971 | - label(name) then (Printable_tree)["<a name=\"",name,"\" />"], | ||
| 1972 | - | ||
| 1973 | - go_to_label(name,content) then (Printable_tree)["<a href=#",name,">", | ||
| 1974 | - format(c_ticket,s_ticket,content),"</a>"], | ||
| 1975 | - | ||
| 1976 | - table(ops,rows) then (Printable_tree)["<table ", | ||
| 1977 | - format(ops), ">",format(c_ticket,s_ticket,rows),"</table>"], | ||
| 1978 | - | ||
| 1979 | - list(l) then (Printable_tree)["<ul>",format_list(c_ticket,s_ticket,l),"</ul>"], | ||
| 1980 | - | ||
| 1981 | - link(name,i) then (Printable_tree)["<a href=\"",name, | ||
| 1982 | - (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',name) then "&" else "?")), | ||
| 1983 | - (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]), | ||
| 1984 | - (if s_ticket = "" then [ ] else [if c_ticket = "" then "" else "&","s_ticket=",s_ticket]), | ||
| 1985 | - "\">",format(c_ticket,s_ticket,i),"</a>"], | ||
| 1986 | - | ||
| 1987 | - link(name,target,i) then (Printable_tree)["<a target=\"",target,"\" href=\"",name, | ||
| 1988 | - (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',name) then "&" else "?")), | ||
| 1989 | - (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]), | ||
| 1990 | - (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]), | ||
| 1991 | - "\">",format(c_ticket,s_ticket,i),"</a>"], | ||
| 1992 | - | ||
| 1993 | - link_for_download(fname,i) then (Printable_tree) | ||
| 1994 | - ["<a href=\"",fname,"?download\">",format(c_ticket,s_ticket,i),"</a>"], | ||
| 1995 | - | ||
| 1996 | - mail_to(addr,i) then (Printable_tree)["<a href=\"mailto:",addr,"\">", | ||
| 1997 | - format(c_ticket,s_ticket,i),"</a>"], | ||
| 1998 | - | ||
| 1999 | - select(name,size,choices) then (Printable_tree) | ||
| 2000 | - ["<select name=\"",name,"\" size=\"",size,"\">",format_choices(choices),"</select>" ], | ||
| 2001 | - | ||
| 2002 | - select(name,size,choices,selected) then (Printable_tree) | ||
| 2003 | - ["<select name=\"",name,"\" size=\"",size,"\">",format_choices(choices,selected),"</select>" ], | ||
| 2004 | - | ||
| 2005 | - immediate_select(name,size,choices) then (Printable_tree) | ||
| 2006 | - ["<select name=\"",name,"\" size=\"",size,"\" onchange=\"submit();\">", | ||
| 2007 | - format_choices(choices),"</select>" ], | ||
| 2008 | - | ||
| 2009 | - radio_button(n,v) then (Printable_tree) | ||
| 2010 | - ["<input type=\"radio\" name=\"", n, "\" value=\"", v, "\" />"], | ||
| 2011 | - | ||
| 2012 | - checked_radio_button(n,v) then (Printable_tree) | ||
| 2013 | - ["<input type=\"radio\" checked=\"checked\" name=\"", n, "\" value=\"", v, "\" />"], | ||
| 2014 | - | ||
| 2015 | - check_box(n,v) then (Printable_tree) | ||
| 2016 | - ["<input type=\"checkbox\" name=\"", n, "\" value=\"", v, "\" />"], | ||
| 2017 | - | ||
| 2018 | - checked_box(n,v) then (Printable_tree) | ||
| 2019 | - ["<input type=\"checkbox\" checked=\"checked\" name=\"", n, "\" value=\"", v, "\" />"], | ||
| 2020 | - | ||
| 2021 | - link_to_window(n,i) then (Printable_tree) | ||
| 2022 | - ["<a href=\"javascript:void window.open('",n,"','default','resizable,scrollbars');\">", | ||
| 2023 | - format(c_ticket,s_ticket,i),"</a>"], | ||
| 2024 | - | ||
| 2025 | - link_to_window(n,wn,i) then (Printable_tree) | ||
| 2026 | - ["<a href=\"javascript:void window.open('",n,"','",wn,"','resizable,scrollbars');\" />", | ||
| 2027 | - format(c_ticket,s_ticket,i),"</a>"], | ||
| 2028 | - | ||
| 2029 | - link_to_window_with_ticket(n,args,wn,i,w,h) then (Printable_tree) | ||
| 2030 | - ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket, | ||
| 2031 | - (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]), | ||
| 2032 | - "&target=",wn, | ||
| 2033 | - if args="" then "" else "&", | ||
| 2034 | - args,"','", | ||
| 2035 | - wn,"','width=",w,",height=",h,"');\">", | ||
| 2036 | - format(c_ticket,s_ticket,i),"</a>"], | ||
| 2037 | - | ||
| 2038 | - link_to_window_with_ticket_and_scroll(n,args,wn,i,w,h) then (Printable_tree) | ||
| 2039 | - ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket, | ||
| 2040 | - (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]), | ||
| 2041 | - "&target=",wn, | ||
| 2042 | - if args="" then "" else "&", | ||
| 2043 | - args,"','", | ||
| 2044 | - wn,"','width=",w,",height=",h,", resizable,scrollbars');\">", | ||
| 2045 | - format(c_ticket,s_ticket,i),"</a>"], | ||
| 2046 | - | ||
| 2047 | - link_to_window_with_ticket_and_scroll(n,lab,args,wn,i,w,h) then (Printable_tree) | ||
| 2048 | - ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket, | ||
| 2049 | - (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]), | ||
| 2050 | - "&target=",wn, | ||
| 2051 | - if args="" then "" else "&", | ||
| 2052 | - args,"&#",lab, "','", | ||
| 2053 | - wn,"','width=",w,",height=",h,", resizable,scrollbars');\">", | ||
| 2054 | - format(c_ticket,s_ticket,i),"</a>"], | ||
| 2055 | - | ||
| 2056 | - link_to_frame(n,fn,i) then ["<a href=\"",n, | ||
| 2057 | - (if member('?',n) then "&" else "?"), | ||
| 2058 | - (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]), | ||
| 2059 | - (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]), | ||
| 2060 | - "\" target=\"",fn,"\">", | ||
| 2061 | - format(c_ticket,s_ticket,i),"</a>"] | ||
| 2062 | - | ||
| 2063 | - }. | ||
| 2064 | - | ||
| 2065 | - | ||
| 2066 | - | ||
| 2067 | -define Printable_tree | ||
| 2068 | - add_tickets | ||
| 2069 | - ( | ||
| 2070 | - String c_ticket, | ||
| 2071 | - String s_ticket, | ||
| 2072 | - String url | ||
| 2073 | - ) = | ||
| 2074 | - if member('?',url) | ||
| 2075 | - then [url , "&c_ticket=", c_ticket, "&s_ticket=", s_ticket ] | ||
| 2076 | - else [url , "?c_ticket=", c_ticket, "&s_ticket=", s_ticket ]. | ||
| 2077 | - | ||
| 2078 | -define Printable_tree | ||
| 2079 | - add_tickets | ||
| 2080 | - ( | ||
| 2081 | - String c_ticket, | ||
| 2082 | - String s_ticket, | ||
| 2083 | - Printable_tree url | ||
| 2084 | - ) = | ||
| 2085 | - if member('?',url) | ||
| 2086 | - then [url , "&c_ticket=", c_ticket, "&s_ticket=", s_ticket ] | ||
| 2087 | - else [url , "?c_ticket=", c_ticket, "&s_ticket=", s_ticket ]. | ||
| 2088 | - | ||
| 2089 | - | ||
| 2090 | -define Printable_tree | ||
| 2091 | - format | ||
| 2092 | - ( | ||
| 2093 | - List(VFrame) frames, | ||
| 2094 | - String c_ticket, | ||
| 2095 | - String s_ticket | ||
| 2096 | - ) = | ||
| 2097 | - if frames is | ||
| 2098 | - { | ||
| 2099 | - [ ] then [ ], | ||
| 2100 | - [h . t] then | ||
| 2101 | - if h is frame(height,url,name) then | ||
| 2102 | - [ | ||
| 2103 | - "<frame src=\"",add_tickets(c_ticket,s_ticket,url), "\" name=\"",name,"\" frameborder=\"no\" />" | ||
| 2104 | - . format(t,c_ticket,s_ticket)] | ||
| 2105 | - }. | ||
| 2106 | - | ||
| 2107 | - | ||
| 2108 | -define String | ||
| 2109 | - frame_size | ||
| 2110 | - ( | ||
| 2111 | - Int s | ||
| 2112 | - ) = | ||
| 2113 | - if s =< 0 then "*" else to_decimal(s). | ||
| 2114 | - | ||
| 2115 | -define String | ||
| 2116 | - frame_stack_rows | ||
| 2117 | - ( | ||
| 2118 | - List(VFrame) frames | ||
| 2119 | - ) = | ||
| 2120 | - if frames is | ||
| 2121 | - { | ||
| 2122 | - [ ] then "", | ||
| 2123 | - [h . t] then if h is frame (height,url,name) then | ||
| 2124 | - frame_size(height)+ | ||
| 2125 | - if t is | ||
| 2126 | - { | ||
| 2127 | - [ ] then "", | ||
| 2128 | - [_ . _] then "," | ||
| 2129 | - }+frame_stack_rows(t) | ||
| 2130 | - }. | ||
| 2131 | - | ||
| 2132 | - | ||
| 2133 | - | ||
| 2134 | - 'crlf' is defined in 'basis.anubis'. | ||
| 2135 | - | ||
| 2136 | - | ||
| 2137 | - | ||
| 2138 | -define Printable_tree | ||
| 2139 | - standard_headers | ||
| 2140 | - ( | ||
| 2141 | - Int size | ||
| 2142 | - ) = | ||
| 2143 | - [ | ||
| 2144 | - "HTTP/1.0 200 OK" + crlf + | ||
| 2145 | - "Server: Anubis" + crlf + | ||
| 2146 | - "Content-Type: text/html" + crlf + | ||
| 2147 | - "Content-Length: "+to_decimal(size)+crlf+ | ||
| 2148 | - crlf | ||
| 2149 | - ]. | ||
| 2150 | - | ||
| 2151 | - define Printable_tree | ||
| 2152 | - download_headers | ||
| 2153 | - = | ||
| 2154 | - [ | ||
| 2155 | - "HTTP/1.0 200 OK" + crlf + | ||
| 2156 | - "Content-Type: application/octet-stream" + crlf + | ||
| 2157 | - crlf | ||
| 2158 | - ]. | ||
| 2159 | - | ||
| 2160 | -define Printable_tree | ||
| 2161 | - apache_headers | ||
| 2162 | - = | ||
| 2163 | - [ | ||
| 2164 | - "Content-type: text/html" + crlf + | ||
| 2165 | - crlf | ||
| 2166 | - ]. | ||
| 2167 | - | ||
| 2168 | - | ||
| 2169 | -define String | ||
| 2170 | - empty_javascript_source | ||
| 2171 | - = | ||
| 2172 | - "javascript:'<html><head></head><body></body></html>';". | ||
| 2173 | - | ||
| 2174 | -public type HeaderSort: | ||
| 2175 | - empty, | ||
| 2176 | - anubis, | ||
| 2177 | - apache. | ||
| 2178 | - | ||
| 2179 | - | ||
| 2180 | -define Printable_tree | ||
| 2181 | - format_keywords | ||
| 2182 | - ( | ||
| 2183 | - List(String) l | ||
| 2184 | - ) = | ||
| 2185 | - if l is | ||
| 2186 | - { | ||
| 2187 | - [ ] then [ ], | ||
| 2188 | - [h . t] then if t is [ ] | ||
| 2189 | - then [h] | ||
| 2190 | - else [h , ", " . format_keywords(t)] | ||
| 2191 | - }. | ||
| 2192 | - | ||
| 2193 | -define Printable_tree | ||
| 2194 | - format | ||
| 2195 | - ( | ||
| 2196 | - WebMeta m | ||
| 2197 | - ) = | ||
| 2198 | - if m is | ||
| 2199 | - { | ||
| 2200 | - keywords(l) then ["<meta name=\"keywords\" content=\"",format_keywords(l),"\">"], | ||
| 2201 | - refresh(url,delay) then ["<meta http-equiv=\"Refresh\" content=\"",delay,"; URL=",url,"\">"], | ||
| 2202 | - meta(n,c) then ["<meta name=\"",n,"\" content=\"",c,"\">"], | ||
| 2203 | - http_equiv(n,c) then ["<meta http-equiv=\"",n,"\" content=\"",c,"\">"] | ||
| 2204 | - }. | ||
| 2205 | - | ||
| 2206 | -define Printable_tree | ||
| 2207 | - format | ||
| 2208 | - ( | ||
| 2209 | - List(WebMeta) metas | ||
| 2210 | - ) = | ||
| 2211 | - if metas is | ||
| 2212 | - { | ||
| 2213 | - [ ] then [ ], | ||
| 2214 | - [h . t] then [format(h) . format(t)] | ||
| 2215 | - }. | ||
| 2216 | - | ||
| 2217 | - | ||
| 2218 | - | ||
| 2219 | - | ||
| 2220 | - | ||
| 2221 | - | ||
| 2222 | -public define Printable_tree | ||
| 2223 | - format | ||
| 2224 | - ( | ||
| 2225 | - HeaderSort hs, | ||
| 2226 | - String c_ticket, | ||
| 2227 | - String s_ticket, | ||
| 2228 | - Web_page p | ||
| 2229 | - ) = | ||
| 2230 | - if p is | ||
| 2231 | - { | ||
| 2232 | - web_page(title,metas,head_scripts,body) then | ||
| 2233 | - with fullpage = | ||
| 2234 | - [ | ||
| 2235 | - "<html>", | ||
| 2236 | - "<head>", | ||
| 2237 | - "<title>", title, "</title>", | ||
| 2238 | - format(metas), | ||
| 2239 | - head_scripts, | ||
| 2240 | - "</head>", | ||
| 2241 | - "<body ", | ||
| 2242 | - if body is body(options,item) then | ||
| 2243 | - with b_options = format(prepare(options)), | ||
| 2244 | - [b_options, " onload='body_onloads();", | ||
| 2245 | - if *images_to_load is [] then "" else " preload_images();", | ||
| 2246 | - "'>", | ||
| 2247 | - load_image_script(*images_to_load), | ||
| 2248 | - reverse(*scripts), | ||
| 2249 | - "<script>", | ||
| 2250 | - " function body_onloads() {", | ||
| 2251 | - format(*body_onloads), | ||
| 2252 | - "}</script>", | ||
| 2253 | - format(c_ticket,s_ticket,item) | ||
| 2254 | - ], | ||
| 2255 | - "</body>", | ||
| 2256 | - "</html>" | ||
| 2257 | - ], | ||
| 2258 | - [ | ||
| 2259 | - if hs is | ||
| 2260 | - { | ||
| 2261 | - empty then [ ], | ||
| 2262 | - anubis then standard_headers(length(fullpage)), | ||
| 2263 | - apache then apache_headers | ||
| 2264 | - } | ||
| 2265 | - . fullpage | ||
| 2266 | - ], | ||
| 2267 | - standard_frameset(title,metas,height,width,main) then | ||
| 2268 | - with body = | ||
| 2269 | - [ | ||
| 2270 | - "<html>", | ||
| 2271 | - "<head>", | ||
| 2272 | - "<title>", title, "</title>", | ||
| 2273 | - format(metas), | ||
| 2274 | - "</head>", | ||
| 2275 | - "<frameset frameborder=\"no\" border=\"0\" framespacing=\"0\"", | ||
| 2276 | - " marginwidth=\"0\" marginheight=\"0\" cols=\"",width,",*\" rows=\"*\">", | ||
| 2277 | - " <frame src=\"",empty_javascript_source,"\" name=\"left\" frameborder=\"no\"", | ||
| 2278 | - " marginwidth=\"0\" marginheight=\"0\" scrolling=\"no\">", | ||
| 2279 | - " <frameset frameborder=\"no\" border=\"0\" framespacing=\"0\" rows=\"",height,",*\" cols=\"*\">", | ||
| 2280 | - " <frame src=\"",empty_javascript_source,"\" name=\"top\"", | ||
| 2281 | - " marginwidth=\"0\" marginheight=\"0\" frameborder=\"no\" scrolling=\"no\">", | ||
| 2282 | - " <frame src =\"", add_tickets(c_ticket,s_ticket,main), | ||
| 2283 | - "\" name=\"main\" marginwidth=\"0\" marginheight=\"0\" frameborder=\"no\">", | ||
| 2284 | - " </frameset>", | ||
| 2285 | - "</frameset>", | ||
| 2286 | - "</html>" | ||
| 2287 | - ], | ||
| 2288 | - [ | ||
| 2289 | - if hs is | ||
| 2290 | - { | ||
| 2291 | - empty then [ ], | ||
| 2292 | - anubis then standard_headers(length(body)), | ||
| 2293 | - apache then apache_headers | ||
| 2294 | - } | ||
| 2295 | - . body | ||
| 2296 | - ] | ||
| 2297 | - }. | ||
| 2298 | - | ||
| 2299 | - | ||
| 2300 | -public define Bool | ||
| 2301 | |||
| 2302 | - ( | ||
| 2303 | - String c_ticket, | ||
| 2304 | - String s_ticket, | ||
| 2305 | - Web_page p | ||
| 2306 | - ) = | ||
| 2307 | - print(format(anubis,c_ticket,s_ticket,p)). | ||
| 2308 | - | ||
| 2309 | -public define Bool | ||
| 2310 | - print_with_headers | ||
| 2311 | - ( | ||
| 2312 | - HeaderSort hs, | ||
| 2313 | - String c_ticket, | ||
| 2314 | - String s_ticket, | ||
| 2315 | - Web_page p | ||
| 2316 | - ) = | ||
| 2317 | - print(format(hs,c_ticket,s_ticket,p)). | ||
| 2318 | - | ||
| 2319 | -public define Bool | ||
| 2320 | |||
| 2321 | - ( | ||
| 2322 | - Web_page p | ||
| 2323 | - ) = | ||
| 2324 | - print(format(anubis,"","",p)). | ||
| 2325 | - | ||
| 2326 | - | ||
| 2327 | - | ||
| 2328 | - | ||
| 2329 | -public define Bool | ||
| 2330 | - print_with_headers | ||
| 2331 | - ( | ||
| 2332 | - HeaderSort hs, | ||
| 2333 | - Web_page p | ||
| 2334 | - ) = | ||
| 2335 | - print(format(hs,"","",p)). | ||
| 2336 | - | ||
| 2337 | - | ||
| 2338 | -public define Cell | ||
| 2339 | - h_spacer | ||
| 2340 | - ( | ||
| 2341 | - Int n | ||
| 2342 | - ) = | ||
| 2343 | - cell([absolute_width(n)],text(" ")). | ||
| 2344 | - | ||
| 2345 | -public define Cell | ||
| 2346 | - v_spacer | ||
| 2347 | - ( | ||
| 2348 | - Int n | ||
| 2349 | - ) = | ||
| 2350 | - cell([absolute_height(n)],text(" ")). | ||
| 2351 | - | ||
| 2352 | -public define Cell | ||
| 2353 | - empty = cell([],text(" ")). | ||
| 2354 | - | ||
| 2355 | - | ||
| 2356 | - | ||
| 2357 | - *** Below is a simple gadget for counting visitors. It increments a counter (in a file) | ||
| 2358 | - at each call. The argument is the name of the file (relative to the directory of the | ||
| 2359 | - server), and the file is created automatically. It returns the number of the visitor. | ||
| 2360 | - | ||
| 2361 | -public define Int | ||
| 2362 | - get_visitor_number | ||
| 2363 | - ( | ||
| 2364 | - String counter_file_name, | ||
| 2365 | - ) = | ||
| 2366 | - protect | ||
| 2367 | - if (RetrieveResult(Int))retrieve(counter_file_name) is | ||
| 2368 | - { | ||
| 2369 | - cannot_find_file then | ||
| 2370 | - // | ||
| 2371 | - // It's time to create the file. | ||
| 2372 | - // | ||
| 2373 | - if save((Int)1,counter_file_name) is | ||
| 2374 | - { | ||
| 2375 | - cannot_open_file then 0, | ||
| 2376 | - write_error then 0, | ||
| 2377 | - ok then 1 | ||
| 2378 | - }, | ||
| 2379 | - read_error then 0, | ||
| 2380 | - type_error then 0, | ||
| 2381 | - ok(n) then | ||
| 2382 | - // | ||
| 2383 | - // Increment the counter | ||
| 2384 | - // | ||
| 2385 | - if save(n+1,counter_file_name) is | ||
| 2386 | - { | ||
| 2387 | - cannot_open_file then n, | ||
| 2388 | - write_error then n, | ||
| 2389 | - ok then n+1 | ||
| 2390 | - } | ||
| 2391 | - }. | ||
| 2392 | - | ||
| 2393 | - | ||
| 2394 | - | ||
| 2395 | - |
web/CXM_multihost_http_server.anubis
| 1 | - | ||
| 2 | - *Project* The Anubis Project | ||
| 3 | - | ||
| 4 | - *Title* A Multi Host HTTP/HTTPS Server | ||
| 5 | - | ||
| 6 | - *Copyright* Copyright (c) Anubis Team 2003-2007. | ||
| 7 | - | ||
| 8 | - | ||
| 9 | - *Authors* Alain Prouté | ||
| 10 | - David René | ||
| 11 | - Cédric Ricard | ||
| 12 | - | ||
| 13 | - | ||
| 14 | - *Revised* July 2007. | ||
| 15 | - | ||
| 16 | - | ||
| 17 | - | ||
| 18 | - *Overviews* | ||
| 19 | - In this file a HTTP/HTTPS server is defined, which is able to handle multiple hosts | ||
| 20 | - (virtual hosts). It answers HTTP/HTTPS requests, sends files (images or any other kind | ||
| 21 | - of file), constructs HTML pages on the fly using informations received from the client | ||
| 22 | - (when the URI ends by '.awp'), handles uploading of files and redirections. It is | ||
| 23 | - multitasking by itself, and can handle any number of sites and clients simultaneously. | ||
| 24 | - It should better be used in conjunction with 'making_a_web_site.anubis' to be found in | ||
| 25 | - the same directory. If you use 'web/making_a_web_site.anubis', you don't need to read | ||
| 26 | - this file. | ||
| 27 | - | ||
| 28 | - | ||
| 29 | - ----------------------------------- Table of Contents --------------------------------- | ||
| 30 | - | ||
| 31 | - *** (1) Multihosting and redirections. | ||
| 32 | - *** (2) The incompatibility between SSL and virtual hosts. | ||
| 33 | - *** (3) HTTP headers and web arguments. | ||
| 34 | - *** (4) Site descriptions. | ||
| 35 | - *** (5) Protection against denial of service attacks. | ||
| 36 | - *** (6) Starting your HTTP and HTTPS servers. | ||
| 37 | - *** (7) Private download. | ||
| 38 | - *** (8) About web argument names. | ||
| 39 | - *** (9) A web dispatcher. | ||
| 40 | - *** (10) HTTP Errors | ||
| 41 | - | ||
| 42 | - --------------------------------------------------------------------------------------- | ||
| 43 | - | ||
| 44 | - | ||
| 45 | - | ||
| 46 | - | ||
| 47 | - *** (1) Multihosting and redirections. | ||
| 48 | - | ||
| 49 | - This HTTP/HTTPS server can handle several host (also called 'virtual hosts'), in other | ||
| 50 | - words, you may have several sites on the same server, with the same IP address and same | ||
| 51 | - port numbers, but distinct 'host names'. | ||
| 52 | - | ||
| 53 | - A HTTP request sent by a browser contains the following informations: | ||
| 54 | - | ||
| 55 | - - a 'host name', | ||
| 56 | - - an URI (Uniform Resource Identifier), | ||
| 57 | - - HTTP headers, | ||
| 58 | - - web arguments (in the form 'name=value'). | ||
| 59 | - | ||
| 60 | - Actually, the host name is just the value of the HTTP header whose name is 'Host'. The | ||
| 61 | - host name indicates which site is requested. Hence, it is the primary information for | ||
| 62 | - branching to the right site. If there is no 'Host' HTTP header in the request, the | ||
| 63 | - request is denied. | ||
| 64 | - | ||
| 65 | - From now on, we may assume that the host is determined, and consequently that we are | ||
| 66 | - concerned by only one site. Each site has his own directories on the server's | ||
| 67 | - disk. | ||
| 68 | - | ||
| 69 | - Each site also has a list of 'redirections'. A redirection is a triplet, like this one: | ||
| 70 | - | ||
| 71 | - redirect("/", "www.our-business.com", "/homepage.awp") | ||
| 72 | - | ||
| 73 | - meaning that if the host is "www.our-business.com", and if the requested URI is "/", | ||
| 74 | - then the URI to be served is "/homepage.awp". 'redirect' is a constructor of the type | ||
| 75 | - 'Redirection' defined in 'web/common.anubis'. | ||
| 76 | - | ||
| 77 | - Now, an URI may end by ".awp" (meaning 'Anubis Web Page') or not. If it does, the | ||
| 78 | - server understands that an HTML page must be constructed on the fly, and to that end it | ||
| 79 | - calls the 'awp handler' of the site. Otherwise, the URI must end by a known extension, | ||
| 80 | - like ".jpg", ".png", ".txt", etc... and represents a file path relative to the | ||
| 81 | - 'public' directory of the site. If these conditions are satisfied, the file is sent to | ||
| 82 | - the client. Known extensions are recorded in 'web/mime.anubis'. | ||
| 83 | - | ||
| 84 | - | ||
| 85 | - | ||
| 86 | - | ||
| 87 | - *** (2) The incompatibility between SSL and virtual hosts. | ||
| 88 | - | ||
| 89 | - Handling virtual hosts makes a problem under SSL (i.e. when using HTTPS), which is due | ||
| 90 | - to the fact that the guys at Netscape who designed SSL probably did not have the | ||
| 91 | - question of virtual hosts in mind. Indeed, the SSL handshake is completed before the | ||
| 92 | - server can know about the value of the 'Host' HTTP header, so that it cannot know which | ||
| 93 | - server certificate must be sent to the client. This makes a problem, because the | ||
| 94 | - browser will not accept a certificate whose common name does not correspond to the name | ||
| 95 | - of the requested host. The user will have to accept the certificate manually, which is | ||
| 96 | - not good for the security image of the site. This problem has at least two solutions | ||
| 97 | - (as far as Anubis is concerned). | ||
| 98 | - | ||
| 99 | - Solution 1. Arrange so that the network interface on which the server is listening | ||
| 100 | - has at least as many different IP addresses as you have virtual hosts. Such | ||
| 101 | - supplementary IP addresses are called 'IP Aliases'. In this case, start one HTTPS | ||
| 102 | - server for each virtual host, each one listening on a different address. For the time | ||
| 103 | - being, this method is applicable under Anubis only if you start as many instances of | ||
| 104 | - 'anbexec' as you have virtual hosts, because each instance of 'anbexec' can handle only | ||
| 105 | - one server certificate. Of course, getting IP aliases is another problem to be solved | ||
| 106 | - with your Internet provider. | ||
| 107 | - | ||
| 108 | - Solution 2. We propose a simple solution, using only one server certificate (hence | ||
| 109 | - only one instance of 'anbexec'). Since, we have only one server certificate, we must | ||
| 110 | - introduce a notion of 'main host', i.e. a host containing all other 'virtual | ||
| 111 | - hosts'. The unique server certificate belong to the main host, so that only the main | ||
| 112 | - host is identified by the client. The client must trust the main host and be confident | ||
| 113 | - that the main host redirects him to the right virtual host. Actually, the process will | ||
| 114 | - be transparent to the client, except that the client will see the name of the main host | ||
| 115 | - instead of the name of the virtual host in the 'location' field of the browser. | ||
| 116 | - | ||
| 117 | - So, assume that the name of main host is 'www.securedhost.com', and that the names of | ||
| 118 | - the virtual hosts are: | ||
| 119 | - | ||
| 120 | - actual name simplified name | ||
| 121 | - ----------------------------------------------------- | ||
| 122 | - www.virtual1.com virtual1 | ||
| 123 | - www.virtual2.com virtual2 | ||
| 124 | - www.virtual3.com virtual3 | ||
| 125 | - | ||
| 126 | - Then the (confidential) document '/doc/my_document.pdf' on 'www.virtual2.com' will have | ||
| 127 | - the URL: | ||
| 128 | - | ||
| 129 | - https://www.securedhost.com/virtual2/doc/my_document.pdf | ||
| 130 | - | ||
| 131 | - In order to work transparently, this solution must combine HTTP and HTTPS. Indeed, the | ||
| 132 | - vitual host must have a first page reachable under HTTP, through the URL: | ||
| 133 | - | ||
| 134 | - http://www.virtual2.com/ | ||
| 135 | - | ||
| 136 | - The HTTP server will redirect this URL to the awp handler of virtual host 'virtual2'. | ||
| 137 | - The handler of this virtual host is able to generate a first page containing the | ||
| 138 | - following HTML meta: | ||
| 139 | - | ||
| 140 | - <meta http-equiv="Refresh" content="0;URL=https://www.securedhost.com/virtual2/">, | ||
| 141 | - | ||
| 142 | - so that the client is immediately redirected to the main host under HTTPS (hence | ||
| 143 | - accepting tranparently the server certificate). The awp handler of 'virtual2' then | ||
| 144 | - redirects this URL to the home page (maybe a login page) of 'virtual2'. | ||
| 145 | - | ||
| 146 | - See 'web/making_a_web_site.anubis' for the sequel of this story. | ||
| 147 | - | ||
| 148 | - | ||
| 149 | - | ||
| 150 | - | ||
| 151 | - | ||
| 152 | - *** (3) HTTP headers and web arguments. | ||
| 153 | - | ||
| 154 | - Each HTTP request which arrives on the server contains a request line followed by a | ||
| 155 | - series of HTTP headers. Each HTTP header is a pair '(name,value)' assigning a value to | ||
| 156 | - a name. The type 'HTTP_header' is defined in 'web/common.anubis'. | ||
| 157 | - | ||
| 158 | - The request may also have a 'body'. The body contains either 'web arguments' or | ||
| 159 | - uploaded files (or both). The request line itself may also contain web arguments (in a | ||
| 160 | - so-called 'query string'). Like HTTP headers, 'web arguments' are pairs | ||
| 161 | - '(name,value)', but the difference is that these pairs are generated by the page within | ||
| 162 | - which the client clicks, while HTTP headers are generated by the browser itself. The | ||
| 163 | - type 'Web_arg' is defined in 'web/common.anubis'. It has two alternatives, one for | ||
| 164 | - ordinary web arguments (pairs) and one for uploaded files. | ||
| 165 | - | ||
| 166 | -read CXM_common.anubis | ||
| 167 | -read tools/basis.anubis | ||
| 168 | -read tools/printable_tree.anubis | ||
| 169 | -read system/string.anubis | ||
| 170 | -read system/files.anubis | ||
| 171 | -read system/lists.anubis | ||
| 172 | -read web/mime.anubis | ||
| 173 | - | ||
| 174 | - | ||
| 175 | - | ||
| 176 | - *** (4) Site descriptions. | ||
| 177 | - | ||
| 178 | - The type HTTP_Info gathers informations comming along with the client's request. These | ||
| 179 | - informations are rarely used for composing HTML pages. Nevertheless, they are at your | ||
| 180 | - disposal. | ||
| 181 | - | ||
| 182 | -public type HTTP_Info: | ||
| 183 | - http_info | ||
| 184 | - ( | ||
| 185 | - Word32 ip_address, // IP address of the client | ||
| 186 | - String hostname, // hostname requested by the client | ||
| 187 | - String uri, // URI requested by the client | ||
| 188 | - List(HTTP_header) http_headers, // HTTP headers sent by the client | ||
| 189 | - Bool is_https, | ||
| 190 | - One -> String generate_trust_ticket // may be used against denial of | ||
| 191 | - // service attacks | ||
| 192 | - ). | ||
| 193 | - | ||
| 194 | - | ||
| 195 | - | ||
| 196 | - Each site is described by a 'web site description', which is a datum of type | ||
| 197 | - 'Web_Site_Description'. | ||
| 198 | - | ||
| 199 | -public type Web_Site_Description: | ||
| 200 | - web_site_description( | ||
| 201 | - List(String) common_names, | ||
| 202 | - String site_directory, | ||
| 203 | - Redirections redirections, | ||
| 204 | - String charset, | ||
| 205 | - List(String) journal_extensions, | ||
| 206 | - List(String) journal_headers, | ||
| 207 | - String authorization_secret, | ||
| 208 | - List(MIME) known_mime_types, | ||
| 209 | - (String host_name, | ||
| 210 | - HTTP_Info http_info, | ||
| 211 | - List(Web_arg) lwa, | ||
| 212 | - Bool is_https) -> (//List(HTTP_header), | ||
| 213 | - Printable_tree) awp_handler, | ||
| 214 | - (HTTP_Info http_info, | ||
| 215 | - List(Web_arg) lwa) -> One before_send_file | ||
| 216 | - //Bool using_state_cookies, | ||
| 217 | - ). | ||
| 218 | - | ||
| 219 | - The component 'common_names' is the list of names of the site, like for example | ||
| 220 | - "www.our-business.com". The reason why we have a list of common names instead of a | ||
| 221 | - single common name, is that it may be useful to have a common name like "192.168.0.1" | ||
| 222 | - for testing. | ||
| 223 | - | ||
| 224 | - 'charset' is a string which will determine the character encoding to be used by the | ||
| 225 | - browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252", | ||
| 226 | - etc... | ||
| 227 | - | ||
| 228 | - 'journal_extensions' is the list of URI extensions for which you want a log in the | ||
| 229 | - journal (and on the console). When a request arrives, and if the extension is a member | ||
| 230 | - of this list, a message is printed into the journal of the site including the date, the | ||
| 231 | - IP address of the client, the complete HTTP request line. The HTTP headers whose name | ||
| 232 | - is a member of 'journal_headers' are also printed in the journal. A reasonable minimum | ||
| 233 | - for these two components is: | ||
| 234 | - | ||
| 235 | - [".awp"] for journal_extensions | ||
| 236 | - ["user-agent"] for journal_headers | ||
| 237 | - | ||
| 238 | - 'authorization_secret' is a string which should just be unguessable. You may choose | ||
| 239 | - something like (but don't choose this one !): | ||
| 240 | - | ||
| 241 | - "Hg8kJe42gCML9jNH-74" | ||
| 242 | - | ||
| 243 | - i.e. a sequence of characters typed at random, long enough to be unguessable. This is | ||
| 244 | - used by the 'private download' mecanism, which is discussed later in this file. | ||
| 245 | - | ||
| 246 | - The component 'awp_handler' is a function of type: | ||
| 247 | - | ||
| 248 | - (String host_name, | ||
| 249 | - HTTP_Info http_info, | ||
| 250 | - List(Web_arg) web_args, | ||
| 251 | - Bool is_https) -> Printable_tree | ||
| 252 | - | ||
| 253 | - ('Printable_tree' is a substitute for 'String' and is defined in | ||
| 254 | - 'tools/basis.anubis'). This function is the 'awp handler' for the site. When the URI | ||
| 255 | - ends by ".awp", this function is called, and the result (an HTML page) is sent to the | ||
| 256 | - client over the connection. The last operand to this function is a boolean which is | ||
| 257 | - 'true' when the requests arrives through the HTTPS channel, and 'false' when it arrives | ||
| 258 | - through the HTTP channel. | ||
| 259 | - | ||
| 260 | - | ||
| 261 | - | ||
| 262 | - | ||
| 263 | - | ||
| 264 | - | ||
| 265 | - | ||
| 266 | - *** (5) Protection against denial of service attacks. | ||
| 267 | - | ||
| 268 | - We need to protect our servers against 'denial of service' attacks. The attack may be | ||
| 269 | - send automatically from machines which are infested by viruses. In that case, our | ||
| 270 | - server is saturated of connections (all virtual machines at work), but nothing is | ||
| 271 | - comming on the connections. In order to avoid this problem, we propose the following: | ||
| 272 | - | ||
| 273 | - (1) Limit the number of simultaneous connections (say to 100). | ||
| 274 | - (2) Close a connection if the request is not complete after say 10 seconds. | ||
| 275 | - (3) Close the connection if the request is bigger than a given size (normal requests | ||
| 276 | - are small except when there are uploaded files. | ||
| 277 | - (4) Close the connection during the sending of the answer if the client is waiting | ||
| 278 | - too much. | ||
| 279 | - (5) Record all IP addresses with which we have encountered one of the problems above. | ||
| 280 | - (6) Immediately close the connections if the IP address is in our list. | ||
| 281 | - (7) Remove an address from the list only after 5 minutes of inactivity of this | ||
| 282 | - address. | ||
| 283 | - (8) Maintain a list of reliable IP addresses. | ||
| 284 | - | ||
| 285 | - Of course, all the above are approximative solutions which may in some circumstances | ||
| 286 | - become either cumbersome or also partially block the system. So, it is needed to have a | ||
| 287 | - set of dynamically modifiable parameters in order to master the behavior of this | ||
| 288 | - mecanism. | ||
| 289 | - | ||
| 290 | - | ||
| 291 | - Each dubious IP address is recorded together with its last activity time. | ||
| 292 | - | ||
| 293 | -public type DubiousIP: | ||
| 294 | - dubious_ip (Word32 address, | ||
| 295 | - Int last_activity). | ||
| 296 | - | ||
| 297 | - | ||
| 298 | -public type DenialOfService: | ||
| 299 | - denial_of_service(Var(Int) max_connections, | ||
| 300 | - Var(Int) request_line_delay, // seconds | ||
| 301 | - Var(Int) headers_delay, | ||
| 302 | - Var(Int) answer_delay, | ||
| 303 | - Var(List(DubiousIP)) list_of_dubious, | ||
| 304 | - Var(List(Word32)) reliable_addresses). | ||
| 305 | - | ||
| 306 | - The informations in this set of variables are stored serialized into the file | ||
| 307 | - 'my_anubis/web_sites/dos_info'. If this file does not exist a set if variables with | ||
| 308 | - default values is created. The values are saved on the disk each time they are | ||
| 309 | - modified. | ||
| 310 | - | ||
| 311 | -public define DenialOfService load_denial_of_service_info. | ||
| 312 | - | ||
| 313 | - | ||
| 314 | - | ||
| 315 | - *** (6) Starting your HTTP and HTTPS servers. | ||
| 316 | - | ||
| 317 | - When your web site descriptions are ready, you can start a pair of servers (a HTTP | ||
| 318 | - server and a HTTPS server) for serving your web sites. Notice that there are always | ||
| 319 | - two servers, regardless of the number of web sites, and that each web sites normally | ||
| 320 | - uses the two servers. | ||
| 321 | - | ||
| 322 | - | ||
| 323 | -public define StartServerResult | ||
| 324 | - start_http_server | ||
| 325 | - ( | ||
| 326 | - Word32 ip_address, | ||
| 327 | - Word32 http_port, | ||
| 328 | - List(Web_Site_Description) web_sites, | ||
| 329 | - DenialOfService dos | ||
| 330 | - ). | ||
| 331 | - | ||
| 332 | -public define StartServerResult | ||
| 333 | - start_https_server | ||
| 334 | - ( | ||
| 335 | - Word32 ip_address, | ||
| 336 | - Word32 https_port, | ||
| 337 | - String certificate_common_name, | ||
| 338 | - List(Web_Site_Description) web_sites, | ||
| 339 | - DenialOfService dos | ||
| 340 | - ). | ||
| 341 | - | ||
| 342 | - The first argument 'ip_address' is the IP address on which the servers listen. If you | ||
| 343 | - put 0, the servers listen on all adresses of the machine (which is useful if the | ||
| 344 | - machine has several network interfaces). Otherwise, use the function 'ip_address' | ||
| 345 | - defined in 'tools/basis.anubis' for composing a particular IP address. | ||
| 346 | - | ||
| 347 | - The next arguments are the port numbers for HTTP and HTTPS. The usual values are 80 and | ||
| 348 | - 443, but you may have reasons to choose other values. | ||
| 349 | - | ||
| 350 | - The next argument is the list of your web site descriptions. All the sites described in | ||
| 351 | - this list will be accessible on the server. | ||
| 352 | - | ||
| 353 | - The argument 'dos' is a set of dynamic variables containing the informations for | ||
| 354 | - protecting the servers against denial of service attacks. | ||
| 355 | - | ||
| 356 | - | ||
| 357 | - | ||
| 358 | - | ||
| 359 | - | ||
| 360 | - | ||
| 361 | - *** (7) Private download. | ||
| 362 | - | ||
| 363 | - It may happen that you want to propose private files for download. This means that such | ||
| 364 | - a file could be downloaded only by the authorized person, and should not be seen by any | ||
| 365 | - other one. This feature can be used only under HTTPS, not under HTTP. | ||
| 366 | - | ||
| 367 | - The file may be located anywhere on the server. Hence, the file has a complete absolute | ||
| 368 | - path, like for example: | ||
| 369 | - | ||
| 370 | - /home/georges/my_documents/my_text.pdf | ||
| 371 | - | ||
| 372 | - which has nothing to do with the directories of the web server. Now, you may also want | ||
| 373 | - to show another path or simply just a name to the client, not the actual absolute path | ||
| 374 | - above, which may need to remain secret. So for example, the same file may appear to the | ||
| 375 | - client as: | ||
| 376 | - | ||
| 377 | - informations.pdf | ||
| 378 | - | ||
| 379 | - The page must provide a link with an authorization. The authorization is just a web | ||
| 380 | - argument, whose name is "zauth". The value of this web argument is computed by hashing | ||
| 381 | - some secret string (known only from the programmer of the web site) with the absolute | ||
| 382 | - path of the file. The HTTPS request will have the form: | ||
| 383 | - | ||
| 384 | - GET /informations.pdf?zauth=d38161f5b4e87e2d46e06ff8b3e233be563794d1 | ||
| 385 | - | ||
| 386 | - The server will search for a file named | ||
| 387 | - | ||
| 388 | - zd38161f5b4e87e2d46e06ff8b3e233be563794d1 | ||
| 389 | - | ||
| 390 | - (i.e. "z" concatenated with the value of the authorization) in the subdirectory | ||
| 391 | - 'private_download' of the site directory. This file contains the absolute path of the | ||
| 392 | - file, i.e: | ||
| 393 | - | ||
| 394 | - /home/georges/my_documents/my_text.pdf | ||
| 395 | - | ||
| 396 | - At that point, the server may hash the secret string and the absolute path together, to | ||
| 397 | - check if the client is authorized to download the file. If it is the case, it sends the | ||
| 398 | - file (the MIME type is declared as 'application/octet-stream' if it is not recognized). | ||
| 399 | - The file is sent under the visible name. | ||
| 400 | - | ||
| 401 | - The server creates automatically the subdirectory 'private_download/' within the 'site | ||
| 402 | - directory' (for each web site) if it does not already exist. Files in this directory | ||
| 403 | - are deleted when they become too old (for example, after 3 days of life). | ||
| 404 | - | ||
| 405 | - Here is the function for computing the value of the authorization, and for making the | ||
| 406 | - authorization file in 'private_download'. | ||
| 407 | - | ||
| 408 | -public define String | ||
| 409 | - make_authorization | ||
| 410 | - ( | ||
| 411 | - String site_directory, | ||
| 412 | - String authorization_secret, // known only by the programmer of the web site | ||
| 413 | - String absolute_path // on server | ||
| 414 | - ). | ||
| 415 | - | ||
| 416 | - See 'web/making_a_web_site.anubis' for the construction of the link for downloading. | ||
| 417 | - | ||
| 418 | - | ||
| 419 | - | ||
| 420 | - | ||
| 421 | - | ||
| 422 | - | ||
| 423 | - | ||
| 424 | - | ||
| 425 | - *** (8) About web argument names. | ||
| 426 | - | ||
| 427 | - The server reserves the name "zauth" for the authorization in the private download | ||
| 428 | - mecanism. Also, if the name of a web arguments begins by "p" (like 'password'), it does | ||
| 429 | - not print the value of the web argument neither on the console or in the journal. A | ||
| 430 | - good politics is to prefix all web arguments by letters distinct from 'p' and 'z'. This | ||
| 431 | - method is used in 'web/making_a_web_site.anubis'. This will avoid clashes of names. | ||
| 432 | - | ||
| 433 | - | ||
| 434 | - | ||
| 435 | - | ||
| 436 | - | ||
| 437 | - | ||
| 438 | - *** (9) A web dispatcher. | ||
| 439 | - | ||
| 440 | - For hosting several sites you may prefer another method which we now describe. We start | ||
| 441 | - a HTTP server on port 80 (or on another port). This server is called the | ||
| 442 | - ``dispatcher''. When a requests arrives, the dispatcher examines the ``host'' HTTP | ||
| 443 | - header, so that it gets the name of the requested host. Then it sends to the client a | ||
| 444 | - page like this one: | ||
| 445 | - | ||
| 446 | - <html> | ||
| 447 | - <head> | ||
| 448 | - <meta http-equiv="Refresh" content="0;URL=..."> | ||
| 449 | - </head> | ||
| 450 | - <body> | ||
| 451 | - </body> | ||
| 452 | - </html> | ||
| 453 | - | ||
| 454 | - where the URL represented by '...' is the URL of the requested site. This URL may have | ||
| 455 | - the same IP address as the dispatcher, except that the port number is different. It may | ||
| 456 | - also have a different IP address. | ||
| 457 | - | ||
| 458 | - The dispatcher uses the file 'my_anubis/web_sites/dispatcher.info'. This file contains | ||
| 459 | - a serialized datum of type 'List(DispatcherInfo)'. | ||
| 460 | - | ||
| 461 | -public type DispatcherInfo: | ||
| 462 | - site(String common_name, | ||
| 463 | - Word32 http_port). | ||
| 464 | - | ||
| 465 | - The dispatcher does not write into this file. It reads it when it starts, and rereads | ||
| 466 | - it each time the date of last modification of the file changes, so that the dispatcher | ||
| 467 | - always has up to date data. The file may be managed (written and updated) by another | ||
| 468 | - program. | ||
| 469 | - | ||
| 470 | - So, for each site, the dispatcher knows the common name (needed to recognize the 'host' | ||
| 471 | - HTTP header), and the pair (ip_address,port) used by the actual site for HTTP. The | ||
| 472 | - dispatcher does not worry about HTTPS. HTTPS must be managed by the actual site. | ||
| 473 | - | ||
| 474 | - The dispatcher is started by: | ||
| 475 | - | ||
| 476 | -public define One | ||
| 477 | - start_web_dispatcher | ||
| 478 | - ( | ||
| 479 | - Word32 ip_address, // address for listening (typically 0) | ||
| 480 | - Word32 port, // typically 80 | ||
| 481 | - DenialOfService dos | ||
| 482 | - ). | ||
| 483 | - | ||
| 484 | - A command line tool for managing the file 'my_anubis/web_sites/dispatcher.info' is also | ||
| 485 | - provided: | ||
| 486 | - | ||
| 487 | - global define One | ||
| 488 | - manage_web_dispatcher | ||
| 489 | - ( | ||
| 490 | - List(String) args | ||
| 491 | - ). | ||
| 492 | - | ||
| 493 | - | ||
| 494 | - *** (10) HTTP Errors | ||
| 495 | - | ||
| 496 | -public type HTTP_Status: | ||
| 497 | - http_continue, // 100 | ||
| 498 | - http_switching_protocol, // 101 | ||
| 499 | - | ||
| 500 | - http_ok, // 200 | ||
| 501 | - http_created, // 201 | ||
| 502 | - http_accepted, // 202 | ||
| 503 | - http_non_authoritative_info, // 203 | ||
| 504 | - http_no_content, // 204 | ||
| 505 | - http_reset_content, // 205 | ||
| 506 | - http_partial_content, // 206 | ||
| 507 | - | ||
| 508 | - http_multiple_choices, | ||
| 509 | - http_moved_permanently(String location), // 301 | ||
| 510 | - http_moved_temporarily(String location), // 302 | ||
| 511 | - http_see_other(String location), // 303 | ||
| 512 | - http_not_modified, // 304 | ||
| 513 | - http_use_proxy(String location), // 305 | ||
| 514 | - http_temporary_redirect(String location), // 307 | ||
| 515 | - | ||
| 516 | - http_bad_request, // 400 | ||
| 517 | - http_unauthorized, // 401 | ||
| 518 | - http_payment_required, // 402 | ||
| 519 | - http_forbidden, // 403 | ||
| 520 | - http_not_found, // 404 | ||
| 521 | - http_method_not_allowed, // 405 | ||
| 522 | - http_not_acceptable, // 406 | ||
| 523 | - http_proxy_authentification_required, // 407 | ||
| 524 | - http_request_timeout, // 408 | ||
| 525 | - http_conflict, // 409 | ||
| 526 | - http_gone, // 410 | ||
| 527 | - http_length_required, // 411 | ||
| 528 | - http_precondition_failed, // 412 | ||
| 529 | - http_request_entity_too_large, // 413 | ||
| 530 | - http_request_uri_too_long, // 414 | ||
| 531 | - http_unsupported_media_type, // 415 | ||
| 532 | - http_request_range_unsatisfiable, // 416 | ||
| 533 | - http_expectation_failed, // 417 | ||
| 534 | - | ||
| 535 | - http_internal_server_error, // 500 | ||
| 536 | - http_not_implemented, // 501 | ||
| 537 | - http_bad_gateway, // 502 | ||
| 538 | - http_service_unavailable, // 503 | ||
| 539 | - http_gateway_timeout, // 504 | ||
| 540 | - http_version_not_supported, // 505 | ||
| 541 | - | ||
| 542 | - http_error(Int /*code*/, String /*message*/). | ||
| 543 | - | ||
| 544 | -public define (String, List(HTTP_header)) | ||
| 545 | - format | ||
| 546 | - ( | ||
| 547 | - HTTP_Status status | ||
| 548 | - ). | ||
| 549 | - | ||
| 550 | - | ||
| 551 | - | ||
| 552 | - | ||
| 553 | - | ||
| 554 | - --- That's all for the public part ! -------------------------------------------------- | ||
| 555 | - | ||
| 556 | -define Maybe(String) get_host_header_value(List(HTTP_header) headers). | ||
| 557 | - | ||
| 558 | -define String | ||
| 559 | - __utime_to_string | ||
| 560 | - ( | ||
| 561 | - UTime t | ||
| 562 | - ) = | ||
| 563 | - to_decimal(t.seconds) + "." + zero_pad_n(6, t.microseconds ) + "s". | ||
| 564 | - | ||
| 565 | - | ||
| 566 | -variable UTime t0 = utime(0,0). | ||
| 567 | -variable UTime t1 = utime(0,0). | ||
| 568 | - | ||
| 569 | -define One | ||
| 570 | - accumulate_t1 | ||
| 571 | - ( | ||
| 572 | - UTime start | ||
| 573 | - ) = | ||
| 574 | - with delta = (UTime)unow - start, | ||
| 575 | - t1 <- delta + *t1; | ||
| 576 | - unique. | ||
| 577 | - | ||
| 578 | -variable UTime t2 = utime(0,0). | ||
| 579 | - | ||
| 580 | -define One | ||
| 581 | - accumulate_t2 | ||
| 582 | - ( | ||
| 583 | - UTime start | ||
| 584 | - ) = | ||
| 585 | - with delta = (UTime)unow - start, | ||
| 586 | - t2 <- delta + *t2; | ||
| 587 | - unique. | ||
| 588 | - | ||
| 589 | - | ||
| 590 | -public define One | ||
| 591 | - print_delta | ||
| 592 | - ( | ||
| 593 | - String txt | ||
| 594 | - ) = | ||
| 595 | - println(__utime_to_string((UTime)unow - *t0) + " : " + txt). | ||
| 596 | - | ||
| 597 | - | ||
| 598 | - ----------------------------------- Table of Contents --------------------------------- | ||
| 599 | - | ||
| 600 | - *** [1] Types which are private to this file. | ||
| 601 | - | ||
| 602 | - *** [2] Tools. | ||
| 603 | - *** [2.1] Formating an error message. | ||
| 604 | - *** [2.2] Converting IP addresses. | ||
| 605 | - *** [2.3] Reading and unputting characters. | ||
| 606 | - *** [2.4] Reading and discarding characters. | ||
| 607 | - *** [2.5] Reading a character string. | ||
| 608 | - *** [2.6] Padding integers with zeros. | ||
| 609 | - *** [2.7] Converting web arguments to ASCII. | ||
| 610 | - *** [2.8] Server description. | ||
| 611 | - | ||
| 612 | - *** [3] Managing the journal. | ||
| 613 | - *** [3.1] Naming journal files. | ||
| 614 | - *** [3.2] Formating HTTP headers. | ||
| 615 | - *** [3.3] Formating web arguments. | ||
| 616 | - *** [3.4] Formating the whole request. | ||
| 617 | - *** [3.5] Putting it in the journal file (and on the console). | ||
| 618 | - | ||
| 619 | - *** [4] Reading the HTTP request. | ||
| 620 | - *** [4.1] Skipping leading blanks. | ||
| 621 | - *** [4.2] Reading a new line. | ||
| 622 | - *** [4.3] Reading a 'word'. | ||
| 623 | - *** [4.4] Separating the URI from the query string. | ||
| 624 | - *** [4.5] Reading the web arguments. | ||
| 625 | - *** [4.7] Reading the request line. | ||
| 626 | - *** [4.8] Reading the HTTP headers. | ||
| 627 | - *** [4.9] Getting the size of the request's body. | ||
| 628 | - *** [4.10] Reading the body of the request. | ||
| 629 | - | ||
| 630 | - *** [5] Making the HTTP answer. | ||
| 631 | - *** [5.1] Avoiding illegal URIs. | ||
| 632 | - *** [5.2] Managing authorizations for downloading private files. | ||
| 633 | - *** [5.3] Recognizing MIME types. | ||
| 634 | - *** [5.4] Formating HTTP headers. | ||
| 635 | - *** [5.5] Sending a file. | ||
| 636 | - *** [5.6] Answering a www-url encoded request. | ||
| 637 | - *** [5.7] Answering a multipart/form-data encoded request. | ||
| 638 | - *** [5.7.1] Finding the boundary. | ||
| 639 | - *** [5.7.2] Reading attributes from a multipart entity. | ||
| 640 | - *** [5.7.3] Creating a temporary filename for an uploaded file. | ||
| 641 | - *** [5.7.4] Saving an uploaded file under a temporary filename. | ||
| 642 | - *** [5.7.5] Removing the path from a file name. | ||
| 643 | - *** [5.7.6] Reading a multipart entity. | ||
| 644 | - *** [5.8] Handling redirections. | ||
| 645 | - *** [5.9] Answering both sorts of requests. | ||
| 646 | - | ||
| 647 | - *** [6] The HTTP/HTTPS servers. | ||
| 648 | - *** [6.1] The HTTP request handler. | ||
| 649 | - *** [6.2] Server's tasks. | ||
| 650 | - *** [6.3] Starting the HTTP/HTTPS servers. | ||
| 651 | - | ||
| 652 | - *** [7] The web dispatcher. | ||
| 653 | - *** [7.1] The dispatcher server. | ||
| 654 | - *** [7.2] The dispatcher web site. | ||
| 655 | - *** [7.3] Managing the info file. | ||
| 656 | - | ||
| 657 | - --------------------------------------------------------------------------------------- | ||
| 658 | - | ||
| 659 | - | ||
| 660 | - | ||
| 661 | - | ||
| 662 | -read tools/basis.anubis | ||
| 663 | -read tools/findstring.anubis | ||
| 664 | -read tools/connections.anubis | ||
| 665 | - | ||
| 666 | - | ||
| 667 | - | ||
| 668 | - | ||
| 669 | - | ||
| 670 | - *** [1] Types which are private to this file. | ||
| 671 | - | ||
| 672 | - We use the following self-explanatory types. | ||
| 673 | - | ||
| 674 | -type Error: | ||
| 675 | - cannot_read_from_connection, | ||
| 676 | - not_get_or_post_request(String), | ||
| 677 | - end_of_line_expected, | ||
| 678 | - incorrect_content_length_value, | ||
| 679 | - colon_expected, | ||
| 680 | - timeout(Int). | ||
| 681 | - | ||
| 682 | -type HTTP_RequestType: | ||
| 683 | - get, | ||
| 684 | - post. | ||
| 685 | - | ||
| 686 | -type HTTP_RequestLine: | ||
| 687 | - request_line (HTTP_RequestType type, | ||
| 688 | - String uri, | ||
| 689 | - List(Web_arg) query_string). | ||
| 690 | - | ||
| 691 | -type EncodingType: | ||
| 692 | - www_url, | ||
| 693 | - multipart_form_data. | ||
| 694 | - | ||
| 695 | -type BufferedConnection: | ||
| 696 | - buffered_connection(Connection conn, | ||
| 697 | - Var(ByteArray) buffer, | ||
| 698 | - Var(Int) read_pos). | ||
| 699 | - | ||
| 700 | - | ||
| 701 | - | ||
| 702 | - *** [2] Tools. | ||
| 703 | - | ||
| 704 | - *** [2.1] Formating an error message. | ||
| 705 | - | ||
| 706 | - The next function formats an error message. | ||
| 707 | - | ||
| 708 | -define String | ||
| 709 | - format | ||
| 710 | - ( | ||
| 711 | - Error msg | ||
| 712 | - ) = | ||
| 713 | - if msg is | ||
| 714 | - { | ||
| 715 | - cannot_read_from_connection then | ||
| 716 | - "Cannot read from connection.\n", | ||
| 717 | - not_get_or_post_request(s) then | ||
| 718 | - "The request did not begin by 'GET' or 'POST': "+s+".\n", | ||
| 719 | - end_of_line_expected then | ||
| 720 | - "End of line expected.\n", | ||
| 721 | - incorrect_content_length_value then | ||
| 722 | - "Incorrect value for HTTP header 'Content-Length'.\n", | ||
| 723 | - colon_expected then | ||
| 724 | - "':' was expected.\n", | ||
| 725 | - timeout(n) then | ||
| 726 | - //"time out: "+n+"\n" | ||
| 727 | - //"time out.\n" | ||
| 728 | - "" | ||
| 729 | - }. | ||
| 730 | - | ||
| 731 | - | ||
| 732 | - | ||
| 733 | - | ||
| 734 | - | ||
| 735 | - | ||
| 736 | - *** [2.2] Converting IP addresses. | ||
| 737 | - | ||
| 738 | - We need two conversion functions for IP addresses: | ||
| 739 | - | ||
| 740 | - (Word8,Word8,Word8,Word8) --> Word32 ip_address | ||
| 741 | - Word32 --> String ip_addr_to_string | ||
| 742 | - | ||
| 743 | - These conversions are defined in 'tools/basis.anubis'. | ||
| 744 | - | ||
| 745 | - | ||
| 746 | - | ||
| 747 | - | ||
| 748 | - | ||
| 749 | - | ||
| 750 | - | ||
| 751 | - | ||
| 752 | - *** [2.3] Reading and unputting characters. | ||
| 753 | - | ||
| 754 | - We need a mecanism for unputting several characters (actually at least 3). This is | ||
| 755 | - because when reading the client connection, we must sometimes go ahead several | ||
| 756 | - characters, and virtually put them back into the connection, so that they can be | ||
| 757 | - reread. Of course, we do not send them back to the client. We store them in a list | ||
| 758 | - (hold by the variable 'unput_chars'), and we manage this list, so that characters may | ||
| 759 | - be virtually put back in the connection (this is called 'unputting'). | ||
| 760 | - | ||
| 761 | -variable List(Word8) unput_chars = []. | ||
| 762 | - | ||
| 763 | - The most recently read one is the head of list. Fortunately, this variable is private | ||
| 764 | - to this virtual machine (hence to this client). | ||
| 765 | - | ||
| 766 | - | ||
| 767 | -define One | ||
| 768 | - unput // unputting a character (add it in front of the list) | ||
| 769 | - ( | ||
| 770 | - Word8 character | ||
| 771 | - ) = | ||
| 772 | - unput_chars <- (List(Word8))[character . *unput_chars]. | ||
| 773 | - | ||
| 774 | - | ||
| 775 | - | ||
| 776 | -define One record_dubious_IP(Word32 addr,DenialOfService dos). | ||
| 777 | - | ||
| 778 | -variable Int sttm = 0. // contains the start time for this connection. | ||
| 779 | - | ||
| 780 | -define Result(Error,Word8) | ||
| 781 | - record_dubious_connection | ||
| 782 | - ( | ||
| 783 | - Connection conn, | ||
| 784 | - Int dead_line, | ||
| 785 | - DenialOfService dos, | ||
| 786 | - ) = | ||
| 787 | - if remote_IP_address_and_port(conn) is (addr,port) then | ||
| 788 | - record_dubious_IP(addr,dos); | ||
| 789 | - print("Recording IP address "+ip_addr_to_string(addr)+ | ||
| 790 | - " as dubious after "+(dead_line-*sttm)+" seconds. Total: "+ | ||
| 791 | - length(*list_of_dubious(dos))+"\n"); | ||
| 792 | - error(timeout(dead_line)). | ||
| 793 | - | ||
| 794 | -define String | ||
| 795 | - pid | ||
| 796 | - = | ||
| 797 | - "[" + virtual_machine_id + "] ". | ||
| 798 | - | ||
| 799 | - | ||
| 800 | -define One | ||
| 801 | - put | ||
| 802 | - ( | ||
| 803 | - ByteArray source, | ||
| 804 | - ByteArray dest, | ||
| 805 | - Int position, | ||
| 806 | - Int i | ||
| 807 | - ) = | ||
| 808 | - if nth(i,source) is | ||
| 809 | - { | ||
| 810 | - failure then unique, | ||
| 811 | - success(b) then if put(dest,position,b) is | ||
| 812 | - { | ||
| 813 | - failure then unique, | ||
| 814 | - success(_) then put(source,dest,position+1,i+1) | ||
| 815 | - } | ||
| 816 | - }. | ||
| 817 | - | ||
| 818 | -define ReadResult | ||
| 819 | - read_from_connexion | ||
| 820 | - ( | ||
| 821 | - BufferedConnection connection, | ||
| 822 | - Int size, | ||
| 823 | - Int time_out, | ||
| 824 | - ByteArray result_buffer, | ||
| 825 | - Int position | ||
| 826 | - ) = | ||
| 827 | - //println(pid + "read_from_connexion(" + size + ")"); | ||
| 828 | - | ||
| 829 | - if *connection.read_pos < length(*connection.buffer) then | ||
| 830 | - //println(pid + " reading from buffer (size = " + length(*connection.buffer) + ", pos = " + *connection.read_pos); | ||
| 831 | - //with t1_tmp = (UTime) unow, | ||
| 832 | - with result = extract(*connection.buffer, *connection.read_pos, *connection.read_pos + size), | ||
| 833 | - size_read = length(result), | ||
| 834 | - put(result,result_buffer,position,0); | ||
| 835 | - connection.read_pos <- *connection.read_pos + size_read; | ||
| 836 | - //accumulate_t1(t1_tmp); | ||
| 837 | - if size > size_read then | ||
| 838 | - //println("Wanted " + size + ", read only " + size_read); | ||
| 839 | - | ||
| 840 | - terminal read_from_connexion(connection, size - size_read, time_out, result_buffer,position+size_read) | ||
| 841 | -// { | ||
| 842 | -// error then error, | ||
| 843 | -// timeout then ok(result), | ||
| 844 | -// ok(ba) then ok(result + ba) | ||
| 845 | -// } | ||
| 846 | - else | ||
| 847 | - ok(result_buffer) | ||
| 848 | - else | ||
| 849 | - //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else | ||
| 850 | - if read(connection.conn, 16384, time_out) is // the connection is closed after 10 minutes of inactivity | ||
| 851 | - { | ||
| 852 | - error then println(pid + "read failed)"); error, | ||
| 853 | - timeout then timeout, | ||
| 854 | - ok(ba) then | ||
| 855 | -// println(pid + "ba = " + length(ba)); | ||
| 856 | - connection.buffer <- ba; | ||
| 857 | - connection.read_pos <- 0; | ||
| 858 | - //println(pid + "rb = " + length(*read_buffer)); | ||
| 859 | - | ||
| 860 | - terminal read_from_connexion(connection, size, time_out, result_buffer,position) | ||
| 861 | - }. | ||
| 862 | - | ||
| 863 | -define Result(Error,Word8) | ||
| 864 | - next_char // reading a character (check the list first, and read on the connection | ||
| 865 | - // only when the list is empty). | ||
| 866 | - ( | ||
| 867 | - BufferedConnection connection, | ||
| 868 | - Int dead_line, | ||
| 869 | - DenialOfService dos | ||
| 870 | - ) = | ||
| 871 | - //with t2_tmp = (UTime) now, | ||
| 872 | - if *unput_chars is | ||
| 873 | - { | ||
| 874 | - [ ] then | ||
| 875 | - // /////////////////// | ||
| 876 | - // Buffered reading | ||
| 877 | - //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else | ||
| 878 | - if nth(*connection.read_pos, *connection.buffer) is | ||
| 879 | - { | ||
| 880 | - failure then | ||
| 881 | - if read_from_connexion(connection,1,600, constant_byte_array(1,0),0) is // the connection is closed after 10 minutes of inactivity | ||
| 882 | - { | ||
| 883 | - error then /*accumulate_t2(t2_tmp);*/ error(cannot_read_from_connection), | ||
| 884 | - timeout then /*accumulate_t2(t2_tmp);*/ error(timeout(600)), | ||
| 885 | - //record_dubious_connection(connection,dead_line,dos), | ||
| 886 | - ok(ba) then if nth(0,ba) is | ||
| 887 | - { | ||
| 888 | - failure then /*accumulate_t2(t2_tmp);*/ error(cannot_read_from_connection), | ||
| 889 | - success(c) then | ||
| 890 | - //println("-" + pid + "read [" + implode([c]) + "]\t"); | ||
| 891 | - //accumulate_t2(t2_tmp); | ||
| 892 | - ok(c) | ||
| 893 | - } | ||
| 894 | - }, | ||
| 895 | - success(c) then | ||
| 896 | - connection.read_pos <- *connection.read_pos + 1; | ||
| 897 | - //accumulate_t2(t2_tmp); | ||
| 898 | - ok(c) | ||
| 899 | - }, | ||
| 900 | - | ||
| 901 | - // /////////////////// | ||
| 902 | - // standard reading | ||
| 903 | -// if read(connection.conn, 1, 600) is // the connection is closed after 10 minutes of inactivity | ||
| 904 | -// { | ||
| 905 | -// error then accumulate_t2(t2_tmp); println(pid + "read failed)"); error(cannot_read_from_connection), | ||
| 906 | -// timeout then accumulate_t2(t2_tmp); error(timeout(600)), | ||
| 907 | -// ok(ba) then if nth(0,ba) is | ||
| 908 | -// { | ||
| 909 | -// failure then accumulate_t2(t2_tmp); error(cannot_read_from_connection), | ||
| 910 | -// success(c) then accumulate_t2(t2_tmp); | ||
| 911 | -// ok(c) | ||
| 912 | -// } | ||
| 913 | -// }, | ||
| 914 | - | ||
| 915 | - [h . t] then | ||
| 916 | - unput_chars <- t; //accumulate_t2(t2_tmp); | ||
| 917 | - ok(h) | ||
| 918 | - }. | ||
| 919 | - | ||
| 920 | - | ||
| 921 | - | ||
| 922 | - | ||
| 923 | - | ||
| 924 | - | ||
| 925 | - *** [2.4] Reading and discarding characters. | ||
| 926 | - | ||
| 927 | - The next function reads the specified number of bytes (this is the same as | ||
| 928 | - 'characters') from the connection and discards them. This is used for discarding CR LF | ||
| 929 | - just before the body of a request. | ||
| 930 | - | ||
| 931 | -define Result(Error,One) | ||
| 932 | - read_and_ignore | ||
| 933 | - ( | ||
| 934 | - BufferedConnection connection, // to client | ||
| 935 | - Int dead_line, | ||
| 936 | - Int number_of_characters, // number of characters to read and ignore | ||
| 937 | - DenialOfService dos | ||
| 938 | - ) = | ||
| 939 | - if number_of_characters =< 0 then ok(unique) else | ||
| 940 | - if next_char(connection, dead_line, dos) is | ||
| 941 | - { | ||
| 942 | - error(msg) then error(msg), | ||
| 943 | - ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos) | ||
| 944 | - }. | ||
| 945 | - | ||
| 946 | - | ||
| 947 | - | ||
| 948 | - | ||
| 949 | - | ||
| 950 | - | ||
| 951 | - | ||
| 952 | - *** [2.5] Reading a character string. | ||
| 953 | - | ||
| 954 | - Sometimes values of HTTP attributes or web args are presented in the form of double | ||
| 955 | - quoted strings. The next function handles the reading of such things. The leading | ||
| 956 | - double quote is already read in. We must read subsequent characters until the next non | ||
| 957 | - backslashed double quote. | ||
| 958 | - | ||
| 959 | -define Result(Error,String) | ||
| 960 | - read_string | ||
| 961 | - ( | ||
| 962 | - BufferedConnection connection, // connection with the client | ||
| 963 | - Int dead_line, | ||
| 964 | - List(Word8) so_far, // characters read so far (in reverse order) | ||
| 965 | - DenialOfService dos | ||
| 966 | - ) = | ||
| 967 | - if next_char(connection, dead_line,dos) is | ||
| 968 | - { | ||
| 969 | - error(msg) then error(msg), | ||
| 970 | - ok(c) then | ||
| 971 | - if c = '\\' | ||
| 972 | - then if next_char(connection,dead_line,dos) is | ||
| 973 | - { | ||
| 974 | - error(msg) then error(msg), | ||
| 975 | - ok(d) then | ||
| 976 | - if d = '\"' | ||
| 977 | - then read_string(connection,dead_line,['\"' . so_far],dos) | ||
| 978 | - else read_string(connection,dead_line,[d, c . so_far],dos) | ||
| 979 | - } | ||
| 980 | - else if c = '\"' | ||
| 981 | - then ok(implode(reverse(so_far))) | ||
| 982 | - else read_string(connection,dead_line,[c . so_far],dos) | ||
| 983 | - }. | ||
| 984 | - | ||
| 985 | - | ||
| 986 | - | ||
| 987 | - | ||
| 988 | - | ||
| 989 | - | ||
| 990 | - | ||
| 991 | - | ||
| 992 | - | ||
| 993 | - | ||
| 994 | - | ||
| 995 | - | ||
| 996 | - *** [2.7] Converting web arguments to ASCII. | ||
| 997 | - | ||
| 998 | - The function 'web_to_ascii' gets a character string and replaces web encoding by normal | ||
| 999 | - ASCII encoding. This amounts to replacing: | ||
| 1000 | - | ||
| 1001 | - + by blank | ||
| 1002 | - %xx by the character whose ASCII code is xx in hexadecimal | ||
| 1003 | - | ||
| 1004 | - Note: We assume that '9' < 'A' (which is the case for ASCII code). | ||
| 1005 | - | ||
| 1006 | - | ||
| 1007 | - | ||
| 1008 | -define Word8 | ||
| 1009 | - web_decode | ||
| 1010 | - ( | ||
| 1011 | - Word8 x1, | ||
| 1012 | - Word8 x2 | ||
| 1013 | - ) = | ||
| 1014 | - with n1 = if x1 +=< '9' then (x1 - '0') else if x1 +=< 'F' then (x1 - 'A' + 10) else (x1 - 'a' + 10), | ||
| 1015 | - n2 = if x2 +=< '9' then (x2 - '0') else if x2 +=< 'F' then (x2 - 'A' + 10) else (x2 - 'a' + 10), | ||
| 1016 | - (n1 << 4) + n2. | ||
| 1017 | - | ||
| 1018 | - | ||
| 1019 | - | ||
| 1020 | -define String | ||
| 1021 | - web_to_ascii | ||
| 1022 | - ( | ||
| 1023 | - String web_string, | ||
| 1024 | - Int n, // current position in web_string | ||
| 1025 | - List(Word8) so_far | ||
| 1026 | - ) = | ||
| 1027 | - if nth(n,web_string) is | ||
| 1028 | - { | ||
| 1029 | - failure then implode(reverse(so_far)), | ||
| 1030 | - success(c) then | ||
| 1031 | - if c = '+' | ||
| 1032 | - then web_to_ascii(web_string,n+1,[' ' . so_far]) | ||
| 1033 | - else if c = '%' | ||
| 1034 | - then if nth(n+1,web_string) is | ||
| 1035 | - { | ||
| 1036 | - failure then implode(reverse(so_far)), | ||
| 1037 | - success(x1) then if nth(n+2,web_string) is | ||
| 1038 | - { | ||
| 1039 | - failure then implode(reverse(so_far)), | ||
| 1040 | - success(x2) then web_to_ascii(web_string,n+3,[web_decode(x1,x2) . so_far]) | ||
| 1041 | - } | ||
| 1042 | - } | ||
| 1043 | - else web_to_ascii(web_string,n+1,[c . so_far]) | ||
| 1044 | - }. | ||
| 1045 | - | ||
| 1046 | - | ||
| 1047 | - | ||
| 1048 | - | ||
| 1049 | - | ||
| 1050 | - | ||
| 1051 | - | ||
| 1052 | - | ||
| 1053 | - *** [3] Managing the journal. | ||
| 1054 | - | ||
| 1055 | - Concurrently working machines should not try to access the same file at the same | ||
| 1056 | - time. This problem may be solved by using the 'protect' mecanism. | ||
| 1057 | - | ||
| 1058 | - | ||
| 1059 | - | ||
| 1060 | - *** [3.1] Naming journal files. | ||
| 1061 | - | ||
| 1062 | - Since journal messages are rather prolific, we should have at least one file per | ||
| 1063 | - hour. Hence, the name of a journal file must be constructed from the current year, | ||
| 1064 | - month, day and hour. For example, it may be: | ||
| 1065 | - | ||
| 1066 | - 2003_03_12_19 | ||
| 1067 | - | ||
| 1068 | - (this is for the journal of 7 PM to 8 PM, 2003/mar/12). | ||
| 1069 | - | ||
| 1070 | -define String | ||
| 1071 | - make_current_journal_file_name | ||
| 1072 | - = | ||
| 1073 | - if convert_time(now) is date_and_time(y,m,d,h,_,_,_,_,_) then | ||
| 1074 | - to_decimal(y)+"_"+ | ||
| 1075 | - zero_pad_n(2,m)+"_"+ | ||
| 1076 | - zero_pad_n(2,d)+"_"+ | ||
| 1077 | - zero_pad_n(2,h). | ||
| 1078 | - | ||
| 1079 | - | ||
| 1080 | - | ||
| 1081 | - | ||
| 1082 | - | ||
| 1083 | - | ||
| 1084 | - | ||
| 1085 | - *** [3.2] Formating HTTP headers. | ||
| 1086 | - | ||
| 1087 | - HTTP headers may be shown on the console or written in the journal. The function below | ||
| 1088 | - formats a list of HTTP headers. | ||
| 1089 | - | ||
| 1090 | -define String | ||
| 1091 | - show_format | ||
| 1092 | - ( | ||
| 1093 | - Web_Site_Description desc, | ||
| 1094 | - List(HTTP_header) headers, | ||
| 1095 | - ) = | ||
| 1096 | - if headers is | ||
| 1097 | - { | ||
| 1098 | - [ ] then "", | ||
| 1099 | - [h . t] then if h is http_header(name,value) then | ||
| 1100 | - if member(journal_headers(desc),name) | ||
| 1101 | - then " | "+name+": "+value+"\n"+show_format(desc,t) | ||
| 1102 | - else show_format(desc,t) | ||
| 1103 | - }. | ||
| 1104 | - | ||
| 1105 | - | ||
| 1106 | - | ||
| 1107 | - | ||
| 1108 | - | ||
| 1109 | - | ||
| 1110 | - *** [3.3] Formating web arguments. | ||
| 1111 | - | ||
| 1112 | - The same thing for web arguments. | ||
| 1113 | - | ||
| 1114 | -define String | ||
| 1115 | - show_format | ||
| 1116 | - ( | ||
| 1117 | - List(Web_arg) lwa | ||
| 1118 | - ) = | ||
| 1119 | - if lwa is | ||
| 1120 | - { | ||
| 1121 | - [ ] then "", | ||
| 1122 | - [h . t] then if h is | ||
| 1123 | - { | ||
| 1124 | - web_arg(n,v) then | ||
| 1125 | - " | "+n+"="+(if nth(0,n) = success('p') then "<not shown>" else v)+"\n"+show_format(t), | ||
| 1126 | - upload(n,fn,tfn) then | ||
| 1127 | - " | "+n+"="+fn+" (uploaded as '"+tfn+"')\n"+show_format(t) | ||
| 1128 | - } | ||
| 1129 | - }. | ||
| 1130 | - | ||
| 1131 | - | ||
| 1132 | - | ||
| 1133 | - | ||
| 1134 | - | ||
| 1135 | - | ||
| 1136 | - *** [3.4] Formating the whole request. | ||
| 1137 | - | ||
| 1138 | - It is cheap to transform month numbers into abbreviated month names. This enhances the | ||
| 1139 | - readability of the journal. | ||
| 1140 | - | ||
| 1141 | -define String | ||
| 1142 | - format_month | ||
| 1143 | - ( | ||
| 1144 | - Int m | ||
| 1145 | - ) = | ||
| 1146 | - if m = 1 then "jan" else | ||
| 1147 | - if m = 2 then "feb" else | ||
| 1148 | - if m = 3 then "mar" else | ||
| 1149 | - if m = 4 then "apr" else | ||
| 1150 | - if m = 5 then "may" else | ||
| 1151 | - if m = 6 then "jun" else | ||
| 1152 | - if m = 7 then "jul" else | ||
| 1153 | - if m = 8 then "aug" else | ||
| 1154 | - if m = 9 then "sep" else | ||
| 1155 | - if m = 10 then "oct" else | ||
| 1156 | - if m = 11 then "nov" else | ||
| 1157 | - if m = 12 then "dec" else | ||
| 1158 | - "???". | ||
| 1159 | - | ||
| 1160 | - | ||
| 1161 | - Below we format a whole HTTP request. This may give this (actually, it depends on how | ||
| 1162 | - you defined the values of 'journal_headers' and 'journal_extensions'): | ||
| 1163 | - | ||
| 1164 | - [3] 2003/mar/10 10:06:57 from 123.456.123.456: /homepage.awp | ||
| 1165 | - | host: www.the-best-one.com | ||
| 1166 | - | user-agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0 | ||
| 1167 | - | ||
| 1168 | - The leading number between brackets is the number of the virtual machine which served | ||
| 1169 | - the URI. | ||
| 1170 | - | ||
| 1171 | -define String | ||
| 1172 | - format_request | ||
| 1173 | - ( | ||
| 1174 | - Web_Site_Description desc, | ||
| 1175 | - Connection client_connection, | ||
| 1176 | - HTTP_RequestLine request_line, | ||
| 1177 | - List(HTTP_header) headers, | ||
| 1178 | - List(Web_arg) web_args | ||
| 1179 | - ) = | ||
| 1180 | - with dt = convert_time(now), | ||
| 1181 | - if remote_IP_address_and_port(client_connection) is (addr,port) then | ||
| 1182 | - to_decimal(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_n(2,day(dt))+" "+ | ||
| 1183 | - zero_pad_n(2,hour(dt))+":"+zero_pad_n(2,minute(dt))+":"+zero_pad_n(2,second(dt))+ | ||
| 1184 | - " from "+ip_addr_to_string(addr)+ | ||
| 1185 | - ": "+uri(request_line)+"\n"+ | ||
| 1186 | - show_format(desc,headers)+ | ||
| 1187 | - show_format(web_args). | ||
| 1188 | - | ||
| 1189 | - | ||
| 1190 | - | ||
| 1191 | - | ||
| 1192 | - | ||
| 1193 | - | ||
| 1194 | - | ||
| 1195 | - *** [3.5] Putting it in the journal file (and on the console). | ||
| 1196 | - | ||
| 1197 | - We must not forget to 'protect' this operation, so that the messages of two machines | ||
| 1198 | - (working for the same site) will not be mixed together. | ||
| 1199 | - | ||
| 1200 | -define One | ||
| 1201 | - log_journal_msg | ||
| 1202 | - ( | ||
| 1203 | - Web_Site_Description desc, | ||
| 1204 | - String msg, | ||
| 1205 | - ) = | ||
| 1206 | - with ba_msg = to_byte_array("["+virtual_machine_id+"] "+msg+"\n"), | ||
| 1207 | - protect | ||
| 1208 | - ( | ||
| 1209 | - if file(site_directory(desc)+"/journal/"+make_current_journal_file_name,append) is | ||
| 1210 | - { | ||
| 1211 | - failure then unique, | ||
| 1212 | - success(journal_file) then | ||
| 1213 | - forget(reliable_write(file(journal_file),ba_msg)) | ||
| 1214 | - }; | ||
| 1215 | - forget(reliable_write(file(stdout),ba_msg)) | ||
| 1216 | - ). | ||
| 1217 | - | ||
| 1218 | - | ||
| 1219 | - | ||
| 1220 | - | ||
| 1221 | - | ||
| 1222 | - | ||
| 1223 | - | ||
| 1224 | - *** [4] Reading the HTTP request. | ||
| 1225 | - | ||
| 1226 | - | ||
| 1227 | - *** [4.1] Skipping leading blanks. | ||
| 1228 | - | ||
| 1229 | - One of the peculiarities of HTTP is that the characters 13 (carriage return) and 10 | ||
| 1230 | - (line feed) followed by either a space (32) or a tab (9), is considered as a blank not | ||
| 1231 | - containing any new line. 'skip_http_blanks' must skip all blanks characters until the | ||
| 1232 | - first non blank character, which should not be read in. Obviously, because of the above | ||
| 1233 | - peculiarity, we need at least 3 characters of lookahead to do this. In other words, we | ||
| 1234 | - must be able to unput at least 3 characters (hopefully we are). | ||
| 1235 | - | ||
| 1236 | - Strictly blanks characters are 'space' and 'tab'. | ||
| 1237 | - | ||
| 1238 | -define Bool | ||
| 1239 | - is_strict_blank | ||
| 1240 | - ( | ||
| 1241 | - Word8 c | ||
| 1242 | - ) = | ||
| 1243 | - if c = ' ' then true else c = '\t'. | ||
| 1244 | - | ||
| 1245 | - | ||
| 1246 | - On the contrary, blanks include 13 and 10. | ||
| 1247 | - | ||
| 1248 | -define Bool | ||
| 1249 | - is_blank | ||
| 1250 | - ( | ||
| 1251 | - Word8 c | ||
| 1252 | - ) = | ||
| 1253 | - if c = ' ' then true else | ||
| 1254 | - if c = '\t' then true else | ||
| 1255 | - if c = 13 then true else | ||
| 1256 | - c = 10. | ||
| 1257 | - | ||
| 1258 | - | ||
| 1259 | - Skipping HTTP blanks. | ||
| 1260 | - | ||
| 1261 | -define Result(Error,One) | ||
| 1262 | - skip_http_blanks | ||
| 1263 | - ( | ||
| 1264 | - BufferedConnection connection, | ||
| 1265 | - Int dead_line, | ||
| 1266 | - DenialOfService dos | ||
| 1267 | - ) = | ||
| 1268 | - if next_char(connection,dead_line,dos) is | ||
| 1269 | - { | ||
| 1270 | - error(msg) then error(msg), | ||
| 1271 | - ok(c) then | ||
| 1272 | - if is_strict_blank(c) | ||
| 1273 | - then skip_http_blanks(connection,dead_line,dos) | ||
| 1274 | - else if c = 13 | ||
| 1275 | - then if next_char(connection,dead_line,dos) is | ||
| 1276 | - { | ||
| 1277 | - error(msg) then error(msg), // (unput(c); ok(unique)), | ||
| 1278 | - ok(d) then | ||
| 1279 | - if d = 10 | ||
| 1280 | - then if next_char(connection,dead_line,dos) is | ||
| 1281 | - { | ||
| 1282 | - error(msg) then error(msg), // (unput(d); unput(c); ok(unique)), | ||
| 1283 | - ok(e) then | ||
| 1284 | - if is_strict_blank(e) | ||
| 1285 | - then skip_http_blanks(connection,dead_line,dos) | ||
| 1286 | - else (unput(e); unput(d); unput(c); ok(unique)) | ||
| 1287 | - } | ||
| 1288 | - else (unput(d); unput(c); ok(unique)) | ||
| 1289 | - } | ||
| 1290 | - else (unput(c); ok(unique)) | ||
| 1291 | - }. | ||
| 1292 | - | ||
| 1293 | - | ||
| 1294 | - | ||
| 1295 | - | ||
| 1296 | - | ||
| 1297 | - | ||
| 1298 | - | ||
| 1299 | - | ||
| 1300 | - *** [4.2] Reading a new line. | ||
| 1301 | - | ||
| 1302 | - Normally in HTTP a new line is the sequence 13 10 (carriage return line feed), not | ||
| 1303 | - followed by a space or tabulator. If it is followed by a space or tabulator, the three | ||
| 1304 | - characters are considered blanks, and no new line has been read. Before trying to read | ||
| 1305 | - a new line, we first skip leading spaces and tabs. Then we try to read 13 and 10, and | ||
| 1306 | - we read another character. if this character is space or tab, we consider we have read | ||
| 1307 | - only blanks and we continue reading in order to find our new line. Otherwise, we unput | ||
| 1308 | - this character (which may be for example the first character of the name of the next | ||
| 1309 | - header), and answer that we have seen a new line. | ||
| 1310 | - | ||
| 1311 | - Warning: we must not use this function for reading the last pair (13,10) before the | ||
| 1312 | - beginning of the body, because if the body is empty, there is no character to read | ||
| 1313 | - after this pair, so that the server could wait for a character which will never | ||
| 1314 | - come. This is the reason for 'read_and_ignore' above, which is used precisely for | ||
| 1315 | - reading that last (13,10) pair. | ||
| 1316 | - | ||
| 1317 | -define Result(Error,One) | ||
| 1318 | - read_new_line | ||
| 1319 | - ( | ||
| 1320 | - BufferedConnection connection, | ||
| 1321 | - Int dead_line, | ||
| 1322 | - DenialOfService dos | ||
| 1323 | - ) = | ||
| 1324 | - if skip_http_blanks(connection,dead_line,dos) is | ||
| 1325 | - { | ||
| 1326 | - error(msg) then error(msg), | ||
| 1327 | - ok(_) then | ||
| 1328 | - if next_char(connection,dead_line,dos) is | ||
| 1329 | - { | ||
| 1330 | - error(msg) then error(msg), | ||
| 1331 | - ok(c) then | ||
| 1332 | - if c = 13 | ||
| 1333 | - then if next_char(connection,dead_line,dos) is | ||
| 1334 | - { | ||
| 1335 | - error(msg) then error(msg), | ||
| 1336 | - ok(d) then | ||
| 1337 | - if d = 10 | ||
| 1338 | - then ok(unique) | ||
| 1339 | - else (unput(d); | ||
| 1340 | - unput(c); | ||
| 1341 | - error(end_of_line_expected)) | ||
| 1342 | - } | ||
| 1343 | - else (unput(c); | ||
| 1344 | - error(end_of_line_expected)) | ||
| 1345 | - }}. | ||
| 1346 | - | ||
| 1347 | - | ||
| 1348 | - | ||
| 1349 | - | ||
| 1350 | - | ||
| 1351 | - | ||
| 1352 | - | ||
| 1353 | - | ||
| 1354 | - *** [4.3] Reading a 'word'. | ||
| 1355 | - | ||
| 1356 | - A 'word' is a sequence of characters which begins either by a double quote or not by a | ||
| 1357 | - double quote. (However, any leading blanks are read in and ignored. This is | ||
| 1358 | - accomplished by 'skip_http_blanks'.) If it begins by a double quote, it is read like a | ||
| 1359 | - string, i.e. it ends at the next (non backslashed) double quote. Otherwise, it is | ||
| 1360 | - right delimited by any character which may be considered as 'blank'. If the word is | ||
| 1361 | - double quoted, the closing double quote is read in. On the contrary, if the word is not | ||
| 1362 | - double quoted, the right delimiting blank character is not read in (it is 'unput' back | ||
| 1363 | - into the connection), and may be read in again. This is needed because carriage return | ||
| 1364 | - or line feed which are 'blank', also have a meaning in HTTP. | ||
| 1365 | - | ||
| 1366 | -define Result(Error,String) | ||
| 1367 | - read_word_aux | ||
| 1368 | - ( | ||
| 1369 | - BufferedConnection connection, | ||
| 1370 | - Int dead_line, | ||
| 1371 | - List(Word8) so_far, | ||
| 1372 | - DenialOfService dos | ||
| 1373 | - ) = | ||
| 1374 | - if next_char(connection,dead_line,dos) is | ||
| 1375 | - { | ||
| 1376 | - error(msg) then error(msg), | ||
| 1377 | - ok(c) then | ||
| 1378 | - if is_blank(c) | ||
| 1379 | - then (unput(c); | ||
| 1380 | - ok(implode(reverse(so_far)))) | ||
| 1381 | - else read_word_aux(connection,dead_line,[c . so_far],dos) | ||
| 1382 | - }. | ||
| 1383 | - | ||
| 1384 | -define Result(Error,String) | ||
| 1385 | - read_word | ||
| 1386 | - ( | ||
| 1387 | - BufferedConnection connection, | ||
| 1388 | - Int dead_line, | ||
| 1389 | - DenialOfService dos | ||
| 1390 | - ) = | ||
| 1391 | - if skip_http_blanks(connection,dead_line,dos) is | ||
| 1392 | - { | ||
| 1393 | - error(msg) then error(msg), | ||
| 1394 | - ok(_) then | ||
| 1395 | - if next_char(connection,dead_line,dos) is | ||
| 1396 | - { | ||
| 1397 | - error(msg) then error(msg), | ||
| 1398 | - ok(c) then | ||
| 1399 | - if c = '\"' | ||
| 1400 | - then read_string(connection,dead_line,[],dos) | ||
| 1401 | - else read_word_aux(connection,dead_line,[c],dos) | ||
| 1402 | - } | ||
| 1403 | - }. | ||
| 1404 | - | ||
| 1405 | - | ||
| 1406 | - | ||
| 1407 | - | ||
| 1408 | - | ||
| 1409 | - | ||
| 1410 | - | ||
| 1411 | - | ||
| 1412 | - *** [4.4] Separating the URI from the query string. | ||
| 1413 | - | ||
| 1414 | - A 'query string' may be postfixed to the URI, just after a question mark. For example, | ||
| 1415 | - the client may send the following request: | ||
| 1416 | - | ||
| 1417 | - GET /catalog.awp?item=3&color=blue | ||
| 1418 | - | ||
| 1419 | - We separate this into an URI: "/catalog.awp" and the string: "item=3&color=blue" which | ||
| 1420 | - will be later transformed into the list: | ||
| 1421 | - | ||
| 1422 | - [web_arg("item","3"),web_arg("color","blue")] | ||
| 1423 | - | ||
| 1424 | - | ||
| 1425 | -define (String,String) | ||
| 1426 | - separate_uri_from_query_string | ||
| 1427 | - ( | ||
| 1428 | - String uri_and_query_string, | ||
| 1429 | - Int n | ||
| 1430 | - ) = | ||
| 1431 | - if nth(n,uri_and_query_string) is | ||
| 1432 | - { | ||
| 1433 | - failure then (uri_and_query_string,""), | ||
| 1434 | - success(c) then | ||
| 1435 | - if c = '?' | ||
| 1436 | - then (substr(uri_and_query_string,0,n), | ||
| 1437 | - substr(uri_and_query_string,n+1,length(uri_and_query_string)-(n+1))) | ||
| 1438 | - else separate_uri_from_query_string(uri_and_query_string,n+1) | ||
| 1439 | - }. | ||
| 1440 | - | ||
| 1441 | - | ||
| 1442 | - | ||
| 1443 | - | ||
| 1444 | - | ||
| 1445 | - | ||
| 1446 | - | ||
| 1447 | - | ||
| 1448 | - | ||
| 1449 | - *** [4.5] Reading the web arguments. | ||
| 1450 | - | ||
| 1451 | - HTTP/HTTPS requests are sent in one of two formats: | ||
| 1452 | - | ||
| 1453 | - (1) www-url encoded | ||
| 1454 | - (2) multipart/form-data encoded | ||
| 1455 | - | ||
| 1456 | - The first one is the normal (historical) way of encoding. The second one is required | ||
| 1457 | - for uploading files. A server which is supposed to accept upload of files must handle | ||
| 1458 | - both formats. The first thing to do is to decide the format of the request. This is | ||
| 1459 | - easily done by examining the HTTP headers. If we find the header: | ||
| 1460 | - | ||
| 1461 | - Content-Type: multipart/form-data | ||
| 1462 | - | ||
| 1463 | - the request is multipart/form-data encoded. Otherwise, it is 'www-url' encoded. We | ||
| 1464 | - first consider 'www-url' encoded requests. | ||
| 1465 | - | ||
| 1466 | - For a 'www-url' encoded request, the web argument are either in the query string or in | ||
| 1467 | - the body of the request, or both. The format is the same for both: | ||
| 1468 | - | ||
| 1469 | - name=value&name=value&... | ||
| 1470 | - | ||
| 1471 | - However, we may also have | ||
| 1472 | - | ||
| 1473 | - name | ||
| 1474 | - name= | ||
| 1475 | - name=&... | ||
| 1476 | - name&... | ||
| 1477 | - | ||
| 1478 | - i.e. some parts may be missing. Hence, we must be careful. | ||
| 1479 | - | ||
| 1480 | - Furthermore, web arguments must be translated from web to ASCII when www-url encoded. | ||
| 1481 | - | ||
| 1482 | -define Bool | ||
| 1483 | - is_ampersand_or_equal | ||
| 1484 | - ( | ||
| 1485 | - Word8 c | ||
| 1486 | - ) = | ||
| 1487 | - if c = '&' then true else c = '='. | ||
| 1488 | - | ||
| 1489 | - | ||
| 1490 | - | ||
| 1491 | - The function 'read_name_or_value' reads the string 's' starting at position 'n' until | ||
| 1492 | - either the end of the string or the first '&' or '='. | ||
| 1493 | - | ||
| 1494 | -define String | ||
| 1495 | - read_name_or_value | ||
| 1496 | - ( | ||
| 1497 | - String s, | ||
| 1498 | - Int start, | ||
| 1499 | - Int i | ||
| 1500 | - ) = | ||
| 1501 | - if nth(i,s) is | ||
| 1502 | - { | ||
| 1503 | - failure then substr(s,start,i - start), | ||
| 1504 | - success(c) then | ||
| 1505 | - if is_ampersand_or_equal(c) | ||
| 1506 | - then substr(s,start,i-start) // the separator is not included | ||
| 1507 | - else read_name_or_value(s,start,i+1) | ||
| 1508 | - }. | ||
| 1509 | - | ||
| 1510 | - | ||
| 1511 | -define List(Web_arg) | ||
| 1512 | - read_www_url_encoded_web_args | ||
| 1513 | - ( | ||
| 1514 | - String s, | ||
| 1515 | - Int start, | ||
| 1516 | - ) = | ||
| 1517 | - with first = read_name_or_value(s,start,start), | ||
| 1518 | - if first = "" | ||
| 1519 | - then [] | ||
| 1520 | - else with i = start+length(first), | ||
| 1521 | - if nth(i,s) is | ||
| 1522 | - { | ||
| 1523 | - failure then [web_arg(first,"")], | ||
| 1524 | - success(c) then | ||
| 1525 | - if c = '&' | ||
| 1526 | - then [web_arg(first,"") . read_www_url_encoded_web_args(s,i+1)] | ||
| 1527 | - else if c = '=' | ||
| 1528 | - then with second1 = read_name_or_value(s,i+1,i+1), | ||
| 1529 | - // print("\""+second1+"\"\n"); | ||
| 1530 | - with second = web_to_ascii(second1,0,[]), | ||
| 1531 | - [web_arg(first,second) . read_www_url_encoded_web_args(s,i+length(second1)+2)] | ||
| 1532 | - else print("**** ALERT **** badly formatted argument [" + s + "]!!!\n"); | ||
| 1533 | - [] | ||
| 1534 | - }. | ||
| 1535 | - | ||
| 1536 | - | ||
| 1537 | - | ||
| 1538 | - | ||
| 1539 | - | ||
| 1540 | - *** [4.7] Reading the request line. | ||
| 1541 | - | ||
| 1542 | - 'read_request_line' reads three words and a new line from the connection. It tries to | ||
| 1543 | - recognize "get" or "post" in the first word, separates the URI from the query string in | ||
| 1544 | - the second word, transforms the query string into a list of 'Web_arg', and finally | ||
| 1545 | - returns a datum of type 'HTTP_RequestLine' if no error arose. | ||
| 1546 | - | ||
| 1547 | - | ||
| 1548 | -define Result(Error,HTTP_RequestType) | ||
| 1549 | - identify_get_or_post | ||
| 1550 | - ( | ||
| 1551 | - String s | ||
| 1552 | - ) = | ||
| 1553 | - with ls = to_lower(s), | ||
| 1554 | - if ls = "get" then ok(get) else | ||
| 1555 | - if ls = "post" then ok(post) else | ||
| 1556 | - error(not_get_or_post_request(ls)). | ||
| 1557 | - | ||
| 1558 | -define Result(Error,HTTP_RequestLine) | ||
| 1559 | - read_request_line | ||
| 1560 | - ( | ||
| 1561 | - BufferedConnection connection, | ||
| 1562 | - Int dead_line, | ||
| 1563 | - DenialOfService dos | ||
| 1564 | - ) = | ||
| 1565 | - if read_word(connection,dead_line,dos) is | ||
| 1566 | - { | ||
| 1567 | - error(msg) then error(msg), | ||
| 1568 | - ok(get_or_post) then if read_word(connection,dead_line,dos) is | ||
| 1569 | - { | ||
| 1570 | - error(msg) then error(msg), | ||
| 1571 | - ok(uri_and_query_string) then if read_word(connection,dead_line,dos) is | ||
| 1572 | - { | ||
| 1573 | - error(msg) then error(msg), | ||
| 1574 | - ok(http_version) then if read_new_line(connection,dead_line,dos) is | ||
| 1575 | - { | ||
| 1576 | - error(msg) then error(msg), | ||
| 1577 | - ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is | ||
| 1578 | - (uri,query_string) then if identify_get_or_post(get_or_post) is | ||
| 1579 | - { | ||
| 1580 | - error(msg) then error(msg), | ||
| 1581 | - ok(request_type) then | ||
| 1582 | - ok(request_line(request_type, web_to_ascii(uri, 0, []), read_www_url_encoded_web_args(query_string,0))) | ||
| 1583 | - } | ||
| 1584 | - } | ||
| 1585 | - } | ||
| 1586 | - } | ||
| 1587 | - }. | ||
| 1588 | - | ||
| 1589 | - | ||
| 1590 | - | ||
| 1591 | - | ||
| 1592 | - | ||
| 1593 | - | ||
| 1594 | - | ||
| 1595 | - *** [4.8] Reading the HTTP headers. | ||
| 1596 | - | ||
| 1597 | - Each header is made of a name (containing only letters, the underscore, digits and the | ||
| 1598 | - minus sign), a colon, a value, and a new line. The first empty line ends the headers. | ||
| 1599 | - | ||
| 1600 | - | ||
| 1601 | - The next function tests characters acceptable in a header name. | ||
| 1602 | - | ||
| 1603 | -define Bool | ||
| 1604 | - is_header_name_char | ||
| 1605 | - ( | ||
| 1606 | - Word8 c | ||
| 1607 | - ) = | ||
| 1608 | - if ('a' +=< c & c +=< 'z') then true else | ||
| 1609 | - if ('A' +=< c & c +=< 'Z') then true else | ||
| 1610 | - if ('0' +=< c & c +=< '9') then true else | ||
| 1611 | - if c = '-' then true else | ||
| 1612 | - c = '_'. | ||
| 1613 | - | ||
| 1614 | -define Result(Error,String) | ||
| 1615 | - read_header_name | ||
| 1616 | - ( | ||
| 1617 | - BufferedConnection connection, | ||
| 1618 | - Int dead_line, | ||
| 1619 | - List(Word8) so_far, | ||
| 1620 | - DenialOfService dos | ||
| 1621 | - ) = | ||
| 1622 | - if next_char(connection,dead_line,dos) is | ||
| 1623 | - { | ||
| 1624 | - error(msg) then error(msg), | ||
| 1625 | - ok(c) then | ||
| 1626 | - if is_header_name_char(c) | ||
| 1627 | - then read_header_name(connection,dead_line,[to_lower(c) . so_far],dos) | ||
| 1628 | - else unput(c); ok(implode(reverse(so_far))) | ||
| 1629 | - }. | ||
| 1630 | - | ||
| 1631 | -define Result(Error,One) | ||
| 1632 | - skip_colon | ||
| 1633 | - ( | ||
| 1634 | - BufferedConnection connection, | ||
| 1635 | - Int dead_line, | ||
| 1636 | - DenialOfService dos | ||
| 1637 | - ) = | ||
| 1638 | - if skip_http_blanks(connection,dead_line,dos) is | ||
| 1639 | - { | ||
| 1640 | - error(msg) then error(msg), | ||
| 1641 | - ok(_) then | ||
| 1642 | - if next_char(connection,dead_line,dos) is | ||
| 1643 | - { | ||
| 1644 | - error(msg) then error(msg), | ||
| 1645 | - ok(c) then | ||
| 1646 | - if c = ':' | ||
| 1647 | - then ok(unique) | ||
| 1648 | - else error(colon_expected) | ||
| 1649 | - }}. | ||
| 1650 | - | ||
| 1651 | - | ||
| 1652 | -define Result(Error,String) | ||
| 1653 | - read_header_value | ||
| 1654 | - ( | ||
| 1655 | - BufferedConnection connection, | ||
| 1656 | - Int dead_line, | ||
| 1657 | - List(Word8) so_far, | ||
| 1658 | - DenialOfService dos | ||
| 1659 | - ) = | ||
| 1660 | - if next_char(connection,dead_line,dos) is | ||
| 1661 | - { | ||
| 1662 | - error(msg) then error(msg), | ||
| 1663 | - ok(c) then | ||
| 1664 | - if c = 13 | ||
| 1665 | - then if next_char(connection,dead_line,dos) is | ||
| 1666 | - { | ||
| 1667 | - error(msg) then error(msg), | ||
| 1668 | - ok(d) then | ||
| 1669 | - if d = 10 | ||
| 1670 | - then if next_char(connection,dead_line,dos) is | ||
| 1671 | - { | ||
| 1672 | - error(msg) then error(msg), | ||
| 1673 | - ok(e) then | ||
| 1674 | - if is_strict_blank(e) | ||
| 1675 | - then read_header_value(connection,dead_line,[e . so_far],dos) | ||
| 1676 | - else (unput(e); ok(implode(reverse(so_far)))) | ||
| 1677 | - } | ||
| 1678 | - else read_header_value(connection,dead_line,[d, c . so_far],dos) | ||
| 1679 | - } | ||
| 1680 | - else read_header_value(connection,dead_line,[c . so_far],dos) | ||
| 1681 | - }. | ||
| 1682 | - | ||
| 1683 | - | ||
| 1684 | - Reading a single header. | ||
| 1685 | - | ||
| 1686 | -define Result(Error,Maybe(HTTP_header)) | ||
| 1687 | - read_header | ||
| 1688 | - ( | ||
| 1689 | - BufferedConnection connection, | ||
| 1690 | - Int dead_line, | ||
| 1691 | - DenialOfService dos | ||
| 1692 | - ) = | ||
| 1693 | - if read_header_name(connection,dead_line,[],dos) is | ||
| 1694 | - { | ||
| 1695 | - error(msg) then error(msg), | ||
| 1696 | - ok(name) then | ||
| 1697 | - if name = "" then | ||
| 1698 | - if read_and_ignore(connection,dead_line,2,dos) /* 13 and 10 */ is | ||
| 1699 | - { | ||
| 1700 | - error(msg) then error(msg), | ||
| 1701 | - ok(_) then // this is the blank line | ||
| 1702 | - ok(failure) // end of headers | ||
| 1703 | - } | ||
| 1704 | - else if skip_colon(connection,dead_line,dos) is | ||
| 1705 | - { | ||
| 1706 | - error(msg) then error(msg), | ||
| 1707 | - ok(_) then if skip_http_blanks(connection,dead_line,dos) is | ||
| 1708 | - { | ||
| 1709 | - error(msg) then error(msg), | ||
| 1710 | - ok(_) then if read_header_value(connection,dead_line,[],dos) is | ||
| 1711 | - { | ||
| 1712 | - error(msg) then error(msg), | ||
| 1713 | - ok(value) then | ||
| 1714 | - ok(success(http_header(name,value))) | ||
| 1715 | - } | ||
| 1716 | - } | ||
| 1717 | - } | ||
| 1718 | - }. | ||
| 1719 | - | ||
| 1720 | - | ||
| 1721 | - | ||
| 1722 | - Reading all the headers. | ||
| 1723 | - | ||
| 1724 | -define Result(Error,List(HTTP_header)) | ||
| 1725 | - read_http_headers | ||
| 1726 | - ( | ||
| 1727 | - BufferedConnection connection, | ||
| 1728 | - Int dead_line, | ||
| 1729 | - DenialOfService dos | ||
| 1730 | - ) = | ||
| 1731 | - if read_header(connection,dead_line,dos) is | ||
| 1732 | - { | ||
| 1733 | - error(msg) then error(msg), | ||
| 1734 | - ok(mbh) then if mbh is | ||
| 1735 | - { | ||
| 1736 | - failure then ok([ ]), | ||
| 1737 | - success(header) then | ||
| 1738 | - if read_http_headers(connection,dead_line,dos) is | ||
| 1739 | - { | ||
| 1740 | - error(msg) then error(msg), | ||
| 1741 | - ok(others) then ok([header . others]) | ||
| 1742 | - } | ||
| 1743 | - } | ||
| 1744 | - }. | ||
| 1745 | - | ||
| 1746 | - | ||
| 1747 | - | ||
| 1748 | - | ||
| 1749 | - | ||
| 1750 | - | ||
| 1751 | - | ||
| 1752 | - *** [4.9] Getting the size of the request's body. | ||
| 1753 | - | ||
| 1754 | - The size of the body of the request is given under the 'Content-Length' header. If this | ||
| 1755 | - header is not present, the size is assumed to be zero. | ||
| 1756 | - | ||
| 1757 | -define Result(Error,Int) | ||
| 1758 | - get_body_size | ||
| 1759 | - ( | ||
| 1760 | - List(HTTP_header) headers | ||
| 1761 | - ) = | ||
| 1762 | - if headers is | ||
| 1763 | - { | ||
| 1764 | - [ ] then ok(0), | ||
| 1765 | - [h . t] then if h is http_header(name,value) then | ||
| 1766 | - if name = "content-length" | ||
| 1767 | - then if decimal_scan(value) is | ||
| 1768 | - { | ||
| 1769 | - failure then error(incorrect_content_length_value), | ||
| 1770 | - success(n) then ok(n) | ||
| 1771 | - } | ||
| 1772 | - else get_body_size(t) | ||
| 1773 | - }. | ||
| 1774 | - | ||
| 1775 | - | ||
| 1776 | - | ||
| 1777 | - | ||
| 1778 | - | ||
| 1779 | - | ||
| 1780 | - | ||
| 1781 | - | ||
| 1782 | - | ||
| 1783 | - | ||
| 1784 | - *** [4.10] Reading the body of the request. | ||
| 1785 | - | ||
| 1786 | - The body of the request may be very big (it contains uploaded files, if any). We read | ||
| 1787 | - it using the primitive 'read', which returns the number of bytes read, which may be | ||
| 1788 | - less than the number of bytes we wanted to read. This is not an error, but simply due | ||
| 1789 | - to the fact the buffer associated with the connection in the Linux (or MS-Windows) | ||
| 1790 | - kernel has a limited size. Hence, we must read bytes again until we have read the | ||
| 1791 | - required number of bytes. However, if the number of bytes read is zero, the connection | ||
| 1792 | - may be broken. In that case, we must not try to read indefinitely. On the contrary, we | ||
| 1793 | - make at most 10 retries, with a small sleeping time between any two of them. | ||
| 1794 | - | ||
| 1795 | -define Result(Error,ByteArray) | ||
| 1796 | - read_http_body | ||
| 1797 | - ( | ||
| 1798 | - BufferedConnection connection, | ||
| 1799 | - Int body_size, | ||
| 1800 | - ByteArray so_far, // when calling this function, 'so_far' is the empty byte array | ||
| 1801 | - Int retries // this function is called with retries = 10 | ||
| 1802 | - ) = | ||
| 1803 | - if body_size = 0 then ok(constant_byte_array(0,0)) else | ||
| 1804 | - if retries =< 0 then error(cannot_read_from_connection) else | ||
| 1805 | - if read_from_connexion(connection,body_size,60,constant_byte_array(body_size,0),0) is | ||
| 1806 | - { | ||
| 1807 | - error then error(cannot_read_from_connection), | ||
| 1808 | - timeout then error(timeout(60)), | ||
| 1809 | - ok(new_bytes) then with | ||
| 1810 | - ba = so_far + new_bytes, // contains all the bytes read so far | ||
| 1811 | - nr = length(ba), // total read since the beginning | ||
| 1812 | - nn = length(new_bytes), // number of bytes just read | ||
| 1813 | - if nr < body_size // must read more bytes | ||
| 1814 | - then if nn > 0 // if connection seems to work | ||
| 1815 | - then read_http_body(connection,body_size,ba,1000) // continue reading | ||
| 1816 | - else sleep(100); // otherwise, sleep 1/10 of second | ||
| 1817 | - read_http_body(connection,body_size,ba, // and retry reading | ||
| 1818 | - retries-1) // but no more than 10 times | ||
| 1819 | - else ok(ba) // required number of bytes has been read | ||
| 1820 | - }. | ||
| 1821 | - | ||
| 1822 | - | ||
| 1823 | - Note: During sleeping, 'anbexec' runs other machines. Actually, calling 'sleep', even | ||
| 1824 | - for one millisecond, is some way of giving up explicitly, so that other virtual | ||
| 1825 | - machines may work. | ||
| 1826 | - | ||
| 1827 | - | ||
| 1828 | - | ||
| 1829 | - | ||
| 1830 | - | ||
| 1831 | - | ||
| 1832 | - | ||
| 1833 | - | ||
| 1834 | - | ||
| 1835 | - | ||
| 1836 | - | ||
| 1837 | - | ||
| 1838 | - *** [5] Making the HTTP answer. | ||
| 1839 | - | ||
| 1840 | - At that point we have read the request line, the headers and the body of the | ||
| 1841 | - request, and we must decide what to do. | ||
| 1842 | - | ||
| 1843 | - Actually, we can do one of the following: | ||
| 1844 | - | ||
| 1845 | - - send a file, | ||
| 1846 | - - execute 'tickets_and_web_page' in case of an ".awp" URI. | ||
| 1847 | - | ||
| 1848 | - The uploaded file (which are in the body of the request) are saved into temporary files | ||
| 1849 | - below. | ||
| 1850 | - | ||
| 1851 | - | ||
| 1852 | - | ||
| 1853 | - | ||
| 1854 | - | ||
| 1855 | - *** [5.1] Avoiding illegal URIs. | ||
| 1856 | - | ||
| 1857 | - For security reasons, we must avoid illegal URIs, for example those which may climb up | ||
| 1858 | - in the file hierarchy. First we accept only few characters in URIs. | ||
| 1859 | - | ||
| 1860 | -define Bool | ||
| 1861 | - is_legal_uri_char | ||
| 1862 | - ( | ||
| 1863 | - Word8 c | ||
| 1864 | - ) = | ||
| 1865 | - if ('a' +=< c & c +=< 'z') then true else // accept 'a' to 'z' | ||
| 1866 | - if ('A' +=< c & c +=< 'Z') then true else // accept 'A' to 'Z' | ||
| 1867 | - if ('0' +=< c & c +=< '9') then true else // accept '0' to '9' | ||
| 1868 | - if c = '.' then true else // accept '.' '-' '/' and '_' | ||
| 1869 | - if c = '-' then true else | ||
| 1870 | - if c = '/' then true else | ||
| 1871 | - c = '_'. | ||
| 1872 | - | ||
| 1873 | - We do not accept ~ which is some way of climbing. Of course, we cannot disallow single | ||
| 1874 | - dots, which are most often present in legal URIs, but we must avoid double dots .. | ||
| 1875 | - which mean 'climb up'. | ||
| 1876 | - | ||
| 1877 | -define Bool | ||
| 1878 | - is_illegal_uri | ||
| 1879 | - ( | ||
| 1880 | - String uri, | ||
| 1881 | - Int n | ||
| 1882 | - ) = | ||
| 1883 | - if nth(n,uri) is | ||
| 1884 | - { | ||
| 1885 | - failure then false, | ||
| 1886 | - success(c) then | ||
| 1887 | - if c = '.' // first dot | ||
| 1888 | - then if nth(n+1,uri) is | ||
| 1889 | - { | ||
| 1890 | - failure then false, | ||
| 1891 | - success(d) then | ||
| 1892 | - if d = '.' // second dot | ||
| 1893 | - then true | ||
| 1894 | - else is_illegal_uri(uri,n+1) | ||
| 1895 | - } | ||
| 1896 | - else is_illegal_uri(uri,n+1) | ||
| 1897 | - }. | ||
| 1898 | - | ||
| 1899 | - | ||
| 1900 | - | ||
| 1901 | - | ||
| 1902 | - | ||
| 1903 | - | ||
| 1904 | - *** [5.2] Managing authorizations for downloading private files. | ||
| 1905 | - | ||
| 1906 | - Computing the authorization and making the authorization file (containing the absolute | ||
| 1907 | - path of the file on the server). | ||
| 1908 | - | ||
| 1909 | - | ||
| 1910 | -define String | ||
| 1911 | - compute_authorization | ||
| 1912 | - ( | ||
| 1913 | - String authorization_secret, | ||
| 1914 | - String absolute_path | ||
| 1915 | - ) = | ||
| 1916 | - to_ascii(sha1((authorization_secret, | ||
| 1917 | - absolute_path))). | ||
| 1918 | - | ||
| 1919 | - | ||
| 1920 | -public define String | ||
| 1921 | - make_authorization | ||
| 1922 | - ( | ||
| 1923 | - String site_directory, | ||
| 1924 | - String authorization_secret, | ||
| 1925 | - String absolute_path | ||
| 1926 | - ) = | ||
| 1927 | - with private_download_dir = site_directory+"/private_download", | ||
| 1928 | - auth = compute_authorization(authorization_secret, | ||
| 1929 | - absolute_path), | ||
| 1930 | - forget(save(absolute_path, | ||
| 1931 | - private_download_dir+"/z"+auth)); | ||
| 1932 | - auth. | ||
| 1933 | - | ||
| 1934 | - | ||
| 1935 | - The function 'send_file' defined below handles the recognition of authorizations. | ||
| 1936 | - | ||
| 1937 | - | ||
| 1938 | - | ||
| 1939 | - | ||
| 1940 | - | ||
| 1941 | - *** [5.3] Recognizing MIME types. | ||
| 1942 | - | ||
| 1943 | - The extension of the (redirected) URI must be either ".awp" or recognized as associated | ||
| 1944 | - to a MIME type. Otherwise, the server will not send the file. This is for security, but | ||
| 1945 | - also because, we must generate a 'Content-Type' header in the answer, with the right | ||
| 1946 | - MIME type. | ||
| 1947 | - | ||
| 1948 | -define String | ||
| 1949 | - get_uri_extension_aux | ||
| 1950 | - ( | ||
| 1951 | - String uri, | ||
| 1952 | - Int n // used for searching backwards | ||
| 1953 | - ) = | ||
| 1954 | - if nth(n,uri) is | ||
| 1955 | - { | ||
| 1956 | - failure then "", | ||
| 1957 | - success(c) then | ||
| 1958 | - if c = '.' then substr(uri,n,length(uri)-n) | ||
| 1959 | - else if c = '/' then "" | ||
| 1960 | - else get_uri_extension_aux(uri,n-1) | ||
| 1961 | - }. | ||
| 1962 | - | ||
| 1963 | -public define String | ||
| 1964 | - get_uri_extension | ||
| 1965 | - ( | ||
| 1966 | - String uri | ||
| 1967 | - ) = | ||
| 1968 | - get_uri_extension_aux(uri, | ||
| 1969 | - length(uri)-1). // search starts at the right end | ||
| 1970 | - | ||
| 1971 | -public define Bool | ||
| 1972 | - contains_no_case | ||
| 1973 | - ( | ||
| 1974 | - List(String) l, | ||
| 1975 | - String val | ||
| 1976 | - ) = | ||
| 1977 | - if l is | ||
| 1978 | - { | ||
| 1979 | - [] then false, | ||
| 1980 | - [h . t] then | ||
| 1981 | - if insensitive_equal(h, val) then true | ||
| 1982 | - else contains_no_case(t, val) | ||
| 1983 | - }. | ||
| 1984 | - | ||
| 1985 | - | ||
| 1986 | -define Maybe(MIME) | ||
| 1987 | - recognize_mime_type_from_ext | ||
| 1988 | - ( | ||
| 1989 | - String ext, | ||
| 1990 | - List(MIME) l | ||
| 1991 | - ) = | ||
| 1992 | - if l is | ||
| 1993 | - { | ||
| 1994 | - [ ] then success(mime("application", "octet-stream", [])), // failure, | ||
| 1995 | - [h . t] then if h is mime(type, subtype, extensions) then | ||
| 1996 | - if contains_no_case(extensions, ext) | ||
| 1997 | - then success(h) | ||
| 1998 | - else recognize_mime_type_from_ext(ext,t) | ||
| 1999 | - }. | ||
| 2000 | - | ||
| 2001 | -define Maybe(MIME) | ||
| 2002 | - recognize_mime_type_from_uri | ||
| 2003 | - ( | ||
| 2004 | - Web_Site_Description desc, | ||
| 2005 | - String uri | ||
| 2006 | - ) = | ||
| 2007 | - recognize_mime_type_from_ext(get_uri_extension(uri),known_mime_types(desc)). | ||
| 2008 | - | ||
| 2009 | - | ||
| 2010 | - | ||
| 2011 | - | ||
| 2012 | - | ||
| 2013 | - | ||
| 2014 | - | ||
| 2015 | - | ||
| 2016 | - *** [5.4] Formating HTTP headers. | ||
| 2017 | - | ||
| 2018 | - This is the formating for sending to the client (hence, it has nothing to do with the | ||
| 2019 | - component 'journal_headers' in the web site description). | ||
| 2020 | - | ||
| 2021 | -public define Printable_tree | ||
| 2022 | - format_headers | ||
| 2023 | - ( | ||
| 2024 | - List(HTTP_header) headers | ||
| 2025 | - ) = | ||
| 2026 | - if headers is | ||
| 2027 | - { | ||
| 2028 | - [ ] then [ ], | ||
| 2029 | - [h . t] then if h is http_header(name,value) then | ||
| 2030 | - [name,": ",value,crlf . format_headers(t)] | ||
| 2031 | - }. | ||
| 2032 | - | ||
| 2033 | - | ||
| 2034 | - | ||
| 2035 | -define String | ||
| 2036 | - month_abrv | ||
| 2037 | - ( | ||
| 2038 | - Date_and_Time d | ||
| 2039 | - ) = | ||
| 2040 | - if d.month = 1 then "Jan" | ||
| 2041 | - else if d.month = 2 then "Feb" | ||
| 2042 | - else if d.month = 3 then "Mar" | ||
| 2043 | - else if d.month = 4 then "Apr" | ||
| 2044 | - else if d.month = 5 then "May" | ||
| 2045 | - else if d.month = 6 then "Jun" | ||
| 2046 | - else if d.month = 7 then "Jul" | ||
| 2047 | - else if d.month = 8 then "Aug" | ||
| 2048 | - else if d.month = 9 then "Sep" | ||
| 2049 | - else if d.month = 10 then "Oct" | ||
| 2050 | - else if d.month = 11 then "Nov" | ||
| 2051 | - else if d.month = 12 then "Dec" | ||
| 2052 | - else | ||
| 2053 | - println("Bad month value [" + d.month + "] on Date_and_Time"); | ||
| 2054 | - "XXX". | ||
| 2055 | - | ||
| 2056 | -define String | ||
| 2057 | - weekday_abrv | ||
| 2058 | - ( | ||
| 2059 | - Date_and_Time d | ||
| 2060 | - ) = | ||
| 2061 | - if d.week_day = 0 then "Sun" | ||
| 2062 | - else if d.week_day = 1 then "Mon" | ||
| 2063 | - else if d.week_day = 2 then "Tue" | ||
| 2064 | - else if d.week_day = 3 then "Wed" | ||
| 2065 | - else if d.week_day = 4 then "Thu" | ||
| 2066 | - else if d.week_day = 5 then "Fri" | ||
| 2067 | - else if d.week_day = 6 then "Sat" | ||
| 2068 | - else | ||
| 2069 | - println("Bad weekday value [" + d.week_day + "] on Date_and_Time"); | ||
| 2070 | - "XXX". | ||
| 2071 | - | ||
| 2072 | -/** | ||
| 2073 | - * Format a date with the followin format : "Mon, 23 Jul 2007 11:33:43 GMT" | ||
| 2074 | - * Currently, this function can't output a GMT time, but only local time. | ||
| 2075 | - * So the final GMT is totally fake, but needed by protocol. | ||
| 2076 | - */ | ||
| 2077 | -public define String | ||
| 2078 | - format_http_date | ||
| 2079 | - ( | ||
| 2080 | - Date_and_Time d | ||
| 2081 | - ) = | ||
| 2082 | - weekday_abrv(d) + ", " + zero_pad_n(2,day(d)) + " " + month_abrv(d) + " " + year(d) | ||
| 2083 | - + " " + zero_pad_n(2,hour(d)) + ":" + zero_pad_n(2,minute(d)) + ":" + zero_pad_n(2,second(d)) + " GMT". | ||
| 2084 | - | ||
| 2085 | -/** | ||
| 2086 | - * Same as previous format_http_date() function, but with seconds count from the UNIX epoch as input. | ||
| 2087 | - */ | ||
| 2088 | -public define String | ||
| 2089 | - format_http_date | ||
| 2090 | - ( | ||
| 2091 | - Int date | ||
| 2092 | - ) = | ||
| 2093 | - format_http_date(convert_time(date)). | ||
| 2094 | - | ||
| 2095 | - | ||
| 2096 | - *** [5.5] Sending a file. | ||
| 2097 | - | ||
| 2098 | - We send 2 headers 'Content-Type' and 'Content-Length'. | ||
| 2099 | - | ||
| 2100 | -define List(HTTP_header) | ||
| 2101 | - headers_for_send_file | ||
| 2102 | - ( | ||
| 2103 | - MIME mime_type, | ||
| 2104 | - Int size, | ||
| 2105 | - String etag, | ||
| 2106 | - Maybe(FileTimes) mb_ftimes, | ||
| 2107 | - ) = | ||
| 2108 | - with headers = (List(HTTP_header)) | ||
| 2109 | - [ | ||
| 2110 | - http_header("Content-Type", to_String(mime_type)), | ||
| 2111 | - http_header("Etag", etag), | ||
| 2112 | - http_header("Content-Length",to_decimal(size)), | ||
| 2113 | - ], | ||
| 2114 | - if mb_ftimes is | ||
| 2115 | - { | ||
| 2116 | - failure then headers, | ||
| 2117 | - success(ftimes) then [http_header("Last-Modified", format_http_date(to_Int(ftimes.last_modified))) . headers] | ||
| 2118 | - } | ||
| 2119 | - . | ||
| 2120 | - | ||
| 2121 | - | ||
| 2122 | - | ||
| 2123 | - Sending the body of the answer (i.e. the file itself). | ||
| 2124 | - | ||
| 2125 | -define One | ||
| 2126 | - send_file_body | ||
| 2127 | - ( | ||
| 2128 | - Web_Site_Description desc, | ||
| 2129 | - Connection connection, // connection with the client | ||
| 2130 | - Connection file, // file to be sent already opened | ||
| 2131 | - Int size, // size of file | ||
| 2132 | - Int sent, // bytes already sent | ||
| 2133 | - String filename // name of file | ||
| 2134 | - ) = | ||
| 2135 | - if sent >= size then unique else | ||
| 2136 | - if read(file,min(16384,size-sent),60) is | ||
| 2137 | - { | ||
| 2138 | - error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"), | ||
| 2139 | - timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"), | ||
| 2140 | - ok(ba) then | ||
| 2141 | - with nr = length(ba), // get the number of bytes read | ||
| 2142 | - if reliable_write(connection, ba) is | ||
| 2143 | - { | ||
| 2144 | - failure then log_journal_msg(desc,"Cannot write into connection delirering '"+filename+"' (sent="+sent+"; size="+size+"; current="+nr+").\n"), | ||
| 2145 | - success(nw) then | ||
| 2146 | - send_file_body(desc,connection,file,size,sent+nw,filename) | ||
| 2147 | - } | ||
| 2148 | - }. | ||
| 2149 | - | ||
| 2150 | - | ||
| 2151 | -define String | ||
| 2152 | - compute_etag | ||
| 2153 | - ( | ||
| 2154 | - String filename, | ||
| 2155 | - Maybe(FileTimes) mb_ftimes, | ||
| 2156 | - Int size, | ||
| 2157 | - ) = | ||
| 2158 | - if mb_ftimes is | ||
| 2159 | - { | ||
| 2160 | - failure then println("Warning: no file times for '" + filename + "', etag won't be very accurate."); to_ascii(sha1((filename, size))), | ||
| 2161 | - success(ftimes) then to_ascii(md5((filename, ftimes, size))) | ||
| 2162 | - }. | ||
| 2163 | - | ||
| 2164 | -define Bool | ||
| 2165 | - are_same_etag | ||
| 2166 | - ( | ||
| 2167 | - Maybe(String) input_etag, | ||
| 2168 | - String current_etag | ||
| 2169 | - ) = | ||
| 2170 | - if input_etag is | ||
| 2171 | - { | ||
| 2172 | - failure then false, | ||
| 2173 | - success(etag) then etag = current_etag | ||
| 2174 | - }. | ||
| 2175 | - | ||
| 2176 | - Sending the answer line, the headers and the body. | ||
| 2177 | - | ||
| 2178 | -define One | ||
| 2179 | - send_file | ||
| 2180 | - ( | ||
| 2181 | - Web_Site_Description desc, | ||
| 2182 | - Connection connection, | ||
| 2183 | - List(HTTP_header) input_headers, | ||
| 2184 | - List(HTTP_header) headers, | ||
| 2185 | - Int size, | ||
| 2186 | - Connection file, | ||
| 2187 | - String filename, | ||
| 2188 | - String full_path, | ||
| 2189 | - MIME mime_type, | ||
| 2190 | - One -> One action_before_send_file | ||
| 2191 | - ) = | ||
| 2192 | - action_before_send_file(unique); | ||
| 2193 | - with input_etag = http_header_value(input_headers, "If-None-Match"), | ||
| 2194 | - mb_ftimes = get_file_times(full_path), | ||
| 2195 | - current_etag = compute_etag(full_path, mb_ftimes, size), | ||
| 2196 | - if are_same_etag(input_etag, current_etag) is | ||
| 2197 | - { | ||
| 2198 | - false then | ||
| 2199 | - forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf))); | ||
| 2200 | - forget(reliable_write(connection,[format_headers(headers + headers_for_send_file(mime_type, size, current_etag, mb_ftimes)) , crlf])); | ||
| 2201 | - //forget(copy_file_to_Connection(file, connection, size)), | ||
| 2202 | - send_file_body(desc,connection,file,size,0,filename), | ||
| 2203 | - true then | ||
| 2204 | - forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf))); | ||
| 2205 | - forget(reliable_write(connection,[format_headers([http_header("Etag", current_etag) . headers]) , crlf])) | ||
| 2206 | - //send_file_body(desc,connection,file,size,0,filename) | ||
| 2207 | - }. | ||
| 2208 | - | ||
| 2209 | - | ||
| 2210 | - | ||
| 2211 | - Checking if a connection is under SSL. | ||
| 2212 | - | ||
| 2213 | -define Bool | ||
| 2214 | - is_SSL | ||
| 2215 | - ( | ||
| 2216 | - Connection c | ||
| 2217 | - ) = | ||
| 2218 | - if c is | ||
| 2219 | - { | ||
| 2220 | - file_r(_) then false, | ||
| 2221 | - file_w(_) then false, | ||
| 2222 | - file_rw(_) then false, | ||
| 2223 | - tcp(_) then false, | ||
| 2224 | - ssl(_) then true | ||
| 2225 | - }. | ||
| 2226 | - | ||
| 2227 | - | ||
| 2228 | - | ||
| 2229 | - Before opening and sending a file, we check the MIME type. It must be recognized, | ||
| 2230 | - except if there is a valid authorization for private download. | ||
| 2231 | - | ||
| 2232 | -define One | ||
| 2233 | - send_file | ||
| 2234 | - ( | ||
| 2235 | - Web_Site_Description desc, | ||
| 2236 | - Connection connection, | ||
| 2237 | - String uri, | ||
| 2238 | - List(HTTP_header) input_headers, | ||
| 2239 | - List(HTTP_header) output_headers, | ||
| 2240 | - Maybe(String) mbauthorization, | ||
| 2241 | - One -> One action_before_send_file | ||
| 2242 | - ) = | ||
| 2243 | - if mbauthorization is | ||
| 2244 | - { | ||
| 2245 | - //--- file without authorization: take it from public --- | ||
| 2246 | - failure then if recognize_mime_type_from_uri(desc,uri) is | ||
| 2247 | - { | ||
| 2248 | - failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"), | ||
| 2249 | - success(mime_type) then | ||
| 2250 | - with path = site_directory(desc)+"/public"+uri, | ||
| 2251 | - if (Maybe(RStream))file(path, read) is | ||
| 2252 | - { | ||
| 2253 | - failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"), | ||
| 2254 | - success(f) then with size = file_size(f), | ||
| 2255 | - send_file(desc, | ||
| 2256 | - connection, | ||
| 2257 | - input_headers, | ||
| 2258 | - output_headers, | ||
| 2259 | - size, | ||
| 2260 | - file(f), | ||
| 2261 | - uri, | ||
| 2262 | - path, | ||
| 2263 | - mime_type, | ||
| 2264 | - action_before_send_file) | ||
| 2265 | - } | ||
| 2266 | - }, | ||
| 2267 | - | ||
| 2268 | - //--- file with authorization: apply 'private download' mecanism --- | ||
| 2269 | - success(authorization) then | ||
| 2270 | - with private_download_dir = site_directory(desc)+"/private_download", | ||
| 2271 | - if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization) | ||
| 2272 | - is ok(absolute_path) | ||
| 2273 | - then ( | ||
| 2274 | - with new_hash = compute_authorization(authorization_secret(desc), | ||
| 2275 | - absolute_path), | ||
| 2276 | - if (Maybe(RStream))connect to file absolute_path is | ||
| 2277 | - { | ||
| 2278 | - failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"), | ||
| 2279 | - success(f) then with size = file_size(f), | ||
| 2280 | - mime_type = if recognize_mime_type_from_uri(desc,uri) is | ||
| 2281 | - { | ||
| 2282 | - failure then mime("application", "octet-stream", []), | ||
| 2283 | - success(mime_type) then mime_type | ||
| 2284 | - }, | ||
| 2285 | - send_file(desc, | ||
| 2286 | - connection, | ||
| 2287 | - input_headers, | ||
| 2288 | - output_headers, | ||
| 2289 | - size, | ||
| 2290 | - file(f), | ||
| 2291 | - uri, | ||
| 2292 | - absolute_path, | ||
| 2293 | - mime_type, | ||
| 2294 | - action_before_send_file) | ||
| 2295 | - } | ||
| 2296 | - ) | ||
| 2297 | - else log_journal_msg(desc,"Cannot find or read authorization file.\n") | ||
| 2298 | - }. | ||
| 2299 | - | ||
| 2300 | - | ||
| 2301 | - | ||
| 2302 | - | ||
| 2303 | - | ||
| 2304 | - | ||
| 2305 | - | ||
| 2306 | - | ||
| 2307 | - *** [5.6] Answering a www-url encoded request. | ||
| 2308 | - | ||
| 2309 | - Standard headers are for answering ".awp" requests. | ||
| 2310 | - | ||
| 2311 | -public define List(HTTP_header) | ||
| 2312 | - standard_headers | ||
| 2313 | - = | ||
| 2314 | - [ | ||
| 2315 | - http_header("Date", format_http_date(now)), | ||
| 2316 | - http_header("Server", "Anubis Embedded Server v" + major_version_number + "." + minor_version_number), | ||
| 2317 | - http_header("Connection", "close"), | ||
| 2318 | - ]. | ||
| 2319 | - | ||
| 2320 | -public define List(HTTP_header) | ||
| 2321 | - standard_headers_for | ||
| 2322 | - ( | ||
| 2323 | - String mime_type, | ||
| 2324 | - Int answer_body_size, | ||
| 2325 | - Maybe(String) mb_charset, | ||
| 2326 | - ) = | ||
| 2327 | - [ | ||
| 2328 | - http_header("Content-Type", mime_type + if mb_charset is success(charset) then "; charset="+charset else ""), | ||
| 2329 | - http_header("Content-length", to_decimal(answer_body_size)) | ||
| 2330 | - ]. | ||
| 2331 | - | ||
| 2332 | -public define List(HTTP_header) | ||
| 2333 | - file_attached_header | ||
| 2334 | - ( | ||
| 2335 | - String filename | ||
| 2336 | - ) = | ||
| 2337 | - [ | ||
| 2338 | - http_header("Content-Disposition", "attachment; filename=\"" + filename +"\"") | ||
| 2339 | - ]. | ||
| 2340 | - | ||
| 2341 | - | ||
| 2342 | -define One | ||
| 2343 | - www_url_answer | ||
| 2344 | - ( | ||
| 2345 | - String host_name, | ||
| 2346 | - Web_Site_Description desc, | ||
| 2347 | - Connection connection, // with the client | ||
| 2348 | - Word32 ip_addr, // of the client | ||
| 2349 | - HTTP_RequestLine request_line, | ||
| 2350 | - List(HTTP_header) headers, | ||
| 2351 | - ByteArray body, | ||
| 2352 | - One -> String generate_tt // trust ticket generation | ||
| 2353 | - ) = | ||
| 2354 | - with all_web_args = query_string(request_line) + | ||
| 2355 | - read_www_url_encoded_web_args(to_string(body),0), | ||
| 2356 | - uri = uri(request_line), | ||
| 2357 | - ext = get_uri_extension(uri), | ||
| 2358 | - http_inf = http_info(ip_addr, host_name, uri, headers, is_SSL(connection), generate_tt), | ||
| 2359 | - (if member(journal_extensions(desc),ext) | ||
| 2360 | - then log_journal_msg(desc, | ||
| 2361 | - format_request(desc,connection,request_line,headers,all_web_args)) | ||
| 2362 | - else unique); | ||
| 2363 | - if is_illegal_uri(uri,0) | ||
| 2364 | - then log_journal_msg(desc,"Received illegal URI: "+uri+"\n") | ||
| 2365 | - else (if (ext = ".awp" | ext = "") | ||
| 2366 | - then (with answer_headers_body = awp_handler(desc)(host_name, | ||
| 2367 | - http_inf, | ||
| 2368 | - all_web_args, | ||
| 2369 | - is_SSL(connection)), | ||
| 2370 | - //print_delta("After page generation"); | ||
| 2371 | - forget(reliable_write(connection, answer_headers_body)) | ||
| 2372 | - //print_delta("After sending page") | ||
| 2373 | - ) | ||
| 2374 | - else (send_file(desc, | ||
| 2375 | - connection, | ||
| 2376 | - uri, | ||
| 2377 | - headers, | ||
| 2378 | - standard_headers, | ||
| 2379 | - if web_arg_value(all_web_args,"zauth") is | ||
| 2380 | - { | ||
| 2381 | - not_found then failure, | ||
| 2382 | - found(v) then success(v) | ||
| 2383 | - }, | ||
| 2384 | - (One u) |-> before_send_file(desc)(http_inf, all_web_args)) | ||
| 2385 | - //print_delta("After sending file") | ||
| 2386 | - )). | ||
| 2387 | - | ||
| 2388 | - | ||
| 2389 | - | ||
| 2390 | - | ||
| 2391 | - | ||
| 2392 | - | ||
| 2393 | - | ||
| 2394 | - *** [5.7] Answering a multipart/form-data encoded request. | ||
| 2395 | - | ||
| 2396 | - In order to support upload of files, we must be able to read web arguments which are | ||
| 2397 | - encoded in a multipart/form-data body. The first thing to do is to find the | ||
| 2398 | - boundary. The boundary is a special string which delimits the various parts of the | ||
| 2399 | - 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as | ||
| 2400 | - the value of the 'boundary' attribute. | ||
| 2401 | - | ||
| 2402 | - | ||
| 2403 | - | ||
| 2404 | - | ||
| 2405 | - | ||
| 2406 | - *** [5.7.1] Finding the boundary. | ||
| 2407 | - | ||
| 2408 | - Hence, we just have to find the string 'boundary=' within the value of the | ||
| 2409 | - 'Content-Type' header, and read the value of the boundary from there. | ||
| 2410 | - | ||
| 2411 | -define Bool | ||
| 2412 | - delimits_boundary | ||
| 2413 | - ( | ||
| 2414 | - Word8 c | ||
| 2415 | - ) = | ||
| 2416 | - if c = ' ' then true else | ||
| 2417 | - if c = 13 then true else | ||
| 2418 | - if c = 10 then true else | ||
| 2419 | - if c = 0 then true else | ||
| 2420 | - if c = ',' then true else | ||
| 2421 | - c = ';'. | ||
| 2422 | - | ||
| 2423 | - | ||
| 2424 | -define Maybe(String) | ||
| 2425 | - get_boundary_value_3 | ||
| 2426 | - ( | ||
| 2427 | - String s, | ||
| 2428 | - Int i, | ||
| 2429 | - List(Word8) so_far | ||
| 2430 | - ) = | ||
| 2431 | - if nth(i,s) is | ||
| 2432 | - { | ||
| 2433 | - failure then success(implode(reverse(so_far))), | ||
| 2434 | - success(c) then | ||
| 2435 | - if delimits_boundary(c) | ||
| 2436 | - then success(implode(reverse(so_far))) | ||
| 2437 | - else get_boundary_value_3(s,i+1,[c . so_far]) | ||
| 2438 | - }. | ||
| 2439 | - | ||
| 2440 | - | ||
| 2441 | - | ||
| 2442 | -define Maybe(String) | ||
| 2443 | - get_boundary_value_2 | ||
| 2444 | - ( | ||
| 2445 | - String s, | ||
| 2446 | - Int i, | ||
| 2447 | - ) = | ||
| 2448 | - if nth(i,s) is | ||
| 2449 | - { | ||
| 2450 | - failure then failure, | ||
| 2451 | - success(c) then | ||
| 2452 | - if is_blank(c) | ||
| 2453 | - then get_boundary_value_2(s,i+1) | ||
| 2454 | - else get_boundary_value_3(s,i+1,[c]) | ||
| 2455 | - }. | ||
| 2456 | - | ||
| 2457 | -define Maybe(String) | ||
| 2458 | - get_boundary_value_1 | ||
| 2459 | - ( | ||
| 2460 | - String s, // string into which we must find '= ...' | ||
| 2461 | - Int i // position of start of search | ||
| 2462 | - ) = | ||
| 2463 | - if nth(i,s) is | ||
| 2464 | - { | ||
| 2465 | - failure then failure, | ||
| 2466 | - success(c) then | ||
| 2467 | - if is_blank(c) | ||
| 2468 | - then get_boundary_value_1(s,i+1) | ||
| 2469 | - else if c = '=' | ||
| 2470 | - then get_boundary_value_2(s,i+1) | ||
| 2471 | - else failure | ||
| 2472 | - }. | ||
| 2473 | - | ||
| 2474 | - | ||
| 2475 | -define Maybe(String) | ||
| 2476 | - get_boundary | ||
| 2477 | - ( | ||
| 2478 | - String content_type_header_value | ||
| 2479 | - ) = | ||
| 2480 | - if find("boundary",content_type_header_value,0) is | ||
| 2481 | - { | ||
| 2482 | - failure then failure, | ||
| 2483 | - success(n) then // 'boundary' has been found at position n | ||
| 2484 | - get_boundary_value_1(content_type_header_value,n+8) | ||
| 2485 | - }. | ||
| 2486 | - | ||
| 2487 | -define Maybe(String) | ||
| 2488 | - get_boundary | ||
| 2489 | - ( | ||
| 2490 | - List(HTTP_header) headers | ||
| 2491 | - ) = | ||
| 2492 | - if headers is | ||
| 2493 | - { | ||
| 2494 | - [ ] then failure, | ||
| 2495 | - [h . t] then if h is http_header(name,value) then | ||
| 2496 | - if name = "content-type" | ||
| 2497 | - then get_boundary(value) | ||
| 2498 | - else get_boundary(t) | ||
| 2499 | - }. | ||
| 2500 | - | ||
| 2501 | - | ||
| 2502 | - | ||
| 2503 | - | ||
| 2504 | - | ||
| 2505 | - | ||
| 2506 | - | ||
| 2507 | - | ||
| 2508 | - *** [5.7.2] Reading attributes from a multipart entity. | ||
| 2509 | - | ||
| 2510 | - Entities in a multipart/form-data body are separated by instances of the string: | ||
| 2511 | - | ||
| 2512 | - --bbbbb | ||
| 2513 | - | ||
| 2514 | - where bbbbb is the boundary computed above. Actually, the body has the form: | ||
| 2515 | - | ||
| 2516 | - --bbbbb | ||
| 2517 | - <entity 1> | ||
| 2518 | - --bbbbb | ||
| 2519 | - <entity 2> | ||
| 2520 | - --bbbbb | ||
| 2521 | - ... | ||
| 2522 | - --bbbbb | ||
| 2523 | - <last entity> | ||
| 2524 | - --bbbbb | ||
| 2525 | - | ||
| 2526 | - | ||
| 2527 | - We have to extract an entity which is in the body between offsets 'start' and 'end' | ||
| 2528 | - (computed when boundaries have been localized). The entity itself is made of two parts: | ||
| 2529 | - headers and body. The body is separated from the headers by a blank line. This blank | ||
| 2530 | - line (a double crlf) marks the beginning of the body of the entity. Within the headers | ||
| 2531 | - of the entity, we look for a 'Content-Disposition' header, which should look like this: | ||
| 2532 | - | ||
| 2533 | - Content-Disposition: form-data; name="..."; filename="..." crlf | ||
| 2534 | - | ||
| 2535 | - We are just interested in the name and the file name. Hence we first search | ||
| 2536 | - 'Content-Disposition', then we search 'name' and read the value, and we do the same for | ||
| 2537 | - 'filename'. | ||
| 2538 | - | ||
| 2539 | - If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise, | ||
| 2540 | - it is an uploaded file. | ||
| 2541 | - | ||
| 2542 | - | ||
| 2543 | - Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end' | ||
| 2544 | - argument. | ||
| 2545 | - | ||
| 2546 | -define Maybe(Int) | ||
| 2547 | - find | ||
| 2548 | - ( | ||
| 2549 | - String what, | ||
| 2550 | - ByteArray where, | ||
| 2551 | - Int start, | ||
| 2552 | - Int end | ||
| 2553 | - ) = | ||
| 2554 | - if find(to_byte_array(what),where,start) is | ||
| 2555 | - { | ||
| 2556 | - failure then failure, | ||
| 2557 | - success(n) then | ||
| 2558 | - if n+length(what) >= end | ||
| 2559 | - then failure | ||
| 2560 | - else success(n) | ||
| 2561 | - }. | ||
| 2562 | - | ||
| 2563 | - | ||
| 2564 | -define String | ||
| 2565 | - read_attribute_value | ||
| 2566 | - ( | ||
| 2567 | - ByteArray where, | ||
| 2568 | - Int start, | ||
| 2569 | - Int end, | ||
| 2570 | - List(Word8) so_far | ||
| 2571 | - ) = | ||
| 2572 | - if start >= end then implode(reverse(so_far)) else | ||
| 2573 | - if nth(start,where) is | ||
| 2574 | - { | ||
| 2575 | - failure then implode(reverse(so_far)), | ||
| 2576 | - success(c) then | ||
| 2577 | - if c = '\"' | ||
| 2578 | - then implode(reverse(so_far)) | ||
| 2579 | - else read_attribute_value(where,start+1,end,[c . so_far]) | ||
| 2580 | - }. | ||
| 2581 | - | ||
| 2582 | -define Maybe(String) | ||
| 2583 | - find_attribute | ||
| 2584 | - ( | ||
| 2585 | - String name, | ||
| 2586 | - ByteArray where, | ||
| 2587 | - Int start, | ||
| 2588 | - Int end | ||
| 2589 | - ) = | ||
| 2590 | - with prefix = name+"=\"", | ||
| 2591 | - if find(to_byte_array(prefix),where,start) is | ||
| 2592 | - { | ||
| 2593 | - failure then failure, | ||
| 2594 | - success(n) then | ||
| 2595 | - if n+length(prefix) >= end | ||
| 2596 | - then failure | ||
| 2597 | - else success(read_attribute_value(where,n+length(prefix),end,[])) | ||
| 2598 | - }. | ||
| 2599 | - | ||
| 2600 | - | ||
| 2601 | - | ||
| 2602 | -define Maybe((String,Maybe(String))) | ||
| 2603 | - find_name_and_filename | ||
| 2604 | - ( | ||
| 2605 | - ByteArray body, | ||
| 2606 | - Int start, | ||
| 2607 | - Int end | ||
| 2608 | - ) = | ||
| 2609 | - if find(to_byte_array("Content-Disposition"),body,start) is | ||
| 2610 | - { | ||
| 2611 | - failure then failure, | ||
| 2612 | - success(n) then | ||
| 2613 | - if find_attribute("name",body,n+19,end) is | ||
| 2614 | - { | ||
| 2615 | - failure then failure, | ||
| 2616 | - success(name_value) then if find_attribute("filename",body,n+19,end) is | ||
| 2617 | - { | ||
| 2618 | - failure then success((name_value,failure)), | ||
| 2619 | - success(filename_value) then success((name_value,success(filename_value))) | ||
| 2620 | - } | ||
| 2621 | - } | ||
| 2622 | - }. | ||
| 2623 | - | ||
| 2624 | - | ||
| 2625 | - | ||
| 2626 | - | ||
| 2627 | - | ||
| 2628 | - | ||
| 2629 | - | ||
| 2630 | - | ||
| 2631 | - | ||
| 2632 | - | ||
| 2633 | - *** [5.7.3] Creating a temporary filename for an uploaded file. | ||
| 2634 | - | ||
| 2635 | -variable Int uploaded_file_count = 0. | ||
| 2636 | - | ||
| 2637 | - This variable is local to the virtual machine. Hence, its value is 0 each time a new | ||
| 2638 | - requests arrives. Temporary uploaded files are stored in the directory represented by | ||
| 2639 | - 'upload_temporary_directory'. The filenames have the form: | ||
| 2640 | - | ||
| 2641 | - _m_n | ||
| 2642 | - | ||
| 2643 | - where 'm' is the number of the virtual machine, and 'n' a number obtained by | ||
| 2644 | - incrementing 'uploaded_file_count'. Notice that the program must do something with this | ||
| 2645 | - file (move it to some directory/name), otherwise, it will probably be overwritten the | ||
| 2646 | - next time the same machine works. | ||
| 2647 | - | ||
| 2648 | - | ||
| 2649 | - | ||
| 2650 | - | ||
| 2651 | - | ||
| 2652 | - | ||
| 2653 | - *** [5.7.4] Saving an uploaded file under a temporary filename. | ||
| 2654 | - | ||
| 2655 | -define Maybe(String) // returns the temporary file name | ||
| 2656 | - save_uploaded_file | ||
| 2657 | - ( | ||
| 2658 | - Web_Site_Description desc, | ||
| 2659 | - ByteArray body, | ||
| 2660 | - Int start, | ||
| 2661 | - Int end | ||
| 2662 | - ) = | ||
| 2663 | - uploaded_file_count <- 1 + *uploaded_file_count; | ||
| 2664 | - with tfn = "_"+to_decimal(virtual_machine_id)+"_"+to_decimal(*uploaded_file_count), | ||
| 2665 | - if (Maybe(WStream))connect to file site_directory(desc)+"/upload_temporary/"+tfn is | ||
| 2666 | - { | ||
| 2667 | - failure then failure, | ||
| 2668 | - success(f) then | ||
| 2669 | - if reliable_write(file(f),extract(body,start,end)) is | ||
| 2670 | - { | ||
| 2671 | - failure then failure, | ||
| 2672 | - success(nw) then | ||
| 2673 | - if nw = end - start | ||
| 2674 | - then success(tfn) | ||
| 2675 | - else failure | ||
| 2676 | - } | ||
| 2677 | - }. | ||
| 2678 | - | ||
| 2679 | - | ||
| 2680 | - | ||
| 2681 | - | ||
| 2682 | - | ||
| 2683 | - | ||
| 2684 | - | ||
| 2685 | - | ||
| 2686 | - *** [5.7.5] Removing the path from a file name. | ||
| 2687 | - | ||
| 2688 | - When a file is uploaded, the browser sends the complete path of the file on the client | ||
| 2689 | - machine as the file name. Actually, this is not quite normal. Nevertheless, we need to | ||
| 2690 | - remove the path, and keep only the file name. This is achieved by 'remove_path' below. | ||
| 2691 | - | ||
| 2692 | -define Int | ||
| 2693 | - file_name_begin | ||
| 2694 | - ( | ||
| 2695 | - String full_name, | ||
| 2696 | - Int i | ||
| 2697 | - ) = | ||
| 2698 | - if nth(i,full_name) is | ||
| 2699 | - { | ||
| 2700 | - failure then 0, | ||
| 2701 | - success(c) then | ||
| 2702 | - if c = '/' then i+1 else | ||
| 2703 | - if c = '\\' then i+1 else | ||
| 2704 | - file_name_begin(full_name,i-1) | ||
| 2705 | - }. | ||
| 2706 | - | ||
| 2707 | -define String | ||
| 2708 | - remove_path | ||
| 2709 | - ( | ||
| 2710 | - String full_name | ||
| 2711 | - ) = | ||
| 2712 | - with l = length(full_name), | ||
| 2713 | - b = file_name_begin(full_name,l-1), | ||
| 2714 | - substr(full_name,b,l-b). | ||
| 2715 | - | ||
| 2716 | - | ||
| 2717 | - | ||
| 2718 | - | ||
| 2719 | - | ||
| 2720 | - *** [5.7.6] Reading a multipart entity. | ||
| 2721 | - | ||
| 2722 | -define Maybe(Web_arg) | ||
| 2723 | - get_multipart_entity | ||
| 2724 | - ( | ||
| 2725 | - Web_Site_Description desc, | ||
| 2726 | - ByteArray body, | ||
| 2727 | - Int start, | ||
| 2728 | - Int end | ||
| 2729 | - ) = | ||
| 2730 | - if find(to_byte_array(crlf+crlf),body,start) is | ||
| 2731 | - { | ||
| 2732 | - failure then failure, | ||
| 2733 | - success(k) then | ||
| 2734 | - if k >= end // must be within this entity, not the next one | ||
| 2735 | - then failure | ||
| 2736 | - else if find_name_and_filename(body,start,k) is | ||
| 2737 | - { | ||
| 2738 | - failure then failure, | ||
| 2739 | - success(n_mbfn) then if n_mbfn is (name,mbfn) then | ||
| 2740 | - if mbfn is | ||
| 2741 | - { | ||
| 2742 | - failure then | ||
| 2743 | - success(web_arg(name,to_string(extract(body,k+4,end-2)))), | ||
| 2744 | - // we must substract 2 to end because of crlf just before the boundary | ||
| 2745 | - | ||
| 2746 | - success(fn) then | ||
| 2747 | - if save_uploaded_file(desc,body,k+4,end-2) is | ||
| 2748 | - { | ||
| 2749 | - failure then failure, | ||
| 2750 | - success(tfn) then | ||
| 2751 | - success(upload(name,remove_path(fn), | ||
| 2752 | - site_directory(desc)+"/upload_temporary/"+tfn)) | ||
| 2753 | - | ||
| 2754 | - } | ||
| 2755 | - } | ||
| 2756 | - } | ||
| 2757 | - }. | ||
| 2758 | - | ||
| 2759 | - | ||
| 2760 | - | ||
| 2761 | -define List(Web_arg) | ||
| 2762 | - read_multipart_form_data_encoded_web_args | ||
| 2763 | - ( | ||
| 2764 | - Web_Site_Description desc, | ||
| 2765 | - ByteArray body, | ||
| 2766 | - ByteArray __boundary, | ||
| 2767 | - Int i, | ||
| 2768 | - ) = | ||
| 2769 | - if find(__boundary,body,i) is | ||
| 2770 | - { | ||
| 2771 | - failure then [ ], | ||
| 2772 | - success(n) then | ||
| 2773 | - if find(__boundary,body,n+length(__boundary)) is | ||
| 2774 | - { | ||
| 2775 | - failure then [ ], | ||
| 2776 | - success(m) then | ||
| 2777 | - if get_multipart_entity(desc,body,n+length(__boundary),m) is | ||
| 2778 | - { | ||
| 2779 | - failure then [ ], | ||
| 2780 | - success(wa) then | ||
| 2781 | - [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)] | ||
| 2782 | - } | ||
| 2783 | - } | ||
| 2784 | - }. | ||
| 2785 | - | ||
| 2786 | - | ||
| 2787 | - | ||
| 2788 | -define One | ||
| 2789 | - multipart_form_data_answer | ||
| 2790 | - ( | ||
| 2791 | - String host_name, | ||
| 2792 | - Web_Site_Description desc, | ||
| 2793 | - Connection connection, | ||
| 2794 | - Word32 ip_addr, | ||
| 2795 | - HTTP_RequestLine request_line, | ||
| 2796 | - List(HTTP_header) headers, | ||
| 2797 | - ByteArray body, | ||
| 2798 | - One -> String generate_tt | ||
| 2799 | - ) = | ||
| 2800 | - if get_boundary(headers) is | ||
| 2801 | - { | ||
| 2802 | - failure then unique, | ||
| 2803 | - success(boundary) then | ||
| 2804 | - with all_web_args = query_string(request_line) + | ||
| 2805 | - read_multipart_form_data_encoded_web_args(desc, | ||
| 2806 | - body, | ||
| 2807 | - to_byte_array("--"+boundary), | ||
| 2808 | - 0), | ||
| 2809 | - uri = uri(request_line), | ||
| 2810 | - ext = get_uri_extension(uri), | ||
| 2811 | - log_journal_msg(desc, | ||
| 2812 | - format_request(desc,connection,request_line,headers,all_web_args)); | ||
| 2813 | - if is_illegal_uri(uri,0) | ||
| 2814 | - then log_journal_msg(desc,"Received illegal URI: "+uri+"\n") | ||
| 2815 | - else | ||
| 2816 | - if (ext = ".awp" | ext = "") then | ||
| 2817 | - (with answer_headers_body = awp_handler(desc)(host_name, | ||
| 2818 | - http_info(ip_addr, host_name, uri, headers, is_SSL(connection), generate_tt), | ||
| 2819 | - all_web_args, | ||
| 2820 | - is_SSL(connection)), | ||
| 2821 | - forget(reliable_write(connection, answer_headers_body))) | ||
| 2822 | - else unique | ||
| 2823 | - }. | ||
| 2824 | - | ||
| 2825 | - | ||
| 2826 | - | ||
| 2827 | - | ||
| 2828 | - | ||
| 2829 | - | ||
| 2830 | - | ||
| 2831 | - | ||
| 2832 | - *** [5.8] Handling redirections. | ||
| 2833 | - | ||
| 2834 | - 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one | ||
| 2835 | - has the form: | ||
| 2836 | - | ||
| 2837 | - redirect(required_uri,required_host,corresponding_uri). | ||
| 2838 | - | ||
| 2839 | - The host required by the client may be found in the 'Host' HTTP header. The URI | ||
| 2840 | - required by the client is given below as 'uri'. We just have to find the required host | ||
| 2841 | - in the headers, and to find the corresponding redirection directive. | ||
| 2842 | - | ||
| 2843 | - | ||
| 2844 | - In the next fonction, the required host and URI are known. We just have to search in | ||
| 2845 | - the 'redirections' list. | ||
| 2846 | - | ||
| 2847 | -define String | ||
| 2848 | - handle_redirection | ||
| 2849 | - ( | ||
| 2850 | - String required_uri, | ||
| 2851 | - String required_host, | ||
| 2852 | - List(Redirection) redirections | ||
| 2853 | - ) = | ||
| 2854 | - if redirections is | ||
| 2855 | - { | ||
| 2856 | - [ ] then required_uri, | ||
| 2857 | - [h . t] then if h is redirect(uri,host,target) then | ||
| 2858 | - if host = required_host | ||
| 2859 | - then if uri = required_uri | ||
| 2860 | - then target | ||
| 2861 | - else handle_redirection(required_uri,required_host,t) | ||
| 2862 | - else handle_redirection(required_uri,required_host,t) | ||
| 2863 | - }. | ||
| 2864 | - | ||
| 2865 | - | ||
| 2866 | - | ||
| 2867 | - The host name may be encumbered by a port number, like | ||
| 2868 | - | ||
| 2869 | - www.our-business.com:1607 | ||
| 2870 | - | ||
| 2871 | - We must remove this port number, otherwise the host name may not be recognized. | ||
| 2872 | - | ||
| 2873 | -define String | ||
| 2874 | - strip_port | ||
| 2875 | - ( | ||
| 2876 | - String name, | ||
| 2877 | - Int i | ||
| 2878 | - ) = | ||
| 2879 | - if nth(i,name) is | ||
| 2880 | - { | ||
| 2881 | - failure then name, | ||
| 2882 | - success(c) then | ||
| 2883 | - if c = ':' | ||
| 2884 | - then substr(name,0,i) | ||
| 2885 | - else strip_port(name,i+1) | ||
| 2886 | - }. | ||
| 2887 | - | ||
| 2888 | - | ||
| 2889 | - | ||
| 2890 | - | ||
| 2891 | - | ||
| 2892 | - Finding the 'Host' header. No redirection is performed if this header is not found. | ||
| 2893 | - | ||
| 2894 | -define String | ||
| 2895 | - handle_redirection // returns the redirected URI | ||
| 2896 | - ( | ||
| 2897 | - Redirections redirections, | ||
| 2898 | - String uri, // original URI | ||
| 2899 | - List(HTTP_header) headers | ||
| 2900 | - )= | ||
| 2901 | - if get_host_header_value(headers) is | ||
| 2902 | - { | ||
| 2903 | - failure then uri, | ||
| 2904 | - success(host) then | ||
| 2905 | - if redirections is | ||
| 2906 | - { | ||
| 2907 | - redirection_list(l) then handle_redirection(uri, host, l) | ||
| 2908 | - redirection_fn(f) then f(uri, host) | ||
| 2909 | - } | ||
| 2910 | - }. | ||
| 2911 | - | ||
| 2912 | - | ||
| 2913 | - | ||
| 2914 | - | ||
| 2915 | - | ||
| 2916 | - | ||
| 2917 | - *** [5.9] Answering both sorts of requests. | ||
| 2918 | - | ||
| 2919 | - We must decide if the request is www-url encoded or multipart/form-data encoded. This | ||
| 2920 | - is achieved through the header 'Content-Type'. | ||
| 2921 | - | ||
| 2922 | -define EncodingType | ||
| 2923 | - get_encoding_type | ||
| 2924 | - ( | ||
| 2925 | - List(HTTP_header) headers | ||
| 2926 | - ) = | ||
| 2927 | - if headers is | ||
| 2928 | - { | ||
| 2929 | - [ ] then www_url, // this is the default | ||
| 2930 | - [h . t] then if h is http_header(name,value) then | ||
| 2931 | - if name = "content-type" | ||
| 2932 | - then if find("multipart/form-data",value,0) is | ||
| 2933 | - { | ||
| 2934 | - failure then www_url, | ||
| 2935 | - success(_) then multipart_form_data | ||
| 2936 | - } | ||
| 2937 | - else get_encoding_type(t) | ||
| 2938 | - }. | ||
| 2939 | - | ||
| 2940 | - | ||
| 2941 | - | ||
| 2942 | -define One | ||
| 2943 | - send_answer | ||
| 2944 | - ( | ||
| 2945 | - String host_name, | ||
| 2946 | - Web_Site_Description desc, | ||
| 2947 | - Connection connection, | ||
| 2948 | - HTTP_RequestLine rqline, | ||
| 2949 | - List(HTTP_header) headers, | ||
| 2950 | - ByteArray body, | ||
| 2951 | - One -> String generate_tt | ||
| 2952 | - ) = | ||
| 2953 | - if rqline is request_line(type,uri,qstring) then | ||
| 2954 | - with rqline2 = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring), | ||
| 2955 | - if remote_IP_address_and_port(connection) is (ip_addr,_) then | ||
| 2956 | - if get_encoding_type(headers) is | ||
| 2957 | - { | ||
| 2958 | - www_url then | ||
| 2959 | - www_url_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt), | ||
| 2960 | - multipart_form_data then | ||
| 2961 | - multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt) | ||
| 2962 | - }. | ||
| 2963 | - | ||
| 2964 | - | ||
| 2965 | - | ||
| 2966 | - | ||
| 2967 | - | ||
| 2968 | - | ||
| 2969 | - | ||
| 2970 | - *** [6] The HTTP/HTTPS server. | ||
| 2971 | - | ||
| 2972 | - The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine | ||
| 2973 | - which opens a server TCP/IP connection, and which continuously listens to this | ||
| 2974 | - connection. When a request arrives, this machine delegates the work of deciphering and | ||
| 2975 | - answering the request to another virtual machine, and continues to listen. The job of | ||
| 2976 | - the delegated machine is defined by the HTTP request handler below. | ||
| 2977 | - | ||
| 2978 | - | ||
| 2979 | - | ||
| 2980 | - | ||
| 2981 | - | ||
| 2982 | - *** [6.1] Determining the requested host. | ||
| 2983 | - | ||
| 2984 | - When a request arrives to one of our two servers, we must decide which site (host) is | ||
| 2985 | - requested. | ||
| 2986 | - | ||
| 2987 | -define Maybe(String) | ||
| 2988 | - get_host_header_value | ||
| 2989 | - ( | ||
| 2990 | - List(HTTP_header) headers | ||
| 2991 | - ) = | ||
| 2992 | - if headers is | ||
| 2993 | - { | ||
| 2994 | - [ ] then failure, | ||
| 2995 | - [h . t] then if h is http_header(name,value) then | ||
| 2996 | - if name = "host" | ||
| 2997 | - then success(strip_port(value,0)) | ||
| 2998 | - else get_host_header_value(t) | ||
| 2999 | - }. | ||
| 3000 | - | ||
| 3001 | -define Maybe((String,Web_Site_Description)) | ||
| 3002 | - get_site | ||
| 3003 | - ( | ||
| 3004 | - String requested_host, | ||
| 3005 | - List(Web_Site_Description) sites | ||
| 3006 | - ) = | ||
| 3007 | - if sites is | ||
| 3008 | - { | ||
| 3009 | - [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure, | ||
| 3010 | - [site1 . others] then | ||
| 3011 | - if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then | ||
| 3012 | - if member(common_names,requested_host) | ||
| 3013 | - then success((requested_host,site1)) | ||
| 3014 | - else get_site(requested_host,others) | ||
| 3015 | - }. | ||
| 3016 | - | ||
| 3017 | - | ||
| 3018 | -define Maybe((String,Web_Site_Description)) | ||
| 3019 | - get_site | ||
| 3020 | - ( | ||
| 3021 | - List(HTTP_header) headers, | ||
| 3022 | - List(Web_Site_Description) sites | ||
| 3023 | - ) = | ||
| 3024 | - if get_host_header_value(headers) is | ||
| 3025 | - { | ||
| 3026 | - failure then print("No 'Host' HTTP header.\n"); failure, | ||
| 3027 | - success(requested_host) then | ||
| 3028 | - //here we treat the case with only one site. hence we accept any host request | ||
| 3029 | - //print("*** there is " +length(sites) + " sites \n"); | ||
| 3030 | - if length(sites) = 1 then | ||
| 3031 | - //with site = force_nth(0, sites), | ||
| 3032 | - if sites is | ||
| 3033 | - { | ||
| 3034 | - [] then get_site(requested_host,sites), | ||
| 3035 | - [site . t] then success((requested_host, site)) | ||
| 3036 | - } | ||
| 3037 | - else | ||
| 3038 | - get_site(requested_host,sites) | ||
| 3039 | - }. | ||
| 3040 | - | ||
| 3041 | - | ||
| 3042 | - | ||
| 3043 | - | ||
| 3044 | - | ||
| 3045 | - *** [6.2] The HTTP request handler. | ||
| 3046 | - | ||
| 3047 | - Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual | ||
| 3048 | - machine. It reads the headers of the HTTP request, determines the host, determines body | ||
| 3049 | - size, reads the body of the HTTP request, and answers the request. | ||
| 3050 | - | ||
| 3051 | - | ||
| 3052 | - | ||
| 3053 | -define One -> String make_generate_trust_ticket(DenialOfService dos). | ||
| 3054 | - | ||
| 3055 | -define One | ||
| 3056 | - http_https_handler | ||
| 3057 | - ( | ||
| 3058 | - List(Web_Site_Description) sites, | ||
| 3059 | - BufferedConnection connection, | ||
| 3060 | - Bool is_https, | ||
| 3061 | - DenialOfService dos | ||
| 3062 | - ) = | ||
| 3063 | - //t0 <- (UTime)unow; | ||
| 3064 | - with start_time = (Int)now, | ||
| 3065 | - sttm <- start_time; | ||
| 3066 | - //println("Request time: " + format_http_date(start_time)); | ||
| 3067 | - if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then | ||
| 3068 | - if remote_IP_address_and_port(connection.conn) is (ip_addr,port) then | ||
| 3069 | - if read_request_line(connection,start_time+*rld_v,dos) is | ||
| 3070 | - { | ||
| 3071 | - error(msg) then print(format(msg)), | ||
| 3072 | - ok(request_line) then | ||
| 3073 | - //print_delta("read_request_line"); | ||
| 3074 | - if read_http_headers(connection,start_time+*hd_v,dos) is | ||
| 3075 | - { | ||
| 3076 | - error(msg) then print(format(msg)), | ||
| 3077 | - ok(headers) then //print_delta("read_http_headers"); | ||
| 3078 | - if get_site(headers,sites) is | ||
| 3079 | - { | ||
| 3080 | - failure then unique, | ||
| 3081 | - success(p) then if p is (host_name,desc) then | ||
| 3082 | - //print_delta("get_site"); | ||
| 3083 | - if get_body_size(headers) is | ||
| 3084 | - { | ||
| 3085 | - error(msg) then log_journal_msg(desc,format(msg)), | ||
| 3086 | - ok(body_size) then | ||
| 3087 | - //print_delta("get_body_size"); | ||
| 3088 | - if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is | ||
| 3089 | - { | ||
| 3090 | - error(msg) then log_journal_msg(desc,format(msg)), | ||
| 3091 | - ok(body) then | ||
| 3092 | - //print_delta("before send_answer"); | ||
| 3093 | - send_answer(host_name, desc,connection.conn, request_line, headers, body, | ||
| 3094 | - make_generate_trust_ticket(dos)) | ||
| 3095 | - //with duration = (UTime) unow - *t0, | ||
| 3096 | - //println("Request duration: " + __utime_to_string(duration)) | ||
| 3097 | - //println("BufferRead duration: " + __utime_to_string(*t1)); | ||
| 3098 | - //println("next_char duration: " + __utime_to_string(*t2)) | ||
| 3099 | - } | ||
| 3100 | - } | ||
| 3101 | - } | ||
| 3102 | - } | ||
| 3103 | - }. | ||
| 3104 | - | ||
| 3105 | - | ||
| 3106 | - Below are the two tools for constructing the handlers required by 'start_server' and | ||
| 3107 | - 'start_ssl_server' (see 'predefined.anubis'). | ||
| 3108 | - | ||
| 3109 | -define Bool is_dubious_IP(Word32 ip, DenialOfService dos). | ||
| 3110 | - | ||
| 3111 | -define Server -> ((RWStream) -> One) | ||
| 3112 | - make_http_handler | ||
| 3113 | - ( | ||
| 3114 | - List(Web_Site_Description) sites, | ||
| 3115 | - DenialOfService dos | ||
| 3116 | - ) = | ||
| 3117 | - (Server server) |-> (RWStream conn) |-> | ||
| 3118 | - if remote_IP_address_and_port(conn) is (addr,_) then | ||
| 3119 | - if is_dubious_IP(addr,dos) | ||
| 3120 | - then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n") | ||
| 3121 | - else | ||
| 3122 | - with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)), | ||
| 3123 | - http_https_handler(sites, connection, false, dos). | ||
| 3124 | - | ||
| 3125 | -define Server -> (SSL_Connection -> One) | ||
| 3126 | - make_https_handler | ||
| 3127 | - ( | ||
| 3128 | - List(Web_Site_Description) sites, | ||
| 3129 | - DenialOfService dos | ||
| 3130 | - ) = | ||
| 3131 | - (Server server) |-> (SSL_Connection conn) |-> | ||
| 3132 | - with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)), | ||
| 3133 | - http_https_handler(sites, connection, true, dos). | ||
| 3134 | - | ||
| 3135 | - | ||
| 3136 | - | ||
| 3137 | - | ||
| 3138 | - *** [6.3] Server's tasks. | ||
| 3139 | - | ||
| 3140 | - Some tasks must be executed periodically, for example for cleaning up directories from | ||
| 3141 | - short life time files. | ||
| 3142 | - | ||
| 3143 | - The next function removes from the given directory (and recursively from its | ||
| 3144 | - subdirectories) all the files which are more than 10 minutes old. | ||
| 3145 | - | ||
| 3146 | -define One | ||
| 3147 | - cleanup_directory_10mn | ||
| 3148 | - ( | ||
| 3149 | - String dir // path of private download directory (or subdirectory) with trailing slash | ||
| 3150 | - ) = | ||
| 3151 | - forget(map((FileDescription fd) |-> if fd is | ||
| 3152 | - { | ||
| 3153 | - no_info(name) then forget(remove(dir+name)), | ||
| 3154 | - file(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique, | ||
| 3155 | - link(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique, | ||
| 3156 | - directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"), | ||
| 3157 | - }, | ||
| 3158 | - directory_full_list(dir,"*","*","*"))). | ||
| 3159 | - | ||
| 3160 | - | ||
| 3161 | -define One | ||
| 3162 | - http_servers_tasks | ||
| 3163 | - ( | ||
| 3164 | - List(Web_Site_Description) sites, | ||
| 3165 | - List(Server) servers, | ||
| 3166 | - Int period, | ||
| 3167 | - Int next_time, | ||
| 3168 | - ) = | ||
| 3169 | - if mapand(is_down,servers) | ||
| 3170 | - then unique | ||
| 3171 | - else if now > next_time | ||
| 3172 | - then | ||
| 3173 | - ( | ||
| 3174 | - /* | ||
| 3175 | - forget(map((Web_Site_Description wsd) |-> | ||
| 3176 | - cleanup_directory_10mn(site_directory(wsd)+"/private_download/"), | ||
| 3177 | - sites)); | ||
| 3178 | - */ | ||
| 3179 | - http_servers_tasks(sites,servers,period,next_time+period) | ||
| 3180 | - ) | ||
| 3181 | - else | ||
| 3182 | - ( | ||
| 3183 | - sleep(1000); | ||
| 3184 | - http_servers_tasks(sites,servers,period,next_time) | ||
| 3185 | - ). | ||
| 3186 | - | ||
| 3187 | - | ||
| 3188 | -public define One | ||
| 3189 | - start_http_servers_tasks | ||
| 3190 | - ( | ||
| 3191 | - List(Web_Site_Description) sites, | ||
| 3192 | - List(Server) servers, | ||
| 3193 | - Int period | ||
| 3194 | - ) = | ||
| 3195 | - delegate http_servers_tasks(sites,servers,period,now), | ||
| 3196 | - unique. | ||
| 3197 | - | ||
| 3198 | - | ||
| 3199 | - | ||
| 3200 | - | ||
| 3201 | - *** [6.4] Protection against 'denial of service' attacks. | ||
| 3202 | - | ||
| 3203 | - | ||
| 3204 | - *** [6.4.1] Counting connections. | ||
| 3205 | - | ||
| 3206 | -define Bool // returns false if the counter cannot be incremented (too many connections) | ||
| 3207 | - increment_connections_counter | ||
| 3208 | - ( | ||
| 3209 | - Var(Int) counter | ||
| 3210 | - ) = | ||
| 3211 | - protect with n = *counter, | ||
| 3212 | - if n >= 100 | ||
| 3213 | - then false | ||
| 3214 | - else (counter <- (*counter)+1); true. | ||
| 3215 | - | ||
| 3216 | -define One | ||
| 3217 | - decrement_connections_counter | ||
| 3218 | - ( | ||
| 3219 | - Var(Int) counter | ||
| 3220 | - ) = | ||
| 3221 | - protect counter <- (*counter)-1. | ||
| 3222 | - | ||
| 3223 | - | ||
| 3224 | - | ||
| 3225 | - | ||
| 3226 | - | ||
| 3227 | - *** [6.4.2] Recording dubious IP addresses. | ||
| 3228 | - | ||
| 3229 | - | ||
| 3230 | -define List(DubiousIP) | ||
| 3231 | - record_dubious_IP | ||
| 3232 | - ( | ||
| 3233 | - Word32 ip, | ||
| 3234 | - List(DubiousIP) l | ||
| 3235 | - ) = | ||
| 3236 | - if l is | ||
| 3237 | - { | ||
| 3238 | - [ ] then [dubious_ip(ip,now)], | ||
| 3239 | - [h . t] then if h is dubious_ip(addr,time) then | ||
| 3240 | - if addr = ip | ||
| 3241 | - then [dubious_ip(addr,now) . t] | ||
| 3242 | - else [h . record_dubious_IP(ip,t)] | ||
| 3243 | - }. | ||
| 3244 | - | ||
| 3245 | - | ||
| 3246 | -define One | ||
| 3247 | - record_dubious_IP | ||
| 3248 | - ( | ||
| 3249 | - Word32 dubious_IP, | ||
| 3250 | - Var(List(DubiousIP)) v | ||
| 3251 | - ) = | ||
| 3252 | - protect v <- record_dubious_IP(dubious_IP,*v). | ||
| 3253 | - | ||
| 3254 | - | ||
| 3255 | -define One | ||
| 3256 | - record_dubious_IP | ||
| 3257 | - ( | ||
| 3258 | - Word32 addr, | ||
| 3259 | - DenialOfService dos | ||
| 3260 | - ) = | ||
| 3261 | - record_dubious_IP(addr,list_of_dubious(dos)). | ||
| 3262 | - | ||
| 3263 | - | ||
| 3264 | -public define DenialOfService | ||
| 3265 | - load_denial_of_service_info | ||
| 3266 | - = | ||
| 3267 | - if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is | ||
| 3268 | - ok(dos) then dos else denial_of_service( | ||
| 3269 | - var(100), | ||
| 3270 | - var(1000), | ||
| 3271 | - var(1500), | ||
| 3272 | - var(2000), | ||
| 3273 | - var([]), | ||
| 3274 | - var([])). | ||
| 3275 | - | ||
| 3276 | - | ||
| 3277 | - | ||
| 3278 | - | ||
| 3279 | - *** [6.4.3] Testing if an address is dubious. | ||
| 3280 | - | ||
| 3281 | -define Bool | ||
| 3282 | - is_dubious_IP | ||
| 3283 | - ( | ||
| 3284 | - Word32 ip, | ||
| 3285 | - List(DubiousIP) l | ||
| 3286 | - ) = | ||
| 3287 | - if l is | ||
| 3288 | - { | ||
| 3289 | - [ ] then false, | ||
| 3290 | - [h . t] then if h is dubious_ip(addr,time) then | ||
| 3291 | - if ip = addr | ||
| 3292 | - then true | ||
| 3293 | - else is_dubious_IP(ip,t) | ||
| 3294 | - }. | ||
| 3295 | - | ||
| 3296 | - | ||
| 3297 | -define Bool | ||
| 3298 | - is_dubious_IP | ||
| 3299 | - ( | ||
| 3300 | - Word32 ip, | ||
| 3301 | - DenialOfService dos | ||
| 3302 | - ) = | ||
| 3303 | - if dos is | ||
| 3304 | - { | ||
| 3305 | - denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then | ||
| 3306 | - if member(*ra_v,ip) then false else | ||
| 3307 | - is_dubious_IP(ip,*ld_v) | ||
| 3308 | - }. | ||
| 3309 | - | ||
| 3310 | - | ||
| 3311 | - | ||
| 3312 | - | ||
| 3313 | - *** [6.4.4] Removing inactive dubious IP addresses. | ||
| 3314 | - | ||
| 3315 | -define List(DubiousIP) | ||
| 3316 | - remove_inactive_dubious_IP | ||
| 3317 | - ( | ||
| 3318 | - List(DubiousIP) l, | ||
| 3319 | - Int ref_time, | ||
| 3320 | - ) = | ||
| 3321 | - if l is | ||
| 3322 | - { | ||
| 3323 | - [ ] then [ ], | ||
| 3324 | - [h . t] then if h is dubious_ip(addr,time) then | ||
| 3325 | - if time < ref_time | ||
| 3326 | - then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n"); | ||
| 3327 | - remove_inactive_dubious_IP(t,ref_time)) | ||
| 3328 | - else [h . remove_inactive_dubious_IP(t,ref_time)] | ||
| 3329 | - }. | ||
| 3330 | - | ||
| 3331 | -define One | ||
| 3332 | - remove_inactive_dubious_IP | ||
| 3333 | - ( | ||
| 3334 | - Var(List(DubiousIP)) v | ||
| 3335 | - ) = | ||
| 3336 | - protect | ||
| 3337 | - with ref_time = (Int)now - 600, // 10 minutes | ||
| 3338 | - v <- remove_inactive_dubious_IP(*v,ref_time). | ||
| 3339 | - | ||
| 3340 | - | ||
| 3341 | - The above function will be executed periodically by the servers's tasks machine. | ||
| 3342 | - | ||
| 3343 | - | ||
| 3344 | - | ||
| 3345 | - *** [6.4.5] Making the function for generating trust tickets. | ||
| 3346 | - | ||
| 3347 | -define One -> String | ||
| 3348 | - make_generate_trust_ticket | ||
| 3349 | - ( | ||
| 3350 | - DenialOfService dos | ||
| 3351 | - ) = | ||
| 3352 | - (One _) |-> "". | ||
| 3353 | - | ||
| 3354 | - | ||
| 3355 | - | ||
| 3356 | - | ||
| 3357 | - | ||
| 3358 | - | ||
| 3359 | - | ||
| 3360 | - *** [6.5] Starting the HTTP/HTTPS server. | ||
| 3361 | - | ||
| 3362 | - | ||
| 3363 | - The next function creates the directories for all sites (if they don't already exist). | ||
| 3364 | - | ||
| 3365 | -define One | ||
| 3366 | - create_directories | ||
| 3367 | - ( | ||
| 3368 | - List(Web_Site_Description) sites | ||
| 3369 | - ) = | ||
| 3370 | - if sites is | ||
| 3371 | - { | ||
| 3372 | - [ ] then unique, | ||
| 3373 | - [s1 . others] then | ||
| 3374 | - with site_dir = site_directory(s1), | ||
| 3375 | - forget(make_directory(site_dir+"/public",default_directory_mode)); | ||
| 3376 | - forget(make_directory(site_dir+"/upload_temporary",default_directory_mode)); | ||
| 3377 | - forget(make_directory(site_dir+"/private_download",default_directory_mode)); | ||
| 3378 | - forget(make_directory(site_dir+"/journal",default_directory_mode)); | ||
| 3379 | - create_directories(others) | ||
| 3380 | - }. | ||
| 3381 | - | ||
| 3382 | - | ||
| 3383 | - | ||
| 3384 | - | ||
| 3385 | - | ||
| 3386 | - Below are the commands for starting an HTTP server and an HTTPS server. | ||
| 3387 | - | ||
| 3388 | - | ||
| 3389 | -define StartServerResult | ||
| 3390 | - start_http_server | ||
| 3391 | - ( | ||
| 3392 | - Word32 ip_address, | ||
| 3393 | - Word32 port, | ||
| 3394 | - Server -> ((RWStream) -> One) handler, | ||
| 3395 | - Int retries, | ||
| 3396 | - DenialOfService dos | ||
| 3397 | - ) = | ||
| 3398 | - if start_server(ip_address, | ||
| 3399 | - port, | ||
| 3400 | - handler, | ||
| 3401 | - identity) is ok(server) | ||
| 3402 | - then print(" \r"); | ||
| 3403 | - ok(server) | ||
| 3404 | - else print("Port "+port+": retry number "+retries+"\r"); | ||
| 3405 | - sleep(1000); | ||
| 3406 | - start_http_server(ip_address,port,handler,retries+1,dos). | ||
| 3407 | - | ||
| 3408 | -public define StartServerResult | ||
| 3409 | - start_http_server | ||
| 3410 | - ( | ||
| 3411 | - Word32 ip_address, | ||
| 3412 | - Word32 port, | ||
| 3413 | - List(Web_Site_Description) sites, | ||
| 3414 | - DenialOfService dos | ||
| 3415 | - ) = | ||
| 3416 | - create_directories(sites); | ||
| 3417 | - start_http_server(ip_address,port, | ||
| 3418 | - make_http_handler(sites,dos), | ||
| 3419 | - 0, | ||
| 3420 | - dos). | ||
| 3421 | - | ||
| 3422 | - | ||
| 3423 | - For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not | ||
| 3424 | - yet able to manipulate several SSL server certificates. 'anbexec' and | ||
| 3425 | - 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The | ||
| 3426 | - 'solution' for the time being is to provide the common name of the unique SSL server | ||
| 3427 | - certificate. | ||
| 3428 | - | ||
| 3429 | - | ||
| 3430 | -define StartServerResult | ||
| 3431 | - start_https_server | ||
| 3432 | - ( | ||
| 3433 | - Word32 ip_address, | ||
| 3434 | - Word32 port, | ||
| 3435 | - String certificate_common_name, | ||
| 3436 | - Server -> (SSL_Connection -> One) handler, | ||
| 3437 | - Int retries, | ||
| 3438 | - DenialOfService dos | ||
| 3439 | - ) = | ||
| 3440 | - if start_ssl_server(ip_address, | ||
| 3441 | - port, | ||
| 3442 | - certificate_common_name, | ||
| 3443 | - handler, | ||
| 3444 | - identity) is ok(server) | ||
| 3445 | - then print(" \r"); | ||
| 3446 | - ok(server) | ||
| 3447 | - else print("Port "+port+": retry number "+retries+"\r"); | ||
| 3448 | - sleep(1000); | ||
| 3449 | - start_https_server(ip_address,port, | ||
| 3450 | - certificate_common_name, | ||
| 3451 | - handler,retries+1, | ||
| 3452 | - dos). | ||
| 3453 | - | ||
| 3454 | - | ||
| 3455 | -public define StartServerResult | ||
| 3456 | - start_https_server | ||
| 3457 | - ( | ||
| 3458 | - Word32 ip_address, | ||
| 3459 | - Word32 port, | ||
| 3460 | - String certificate_common_name, // of SSL server certificate | ||
| 3461 | - List(Web_Site_Description) sites, | ||
| 3462 | - DenialOfService dos | ||
| 3463 | - ) = | ||
| 3464 | - create_directories(sites); | ||
| 3465 | - start_https_server(ip_address,port,certificate_common_name, | ||
| 3466 | - make_https_handler(sites,dos), | ||
| 3467 | - 0,dos). | ||
| 3468 | - | ||
| 3469 | - | ||
| 3470 | - | ||
| 3471 | - | ||
| 3472 | - | ||
| 3473 | - | ||
| 3474 | - | ||
| 3475 | - | ||
| 3476 | - | ||
| 3477 | - *** [7] The web dispatcher. | ||
| 3478 | - | ||
| 3479 | - | ||
| 3480 | - *** [7.1] The dispatcher server. | ||
| 3481 | - | ||
| 3482 | -define One | ||
| 3483 | - send_dispatching_page | ||
| 3484 | - ( | ||
| 3485 | - RWStream conn, | ||
| 3486 | - String common_name, | ||
| 3487 | - Word32 port | ||
| 3488 | - ) = | ||
| 3489 | - print("Dispatching '"+common_name+"' to port "+port+"\n"); | ||
| 3490 | - forget(reliable_write(conn,to_byte_array( | ||
| 3491 | - "<html><head><meta http-equiv=\"Refresh\" content=\"0;URL="+ | ||
| 3492 | - "http://"+common_name+":"+port+"/"+ | ||
| 3493 | - "\"></head><body></body></html>" | ||
| 3494 | - ))). | ||
| 3495 | - | ||
| 3496 | - | ||
| 3497 | - | ||
| 3498 | -define Maybe(DispatcherInfo) | ||
| 3499 | - find_host | ||
| 3500 | - ( | ||
| 3501 | - List(DispatcherInfo) l, | ||
| 3502 | - String host | ||
| 3503 | - ) = | ||
| 3504 | - if l is | ||
| 3505 | - { | ||
| 3506 | - [ ] then failure, | ||
| 3507 | - [h . t] then if h is site(name,port) then | ||
| 3508 | - if name = host | ||
| 3509 | - then success(h) | ||
| 3510 | - else find_host(t,host) | ||
| 3511 | - }. | ||
| 3512 | - | ||
| 3513 | - | ||
| 3514 | - | ||
| 3515 | -define Server -> ((RWStream) -> One) | ||
| 3516 | - make_dispatcher_handler | ||
| 3517 | - ( | ||
| 3518 | - Var(List(DispatcherInfo)) info_v, | ||
| 3519 | - DenialOfService dos | ||
| 3520 | - ) = | ||
| 3521 | - (Server server) |-> (RWStream conn) |-> | ||
| 3522 | - with start_time = (Int)now, | ||
| 3523 | - connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)), | ||
| 3524 | - if read_request_line(connection, start_time+*request_line_delay(dos), dos) is | ||
| 3525 | - { | ||
| 3526 | - error(msg) then print(format(msg)), | ||
| 3527 | - ok(request_line) then | ||
| 3528 | - if read_http_headers(connection, start_time+*headers_delay(dos), dos) is | ||
| 3529 | - { | ||
| 3530 | - error(msg) then print(format(msg)), | ||
| 3531 | - ok(headers) then if get_host_header_value(headers) is | ||
| 3532 | - { | ||
| 3533 | - failure then print("No 'HOST' HTTP header.\n"), | ||
| 3534 | - success(host) then | ||
| 3535 | - if find_host(*info_v,host) is | ||
| 3536 | - { | ||
| 3537 | - failure then print("Host: '"+host+"' not registered.\n"), | ||
| 3538 | - success(s) then if s is site(common_name,ip_port) then | ||
| 3539 | - send_dispatching_page(conn,common_name,ip_port) | ||
| 3540 | - } | ||
| 3541 | - } | ||
| 3542 | - } | ||
| 3543 | - }. | ||
| 3544 | - | ||
| 3545 | - | ||
| 3546 | -define One | ||
| 3547 | - dispatcher_update_error | ||
| 3548 | - ( | ||
| 3549 | - String file_path | ||
| 3550 | - ) = | ||
| 3551 | - print("web_dispatcher: unable to reread file: '"+file_path+"'.\n"). | ||
| 3552 | - | ||
| 3553 | - | ||
| 3554 | -define Bool | ||
| 3555 | - dispatcher_update_data | ||
| 3556 | - ( | ||
| 3557 | - String info_file_path, | ||
| 3558 | - Var(List(DispatcherInfo)) info_v, | ||
| 3559 | - Var(Int) info_date_v | ||
| 3560 | - ) = | ||
| 3561 | - if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is | ||
| 3562 | - { | ||
| 3563 | - [ ] then false, | ||
| 3564 | - [h . t] then if h is | ||
| 3565 | - { | ||
| 3566 | - no_info(n) then false, | ||
| 3567 | - file(n,_,_,d) then if n = "dispatcher.info" | ||
| 3568 | - then (info_date_v <- to_Int(d); | ||
| 3569 | - if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is | ||
| 3570 | - { | ||
| 3571 | - cannot_find_file then false, | ||
| 3572 | - read_error then false, | ||
| 3573 | - type_error then false, | ||
| 3574 | - ok(info) then info_v <- info; true | ||
| 3575 | - }) | ||
| 3576 | - else false, | ||
| 3577 | - link(_,_,_,_) then false, | ||
| 3578 | - directory(_,_,_) then false | ||
| 3579 | - } | ||
| 3580 | - }. | ||
| 3581 | - | ||
| 3582 | - | ||
| 3583 | - | ||
| 3584 | - The loop within which the dispatcher updates its data every 3 seconds: | ||
| 3585 | - | ||
| 3586 | -define One | ||
| 3587 | - dispatcher_update_task | ||
| 3588 | - ( | ||
| 3589 | - String info_file_path, | ||
| 3590 | - Var(List(DispatcherInfo)) info_v, | ||
| 3591 | - Var(Int) info_date_v | ||
| 3592 | - ) = | ||
| 3593 | - sleep(3000); | ||
| 3594 | - (if dispatcher_update_data(info_file_path,info_v,info_date_v) | ||
| 3595 | - then unique | ||
| 3596 | - else dispatcher_update_error(info_file_path)); | ||
| 3597 | - dispatcher_update_task(info_file_path,info_v,info_date_v). | ||
| 3598 | - | ||
| 3599 | - | ||
| 3600 | -public define One | ||
| 3601 | - start_web_dispatcher | ||
| 3602 | - ( | ||
| 3603 | - Word32 ip_address, // address for listening (typically 0: listen on all interfaces) | ||
| 3604 | - Word32 http_port, // typically 80 | ||
| 3605 | - DenialOfService dos | ||
| 3606 | - ) = | ||
| 3607 | - with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info", | ||
| 3608 | - info_v = var((List(DispatcherInfo))[]), | ||
| 3609 | - info_date_v = var((Int)0), | ||
| 3610 | - if dispatcher_update_data(info_file_path,info_v,info_date_v) | ||
| 3611 | - then if start_server(ip_address, | ||
| 3612 | - http_port, | ||
| 3613 | - make_dispatcher_handler(info_v,dos), | ||
| 3614 | - (One u)|->u) is | ||
| 3615 | - { | ||
| 3616 | - cannot_create_the_socket then | ||
| 3617 | - print("Cannot create the socket for HTTP server.\n"), | ||
| 3618 | - cannot_bind_to_port then | ||
| 3619 | - print("Cannot bind HTTP server to port "+http_port+".\n"), | ||
| 3620 | - cannot_listen_on_port then | ||
| 3621 | - print("HTTP server cannot listen on port "+http_port+".\n"), | ||
| 3622 | - ok(http_server) then | ||
| 3623 | - dispatcher_update_task(info_file_path,info_v,info_date_v) | ||
| 3624 | - } | ||
| 3625 | - else dispatcher_update_error(info_file_path). | ||
| 3626 | - | ||
| 3627 | - | ||
| 3628 | - | ||
| 3629 | - *** [7.2] The dispatcher web site. | ||
| 3630 | - | ||
| 3631 | - global define One | ||
| 3632 | - web_dispatcher | ||
| 3633 | - ( | ||
| 3634 | - List(String) args | ||
| 3635 | - ) = | ||
| 3636 | - start_web_dispatcher(0,80,load_denial_of_service_info). | ||
| 3637 | - | ||
| 3638 | - | ||
| 3639 | - | ||
| 3640 | - | ||
| 3641 | - | ||
| 3642 | - | ||
| 3643 | - *** [7.3] Managing the info file. | ||
| 3644 | - | ||
| 3645 | -define Word32 | ||
| 3646 | - register_ip_address | ||
| 3647 | - = | ||
| 3648 | - if ip_address(prompt(" numerical IP address (for HTTP): ")) is | ||
| 3649 | - { | ||
| 3650 | - failure then print(" *** Error: incorrect IP address.\n"); | ||
| 3651 | - register_ip_address, | ||
| 3652 | - success(n) then n | ||
| 3653 | - }. | ||
| 3654 | - | ||
| 3655 | - | ||
| 3656 | -define Word32 | ||
| 3657 | - register_ip_port | ||
| 3658 | - = | ||
| 3659 | - if decimal_scan(prompt(" IP port (for HTTP): ")) is | ||
| 3660 | - { | ||
| 3661 | - failure then print(" *** Error: incorrect IP port.\n"); | ||
| 3662 | - register_ip_port, | ||
| 3663 | - success(p) then if (0 =< p & p =< 65535) | ||
| 3664 | - then truncate_to_Word32(p) | ||
| 3665 | - else print(" *** Error: IP port out of bounds.\n"); | ||
| 3666 | - register_ip_port | ||
| 3667 | - }. | ||
| 3668 | - | ||
| 3669 | - | ||
| 3670 | -define One | ||
| 3671 | - register_new_site | ||
| 3672 | - ( | ||
| 3673 | - Var(List(DispatcherInfo)) info_v | ||
| 3674 | - ) = | ||
| 3675 | - print("\n"); | ||
| 3676 | - print(" Registering a new site:\n"); | ||
| 3677 | - with name = prompt(" Site name: "), | ||
| 3678 | - with addr = register_ip_address, | ||
| 3679 | - with port = register_ip_port, | ||
| 3680 | - (protect info_v <- [site(name,port) . *info_v]); | ||
| 3681 | - print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n"). | ||
| 3682 | - | ||
| 3683 | - | ||
| 3684 | -define List(DispatcherInfo) | ||
| 3685 | - find_sites | ||
| 3686 | - ( | ||
| 3687 | - List(DispatcherInfo) l, | ||
| 3688 | - String name | ||
| 3689 | - ) = | ||
| 3690 | - if l is | ||
| 3691 | - { | ||
| 3692 | - [ ] then [ ], | ||
| 3693 | - [h . t] then if h is site(n,_) then | ||
| 3694 | - if find(name,n,0) is | ||
| 3695 | - { | ||
| 3696 | - failure then find_sites(t,name), | ||
| 3697 | - success(_) then [h . find_sites(t,name)] | ||
| 3698 | - } | ||
| 3699 | - }. | ||
| 3700 | - | ||
| 3701 | - | ||
| 3702 | -define String | ||
| 3703 | - pad | ||
| 3704 | - ( | ||
| 3705 | - String s, | ||
| 3706 | - Int l | ||
| 3707 | - ) = | ||
| 3708 | - if length(s) >= l | ||
| 3709 | - then s | ||
| 3710 | - else s+constant_string(l-length(s),' '). | ||
| 3711 | - | ||
| 3712 | - | ||
| 3713 | - | ||
| 3714 | -define One | ||
| 3715 | - show_sites_1 | ||
| 3716 | - ( | ||
| 3717 | - List(DispatcherInfo) l, | ||
| 3718 | - Int i | ||
| 3719 | - ) = | ||
| 3720 | - if l is | ||
| 3721 | - { | ||
| 3722 | - [ ] then unique, | ||
| 3723 | - [h . t] then if h is site(name,port) then | ||
| 3724 | - print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n"); | ||
| 3725 | - show_sites_1(t,i+1) | ||
| 3726 | - }. | ||
| 3727 | - | ||
| 3728 | - | ||
| 3729 | -define One | ||
| 3730 | - show_sites | ||
| 3731 | - ( | ||
| 3732 | - List(DispatcherInfo) l, | ||
| 3733 | - Int i | ||
| 3734 | - ) = | ||
| 3735 | - print(" Name Port\n"); | ||
| 3736 | - print(" --------------------------------------------------------\n"); | ||
| 3737 | - show_sites_1(l,i). | ||
| 3738 | - | ||
| 3739 | -define List(DispatcherInfo) | ||
| 3740 | - replace_info | ||
| 3741 | - ( | ||
| 3742 | - List(DispatcherInfo) l, | ||
| 3743 | - String site_name, | ||
| 3744 | - Word32 new_port | ||
| 3745 | - ) = | ||
| 3746 | - if l is | ||
| 3747 | - { | ||
| 3748 | - [ ] then print("ALERT: Empty list into replace_info() [" + __FILE__ + "]\n"); [], | ||
| 3749 | - [h . t] then if h is site(n,_) then | ||
| 3750 | - if n = site_name | ||
| 3751 | - then [site(n,new_port) . t] | ||
| 3752 | - else [h . replace_info(t,site_name,new_port)] | ||
| 3753 | - }. | ||
| 3754 | - | ||
| 3755 | -define List(DispatcherInfo) | ||
| 3756 | - delete_info | ||
| 3757 | - ( | ||
| 3758 | - List(DispatcherInfo) l, | ||
| 3759 | - String site_name, | ||
| 3760 | - ) = | ||
| 3761 | - if l is | ||
| 3762 | - { | ||
| 3763 | - [ ] then print("ALERT: Empty list into delete_info() [" + __FILE__ + "]\n"); [], | ||
| 3764 | - [h . t] then if h is site(n,_) then | ||
| 3765 | - if n = site_name | ||
| 3766 | - then t | ||
| 3767 | - else [h . delete_info(t,site_name)] | ||
| 3768 | - }. | ||
| 3769 | - | ||
| 3770 | - | ||
| 3771 | -define One | ||
| 3772 | - update_site | ||
| 3773 | - ( | ||
| 3774 | - Var(List(DispatcherInfo)) info_v, | ||
| 3775 | - String site_name, | ||
| 3776 | - Word32 old_port | ||
| 3777 | - ) = | ||
| 3778 | - print("\n"); | ||
| 3779 | - print(" Updating site '"+site_name+"': (currently: "+old_port+")\n"); | ||
| 3780 | - with new_port = register_ip_port, | ||
| 3781 | - answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "), | ||
| 3782 | - if (answer = "Y" | answer = "y") | ||
| 3783 | - then info_v <- replace_info(*info_v,site_name,new_port) | ||
| 3784 | - else unique. | ||
| 3785 | - | ||
| 3786 | - | ||
| 3787 | - | ||
| 3788 | -define Bool | ||
| 3789 | - compare | ||
| 3790 | - ( | ||
| 3791 | - DispatcherInfo d1, | ||
| 3792 | - DispatcherInfo d2 | ||
| 3793 | - ) = | ||
| 3794 | - if d1 is site(n1,_) then | ||
| 3795 | - if d2 is site(n2,_) then | ||
| 3796 | - string_less(n1,n2). | ||
| 3797 | - | ||
| 3798 | - | ||
| 3799 | - | ||
| 3800 | -define One | ||
| 3801 | - update_site | ||
| 3802 | - ( | ||
| 3803 | - Var(List(DispatcherInfo)) info_v | ||
| 3804 | - ) = | ||
| 3805 | - print("\n"); | ||
| 3806 | - with prefix = prompt(" Search for site to update: "), | ||
| 3807 | - if find_sites(*info_v,prefix) is | ||
| 3808 | - { | ||
| 3809 | - [ ] then print(" No site found.\n"); | ||
| 3810 | - update_site(info_v), | ||
| 3811 | - [h . t] then | ||
| 3812 | - show_sites(qsort([h . t],compare),1); | ||
| 3813 | - with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "), | ||
| 3814 | - if decimal_scan(i1) is | ||
| 3815 | - { | ||
| 3816 | - failure then print(" *** Error: site number not recognized.\n"); | ||
| 3817 | - update_site(info_v), | ||
| 3818 | - success(ii1) then if nth(ii1-1,*info_v) is | ||
| 3819 | - { | ||
| 3820 | - failure then print(" *** Error: site number "+i1+" does not exist.\n"); | ||
| 3821 | - update_site(info_v), | ||
| 3822 | - success(site_info) then if site_info is site(name,old_port) then | ||
| 3823 | - update_site(info_v,name,old_port) | ||
| 3824 | - } | ||
| 3825 | - } | ||
| 3826 | - }. | ||
| 3827 | - | ||
| 3828 | - | ||
| 3829 | -define One | ||
| 3830 | - delete_site | ||
| 3831 | - ( | ||
| 3832 | - Var(List(DispatcherInfo)) info_v, | ||
| 3833 | - String site_name, | ||
| 3834 | - Word32 old_port | ||
| 3835 | - ) = | ||
| 3836 | - print("\n"); | ||
| 3837 | - print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n"); | ||
| 3838 | - with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "), | ||
| 3839 | - if (answer = "Y" | answer = "y") | ||
| 3840 | - then info_v <- delete_info(*info_v,site_name) | ||
| 3841 | - else print(" Site '"+site_name+"' not deleted.\n"). | ||
| 3842 | - | ||
| 3843 | - | ||
| 3844 | -define One | ||
| 3845 | - delete_site | ||
| 3846 | - ( | ||
| 3847 | - Var(List(DispatcherInfo)) info_v | ||
| 3848 | - ) = | ||
| 3849 | - print("\n"); | ||
| 3850 | - with prefix = prompt(" Search for site to delete: "), | ||
| 3851 | - if find_sites(*info_v,prefix) is | ||
| 3852 | - { | ||
| 3853 | - [ ] then print(" No site found.\n"); | ||
| 3854 | - delete_site(info_v), | ||
| 3855 | - [h . t] then | ||
| 3856 | - show_sites(qsort([h . t],compare),1); | ||
| 3857 | - with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "), | ||
| 3858 | - if decimal_scan(i1) is | ||
| 3859 | - { | ||
| 3860 | - failure then print(" *** Error: site number not recognized.\n"); | ||
| 3861 | - delete_site(info_v), | ||
| 3862 | - success(ii1) then if nth(ii1-1,*info_v) is | ||
| 3863 | - { | ||
| 3864 | - failure then print(" *** Error: site number "+i1+" does not exist.\n"); | ||
| 3865 | - delete_site(info_v), | ||
| 3866 | - success(site_info) then if site_info is site(name,old_port) then | ||
| 3867 | - delete_site(info_v,name,old_port) | ||
| 3868 | - } | ||
| 3869 | - } | ||
| 3870 | - }. | ||
| 3871 | - | ||
| 3872 | - | ||
| 3873 | -define One | ||
| 3874 | - manager | ||
| 3875 | - ( | ||
| 3876 | - Var(List(DispatcherInfo)) info_v, | ||
| 3877 | - String file_path | ||
| 3878 | - ) = | ||
| 3879 | - print("\n"); | ||
| 3880 | - print(" --- Welcome to the Web Dispatcher Manager ---\n"); | ||
| 3881 | - with l = length(*info_v), | ||
| 3882 | - print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n"); | ||
| 3883 | - print(" [L] List registered sites.\n"); | ||
| 3884 | - print(" [R] Register a new site.\n"); | ||
| 3885 | - print(" [U] Update a registred site.\n"); | ||
| 3886 | - print(" [D] Delete a registred site.\n"); | ||
| 3887 | - with propose_write_v = var((Bool)true), | ||
| 3888 | - action = prompt(" Choose an action [L/R/U/D]: "), | ||
| 3889 | - (if (action = "L" | action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else | ||
| 3890 | - if (action = "R" | action = "r") then register_new_site(info_v) else | ||
| 3891 | - if (action = "U" | action = "u") then update_site(info_v) else | ||
| 3892 | - if (action = "D" | action = "d") then delete_site(info_v) else | ||
| 3893 | - print("Action not recognized.\n")); | ||
| 3894 | - print("\n"); | ||
| 3895 | - if *propose_write_v then | ||
| 3896 | - with result = prompt(" Write modifications to data base [Y/N] ?"), | ||
| 3897 | - if (result = "Y" | result = "y") | ||
| 3898 | - then if save(*info_v,file_path) is | ||
| 3899 | - { | ||
| 3900 | - cannot_open_file then print(" File '"+file_path+"' not found.\n"), | ||
| 3901 | - write_error then print(" Error while writing file '"+file_path+"'.\n"), | ||
| 3902 | - ok then print(" Data base has been modified.\n") | ||
| 3903 | - } | ||
| 3904 | - else print(" Data base not modified.\n") | ||
| 3905 | - else unique. | ||
| 3906 | - | ||
| 3907 | - | ||
| 3908 | - | ||
| 3909 | -global define One | ||
| 3910 | - manage_web_dispatcher | ||
| 3911 | - ( | ||
| 3912 | - List(String) args | ||
| 3913 | - ) = | ||
| 3914 | - with info_v = var((List(DispatcherInfo))[]), | ||
| 3915 | - with file_path = my_anubis_directory+"/web_sites/dispatcher.info", | ||
| 3916 | - if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is | ||
| 3917 | - { | ||
| 3918 | - cannot_find_file then print("File '"+file_path+"' does not exist.\n"); | ||
| 3919 | - with answer = prompt("Create it [Y/N] ? "), | ||
| 3920 | - if (answer = "Y" | answer = "y") | ||
| 3921 | - then if save((List(DispatcherInfo))[],file_path) is | ||
| 3922 | - { | ||
| 3923 | - cannot_open_file then | ||
| 3924 | - print("Cannot create file '"+file_path+"'.\n"), | ||
| 3925 | - write_error then | ||
| 3926 | - print("Error while creating file '"+file_path+"'.\n"), | ||
| 3927 | - ok then manager(info_v,file_path) | ||
| 3928 | - } | ||
| 3929 | - else unique, | ||
| 3930 | - read_error then print("Error while reading file '"+file_path+"'.\n"), | ||
| 3931 | - type_error then print("File '"+file_path+"' is corrupted.\n"), | ||
| 3932 | - ok(info) then info_v <- info; | ||
| 3933 | - manager(info_v,file_path) | ||
| 3934 | - }. | ||
| 3935 | - | ||
| 3936 | - | ||
| 3937 | - | ||
| 3938 | - | ||
| 3939 | - | ||
| 3940 | -public define (String, List(HTTP_header)) | ||
| 3941 | - format | ||
| 3942 | - ( | ||
| 3943 | - HTTP_Status status | ||
| 3944 | - ) = | ||
| 3945 | - if status is | ||
| 3946 | - { | ||
| 3947 | - http_continue then ("100 Continue", []), | ||
| 3948 | - http_switching_protocol then ("101 Switching Protocols", []), | ||
| 3949 | - | ||
| 3950 | - http_ok then ("200 OK", []), | ||
| 3951 | - http_created then ("201 Created", []), | ||
| 3952 | - http_accepted then ("202 Accepted", []), | ||
| 3953 | - http_non_authoritative_info then ("203 Non-Authoritative Information", []), | ||
| 3954 | - http_no_content then ("204 No Content", []), | ||
| 3955 | - http_reset_content then ("205 Reset Content", []), | ||
| 3956 | - http_partial_content then ("206 Partial Content", []), | ||
| 3957 | - | ||
| 3958 | - http_multiple_choices then ("300 Multiple Choices", []), | ||
| 3959 | - http_moved_permanently(loc) then ("301 Moved Permanently", [http_header("Location", loc)]), | ||
| 3960 | - http_moved_temporarily(loc) then ("302 Moved Temporarily", [http_header("Location", loc)]), | ||
| 3961 | - http_see_other(loc) then ("303 See Other", [http_header("Location", loc)]), | ||
| 3962 | - http_not_modified then ("304 Not Modified", []), | ||
| 3963 | - http_use_proxy(loc) then ("305 Use Proxy", [http_header("Location", loc)]), | ||
| 3964 | - http_temporary_redirect(loc) then ("307 Temporary Redirect", [http_header("Location", loc)]), | ||
| 3965 | - | ||
| 3966 | - http_bad_request then ("400 Bad Request", []), | ||
| 3967 | - http_unauthorized then ("401 Unauthorized", []), | ||
| 3968 | - http_payment_required then ("402 Payment Required", []), | ||
| 3969 | - http_forbidden then ("403 Forbidden", []), | ||
| 3970 | - http_not_found then ("404 Not Found", []), | ||
| 3971 | - http_method_not_allowed then ("405 Method Not Allowed", []), | ||
| 3972 | - http_not_acceptable then ("406 Not Acceptable", []), | ||
| 3973 | - http_proxy_authentification_required then ("407 Proxy Authentication Required", []), | ||
| 3974 | - http_request_timeout then ("408 Request Time-out", []), | ||
| 3975 | - http_conflict then ("409 Conflict", []), | ||
| 3976 | - http_gone then ("410 Gone", []), | ||
| 3977 | - http_length_required then ("411 Length Required", []), | ||
| 3978 | - http_precondition_failed then ("412 Precondition Failed", []), | ||
| 3979 | - http_request_entity_too_large then ("413 Request Entity Too Large", []), | ||
| 3980 | - http_request_uri_too_long then ("414 Request-URI Too Long", []), | ||
| 3981 | - http_unsupported_media_type then ("415 Unsupported Media Type", []), | ||
| 3982 | - http_request_range_unsatisfiable then ("416 Requested range unsatisfiable", []), | ||
| 3983 | - http_expectation_failed then ("417 Expectation failed", []), | ||
| 3984 | - | ||
| 3985 | - http_internal_server_error then ("500 Internal Server Error", []), | ||
| 3986 | - http_not_implemented then ("501 Not Implemented", []), | ||
| 3987 | - http_bad_gateway then ("502 Bad Gateway", []), | ||
| 3988 | - http_service_unavailable then ("503 Service Unavailable", []), | ||
| 3989 | - http_gateway_timeout then ("504 Gateway Time-out", []), | ||
| 3990 | - http_version_not_supported then ("505 HTTP Version not supported", []), | ||
| 3991 | - | ||
| 3992 | - http_error(code, message) then (abs_to_decimal(code) + " " + message, []) | ||
| 3993 | - }. | ||
| 3994 | - | ||
| 3995 | - | 1 | + |
| 2 | + *Project* The Anubis Project | ||
| 3 | + | ||
| 4 | + *Title* A Multi Host HTTP/HTTPS Server | ||
| 5 | + | ||
| 6 | + *Copyright* Copyright (c) Anubis Team 2003-2007. | ||
| 7 | + | ||
| 8 | + | ||
| 9 | + *Authors* Alain Prouté | ||
| 10 | + David René | ||
| 11 | + Cédric Ricard | ||
| 12 | + | ||
| 13 | + | ||
| 14 | + *Revised* July 2007. | ||
| 15 | + | ||
| 16 | + | ||
| 17 | + | ||
| 18 | + *Overviews* | ||
| 19 | + In this file a HTTP/HTTPS server is defined, which is able to handle multiple hosts | ||
| 20 | + (virtual hosts). It answers HTTP/HTTPS requests, sends files (images or any other kind | ||
| 21 | + of file), constructs HTML pages on the fly using informations received from the client | ||
| 22 | + (when the URI ends by '.awp'), handles uploading of files and redirections. It is | ||
| 23 | + multitasking by itself, and can handle any number of sites and clients simultaneously. | ||
| 24 | + It should better be used in conjunction with 'making_a_web_site.anubis' to be found in | ||
| 25 | + the same directory. If you use 'web/making_a_web_site.anubis', you don't need to read | ||
| 26 | + this file. | ||
| 27 | + | ||
| 28 | + | ||
| 29 | + ----------------------------------- Table of Contents --------------------------------- | ||
| 30 | + | ||
| 31 | + *** (1) Multihosting and redirections. | ||
| 32 | + *** (2) The incompatibility between SSL and virtual hosts. | ||
| 33 | + *** (3) HTTP headers and web arguments. | ||
| 34 | + *** (4) Site descriptions. | ||
| 35 | + *** (5) Protection against denial of service attacks. | ||
| 36 | + *** (6) Starting your HTTP and HTTPS servers. | ||
| 37 | + *** (7) Private download. | ||
| 38 | + *** (8) About web argument names. | ||
| 39 | + *** (9) A web dispatcher. | ||
| 40 | + *** (10) HTTP Errors | ||
| 41 | + | ||
| 42 | + --------------------------------------------------------------------------------------- | ||
| 43 | + | ||
| 44 | + | ||
| 45 | + | ||
| 46 | + | ||
| 47 | + *** (1) Multihosting and redirections. | ||
| 48 | + | ||
| 49 | + This HTTP/HTTPS server can handle several host (also called 'virtual hosts'), in other | ||
| 50 | + words, you may have several sites on the same server, with the same IP address and same | ||
| 51 | + port numbers, but distinct 'host names'. | ||
| 52 | + | ||
| 53 | + A HTTP request sent by a browser contains the following informations: | ||
| 54 | + | ||
| 55 | + - a 'host name', | ||
| 56 | + - an URI (Uniform Resource Identifier), | ||
| 57 | + - HTTP headers, | ||
| 58 | + - web arguments (in the form 'name=value'). | ||
| 59 | + | ||
| 60 | + Actually, the host name is just the value of the HTTP header whose name is 'Host'. The | ||
| 61 | + host name indicates which site is requested. Hence, it is the primary information for | ||
| 62 | + branching to the right site. If there is no 'Host' HTTP header in the request, the | ||
| 63 | + request is denied. | ||
| 64 | + | ||
| 65 | + From now on, we may assume that the host is determined, and consequently that we are | ||
| 66 | + concerned by only one site. Each site has his own directories on the server's | ||
| 67 | + disk. | ||
| 68 | + | ||
| 69 | + Each site also has a list of 'redirections'. A redirection is a triplet, like this one: | ||
| 70 | + | ||
| 71 | + redirect("/", "www.our-business.com", "/homepage.awp") | ||
| 72 | + | ||
| 73 | + meaning that if the host is "www.our-business.com", and if the requested URI is "/", | ||
| 74 | + then the URI to be served is "/homepage.awp". 'redirect' is a constructor of the type | ||
| 75 | + 'Redirection' defined in 'web/common.anubis'. | ||
| 76 | + | ||
| 77 | + Now, an URI may end by ".awp" (meaning 'Anubis Web Page') or not. If it does, the | ||
| 78 | + server understands that an HTML page must be constructed on the fly, and to that end it | ||
| 79 | + calls the 'awp handler' of the site. Otherwise, the URI must end by a known extension, | ||
| 80 | + like ".jpg", ".png", ".txt", etc... and represents a file path relative to the | ||
| 81 | + 'public' directory of the site. If these conditions are satisfied, the file is sent to | ||
| 82 | + the client. Known extensions are recorded in 'web/mime.anubis'. | ||
| 83 | + | ||
| 84 | + | ||
| 85 | + | ||
| 86 | + | ||
| 87 | + *** (2) The incompatibility between SSL and virtual hosts. | ||
| 88 | + | ||
| 89 | + Handling virtual hosts makes a problem under SSL (i.e. when using HTTPS), which is due | ||
| 90 | + to the fact that the guys at Netscape who designed SSL probably did not have the | ||
| 91 | + question of virtual hosts in mind. Indeed, the SSL handshake is completed before the | ||
| 92 | + server can know about the value of the 'Host' HTTP header, so that it cannot know which | ||
| 93 | + server certificate must be sent to the client. This makes a problem, because the | ||
| 94 | + browser will not accept a certificate whose common name does not correspond to the name | ||
| 95 | + of the requested host. The user will have to accept the certificate manually, which is | ||
| 96 | + not good for the security image of the site. This problem has at least two solutions | ||
| 97 | + (as far as Anubis is concerned). | ||
| 98 | + | ||
| 99 | + Solution 1. Arrange so that the network interface on which the server is listening | ||
| 100 | + has at least as many different IP addresses as you have virtual hosts. Such | ||
| 101 | + supplementary IP addresses are called 'IP Aliases'. In this case, start one HTTPS | ||
| 102 | + server for each virtual host, each one listening on a different address. For the time | ||
| 103 | + being, this method is applicable under Anubis only if you start as many instances of | ||
| 104 | + 'anbexec' as you have virtual hosts, because each instance of 'anbexec' can handle only | ||
| 105 | + one server certificate. Of course, getting IP aliases is another problem to be solved | ||
| 106 | + with your Internet provider. | ||
| 107 | + | ||
| 108 | + Solution 2. We propose a simple solution, using only one server certificate (hence | ||
| 109 | + only one instance of 'anbexec'). Since, we have only one server certificate, we must | ||
| 110 | + introduce a notion of 'main host', i.e. a host containing all other 'virtual | ||
| 111 | + hosts'. The unique server certificate belong to the main host, so that only the main | ||
| 112 | + host is identified by the client. The client must trust the main host and be confident | ||
| 113 | + that the main host redirects him to the right virtual host. Actually, the process will | ||
| 114 | + be transparent to the client, except that the client will see the name of the main host | ||
| 115 | + instead of the name of the virtual host in the 'location' field of the browser. | ||
| 116 | + | ||
| 117 | + So, assume that the name of main host is 'www.securedhost.com', and that the names of | ||
| 118 | + the virtual hosts are: | ||
| 119 | + | ||
| 120 | + actual name simplified name | ||
| 121 | + ----------------------------------------------------- | ||
| 122 | + www.virtual1.com virtual1 | ||
| 123 | + www.virtual2.com virtual2 | ||
| 124 | + www.virtual3.com virtual3 | ||
| 125 | + | ||
| 126 | + Then the (confidential) document '/doc/my_document.pdf' on 'www.virtual2.com' will have | ||
| 127 | + the URL: | ||
| 128 | + | ||
| 129 | + https://www.securedhost.com/virtual2/doc/my_document.pdf | ||
| 130 | + | ||
| 131 | + In order to work transparently, this solution must combine HTTP and HTTPS. Indeed, the | ||
| 132 | + vitual host must have a first page reachable under HTTP, through the URL: | ||
| 133 | + | ||
| 134 | + http://www.virtual2.com/ | ||
| 135 | + | ||
| 136 | + The HTTP server will redirect this URL to the awp handler of virtual host 'virtual2'. | ||
| 137 | + The handler of this virtual host is able to generate a first page containing the | ||
| 138 | + following HTML meta: | ||
| 139 | + | ||
| 140 | + <meta http-equiv="Refresh" content="0;URL=https://www.securedhost.com/virtual2/">, | ||
| 141 | + | ||
| 142 | + so that the client is immediately redirected to the main host under HTTPS (hence | ||
| 143 | + accepting tranparently the server certificate). The awp handler of 'virtual2' then | ||
| 144 | + redirects this URL to the home page (maybe a login page) of 'virtual2'. | ||
| 145 | + | ||
| 146 | + See 'web/making_a_web_site.anubis' for the sequel of this story. | ||
| 147 | + | ||
| 148 | + | ||
| 149 | + | ||
| 150 | + | ||
| 151 | + | ||
| 152 | + *** (3) HTTP headers and web arguments. | ||
| 153 | + | ||
| 154 | + Each HTTP request which arrives on the server contains a request line followed by a | ||
| 155 | + series of HTTP headers. Each HTTP header is a pair '(name,value)' assigning a value to | ||
| 156 | + a name. The type 'HTTP_header' is defined in 'web/common.anubis'. | ||
| 157 | + | ||
| 158 | + The request may also have a 'body'. The body contains either 'web arguments' or | ||
| 159 | + uploaded files (or both). The request line itself may also contain web arguments (in a | ||
| 160 | + so-called 'query string'). Like HTTP headers, 'web arguments' are pairs | ||
| 161 | + '(name,value)', but the difference is that these pairs are generated by the page within | ||
| 162 | + which the client clicks, while HTTP headers are generated by the browser itself. The | ||
| 163 | + type 'Web_arg' is defined in 'web/common.anubis'. It has two alternatives, one for | ||
| 164 | + ordinary web arguments (pairs) and one for uploaded files. | ||
| 165 | + | ||
| 166 | +read CXM_common.anubis | ||
| 167 | +read tools/basis.anubis | ||
| 168 | +read tools/printable_tree.anubis | ||
| 169 | +read system/string.anubis | ||
| 170 | +read system/files.anubis | ||
| 171 | +read system/lists.anubis | ||
| 172 | +read web/mime.anubis | ||
| 173 | + | ||
| 174 | + | ||
| 175 | + | ||
| 176 | + *** (4) Site descriptions. | ||
| 177 | + | ||
| 178 | + The type HTTP_Info gathers informations comming along with the client's request. These | ||
| 179 | + informations are rarely used for composing HTML pages. Nevertheless, they are at your | ||
| 180 | + disposal. | ||
| 181 | + | ||
| 182 | +public type HTTP_Info: | ||
| 183 | + http_info | ||
| 184 | + ( | ||
| 185 | + Word32 ip_address, // IP address of the client | ||
| 186 | + String hostname, // hostname requested by the client | ||
| 187 | + String uri, // URI requested by the client | ||
| 188 | + List(HTTP_header) http_headers, // HTTP headers sent by the client | ||
| 189 | + Bool is_https, | ||
| 190 | + One -> String generate_trust_ticket // may be used against denial of | ||
| 191 | + // service attacks | ||
| 192 | + ). | ||
| 193 | + | ||
| 194 | + | ||
| 195 | + | ||
| 196 | + Each site is described by a 'web site description', which is a datum of type | ||
| 197 | + 'Web_Site_Description'. | ||
| 198 | + | ||
| 199 | +public type Web_Site_Description: | ||
| 200 | + web_site_description( | ||
| 201 | + List(String) common_names, | ||
| 202 | + String site_directory, | ||
| 203 | + Redirections redirections, | ||
| 204 | + String charset, | ||
| 205 | + List(String) journal_extensions, | ||
| 206 | + List(String) journal_headers, | ||
| 207 | + String authorization_secret, | ||
| 208 | + List(MIME) known_mime_types, | ||
| 209 | + (String host_name, | ||
| 210 | + HTTP_Info http_info, | ||
| 211 | + List(Web_arg) lwa, | ||
| 212 | + Bool is_https) -> (//List(HTTP_header), | ||
| 213 | + Printable_tree) awp_handler, | ||
| 214 | + (HTTP_Info http_info, | ||
| 215 | + List(Web_arg) lwa) -> One before_send_file | ||
| 216 | + //Bool using_state_cookies, | ||
| 217 | + ). | ||
| 218 | + | ||
| 219 | + The component 'common_names' is the list of names of the site, like for example | ||
| 220 | + "www.our-business.com". The reason why we have a list of common names instead of a | ||
| 221 | + single common name, is that it may be useful to have a common name like "192.168.0.1" | ||
| 222 | + for testing. | ||
| 223 | + | ||
| 224 | + 'charset' is a string which will determine the character encoding to be used by the | ||
| 225 | + browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252", | ||
| 226 | + etc... | ||
| 227 | + | ||
| 228 | + 'journal_extensions' is the list of URI extensions for which you want a log in the | ||
| 229 | + journal (and on the console). When a request arrives, and if the extension is a member | ||
| 230 | + of this list, a message is printed into the journal of the site including the date, the | ||
| 231 | + IP address of the client, the complete HTTP request line. The HTTP headers whose name | ||
| 232 | + is a member of 'journal_headers' are also printed in the journal. A reasonable minimum | ||
| 233 | + for these two components is: | ||
| 234 | + | ||
| 235 | + [".awp"] for journal_extensions | ||
| 236 | + ["user-agent"] for journal_headers | ||
| 237 | + | ||
| 238 | + 'authorization_secret' is a string which should just be unguessable. You may choose | ||
| 239 | + something like (but don't choose this one !): | ||
| 240 | + | ||
| 241 | + "Hg8kJe42gCML9jNH-74" | ||
| 242 | + | ||
| 243 | + i.e. a sequence of characters typed at random, long enough to be unguessable. This is | ||
| 244 | + used by the 'private download' mecanism, which is discussed later in this file. | ||
| 245 | + | ||
| 246 | + The component 'awp_handler' is a function of type: | ||
| 247 | + | ||
| 248 | + (String host_name, | ||
| 249 | + HTTP_Info http_info, | ||
| 250 | + List(Web_arg) web_args, | ||
| 251 | + Bool is_https) -> Printable_tree | ||
| 252 | + | ||
| 253 | + ('Printable_tree' is a substitute for 'String' and is defined in | ||
| 254 | + 'tools/basis.anubis'). This function is the 'awp handler' for the site. When the URI | ||
| 255 | + ends by ".awp", this function is called, and the result (an HTML page) is sent to the | ||
| 256 | + client over the connection. The last operand to this function is a boolean which is | ||
| 257 | + 'true' when the requests arrives through the HTTPS channel, and 'false' when it arrives | ||
| 258 | + through the HTTP channel. | ||
| 259 | + | ||
| 260 | + | ||
| 261 | + | ||
| 262 | + | ||
| 263 | + | ||
| 264 | + | ||
| 265 | + | ||
| 266 | + *** (5) Protection against denial of service attacks. | ||
| 267 | + | ||
| 268 | + We need to protect our servers against 'denial of service' attacks. The attack may be | ||
| 269 | + send automatically from machines which are infested by viruses. In that case, our | ||
| 270 | + server is saturated of connections (all virtual machines at work), but nothing is | ||
| 271 | + comming on the connections. In order to avoid this problem, we propose the following: | ||
| 272 | + | ||
| 273 | + (1) Limit the number of simultaneous connections (say to 100). | ||
| 274 | + (2) Close a connection if the request is not complete after say 10 seconds. | ||
| 275 | + (3) Close the connection if the request is bigger than a given size (normal requests | ||
| 276 | + are small except when there are uploaded files. | ||
| 277 | + (4) Close the connection during the sending of the answer if the client is waiting | ||
| 278 | + too much. | ||
| 279 | + (5) Record all IP addresses with which we have encountered one of the problems above. | ||
| 280 | + (6) Immediately close the connections if the IP address is in our list. | ||
| 281 | + (7) Remove an address from the list only after 5 minutes of inactivity of this | ||
| 282 | + address. | ||
| 283 | + (8) Maintain a list of reliable IP addresses. | ||
| 284 | + | ||
| 285 | + Of course, all the above are approximative solutions which may in some circumstances | ||
| 286 | + become either cumbersome or also partially block the system. So, it is needed to have a | ||
| 287 | + set of dynamically modifiable parameters in order to master the behavior of this | ||
| 288 | + mecanism. | ||
| 289 | + | ||
| 290 | + | ||
| 291 | + Each dubious IP address is recorded together with its last activity time. | ||
| 292 | + | ||
| 293 | +public type DubiousIP: | ||
| 294 | + dubious_ip (Word32 address, | ||
| 295 | + Int last_activity). | ||
| 296 | + | ||
| 297 | + | ||
| 298 | +public type DenialOfService: | ||
| 299 | + denial_of_service(Var(Int) max_connections, | ||
| 300 | + Var(Int) request_line_delay, // seconds | ||
| 301 | + Var(Int) headers_delay, | ||
| 302 | + Var(Int) answer_delay, | ||
| 303 | + Var(List(DubiousIP)) list_of_dubious, | ||
| 304 | + Var(List(Word32)) reliable_addresses). | ||
| 305 | + | ||
| 306 | + The informations in this set of variables are stored serialized into the file | ||
| 307 | + 'my_anubis/web_sites/dos_info'. If this file does not exist a set if variables with | ||
| 308 | + default values is created. The values are saved on the disk each time they are | ||
| 309 | + modified. | ||
| 310 | + | ||
| 311 | +public define DenialOfService load_denial_of_service_info. | ||
| 312 | + | ||
| 313 | + | ||
| 314 | + | ||
| 315 | + *** (6) Starting your HTTP and HTTPS servers. | ||
| 316 | + | ||
| 317 | + When your web site descriptions are ready, you can start a pair of servers (a HTTP | ||
| 318 | + server and a HTTPS server) for serving your web sites. Notice that there are always | ||
| 319 | + two servers, regardless of the number of web sites, and that each web sites normally | ||
| 320 | + uses the two servers. | ||
| 321 | + | ||
| 322 | + | ||
| 323 | +public define StartServerResult | ||
| 324 | + start_http_server | ||
| 325 | + ( | ||
| 326 | + Word32 ip_address, | ||
| 327 | + Word32 http_port, | ||
| 328 | + List(Web_Site_Description) web_sites, | ||
| 329 | + DenialOfService dos | ||
| 330 | + ). | ||
| 331 | + | ||
| 332 | +public define StartServerResult | ||
| 333 | + start_https_server | ||
| 334 | + ( | ||
| 335 | + Word32 ip_address, | ||
| 336 | + Word32 https_port, | ||
| 337 | + String certificate_common_name, | ||
| 338 | + List(Web_Site_Description) web_sites, | ||
| 339 | + DenialOfService dos | ||
| 340 | + ). | ||
| 341 | + | ||
| 342 | + The first argument 'ip_address' is the IP address on which the servers listen. If you | ||
| 343 | + put 0, the servers listen on all adresses of the machine (which is useful if the | ||
| 344 | + machine has several network interfaces). Otherwise, use the function 'ip_address' | ||
| 345 | + defined in 'tools/basis.anubis' for composing a particular IP address. | ||
| 346 | + | ||
| 347 | + The next arguments are the port numbers for HTTP and HTTPS. The usual values are 80 and | ||
| 348 | + 443, but you may have reasons to choose other values. | ||
| 349 | + | ||
| 350 | + The next argument is the list of your web site descriptions. All the sites described in | ||
| 351 | + this list will be accessible on the server. | ||
| 352 | + | ||
| 353 | + The argument 'dos' is a set of dynamic variables containing the informations for | ||
| 354 | + protecting the servers against denial of service attacks. | ||
| 355 | + | ||
| 356 | + | ||
| 357 | + | ||
| 358 | + | ||
| 359 | + | ||
| 360 | + | ||
| 361 | + *** (7) Private download. | ||
| 362 | + | ||
| 363 | + It may happen that you want to propose private files for download. This means that such | ||
| 364 | + a file could be downloaded only by the authorized person, and should not be seen by any | ||
| 365 | + other one. This feature can be used only under HTTPS, not under HTTP. | ||
| 366 | + | ||
| 367 | + The file may be located anywhere on the server. Hence, the file has a complete absolute | ||
| 368 | + path, like for example: | ||
| 369 | + | ||
| 370 | + /home/georges/my_documents/my_text.pdf | ||
| 371 | + | ||
| 372 | + which has nothing to do with the directories of the web server. Now, you may also want | ||
| 373 | + to show another path or simply just a name to the client, not the actual absolute path | ||
| 374 | + above, which may need to remain secret. So for example, the same file may appear to the | ||
| 375 | + client as: | ||
| 376 | + | ||
| 377 | + informations.pdf | ||
| 378 | + | ||
| 379 | + The page must provide a link with an authorization. The authorization is just a web | ||
| 380 | + argument, whose name is "zauth". The value of this web argument is computed by hashing | ||
| 381 | + some secret string (known only from the programmer of the web site) with the absolute | ||
| 382 | + path of the file. The HTTPS request will have the form: | ||
| 383 | + | ||
| 384 | + GET /informations.pdf?zauth=d38161f5b4e87e2d46e06ff8b3e233be563794d1 | ||
| 385 | + | ||
| 386 | + The server will search for a file named | ||
| 387 | + | ||
| 388 | + zd38161f5b4e87e2d46e06ff8b3e233be563794d1 | ||
| 389 | + | ||
| 390 | + (i.e. "z" concatenated with the value of the authorization) in the subdirectory | ||
| 391 | + 'private_download' of the site directory. This file contains the absolute path of the | ||
| 392 | + file, i.e: | ||
| 393 | + | ||
| 394 | + /home/georges/my_documents/my_text.pdf | ||
| 395 | + | ||
| 396 | + At that point, the server may hash the secret string and the absolute path together, to | ||
| 397 | + check if the client is authorized to download the file. If it is the case, it sends the | ||
| 398 | + file (the MIME type is declared as 'application/octet-stream' if it is not recognized). | ||
| 399 | + The file is sent under the visible name. | ||
| 400 | + | ||
| 401 | + The server creates automatically the subdirectory 'private_download/' within the 'site | ||
| 402 | + directory' (for each web site) if it does not already exist. Files in this directory | ||
| 403 | + are deleted when they become too old (for example, after 3 days of life). | ||
| 404 | + | ||
| 405 | + Here is the function for computing the value of the authorization, and for making the | ||
| 406 | + authorization file in 'private_download'. | ||
| 407 | + | ||
| 408 | +public define String | ||
| 409 | + make_authorization | ||
| 410 | + ( | ||
| 411 | + String site_directory, | ||
| 412 | + String authorization_secret, // known only by the programmer of the web site | ||
| 413 | + String absolute_path // on server | ||
| 414 | + ). | ||
| 415 | + | ||
| 416 | + See 'web/making_a_web_site.anubis' for the construction of the link for downloading. | ||
| 417 | + | ||
| 418 | + | ||
| 419 | + | ||
| 420 | + | ||
| 421 | + | ||
| 422 | + | ||
| 423 | + | ||
| 424 | + | ||
| 425 | + *** (8) About web argument names. | ||
| 426 | + | ||
| 427 | + The server reserves the name "zauth" for the authorization in the private download | ||
| 428 | + mecanism. Also, if the name of a web arguments begins by "p" (like 'password'), it does | ||
| 429 | + not print the value of the web argument neither on the console or in the journal. A | ||
| 430 | + good politics is to prefix all web arguments by letters distinct from 'p' and 'z'. This | ||
| 431 | + method is used in 'web/making_a_web_site.anubis'. This will avoid clashes of names. | ||
| 432 | + | ||
| 433 | + | ||
| 434 | + | ||
| 435 | + | ||
| 436 | + | ||
| 437 | + | ||
| 438 | + *** (9) A web dispatcher. | ||
| 439 | + | ||
| 440 | + For hosting several sites you may prefer another method which we now describe. We start | ||
| 441 | + a HTTP server on port 80 (or on another port). This server is called the | ||
| 442 | + ``dispatcher''. When a requests arrives, the dispatcher examines the ``host'' HTTP | ||
| 443 | + header, so that it gets the name of the requested host. Then it sends to the client a | ||
| 444 | + page like this one: | ||
| 445 | + | ||
| 446 | + <html> | ||
| 447 | + <head> | ||
| 448 | + <meta http-equiv="Refresh" content="0;URL=..."> | ||
| 449 | + </head> | ||
| 450 | + <body> | ||
| 451 | + </body> | ||
| 452 | + </html> | ||
| 453 | + | ||
| 454 | + where the URL represented by '...' is the URL of the requested site. This URL may have | ||
| 455 | + the same IP address as the dispatcher, except that the port number is different. It may | ||
| 456 | + also have a different IP address. | ||
| 457 | + | ||
| 458 | + The dispatcher uses the file 'my_anubis/web_sites/dispatcher.info'. This file contains | ||
| 459 | + a serialized datum of type 'List(DispatcherInfo)'. | ||
| 460 | + | ||
| 461 | +public type DispatcherInfo: | ||
| 462 | + site(String common_name, | ||
| 463 | + Word32 http_port). | ||
| 464 | + | ||
| 465 | + The dispatcher does not write into this file. It reads it when it starts, and rereads | ||
| 466 | + it each time the date of last modification of the file changes, so that the dispatcher | ||
| 467 | + always has up to date data. The file may be managed (written and updated) by another | ||
| 468 | + program. | ||
| 469 | + | ||
| 470 | + So, for each site, the dispatcher knows the common name (needed to recognize the 'host' | ||
| 471 | + HTTP header), and the pair (ip_address,port) used by the actual site for HTTP. The | ||
| 472 | + dispatcher does not worry about HTTPS. HTTPS must be managed by the actual site. | ||
| 473 | + | ||
| 474 | + The dispatcher is started by: | ||
| 475 | + | ||
| 476 | +public define One | ||
| 477 | + start_web_dispatcher | ||
| 478 | + ( | ||
| 479 | + Word32 ip_address, // address for listening (typically 0) | ||
| 480 | + Word32 port, // typically 80 | ||
| 481 | + DenialOfService dos | ||
| 482 | + ). | ||
| 483 | + | ||
| 484 | + A command line tool for managing the file 'my_anubis/web_sites/dispatcher.info' is also | ||
| 485 | + provided: | ||
| 486 | + | ||
| 487 | + global define One | ||
| 488 | + manage_web_dispatcher | ||
| 489 | + ( | ||
| 490 | + List(String) args | ||
| 491 | + ). | ||
| 492 | + | ||
| 493 | + | ||
| 494 | + *** (10) HTTP Errors | ||
| 495 | + | ||
| 496 | +public type HTTP_Status: | ||
| 497 | + http_continue, // 100 | ||
| 498 | + http_switching_protocol, // 101 | ||
| 499 | + | ||
| 500 | + http_ok, // 200 | ||
| 501 | + http_created, // 201 | ||
| 502 | + http_accepted, // 202 | ||
| 503 | + http_non_authoritative_info, // 203 | ||
| 504 | + http_no_content, // 204 | ||
| 505 | + http_reset_content, // 205 | ||
| 506 | + http_partial_content, // 206 | ||
| 507 | + | ||
| 508 | + http_multiple_choices, | ||
| 509 | + http_moved_permanently(String location), // 301 | ||
| 510 | + http_moved_temporarily(String location), // 302 | ||
| 511 | + http_see_other(String location), // 303 | ||
| 512 | + http_not_modified, // 304 | ||
| 513 | + http_use_proxy(String location), // 305 | ||
| 514 | + http_temporary_redirect(String location), // 307 | ||
| 515 | + | ||
| 516 | + http_bad_request, // 400 | ||
| 517 | + http_unauthorized, // 401 | ||
| 518 | + http_payment_required, // 402 | ||
| 519 | + http_forbidden, // 403 | ||
| 520 | + http_not_found, // 404 | ||
| 521 | + http_method_not_allowed, // 405 | ||
| 522 | + http_not_acceptable, // 406 | ||
| 523 | + http_proxy_authentification_required, // 407 | ||
| 524 | + http_request_timeout, // 408 | ||
| 525 | + http_conflict, // 409 | ||
| 526 | + http_gone, // 410 | ||
| 527 | + http_length_required, // 411 | ||
| 528 | + http_precondition_failed, // 412 | ||
| 529 | + http_request_entity_too_large, // 413 | ||
| 530 | + http_request_uri_too_long, // 414 | ||
| 531 | + http_unsupported_media_type, // 415 | ||
| 532 | + http_request_range_unsatisfiable, // 416 | ||
| 533 | + http_expectation_failed, // 417 | ||
| 534 | + | ||
| 535 | + http_internal_server_error, // 500 | ||
| 536 | + http_not_implemented, // 501 | ||
| 537 | + http_bad_gateway, // 502 | ||
| 538 | + http_service_unavailable, // 503 | ||
| 539 | + http_gateway_timeout, // 504 | ||
| 540 | + http_version_not_supported, // 505 | ||
| 541 | + | ||
| 542 | + http_error(Int /*code*/, String /*message*/). | ||
| 543 | + | ||
| 544 | +public define (String, List(HTTP_header)) | ||
| 545 | + format | ||
| 546 | + ( | ||
| 547 | + HTTP_Status status | ||
| 548 | + ). | ||
| 549 | + | ||
| 550 | + | ||
| 551 | + | ||
| 552 | + | ||
| 553 | + | ||
| 554 | + --- That's all for the public part ! -------------------------------------------------- | ||
| 555 | + | ||
| 556 | +define Maybe(String) get_host_header_value(List(HTTP_header) headers). | ||
| 557 | + | ||
| 558 | +define String | ||
| 559 | + __utime_to_string | ||
| 560 | + ( | ||
| 561 | + UTime t | ||
| 562 | + ) = | ||
| 563 | + to_decimal(t.seconds) + "." + zero_pad_n(6, t.microseconds ) + "s". | ||
| 564 | + | ||
| 565 | + | ||
| 566 | +variable UTime t0 = utime(0,0). | ||
| 567 | +variable UTime t1 = utime(0,0). | ||
| 568 | + | ||
| 569 | +define One | ||
| 570 | + accumulate_t1 | ||
| 571 | + ( | ||
| 572 | + UTime start | ||
| 573 | + ) = | ||
| 574 | + with delta = (UTime)unow - start, | ||
| 575 | + t1 <- delta + *t1; | ||
| 576 | + unique. | ||
| 577 | + | ||
| 578 | +variable UTime t2 = utime(0,0). | ||
| 579 | + | ||
| 580 | +define One | ||
| 581 | + accumulate_t2 | ||
| 582 | + ( | ||
| 583 | + UTime start | ||
| 584 | + ) = | ||
| 585 | + with delta = (UTime)unow - start, | ||
| 586 | + t2 <- delta + *t2; | ||
| 587 | + unique. | ||
| 588 | + | ||
| 589 | + | ||
| 590 | +public define One | ||
| 591 | + print_delta | ||
| 592 | + ( | ||
| 593 | + String txt | ||
| 594 | + ) = | ||
| 595 | + println(__utime_to_string((UTime)unow - *t0) + " : " + txt). | ||
| 596 | + | ||
| 597 | + | ||
| 598 | + ----------------------------------- Table of Contents --------------------------------- | ||
| 599 | + | ||
| 600 | + *** [1] Types which are private to this file. | ||
| 601 | + | ||
| 602 | + *** [2] Tools. | ||
| 603 | + *** [2.1] Formating an error message. | ||
| 604 | + *** [2.2] Converting IP addresses. | ||
| 605 | + *** [2.3] Reading and unputting characters. | ||
| 606 | + *** [2.4] Reading and discarding characters. | ||
| 607 | + *** [2.5] Reading a character string. | ||
| 608 | + *** [2.6] Padding integers with zeros. | ||
| 609 | + *** [2.7] Converting web arguments to ASCII. | ||
| 610 | + *** [2.8] Server description. | ||
| 611 | + | ||
| 612 | + *** [3] Managing the journal. | ||
| 613 | + *** [3.1] Naming journal files. | ||
| 614 | + *** [3.2] Formating HTTP headers. | ||
| 615 | + *** [3.3] Formating web arguments. | ||
| 616 | + *** [3.4] Formating the whole request. | ||
| 617 | + *** [3.5] Putting it in the journal file (and on the console). | ||
| 618 | + | ||
| 619 | + *** [4] Reading the HTTP request. | ||
| 620 | + *** [4.1] Skipping leading blanks. | ||
| 621 | + *** [4.2] Reading a new line. | ||
| 622 | + *** [4.3] Reading a 'word'. | ||
| 623 | + *** [4.4] Separating the URI from the query string. | ||
| 624 | + *** [4.5] Reading the web arguments. | ||
| 625 | + *** [4.7] Reading the request line. | ||
| 626 | + *** [4.8] Reading the HTTP headers. | ||
| 627 | + *** [4.9] Getting the size of the request's body. | ||
| 628 | + *** [4.10] Reading the body of the request. | ||
| 629 | + | ||
| 630 | + *** [5] Making the HTTP answer. | ||
| 631 | + *** [5.1] Avoiding illegal URIs. | ||
| 632 | + *** [5.2] Managing authorizations for downloading private files. | ||
| 633 | + *** [5.3] Recognizing MIME types. | ||
| 634 | + *** [5.4] Formating HTTP headers. | ||
| 635 | + *** [5.5] Sending a file. | ||
| 636 | + *** [5.6] Answering a www-url encoded request. | ||
| 637 | + *** [5.7] Answering a multipart/form-data encoded request. | ||
| 638 | + *** [5.7.1] Finding the boundary. | ||
| 639 | + *** [5.7.2] Reading attributes from a multipart entity. | ||
| 640 | + *** [5.7.3] Creating a temporary filename for an uploaded file. | ||
| 641 | + *** [5.7.4] Saving an uploaded file under a temporary filename. | ||
| 642 | + *** [5.7.5] Removing the path from a file name. | ||
| 643 | + *** [5.7.6] Reading a multipart entity. | ||
| 644 | + *** [5.8] Handling redirections. | ||
| 645 | + *** [5.9] Answering both sorts of requests. | ||
| 646 | + | ||
| 647 | + *** [6] The HTTP/HTTPS servers. | ||
| 648 | + *** [6.1] The HTTP request handler. | ||
| 649 | + *** [6.2] Server's tasks. | ||
| 650 | + *** [6.3] Starting the HTTP/HTTPS servers. | ||
| 651 | + | ||
| 652 | + *** [7] The web dispatcher. | ||
| 653 | + *** [7.1] The dispatcher server. | ||
| 654 | + *** [7.2] The dispatcher web site. | ||
| 655 | + *** [7.3] Managing the info file. | ||
| 656 | + | ||
| 657 | + --------------------------------------------------------------------------------------- | ||
| 658 | + | ||
| 659 | + | ||
| 660 | + | ||
| 661 | + | ||
| 662 | +read tools/basis.anubis | ||
| 663 | +read tools/findstring.anubis | ||
| 664 | +read tools/connections.anubis | ||
| 665 | + | ||
| 666 | + | ||
| 667 | + | ||
| 668 | + | ||
| 669 | + | ||
| 670 | + *** [1] Types which are private to this file. | ||
| 671 | + | ||
| 672 | + We use the following self-explanatory types. | ||
| 673 | + | ||
| 674 | +type Error: | ||
| 675 | + cannot_read_from_connection, | ||
| 676 | + not_get_or_post_request(String), | ||
| 677 | + end_of_line_expected, | ||
| 678 | + incorrect_content_length_value, | ||
| 679 | + colon_expected, | ||
| 680 | + timeout(Int). | ||
| 681 | + | ||
| 682 | +type HTTP_RequestType: | ||
| 683 | + get, | ||
| 684 | + post. | ||
| 685 | + | ||
| 686 | +type HTTP_RequestLine: | ||
| 687 | + request_line (HTTP_RequestType type, | ||
| 688 | + String uri, | ||
| 689 | + List(Web_arg) query_string). | ||
| 690 | + | ||
| 691 | +type EncodingType: | ||
| 692 | + www_url, | ||
| 693 | + multipart_form_data. | ||
| 694 | + | ||
| 695 | +type BufferedConnection: | ||
| 696 | + buffered_connection(Connection conn, | ||
| 697 | + Var(ByteArray) buffer, | ||
| 698 | + Var(Int) read_pos). | ||
| 699 | + | ||
| 700 | + | ||
| 701 | + | ||
| 702 | + *** [2] Tools. | ||
| 703 | + | ||
| 704 | + *** [2.1] Formating an error message. | ||
| 705 | + | ||
| 706 | + The next function formats an error message. | ||
| 707 | + | ||
| 708 | +define String | ||
| 709 | + format | ||
| 710 | + ( | ||
| 711 | + Error msg | ||
| 712 | + ) = | ||
| 713 | + if msg is | ||
| 714 | + { | ||
| 715 | + cannot_read_from_connection then | ||
| 716 | + "Cannot read from connection.\n", | ||
| 717 | + not_get_or_post_request(s) then | ||
| 718 | + "The request did not begin by 'GET' or 'POST': "+s+".\n", | ||
| 719 | + end_of_line_expected then | ||
| 720 | + "End of line expected.\n", | ||
| 721 | + incorrect_content_length_value then | ||
| 722 | + "Incorrect value for HTTP header 'Content-Length'.\n", | ||
| 723 | + colon_expected then | ||
| 724 | + "':' was expected.\n", | ||
| 725 | + timeout(n) then | ||
| 726 | + //"time out: "+n+"\n" | ||
| 727 | + //"time out.\n" | ||
| 728 | + "" | ||
| 729 | + }. | ||
| 730 | + | ||
| 731 | + | ||
| 732 | + | ||
| 733 | + | ||
| 734 | + | ||
| 735 | + | ||
| 736 | + *** [2.2] Converting IP addresses. | ||
| 737 | + | ||
| 738 | + We need two conversion functions for IP addresses: | ||
| 739 | + | ||
| 740 | + (Word8,Word8,Word8,Word8) --> Word32 ip_address | ||
| 741 | + Word32 --> String ip_addr_to_string | ||
| 742 | + | ||
| 743 | + These conversions are defined in 'tools/basis.anubis'. | ||
| 744 | + | ||
| 745 | + | ||
| 746 | + | ||
| 747 | + | ||
| 748 | + | ||
| 749 | + | ||
| 750 | + | ||
| 751 | + | ||
| 752 | + *** [2.3] Reading and unputting characters. | ||
| 753 | + | ||
| 754 | + We need a mecanism for unputting several characters (actually at least 3). This is | ||
| 755 | + because when reading the client connection, we must sometimes go ahead several | ||
| 756 | + characters, and virtually put them back into the connection, so that they can be | ||
| 757 | + reread. Of course, we do not send them back to the client. We store them in a list | ||
| 758 | + (hold by the variable 'unput_chars'), and we manage this list, so that characters may | ||
| 759 | + be virtually put back in the connection (this is called 'unputting'). | ||
| 760 | + | ||
| 761 | +variable List(Word8) unput_chars = []. | ||
| 762 | + | ||
| 763 | + The most recently read one is the head of list. Fortunately, this variable is private | ||
| 764 | + to this virtual machine (hence to this client). | ||
| 765 | + | ||
| 766 | + | ||
| 767 | +define One | ||
| 768 | + unput // unputting a character (add it in front of the list) | ||
| 769 | + ( | ||
| 770 | + Word8 character | ||
| 771 | + ) = | ||
| 772 | + unput_chars <- (List(Word8))[character . *unput_chars]. | ||
| 773 | + | ||
| 774 | + | ||
| 775 | + | ||
| 776 | +define One record_dubious_IP(Word32 addr,DenialOfService dos). | ||
| 777 | + | ||
| 778 | +variable Int sttm = 0. // contains the start time for this connection. | ||
| 779 | + | ||
| 780 | +define Result(Error,Word8) | ||
| 781 | + record_dubious_connection | ||
| 782 | + ( | ||
| 783 | + Connection conn, | ||
| 784 | + Int dead_line, | ||
| 785 | + DenialOfService dos, | ||
| 786 | + ) = | ||
| 787 | + if remote_IP_address_and_port(conn) is (addr,port) then | ||
| 788 | + record_dubious_IP(addr,dos); | ||
| 789 | + print("Recording IP address "+ip_addr_to_string(addr)+ | ||
| 790 | + " as dubious after "+(dead_line-*sttm)+" seconds. Total: "+ | ||
| 791 | + length(*list_of_dubious(dos))+"\n"); | ||
| 792 | + error(timeout(dead_line)). | ||
| 793 | + | ||
| 794 | +define String | ||
| 795 | + pid | ||
| 796 | + = | ||
| 797 | + "[" + virtual_machine_id + "] ". | ||
| 798 | + | ||
| 799 | + | ||
| 800 | +define One | ||
| 801 | + put | ||
| 802 | + ( | ||
| 803 | + ByteArray source, | ||
| 804 | + ByteArray dest, | ||
| 805 | + Int position, | ||
| 806 | + Int i | ||
| 807 | + ) = | ||
| 808 | + if nth(i,source) is | ||
| 809 | + { | ||
| 810 | + failure then unique, | ||
| 811 | + success(b) then if put(dest,position,b) is | ||
| 812 | + { | ||
| 813 | + failure then unique, | ||
| 814 | + success(_) then put(source,dest,position+1,i+1) | ||
| 815 | + } | ||
| 816 | + }. | ||
| 817 | + | ||
| 818 | +define ReadResult | ||
| 819 | + read_from_connexion | ||
| 820 | + ( | ||
| 821 | + BufferedConnection connection, | ||
| 822 | + Int size, | ||
| 823 | + Int time_out, | ||
| 824 | + ByteArray result_buffer, | ||
| 825 | + Int position | ||
| 826 | + ) = | ||
| 827 | + //println(pid + "read_from_connexion(" + size + ")"); | ||
| 828 | + | ||
| 829 | + if *connection.read_pos < length(*connection.buffer) then | ||
| 830 | + //println(pid + " reading from buffer (size = " + length(*connection.buffer) + ", pos = " + *connection.read_pos); | ||
| 831 | + //with t1_tmp = (UTime) unow, | ||
| 832 | + with result = extract(*connection.buffer, *connection.read_pos, *connection.read_pos + size), | ||
| 833 | + size_read = length(result), | ||
| 834 | + put(result,result_buffer,position,0); | ||
| 835 | + connection.read_pos <- *connection.read_pos + size_read; | ||
| 836 | + //accumulate_t1(t1_tmp); | ||
| 837 | + if size > size_read then | ||
| 838 | + //println("Wanted " + size + ", read only " + size_read); | ||
| 839 | + | ||
| 840 | + terminal read_from_connexion(connection, size - size_read, time_out, result_buffer,position+size_read) | ||
| 841 | +// { | ||
| 842 | +// error then error, | ||
| 843 | +// timeout then ok(result), | ||
| 844 | +// ok(ba) then ok(result + ba) | ||
| 845 | +// } | ||
| 846 | + else | ||
| 847 | + ok(result_buffer) | ||
| 848 | + else | ||
| 849 | + //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else | ||
| 850 | + if read(connection.conn, 16384, time_out) is // the connection is closed after 10 minutes of inactivity | ||
| 851 | + { | ||
| 852 | + error then println(pid + "read failed)"); error, | ||
| 853 | + timeout then timeout, | ||
| 854 | + ok(ba) then | ||
| 855 | +// println(pid + "ba = " + length(ba)); | ||
| 856 | + connection.buffer <- ba; | ||
| 857 | + connection.read_pos <- 0; | ||
| 858 | + //println(pid + "rb = " + length(*read_buffer)); | ||
| 859 | + | ||
| 860 | + terminal read_from_connexion(connection, size, time_out, result_buffer,position) | ||
| 861 | + }. | ||
| 862 | + | ||
| 863 | +define Result(Error,Word8) | ||
| 864 | + next_char // reading a character (check the list first, and read on the connection | ||
| 865 | + // only when the list is empty). | ||
| 866 | + ( | ||
| 867 | + BufferedConnection connection, | ||
| 868 | + Int dead_line, | ||
| 869 | + DenialOfService dos | ||
| 870 | + ) = | ||
| 871 | + //with t2_tmp = (UTime) now, | ||
| 872 | + if *unput_chars is | ||
| 873 | + { | ||
| 874 | + [ ] then | ||
| 875 | + // /////////////////// | ||
| 876 | + // Buffered reading | ||
| 877 | + //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else | ||
| 878 | + if nth(*connection.read_pos, *connection.buffer) is | ||
| 879 | + { | ||
| 880 | + failure then | ||
| 881 | + if read_from_connexion(connection,1,600, constant_byte_array(1,0),0) is // the connection is closed after 10 minutes of inactivity | ||
| 882 | + { | ||
| 883 | + error then /*accumulate_t2(t2_tmp);*/ error(cannot_read_from_connection), | ||
| 884 | + timeout then /*accumulate_t2(t2_tmp);*/ error(timeout(600)), | ||
| 885 | + //record_dubious_connection(connection,dead_line,dos), | ||
| 886 | + ok(ba) then if nth(0,ba) is | ||
| 887 | + { | ||
| 888 | + failure then /*accumulate_t2(t2_tmp);*/ error(cannot_read_from_connection), | ||
| 889 | + success(c) then | ||
| 890 | + //println("-" + pid + "read [" + implode([c]) + "]\t"); | ||
| 891 | + //accumulate_t2(t2_tmp); | ||
| 892 | + ok(c) | ||
| 893 | + } | ||
| 894 | + }, | ||
| 895 | + success(c) then | ||
| 896 | + connection.read_pos <- *connection.read_pos + 1; | ||
| 897 | + //accumulate_t2(t2_tmp); | ||
| 898 | + ok(c) | ||
| 899 | + }, | ||
| 900 | + | ||
| 901 | + // /////////////////// | ||
| 902 | + // standard reading | ||
| 903 | +// if read(connection.conn, 1, 600) is // the connection is closed after 10 minutes of inactivity | ||
| 904 | +// { | ||
| 905 | +// error then accumulate_t2(t2_tmp); println(pid + "read failed)"); error(cannot_read_from_connection), | ||
| 906 | +// timeout then accumulate_t2(t2_tmp); error(timeout(600)), | ||
| 907 | +// ok(ba) then if nth(0,ba) is | ||
| 908 | +// { | ||
| 909 | +// failure then accumulate_t2(t2_tmp); error(cannot_read_from_connection), | ||
| 910 | +// success(c) then accumulate_t2(t2_tmp); | ||
| 911 | +// ok(c) | ||
| 912 | +// } | ||
| 913 | +// }, | ||
| 914 | + | ||
| 915 | + [h . t] then | ||
| 916 | + unput_chars <- t; //accumulate_t2(t2_tmp); | ||
| 917 | + ok(h) | ||
| 918 | + }. | ||
| 919 | + | ||
| 920 | + | ||
| 921 | + | ||
| 922 | + | ||
| 923 | + | ||
| 924 | + | ||
| 925 | + *** [2.4] Reading and discarding characters. | ||
| 926 | + | ||
| 927 | + The next function reads the specified number of bytes (this is the same as | ||
| 928 | + 'characters') from the connection and discards them. This is used for discarding CR LF | ||
| 929 | + just before the body of a request. | ||
| 930 | + | ||
| 931 | +define Result(Error,One) | ||
| 932 | + read_and_ignore | ||
| 933 | + ( | ||
| 934 | + BufferedConnection connection, // to client | ||
| 935 | + Int dead_line, | ||
| 936 | + Int number_of_characters, // number of characters to read and ignore | ||
| 937 | + DenialOfService dos | ||
| 938 | + ) = | ||
| 939 | + if number_of_characters =< 0 then ok(unique) else | ||
| 940 | + if next_char(connection, dead_line, dos) is | ||
| 941 | + { | ||
| 942 | + error(msg) then error(msg), | ||
| 943 | + ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos) | ||
| 944 | + }. | ||
| 945 | + | ||
| 946 | + | ||
| 947 | + | ||
| 948 | + | ||
| 949 | + | ||
| 950 | + | ||
| 951 | + | ||
| 952 | + *** [2.5] Reading a character string. | ||
| 953 | + | ||
| 954 | + Sometimes values of HTTP attributes or web args are presented in the form of double | ||
| 955 | + quoted strings. The next function handles the reading of such things. The leading | ||
| 956 | + double quote is already read in. We must read subsequent characters until the next non | ||
| 957 | + backslashed double quote. | ||
| 958 | + | ||
| 959 | +define Result(Error,String) | ||
| 960 | + read_string | ||
| 961 | + ( | ||
| 962 | + BufferedConnection connection, // connection with the client | ||
| 963 | + Int dead_line, | ||
| 964 | + List(Word8) so_far, // characters read so far (in reverse order) | ||
| 965 | + DenialOfService dos | ||
| 966 | + ) = | ||
| 967 | + if next_char(connection, dead_line,dos) is | ||
| 968 | + { | ||
| 969 | + error(msg) then error(msg), | ||
| 970 | + ok(c) then | ||
| 971 | + if c = '\\' | ||
| 972 | + then if next_char(connection,dead_line,dos) is | ||
| 973 | + { | ||
| 974 | + error(msg) then error(msg), | ||
| 975 | + ok(d) then | ||
| 976 | + if d = '\"' | ||
| 977 | + then read_string(connection,dead_line,['\"' . so_far],dos) | ||
| 978 | + else read_string(connection,dead_line,[d, c . so_far],dos) | ||
| 979 | + } | ||
| 980 | + else if c = '\"' | ||
| 981 | + then ok(implode(reverse(so_far))) | ||
| 982 | + else read_string(connection,dead_line,[c . so_far],dos) | ||
| 983 | + }. | ||
| 984 | + | ||
| 985 | + | ||
| 986 | + | ||
| 987 | + | ||
| 988 | + | ||
| 989 | + | ||
| 990 | + | ||
| 991 | + | ||
| 992 | + | ||
| 993 | + | ||
| 994 | + | ||
| 995 | + | ||
| 996 | + *** [2.7] Converting web arguments to ASCII. | ||
| 997 | + | ||
| 998 | + The function 'web_to_ascii' gets a character string and replaces web encoding by normal | ||
| 999 | + ASCII encoding. This amounts to replacing: | ||
| 1000 | + | ||
| 1001 | + + by blank | ||
| 1002 | + %xx by the character whose ASCII code is xx in hexadecimal | ||
| 1003 | + | ||
| 1004 | + Note: We assume that '9' < 'A' (which is the case for ASCII code). | ||
| 1005 | + | ||
| 1006 | + | ||
| 1007 | + | ||
| 1008 | +define Word8 | ||
| 1009 | + web_decode | ||
| 1010 | + ( | ||
| 1011 | + Word8 x1, | ||
| 1012 | + Word8 x2 | ||
| 1013 | + ) = | ||
| 1014 | + with n1 = if x1 +=< '9' then (x1 - '0') else if x1 +=< 'F' then (x1 - 'A' + 10) else (x1 - 'a' + 10), | ||
| 1015 | + n2 = if x2 +=< '9' then (x2 - '0') else if x2 +=< 'F' then (x2 - 'A' + 10) else (x2 - 'a' + 10), | ||
| 1016 | + (n1 << 4) + n2. | ||
| 1017 | + | ||
| 1018 | + | ||
| 1019 | + | ||
| 1020 | +define String | ||
| 1021 | + web_to_ascii | ||
| 1022 | + ( | ||
| 1023 | + String web_string, | ||
| 1024 | + Int n, // current position in web_string | ||
| 1025 | + List(Word8) so_far | ||
| 1026 | + ) = | ||
| 1027 | + if nth(n,web_string) is | ||
| 1028 | + { | ||
| 1029 | + failure then implode(reverse(so_far)), | ||
| 1030 | + success(c) then | ||
| 1031 | + if c = '+' | ||
| 1032 | + then web_to_ascii(web_string,n+1,[' ' . so_far]) | ||
| 1033 | + else if c = '%' | ||
| 1034 | + then if nth(n+1,web_string) is | ||
| 1035 | + { | ||
| 1036 | + failure then implode(reverse(so_far)), | ||
| 1037 | + success(x1) then if nth(n+2,web_string) is | ||
| 1038 | + { | ||
| 1039 | + failure then implode(reverse(so_far)), | ||
| 1040 | + success(x2) then web_to_ascii(web_string,n+3,[web_decode(x1,x2) . so_far]) | ||
| 1041 | + } | ||
| 1042 | + } | ||
| 1043 | + else web_to_ascii(web_string,n+1,[c . so_far]) | ||
| 1044 | + }. | ||
| 1045 | + | ||
| 1046 | + | ||
| 1047 | + | ||
| 1048 | + | ||
| 1049 | + | ||
| 1050 | + | ||
| 1051 | + | ||
| 1052 | + | ||
| 1053 | + *** [3] Managing the journal. | ||
| 1054 | + | ||
| 1055 | + Concurrently working machines should not try to access the same file at the same | ||
| 1056 | + time. This problem may be solved by using the 'protect' mecanism. | ||
| 1057 | + | ||
| 1058 | + | ||
| 1059 | + | ||
| 1060 | + *** [3.1] Naming journal files. | ||
| 1061 | + | ||
| 1062 | + Since journal messages are rather prolific, we should have at least one file per | ||
| 1063 | + hour. Hence, the name of a journal file must be constructed from the current year, | ||
| 1064 | + month, day and hour. For example, it may be: | ||
| 1065 | + | ||
| 1066 | + 2003_03_12_19 | ||
| 1067 | + | ||
| 1068 | + (this is for the journal of 7 PM to 8 PM, 2003/mar/12). | ||
| 1069 | + | ||
| 1070 | +define String | ||
| 1071 | + make_current_journal_file_name | ||
| 1072 | + = | ||
| 1073 | + if convert_time(now) is date_and_time(y,m,d,h,_,_,_,_,_) then | ||
| 1074 | + to_decimal(y)+"_"+ | ||
| 1075 | + zero_pad_n(2,m)+"_"+ | ||
| 1076 | + zero_pad_n(2,d)+"_"+ | ||
| 1077 | + zero_pad_n(2,h). | ||
| 1078 | + | ||
| 1079 | + | ||
| 1080 | + | ||
| 1081 | + | ||
| 1082 | + | ||
| 1083 | + | ||
| 1084 | + | ||
| 1085 | + *** [3.2] Formating HTTP headers. | ||
| 1086 | + | ||
| 1087 | + HTTP headers may be shown on the console or written in the journal. The function below | ||
| 1088 | + formats a list of HTTP headers. | ||
| 1089 | + | ||
| 1090 | +define String | ||
| 1091 | + show_format | ||
| 1092 | + ( | ||
| 1093 | + Web_Site_Description desc, | ||
| 1094 | + List(HTTP_header) headers, | ||
| 1095 | + ) = | ||
| 1096 | + if headers is | ||
| 1097 | + { | ||
| 1098 | + [ ] then "", | ||
| 1099 | + [h . t] then if h is http_header(name,value) then | ||
| 1100 | + if member(journal_headers(desc),name) | ||
| 1101 | + then " | "+name+": "+value+"\n"+show_format(desc,t) | ||
| 1102 | + else show_format(desc,t) | ||
| 1103 | + }. | ||
| 1104 | + | ||
| 1105 | + | ||
| 1106 | + | ||
| 1107 | + | ||
| 1108 | + | ||
| 1109 | + | ||
| 1110 | + *** [3.3] Formating web arguments. | ||
| 1111 | + | ||
| 1112 | + The same thing for web arguments. | ||
| 1113 | + | ||
| 1114 | +define String | ||
| 1115 | + show_format | ||
| 1116 | + ( | ||
| 1117 | + List(Web_arg) lwa | ||
| 1118 | + ) = | ||
| 1119 | + if lwa is | ||
| 1120 | + { | ||
| 1121 | + [ ] then "", | ||
| 1122 | + [h . t] then if h is | ||
| 1123 | + { | ||
| 1124 | + web_arg(n,v) then | ||
| 1125 | + " | "+n+"="+(if nth(0,n) = success('p') then "<not shown>" else v)+"\n"+show_format(t), | ||
| 1126 | + upload(n,fn,tfn) then | ||
| 1127 | + " | "+n+"="+fn+" (uploaded as '"+tfn+"')\n"+show_format(t) | ||
| 1128 | + } | ||
| 1129 | + }. | ||
| 1130 | + | ||
| 1131 | + | ||
| 1132 | + | ||
| 1133 | + | ||
| 1134 | + | ||
| 1135 | + | ||
| 1136 | + *** [3.4] Formating the whole request. | ||
| 1137 | + | ||
| 1138 | + It is cheap to transform month numbers into abbreviated month names. This enhances the | ||
| 1139 | + readability of the journal. | ||
| 1140 | + | ||
| 1141 | +define String | ||
| 1142 | + format_month | ||
| 1143 | + ( | ||
| 1144 | + Int m | ||
| 1145 | + ) = | ||
| 1146 | + if m = 1 then "jan" else | ||
| 1147 | + if m = 2 then "feb" else | ||
| 1148 | + if m = 3 then "mar" else | ||
| 1149 | + if m = 4 then "apr" else | ||
| 1150 | + if m = 5 then "may" else | ||
| 1151 | + if m = 6 then "jun" else | ||
| 1152 | + if m = 7 then "jul" else | ||
| 1153 | + if m = 8 then "aug" else | ||
| 1154 | + if m = 9 then "sep" else | ||
| 1155 | + if m = 10 then "oct" else | ||
| 1156 | + if m = 11 then "nov" else | ||
| 1157 | + if m = 12 then "dec" else | ||
| 1158 | + "???". | ||
| 1159 | + | ||
| 1160 | + | ||
| 1161 | + Below we format a whole HTTP request. This may give this (actually, it depends on how | ||
| 1162 | + you defined the values of 'journal_headers' and 'journal_extensions'): | ||
| 1163 | + | ||
| 1164 | + [3] 2003/mar/10 10:06:57 from 123.456.123.456: /homepage.awp | ||
| 1165 | + | host: www.the-best-one.com | ||
| 1166 | + | user-agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0 | ||
| 1167 | + | ||
| 1168 | + The leading number between brackets is the number of the virtual machine which served | ||
| 1169 | + the URI. | ||
| 1170 | + | ||
| 1171 | +define String | ||
| 1172 | + format_request | ||
| 1173 | + ( | ||
| 1174 | + Web_Site_Description desc, | ||
| 1175 | + Connection client_connection, | ||
| 1176 | + HTTP_RequestLine request_line, | ||
| 1177 | + List(HTTP_header) headers, | ||
| 1178 | + List(Web_arg) web_args | ||
| 1179 | + ) = | ||
| 1180 | + with dt = convert_time(now), | ||
| 1181 | + if remote_IP_address_and_port(client_connection) is (addr,port) then | ||
| 1182 | + to_decimal(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_n(2,day(dt))+" "+ | ||
| 1183 | + zero_pad_n(2,hour(dt))+":"+zero_pad_n(2,minute(dt))+":"+zero_pad_n(2,second(dt))+ | ||
| 1184 | + " from "+ip_addr_to_string(addr)+ | ||
| 1185 | + ": "+uri(request_line)+"\n"+ | ||
| 1186 | + show_format(desc,headers)+ | ||
| 1187 | + show_format(web_args). | ||
| 1188 | + | ||
| 1189 | + | ||
| 1190 | + | ||
| 1191 | + | ||
| 1192 | + | ||
| 1193 | + | ||
| 1194 | + | ||
| 1195 | + *** [3.5] Putting it in the journal file (and on the console). | ||
| 1196 | + | ||
| 1197 | + We must not forget to 'protect' this operation, so that the messages of two machines | ||
| 1198 | + (working for the same site) will not be mixed together. | ||
| 1199 | + | ||
| 1200 | +define One | ||
| 1201 | + log_journal_msg | ||
| 1202 | + ( | ||
| 1203 | + Web_Site_Description desc, | ||
| 1204 | + String msg, | ||
| 1205 | + ) = | ||
| 1206 | + with ba_msg = to_byte_array("["+virtual_machine_id+"] "+msg+"\n"), | ||
| 1207 | + protect | ||
| 1208 | + ( | ||
| 1209 | + if file(site_directory(desc)+"/journal/"+make_current_journal_file_name,append) is | ||
| 1210 | + { | ||
| 1211 | + failure then unique, | ||
| 1212 | + success(journal_file) then | ||
| 1213 | + forget(reliable_write(file(journal_file),ba_msg)) | ||
| 1214 | + }; | ||
| 1215 | + forget(reliable_write(file(stdout),ba_msg)) | ||
| 1216 | + ). | ||
| 1217 | + | ||
| 1218 | + | ||
| 1219 | + | ||
| 1220 | + | ||
| 1221 | + | ||
| 1222 | + | ||
| 1223 | + | ||
| 1224 | + *** [4] Reading the HTTP request. | ||
| 1225 | + | ||
| 1226 | + | ||
| 1227 | + *** [4.1] Skipping leading blanks. | ||
| 1228 | + | ||
| 1229 | + One of the peculiarities of HTTP is that the characters 13 (carriage return) and 10 | ||
| 1230 | + (line feed) followed by either a space (32) or a tab (9), is considered as a blank not | ||
| 1231 | + containing any new line. 'skip_http_blanks' must skip all blanks characters until the | ||
| 1232 | + first non blank character, which should not be read in. Obviously, because of the above | ||
| 1233 | + peculiarity, we need at least 3 characters of lookahead to do this. In other words, we | ||
| 1234 | + must be able to unput at least 3 characters (hopefully we are). | ||
| 1235 | + | ||
| 1236 | + Strictly blanks characters are 'space' and 'tab'. | ||
| 1237 | + | ||
| 1238 | +define Bool | ||
| 1239 | + is_strict_blank | ||
| 1240 | + ( | ||
| 1241 | + Word8 c | ||
| 1242 | + ) = | ||
| 1243 | + if c = ' ' then true else c = '\t'. | ||
| 1244 | + | ||
| 1245 | + | ||
| 1246 | + On the contrary, blanks include 13 and 10. | ||
| 1247 | + | ||
| 1248 | +define Bool | ||
| 1249 | + is_blank | ||
| 1250 | + ( | ||
| 1251 | + Word8 c | ||
| 1252 | + ) = | ||
| 1253 | + if c = ' ' then true else | ||
| 1254 | + if c = '\t' then true else | ||
| 1255 | + if c = 13 then true else | ||
| 1256 | + c = 10. | ||
| 1257 | + | ||
| 1258 | + | ||
| 1259 | + Skipping HTTP blanks. | ||
| 1260 | + | ||
| 1261 | +define Result(Error,One) | ||
| 1262 | + skip_http_blanks | ||
| 1263 | + ( | ||
| 1264 | + BufferedConnection connection, | ||
| 1265 | + Int dead_line, | ||
| 1266 | + DenialOfService dos | ||
| 1267 | + ) = | ||
| 1268 | + if next_char(connection,dead_line,dos) is | ||
| 1269 | + { | ||
| 1270 | + error(msg) then error(msg), | ||
| 1271 | + ok(c) then | ||
| 1272 | + if is_strict_blank(c) | ||
| 1273 | + then skip_http_blanks(connection,dead_line,dos) | ||
| 1274 | + else if c = 13 | ||
| 1275 | + then if next_char(connection,dead_line,dos) is | ||
| 1276 | + { | ||
| 1277 | + error(msg) then error(msg), // (unput(c); ok(unique)), | ||
| 1278 | + ok(d) then | ||
| 1279 | + if d = 10 | ||
| 1280 | + then if next_char(connection,dead_line,dos) is | ||
| 1281 | + { | ||
| 1282 | + error(msg) then error(msg), // (unput(d); unput(c); ok(unique)), | ||
| 1283 | + ok(e) then | ||
| 1284 | + if is_strict_blank(e) | ||
| 1285 | + then skip_http_blanks(connection,dead_line,dos) | ||
| 1286 | + else (unput(e); unput(d); unput(c); ok(unique)) | ||
| 1287 | + } | ||
| 1288 | + else (unput(d); unput(c); ok(unique)) | ||
| 1289 | + } | ||
| 1290 | + else (unput(c); ok(unique)) | ||
| 1291 | + }. | ||
| 1292 | + | ||
| 1293 | + | ||
| 1294 | + | ||
| 1295 | + | ||
| 1296 | + | ||
| 1297 | + | ||
| 1298 | + | ||
| 1299 | + | ||
| 1300 | + *** [4.2] Reading a new line. | ||
| 1301 | + | ||
| 1302 | + Normally in HTTP a new line is the sequence 13 10 (carriage return line feed), not | ||
| 1303 | + followed by a space or tabulator. If it is followed by a space or tabulator, the three | ||
| 1304 | + characters are considered blanks, and no new line has been read. Before trying to read | ||
| 1305 | + a new line, we first skip leading spaces and tabs. Then we try to read 13 and 10, and | ||
| 1306 | + we read another character. if this character is space or tab, we consider we have read | ||
| 1307 | + only blanks and we continue reading in order to find our new line. Otherwise, we unput | ||
| 1308 | + this character (which may be for example the first character of the name of the next | ||
| 1309 | + header), and answer that we have seen a new line. | ||
| 1310 | + | ||
| 1311 | + Warning: we must not use this function for reading the last pair (13,10) before the | ||
| 1312 | + beginning of the body, because if the body is empty, there is no character to read | ||
| 1313 | + after this pair, so that the server could wait for a character which will never | ||
| 1314 | + come. This is the reason for 'read_and_ignore' above, which is used precisely for | ||
| 1315 | + reading that last (13,10) pair. | ||
| 1316 | + | ||
| 1317 | +define Result(Error,One) | ||
| 1318 | + read_new_line | ||
| 1319 | + ( | ||
| 1320 | + BufferedConnection connection, | ||
| 1321 | + Int dead_line, | ||
| 1322 | + DenialOfService dos | ||
| 1323 | + ) = | ||
| 1324 | + if skip_http_blanks(connection,dead_line,dos) is | ||
| 1325 | + { | ||
| 1326 | + error(msg) then error(msg), | ||
| 1327 | + ok(_) then | ||
| 1328 | + if next_char(connection,dead_line,dos) is | ||
| 1329 | + { | ||
| 1330 | + error(msg) then error(msg), | ||
| 1331 | + ok(c) then | ||
| 1332 | + if c = 13 | ||
| 1333 | + then if next_char(connection,dead_line,dos) is | ||
| 1334 | + { | ||
| 1335 | + error(msg) then error(msg), | ||
| 1336 | + ok(d) then | ||
| 1337 | + if d = 10 | ||
| 1338 | + then ok(unique) | ||
| 1339 | + else (unput(d); | ||
| 1340 | + unput(c); | ||
| 1341 | + error(end_of_line_expected)) | ||
| 1342 | + } | ||
| 1343 | + else (unput(c); | ||
| 1344 | + error(end_of_line_expected)) | ||
| 1345 | + }}. | ||
| 1346 | + | ||
| 1347 | + | ||
| 1348 | + | ||
| 1349 | + | ||
| 1350 | + | ||
| 1351 | + | ||
| 1352 | + | ||
| 1353 | + | ||
| 1354 | + *** [4.3] Reading a 'word'. | ||
| 1355 | + | ||
| 1356 | + A 'word' is a sequence of characters which begins either by a double quote or not by a | ||
| 1357 | + double quote. (However, any leading blanks are read in and ignored. This is | ||
| 1358 | + accomplished by 'skip_http_blanks'.) If it begins by a double quote, it is read like a | ||
| 1359 | + string, i.e. it ends at the next (non backslashed) double quote. Otherwise, it is | ||
| 1360 | + right delimited by any character which may be considered as 'blank'. If the word is | ||
| 1361 | + double quoted, the closing double quote is read in. On the contrary, if the word is not | ||
| 1362 | + double quoted, the right delimiting blank character is not read in (it is 'unput' back | ||
| 1363 | + into the connection), and may be read in again. This is needed because carriage return | ||
| 1364 | + or line feed which are 'blank', also have a meaning in HTTP. | ||
| 1365 | + | ||
| 1366 | +define Result(Error,String) | ||
| 1367 | + read_word_aux | ||
| 1368 | + ( | ||
| 1369 | + BufferedConnection connection, | ||
| 1370 | + Int dead_line, | ||
| 1371 | + List(Word8) so_far, | ||
| 1372 | + DenialOfService dos | ||
| 1373 | + ) = | ||
| 1374 | + if next_char(connection,dead_line,dos) is | ||
| 1375 | + { | ||
| 1376 | + error(msg) then error(msg), | ||
| 1377 | + ok(c) then | ||
| 1378 | + if is_blank(c) | ||
| 1379 | + then (unput(c); | ||
| 1380 | + ok(implode(reverse(so_far)))) | ||
| 1381 | + else read_word_aux(connection,dead_line,[c . so_far],dos) | ||
| 1382 | + }. | ||
| 1383 | + | ||
| 1384 | +define Result(Error,String) | ||
| 1385 | + read_word | ||
| 1386 | + ( | ||
| 1387 | + BufferedConnection connection, | ||
| 1388 | + Int dead_line, | ||
| 1389 | + DenialOfService dos | ||
| 1390 | + ) = | ||
| 1391 | + if skip_http_blanks(connection,dead_line,dos) is | ||
| 1392 | + { | ||
| 1393 | + error(msg) then error(msg), | ||
| 1394 | + ok(_) then | ||
| 1395 | + if next_char(connection,dead_line,dos) is | ||
| 1396 | + { | ||
| 1397 | + error(msg) then error(msg), | ||
| 1398 | + ok(c) then | ||
| 1399 | + if c = '\"' | ||
| 1400 | + then read_string(connection,dead_line,[],dos) | ||
| 1401 | + else read_word_aux(connection,dead_line,[c],dos) | ||
| 1402 | + } | ||
| 1403 | + }. | ||
| 1404 | + | ||
| 1405 | + | ||
| 1406 | + | ||
| 1407 | + | ||
| 1408 | + | ||
| 1409 | + | ||
| 1410 | + | ||
| 1411 | + | ||
| 1412 | + *** [4.4] Separating the URI from the query string. | ||
| 1413 | + | ||
| 1414 | + A 'query string' may be postfixed to the URI, just after a question mark. For example, | ||
| 1415 | + the client may send the following request: | ||
| 1416 | + | ||
| 1417 | + GET /catalog.awp?item=3&color=blue | ||
| 1418 | + | ||
| 1419 | + We separate this into an URI: "/catalog.awp" and the string: "item=3&color=blue" which | ||
| 1420 | + will be later transformed into the list: | ||
| 1421 | + | ||
| 1422 | + [web_arg("item","3"),web_arg("color","blue")] | ||
| 1423 | + | ||
| 1424 | + | ||
| 1425 | +define (String,String) | ||
| 1426 | + separate_uri_from_query_string | ||
| 1427 | + ( | ||
| 1428 | + String uri_and_query_string, | ||
| 1429 | + Int n | ||
| 1430 | + ) = | ||
| 1431 | + if nth(n,uri_and_query_string) is | ||
| 1432 | + { | ||
| 1433 | + failure then (uri_and_query_string,""), | ||
| 1434 | + success(c) then | ||
| 1435 | + if c = '?' | ||
| 1436 | + then (substr(uri_and_query_string,0,n), | ||
| 1437 | + substr(uri_and_query_string,n+1,length(uri_and_query_string)-(n+1))) | ||
| 1438 | + else separate_uri_from_query_string(uri_and_query_string,n+1) | ||
| 1439 | + }. | ||
| 1440 | + | ||
| 1441 | + | ||
| 1442 | + | ||
| 1443 | + | ||
| 1444 | + | ||
| 1445 | + | ||
| 1446 | + | ||
| 1447 | + | ||
| 1448 | + | ||
| 1449 | + *** [4.5] Reading the web arguments. | ||
| 1450 | + | ||
| 1451 | + HTTP/HTTPS requests are sent in one of two formats: | ||
| 1452 | + | ||
| 1453 | + (1) www-url encoded | ||
| 1454 | + (2) multipart/form-data encoded | ||
| 1455 | + | ||
| 1456 | + The first one is the normal (historical) way of encoding. The second one is required | ||
| 1457 | + for uploading files. A server which is supposed to accept upload of files must handle | ||
| 1458 | + both formats. The first thing to do is to decide the format of the request. This is | ||
| 1459 | + easily done by examining the HTTP headers. If we find the header: | ||
| 1460 | + | ||
| 1461 | + Content-Type: multipart/form-data | ||
| 1462 | + | ||
| 1463 | + the request is multipart/form-data encoded. Otherwise, it is 'www-url' encoded. We | ||
| 1464 | + first consider 'www-url' encoded requests. | ||
| 1465 | + | ||
| 1466 | + For a 'www-url' encoded request, the web argument are either in the query string or in | ||
| 1467 | + the body of the request, or both. The format is the same for both: | ||
| 1468 | + | ||
| 1469 | + name=value&name=value&... | ||
| 1470 | + | ||
| 1471 | + However, we may also have | ||
| 1472 | + | ||
| 1473 | + name | ||
| 1474 | + name= | ||
| 1475 | + name=&... | ||
| 1476 | + name&... | ||
| 1477 | + | ||
| 1478 | + i.e. some parts may be missing. Hence, we must be careful. | ||
| 1479 | + | ||
| 1480 | + Furthermore, web arguments must be translated from web to ASCII when www-url encoded. | ||
| 1481 | + | ||
| 1482 | +define Bool | ||
| 1483 | + is_ampersand_or_equal | ||
| 1484 | + ( | ||
| 1485 | + Word8 c | ||
| 1486 | + ) = | ||
| 1487 | + if c = '&' then true else c = '='. | ||
| 1488 | + | ||
| 1489 | + | ||
| 1490 | + | ||
| 1491 | + The function 'read_name_or_value' reads the string 's' starting at position 'n' until | ||
| 1492 | + either the end of the string or the first '&' or '='. | ||
| 1493 | + | ||
| 1494 | +define String | ||
| 1495 | + read_name_or_value | ||
| 1496 | + ( | ||
| 1497 | + String s, | ||
| 1498 | + Int start, | ||
| 1499 | + Int i | ||
| 1500 | + ) = | ||
| 1501 | + if nth(i,s) is | ||
| 1502 | + { | ||
| 1503 | + failure then substr(s,start,i - start), | ||
| 1504 | + success(c) then | ||
| 1505 | + if is_ampersand_or_equal(c) | ||
| 1506 | + then substr(s,start,i-start) // the separator is not included | ||
| 1507 | + else read_name_or_value(s,start,i+1) | ||
| 1508 | + }. | ||
| 1509 | + | ||
| 1510 | + | ||
| 1511 | +define List(Web_arg) | ||
| 1512 | + read_www_url_encoded_web_args | ||
| 1513 | + ( | ||
| 1514 | + String s, | ||
| 1515 | + Int start, | ||
| 1516 | + ) = | ||
| 1517 | + with first = read_name_or_value(s,start,start), | ||
| 1518 | + if first = "" | ||
| 1519 | + then [] | ||
| 1520 | + else with i = start+length(first), | ||
| 1521 | + if nth(i,s) is | ||
| 1522 | + { | ||
| 1523 | + failure then [web_arg(first,"")], | ||
| 1524 | + success(c) then | ||
| 1525 | + if c = '&' | ||
| 1526 | + then [web_arg(first,"") . read_www_url_encoded_web_args(s,i+1)] | ||
| 1527 | + else if c = '=' | ||
| 1528 | + then with second1 = read_name_or_value(s,i+1,i+1), | ||
| 1529 | + // print("\""+second1+"\"\n"); | ||
| 1530 | + with second = web_to_ascii(second1,0,[]), | ||
| 1531 | + [web_arg(first,second) . read_www_url_encoded_web_args(s,i+length(second1)+2)] | ||
| 1532 | + else print("**** ALERT **** badly formatted argument [" + s + "]!!!\n"); | ||
| 1533 | + [] | ||
| 1534 | + }. | ||
| 1535 | + | ||
| 1536 | + | ||
| 1537 | + | ||
| 1538 | + | ||
| 1539 | + | ||
| 1540 | + *** [4.7] Reading the request line. | ||
| 1541 | + | ||
| 1542 | + 'read_request_line' reads three words and a new line from the connection. It tries to | ||
| 1543 | + recognize "get" or "post" in the first word, separates the URI from the query string in | ||
| 1544 | + the second word, transforms the query string into a list of 'Web_arg', and finally | ||
| 1545 | + returns a datum of type 'HTTP_RequestLine' if no error arose. | ||
| 1546 | + | ||
| 1547 | + | ||
| 1548 | +define Result(Error,HTTP_RequestType) | ||
| 1549 | + identify_get_or_post | ||
| 1550 | + ( | ||
| 1551 | + String s | ||
| 1552 | + ) = | ||
| 1553 | + with ls = to_lower(s), | ||
| 1554 | + if ls = "get" then ok(get) else | ||
| 1555 | + if ls = "post" then ok(post) else | ||
| 1556 | + error(not_get_or_post_request(ls)). | ||
| 1557 | + | ||
| 1558 | +define Result(Error,HTTP_RequestLine) | ||
| 1559 | + read_request_line | ||
| 1560 | + ( | ||
| 1561 | + BufferedConnection connection, | ||
| 1562 | + Int dead_line, | ||
| 1563 | + DenialOfService dos | ||
| 1564 | + ) = | ||
| 1565 | + if read_word(connection,dead_line,dos) is | ||
| 1566 | + { | ||
| 1567 | + error(msg) then error(msg), | ||
| 1568 | + ok(get_or_post) then if read_word(connection,dead_line,dos) is | ||
| 1569 | + { | ||
| 1570 | + error(msg) then error(msg), | ||
| 1571 | + ok(uri_and_query_string) then if read_word(connection,dead_line,dos) is | ||
| 1572 | + { | ||
| 1573 | + error(msg) then error(msg), | ||
| 1574 | + ok(http_version) then if read_new_line(connection,dead_line,dos) is | ||
| 1575 | + { | ||
| 1576 | + error(msg) then error(msg), | ||
| 1577 | + ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is | ||
| 1578 | + (uri,query_string) then if identify_get_or_post(get_or_post) is | ||
| 1579 | + { | ||
| 1580 | + error(msg) then error(msg), | ||
| 1581 | + ok(request_type) then | ||
| 1582 | + ok(request_line(request_type, web_to_ascii(uri, 0, []), read_www_url_encoded_web_args(query_string,0))) | ||
| 1583 | + } | ||
| 1584 | + } | ||
| 1585 | + } | ||
| 1586 | + } | ||
| 1587 | + }. | ||
| 1588 | + | ||
| 1589 | + | ||
| 1590 | + | ||
| 1591 | + | ||
| 1592 | + | ||
| 1593 | + | ||
| 1594 | + | ||
| 1595 | + *** [4.8] Reading the HTTP headers. | ||
| 1596 | + | ||
| 1597 | + Each header is made of a name (containing only letters, the underscore, digits and the | ||
| 1598 | + minus sign), a colon, a value, and a new line. The first empty line ends the headers. | ||
| 1599 | + | ||
| 1600 | + | ||
| 1601 | + The next function tests characters acceptable in a header name. | ||
| 1602 | + | ||
| 1603 | +define Bool | ||
| 1604 | + is_header_name_char | ||
| 1605 | + ( | ||
| 1606 | + Word8 c | ||
| 1607 | + ) = | ||
| 1608 | + if ('a' +=< c & c +=< 'z') then true else | ||
| 1609 | + if ('A' +=< c & c +=< 'Z') then true else | ||
| 1610 | + if ('0' +=< c & c +=< '9') then true else | ||
| 1611 | + if c = '-' then true else | ||
| 1612 | + c = '_'. | ||
| 1613 | + | ||
| 1614 | +define Result(Error,String) | ||
| 1615 | + read_header_name | ||
| 1616 | + ( | ||
| 1617 | + BufferedConnection connection, | ||
| 1618 | + Int dead_line, | ||
| 1619 | + List(Word8) so_far, | ||
| 1620 | + DenialOfService dos | ||
| 1621 | + ) = | ||
| 1622 | + if next_char(connection,dead_line,dos) is | ||
| 1623 | + { | ||
| 1624 | + error(msg) then error(msg), | ||
| 1625 | + ok(c) then | ||
| 1626 | + if is_header_name_char(c) | ||
| 1627 | + then read_header_name(connection,dead_line,[to_lower(c) . so_far],dos) | ||
| 1628 | + else unput(c); ok(implode(reverse(so_far))) | ||
| 1629 | + }. | ||
| 1630 | + | ||
| 1631 | +define Result(Error,One) | ||
| 1632 | + skip_colon | ||
| 1633 | + ( | ||
| 1634 | + BufferedConnection connection, | ||
| 1635 | + Int dead_line, | ||
| 1636 | + DenialOfService dos | ||
| 1637 | + ) = | ||
| 1638 | + if skip_http_blanks(connection,dead_line,dos) is | ||
| 1639 | + { | ||
| 1640 | + error(msg) then error(msg), | ||
| 1641 | + ok(_) then | ||
| 1642 | + if next_char(connection,dead_line,dos) is | ||
| 1643 | + { | ||
| 1644 | + error(msg) then error(msg), | ||
| 1645 | + ok(c) then | ||
| 1646 | + if c = ':' | ||
| 1647 | + then ok(unique) | ||
| 1648 | + else error(colon_expected) | ||
| 1649 | + }}. | ||
| 1650 | + | ||
| 1651 | + | ||
| 1652 | +define Result(Error,String) | ||
| 1653 | + read_header_value | ||
| 1654 | + ( | ||
| 1655 | + BufferedConnection connection, | ||
| 1656 | + Int dead_line, | ||
| 1657 | + List(Word8) so_far, | ||
| 1658 | + DenialOfService dos | ||
| 1659 | + ) = | ||
| 1660 | + if next_char(connection,dead_line,dos) is | ||
| 1661 | + { | ||
| 1662 | + error(msg) then error(msg), | ||
| 1663 | + ok(c) then | ||
| 1664 | + if c = 13 | ||
| 1665 | + then if next_char(connection,dead_line,dos) is | ||
| 1666 | + { | ||
| 1667 | + error(msg) then error(msg), | ||
| 1668 | + ok(d) then | ||
| 1669 | + if d = 10 | ||
| 1670 | + then if next_char(connection,dead_line,dos) is | ||
| 1671 | + { | ||
| 1672 | + error(msg) then error(msg), | ||
| 1673 | + ok(e) then | ||
| 1674 | + if is_strict_blank(e) | ||
| 1675 | + then read_header_value(connection,dead_line,[e . so_far],dos) | ||
| 1676 | + else (unput(e); ok(implode(reverse(so_far)))) | ||
| 1677 | + } | ||
| 1678 | + else read_header_value(connection,dead_line,[d, c . so_far],dos) | ||
| 1679 | + } | ||
| 1680 | + else read_header_value(connection,dead_line,[c . so_far],dos) | ||
| 1681 | + }. | ||
| 1682 | + | ||
| 1683 | + | ||
| 1684 | + Reading a single header. | ||
| 1685 | + | ||
| 1686 | +define Result(Error,Maybe(HTTP_header)) | ||
| 1687 | + read_header | ||
| 1688 | + ( | ||
| 1689 | + BufferedConnection connection, | ||
| 1690 | + Int dead_line, | ||
| 1691 | + DenialOfService dos | ||
| 1692 | + ) = | ||
| 1693 | + if read_header_name(connection,dead_line,[],dos) is | ||
| 1694 | + { | ||
| 1695 | + error(msg) then error(msg), | ||
| 1696 | + ok(name) then | ||
| 1697 | + if name = "" then | ||
| 1698 | + if read_and_ignore(connection,dead_line,2,dos) /* 13 and 10 */ is | ||
| 1699 | + { | ||
| 1700 | + error(msg) then error(msg), | ||
| 1701 | + ok(_) then // this is the blank line | ||
| 1702 | + ok(failure) // end of headers | ||
| 1703 | + } | ||
| 1704 | + else if skip_colon(connection,dead_line,dos) is | ||
| 1705 | + { | ||
| 1706 | + error(msg) then error(msg), | ||
| 1707 | + ok(_) then if skip_http_blanks(connection,dead_line,dos) is | ||
| 1708 | + { | ||
| 1709 | + error(msg) then error(msg), | ||
| 1710 | + ok(_) then if read_header_value(connection,dead_line,[],dos) is | ||
| 1711 | + { | ||
| 1712 | + error(msg) then error(msg), | ||
| 1713 | + ok(value) then | ||
| 1714 | + ok(success(http_header(name,value))) | ||
| 1715 | + } | ||
| 1716 | + } | ||
| 1717 | + } | ||
| 1718 | + }. | ||
| 1719 | + | ||
| 1720 | + | ||
| 1721 | + | ||
| 1722 | + Reading all the headers. | ||
| 1723 | + | ||
| 1724 | +define Result(Error,List(HTTP_header)) | ||
| 1725 | + read_http_headers | ||
| 1726 | + ( | ||
| 1727 | + BufferedConnection connection, | ||
| 1728 | + Int dead_line, | ||
| 1729 | + DenialOfService dos | ||
| 1730 | + ) = | ||
| 1731 | + if read_header(connection,dead_line,dos) is | ||
| 1732 | + { | ||
| 1733 | + error(msg) then error(msg), | ||
| 1734 | + ok(mbh) then if mbh is | ||
| 1735 | + { | ||
| 1736 | + failure then ok([ ]), | ||
| 1737 | + success(header) then | ||
| 1738 | + if read_http_headers(connection,dead_line,dos) is | ||
| 1739 | + { | ||
| 1740 | + error(msg) then error(msg), | ||
| 1741 | + ok(others) then ok([header . others]) | ||
| 1742 | + } | ||
| 1743 | + } | ||
| 1744 | + }. | ||
| 1745 | + | ||
| 1746 | + | ||
| 1747 | + | ||
| 1748 | + | ||
| 1749 | + | ||
| 1750 | + | ||
| 1751 | + | ||
| 1752 | + *** [4.9] Getting the size of the request's body. | ||
| 1753 | + | ||
| 1754 | + The size of the body of the request is given under the 'Content-Length' header. If this | ||
| 1755 | + header is not present, the size is assumed to be zero. | ||
| 1756 | + | ||
| 1757 | +define Result(Error,Int) | ||
| 1758 | + get_body_size | ||
| 1759 | + ( | ||
| 1760 | + List(HTTP_header) headers | ||
| 1761 | + ) = | ||
| 1762 | + if headers is | ||
| 1763 | + { | ||
| 1764 | + [ ] then ok(0), | ||
| 1765 | + [h . t] then if h is http_header(name,value) then | ||
| 1766 | + if name = "content-length" | ||
| 1767 | + then if decimal_scan(value) is | ||
| 1768 | + { | ||
| 1769 | + failure then error(incorrect_content_length_value), | ||
| 1770 | + success(n) then ok(n) | ||
| 1771 | + } | ||
| 1772 | + else get_body_size(t) | ||
| 1773 | + }. | ||
| 1774 | + | ||
| 1775 | + | ||
| 1776 | + | ||
| 1777 | + | ||
| 1778 | + | ||
| 1779 | + | ||
| 1780 | + | ||
| 1781 | + | ||
| 1782 | + | ||
| 1783 | + | ||
| 1784 | + *** [4.10] Reading the body of the request. | ||
| 1785 | + | ||
| 1786 | + The body of the request may be very big (it contains uploaded files, if any). We read | ||
| 1787 | + it using the primitive 'read', which returns the number of bytes read, which may be | ||
| 1788 | + less than the number of bytes we wanted to read. This is not an error, but simply due | ||
| 1789 | + to the fact the buffer associated with the connection in the Linux (or MS-Windows) | ||
| 1790 | + kernel has a limited size. Hence, we must read bytes again until we have read the | ||
| 1791 | + required number of bytes. However, if the number of bytes read is zero, the connection | ||
| 1792 | + may be broken. In that case, we must not try to read indefinitely. On the contrary, we | ||
| 1793 | + make at most 10 retries, with a small sleeping time between any two of them. | ||
| 1794 | + | ||
| 1795 | +define Result(Error,ByteArray) | ||
| 1796 | + read_http_body | ||
| 1797 | + ( | ||
| 1798 | + BufferedConnection connection, | ||
| 1799 | + Int body_size, | ||
| 1800 | + ByteArray so_far, // when calling this function, 'so_far' is the empty byte array | ||
| 1801 | + Int retries // this function is called with retries = 10 | ||
| 1802 | + ) = | ||
| 1803 | + if body_size = 0 then ok(constant_byte_array(0,0)) else | ||
| 1804 | + if retries =< 0 then error(cannot_read_from_connection) else | ||
| 1805 | + if read_from_connexion(connection,body_size,60,constant_byte_array(body_size,0),0) is | ||
| 1806 | + { | ||
| 1807 | + error then error(cannot_read_from_connection), | ||
| 1808 | + timeout then error(timeout(60)), | ||
| 1809 | + ok(new_bytes) then with | ||
| 1810 | + ba = so_far + new_bytes, // contains all the bytes read so far | ||
| 1811 | + nr = length(ba), // total read since the beginning | ||
| 1812 | + nn = length(new_bytes), // number of bytes just read | ||
| 1813 | + if nr < body_size // must read more bytes | ||
| 1814 | + then if nn > 0 // if connection seems to work | ||
| 1815 | + then read_http_body(connection,body_size,ba,1000) // continue reading | ||
| 1816 | + else sleep(100); // otherwise, sleep 1/10 of second | ||
| 1817 | + read_http_body(connection,body_size,ba, // and retry reading | ||
| 1818 | + retries-1) // but no more than 10 times | ||
| 1819 | + else ok(ba) // required number of bytes has been read | ||
| 1820 | + }. | ||
| 1821 | + | ||
| 1822 | + | ||
| 1823 | + Note: During sleeping, 'anbexec' runs other machines. Actually, calling 'sleep', even | ||
| 1824 | + for one millisecond, is some way of giving up explicitly, so that other virtual | ||
| 1825 | + machines may work. | ||
| 1826 | + | ||
| 1827 | + | ||
| 1828 | + | ||
| 1829 | + | ||
| 1830 | + | ||
| 1831 | + | ||
| 1832 | + | ||
| 1833 | + | ||
| 1834 | + | ||
| 1835 | + | ||
| 1836 | + | ||
| 1837 | + | ||
| 1838 | + *** [5] Making the HTTP answer. | ||
| 1839 | + | ||
| 1840 | + At that point we have read the request line, the headers and the body of the | ||
| 1841 | + request, and we must decide what to do. | ||
| 1842 | + | ||
| 1843 | + Actually, we can do one of the following: | ||
| 1844 | + | ||
| 1845 | + - send a file, | ||
| 1846 | + - execute 'tickets_and_web_page' in case of an ".awp" URI. | ||
| 1847 | + | ||
| 1848 | + The uploaded file (which are in the body of the request) are saved into temporary files | ||
| 1849 | + below. | ||
| 1850 | + | ||
| 1851 | + | ||
| 1852 | + | ||
| 1853 | + | ||
| 1854 | + | ||
| 1855 | + *** [5.1] Avoiding illegal URIs. | ||
| 1856 | + | ||
| 1857 | + For security reasons, we must avoid illegal URIs, for example those which may climb up | ||
| 1858 | + in the file hierarchy. First we accept only few characters in URIs. | ||
| 1859 | + | ||
| 1860 | +define Bool | ||
| 1861 | + is_legal_uri_char | ||
| 1862 | + ( | ||
| 1863 | + Word8 c | ||
| 1864 | + ) = | ||
| 1865 | + if ('a' +=< c & c +=< 'z') then true else // accept 'a' to 'z' | ||
| 1866 | + if ('A' +=< c & c +=< 'Z') then true else // accept 'A' to 'Z' | ||
| 1867 | + if ('0' +=< c & c +=< '9') then true else // accept '0' to '9' | ||
| 1868 | + if c = '.' then true else // accept '.' '-' '/' and '_' | ||
| 1869 | + if c = '-' then true else | ||
| 1870 | + if c = '/' then true else | ||
| 1871 | + c = '_'. | ||
| 1872 | + | ||
| 1873 | + We do not accept ~ which is some way of climbing. Of course, we cannot disallow single | ||
| 1874 | + dots, which are most often present in legal URIs, but we must avoid double dots .. | ||
| 1875 | + which mean 'climb up'. | ||
| 1876 | + | ||
| 1877 | +define Bool | ||
| 1878 | + is_illegal_uri | ||
| 1879 | + ( | ||
| 1880 | + String uri, | ||
| 1881 | + Int n | ||
| 1882 | + ) = | ||
| 1883 | + if nth(n,uri) is | ||
| 1884 | + { | ||
| 1885 | + failure then false, | ||
| 1886 | + success(c) then | ||
| 1887 | + if c = '.' // first dot | ||
| 1888 | + then if nth(n+1,uri) is | ||
| 1889 | + { | ||
| 1890 | + failure then false, | ||
| 1891 | + success(d) then | ||
| 1892 | + if d = '.' // second dot | ||
| 1893 | + then true | ||
| 1894 | + else is_illegal_uri(uri,n+1) | ||
| 1895 | + } | ||
| 1896 | + else is_illegal_uri(uri,n+1) | ||
| 1897 | + }. | ||
| 1898 | + | ||
| 1899 | + | ||
| 1900 | + | ||
| 1901 | + | ||
| 1902 | + | ||
| 1903 | + | ||
| 1904 | + *** [5.2] Managing authorizations for downloading private files. | ||
| 1905 | + | ||
| 1906 | + Computing the authorization and making the authorization file (containing the absolute | ||
| 1907 | + path of the file on the server). | ||
| 1908 | + | ||
| 1909 | + | ||
| 1910 | +define String | ||
| 1911 | + compute_authorization | ||
| 1912 | + ( | ||
| 1913 | + String authorization_secret, | ||
| 1914 | + String absolute_path | ||
| 1915 | + ) = | ||
| 1916 | + to_ascii(sha1((authorization_secret, | ||
| 1917 | + absolute_path))). | ||
| 1918 | + | ||
| 1919 | + | ||
| 1920 | +public define String | ||
| 1921 | + make_authorization | ||
| 1922 | + ( | ||
| 1923 | + String site_directory, | ||
| 1924 | + String authorization_secret, | ||
| 1925 | + String absolute_path | ||
| 1926 | + ) = | ||
| 1927 | + with private_download_dir = site_directory+"/private_download", | ||
| 1928 | + auth = compute_authorization(authorization_secret, | ||
| 1929 | + absolute_path), | ||
| 1930 | + forget(save(absolute_path, | ||
| 1931 | + private_download_dir+"/z"+auth)); | ||
| 1932 | + auth. | ||
| 1933 | + | ||
| 1934 | + | ||
| 1935 | + The function 'send_file' defined below handles the recognition of authorizations. | ||
| 1936 | + | ||
| 1937 | + | ||
| 1938 | + | ||
| 1939 | + | ||
| 1940 | + | ||
| 1941 | + *** [5.3] Recognizing MIME types. | ||
| 1942 | + | ||
| 1943 | + The extension of the (redirected) URI must be either ".awp" or recognized as associated | ||
| 1944 | + to a MIME type. Otherwise, the server will not send the file. This is for security, but | ||
| 1945 | + also because, we must generate a 'Content-Type' header in the answer, with the right | ||
| 1946 | + MIME type. | ||
| 1947 | + | ||
| 1948 | +define String | ||
| 1949 | + get_uri_extension_aux | ||
| 1950 | + ( | ||
| 1951 | + String uri, | ||
| 1952 | + Int n // used for searching backwards | ||
| 1953 | + ) = | ||
| 1954 | + if nth(n,uri) is | ||
| 1955 | + { | ||
| 1956 | + failure then "", | ||
| 1957 | + success(c) then | ||
| 1958 | + if c = '.' then substr(uri,n,length(uri)-n) | ||
| 1959 | + else if c = '/' then "" | ||
| 1960 | + else get_uri_extension_aux(uri,n-1) | ||
| 1961 | + }. | ||
| 1962 | + | ||
| 1963 | +public define String | ||
| 1964 | + get_uri_extension | ||
| 1965 | + ( | ||
| 1966 | + String uri | ||
| 1967 | + ) = | ||
| 1968 | + get_uri_extension_aux(uri, | ||
| 1969 | + length(uri)-1). // search starts at the right end | ||
| 1970 | + | ||
| 1971 | +public define Bool | ||
| 1972 | + contains_no_case | ||
| 1973 | + ( | ||
| 1974 | + List(String) l, | ||
| 1975 | + String val | ||
| 1976 | + ) = | ||
| 1977 | + if l is | ||
| 1978 | + { | ||
| 1979 | + [] then false, | ||
| 1980 | + [h . t] then | ||
| 1981 | + if insensitive_equal(h, val) then true | ||
| 1982 | + else contains_no_case(t, val) | ||
| 1983 | + }. | ||
| 1984 | + | ||
| 1985 | + | ||
| 1986 | +define Maybe(MIME) | ||
| 1987 | + recognize_mime_type_from_ext | ||
| 1988 | + ( | ||
| 1989 | + String ext, | ||
| 1990 | + List(MIME) l | ||
| 1991 | + ) = | ||
| 1992 | + if l is | ||
| 1993 | + { | ||
| 1994 | + [ ] then success(mime("application", "octet-stream", [])), // failure, | ||
| 1995 | + [h . t] then if h is mime(type, subtype, extensions) then | ||
| 1996 | + if contains_no_case(extensions, ext) | ||
| 1997 | + then success(h) | ||
| 1998 | + else recognize_mime_type_from_ext(ext,t) | ||
| 1999 | + }. | ||
| 2000 | + | ||
| 2001 | +define Maybe(MIME) | ||
| 2002 | + recognize_mime_type_from_uri | ||
| 2003 | + ( | ||
| 2004 | + Web_Site_Description desc, | ||
| 2005 | + String uri | ||
| 2006 | + ) = | ||
| 2007 | + recognize_mime_type_from_ext(get_uri_extension(uri),known_mime_types(desc)). | ||
| 2008 | + | ||
| 2009 | + | ||
| 2010 | + | ||
| 2011 | + | ||
| 2012 | + | ||
| 2013 | + | ||
| 2014 | + | ||
| 2015 | + | ||
| 2016 | + *** [5.4] Formating HTTP headers. | ||
| 2017 | + | ||
| 2018 | + This is the formating for sending to the client (hence, it has nothing to do with the | ||
| 2019 | + component 'journal_headers' in the web site description). | ||
| 2020 | + | ||
| 2021 | +public define Printable_tree | ||
| 2022 | + format_headers | ||
| 2023 | + ( | ||
| 2024 | + List(HTTP_header) headers | ||
| 2025 | + ) = | ||
| 2026 | + if headers is | ||
| 2027 | + { | ||
| 2028 | + [ ] then [ ], | ||
| 2029 | + [h . t] then if h is http_header(name,value) then | ||
| 2030 | + [name,": ",value,crlf . format_headers(t)] | ||
| 2031 | + }. | ||
| 2032 | + | ||
| 2033 | + | ||
| 2034 | + | ||
| 2035 | +define String | ||
| 2036 | + month_abrv | ||
| 2037 | + ( | ||
| 2038 | + Date_and_Time d | ||
| 2039 | + ) = | ||
| 2040 | + if d.month = 1 then "Jan" | ||
| 2041 | + else if d.month = 2 then "Feb" | ||
| 2042 | + else if d.month = 3 then "Mar" | ||
| 2043 | + else if d.month = 4 then "Apr" | ||
| 2044 | + else if d.month = 5 then "May" | ||
| 2045 | + else if d.month = 6 then "Jun" | ||
| 2046 | + else if d.month = 7 then "Jul" | ||
| 2047 | + else if d.month = 8 then "Aug" | ||
| 2048 | + else if d.month = 9 then "Sep" | ||
| 2049 | + else if d.month = 10 then "Oct" | ||
| 2050 | + else if d.month = 11 then "Nov" | ||
| 2051 | + else if d.month = 12 then "Dec" | ||
| 2052 | + else | ||
| 2053 | + println("Bad month value [" + d.month + "] on Date_and_Time"); | ||
| 2054 | + "XXX". | ||
| 2055 | + | ||
| 2056 | +define String | ||
| 2057 | + weekday_abrv | ||
| 2058 | + ( | ||
| 2059 | + Date_and_Time d | ||
| 2060 | + ) = | ||
| 2061 | + if d.week_day = 0 then "Sun" | ||
| 2062 | + else if d.week_day = 1 then "Mon" | ||
| 2063 | + else if d.week_day = 2 then "Tue" | ||
| 2064 | + else if d.week_day = 3 then "Wed" | ||
| 2065 | + else if d.week_day = 4 then "Thu" | ||
| 2066 | + else if d.week_day = 5 then "Fri" | ||
| 2067 | + else if d.week_day = 6 then "Sat" | ||
| 2068 | + else | ||
| 2069 | + println("Bad weekday value [" + d.week_day + "] on Date_and_Time"); | ||
| 2070 | + "XXX". | ||
| 2071 | + | ||
| 2072 | +/** | ||
| 2073 | + * Format a date with the followin format : "Mon, 23 Jul 2007 11:33:43 GMT" | ||
| 2074 | + * Currently, this function can't output a GMT time, but only local time. | ||
| 2075 | + * So the final GMT is totally fake, but needed by protocol. | ||
| 2076 | + */ | ||
| 2077 | +public define String | ||
| 2078 | + format_http_date | ||
| 2079 | + ( | ||
| 2080 | + Date_and_Time d | ||
| 2081 | + ) = | ||
| 2082 | + weekday_abrv(d) + ", " + zero_pad_n(2,day(d)) + " " + month_abrv(d) + " " + year(d) | ||
| 2083 | + + " " + zero_pad_n(2,hour(d)) + ":" + zero_pad_n(2,minute(d)) + ":" + zero_pad_n(2,second(d)) + " GMT". | ||
| 2084 | + | ||
| 2085 | +/** | ||
| 2086 | + * Same as previous format_http_date() function, but with seconds count from the UNIX epoch as input. | ||
| 2087 | + */ | ||
| 2088 | +public define String | ||
| 2089 | + format_http_date | ||
| 2090 | + ( | ||
| 2091 | + Int date | ||
| 2092 | + ) = | ||
| 2093 | + format_http_date(convert_time(date)). | ||
| 2094 | + | ||
| 2095 | + | ||
| 2096 | + *** [5.5] Sending a file. | ||
| 2097 | + | ||
| 2098 | + We send 2 headers 'Content-Type' and 'Content-Length'. | ||
| 2099 | + | ||
| 2100 | +define List(HTTP_header) | ||
| 2101 | + headers_for_send_file | ||
| 2102 | + ( | ||
| 2103 | + MIME mime_type, | ||
| 2104 | + Int size, | ||
| 2105 | + String etag, | ||
| 2106 | + Maybe(FileTimes) mb_ftimes, | ||
| 2107 | + ) = | ||
| 2108 | + with headers = (List(HTTP_header)) | ||
| 2109 | + [ | ||
| 2110 | + http_header("Content-Type", to_String(mime_type)), | ||
| 2111 | + http_header("Etag", etag), | ||
| 2112 | + http_header("Content-Length",to_decimal(size)), | ||
| 2113 | + ], | ||
| 2114 | + if mb_ftimes is | ||
| 2115 | + { | ||
| 2116 | + failure then headers, | ||
| 2117 | + success(ftimes) then [http_header("Last-Modified", format_http_date(to_Int(ftimes.last_modified))) . headers] | ||
| 2118 | + } | ||
| 2119 | + . | ||
| 2120 | + | ||
| 2121 | + | ||
| 2122 | + | ||
| 2123 | + Sending the body of the answer (i.e. the file itself). | ||
| 2124 | + | ||
| 2125 | +define One | ||
| 2126 | + send_file_body | ||
| 2127 | + ( | ||
| 2128 | + Web_Site_Description desc, | ||
| 2129 | + Connection connection, // connection with the client | ||
| 2130 | + Connection file, // file to be sent already opened | ||
| 2131 | + Int size, // size of file | ||
| 2132 | + Int sent, // bytes already sent | ||
| 2133 | + String filename // name of file | ||
| 2134 | + ) = | ||
| 2135 | + if sent >= size then unique else | ||
| 2136 | + if read(file,min(16384,size-sent),60) is | ||
| 2137 | + { | ||
| 2138 | + error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"), | ||
| 2139 | + timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"), | ||
| 2140 | + ok(ba) then | ||
| 2141 | + with nr = length(ba), // get the number of bytes read | ||
| 2142 | + if reliable_write(connection, ba) is | ||
| 2143 | + { | ||
| 2144 | + failure then log_journal_msg(desc,"Cannot write into connection delirering '"+filename+"' (sent="+sent+"; size="+size+"; current="+nr+").\n"), | ||
| 2145 | + success(nw) then | ||
| 2146 | + send_file_body(desc,connection,file,size,sent+nw,filename) | ||
| 2147 | + } | ||
| 2148 | + }. | ||
| 2149 | + | ||
| 2150 | + | ||
| 2151 | +define String | ||
| 2152 | + compute_etag | ||
| 2153 | + ( | ||
| 2154 | + String filename, | ||
| 2155 | + Maybe(FileTimes) mb_ftimes, | ||
| 2156 | + Int size, | ||
| 2157 | + ) = | ||
| 2158 | + if mb_ftimes is | ||
| 2159 | + { | ||
| 2160 | + failure then println("Warning: no file times for '" + filename + "', etag won't be very accurate."); to_ascii(sha1((filename, size))), | ||
| 2161 | + success(ftimes) then to_ascii(md5((filename, ftimes, size))) | ||
| 2162 | + }. | ||
| 2163 | + | ||
| 2164 | +define Bool | ||
| 2165 | + are_same_etag | ||
| 2166 | + ( | ||
| 2167 | + Maybe(String) input_etag, | ||
| 2168 | + String current_etag | ||
| 2169 | + ) = | ||
| 2170 | + if input_etag is | ||
| 2171 | + { | ||
| 2172 | + failure then false, | ||
| 2173 | + success(etag) then etag = current_etag | ||
| 2174 | + }. | ||
| 2175 | + | ||
| 2176 | + Sending the answer line, the headers and the body. | ||
| 2177 | + | ||
| 2178 | +define One | ||
| 2179 | + send_file | ||
| 2180 | + ( | ||
| 2181 | + Web_Site_Description desc, | ||
| 2182 | + Connection connection, | ||
| 2183 | + List(HTTP_header) input_headers, | ||
| 2184 | + List(HTTP_header) headers, | ||
| 2185 | + Int size, | ||
| 2186 | + Connection file, | ||
| 2187 | + String filename, | ||
| 2188 | + String full_path, | ||
| 2189 | + MIME mime_type, | ||
| 2190 | + One -> One action_before_send_file | ||
| 2191 | + ) = | ||
| 2192 | + action_before_send_file(unique); | ||
| 2193 | + with input_etag = http_header_value(input_headers, "If-None-Match"), | ||
| 2194 | + mb_ftimes = get_file_times(full_path), | ||
| 2195 | + current_etag = compute_etag(full_path, mb_ftimes, size), | ||
| 2196 | + if are_same_etag(input_etag, current_etag) is | ||
| 2197 | + { | ||
| 2198 | + false then | ||
| 2199 | + forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf))); | ||
| 2200 | + forget(reliable_write(connection,[format_headers(headers + headers_for_send_file(mime_type, size, current_etag, mb_ftimes)) , crlf])); | ||
| 2201 | + //forget(copy_file_to_Connection(file, connection, size)), | ||
| 2202 | + send_file_body(desc,connection,file,size,0,filename), | ||
| 2203 | + true then | ||
| 2204 | + forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf))); | ||
| 2205 | + forget(reliable_write(connection,[format_headers([http_header("Etag", current_etag) . headers]) , crlf])) | ||
| 2206 | + //send_file_body(desc,connection,file,size,0,filename) | ||
| 2207 | + }. | ||
| 2208 | + | ||
| 2209 | + | ||
| 2210 | + | ||
| 2211 | + Checking if a connection is under SSL. | ||
| 2212 | + | ||
| 2213 | +define Bool | ||
| 2214 | + is_SSL | ||
| 2215 | + ( | ||
| 2216 | + Connection c | ||
| 2217 | + ) = | ||
| 2218 | + if c is | ||
| 2219 | + { | ||
| 2220 | + file_r(_) then false, | ||
| 2221 | + file_w(_) then false, | ||
| 2222 | + file_rw(_) then false, | ||
| 2223 | + tcp(_) then false, | ||
| 2224 | + ssl(_) then true | ||
| 2225 | + }. | ||
| 2226 | + | ||
| 2227 | + | ||
| 2228 | + | ||
| 2229 | + Before opening and sending a file, we check the MIME type. It must be recognized, | ||
| 2230 | + except if there is a valid authorization for private download. | ||
| 2231 | + | ||
| 2232 | +define One | ||
| 2233 | + send_file | ||
| 2234 | + ( | ||
| 2235 | + Web_Site_Description desc, | ||
| 2236 | + Connection connection, | ||
| 2237 | + String uri, | ||
| 2238 | + List(HTTP_header) input_headers, | ||
| 2239 | + List(HTTP_header) output_headers, | ||
| 2240 | + Maybe(String) mbauthorization, | ||
| 2241 | + One -> One action_before_send_file | ||
| 2242 | + ) = | ||
| 2243 | + if mbauthorization is | ||
| 2244 | + { | ||
| 2245 | + //--- file without authorization: take it from public --- | ||
| 2246 | + failure then if recognize_mime_type_from_uri(desc,uri) is | ||
| 2247 | + { | ||
| 2248 | + failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"), | ||
| 2249 | + success(mime_type) then | ||
| 2250 | + with path = site_directory(desc)+"/public"+uri, | ||
| 2251 | + if (Maybe(RStream))file(path, read) is | ||
| 2252 | + { | ||
| 2253 | + failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"), | ||
| 2254 | + success(f) then with size = file_size(f), | ||
| 2255 | + send_file(desc, | ||
| 2256 | + connection, | ||
| 2257 | + input_headers, | ||
| 2258 | + output_headers, | ||
| 2259 | + size, | ||
| 2260 | + file(f), | ||
| 2261 | + uri, | ||
| 2262 | + path, | ||
| 2263 | + mime_type, | ||
| 2264 | + action_before_send_file) | ||
| 2265 | + } | ||
| 2266 | + }, | ||
| 2267 | + | ||
| 2268 | + //--- file with authorization: apply 'private download' mecanism --- | ||
| 2269 | + success(authorization) then | ||
| 2270 | + with private_download_dir = site_directory(desc)+"/private_download", | ||
| 2271 | + if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization) | ||
| 2272 | + is ok(absolute_path) | ||
| 2273 | + then ( | ||
| 2274 | + with new_hash = compute_authorization(authorization_secret(desc), | ||
| 2275 | + absolute_path), | ||
| 2276 | + if (Maybe(RStream))file(absolute_path, read) is | ||
| 2277 | + { | ||
| 2278 | + failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"), | ||
| 2279 | + success(f) then with size = file_size(f), | ||
| 2280 | + mime_type = if recognize_mime_type_from_uri(desc,uri) is | ||
| 2281 | + { | ||
| 2282 | + failure then mime("application", "octet-stream", []), | ||
| 2283 | + success(mime_type) then mime_type | ||
| 2284 | + }, | ||
| 2285 | + send_file(desc, | ||
| 2286 | + connection, | ||
| 2287 | + input_headers, | ||
| 2288 | + output_headers, | ||
| 2289 | + size, | ||
| 2290 | + file(f), | ||
| 2291 | + uri, | ||
| 2292 | + absolute_path, | ||
| 2293 | + mime_type, | ||
| 2294 | + action_before_send_file) | ||
| 2295 | + } | ||
| 2296 | + ) | ||
| 2297 | + else log_journal_msg(desc,"Cannot find or read authorization file.\n") | ||
| 2298 | + }. | ||
| 2299 | + | ||
| 2300 | + | ||
| 2301 | + | ||
| 2302 | + | ||
| 2303 | + | ||
| 2304 | + | ||
| 2305 | + | ||
| 2306 | + | ||
| 2307 | + *** [5.6] Answering a www-url encoded request. | ||
| 2308 | + | ||
| 2309 | + Standard headers are for answering ".awp" requests. | ||
| 2310 | + | ||
| 2311 | +public define List(HTTP_header) | ||
| 2312 | + standard_headers | ||
| 2313 | + = | ||
| 2314 | + [ | ||
| 2315 | + http_header("Date", format_http_date(now)), | ||
| 2316 | + http_header("Server", "Anubis Embedded Server v" + major_version_number + "." + minor_version_number), | ||
| 2317 | + http_header("Connection", "close"), | ||
| 2318 | + ]. | ||
| 2319 | + | ||
| 2320 | +public define List(HTTP_header) | ||
| 2321 | + standard_headers_for | ||
| 2322 | + ( | ||
| 2323 | + String mime_type, | ||
| 2324 | + Int answer_body_size, | ||
| 2325 | + Maybe(String) mb_charset, | ||
| 2326 | + ) = | ||
| 2327 | + [ | ||
| 2328 | + http_header("Content-Type", mime_type + if mb_charset is success(charset) then "; charset="+charset else ""), | ||
| 2329 | + http_header("Content-length", to_decimal(answer_body_size)) | ||
| 2330 | + ]. | ||
| 2331 | + | ||
| 2332 | +public define List(HTTP_header) | ||
| 2333 | + file_attached_header | ||
| 2334 | + ( | ||
| 2335 | + String filename | ||
| 2336 | + ) = | ||
| 2337 | + [ | ||
| 2338 | + http_header("Content-Disposition", "attachment; filename=\"" + filename +"\"") | ||
| 2339 | + ]. | ||
| 2340 | + | ||
| 2341 | + | ||
| 2342 | +define One | ||
| 2343 | + www_url_answer | ||
| 2344 | + ( | ||
| 2345 | + String host_name, | ||
| 2346 | + Web_Site_Description desc, | ||
| 2347 | + Connection connection, // with the client | ||
| 2348 | + Word32 ip_addr, // of the client | ||
| 2349 | + HTTP_RequestLine request_line, | ||
| 2350 | + List(HTTP_header) headers, | ||
| 2351 | + ByteArray body, | ||
| 2352 | + One -> String generate_tt // trust ticket generation | ||
| 2353 | + ) = | ||
| 2354 | + with all_web_args = query_string(request_line) + | ||
| 2355 | + read_www_url_encoded_web_args(to_string(body),0), | ||
| 2356 | + uri = uri(request_line), | ||
| 2357 | + ext = get_uri_extension(uri), | ||
| 2358 | + http_inf = http_info(ip_addr, host_name, uri, headers, is_SSL(connection), generate_tt), | ||
| 2359 | + (if member(journal_extensions(desc),ext) | ||
| 2360 | + then log_journal_msg(desc, | ||
| 2361 | + format_request(desc,connection,request_line,headers,all_web_args)) | ||
| 2362 | + else unique); | ||
| 2363 | + if is_illegal_uri(uri,0) | ||
| 2364 | + then log_journal_msg(desc,"Received illegal URI: "+uri+"\n") | ||
| 2365 | + else (if (ext = ".awp" | ext = "") | ||
| 2366 | + then (with answer_headers_body = awp_handler(desc)(host_name, | ||
| 2367 | + http_inf, | ||
| 2368 | + all_web_args, | ||
| 2369 | + is_SSL(connection)), | ||
| 2370 | + //print_delta("After page generation"); | ||
| 2371 | + forget(reliable_write(connection, answer_headers_body)) | ||
| 2372 | + //print_delta("After sending page") | ||
| 2373 | + ) | ||
| 2374 | + else (send_file(desc, | ||
| 2375 | + connection, | ||
| 2376 | + uri, | ||
| 2377 | + headers, | ||
| 2378 | + standard_headers, | ||
| 2379 | + if web_arg_value(all_web_args,"zauth") is | ||
| 2380 | + { | ||
| 2381 | + not_found then failure, | ||
| 2382 | + found(v) then success(v) | ||
| 2383 | + }, | ||
| 2384 | + (One u) |-> before_send_file(desc)(http_inf, all_web_args)) | ||
| 2385 | + //print_delta("After sending file") | ||
| 2386 | + )). | ||
| 2387 | + | ||
| 2388 | + | ||
| 2389 | + | ||
| 2390 | + | ||
| 2391 | + | ||
| 2392 | + | ||
| 2393 | + | ||
| 2394 | + *** [5.7] Answering a multipart/form-data encoded request. | ||
| 2395 | + | ||
| 2396 | + In order to support upload of files, we must be able to read web arguments which are | ||
| 2397 | + encoded in a multipart/form-data body. The first thing to do is to find the | ||
| 2398 | + boundary. The boundary is a special string which delimits the various parts of the | ||
| 2399 | + 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as | ||
| 2400 | + the value of the 'boundary' attribute. | ||
| 2401 | + | ||
| 2402 | + | ||
| 2403 | + | ||
| 2404 | + | ||
| 2405 | + | ||
| 2406 | + *** [5.7.1] Finding the boundary. | ||
| 2407 | + | ||
| 2408 | + Hence, we just have to find the string 'boundary=' within the value of the | ||
| 2409 | + 'Content-Type' header, and read the value of the boundary from there. | ||
| 2410 | + | ||
| 2411 | +define Bool | ||
| 2412 | + delimits_boundary | ||
| 2413 | + ( | ||
| 2414 | + Word8 c | ||
| 2415 | + ) = | ||
| 2416 | + if c = ' ' then true else | ||
| 2417 | + if c = 13 then true else | ||
| 2418 | + if c = 10 then true else | ||
| 2419 | + if c = 0 then true else | ||
| 2420 | + if c = ',' then true else | ||
| 2421 | + c = ';'. | ||
| 2422 | + | ||
| 2423 | + | ||
| 2424 | +define Maybe(String) | ||
| 2425 | + get_boundary_value_3 | ||
| 2426 | + ( | ||
| 2427 | + String s, | ||
| 2428 | + Int i, | ||
| 2429 | + List(Word8) so_far | ||
| 2430 | + ) = | ||
| 2431 | + if nth(i,s) is | ||
| 2432 | + { | ||
| 2433 | + failure then success(implode(reverse(so_far))), | ||
| 2434 | + success(c) then | ||
| 2435 | + if delimits_boundary(c) | ||
| 2436 | + then success(implode(reverse(so_far))) | ||
| 2437 | + else get_boundary_value_3(s,i+1,[c . so_far]) | ||
| 2438 | + }. | ||
| 2439 | + | ||
| 2440 | + | ||
| 2441 | + | ||
| 2442 | +define Maybe(String) | ||
| 2443 | + get_boundary_value_2 | ||
| 2444 | + ( | ||
| 2445 | + String s, | ||
| 2446 | + Int i, | ||
| 2447 | + ) = | ||
| 2448 | + if nth(i,s) is | ||
| 2449 | + { | ||
| 2450 | + failure then failure, | ||
| 2451 | + success(c) then | ||
| 2452 | + if is_blank(c) | ||
| 2453 | + then get_boundary_value_2(s,i+1) | ||
| 2454 | + else get_boundary_value_3(s,i+1,[c]) | ||
| 2455 | + }. | ||
| 2456 | + | ||
| 2457 | +define Maybe(String) | ||
| 2458 | + get_boundary_value_1 | ||
| 2459 | + ( | ||
| 2460 | + String s, // string into which we must find '= ...' | ||
| 2461 | + Int i // position of start of search | ||
| 2462 | + ) = | ||
| 2463 | + if nth(i,s) is | ||
| 2464 | + { | ||
| 2465 | + failure then failure, | ||
| 2466 | + success(c) then | ||
| 2467 | + if is_blank(c) | ||
| 2468 | + then get_boundary_value_1(s,i+1) | ||
| 2469 | + else if c = '=' | ||
| 2470 | + then get_boundary_value_2(s,i+1) | ||
| 2471 | + else failure | ||
| 2472 | + }. | ||
| 2473 | + | ||
| 2474 | + | ||
| 2475 | +define Maybe(String) | ||
| 2476 | + get_boundary | ||
| 2477 | + ( | ||
| 2478 | + String content_type_header_value | ||
| 2479 | + ) = | ||
| 2480 | + if find("boundary",content_type_header_value,0) is | ||
| 2481 | + { | ||
| 2482 | + failure then failure, | ||
| 2483 | + success(n) then // 'boundary' has been found at position n | ||
| 2484 | + get_boundary_value_1(content_type_header_value,n+8) | ||
| 2485 | + }. | ||
| 2486 | + | ||
| 2487 | +define Maybe(String) | ||
| 2488 | + get_boundary | ||
| 2489 | + ( | ||
| 2490 | + List(HTTP_header) headers | ||
| 2491 | + ) = | ||
| 2492 | + if headers is | ||
| 2493 | + { | ||
| 2494 | + [ ] then failure, | ||
| 2495 | + [h . t] then if h is http_header(name,value) then | ||
| 2496 | + if name = "content-type" | ||
| 2497 | + then get_boundary(value) | ||
| 2498 | + else get_boundary(t) | ||
| 2499 | + }. | ||
| 2500 | + | ||
| 2501 | + | ||
| 2502 | + | ||
| 2503 | + | ||
| 2504 | + | ||
| 2505 | + | ||
| 2506 | + | ||
| 2507 | + | ||
| 2508 | + *** [5.7.2] Reading attributes from a multipart entity. | ||
| 2509 | + | ||
| 2510 | + Entities in a multipart/form-data body are separated by instances of the string: | ||
| 2511 | + | ||
| 2512 | + --bbbbb | ||
| 2513 | + | ||
| 2514 | + where bbbbb is the boundary computed above. Actually, the body has the form: | ||
| 2515 | + | ||
| 2516 | + --bbbbb | ||
| 2517 | + <entity 1> | ||
| 2518 | + --bbbbb | ||
| 2519 | + <entity 2> | ||
| 2520 | + --bbbbb | ||
| 2521 | + ... | ||
| 2522 | + --bbbbb | ||
| 2523 | + <last entity> | ||
| 2524 | + --bbbbb | ||
| 2525 | + | ||
| 2526 | + | ||
| 2527 | + We have to extract an entity which is in the body between offsets 'start' and 'end' | ||
| 2528 | + (computed when boundaries have been localized). The entity itself is made of two parts: | ||
| 2529 | + headers and body. The body is separated from the headers by a blank line. This blank | ||
| 2530 | + line (a double crlf) marks the beginning of the body of the entity. Within the headers | ||
| 2531 | + of the entity, we look for a 'Content-Disposition' header, which should look like this: | ||
| 2532 | + | ||
| 2533 | + Content-Disposition: form-data; name="..."; filename="..." crlf | ||
| 2534 | + | ||
| 2535 | + We are just interested in the name and the file name. Hence we first search | ||
| 2536 | + 'Content-Disposition', then we search 'name' and read the value, and we do the same for | ||
| 2537 | + 'filename'. | ||
| 2538 | + | ||
| 2539 | + If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise, | ||
| 2540 | + it is an uploaded file. | ||
| 2541 | + | ||
| 2542 | + | ||
| 2543 | + Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end' | ||
| 2544 | + argument. | ||
| 2545 | + | ||
| 2546 | +define Maybe(Int) | ||
| 2547 | + find | ||
| 2548 | + ( | ||
| 2549 | + String what, | ||
| 2550 | + ByteArray where, | ||
| 2551 | + Int start, | ||
| 2552 | + Int end | ||
| 2553 | + ) = | ||
| 2554 | + if find(to_byte_array(what),where,start) is | ||
| 2555 | + { | ||
| 2556 | + failure then failure, | ||
| 2557 | + success(n) then | ||
| 2558 | + if n+length(what) >= end | ||
| 2559 | + then failure | ||
| 2560 | + else success(n) | ||
| 2561 | + }. | ||
| 2562 | + | ||
| 2563 | + | ||
| 2564 | +define String | ||
| 2565 | + read_attribute_value | ||
| 2566 | + ( | ||
| 2567 | + ByteArray where, | ||
| 2568 | + Int start, | ||
| 2569 | + Int end, | ||
| 2570 | + List(Word8) so_far | ||
| 2571 | + ) = | ||
| 2572 | + if start >= end then implode(reverse(so_far)) else | ||
| 2573 | + if nth(start,where) is | ||
| 2574 | + { | ||
| 2575 | + failure then implode(reverse(so_far)), | ||
| 2576 | + success(c) then | ||
| 2577 | + if c = '\"' | ||
| 2578 | + then implode(reverse(so_far)) | ||
| 2579 | + else read_attribute_value(where,start+1,end,[c . so_far]) | ||
| 2580 | + }. | ||
| 2581 | + | ||
| 2582 | +define Maybe(String) | ||
| 2583 | + find_attribute | ||
| 2584 | + ( | ||
| 2585 | + String name, | ||
| 2586 | + ByteArray where, | ||
| 2587 | + Int start, | ||
| 2588 | + Int end | ||
| 2589 | + ) = | ||
| 2590 | + with prefix = name+"=\"", | ||
| 2591 | + if find(to_byte_array(prefix),where,start) is | ||
| 2592 | + { | ||
| 2593 | + failure then failure, | ||
| 2594 | + success(n) then | ||
| 2595 | + if n+length(prefix) >= end | ||
| 2596 | + then failure | ||
| 2597 | + else success(read_attribute_value(where,n+length(prefix),end,[])) | ||
| 2598 | + }. | ||
| 2599 | + | ||
| 2600 | + | ||
| 2601 | + | ||
| 2602 | +define Maybe((String,Maybe(String))) | ||
| 2603 | + find_name_and_filename | ||
| 2604 | + ( | ||
| 2605 | + ByteArray body, | ||
| 2606 | + Int start, | ||
| 2607 | + Int end | ||
| 2608 | + ) = | ||
| 2609 | + if find(to_byte_array("Content-Disposition"),body,start) is | ||
| 2610 | + { | ||
| 2611 | + failure then failure, | ||
| 2612 | + success(n) then | ||
| 2613 | + if find_attribute("name",body,n+19,end) is | ||
| 2614 | + { | ||
| 2615 | + failure then failure, | ||
| 2616 | + success(name_value) then if find_attribute("filename",body,n+19,end) is | ||
| 2617 | + { | ||
| 2618 | + failure then success((name_value,failure)), | ||
| 2619 | + success(filename_value) then success((name_value,success(filename_value))) | ||
| 2620 | + } | ||
| 2621 | + } | ||
| 2622 | + }. | ||
| 2623 | + | ||
| 2624 | + | ||
| 2625 | + | ||
| 2626 | + | ||
| 2627 | + | ||
| 2628 | + | ||
| 2629 | + | ||
| 2630 | + | ||
| 2631 | + | ||
| 2632 | + | ||
| 2633 | + *** [5.7.3] Creating a temporary filename for an uploaded file. | ||
| 2634 | + | ||
| 2635 | +variable Int uploaded_file_count = 0. | ||
| 2636 | + | ||
| 2637 | + This variable is local to the virtual machine. Hence, its value is 0 each time a new | ||
| 2638 | + requests arrives. Temporary uploaded files are stored in the directory represented by | ||
| 2639 | + 'upload_temporary_directory'. The filenames have the form: | ||
| 2640 | + | ||
| 2641 | + _m_n | ||
| 2642 | + | ||
| 2643 | + where 'm' is the number of the virtual machine, and 'n' a number obtained by | ||
| 2644 | + incrementing 'uploaded_file_count'. Notice that the program must do something with this | ||
| 2645 | + file (move it to some directory/name), otherwise, it will probably be overwritten the | ||
| 2646 | + next time the same machine works. | ||
| 2647 | + | ||
| 2648 | + | ||
| 2649 | + | ||
| 2650 | + | ||
| 2651 | + | ||
| 2652 | + | ||
| 2653 | + *** [5.7.4] Saving an uploaded file under a temporary filename. | ||
| 2654 | + | ||
| 2655 | +define Maybe(String) // returns the temporary file name | ||
| 2656 | + save_uploaded_file | ||
| 2657 | + ( | ||
| 2658 | + Web_Site_Description desc, | ||
| 2659 | + ByteArray body, | ||
| 2660 | + Int start, | ||
| 2661 | + Int end | ||
| 2662 | + ) = | ||
| 2663 | + uploaded_file_count <- 1 + *uploaded_file_count; | ||
| 2664 | + with tfn = "_"+to_decimal(virtual_machine_id)+"_"+to_decimal(*uploaded_file_count), | ||
| 2665 | + if (Maybe(RWStream))file(site_directory(desc)+"/upload_temporary/"+tfn, new) is | ||
| 2666 | + { | ||
| 2667 | + failure then failure, | ||
| 2668 | + success(f) then | ||
| 2669 | + if reliable_write(file(f),extract(body,start,end)) is | ||
| 2670 | + { | ||
| 2671 | + failure then failure, | ||
| 2672 | + success(nw) then | ||
| 2673 | + if nw = end - start | ||
| 2674 | + then success(tfn) | ||
| 2675 | + else failure | ||
| 2676 | + } | ||
| 2677 | + }. | ||
| 2678 | + | ||
| 2679 | + | ||
| 2680 | + | ||
| 2681 | + | ||
| 2682 | + | ||
| 2683 | + | ||
| 2684 | + | ||
| 2685 | + | ||
| 2686 | + *** [5.7.5] Removing the path from a file name. | ||
| 2687 | + | ||
| 2688 | + When a file is uploaded, the browser sends the complete path of the file on the client | ||
| 2689 | + machine as the file name. Actually, this is not quite normal. Nevertheless, we need to | ||
| 2690 | + remove the path, and keep only the file name. This is achieved by 'remove_path' below. | ||
| 2691 | + | ||
| 2692 | +define Int | ||
| 2693 | + file_name_begin | ||
| 2694 | + ( | ||
| 2695 | + String full_name, | ||
| 2696 | + Int i | ||
| 2697 | + ) = | ||
| 2698 | + if nth(i,full_name) is | ||
| 2699 | + { | ||
| 2700 | + failure then 0, | ||
| 2701 | + success(c) then | ||
| 2702 | + if c = '/' then i+1 else | ||
| 2703 | + if c = '\\' then i+1 else | ||
| 2704 | + file_name_begin(full_name,i-1) | ||
| 2705 | + }. | ||
| 2706 | + | ||
| 2707 | +define String | ||
| 2708 | + remove_path | ||
| 2709 | + ( | ||
| 2710 | + String full_name | ||
| 2711 | + ) = | ||
| 2712 | + with l = length(full_name), | ||
| 2713 | + b = file_name_begin(full_name,l-1), | ||
| 2714 | + substr(full_name,b,l-b). | ||
| 2715 | + | ||
| 2716 | + | ||
| 2717 | + | ||
| 2718 | + | ||
| 2719 | + | ||
| 2720 | + *** [5.7.6] Reading a multipart entity. | ||
| 2721 | + | ||
| 2722 | +define Maybe(Web_arg) | ||
| 2723 | + get_multipart_entity | ||
| 2724 | + ( | ||
| 2725 | + Web_Site_Description desc, | ||
| 2726 | + ByteArray body, | ||
| 2727 | + Int start, | ||
| 2728 | + Int end | ||
| 2729 | + ) = | ||
| 2730 | + if find(to_byte_array(crlf+crlf),body,start) is | ||
| 2731 | + { | ||
| 2732 | + failure then failure, | ||
| 2733 | + success(k) then | ||
| 2734 | + if k >= end // must be within this entity, not the next one | ||
| 2735 | + then failure | ||
| 2736 | + else if find_name_and_filename(body,start,k) is | ||
| 2737 | + { | ||
| 2738 | + failure then failure, | ||
| 2739 | + success(n_mbfn) then if n_mbfn is (name,mbfn) then | ||
| 2740 | + if mbfn is | ||
| 2741 | + { | ||
| 2742 | + failure then | ||
| 2743 | + success(web_arg(name,to_string(extract(body,k+4,end-2)))), | ||
| 2744 | + // we must substract 2 to end because of crlf just before the boundary | ||
| 2745 | + | ||
| 2746 | + success(fn) then | ||
| 2747 | + if save_uploaded_file(desc,body,k+4,end-2) is | ||
| 2748 | + { | ||
| 2749 | + failure then failure, | ||
| 2750 | + success(tfn) then | ||
| 2751 | + success(upload(name,remove_path(fn), | ||
| 2752 | + site_directory(desc)+"/upload_temporary/"+tfn)) | ||
| 2753 | + | ||
| 2754 | + } | ||
| 2755 | + } | ||
| 2756 | + } | ||
| 2757 | + }. | ||
| 2758 | + | ||
| 2759 | + | ||
| 2760 | + | ||
| 2761 | +define List(Web_arg) | ||
| 2762 | + read_multipart_form_data_encoded_web_args | ||
| 2763 | + ( | ||
| 2764 | + Web_Site_Description desc, | ||
| 2765 | + ByteArray body, | ||
| 2766 | + ByteArray __boundary, | ||
| 2767 | + Int i, | ||
| 2768 | + ) = | ||
| 2769 | + if find(__boundary,body,i) is | ||
| 2770 | + { | ||
| 2771 | + failure then [ ], | ||
| 2772 | + success(n) then | ||
| 2773 | + if find(__boundary,body,n+length(__boundary)) is | ||
| 2774 | + { | ||
| 2775 | + failure then [ ], | ||
| 2776 | + success(m) then | ||
| 2777 | + if get_multipart_entity(desc,body,n+length(__boundary),m) is | ||
| 2778 | + { | ||
| 2779 | + failure then [ ], | ||
| 2780 | + success(wa) then | ||
| 2781 | + [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)] | ||
| 2782 | + } | ||
| 2783 | + } | ||
| 2784 | + }. | ||
| 2785 | + | ||
| 2786 | + | ||
| 2787 | + | ||
| 2788 | +define One | ||
| 2789 | + multipart_form_data_answer | ||
| 2790 | + ( | ||
| 2791 | + String host_name, | ||
| 2792 | + Web_Site_Description desc, | ||
| 2793 | + Connection connection, | ||
| 2794 | + Word32 ip_addr, | ||
| 2795 | + HTTP_RequestLine request_line, | ||
| 2796 | + List(HTTP_header) headers, | ||
| 2797 | + ByteArray body, | ||
| 2798 | + One -> String generate_tt | ||
| 2799 | + ) = | ||
| 2800 | + if get_boundary(headers) is | ||
| 2801 | + { | ||
| 2802 | + failure then unique, | ||
| 2803 | + success(boundary) then | ||
| 2804 | + with all_web_args = query_string(request_line) + | ||
| 2805 | + read_multipart_form_data_encoded_web_args(desc, | ||
| 2806 | + body, | ||
| 2807 | + to_byte_array("--"+boundary), | ||
| 2808 | + 0), | ||
| 2809 | + uri = uri(request_line), | ||
| 2810 | + ext = get_uri_extension(uri), | ||
| 2811 | + log_journal_msg(desc, | ||
| 2812 | + format_request(desc,connection,request_line,headers,all_web_args)); | ||
| 2813 | + if is_illegal_uri(uri,0) | ||
| 2814 | + then log_journal_msg(desc,"Received illegal URI: "+uri+"\n") | ||
| 2815 | + else | ||
| 2816 | + if (ext = ".awp" | ext = "") then | ||
| 2817 | + (with answer_headers_body = awp_handler(desc)(host_name, | ||
| 2818 | + http_info(ip_addr, host_name, uri, headers, is_SSL(connection), generate_tt), | ||
| 2819 | + all_web_args, | ||
| 2820 | + is_SSL(connection)), | ||
| 2821 | + forget(reliable_write(connection, answer_headers_body))) | ||
| 2822 | + else unique | ||
| 2823 | + }. | ||
| 2824 | + | ||
| 2825 | + | ||
| 2826 | + | ||
| 2827 | + | ||
| 2828 | + | ||
| 2829 | + | ||
| 2830 | + | ||
| 2831 | + | ||
| 2832 | + *** [5.8] Handling redirections. | ||
| 2833 | + | ||
| 2834 | + 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one | ||
| 2835 | + has the form: | ||
| 2836 | + | ||
| 2837 | + redirect(required_uri,required_host,corresponding_uri). | ||
| 2838 | + | ||
| 2839 | + The host required by the client may be found in the 'Host' HTTP header. The URI | ||
| 2840 | + required by the client is given below as 'uri'. We just have to find the required host | ||
| 2841 | + in the headers, and to find the corresponding redirection directive. | ||
| 2842 | + | ||
| 2843 | + | ||
| 2844 | + In the next fonction, the required host and URI are known. We just have to search in | ||
| 2845 | + the 'redirections' list. | ||
| 2846 | + | ||
| 2847 | +define String | ||
| 2848 | + handle_redirection | ||
| 2849 | + ( | ||
| 2850 | + String required_uri, | ||
| 2851 | + String required_host, | ||
| 2852 | + List(Redirection) redirections | ||
| 2853 | + ) = | ||
| 2854 | + if redirections is | ||
| 2855 | + { | ||
| 2856 | + [ ] then required_uri, | ||
| 2857 | + [h . t] then if h is redirect(uri,host,target) then | ||
| 2858 | + if host = required_host | ||
| 2859 | + then if uri = required_uri | ||
| 2860 | + then target | ||
| 2861 | + else handle_redirection(required_uri,required_host,t) | ||
| 2862 | + else handle_redirection(required_uri,required_host,t) | ||
| 2863 | + }. | ||
| 2864 | + | ||
| 2865 | + | ||
| 2866 | + | ||
| 2867 | + The host name may be encumbered by a port number, like | ||
| 2868 | + | ||
| 2869 | + www.our-business.com:1607 | ||
| 2870 | + | ||
| 2871 | + We must remove this port number, otherwise the host name may not be recognized. | ||
| 2872 | + | ||
| 2873 | +define String | ||
| 2874 | + strip_port | ||
| 2875 | + ( | ||
| 2876 | + String name, | ||
| 2877 | + Int i | ||
| 2878 | + ) = | ||
| 2879 | + if nth(i,name) is | ||
| 2880 | + { | ||
| 2881 | + failure then name, | ||
| 2882 | + success(c) then | ||
| 2883 | + if c = ':' | ||
| 2884 | + then substr(name,0,i) | ||
| 2885 | + else strip_port(name,i+1) | ||
| 2886 | + }. | ||
| 2887 | + | ||
| 2888 | + | ||
| 2889 | + | ||
| 2890 | + | ||
| 2891 | + | ||
| 2892 | + Finding the 'Host' header. No redirection is performed if this header is not found. | ||
| 2893 | + | ||
| 2894 | +define String | ||
| 2895 | + handle_redirection // returns the redirected URI | ||
| 2896 | + ( | ||
| 2897 | + Redirections redirections, | ||
| 2898 | + String uri, // original URI | ||
| 2899 | + List(HTTP_header) headers | ||
| 2900 | + )= | ||
| 2901 | + if get_host_header_value(headers) is | ||
| 2902 | + { | ||
| 2903 | + failure then uri, | ||
| 2904 | + success(host) then | ||
| 2905 | + if redirections is | ||
| 2906 | + { | ||
| 2907 | + redirection_list(l) then handle_redirection(uri, host, l) | ||
| 2908 | + redirection_fn(f) then f(uri, host) | ||
| 2909 | + } | ||
| 2910 | + }. | ||
| 2911 | + | ||
| 2912 | + | ||
| 2913 | + | ||
| 2914 | + | ||
| 2915 | + | ||
| 2916 | + | ||
| 2917 | + *** [5.9] Answering both sorts of requests. | ||
| 2918 | + | ||
| 2919 | + We must decide if the request is www-url encoded or multipart/form-data encoded. This | ||
| 2920 | + is achieved through the header 'Content-Type'. | ||
| 2921 | + | ||
| 2922 | +define EncodingType | ||
| 2923 | + get_encoding_type | ||
| 2924 | + ( | ||
| 2925 | + List(HTTP_header) headers | ||
| 2926 | + ) = | ||
| 2927 | + if headers is | ||
| 2928 | + { | ||
| 2929 | + [ ] then www_url, // this is the default | ||
| 2930 | + [h . t] then if h is http_header(name,value) then | ||
| 2931 | + if name = "content-type" | ||
| 2932 | + then if find("multipart/form-data",value,0) is | ||
| 2933 | + { | ||
| 2934 | + failure then www_url, | ||
| 2935 | + success(_) then multipart_form_data | ||
| 2936 | + } | ||
| 2937 | + else get_encoding_type(t) | ||
| 2938 | + }. | ||
| 2939 | + | ||
| 2940 | + | ||
| 2941 | + | ||
| 2942 | +define One | ||
| 2943 | + send_answer | ||
| 2944 | + ( | ||
| 2945 | + String host_name, | ||
| 2946 | + Web_Site_Description desc, | ||
| 2947 | + Connection connection, | ||
| 2948 | + HTTP_RequestLine rqline, | ||
| 2949 | + List(HTTP_header) headers, | ||
| 2950 | + ByteArray body, | ||
| 2951 | + One -> String generate_tt | ||
| 2952 | + ) = | ||
| 2953 | + if rqline is request_line(type,uri,qstring) then | ||
| 2954 | + with rqline2 = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring), | ||
| 2955 | + if remote_IP_address_and_port(connection) is (ip_addr,_) then | ||
| 2956 | + if get_encoding_type(headers) is | ||
| 2957 | + { | ||
| 2958 | + www_url then | ||
| 2959 | + www_url_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt), | ||
| 2960 | + multipart_form_data then | ||
| 2961 | + multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt) | ||
| 2962 | + }. | ||
| 2963 | + | ||
| 2964 | + | ||
| 2965 | + | ||
| 2966 | + | ||
| 2967 | + | ||
| 2968 | + | ||
| 2969 | + | ||
| 2970 | + *** [6] The HTTP/HTTPS server. | ||
| 2971 | + | ||
| 2972 | + The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine | ||
| 2973 | + which opens a server TCP/IP connection, and which continuously listens to this | ||
| 2974 | + connection. When a request arrives, this machine delegates the work of deciphering and | ||
| 2975 | + answering the request to another virtual machine, and continues to listen. The job of | ||
| 2976 | + the delegated machine is defined by the HTTP request handler below. | ||
| 2977 | + | ||
| 2978 | + | ||
| 2979 | + | ||
| 2980 | + | ||
| 2981 | + | ||
| 2982 | + *** [6.1] Determining the requested host. | ||
| 2983 | + | ||
| 2984 | + When a request arrives to one of our two servers, we must decide which site (host) is | ||
| 2985 | + requested. | ||
| 2986 | + | ||
| 2987 | +define Maybe(String) | ||
| 2988 | + get_host_header_value | ||
| 2989 | + ( | ||
| 2990 | + List(HTTP_header) headers | ||
| 2991 | + ) = | ||
| 2992 | + if headers is | ||
| 2993 | + { | ||
| 2994 | + [ ] then failure, | ||
| 2995 | + [h . t] then if h is http_header(name,value) then | ||
| 2996 | + if name = "host" | ||
| 2997 | + then success(strip_port(value,0)) | ||
| 2998 | + else get_host_header_value(t) | ||
| 2999 | + }. | ||
| 3000 | + | ||
| 3001 | +define Maybe((String,Web_Site_Description)) | ||
| 3002 | + get_site | ||
| 3003 | + ( | ||
| 3004 | + String requested_host, | ||
| 3005 | + List(Web_Site_Description) sites | ||
| 3006 | + ) = | ||
| 3007 | + if sites is | ||
| 3008 | + { | ||
| 3009 | + [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure, | ||
| 3010 | + [site1 . others] then | ||
| 3011 | + if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then | ||
| 3012 | + if member(common_names,requested_host) | ||
| 3013 | + then success((requested_host,site1)) | ||
| 3014 | + else get_site(requested_host,others) | ||
| 3015 | + }. | ||
| 3016 | + | ||
| 3017 | + | ||
| 3018 | +define Maybe((String,Web_Site_Description)) | ||
| 3019 | + get_site | ||
| 3020 | + ( | ||
| 3021 | + List(HTTP_header) headers, | ||
| 3022 | + List(Web_Site_Description) sites | ||
| 3023 | + ) = | ||
| 3024 | + if get_host_header_value(headers) is | ||
| 3025 | + { | ||
| 3026 | + failure then print("No 'Host' HTTP header.\n"); failure, | ||
| 3027 | + success(requested_host) then | ||
| 3028 | + //here we treat the case with only one site. hence we accept any host request | ||
| 3029 | + //print("*** there is " +length(sites) + " sites \n"); | ||
| 3030 | + if length(sites) = 1 then | ||
| 3031 | + //with site = force_nth(0, sites), | ||
| 3032 | + if sites is | ||
| 3033 | + { | ||
| 3034 | + [] then get_site(requested_host,sites), | ||
| 3035 | + [site . t] then success((requested_host, site)) | ||
| 3036 | + } | ||
| 3037 | + else | ||
| 3038 | + get_site(requested_host,sites) | ||
| 3039 | + }. | ||
| 3040 | + | ||
| 3041 | + | ||
| 3042 | + | ||
| 3043 | + | ||
| 3044 | + | ||
| 3045 | + *** [6.2] The HTTP request handler. | ||
| 3046 | + | ||
| 3047 | + Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual | ||
| 3048 | + machine. It reads the headers of the HTTP request, determines the host, determines body | ||
| 3049 | + size, reads the body of the HTTP request, and answers the request. | ||
| 3050 | + | ||
| 3051 | + | ||
| 3052 | + | ||
| 3053 | +define One -> String make_generate_trust_ticket(DenialOfService dos). | ||
| 3054 | + | ||
| 3055 | +define One | ||
| 3056 | + http_https_handler | ||
| 3057 | + ( | ||
| 3058 | + List(Web_Site_Description) sites, | ||
| 3059 | + BufferedConnection connection, | ||
| 3060 | + Bool is_https, | ||
| 3061 | + DenialOfService dos | ||
| 3062 | + ) = | ||
| 3063 | + //t0 <- (UTime)unow; | ||
| 3064 | + with start_time = (Int)now, | ||
| 3065 | + sttm <- start_time; | ||
| 3066 | + //println("Request time: " + format_http_date(start_time)); | ||
| 3067 | + if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then | ||
| 3068 | + if remote_IP_address_and_port(connection.conn) is (ip_addr,port) then | ||
| 3069 | + if read_request_line(connection,start_time+*rld_v,dos) is | ||
| 3070 | + { | ||
| 3071 | + error(msg) then print(format(msg)), | ||
| 3072 | + ok(request_line) then | ||
| 3073 | + //print_delta("read_request_line"); | ||
| 3074 | + if read_http_headers(connection,start_time+*hd_v,dos) is | ||
| 3075 | + { | ||
| 3076 | + error(msg) then print(format(msg)), | ||
| 3077 | + ok(headers) then //print_delta("read_http_headers"); | ||
| 3078 | + if get_site(headers,sites) is | ||
| 3079 | + { | ||
| 3080 | + failure then unique, | ||
| 3081 | + success(p) then if p is (host_name,desc) then | ||
| 3082 | + //print_delta("get_site"); | ||
| 3083 | + if get_body_size(headers) is | ||
| 3084 | + { | ||
| 3085 | + error(msg) then log_journal_msg(desc,format(msg)), | ||
| 3086 | + ok(body_size) then | ||
| 3087 | + //print_delta("get_body_size"); | ||
| 3088 | + if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is | ||
| 3089 | + { | ||
| 3090 | + error(msg) then log_journal_msg(desc,format(msg)), | ||
| 3091 | + ok(body) then | ||
| 3092 | + //print_delta("before send_answer"); | ||
| 3093 | + send_answer(host_name, desc,connection.conn, request_line, headers, body, | ||
| 3094 | + make_generate_trust_ticket(dos)) | ||
| 3095 | + //with duration = (UTime) unow - *t0, | ||
| 3096 | + //println("Request duration: " + __utime_to_string(duration)) | ||
| 3097 | + //println("BufferRead duration: " + __utime_to_string(*t1)); | ||
| 3098 | + //println("next_char duration: " + __utime_to_string(*t2)) | ||
| 3099 | + } | ||
| 3100 | + } | ||
| 3101 | + } | ||
| 3102 | + } | ||
| 3103 | + }. | ||
| 3104 | + | ||
| 3105 | + | ||
| 3106 | + Below are the two tools for constructing the handlers required by 'start_server' and | ||
| 3107 | + 'start_ssl_server' (see 'predefined.anubis'). | ||
| 3108 | + | ||
| 3109 | +define Bool is_dubious_IP(Word32 ip, DenialOfService dos). | ||
| 3110 | + | ||
| 3111 | +define Server -> ((RWStream) -> One) | ||
| 3112 | + make_http_handler | ||
| 3113 | + ( | ||
| 3114 | + List(Web_Site_Description) sites, | ||
| 3115 | + DenialOfService dos | ||
| 3116 | + ) = | ||
| 3117 | + (Server server) |-> (RWStream conn) |-> | ||
| 3118 | + if remote_IP_address_and_port(conn) is (addr,_) then | ||
| 3119 | + if is_dubious_IP(addr,dos) | ||
| 3120 | + then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n") | ||
| 3121 | + else | ||
| 3122 | + with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)), | ||
| 3123 | + http_https_handler(sites, connection, false, dos). | ||
| 3124 | + | ||
| 3125 | +define Server -> (SSL_Connection -> One) | ||
| 3126 | + make_https_handler | ||
| 3127 | + ( | ||
| 3128 | + List(Web_Site_Description) sites, | ||
| 3129 | + DenialOfService dos | ||
| 3130 | + ) = | ||
| 3131 | + (Server server) |-> (SSL_Connection conn) |-> | ||
| 3132 | + with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)), | ||
| 3133 | + http_https_handler(sites, connection, true, dos). | ||
| 3134 | + | ||
| 3135 | + | ||
| 3136 | + | ||
| 3137 | + | ||
| 3138 | + *** [6.3] Server's tasks. | ||
| 3139 | + | ||
| 3140 | + Some tasks must be executed periodically, for example for cleaning up directories from | ||
| 3141 | + short life time files. | ||
| 3142 | + | ||
| 3143 | + The next function removes from the given directory (and recursively from its | ||
| 3144 | + subdirectories) all the files which are more than 10 minutes old. | ||
| 3145 | + | ||
| 3146 | +define One | ||
| 3147 | + cleanup_directory_10mn | ||
| 3148 | + ( | ||
| 3149 | + String dir // path of private download directory (or subdirectory) with trailing slash | ||
| 3150 | + ) = | ||
| 3151 | + forget(map((FileDescription fd) |-> if fd is | ||
| 3152 | + { | ||
| 3153 | + no_info(name) then forget(remove(dir+name)), | ||
| 3154 | + file(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique, | ||
| 3155 | + link(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique, | ||
| 3156 | + directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"), | ||
| 3157 | + }, | ||
| 3158 | + directory_full_list(dir,"*","*","*"))). | ||
| 3159 | + | ||
| 3160 | + | ||
| 3161 | +define One | ||
| 3162 | + http_servers_tasks | ||
| 3163 | + ( | ||
| 3164 | + List(Web_Site_Description) sites, | ||
| 3165 | + List(Server) servers, | ||
| 3166 | + Int period, | ||
| 3167 | + Int next_time, | ||
| 3168 | + ) = | ||
| 3169 | + if mapand(is_down,servers) | ||
| 3170 | + then unique | ||
| 3171 | + else if now > next_time | ||
| 3172 | + then | ||
| 3173 | + ( | ||
| 3174 | + /* | ||
| 3175 | + forget(map((Web_Site_Description wsd) |-> | ||
| 3176 | + cleanup_directory_10mn(site_directory(wsd)+"/private_download/"), | ||
| 3177 | + sites)); | ||
| 3178 | + */ | ||
| 3179 | + http_servers_tasks(sites,servers,period,next_time+period) | ||
| 3180 | + ) | ||
| 3181 | + else | ||
| 3182 | + ( | ||
| 3183 | + sleep(1000); | ||
| 3184 | + http_servers_tasks(sites,servers,period,next_time) | ||
| 3185 | + ). | ||
| 3186 | + | ||
| 3187 | + | ||
| 3188 | +public define One | ||
| 3189 | + start_http_servers_tasks | ||
| 3190 | + ( | ||
| 3191 | + List(Web_Site_Description) sites, | ||
| 3192 | + List(Server) servers, | ||
| 3193 | + Int period | ||
| 3194 | + ) = | ||
| 3195 | + delegate http_servers_tasks(sites,servers,period,now), | ||
| 3196 | + unique. | ||
| 3197 | + | ||
| 3198 | + | ||
| 3199 | + | ||
| 3200 | + | ||
| 3201 | + *** [6.4] Protection against 'denial of service' attacks. | ||
| 3202 | + | ||
| 3203 | + | ||
| 3204 | + *** [6.4.1] Counting connections. | ||
| 3205 | + | ||
| 3206 | +define Bool // returns false if the counter cannot be incremented (too many connections) | ||
| 3207 | + increment_connections_counter | ||
| 3208 | + ( | ||
| 3209 | + Var(Int) counter | ||
| 3210 | + ) = | ||
| 3211 | + protect with n = *counter, | ||
| 3212 | + if n >= 100 | ||
| 3213 | + then false | ||
| 3214 | + else (counter <- (*counter)+1); true. | ||
| 3215 | + | ||
| 3216 | +define One | ||
| 3217 | + decrement_connections_counter | ||
| 3218 | + ( | ||
| 3219 | + Var(Int) counter | ||
| 3220 | + ) = | ||
| 3221 | + protect counter <- (*counter)-1. | ||
| 3222 | + | ||
| 3223 | + | ||
| 3224 | + | ||
| 3225 | + | ||
| 3226 | + | ||
| 3227 | + *** [6.4.2] Recording dubious IP addresses. | ||
| 3228 | + | ||
| 3229 | + | ||
| 3230 | +define List(DubiousIP) | ||
| 3231 | + record_dubious_IP | ||
| 3232 | + ( | ||
| 3233 | + Word32 ip, | ||
| 3234 | + List(DubiousIP) l | ||
| 3235 | + ) = | ||
| 3236 | + if l is | ||
| 3237 | + { | ||
| 3238 | + [ ] then [dubious_ip(ip,now)], | ||
| 3239 | + [h . t] then if h is dubious_ip(addr,time) then | ||
| 3240 | + if addr = ip | ||
| 3241 | + then [dubious_ip(addr,now) . t] | ||
| 3242 | + else [h . record_dubious_IP(ip,t)] | ||
| 3243 | + }. | ||
| 3244 | + | ||
| 3245 | + | ||
| 3246 | +define One | ||
| 3247 | + record_dubious_IP | ||
| 3248 | + ( | ||
| 3249 | + Word32 dubious_IP, | ||
| 3250 | + Var(List(DubiousIP)) v | ||
| 3251 | + ) = | ||
| 3252 | + protect v <- record_dubious_IP(dubious_IP,*v). | ||
| 3253 | + | ||
| 3254 | + | ||
| 3255 | +define One | ||
| 3256 | + record_dubious_IP | ||
| 3257 | + ( | ||
| 3258 | + Word32 addr, | ||
| 3259 | + DenialOfService dos | ||
| 3260 | + ) = | ||
| 3261 | + record_dubious_IP(addr,list_of_dubious(dos)). | ||
| 3262 | + | ||
| 3263 | + | ||
| 3264 | +public define DenialOfService | ||
| 3265 | + load_denial_of_service_info | ||
| 3266 | + = | ||
| 3267 | + if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is | ||
| 3268 | + ok(dos) then dos else denial_of_service( | ||
| 3269 | + var(100), | ||
| 3270 | + var(1000), | ||
| 3271 | + var(1500), | ||
| 3272 | + var(2000), | ||
| 3273 | + var([]), | ||
| 3274 | + var([])). | ||
| 3275 | + | ||
| 3276 | + | ||
| 3277 | + | ||
| 3278 | + | ||
| 3279 | + *** [6.4.3] Testing if an address is dubious. | ||
| 3280 | + | ||
| 3281 | +define Bool | ||
| 3282 | + is_dubious_IP | ||
| 3283 | + ( | ||
| 3284 | + Word32 ip, | ||
| 3285 | + List(DubiousIP) l | ||
| 3286 | + ) = | ||
| 3287 | + if l is | ||
| 3288 | + { | ||
| 3289 | + [ ] then false, | ||
| 3290 | + [h . t] then if h is dubious_ip(addr,time) then | ||
| 3291 | + if ip = addr | ||
| 3292 | + then true | ||
| 3293 | + else is_dubious_IP(ip,t) | ||
| 3294 | + }. | ||
| 3295 | + | ||
| 3296 | + | ||
| 3297 | +define Bool | ||
| 3298 | + is_dubious_IP | ||
| 3299 | + ( | ||
| 3300 | + Word32 ip, | ||
| 3301 | + DenialOfService dos | ||
| 3302 | + ) = | ||
| 3303 | + if dos is | ||
| 3304 | + { | ||
| 3305 | + denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then | ||
| 3306 | + if member(*ra_v,ip) then false else | ||
| 3307 | + is_dubious_IP(ip,*ld_v) | ||
| 3308 | + }. | ||
| 3309 | + | ||
| 3310 | + | ||
| 3311 | + | ||
| 3312 | + | ||
| 3313 | + *** [6.4.4] Removing inactive dubious IP addresses. | ||
| 3314 | + | ||
| 3315 | +define List(DubiousIP) | ||
| 3316 | + remove_inactive_dubious_IP | ||
| 3317 | + ( | ||
| 3318 | + List(DubiousIP) l, | ||
| 3319 | + Int ref_time, | ||
| 3320 | + ) = | ||
| 3321 | + if l is | ||
| 3322 | + { | ||
| 3323 | + [ ] then [ ], | ||
| 3324 | + [h . t] then if h is dubious_ip(addr,time) then | ||
| 3325 | + if time < ref_time | ||
| 3326 | + then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n"); | ||
| 3327 | + remove_inactive_dubious_IP(t,ref_time)) | ||
| 3328 | + else [h . remove_inactive_dubious_IP(t,ref_time)] | ||
| 3329 | + }. | ||
| 3330 | + | ||
| 3331 | +define One | ||
| 3332 | + remove_inactive_dubious_IP | ||
| 3333 | + ( | ||
| 3334 | + Var(List(DubiousIP)) v | ||
| 3335 | + ) = | ||
| 3336 | + protect | ||
| 3337 | + with ref_time = (Int)now - 600, // 10 minutes | ||
| 3338 | + v <- remove_inactive_dubious_IP(*v,ref_time). | ||
| 3339 | + | ||
| 3340 | + | ||
| 3341 | + The above function will be executed periodically by the servers's tasks machine. | ||
| 3342 | + | ||
| 3343 | + | ||
| 3344 | + | ||
| 3345 | + *** [6.4.5] Making the function for generating trust tickets. | ||
| 3346 | + | ||
| 3347 | +define One -> String | ||
| 3348 | + make_generate_trust_ticket | ||
| 3349 | + ( | ||
| 3350 | + DenialOfService dos | ||
| 3351 | + ) = | ||
| 3352 | + (One _) |-> "". | ||
| 3353 | + | ||
| 3354 | + | ||
| 3355 | + | ||
| 3356 | + | ||
| 3357 | + | ||
| 3358 | + | ||
| 3359 | + | ||
| 3360 | + *** [6.5] Starting the HTTP/HTTPS server. | ||
| 3361 | + | ||
| 3362 | + | ||
| 3363 | + The next function creates the directories for all sites (if they don't already exist). | ||
| 3364 | + | ||
| 3365 | +define One | ||
| 3366 | + create_directories | ||
| 3367 | + ( | ||
| 3368 | + List(Web_Site_Description) sites | ||
| 3369 | + ) = | ||
| 3370 | + if sites is | ||
| 3371 | + { | ||
| 3372 | + [ ] then unique, | ||
| 3373 | + [s1 . others] then | ||
| 3374 | + with site_dir = site_directory(s1), | ||
| 3375 | + forget(make_directory(site_dir+"/public",default_directory_mode)); | ||
| 3376 | + forget(make_directory(site_dir+"/upload_temporary",default_directory_mode)); | ||
| 3377 | + forget(make_directory(site_dir+"/private_download",default_directory_mode)); | ||
| 3378 | + forget(make_directory(site_dir+"/journal",default_directory_mode)); | ||
| 3379 | + create_directories(others) | ||
| 3380 | + }. | ||
| 3381 | + | ||
| 3382 | + | ||
| 3383 | + | ||
| 3384 | + | ||
| 3385 | + | ||
| 3386 | + Below are the commands for starting an HTTP server and an HTTPS server. | ||
| 3387 | + | ||
| 3388 | + | ||
| 3389 | +define StartServerResult | ||
| 3390 | + start_http_server | ||
| 3391 | + ( | ||
| 3392 | + Word32 ip_address, | ||
| 3393 | + Word32 port, | ||
| 3394 | + Server -> ((RWStream) -> One) handler, | ||
| 3395 | + Int retries, | ||
| 3396 | + DenialOfService dos | ||
| 3397 | + ) = | ||
| 3398 | + if start_server(ip_address, | ||
| 3399 | + port, | ||
| 3400 | + handler, | ||
| 3401 | + identity) is ok(server) | ||
| 3402 | + then print(" \r"); | ||
| 3403 | + ok(server) | ||
| 3404 | + else print("Port "+port+": retry number "+retries+"\r"); | ||
| 3405 | + sleep(1000); | ||
| 3406 | + start_http_server(ip_address,port,handler,retries+1,dos). | ||
| 3407 | + | ||
| 3408 | +public define StartServerResult | ||
| 3409 | + start_http_server | ||
| 3410 | + ( | ||
| 3411 | + Word32 ip_address, | ||
| 3412 | + Word32 port, | ||
| 3413 | + List(Web_Site_Description) sites, | ||
| 3414 | + DenialOfService dos | ||
| 3415 | + ) = | ||
| 3416 | + create_directories(sites); | ||
| 3417 | + start_http_server(ip_address,port, | ||
| 3418 | + make_http_handler(sites,dos), | ||
| 3419 | + 0, | ||
| 3420 | + dos). | ||
| 3421 | + | ||
| 3422 | + | ||
| 3423 | + For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not | ||
| 3424 | + yet able to manipulate several SSL server certificates. 'anbexec' and | ||
| 3425 | + 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The | ||
| 3426 | + 'solution' for the time being is to provide the common name of the unique SSL server | ||
| 3427 | + certificate. | ||
| 3428 | + | ||
| 3429 | + | ||
| 3430 | +define StartServerResult | ||
| 3431 | + start_https_server | ||
| 3432 | + ( | ||
| 3433 | + Word32 ip_address, | ||
| 3434 | + Word32 port, | ||
| 3435 | + String certificate_common_name, | ||
| 3436 | + Server -> (SSL_Connection -> One) handler, | ||
| 3437 | + Int retries, | ||
| 3438 | + DenialOfService dos | ||
| 3439 | + ) = | ||
| 3440 | + if start_ssl_server(ip_address, | ||
| 3441 | + port, | ||
| 3442 | + certificate_common_name, | ||
| 3443 | + handler, | ||
| 3444 | + identity) is ok(server) | ||
| 3445 | + then print(" \r"); | ||
| 3446 | + ok(server) | ||
| 3447 | + else print("Port "+port+": retry number "+retries+"\r"); | ||
| 3448 | + sleep(1000); | ||
| 3449 | + start_https_server(ip_address,port, | ||
| 3450 | + certificate_common_name, | ||
| 3451 | + handler,retries+1, | ||
| 3452 | + dos). | ||
| 3453 | + | ||
| 3454 | + | ||
| 3455 | +public define StartServerResult | ||
| 3456 | + start_https_server | ||
| 3457 | + ( | ||
| 3458 | + Word32 ip_address, | ||
| 3459 | + Word32 port, | ||
| 3460 | + String certificate_common_name, // of SSL server certificate | ||
| 3461 | + List(Web_Site_Description) sites, | ||
| 3462 | + DenialOfService dos | ||
| 3463 | + ) = | ||
| 3464 | + create_directories(sites); | ||
| 3465 | + start_https_server(ip_address,port,certificate_common_name, | ||
| 3466 | + make_https_handler(sites,dos), | ||
| 3467 | + 0,dos). | ||
| 3468 | + | ||
| 3469 | + | ||
| 3470 | + | ||
| 3471 | + | ||
| 3472 | + | ||
| 3473 | + | ||
| 3474 | + | ||
| 3475 | + | ||
| 3476 | + | ||
| 3477 | + *** [7] The web dispatcher. | ||
| 3478 | + | ||
| 3479 | + | ||
| 3480 | + *** [7.1] The dispatcher server. | ||
| 3481 | + | ||
| 3482 | +define One | ||
| 3483 | + send_dispatching_page | ||
| 3484 | + ( | ||
| 3485 | + RWStream conn, | ||
| 3486 | + String common_name, | ||
| 3487 | + Word32 port | ||
| 3488 | + ) = | ||
| 3489 | + print("Dispatching '"+common_name+"' to port "+port+"\n"); | ||
| 3490 | + forget(reliable_write(conn,to_byte_array( | ||
| 3491 | + "<html><head><meta http-equiv=\"Refresh\" content=\"0;URL="+ | ||
| 3492 | + "http://"+common_name+":"+port+"/"+ | ||
| 3493 | + "\"></head><body></body></html>" | ||
| 3494 | + ))). | ||
| 3495 | + | ||
| 3496 | + | ||
| 3497 | + | ||
| 3498 | +define Maybe(DispatcherInfo) | ||
| 3499 | + find_host | ||
| 3500 | + ( | ||
| 3501 | + List(DispatcherInfo) l, | ||
| 3502 | + String host | ||
| 3503 | + ) = | ||
| 3504 | + if l is | ||
| 3505 | + { | ||
| 3506 | + [ ] then failure, | ||
| 3507 | + [h . t] then if h is site(name,port) then | ||
| 3508 | + if name = host | ||
| 3509 | + then success(h) | ||
| 3510 | + else find_host(t,host) | ||
| 3511 | + }. | ||
| 3512 | + | ||
| 3513 | + | ||
| 3514 | + | ||
| 3515 | +define Server -> ((RWStream) -> One) | ||
| 3516 | + make_dispatcher_handler | ||
| 3517 | + ( | ||
| 3518 | + Var(List(DispatcherInfo)) info_v, | ||
| 3519 | + DenialOfService dos | ||
| 3520 | + ) = | ||
| 3521 | + (Server server) |-> (RWStream conn) |-> | ||
| 3522 | + with start_time = (Int)now, | ||
| 3523 | + connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)), | ||
| 3524 | + if read_request_line(connection, start_time+*request_line_delay(dos), dos) is | ||
| 3525 | + { | ||
| 3526 | + error(msg) then print(format(msg)), | ||
| 3527 | + ok(request_line) then | ||
| 3528 | + if read_http_headers(connection, start_time+*headers_delay(dos), dos) is | ||
| 3529 | + { | ||
| 3530 | + error(msg) then print(format(msg)), | ||
| 3531 | + ok(headers) then if get_host_header_value(headers) is | ||
| 3532 | + { | ||
| 3533 | + failure then print("No 'HOST' HTTP header.\n"), | ||
| 3534 | + success(host) then | ||
| 3535 | + if find_host(*info_v,host) is | ||
| 3536 | + { | ||
| 3537 | + failure then print("Host: '"+host+"' not registered.\n"), | ||
| 3538 | + success(s) then if s is site(common_name,ip_port) then | ||
| 3539 | + send_dispatching_page(conn,common_name,ip_port) | ||
| 3540 | + } | ||
| 3541 | + } | ||
| 3542 | + } | ||
| 3543 | + }. | ||
| 3544 | + | ||
| 3545 | + | ||
| 3546 | +define One | ||
| 3547 | + dispatcher_update_error | ||
| 3548 | + ( | ||
| 3549 | + String file_path | ||
| 3550 | + ) = | ||
| 3551 | + print("web_dispatcher: unable to reread file: '"+file_path+"'.\n"). | ||
| 3552 | + | ||
| 3553 | + | ||
| 3554 | +define Bool | ||
| 3555 | + dispatcher_update_data | ||
| 3556 | + ( | ||
| 3557 | + String info_file_path, | ||
| 3558 | + Var(List(DispatcherInfo)) info_v, | ||
| 3559 | + Var(Int) info_date_v | ||
| 3560 | + ) = | ||
| 3561 | + if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is | ||
| 3562 | + { | ||
| 3563 | + [ ] then false, | ||
| 3564 | + [h . t] then if h is | ||
| 3565 | + { | ||
| 3566 | + no_info(n) then false, | ||
| 3567 | + file(n,_,_,d) then if n = "dispatcher.info" | ||
| 3568 | + then (info_date_v <- to_Int(d); | ||
| 3569 | + if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is | ||
| 3570 | + { | ||
| 3571 | + cannot_find_file then false, | ||
| 3572 | + read_error then false, | ||
| 3573 | + type_error then false, | ||
| 3574 | + ok(info) then info_v <- info; true | ||
| 3575 | + }) | ||
| 3576 | + else false, | ||
| 3577 | + link(_,_,_,_) then false, | ||
| 3578 | + directory(_,_,_) then false | ||
| 3579 | + } | ||
| 3580 | + }. | ||
| 3581 | + | ||
| 3582 | + | ||
| 3583 | + | ||
| 3584 | + The loop within which the dispatcher updates its data every 3 seconds: | ||
| 3585 | + | ||
| 3586 | +define One | ||
| 3587 | + dispatcher_update_task | ||
| 3588 | + ( | ||
| 3589 | + String info_file_path, | ||
| 3590 | + Var(List(DispatcherInfo)) info_v, | ||
| 3591 | + Var(Int) info_date_v | ||
| 3592 | + ) = | ||
| 3593 | + sleep(3000); | ||
| 3594 | + (if dispatcher_update_data(info_file_path,info_v,info_date_v) | ||
| 3595 | + then unique | ||
| 3596 | + else dispatcher_update_error(info_file_path)); | ||
| 3597 | + dispatcher_update_task(info_file_path,info_v,info_date_v). | ||
| 3598 | + | ||
| 3599 | + | ||
| 3600 | +public define One | ||
| 3601 | + start_web_dispatcher | ||
| 3602 | + ( | ||
| 3603 | + Word32 ip_address, // address for listening (typically 0: listen on all interfaces) | ||
| 3604 | + Word32 http_port, // typically 80 | ||
| 3605 | + DenialOfService dos | ||
| 3606 | + ) = | ||
| 3607 | + with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info", | ||
| 3608 | + info_v = var((List(DispatcherInfo))[]), | ||
| 3609 | + info_date_v = var((Int)0), | ||
| 3610 | + if dispatcher_update_data(info_file_path,info_v,info_date_v) | ||
| 3611 | + then if start_server(ip_address, | ||
| 3612 | + http_port, | ||
| 3613 | + make_dispatcher_handler(info_v,dos), | ||
| 3614 | + (One u)|->u) is | ||
| 3615 | + { | ||
| 3616 | + cannot_create_the_socket then | ||
| 3617 | + print("Cannot create the socket for HTTP server.\n"), | ||
| 3618 | + cannot_bind_to_port then | ||
| 3619 | + print("Cannot bind HTTP server to port "+http_port+".\n"), | ||
| 3620 | + cannot_listen_on_port then | ||
| 3621 | + print("HTTP server cannot listen on port "+http_port+".\n"), | ||
| 3622 | + ok(http_server) then | ||
| 3623 | + dispatcher_update_task(info_file_path,info_v,info_date_v) | ||
| 3624 | + } | ||
| 3625 | + else dispatcher_update_error(info_file_path). | ||
| 3626 | + | ||
| 3627 | + | ||
| 3628 | + | ||
| 3629 | + *** [7.2] The dispatcher web site. | ||
| 3630 | + | ||
| 3631 | + global define One | ||
| 3632 | + web_dispatcher | ||
| 3633 | + ( | ||
| 3634 | + List(String) args | ||
| 3635 | + ) = | ||
| 3636 | + start_web_dispatcher(0,80,load_denial_of_service_info). | ||
| 3637 | + | ||
| 3638 | + | ||
| 3639 | + | ||
| 3640 | + | ||
| 3641 | + | ||
| 3642 | + | ||
| 3643 | + *** [7.3] Managing the info file. | ||
| 3644 | + | ||
| 3645 | +define Word32 | ||
| 3646 | + register_ip_address | ||
| 3647 | + = | ||
| 3648 | + if ip_address(prompt(" numerical IP address (for HTTP): ")) is | ||
| 3649 | + { | ||
| 3650 | + failure then print(" *** Error: incorrect IP address.\n"); | ||
| 3651 | + register_ip_address, | ||
| 3652 | + success(n) then n | ||
| 3653 | + }. | ||
| 3654 | + | ||
| 3655 | + | ||
| 3656 | +define Word32 | ||
| 3657 | + register_ip_port | ||
| 3658 | + = | ||
| 3659 | + if decimal_scan(prompt(" IP port (for HTTP): ")) is | ||
| 3660 | + { | ||
| 3661 | + failure then print(" *** Error: incorrect IP port.\n"); | ||
| 3662 | + register_ip_port, | ||
| 3663 | + success(p) then if (0 =< p & p =< 65535) | ||
| 3664 | + then truncate_to_Word32(p) | ||
| 3665 | + else print(" *** Error: IP port out of bounds.\n"); | ||
| 3666 | + register_ip_port | ||
| 3667 | + }. | ||
| 3668 | + | ||
| 3669 | + | ||
| 3670 | +define One | ||
| 3671 | + register_new_site | ||
| 3672 | + ( | ||
| 3673 | + Var(List(DispatcherInfo)) info_v | ||
| 3674 | + ) = | ||
| 3675 | + print("\n"); | ||
| 3676 | + print(" Registering a new site:\n"); | ||
| 3677 | + with name = prompt(" Site name: "), | ||
| 3678 | + with addr = register_ip_address, | ||
| 3679 | + with port = register_ip_port, | ||
| 3680 | + (protect info_v <- [site(name,port) . *info_v]); | ||
| 3681 | + print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n"). | ||
| 3682 | + | ||
| 3683 | + | ||
| 3684 | +define List(DispatcherInfo) | ||
| 3685 | + find_sites | ||
| 3686 | + ( | ||
| 3687 | + List(DispatcherInfo) l, | ||
| 3688 | + String name | ||
| 3689 | + ) = | ||
| 3690 | + if l is | ||
| 3691 | + { | ||
| 3692 | + [ ] then [ ], | ||
| 3693 | + [h . t] then if h is site(n,_) then | ||
| 3694 | + if find(name,n,0) is | ||
| 3695 | + { | ||
| 3696 | + failure then find_sites(t,name), | ||
| 3697 | + success(_) then [h . find_sites(t,name)] | ||
| 3698 | + } | ||
| 3699 | + }. | ||
| 3700 | + | ||
| 3701 | + | ||
| 3702 | +define String | ||
| 3703 | + pad | ||
| 3704 | + ( | ||
| 3705 | + String s, | ||
| 3706 | + Int l | ||
| 3707 | + ) = | ||
| 3708 | + if length(s) >= l | ||
| 3709 | + then s | ||
| 3710 | + else s+constant_string(l-length(s),' '). | ||
| 3711 | + | ||
| 3712 | + | ||
| 3713 | + | ||
| 3714 | +define One | ||
| 3715 | + show_sites_1 | ||
| 3716 | + ( | ||
| 3717 | + List(DispatcherInfo) l, | ||
| 3718 | + Int i | ||
| 3719 | + ) = | ||
| 3720 | + if l is | ||
| 3721 | + { | ||
| 3722 | + [ ] then unique, | ||
| 3723 | + [h . t] then if h is site(name,port) then | ||
| 3724 | + print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n"); | ||
| 3725 | + show_sites_1(t,i+1) | ||
| 3726 | + }. | ||
| 3727 | + | ||
| 3728 | + | ||
| 3729 | +define One | ||
| 3730 | + show_sites | ||
| 3731 | + ( | ||
| 3732 | + List(DispatcherInfo) l, | ||
| 3733 | + Int i | ||
| 3734 | + ) = | ||
| 3735 | + print(" Name Port\n"); | ||
| 3736 | + print(" --------------------------------------------------------\n"); | ||
| 3737 | + show_sites_1(l,i). | ||
| 3738 | + | ||
| 3739 | +define List(DispatcherInfo) | ||
| 3740 | + replace_info | ||
| 3741 | + ( | ||
| 3742 | + List(DispatcherInfo) l, | ||
| 3743 | + String site_name, | ||
| 3744 | + Word32 new_port | ||
| 3745 | + ) = | ||
| 3746 | + if l is | ||
| 3747 | + { | ||
| 3748 | + [ ] then print("ALERT: Empty list into replace_info() [" + __FILE__ + "]\n"); [], | ||
| 3749 | + [h . t] then if h is site(n,_) then | ||
| 3750 | + if n = site_name | ||
| 3751 | + then [site(n,new_port) . t] | ||
| 3752 | + else [h . replace_info(t,site_name,new_port)] | ||
| 3753 | + }. | ||
| 3754 | + | ||
| 3755 | +define List(DispatcherInfo) | ||
| 3756 | + delete_info | ||
| 3757 | + ( | ||
| 3758 | + List(DispatcherInfo) l, | ||
| 3759 | + String site_name, | ||
| 3760 | + ) = | ||
| 3761 | + if l is | ||
| 3762 | + { | ||
| 3763 | + [ ] then print("ALERT: Empty list into delete_info() [" + __FILE__ + "]\n"); [], | ||
| 3764 | + [h . t] then if h is site(n,_) then | ||
| 3765 | + if n = site_name | ||
| 3766 | + then t | ||
| 3767 | + else [h . delete_info(t,site_name)] | ||
| 3768 | + }. | ||
| 3769 | + | ||
| 3770 | + | ||
| 3771 | +define One | ||
| 3772 | + update_site | ||
| 3773 | + ( | ||
| 3774 | + Var(List(DispatcherInfo)) info_v, | ||
| 3775 | + String site_name, | ||
| 3776 | + Word32 old_port | ||
| 3777 | + ) = | ||
| 3778 | + print("\n"); | ||
| 3779 | + print(" Updating site '"+site_name+"': (currently: "+old_port+")\n"); | ||
| 3780 | + with new_port = register_ip_port, | ||
| 3781 | + answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "), | ||
| 3782 | + if (answer = "Y" | answer = "y") | ||
| 3783 | + then info_v <- replace_info(*info_v,site_name,new_port) | ||
| 3784 | + else unique. | ||
| 3785 | + | ||
| 3786 | + | ||
| 3787 | + | ||
| 3788 | +define Bool | ||
| 3789 | + compare | ||
| 3790 | + ( | ||
| 3791 | + DispatcherInfo d1, | ||
| 3792 | + DispatcherInfo d2 | ||
| 3793 | + ) = | ||
| 3794 | + if d1 is site(n1,_) then | ||
| 3795 | + if d2 is site(n2,_) then | ||
| 3796 | + string_less(n1,n2). | ||
| 3797 | + | ||
| 3798 | + | ||
| 3799 | + | ||
| 3800 | +define One | ||
| 3801 | + update_site | ||
| 3802 | + ( | ||
| 3803 | + Var(List(DispatcherInfo)) info_v | ||
| 3804 | + ) = | ||
| 3805 | + print("\n"); | ||
| 3806 | + with prefix = prompt(" Search for site to update: "), | ||
| 3807 | + if find_sites(*info_v,prefix) is | ||
| 3808 | + { | ||
| 3809 | + [ ] then print(" No site found.\n"); | ||
| 3810 | + update_site(info_v), | ||
| 3811 | + [h . t] then | ||
| 3812 | + show_sites(qsort([h . t],compare),1); | ||
| 3813 | + with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "), | ||
| 3814 | + if decimal_scan(i1) is | ||
| 3815 | + { | ||
| 3816 | + failure then print(" *** Error: site number not recognized.\n"); | ||
| 3817 | + update_site(info_v), | ||
| 3818 | + success(ii1) then if nth(ii1-1,*info_v) is | ||
| 3819 | + { | ||
| 3820 | + failure then print(" *** Error: site number "+i1+" does not exist.\n"); | ||
| 3821 | + update_site(info_v), | ||
| 3822 | + success(site_info) then if site_info is site(name,old_port) then | ||
| 3823 | + update_site(info_v,name,old_port) | ||
| 3824 | + } | ||
| 3825 | + } | ||
| 3826 | + }. | ||
| 3827 | + | ||
| 3828 | + | ||
| 3829 | +define One | ||
| 3830 | + delete_site | ||
| 3831 | + ( | ||
| 3832 | + Var(List(DispatcherInfo)) info_v, | ||
| 3833 | + String site_name, | ||
| 3834 | + Word32 old_port | ||
| 3835 | + ) = | ||
| 3836 | + print("\n"); | ||
| 3837 | + print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n"); | ||
| 3838 | + with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "), | ||
| 3839 | + if (answer = "Y" | answer = "y") | ||
| 3840 | + then info_v <- delete_info(*info_v,site_name) | ||
| 3841 | + else print(" Site '"+site_name+"' not deleted.\n"). | ||
| 3842 | + | ||
| 3843 | + | ||
| 3844 | +define One | ||
| 3845 | + delete_site | ||
| 3846 | + ( | ||
| 3847 | + Var(List(DispatcherInfo)) info_v | ||
| 3848 | + ) = | ||
| 3849 | + print("\n"); | ||
| 3850 | + with prefix = prompt(" Search for site to delete: "), | ||
| 3851 | + if find_sites(*info_v,prefix) is | ||
| 3852 | + { | ||
| 3853 | + [ ] then print(" No site found.\n"); | ||
| 3854 | + delete_site(info_v), | ||
| 3855 | + [h . t] then | ||
| 3856 | + show_sites(qsort([h . t],compare),1); | ||
| 3857 | + with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "), | ||
| 3858 | + if decimal_scan(i1) is | ||
| 3859 | + { | ||
| 3860 | + failure then print(" *** Error: site number not recognized.\n"); | ||
| 3861 | + delete_site(info_v), | ||
| 3862 | + success(ii1) then if nth(ii1-1,*info_v) is | ||
| 3863 | + { | ||
| 3864 | + failure then print(" *** Error: site number "+i1+" does not exist.\n"); | ||
| 3865 | + delete_site(info_v), | ||
| 3866 | + success(site_info) then if site_info is site(name,old_port) then | ||
| 3867 | + delete_site(info_v,name,old_port) | ||
| 3868 | + } | ||
| 3869 | + } | ||
| 3870 | + }. | ||
| 3871 | + | ||
| 3872 | + | ||
| 3873 | +define One | ||
| 3874 | + manager | ||
| 3875 | + ( | ||
| 3876 | + Var(List(DispatcherInfo)) info_v, | ||
| 3877 | + String file_path | ||
| 3878 | + ) = | ||
| 3879 | + print("\n"); | ||
| 3880 | + print(" --- Welcome to the Web Dispatcher Manager ---\n"); | ||
| 3881 | + with l = length(*info_v), | ||
| 3882 | + print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n"); | ||
| 3883 | + print(" [L] List registered sites.\n"); | ||
| 3884 | + print(" [R] Register a new site.\n"); | ||
| 3885 | + print(" [U] Update a registred site.\n"); | ||
| 3886 | + print(" [D] Delete a registred site.\n"); | ||
| 3887 | + with propose_write_v = var((Bool)true), | ||
| 3888 | + action = prompt(" Choose an action [L/R/U/D]: "), | ||
| 3889 | + (if (action = "L" | action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else | ||
| 3890 | + if (action = "R" | action = "r") then register_new_site(info_v) else | ||
| 3891 | + if (action = "U" | action = "u") then update_site(info_v) else | ||
| 3892 | + if (action = "D" | action = "d") then delete_site(info_v) else | ||
| 3893 | + print("Action not recognized.\n")); | ||
| 3894 | + print("\n"); | ||
| 3895 | + if *propose_write_v then | ||
| 3896 | + with result = prompt(" Write modifications to data base [Y/N] ?"), | ||
| 3897 | + if (result = "Y" | result = "y") | ||
| 3898 | + then if save(*info_v,file_path) is | ||
| 3899 | + { | ||
| 3900 | + cannot_open_file then print(" File '"+file_path+"' not found.\n"), | ||
| 3901 | + write_error then print(" Error while writing file '"+file_path+"'.\n"), | ||
| 3902 | + ok then print(" Data base has been modified.\n") | ||
| 3903 | + } | ||
| 3904 | + else print(" Data base not modified.\n") | ||
| 3905 | + else unique. | ||
| 3906 | + | ||
| 3907 | + | ||
| 3908 | + | ||
| 3909 | +global define One | ||
| 3910 | + manage_web_dispatcher | ||
| 3911 | + ( | ||
| 3912 | + List(String) args | ||
| 3913 | + ) = | ||
| 3914 | + with info_v = var((List(DispatcherInfo))[]), | ||
| 3915 | + with file_path = my_anubis_directory+"/web_sites/dispatcher.info", | ||
| 3916 | + if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is | ||
| 3917 | + { | ||
| 3918 | + cannot_find_file then print("File '"+file_path+"' does not exist.\n"); | ||
| 3919 | + with answer = prompt("Create it [Y/N] ? "), | ||
| 3920 | + if (answer = "Y" | answer = "y") | ||
| 3921 | + then if save((List(DispatcherInfo))[],file_path) is | ||
| 3922 | + { | ||
| 3923 | + cannot_open_file then | ||
| 3924 | + print("Cannot create file '"+file_path+"'.\n"), | ||
| 3925 | + write_error then | ||
| 3926 | + print("Error while creating file '"+file_path+"'.\n"), | ||
| 3927 | + ok then manager(info_v,file_path) | ||
| 3928 | + } | ||
| 3929 | + else unique, | ||
| 3930 | + read_error then print("Error while reading file '"+file_path+"'.\n"), | ||
| 3931 | + type_error then print("File '"+file_path+"' is corrupted.\n"), | ||
| 3932 | + ok(info) then info_v <- info; | ||
| 3933 | + manager(info_v,file_path) | ||
| 3934 | + }. | ||
| 3935 | + | ||
| 3936 | + | ||
| 3937 | + | ||
| 3938 | + | ||
| 3939 | + | ||
| 3940 | +public define (String, List(HTTP_header)) | ||
| 3941 | + format | ||
| 3942 | + ( | ||
| 3943 | + HTTP_Status status | ||
| 3944 | + ) = | ||
| 3945 | + if status is | ||
| 3946 | + { | ||
| 3947 | + http_continue then ("100 Continue", []), | ||
| 3948 | + http_switching_protocol then ("101 Switching Protocols", []), | ||
| 3949 | + | ||
| 3950 | + http_ok then ("200 OK", []), | ||
| 3951 | + http_created then ("201 Created", []), | ||
| 3952 | + http_accepted then ("202 Accepted", []), | ||
| 3953 | + http_non_authoritative_info then ("203 Non-Authoritative Information", []), | ||
| 3954 | + http_no_content then ("204 No Content", []), | ||
| 3955 | + http_reset_content then ("205 Reset Content", []), | ||
| 3956 | + http_partial_content then ("206 Partial Content", []), | ||
| 3957 | + | ||
| 3958 | + http_multiple_choices then ("300 Multiple Choices", []), | ||
| 3959 | + http_moved_permanently(loc) then ("301 Moved Permanently", [http_header("Location", loc)]), | ||
| 3960 | + http_moved_temporarily(loc) then ("302 Moved Temporarily", [http_header("Location", loc)]), | ||
| 3961 | + http_see_other(loc) then ("303 See Other", [http_header("Location", loc)]), | ||
| 3962 | + http_not_modified then ("304 Not Modified", []), | ||
| 3963 | + http_use_proxy(loc) then ("305 Use Proxy", [http_header("Location", loc)]), | ||
| 3964 | + http_temporary_redirect(loc) then ("307 Temporary Redirect", [http_header("Location", loc)]), | ||
| 3965 | + | ||
| 3966 | + http_bad_request then ("400 Bad Request", []), | ||
| 3967 | + http_unauthorized then ("401 Unauthorized", []), | ||
| 3968 | + http_payment_required then ("402 Payment Required", []), | ||
| 3969 | + http_forbidden then ("403 Forbidden", []), | ||
| 3970 | + http_not_found then ("404 Not Found", []), | ||
| 3971 | + http_method_not_allowed then ("405 Method Not Allowed", []), | ||
| 3972 | + http_not_acceptable then ("406 Not Acceptable", []), | ||
| 3973 | + http_proxy_authentification_required then ("407 Proxy Authentication Required", []), | ||
| 3974 | + http_request_timeout then ("408 Request Time-out", []), | ||
| 3975 | + http_conflict then ("409 Conflict", []), | ||
| 3976 | + http_gone then ("410 Gone", []), | ||
| 3977 | + http_length_required then ("411 Length Required", []), | ||
| 3978 | + http_precondition_failed then ("412 Precondition Failed", []), | ||
| 3979 | + http_request_entity_too_large then ("413 Request Entity Too Large", []), | ||
| 3980 | + http_request_uri_too_long then ("414 Request-URI Too Long", []), | ||
| 3981 | + http_unsupported_media_type then ("415 Unsupported Media Type", []), | ||
| 3982 | + http_request_range_unsatisfiable then ("416 Requested range unsatisfiable", []), | ||
| 3983 | + http_expectation_failed then ("417 Expectation failed", []), | ||
| 3984 | + | ||
| 3985 | + http_internal_server_error then ("500 Internal Server Error", []), | ||
| 3986 | + http_not_implemented then ("501 Not Implemented", []), | ||
| 3987 | + http_bad_gateway then ("502 Bad Gateway", []), | ||
| 3988 | + http_service_unavailable then ("503 Service Unavailable", []), | ||
| 3989 | + http_gateway_timeout then ("504 Gateway Time-out", []), | ||
| 3990 | + http_version_not_supported then ("505 HTTP Version not supported", []), | ||
| 3991 | + | ||
| 3992 | + http_error(code, message) then (abs_to_decimal(code) + " " + message, []) | ||
| 3993 | + }. | ||
| 3994 | + | ||
| 3995 | + |