1# Copyright (C) 2006-2012, Parrot Foundation. 2 3=head1 NAME 4 5HTTP;Daemon - A Simple HTTPD Server 6 7=head1 SYNOPSIS 8 9 load_bytecode "HTTP/Daemon.pbc" 10 opts = new 'Hash' 11 opts['LocalPort'] = 1234 12 opts['LocalAddr'] = 'localhost' 13 d = new ['HTTP';'Daemon'], opts 14 unless d goto err 15 d.'run'() 16 17=head1 DESCRIPTION 18 19The code is by now just an objectified version of httpd.pir. 20 21=head1 SEE ALSO 22 23RFC2616 24 25=head1 AUTHOR 26 27Leopold Toetsch <lt@toetsch.at> - some code based on httpd.pir. 28 29=cut 30 31=head1 Class HTTP; Daemon 32 33A HTTP server class. 34 35=head2 Functions 36 37=over 38 39=item _onload 40 41Called from I<load_bytecode> to create used classes. 42 43=item req_handler(pio, conn) 44 45Called from the asynchronous select code, when data are ready to read 46at the pio. 47 48=cut 49 50.sub '_onload' :load 51 .local pmc cl 52 # server clsass 53 cl = newclass ['HTTP'; 'Daemon'] 54 addattribute cl, 'socket' # pio where httpd is listening 55 addattribute cl, 'opts' # options TBdoced 56 addattribute cl, 'active' # list of active ClientConns 57 addattribute cl, 'to_log' # list of strings to be logged 58 addattribute cl, 'doc_root' # where to serve files from 59 60 # client connection 61 # XXX this should subclass ParrotIO but opcode or PIO code 62 # just doesn't work with classes 63 cl = newclass ['HTTP'; 'Daemon'; 'ClientConn'] 64 addattribute cl, 'socket' # the connected pio 65 addattribute cl, 'server' # whom are we working for 66 addattribute cl, 'close' # needs closing after req is handled 67 addattribute cl, 'time_stamp' # timestamp for timeout 68 69 # TODO split into new file, if more mature 70 cl = newclass ['HTTP'; 'Message'] 71 addattribute cl, 'headers' # hash 72 addattribute cl, 'content' # string 73 74 # Message subclasses 75 $P0 = subclass cl, ['HTTP'; 'Request'] 76 $P0 = subclass cl, ['HTTP'; 'Response'] 77.end 78 79.namespace ['HTTP'; 'Daemon'] 80 81.const string CRLF = "\r\n" 82.const string CRLFCRLF = "\r\n\r\n" 83.const string LFLF = "\n\n" 84.const string CRCR = "\r\r" 85 86.include "stat.pasm" 87.include 'except_types.pasm' 88.include 'socket.pasm' 89 90.loadlib 'io_ops' 91.loadlib 'sys_ops' 92 93=back 94 95=head2 Methods 96 97=over 98 99=item __init(args) 100 101Object initializer, takes a hash argument to initialize attributes, 102which are: 103 104=over 105 106=item LocalPort 107 108Port number to listen. 109 110=item LocalAddr 111 112Address name or IP number to listen. 113 114=item debug 115 116Turn on internal diagnostic messages, printed to stderr. 117 118=item parrot-docs 119 120Redirect to and serve files from F<docs/html>. 121 122=back 123 124=cut 125 126.sub init_pmc :vtable :method 127 .param pmc args 128 129 .local pmc active 130 131 setattribute self, 'opts', args 132 active = new 'ResizablePMCArray' 133 setattribute self, 'active', active 134 $P0 = new 'ResizableStringArray' 135 setattribute self, 'to_log', $P0 136 $P0 = new 'String' 137 $P0 = '.' 138 setattribute self, 'doc_root', $P0 139 140 # create listener socket 141 .local pmc listener 142 listener = new 'Socket' 143 listener.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP) 144 unless listener goto err_sock 145 setattribute self, 'socket', listener 146 147 .local int port 148 .local string host 149 host = args['LocalAddr'] 150 port = args['LocalPort'] 151 152 # bind 153 .local string i_addr 154 .local int res 155 i_addr = listener.'sockaddr'(host, port) 156 res = listener.'bind'(i_addr) 157 if res == -1 goto err_bind 158 159 # listen 160 res = listener.'listen'(1) 161 if res == -1 goto err_listen 162 163 # add connection 164 self.'new_conn'(listener) 165 .return() 166 167err_listen: 168err_bind: 169 err $I0 170 err $S0, $I0 171 printerr $S0 172 printerr "\n" 173 listener.'close'() 174err_sock: 175 $P0 = new 'Undef' 176 setattribute self, 'socket', $P0 177.end 178 179=item socket() 180 181Get connected server socket. 182 183=item opts() 184 185Get server options. 186 187=item url(?init?) 188 189Get or set server url, aka document root 190 191=cut 192 193.sub 'socket' :method 194 $P0 = getattribute self, 'socket' 195 .return ($P0) 196.end 197 198.sub 'opts' :method 199 $P0 = getattribute self, 'opts' 200 .return ($P0) 201.end 202 203.sub 'url' :method 204 .param string doc_root :optional 205 .param int has_dr :opt_flag 206 $P0 = getattribute self, 'doc_root' 207 if has_dr goto set_it 208 $S0 = $P0 209 .return ($S0) 210set_it: 211 $P0 = doc_root 212.end 213 214=item get_bool() 215 216Object is true if the daemon is listening on a socket, that is if the 217initialization went ok. 218 219=cut 220 221.sub 'get_bool' :vtable :method 222 $P0 = getattribute self, 'socket' 223 $I0 = istrue $P0 224 .return ($I0) 225.end 226 227 228=item run() 229 230Main server runloop. 231 232=cut 233 234.sub 'run' :method 235 print "running\n" 236 237loop: 238 ## self.'_del_stale_conns'() 239 self.'_select_active'() 240 # while idle dump the logfile 241 self.'_write_logs'() 242 sleep 0.5 243 goto loop 244.end 245 246# === server utils 247 248=item _write_logs() 249 250Called from server runloop. Write log files (currently to stdout 251only). 252 253=cut 254 255.sub '_write_logs' :method 256 .local pmc to_log 257 to_log = getattribute self, 'to_log' 258loop: 259 # log can fill, while we are running here 260 unless to_log goto ex 261 $S0 = shift to_log 262 print $S0 263 goto loop 264ex: 265.end 266 267=item debug(...) 268 269If debugging is on, concat passed arguments and write that string to 270stderr. 271 272=cut 273 274.sub 'debug' :method 275 .param pmc args :slurpy 276 277 .local pmc opts 278 opts = getattribute self, 'opts' 279 $I0 = opts['debug'] 280 if $I0 goto do_debug 281 .return() 282do_debug: 283 .local int n 284 .local string fmt, res 285 n = elements args 286 fmt = repeat "%Ss", n 287 res = sprintf fmt, args 288 printerr res 289.end 290 291=item log(...) 292 293Concat passed arguments and schedule the string for logging. 294 295=cut 296 297.sub 'log' :method 298 .param pmc args :slurpy 299 300 .local int n, now 301 .local string fmt, res, t 302 n = elements args 303 n += 3 304 now = time 305 $S0 = gmtime now 306 $S0 = chopn $S0, 1 # XXX why 1? asctime is \n terminated 307 unshift args, ", " 308 unshift args, $S0 309 push args, "\n" 310 fmt = repeat "%Ss", n 311 res = sprintf fmt, args 312 .local pmc to_log 313 to_log = getattribute self, 'to_log' 314 # Yay! The fun of any async server 315 # write to log when we idling 316 push to_log, res 317.end 318 319# === connection handling 320 321=item _select_active() 322 323Create a select event for all active connections. Called from server 324runnloop. 325 326=cut 327 328.sub '_select_active' :method 329 .local pmc active, conn, sock 330 .local int i, n 331 .const 'Sub' req_handler = "req_handler" 332 active = getattribute self, 'active' 333 n = elements active 334 i = 0 335add_lp: 336 conn = active[i] 337 sock = conn.'socket'() 338 # XXX: this opcode is long gone; need something else 339 # add_io_event sock, req_handler, conn, .IO_THR_MSG_ADD_SELECT_RD 340 ## self.'debug'('**select ', i, "\n") 341 inc i 342 if i < n goto add_lp 343.end 344 345=item _del_stale_conns() 346 347Not yet used method to delete old connections for the active set. 348Called from server runloop. 349 350=cut 351 352.sub '_del_stale_conns' :method 353 .local int n, now, last 354 .local pmc active, conn, sock 355 356 now = time 357 active = getattribute self, 'active' 358 n = elements active 359 dec n 360loop: 361 unless n goto done 362 conn = active[n] 363 last = conn.'time_stamp'() 364 $I0 = now - last 365 if $I0 < 10 goto keep_it # TODO ops var 366 sock = conn.'socket'() 367 close sock 368 delete active[n] 369 self.'debug'('del stale conn ', n, "\n") 370keep_it: 371 dec n 372 goto loop 373done: 374.end 375 376=item new_conn(pio) 377 378Add C<pio> to the list of active connections. 379 380 381=item accept_conn() 382 383Accept a new connection and call C<new_conn> on the accepted socket. 384 385=item del_conn(conn) 386 387Delete connection from the active list 388 389=item exists_conn(conn) 390 391Return true, if the given connection is already active. 392 393=cut 394 395# add socket to active connections 396.sub 'new_conn' :method 397 .param pmc sock 398 .local pmc active, conn 399 active = getattribute self, 'active' 400 conn = new ['HTTP'; 'Daemon'; 'ClientConn'], sock 401 conn.'server'(self) 402 push active, conn 403 self.'debug'("new conn\n") 404.end 405 406# accept new connection and add to active 407.sub 'accept_conn' :method 408 .local pmc orig, work 409 orig = getattribute self, 'socket' 410 work.'accept'(orig) 411 self.'new_conn'(work) 412.end 413 414# remove work from active connections and close it 415.sub 'del_conn' :method 416 .param pmc work 417 418 .local pmc active, orig, sock 419 .local int i, n 420 sock = getattribute work, 'socket' 421 sock.'close'() 422 active = getattribute self, 'active' 423loop: 424 n = elements active 425 i = 0 426rem_lp: 427 $P0 = active[i] 428 eq_addr $P0, work, del_it 429 inc i 430 if i < n goto rem_lp 431del_it: 432 delete active[i] 433 .return() 434not_found: 435 self.'debug'("connection not found to delete\n") 436.end 437 438# close all sockets 439# this needs enabling of SIGHUP but still doesn't 440# help against FIN_WAIT2 / TIME_WAIT state of connections 441.sub 'shutdown' :method 442 .local pmc active, sock 443 active = getattribute self, 'active' 444rem_lp: 445 $P0 = pop active 446 sock = $P0.'socket'() 447 close sock 448 if active goto rem_lp 449.end 450 451# if work is the original httpd conn, it's a new connection 452.sub 'exists_conn' :method 453 .param pmc work 454 455 .local pmc active, orig 456 active = getattribute self, 'active' 457 orig = active[0] 458 ne_addr work, orig, yes 459 .return (0) 460yes: 461 .return (1) 462.end 463 464 465# request handler sub - not a method 466# this is called from the async select code, i.e from the event 467# subsystem 468.sub req_handler 469 .param pmc work # a pio 470 .param pmc conn # Conn obj 471 472 .local pmc srv, req 473 474 srv = conn.'server'() 475 $I0 = srv.'exists_conn'(conn) 476 if $I0 goto do_read 477 .tailcall srv.'accept_conn'() 478 479do_read: 480 req = conn.'get_request'() 481 unless req goto close_it 482 $S0 = req.'method'() 483 if $S0 == 'GET' goto serve_get 484 printerr 'unknown method: ' 485 printerr $S0 486 printerr "\n" 487close_it: 488 srv.'del_conn'(conn) 489 .return() 490serve_get: 491 .local string file 492 file = req.'uri'() 493 conn.'send_file_response'(file) 494.end 495 496=back 497 498=cut 499 500 501.namespace ['HTTP'; 'Daemon'; 'ClientConn'] 502 503=head1 Class HTTP; Daemon; ClientConn 504 505A class abstracting client connections. 506 507=head2 Methods 508 509=over 510 511=item init_pmc(pio) 512 513Create a new connection object with the given socket pio. 514 515=cut 516 517.sub init_pmc :vtable :method 518 .param pmc sock 519 setattribute self, 'socket', sock 520 $P0 = new 'Boolean' 521 setattribute self, 'close', $P0 522 $P0 = new 'Integer' 523 time $I0 524 $P0 = $I0 525 setattribute self, 'time_stamp', $P0 526.end 527 528=item socket() 529 530Get connection socket. 531 532=cut 533 534# get socket 535.sub 'socket' :method 536 $P0 = getattribute self, 'socket' 537 .return ($P0) 538.end 539 540=item server(?srv?) 541 542Get or set server object. 543 544=item timestamp(?ticks?) 545 546Get or set the timestamp of this connection. 547 548=cut 549 550.sub 'server' :method 551 .param pmc sv :optional 552 .param int has_sv :opt_flag 553 if has_sv goto set_it 554 sv = getattribute self, 'server' 555 .return (sv) 556set_it: 557 setattribute self, 'server', sv 558.end 559 560# get/set timestamp 561.sub 'time_stamp' :method 562 .param int ts :optional 563 .param int has_ts :opt_flag 564 $P0 = getattribute self, 'time_stamp' 565 if has_ts goto set_it 566 .return ($P0) 567set_it: 568 $P0 = ts 569.end 570 571=item get_request 572 573Read client request, return Request obj. Currently only C<GET> is 574supported. 575 576=cut 577 578.sub 'get_request' :method 579 580 .local pmc srv, req 581 .local string req_str 582 583 .local int now 584 now = time 585 self.'time_stamp'(now) 586 srv = self.'server'() 587 srv.'debug'("reading from work\n") 588 req_str = self.'_read'() 589 req = new ['HTTP'; 'Request'] 590 req.'parse'(req_str) 591 .return (req) 592.end 593 594=item _read 595 596Internal method to read from the client. It returns a request string. 597 598=cut 599 600.sub '_read' :method 601 .local int res, do_close, pos 602 .local string buf, req 603 .local pmc sock, srv 604 605 srv = self.'server'() 606 req = '' 607 do_close = 0 608 sock = self.'socket'() 609 # TODO keep a buffer and a state in Conn 610 # check method, read Content-Length if needed and read 611 # until message is complete 612MORE: 613 res = sock.'recv'(buf) 614 srv.'debug'("**read ", res, " bytes\n") 615 if res > 0 goto not_empty 616 do_close = 1 617 if res <= 0 goto done 618not_empty: 619 req = concat req, buf 620 index pos, req, CRLFCRLF 621 if pos >= 0 goto have_hdr 622 index pos, req, LFLF 623 if pos >= 0 goto have_hdr 624 index pos, req, CRCR 625 if pos >= 0 goto have_hdr 626 goto MORE 627have_hdr: 628 # TODO read content if any 629done: 630 $P0 = getattribute self, 'close' 631 $P0 = do_close 632 .return (req) 633.end 634 635=item send_respons(resp) 636 637Send the response back to the client. Argument is a response object. 638 639=item send_file_respons(url) 640 641Slurp the C<url> and send the response back to the client. 642TODO doc CGI urls. 643 644=item check_cgi(url) 645 646Check if a request url is a CGI request. If yes, return the result of the 647CGI invocation. 648 649=cut 650 651.sub 'send_response' :method 652 .param pmc resp 653 .local string rep 654 .local pmc sock 655 sock = self.'socket'() 656 rep = resp.'as_string'() 657 $I0 = sock.'send'(rep) # XXX don't ignore 658.end 659 660.sub 'send_file_response' :method 661 .param string url 662 663 .local string file_content, temp 664 .local int len 665 .local pmc srv, fp 666 667 srv = self.'server'() 668 goto SERVE_GET 669 670DONE: 671 .local int do_close 672 $P0 = getattribute self, 'close' 673 do_close = $P0 674 if do_close goto close_it 675 .return() 676close_it: 677 srv.'debug'("******* closed work\n") 678 srv.'del_conn'(self) 679 .return() 680 681SERVE_GET: 682 .local int is_cgi 683 .local pmc resp, opts 684 .local string doc_root 685 686 srv.'debug'("req url: ", url, "\n") 687 688 resp = new ['HTTP'; 'Response'] 689 690 opts = srv.'opts'() 691 $I0 = opts['parrot-docs'] 692 if $I0 goto parrot_docs 693 694 if url != "/" goto no_sl 695 url = '/index.html' 696no_sl: 697 goto normal 698 699parrot_docs: 700 if url == "/" goto SERVE_docroot 701 702 # Those little pics in the URL field or in tabs 703 # XXX only in parrot mode 704 if url != "/favicon.ico" goto no_fav 705 url = '../resources/favicon.ico' 706 goto SERVE_file 707no_fav: 708 709normal: 710 doc_root = srv.'url'() 711 concat url, doc_root, url 712 713 (is_cgi, file_content, len) = self.'check_cgi'(url) 714 if is_cgi goto SERVE_blob 715 # decode the url 716 url = urldecode(url) 717 718SERVE_file: 719 # try to open the file in url 720 fp = open url, 'r' 721 unless fp goto SERVE_404 722 len = stat url, .STAT_FILESIZE 723 read file_content, fp, len 724 close fp 725 726SERVE_blob: 727 # TODO make more subs 728 # takes: file_content, len 729 resp.'code'(200) 730 temp = to_string (len) 731 resp.'header'('Server' => 'Parrot-httpd/0.2', 'Content-Length' => temp) 732 resp.'content'(file_content) 733 self.'send_response'(resp) 734 srv.'log'(200, ", ", url) 735 goto DONE 736 737SERVE_docroot: 738 file_content = "Please go to <a href='docs/html/index.html'>Parrot Document ation</a>." 739 length len, file_content 740 temp = to_string (len) 741 resp.'code'(301) 742 resp.'header'('Location' => '/docs/html/index.html') 743 resp.'header'('Server' => 'Parrot-httpd/0.2', 'Content-Length' => temp) 744 resp.'content'(file_content) 745 self.'send_response'(resp) 746 srv.'log'(301, ", ", url, " - Redirect to 'docs/html/index.hmtl'") 747 goto DONE 748 749SERVE_404: 750 resp.'code'(404) 751 $S0 = '404 Not found' 752 $I0 = length $S0 753 temp = $I0 754 resp.'header'('Server' => 'Parrot-httpd/0.2', 'Content-Length' => temp) 755 resp.'content'($S0) 756 self.'send_response'(resp) 757 srv.'log'(404, ", ", url) 758 goto DONE 759.end 760 761=back 762 763=head2 Utility functions 764 765=over 766 767=item to_string 768 769Doomed. 770 771=item urldecode(s) 772 773Return %-unescaped string of url string. 774 775=item hex_to_int 776 777Called from above to convert a hex string to integer. 778 779=item make_query_hash 780 781Split a query string at '&' and return a hash of foo=bar items. 782The hash keys and values are urldecoded already. 783 784=cut 785 786# util functions 787.sub to_string 788 .param pmc args :slurpy 789 790 .local string ret 791 ret = sprintf "%d", args 792 .return( ret ) 793.end 794 795# convert %xx to char 796.sub urldecode 797 .param string in 798 799 .local string out, char_in, char_out 800 .local int c_out, pos_in, len 801 .local string hex 802 803 len = length in 804 pos_in = 0 805 out = "" 806START: 807 if pos_in >= len goto END 808 substr char_in, in, pos_in, 1 809 char_out = char_in 810 if char_in != "%" goto INC_IN 811 # OK this was a escape character, next two are hexadecimal 812 inc pos_in 813 substr hex, in, pos_in, 2 814 c_out = hex_to_int (hex) 815 chr char_out, c_out 816 inc pos_in 817 818INC_IN: 819 out = concat out, char_out 820 inc pos_in 821 goto START 822END: 823 .return( out ) 824.end 825 826.sub hex_to_int 827 .param pmc hex 828 .tailcall hex.'to_int'(16) 829.end 830 831# if file is *.pir or *.pbc run it as CGI 832.sub check_cgi :method 833 .param string url 834 .local int pos 835 # file.pir?foo=1&bar=2 836 pos = index url, '.pir?' 837 if pos > 0 goto cgi_1 838 pos = index url, '.pbc?' 839 if pos > 0 goto cgi_1 840 .return (0, '', 0) 841cgi_1: 842 .local string file, query 843 .local pmc query_hash 844 pos += 4 845 file = substr url, 0, pos 846 inc pos 847 query = substr url, pos 848 # TODO split into a hash, then decode parts 849 query_hash = make_query_hash(query) 850 query = urldecode(query) 851 # escape % 852 file = urldecode(file) 853 #self.'debug'("CGI: '", file, "' Q: '", query, "'\n") 854 file = "cgi-pir/" . file 855 # TODO stat the file 856 load_bytecode file 857 .local string result 858 # TODO catch ex 859 result = 'cgi_main'(self, query, query_hash) 860 $I0 = length result 861 .return (1, result, $I0) 862.end 863 864# split query at '&', make hash from foo=bar items 865.sub make_query_hash 866 .param string query # the unescapced one 867 .local pmc query_hash, items 868 .local string kv, k, v 869 query_hash = new 'Hash' 870 items = split '&', query 871 .local int i, n 872 i = 0 873 n = elements items 874lp_items: 875 kv = items[i] 876 $I0 = index kv, "=" 877 if $I0 == -1 goto no_val 878 k = substr kv, 0, $I0 879 inc $I0 880 v = substr kv, $I0 881 v = urldecode(v) 882 goto set_val 883no_val: 884 k = kv 885 v = 1 886set_val: 887 k = urldecode(k) 888 query_hash[k] = v 889 890next_item: 891 inc i 892 if i < n goto lp_items 893 .return (query_hash) 894.end 895 896=back 897 898=cut 899 900.namespace ['HTTP'; 'Message'] 901 902=head1 Class HTTP;Message 903 904Base class for Request and Response Messages. 905 906=head2 Methods 907 908=over 909 910=item __init() 911 912Create a new Message object. 913 914=item headers() 915 916Return an OrderedHash of message headers. 917 918=item content(?s?) 919 920Set or get the message contents. 921 922=item parse(s) 923 924Parse the given request string into C<header> and C<content> 925attributes of the Message object. 926 927=back 928 929=cut 930 931.sub init :vtable :method 932 $P0 = new 'OrderedHash' 933 setattribute self, 'headers', $P0 934 $P0 = new 'String' 935 setattribute self, 'content', $P0 936.end 937 938.sub 'headers' :method 939 $P0 = getattribute self, 'headers' 940 .return ($P0) 941.end 942 943.sub 'content' :method 944 .param string c :optional 945 .param int has_c :opt_flag 946 $P0 = getattribute self, 'content' 947 if has_c goto set_it 948 .return ($P0) 949set_it: 950 $P0 = c 951.end 952 953.sub 'parse' :method 954 .param string buf 955 .local int eol, len, pos, sp 956 .local string line, rest, key, value 957 .local pmc hdrs 958 959 hdrs = getattribute self, 'headers' 960 len = length buf 961 pos = 0 962loop: 963 if pos >= len goto done 964 eol = index buf, "\r", pos 965 if eol != -1 goto is_cr 966 eol = index buf, "\n", pos 967is_cr: 968 if pos == eol goto rest_is_content 969 line = substr buf, pos, eol 970 sp = index line, ' ', pos 971 key = substr line, pos, sp 972 inc sp 973 $I0 = eol - sp 974 value = substr line, sp, $I0 975 # TODO continuation lines, multiple entries 976 # TODO normalize keys 977 hdrs[key] = value 978 inc eol 979 $S0 = buf[eol] 980 if $S0 != "\n" goto no_nl 981 inc eol 982no_nl: 983 pos = eol 984 goto loop 985 986rest_is_content: 987 inc pos 988 $S0 = buf[pos] 989 if $S0 != "\n" goto set_content 990 inc pos 991set_content: 992 rest = substr buf, pos 993 994 $P0 = getattribute self, 'content' 995 $P0 = rest 996 997done: 998.end 999 1000.namespace ['HTTP'; 'Request'] 1001 1002=head1 Class HTTP;Request isa HTTP;Message 1003 1004Handles client requests. 1005 1006=head2 Methods 1007 1008=over 1009 1010=item method() 1011 1012Return the request method. Currently just 'GET' or '' is returned. 1013 1014=item __get_bool() 1015 1016Returns true, if the request has at least one header. 1017 1018=item uri() 1019 1020Return the uri of the request. 1021 1022=back 1023 1024=cut 1025 1026.sub 'method' :method 1027 .local pmc hdrs 1028 hdrs = self.'headers'() 1029 $I0 = exists hdrs['GET'] 1030 unless $I0 goto no_get 1031 .return ('GET') 1032no_get: 1033 .return ('') 1034.end 1035 1036.sub get_bool :vtable :method 1037 .local pmc hdrs 1038 hdrs = self.'headers'() 1039 $I0 = elements hdrs 1040 .return ($I0) 1041.end 1042 1043.sub 'uri' :method 1044 .local pmc hdrs, ar 1045 .local string val 1046 hdrs = self.'headers'() 1047 val = hdrs[0] 1048 ar = split ' ', val 1049 $P0 = ar[0] 1050 .return ($P0) 1051.end 1052 1053.namespace ['HTTP'; 'Response'] 1054 1055=head1 Class HTTP;Response isa HTTP;Message 1056 1057=head2 Methods 1058 1059=over 1060 1061=item code(c) 1062 1063Create initial code response line. This has to be called first to 1064create header response items. 1065 1066=cut 1067 1068.sub 'code' :method 1069 .param string ccc 1070 .const string proto = 'HTTP/1.1 ' 1071 1072 .local string line 1073 .local pmc hdrs 1074 line = proto 1075 line .= ccc 1076 if ccc != '200' goto no_200 1077 line .= ' OK' 1078 goto fin 1079no_200: 1080 if ccc != '301' goto no_301 1081 line .= ' Moved Permanently' 1082 goto fin 1083no_301: 1084 if ccc != '404' goto no_404 1085 line .= ' Not Found' 1086 goto fin 1087no_404: 1088 line .= " ??" 1089fin: 1090 line .= CRLF 1091 hdrs = getattribute self, 'headers' 1092 hdrs[0] = line 1093.end 1094 1095=item header(h => v, ...) 1096 1097Append the given keyed items to the response headers. 1098 1099XXX shall this be actually push_header? 1100 1101=cut 1102 1103.sub 'header' :method 1104 .param pmc init :slurpy :named 1105 .local pmc it, hdrs 1106 hdrs = getattribute self, 'headers' 1107 it = iter init 1108loop: 1109 unless it goto ex 1110 $S0 = shift it 1111 if $S0 != 'code' goto other 1112 self.'code'($S0) 1113 goto loop 1114other: 1115 $P0 = init[$S0] 1116 hdrs[$S0] = $P0 1117 goto loop 1118ex: 1119.end 1120 1121=item as_string() 1122 1123Return stringified version of the response object, ready for returning 1124to client. 1125 1126=cut 1127 1128.sub 'as_string' :method 1129 .local pmc hdrs, content, it 1130 .local string line, k, v 1131 hdrs = getattribute self, 'headers' 1132 content = getattribute self, 'content' 1133 it = iter hdrs 1134 # resp status 1135 k = shift it 1136 line = it[k] 1137loop: 1138 unless it goto done 1139 k = shift it 1140 v = hdrs[k] 1141 line .= k 1142 line .= ': ' 1143 line .= v 1144 line .= CRLF 1145 goto loop 1146done: 1147 line .= CRLF 1148 $S0 = content 1149 line .= $S0 1150 .return (line) 1151.end 1152 1153=back 1154 1155# Local Variables: 1156# mode: pir 1157# fill-column: 100 1158# End: 1159# vim: expandtab shiftwidth=4 ft=pir: 1160