├── README └── http.fs /README: -------------------------------------------------------------------------------- 1 | http.fs - A simple sample webserver for gforth 2 | ---------------------------------------------- 3 | 4 | This is a simple webserver for gforth. It requires the unix/socket.fs code to 5 | work. Currently the server is extended by defining additional routes to handle 6 | various paths. It also uses parsing words to evaluate the HTTP headers, and 7 | will gladly die if it encounters anything unexpected. 8 | 9 | The home page is served via: 10 | 11 | : /. ( -- s-addr u ) ... ; 12 | 13 | Which returns the body of the home page. There is also a sample of returning json in /foo. 14 | 15 | Obviously this is a work in progress, but is inteded to eventually work in a non-gforth 16 | based embedded system. 17 | 18 | To run: 19 | 20 | gforth http.fs 21 | 22 | Currently it is configured to listen on 8080. YMMV. 23 | 24 | Dave Goehrig 25 | 26 | 27 | --- 28 | 29 | Copyright (c) 2013, David J. Goehrig 30 | All rights reserved. 31 | 32 | Redistribution and use in source and binary forms, with or without 33 | modification, are permitted provided that the following conditions are met: 34 | 35 | Redistributions of source code must retain the above copyright notice, 36 | this list of conditions and the following disclaimer. 37 | 38 | Redistributions in binary form must reproduce the above copyright notice, 39 | this list of conditions and the following disclaimer in the documentation 40 | and/or other materials provided with the distribution. 41 | 42 | Neither the name of the project nor the names of its contributors may be 43 | used to endorse or promote products derived from this software without 44 | specific prior written permission. 45 | 46 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 47 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 48 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 49 | IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, 50 | INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 51 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 52 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 53 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 54 | OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED 55 | OF THE POSSIBILITY OF SUCH DAMAGE. 56 | 57 | 58 | 59 | 60 | -------------------------------------------------------------------------------- /http.fs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env gforth 2 | \ sample http server 3 | \ © 2013 David J. Goehrig 4 | 5 | require unix/socket.fs 6 | 7 | \ configuration settings 8 | 4096 constant size \ 1 page buffer sizes 9 | 255 constant backlog \ number of sockets to backlog 10 | 8080 constant http-port \ port we're listening on 11 | 12 | \ useful buffers 13 | create request size allot \ create a big buffer for http requests 14 | 0 value request:length 15 | create response size allot \ create a big response buffer for http responses 16 | 0 value response:length 17 | 18 | \ Configure the port we're listening on. 19 | http-port create-server value server 20 | 21 | \ The socket the client will use 22 | 0 value client 23 | 24 | \ HTTP parameters 25 | 0 value path:length 26 | 0 value path 27 | 28 | 0 value version:length 29 | 0 value version 30 | 31 | 0 value user-agent:length 32 | 0 value user-agent 33 | 34 | 0 value host:length 35 | 0 value host 36 | 37 | 0 value accept:length 38 | 0 value accept \ overrides a built in but we don't need it :) 39 | 40 | 0 value accept-language:length 41 | 0 value accept-language 42 | 43 | 0 value accept-encoding:length 44 | 0 value accept-encoding 45 | 46 | 0 value connection:length 47 | 0 value connection 48 | 49 | 0 value cache-control:length 50 | 0 value cache-control 51 | 52 | 0 value referer:length 53 | 0 value referer 54 | 55 | \ parse to end of line 56 | : >eol ( "input to newline" -- s-addr u ) 10 parse ; 57 | 58 | \ Parsing methods TODO: implement POST HEAD OPTIONS PUT DELETE etc. 59 | : GET 60 | parse-name to path:length to path 61 | parse-name to version:length to version ; 62 | 63 | : User-Agent: 64 | >eol to user-agent:length to user-agent ; 65 | 66 | : Host: 67 | parse-name to host:length to host ; 68 | 69 | : Accept: 70 | >eol to accept:length to accept ; 71 | 72 | : Accept-Language: 73 | >eol to accept-language:length to accept-language ; 74 | 75 | : Accept-Encoding: 76 | >eol to accept-encoding:length to accept-encoding ; 77 | 78 | : Connection: 79 | parse-name to connection:length to connection ; 80 | 81 | : Cache-Control: 82 | >eol to cache-control:length to cache-control ; 83 | 84 | : Referer: 85 | >eol to referer:length to referer ; 86 | 87 | \ Routing code 88 | : /. \ this is the default path 89 | s\" HTTP/1.1 200 OK\r\nContent-Length: 13\r\n\r\nHello World!\n" ; 90 | 91 | : /foo \ this is a sample route 92 | s\" HTTP/1.1 200 OK\r\nContent-Length: 13\r\n\r\n{\"foo\":\"bar\"}" ; 93 | 94 | : http/404 \ this is an error page 95 | s\" HTTP/1.1 404 Not Found\r\nContent-Length: 10\r\n\r\nNot Found\n" ; 96 | 97 | \ path must be smaller than 256, because it is a counted string 0-255 chars 98 | create route 256 allot 99 | 100 | \ converts the path to a route, right now we only translate / to /. 101 | : path>route 102 | s" /" path path:length compare 0= if 103 | 2 route c! 104 | [char] / route 1+ c! 105 | [char] . route 2 + c! 106 | else 107 | path:length route c! 108 | path route 1+ path:length cmove 109 | then ; 110 | 111 | \ tests if a route exists 112 | : route? ( -- true|false) 113 | route find nip ; 114 | 115 | \ dispatch the route's method 116 | : dispatch route count evaluate ; 117 | 118 | : read-request ( fd -- s-addr u ) 119 | request size read-socket dup to request:length ; 120 | 121 | : parse-request ( s-addr u -- ) 122 | evaluate ; \ note well request contains a forth string 123 | 124 | : send-response ( s-addr u -- ) 125 | client write-socket 126 | client close-socket ; 127 | 128 | \ web server 129 | : serve begin 130 | server backlog listen 131 | server accept-socket to client 132 | client read-request parse-request 133 | path>route route? if dispatch else http/404 then 134 | send-response 135 | again ; 136 | 137 | serve 138 | --------------------------------------------------------------------------------