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 .sub main :main
  99     .local pmc listener, work, fp
 100     .local pmc fp               # read requested files from disk
 101     .local int port
 102     .local pmc address
 103     .local string host
 104     .local string buf, req, rep, temp
 105     .local string meth, url, file_content
 106     .local int ret
 107     .local int len, pos, occ1, occ2, dotdot
 108
 109     .local string doc_root
 110     doc_root = "."
 111     host = "localhost"
 112     port = 1234
 113
 114     # TODO provide sys/socket constants
 115     listener = new 'Socket'
 116     listener.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP)   # PF_INET, SOCK_STREAM, tcp
 117     unless listener goto ERR_NO_SOCKET
 118
 119     # Pack a sockaddr_in structure with IP and port
 120     address = listener.'sockaddr'(host, port)
 121     ret = listener.'bind'(address)
 122     if ret == -1 goto ERR_bind
 123     $S0 = port
 124     print "Running webserver on port "
 125     print $S0
 126     print " of "
 127     print host
 128     print ".\n"
 129     print "The Parrot documentation can now be accessed at http://"
 130     print host
 131     print ":"
 132     print $S0
 133     print "\n"
 134     print "Be sure that the HTML docs have been generated with 'make html'.\n"
 135
 136     listener.'listen'(1)
 137 NEXT:
 138     work = listener.'accept'()
 139     req = ""
 140 MORE:
 141     buf = work.'recv'()
 142     # charset I0, buf
 143     # charsetname S1, I0
 144     # print "\nret: "
 145     # print ret
 146     # print "\ncharset of buf: "
 147     # print S1
 148     # print "\nbuf:"
 149     # print buf
 150     # print "\nafter buf"
 151
 152     ret = length buf
 153     if ret <= 0 goto SERVE_REQ
 154     concat req, buf
 155     index pos, req, CRLFCRLF
 156     # print "\npos1:"
 157     # print pos
 158     if pos >= 0 goto SERVE_REQ
 159     index pos, req, LFLF
 160     # print "\npos2:"
 161     # print pos
 162     if pos >= 0 goto SERVE_REQ
 163     index pos, req, CRCR
 164     # print "\npos3:"
 165     # print pos
 166     if pos >= 0 goto SERVE_REQ
 167     goto MORE
 168
 169 SERVE_REQ:
 170 #    print "Request:\n"
 171 #    print req
 172 #    print "*******\n"
 173     .local string response
 174     .local pmc headers
 175     response = '500 Internal Server Error'
 176     headers = new 'Hash'
 177     headers['Server'] = SERVER_NAME
 178
 179 # parse
 180 # GET the_file HTTP*
 181     index occ1, req, " "
 182     substr meth, req, 0, occ1
 183     inc occ1
 184     index occ2, req, " ", occ1
 185     len = occ2 - occ1
 186     substr url, req, occ1, len
 187
 188     if meth == "GET" goto SERVE_GET
 189
 190     print "unknown method:'"
 191     print meth
 192     print "'\n"
 193     close work
 194     goto NEXT
 195
 196 SERVE_GET:
 197     .local int is_cgi
 198     (is_cgi, file_content, len) = check_cgi(url)
 199     if is_cgi goto SERVE_blob
 200
 201     # decode the url
 202     url = urldecode(url)
 203
 204     # Security: Don't allow access to the parent dir
 205     index dotdot, url, ".."
 206     if dotdot >= 0 goto SERVE_404
 207
 208     # redirect instead of serving index.html
 209     if url == "/" goto SERVE_docroot
 210
 211     # Those little pics in the URL field or in tabs
 212     if url == "/favicon.ico" goto SERVE_favicon
 213
 214     # try to serve a file
 215     goto SERVE_file
 216
 217 SERVE_file:
 218     # try to open the file in url
 219     concat url, doc_root, url
 220     .local pmc eh
 221     eh = new 'ExceptionHandler'
 222     set_addr eh, handle_404_exception
 223     eh.'handle_types'(.EXCEPTION_PIO_ERROR)
 224     push_eh eh
 225     fp = open url, 'r'
 226     pop_eh
 227     unless fp goto SERVE_404
 228     len = stat url, .STAT_FILESIZE
 229     read file_content, fp, len
 230
 231 SERVE_blob:
 232     response = '200 OK'
 233     send_response(work, response, headers, file_content)
 234     # TODO provide a log method
 235     print "served file '"
 236     print url
 237     print "'\n"
 238     goto NEXT
 239
 240 SERVE_docroot:
 241     response = '301 Moved Permanently'
 242     headers['Location'] = '/docs/html/index.html'
 243     file_content = "Please go to <a href='docs/html/index.html'>Parrot Documentation</a>."
 244     send_response(work, response, headers, file_content)
 245     print "Redirect to 'docs/html/index.html'\n"
 246     goto NEXT
 247
 248 SERVE_favicon:
 249     url = urldecode( '/docs/resources/favicon.ico')
 250     goto SERVE_file
 251
 252 handle_404_exception:
 253     .local pmc ex
 254     .get_results (ex)
 255     pop_eh
 256     say "Trapped file not found exception."
 257     # fall through
 258
 259 SERVE_404:
 260     response = '404 Not found'
 261     file_content = response
 262     send_response(work, response, headers, file_content)
 263     print "File not found: '"
 264     print url
 265     print "'\n"
 266     goto NEXT
 267
 268 ERR_NO_SOCKET:
 269     print "Could not open socket.\n"
 270     print "Did you enable PARROT_NET_DEVEL in include/io_private.h?\n"
 271     end
 272 ERR_bind:
 273     print "bind failed\n"
 274     # fall through
 275 END:
 276     close listener
 277     end
 278 .end
 279
 280 # send_response(socket, response_code, headers, body)
 281 # sends HTTP response to the socket and closes the socket afterwards.
 282 .sub send_response
 283     .param pmc sock
 284     .param string code
 285     .param pmc headers
 286     .param string body
 287     .local string rep, temp, headername
 288     .local int len, ret
 289     .local pmc headers_iter
 290     rep = "HTTP/1.1 "
 291     rep .= code
 292     rep .= CRLF
 293     rep .= "Connection: close"
 294     rep .= CRLF
 295     ret = exists headers['Content-Length']
 296     if ret goto SKIP_CONTENT_LENGTH
 297     len = length body
 298     temp = to_string (len)
 299     headers['Content-Length'] = temp
 300 SKIP_CONTENT_LENGTH:
 301
 302     headers_iter = iter headers
 303 HEADER_LOOP:
 304     headername = shift headers_iter
 305     rep .= headername
 306     rep .= ': '
 307     temp = headers[headername]
 308     rep .= temp
 309     rep .= CRLF
 310     if headers_iter goto HEADER_LOOP
 311
 312     rep .= CRLF
 313     rep .= body
 314     ret = sock.'send'(rep)
 315     sock.'close'()
 316     .return()
 317 .end
 318
 319 .sub to_string
 320     .param pmc args :slurpy
 321
 322     .local string ret
 323     ret = sprintf "%d", args
 324     .return( ret )
 325 .end
 326
 327 # convert %xx to char
 328 .sub urldecode
 329     .param string in
 330
 331     .local string out, char_in, char_out
 332     .local int    c_out, pos_in, len
 333     .local string hex
 334
 335     len = length in
 336     pos_in = 0
 337     out = ""
 338 START:
 339     if pos_in >= len goto END
 340     substr char_in, in, pos_in, 1
 341     char_out = char_in
 342     if char_in != "%" goto INC_IN
 343     # OK this was a escape character, next two are hexadecimal
 344     inc pos_in
 345     substr hex, in, pos_in, 2
 346     c_out = hex_to_int (hex)
 347     chr char_out, c_out
 348     inc pos_in
 349
 350 INC_IN:
 351     concat out, char_out
 352     inc pos_in
 353     goto START
 354 END:
 355     .return( out )
 356 .end
 357
 358 .sub hex_to_int
 359     .param pmc hex
 360     .tailcall hex.'to_int'(16)
 361 .end
 362
 363 # if file is *.pir or *.pbc run it as CGI
 364 .sub check_cgi
 365     .param string url
 366     $I0 = index url, ".pir"
 367     if $I0 > 0 goto cgi_1
 368     $I0 = index url, ".pbc"
 369     if $I0 > 0 goto cgi_1
 370     .return (0, '', 0)
 371 cgi_1:
 372     # file.pir?foo=1+bar=2
 373     $I0 = index url, '?'
 374     if $I0 == -1 goto no_query
 375     .local string file, query
 376     .local pmc query_hash
 377     file = substr url, 0, $I0
 378     inc $I0
 379     query = substr url, $I0
 380     # TODO split into a hash, then decode parts
 381     query_hash = make_query_hash(query)
 382     query = urldecode(query)
 383     goto have_query
 384 no_query:
 385     file = url
 386     query = ''
 387     query_hash = new 'Hash'
 388 have_query:
 389     # escape %
 390     file = urldecode(file)
 391
 392     # Security: Don't allow access to the parent dir
 393     .local int dotdot
 394     index dotdot, file, ".."
 395     if dotdot < 0 goto cgi_file
 396     .return (0, '', 0)
 397
 398 cgi_file:
 399     print "CGI: '"
 400     print file
 401     print "' Q: '"
 402     print query
 403     print "'\n"
 404     file = "cgi-pir/" . file
 405     # TODO stat the file
 406     load_bytecode file
 407     .local string result
 408     null $P0    # not yet
 409     # TODO catch ex
 410     result = 'cgi_main'($P0, query, query_hash)
 411     $I0 = length result
 412     .return (1, result, $I0)
 413 .end
 414
 415 # split query at '+', make hash from foo=bar items
 416 .sub make_query_hash
 417     .param string query         # the unescapced one
 418     .local pmc query_hash, items
 419     .local string kv, k, v
 420     query_hash = new 'Hash'
 421     items = split '+', query
 422     .local int i, n
 423     i = 0
 424     n = elements items
 425 lp_items:
 426     kv = items[i]
 427     $I0 = index kv, "="
 428     if $I0 == -1 goto no_val
 429     k = substr kv, 0, $I0
 430     inc $I0
 431     v = substr kv, $I0
 432     v = urldecode(v)
 433     goto set_val
 434 no_val:
 435     k = kv
 436     v = 1
 437 set_val:
 438     k = urldecode(k)
 439     query_hash[k] = v
 440
 441 next_item:
 442     inc i
 443     if i < n goto lp_items
 444     .return (query_hash)
 445 .end
 446
 447 # Local Variables:
 448 #   mode: pir
 449 #   fill-column: 100
 450 # End:
 451 # vim: expandtab shiftwidth=4 ft=pir: