# Copyright (C) 2006-2008, Parrot Foundation. # $Id: httpd.pir 37827 2009-03-31 16:34:25Z Infinoid $ =head1 NAME examples/io/httpd.pir - HTTP server =head1 SYNOPSIS $ ./parrot examples/io/httpd.pir =head1 DESCRIPTION A very tiny HTTP-Server. It currently only understands the GET method. It's a nice way of testing pretty much all IO functions. By default (and not yet configurable) it binds to localhost:1234. =head2 Serving Parrot Docs If no filename is given it serves the HTML documentation in ./docs/html. Make sure you have built them with $ make html After that you can browse the documentation with http://localhost:1234 which redirects to http://localhost:1234/docs/html/index.html =head2 Serving Other HTML Files If a html file is present in the request, this file will be served: http://localhost:1234/index.html This will sent F<./index.html> from the directory, where F<httpd.pir> was started. =head2 CGI If the file extension is C<.pir> or C<.pbc>, this file will be loaded below the directory F<cgi-pir> and the function C<cgi_main> will be invoked with the query as an argument. This functions should return a plain string, which will be sent to the browser. F<cgi_main> is called with 3 arguments: a todo/reserved PMC, a string with the original query and a Hash, with C<key=value> items split by C<'+'>. C<key> and C<value> are already C<urldecoded>. $ cat cgi-pir/foo.pir .sub cgi_main .param pmc reserved # TODO .param string query # all after '?': "foo=1+bar=A" .param pmc query_hash # Hash { foo=>'1', bar=>'A' } .return ("<p>foo</p>") # in practice use a full <html>doc</html> # unless serving XMLHttpRequest's .end The browser request: http://localhost:1234/foo.pir?foo=1+bar=%61 will serve, whatever the C<cgi_main> function returned. =head1 TODO make it work on W32/IE Transcode the received string to ascii, in order to have access to an implemented 'index' op. Or just use unicode instead. =head1 SEE ALSO RFC2616 =head1 AUTHOR Original author is Markus Amsler - <markus.amsler@oribi.org> The code was heavily hacked by bernhard and leo. =cut .const string CRLF = "\r\n" .const string CRLFCRLF = "\r\n\r\n" .const string LFLF = "\n\n" .const string CRCR = "\r\r" .const string SERVER_NAME = "Parrot-httpd/0.1" .include "stat.pasm" .include 'except_types.pasm' .include 'socket.pasm' .sub main :main .local pmc listener, work, fp .local pmc fp # read requested files from disk .local int port .local pmc address .local string host .local string buf, req, rep, temp .local string meth, url, file_content .local int ret .local int len, pos, occ1, occ2, dotdot .local string doc_root doc_root = "." host = "localhost" port = 1234 # TODO provide sys/socket constants listener = new 'Socket' listener.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP) # PF_INET, SOCK_STREAM, tcp unless listener goto ERR_NO_SOCKET # Pack a sockaddr_in structure with IP and port address = listener.'sockaddr'(host, port) ret = listener.'bind'(address) if ret == -1 goto ERR_bind $S0 = port print "Running webserver on port " print $S0 print " of " print host print ".\n" print "The Parrot documentation can now be accessed at http://" print host print ":" print $S0 print "\n" print "Be sure that the HTML docs have been generated with 'make html'.\n" listener.'listen'(1) NEXT: work = listener.'accept'() req = "" MORE: buf = work.'recv'() # charset I0, buf # charsetname S1, I0 # print "\nret: " # print ret # print "\ncharset of buf: " # print S1 # print "\nbuf:" # print buf # print "\nafter buf" ret = length buf if ret <= 0 goto SERVE_REQ concat req, buf index pos, req, CRLFCRLF # print "\npos1:" # print pos if pos >= 0 goto SERVE_REQ index pos, req, LFLF # print "\npos2:" # print pos if pos >= 0 goto SERVE_REQ index pos, req, CRCR # print "\npos3:" # print pos if pos >= 0 goto SERVE_REQ goto MORE SERVE_REQ: # print "Request:\n" # print req # print "*******\n" .local string response .local pmc headers response = '500 Internal Server Error' headers = new 'Hash' headers['Server'] = SERVER_NAME # parse # GET the_file HTTP* index occ1, req, " " substr meth, req, 0, occ1 inc occ1 index occ2, req, " ", occ1 len = occ2 - occ1 substr url, req, occ1, len if meth == "GET" goto SERVE_GET print "unknown method:'" print meth print "'\n" close work goto NEXT SERVE_GET: .local int is_cgi (is_cgi, file_content, len) = check_cgi(url) if is_cgi goto SERVE_blob # decode the url url = urldecode(url) # Security: Don't allow access to the parent dir index dotdot, url, ".." if dotdot >= 0 goto SERVE_404 # redirect instead of serving index.html if url == "/" goto SERVE_docroot # Those little pics in the URL field or in tabs if url == "/favicon.ico" goto SERVE_favicon # try to serve a file goto SERVE_file SERVE_file: # try to open the file in url concat url, doc_root, url .local pmc eh eh = new 'ExceptionHandler' set_addr eh, handle_404_exception eh.'handle_types'(.EXCEPTION_PIO_ERROR) push_eh eh fp = open url, 'r' pop_eh unless fp goto SERVE_404 len = stat url, .STAT_FILESIZE read file_content, fp, len SERVE_blob: response = '200 OK' send_response(work, response, headers, file_content) # TODO provide a log method print "served file '" print url print "'\n" goto NEXT SERVE_docroot: response = '301 Moved Permanently' headers['Location'] = '/docs/html/index.html' file_content = "Please go to <a href='docs/html/index.html'>Parrot Documentation</a>." send_response(work, response, headers, file_content) print "Redirect to 'docs/html/index.html'\n" goto NEXT SERVE_favicon: url = urldecode( '/docs/resources/favicon.ico') goto SERVE_file handle_404_exception: .local pmc ex .get_results (ex) pop_eh say "Trapped file not found exception." # fall through SERVE_404: response = '404 Not found' file_content = response send_response(work, response, headers, file_content) print "File not found: '" print url print "'\n" goto NEXT ERR_NO_SOCKET: print "Could not open socket.\n" print "Did you enable PARROT_NET_DEVEL in include/io_private.h?\n" end ERR_bind: print "bind failed\n" # fall through END: close listener end .end # send_response(socket, response_code, headers, body) # sends HTTP response to the socket and closes the socket afterwards. .sub send_response .param pmc sock .param string code .param pmc headers .param string body .local string rep, temp, headername .local int len, ret .local pmc headers_iter rep = "HTTP/1.1 " rep .= code rep .= CRLF rep .= "Connection: close" rep .= CRLF ret = exists headers['Content-Length'] if ret goto SKIP_CONTENT_LENGTH len = length body temp = to_string (len) headers['Content-Length'] = temp SKIP_CONTENT_LENGTH: headers_iter = iter headers HEADER_LOOP: headername = shift headers_iter rep .= headername rep .= ': ' temp = headers[headername] rep .= temp rep .= CRLF if headers_iter goto HEADER_LOOP rep .= CRLF rep .= body ret = sock.'send'(rep) sock.'close'() .return() .end .sub to_string .param pmc args :slurpy .local string ret ret = sprintf "%d", args .return( ret ) .end # convert %xx to char .sub urldecode .param string in .local string out, char_in, char_out .local int c_out, pos_in, len .local string hex len = length in pos_in = 0 out = "" START: if pos_in >= len goto END substr char_in, in, pos_in, 1 char_out = char_in if char_in != "%" goto INC_IN # OK this was a escape character, next two are hexadecimal inc pos_in substr hex, in, pos_in, 2 c_out = hex_to_int (hex) chr char_out, c_out inc pos_in INC_IN: concat out, char_out inc pos_in goto START END: .return( out ) .end .sub hex_to_int .param pmc hex .tailcall hex.'to_int'(16) .end # if file is *.pir or *.pbc run it as CGI .sub check_cgi .param string url $I0 = index url, ".pir" if $I0 > 0 goto cgi_1 $I0 = index url, ".pbc" if $I0 > 0 goto cgi_1 .return (0, '', 0) cgi_1: # file.pir?foo=1+bar=2 $I0 = index url, '?' if $I0 == -1 goto no_query .local string file, query .local pmc query_hash file = substr url, 0, $I0 inc $I0 query = substr url, $I0 # TODO split into a hash, then decode parts query_hash = make_query_hash(query) query = urldecode(query) goto have_query no_query: file = url query = '' query_hash = new 'Hash' have_query: # escape % file = urldecode(file) # Security: Don't allow access to the parent dir .local int dotdot index dotdot, file, ".." if dotdot < 0 goto cgi_file .return (0, '', 0) cgi_file: print "CGI: '" print file print "' Q: '" print query print "'\n" file = "cgi-pir/" . file # TODO stat the file load_bytecode file .local string result null $P0 # not yet # TODO catch ex result = 'cgi_main'($P0, query, query_hash) $I0 = length result .return (1, result, $I0) .end # split query at '+', make hash from foo=bar items .sub make_query_hash .param string query # the unescapced one .local pmc query_hash, items .local string kv, k, v query_hash = new 'Hash' items = split '+', query .local int i, n i = 0 n = elements items lp_items: kv = items[i] $I0 = index kv, "=" if $I0 == -1 goto no_val k = substr kv, 0, $I0 inc $I0 v = substr kv, $I0 v = urldecode(v) goto set_val no_val: k = kv v = 1 set_val: k = urldecode(k) query_hash[k] = v next_item: inc i if i < n goto lp_items .return (query_hash) .end # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir: