examples/io/httpd.pir

   1 # Copyright (C) 2006-2008, Parrot Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 examples/io/httpd.pir - HTTP server
   7
   8 =head1 SYNOPSIS
   9
  10   $ ./parrot examples/io/httpd.pir
  11
  12 =head1 DESCRIPTION
  13
  14 A very tiny HTTP-Server. It currently only understands the GET method.
  15 It's a nice way of testing pretty much all IO functions.
  16 By default (and not yet configurable) it binds to localhost:1234.
  17
  18 =head2 Serving Parrot Docs
  19
  20 If no filename is given it serves the HTML documentation
  21 in ./docs/html. Make sure you have built them with
  22
  23   $ make html
  24
  25 After that you can browse the documentation with
  26
  27   http://localhost:1234
  28
  29 which redirects to
  30
  31   http://localhost:1234/docs/html/index.html
  32
  33 =head2 Serving Other HTML Files
  34
  35 If a html file is present in the request, this file will be served:
  36
  37   http://localhost:1234/index.html
  38
  39 This will sent F<./index.html> from the directory, where F<httpd.pir>
  40 was started.
  41
  42 =head2 CGI
  43
  44 If the file extension is C<.pir> or C<.pbc>, this file will be loaded
  45 below the directory F<cgi-pir> and the function C<cgi_main> will be
  46 invoked with the query as an argument.
  47 This functions should return a plain string, which will be sent to the
  48 browser.
  49
  50 F<cgi_main> is called with 3 arguments: a todo/reserved PMC, a string
  51 with the original query and a Hash, with C<key=value> items split by
  52 C<'+'>. C<key> and C<value> are already C<urldecoded>.
  53
  54   $ cat cgi-pir/foo.pir
  55   .sub cgi_main
  56     .param pmc reserved         # TODO
  57     .param string query         # all after '?':  "foo=1+bar=A"
  58     .param pmc query_hash       # Hash { foo=>'1', bar=>'A' }
  59     .return ("<p>foo</p>")      # in practice use a full <html>doc</html>
  60                                 # unless serving XMLHttpRequest's
  61   .end
  62
  63 The browser request:
  64
  65   http://localhost:1234/foo.pir?foo=1+bar=%61
  66
  67 will serve, whatever the C<cgi_main> function returned.
  68
  69 =head1 TODO
  70
  71 make it work on W32/IE
  72
  73 Transcode the received string to ascii, in order to have access to an
  74 implemented 'index' op. Or just use unicode instead.
  75
  76 =head1 SEE ALSO
  77
  78 RFC2616
  79
  80 =head1 AUTHOR
  81
  82 Original author is Markus Amsler - <markus.amsler@oribi.org>
  83 The code was heavily hacked by bernhard and leo.
  84
  85 =cut
  86
  87 .const string CRLF     = "\r\n"
  88 .const string CRLFCRLF = "\r\n\r\n"
  89 .const string LFLF     = "\n\n"
  90 .const string CRCR     = "\r\r"
  91
  92 .const string SERVER_NAME = "Parrot-httpd/0.1"
  93
  94 .include "stat.pasm"
  95 .include 'except_types.pasm'
  96 .include 'socket.pasm'
  97
  98 .loadlib 'io_ops'
  99 .loadlib 'sys_ops'
 100
 101 .sub main :main
 102     .local pmc listener, work, fp
 103     .local pmc fp               # read requested files from disk
 104     .local int port
 105     .local pmc address
 106     .local string host
 107     .local string buf, req, rep, temp
 108     .local string meth, url, file_content
 109     .local int ret
 110     .local int len, pos, occ1, occ2, dotdot
 111
 112     .local string doc_root
 113     doc_root = "."
 114     host = "localhost"
 115     port = 1234
 116
 117     # TODO provide sys/socket constants
 118     listener = new 'Socket'
 119     listener.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP)   # PF_INET, SOCK_STREAM, tcp
 120     unless listener goto ERR_NO_SOCKET
 121
 122     # Pack a sockaddr_in structure with IP and port
 123     address = listener.'sockaddr'(host, port)
 124     ret = listener.'bind'(address)
 125     if ret == -1 goto ERR_bind
 126     $S0 = port
 127     print "Running webserver on port "
 128     print $S0
 129     print " of "
 130     print host
 131     print ".\n"
 132     print "The Parrot documentation can now be accessed at http://"
 133     print host
 134     print ":"
 135     print $S0
 136     print "\n"
 137     print "Be sure that the HTML docs have been generated with 'make html'.\n"
 138
 139     listener.'listen'(1)
 140 NEXT:
 141     work = listener.'accept'()
 142     req = ""
 143 MORE:
 144     buf = work.'recv'()
 145     # encoding I0, buf
 146     # encodingname S1, I0
 147     # print "\nret: "
 148     # print ret
 149     # print "\nencoding of buf: "
 150     # print S1
 151     # print "\nbuf:"
 152     # print buf
 153     # print "\nafter buf"
 154
 155     ret = length buf
 156     if ret <= 0 goto SERVE_REQ
 157     concat req, buf
 158     index pos, req, CRLFCRLF
 159     # print "\npos1:"
 160     # print pos
 161     if pos >= 0 goto SERVE_REQ
 162     index pos, req, LFLF
 163     # print "\npos2:"
 164     # print pos
 165     if pos >= 0 goto SERVE_REQ
 166     index pos, req, CRCR
 167     # print "\npos3:"
 168     # print pos
 169     if pos >= 0 goto SERVE_REQ
 170     goto MORE
 171
 172 SERVE_REQ:
 173 #    print "Request:\n"
 174 #    print req
 175 #    print "*******\n"
 176     .local string response
 177     .local pmc headers
 178     response = '500 Internal Server Error'
 179     headers = new 'Hash'
 180     headers['Server'] = SERVER_NAME
 181
 182 # parse
 183 # GET the_file HTTP*
 184     index occ1, req, " "
 185     substr meth, req, 0, occ1
 186     inc occ1
 187     index occ2, req, " ", occ1
 188     len = occ2 - occ1
 189     substr url, req, occ1, len
 190
 191     if meth == "GET" goto SERVE_GET
 192
 193     print "unknown method:'"
 194     print meth
 195     print "'\n"
 196     close work
 197     goto NEXT
 198
 199 SERVE_GET:
 200     .local int is_cgi
 201     (is_cgi, file_content, len) = check_cgi(url)
 202     if is_cgi goto SERVE_blob
 203
 204     # decode the url
 205     url = urldecode(url)
 206
 207     # Security: Don't allow access to the parent dir
 208     index dotdot, url, ".."
 209     if dotdot >= 0 goto SERVE_404
 210
 211     # redirect instead of serving index.html
 212     if url == "/" goto SERVE_docroot
 213
 214     # Those little pics in the URL field or in tabs
 215     if url == "/favicon.ico" goto SERVE_favicon
 216
 217     # try to serve a file
 218     goto SERVE_file
 219
 220 SERVE_file:
 221     # try to open the file in url
 222     concat url, doc_root, url
 223     .local pmc eh
 224     eh = new 'ExceptionHandler'
 225     set_addr eh, handle_404_exception
 226     eh.'handle_types'(.EXCEPTION_PIO_ERROR)
 227     push_eh eh
 228     fp = open url, 'r'
 229     pop_eh
 230     unless fp goto SERVE_404
 231     len = stat url, .STAT_FILESIZE
 232     read file_content, fp, len
 233
 234 SERVE_blob:
 235     response = '200 OK'
 236     send_response(work, response, headers, file_content)
 237     # TODO provide a log method
 238     print "served file '"
 239     print url
 240     print "'\n"
 241     goto NEXT
 242
 243 SERVE_docroot:
 244     response = '301 Moved Permanently'
 245     headers['Location'] = '/docs/html/index.html'
 246     file_content = "Please go to <a href='docs/html/index.html'>Parrot Documentation</a>."
 247     send_response(work, response, headers, file_content)
 248     print "Redirect to 'docs/html/index.html'\n"
 249     goto NEXT
 250
 251 SERVE_favicon:
 252     url = urldecode( '/docs/resources/favicon.ico')
 253     goto SERVE_file
 254
 255 handle_404_exception:
 256     .local pmc ex
 257     .get_results (ex)
 258     pop_eh
 259     say "Trapped file not found exception."
 260     # fall through
 261
 262 SERVE_404:
 263     response = '404 Not found'
 264     file_content = response
 265     send_response(work, response, headers, file_content)
 266     print "File not found: '"
 267     print url
 268     print "'\n"
 269     goto NEXT
 270
 271 ERR_NO_SOCKET:
 272     print "Could not open socket.\n"
 273     end
 274 ERR_bind:
 275     print "bind failed\n"
 276     # fall through
 277 END:
 278     close listener
 279     end
 280 .end
 281
 282 # send_response(socket, response_code, headers, body)
 283 # sends HTTP response to the socket and closes the socket afterwards.
 284 .sub send_response
 285     .param pmc sock
 286     .param string code
 287     .param pmc headers
 288     .param string body
 289     .local string rep, temp, headername
 290     .local int len, ret
 291     .local pmc headers_iter
 292     rep = "HTTP/1.1 "
 293     rep .= code
 294     rep .= CRLF
 295     rep .= "Connection: close"
 296     rep .= CRLF
 297     ret = exists headers['Content-Length']
 298     if ret goto SKIP_CONTENT_LENGTH
 299     len = length body
 300     temp = to_string (len)
 301     headers['Content-Length'] = temp
 302 SKIP_CONTENT_LENGTH:
 303
 304     headers_iter = iter headers
 305 HEADER_LOOP:
 306     headername = shift headers_iter
 307     rep .= headername
 308     rep .= ': '
 309     temp = headers[headername]
 310     rep .= temp
 311     rep .= CRLF
 312     if headers_iter goto HEADER_LOOP
 313
 314     rep .= CRLF
 315     rep .= body
 316     ret = sock.'send'(rep)
 317     sock.'close'()
 318     .return()
 319 .end
 320
 321 .sub to_string
 322     .param pmc args :slurpy
 323
 324     .local string ret
 325     ret = sprintf "%d", args
 326     .return( ret )
 327 .end
 328
 329 # convert %xx to char
 330 .sub urldecode
 331     .param string in
 332
 333     .local string out, char_in, char_out
 334     .local int    c_out, pos_in, len
 335     .local string hex
 336
 337     len = length in
 338     pos_in = 0
 339     out = ""
 340 START:
 341     if pos_in >= len goto END
 342     substr char_in, in, pos_in, 1
 343     char_out = char_in
 344     if char_in != "%" goto INC_IN
 345     # OK this was a escape character, next two are hexadecimal
 346     inc pos_in
 347     substr hex, in, pos_in, 2
 348     c_out = hex_to_int (hex)
 349     chr char_out, c_out
 350     inc pos_in
 351
 352 INC_IN:
 353     concat out, char_out
 354     inc pos_in
 355     goto START
 356 END:
 357     .return( out )
 358 .end
 359
 360 .sub hex_to_int
 361     .param pmc hex
 362     .tailcall hex.'to_int'(16)
 363 .end
 364
 365 # if file is *.pir or *.pbc run it as CGI
 366 .sub check_cgi
 367     .param string url
 368     $I0 = index url, ".pir"
 369     if $I0 > 0 goto cgi_1
 370     $I0 = index url, ".pbc"
 371     if $I0 > 0 goto cgi_1
 372     .return (0, '', 0)
 373 cgi_1:
 374     # file.pir?foo=1+bar=2
 375     $I0 = index url, '?'
 376     if $I0 == -1 goto no_query
 377     .local string file, query
 378     .local pmc query_hash
 379     file = substr url, 0, $I0
 380     inc $I0
 381     query = substr url, $I0
 382     # TODO split into a hash, then decode parts
 383     query_hash = make_query_hash(query)
 384     query = urldecode(query)
 385     goto have_query
 386 no_query:
 387     file = url
 388     query = ''
 389     query_hash = new 'Hash'
 390 have_query:
 391     # escape %
 392     file = urldecode(file)
 393
 394     # Security: Don't allow access to the parent dir
 395     .local int dotdot
 396     index dotdot, file, ".."
 397     if dotdot < 0 goto cgi_file
 398     .return (0, '', 0)
 399
 400 cgi_file:
 401     print "CGI: '"
 402     print file
 403     print "' Q: '"
 404     print query
 405     print "'\n"
 406     file = "cgi-pir/" . file
 407     # TODO stat the file
 408     load_bytecode file
 409     .local string result
 410     null $P0    # not yet
 411     # TODO catch ex
 412     result = 'cgi_main'($P0, query, query_hash)
 413     $I0 = length result
 414     .return (1, result, $I0)
 415 .end
 416
 417 # split query at '+', make hash from foo=bar items
 418 .sub make_query_hash
 419     .param string query         # the unescapced one
 420     .local pmc query_hash, items
 421     .local string kv, k, v
 422     query_hash = new 'Hash'
 423     items = split '+', query
 424     .local int i, n
 425     i = 0
 426     n = elements items
 427 lp_items:
 428     kv = items[i]
 429     $I0 = index kv, "="
 430     if $I0 == -1 goto no_val
 431     k = substr kv, 0, $I0
 432     inc $I0
 433     v = substr kv, $I0
 434     v = urldecode(v)
 435     goto set_val
 436 no_val:
 437     k = kv
 438     v = 1
 439 set_val:
 440     k = urldecode(k)
 441     query_hash[k] = v
 442
 443 next_item:
 444     inc i
 445     if i < n goto lp_items
 446     .return (query_hash)
 447 .end
 448
 449 # Local Variables:
 450 #   mode: pir
 451 #   fill-column: 100
 452 # End:
 453 # vim: expandtab shiftwidth=4 ft=pir: