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