Add http-server example

9 files changed, 232 insertions, 0 deletions

diff --git a/examples/README.md b/examples/README.md
index 3d83fe44..6dbd50df 100644
--- a/examples/README.md
+++ b/examples/README.md
@@ -6,6 +6,7 @@ This folder contains some example programs and libraries.
 
 - [learnxiny.tm](learnxiny.tm): A quick overview of language features in the
 - [game](game/): An example game using raylib.
+- [http-server](http-server/): A multithreaded HTTP server.
 - [tomodeps](tomodeps/): A library for finding Tomo dependencies.
 - [tomo-install](tomo-install/): A library for installing Tomo dependencies.
 
diff --git a/examples/http-server/README.md b/examples/http-server/README.md
new file mode 100644
index 00000000..78c8d793
--- /dev/null
+++ b/examples/http-server/README.md
@@ -0,0 +1,8 @@
+# HTTP Server
+
+This is a simple multithreaded Tomo HTTP server that can be run like this:
+
+```
+tomo -e http-server.tm
+./http-server ./sample-site
+```
diff --git a/examples/http-server/connection-queue.tm b/examples/http-server/connection-queue.tm
new file mode 100644
index 00000000..a198f091
--- /dev/null
+++ b/examples/http-server/connection-queue.tm
@@ -0,0 +1,25 @@
+use pthreads
+
+func _assert_success(name:Text, val:Int32; inline):
+    fail("$name() failed!") if val < 0
+
+struct ConnectionQueue(_connections=@[:Int32], _mutex=pthread_mutex_t.new(), _cond=pthread_cond_t.new()):
+    func enqueue(queue:ConnectionQueue, connection:Int32):
+        queue._mutex:lock()
+        queue._connections:insert(connection)
+        queue._mutex:unlock()
+        queue._cond:signal()
+
+
+    func dequeue(queue:ConnectionQueue -> Int32):
+        conn := none:Int32
+
+        queue._mutex:lock()
+
+        while queue._connections.length == 0:
+            queue._cond:wait(queue._mutex)
+
+        conn = queue._connections:pop(1)
+        queue._mutex:unlock()
+        queue._cond:signal()
+        return conn!
diff --git a/examples/http-server/http-server.tm b/examples/http-server/http-server.tm
new file mode 100644
index 00000000..ad489594
--- /dev/null
+++ b/examples/http-server/http-server.tm
@@ -0,0 +1,159 @@
+#!/bin/env tomo
+
+# This file provides an HTTP server module and standalone executable
+
+use <stdio.h>
+use <stdlib.h>
+use <string.h>
+use <unistd.h>
+use <arpa/inet.h>
+use <err.h>
+
+use commands
+use pthreads
+use patterns
+
+use ./connection-queue.tm
+
+func serve(port:Int32, handler:func(request:HTTPRequest -> HTTPResponse), num_threads=16):
+    connections := ConnectionQueue()
+    workers := &[:@pthread_t] 
+    for i in num_threads:
+        workers:insert(pthread_t.new(func():
+            repeat:
+                connection := connections:dequeue()
+                request_text := inline C : Text {
+                    Text_t request = EMPTY_TEXT;
+                    char buf[1024] = {};
+                    for (ssize_t n; (n = read(_$connection, buf, sizeof(buf) - 1)) > 0; ) {
+                        buf[n] = 0;
+                        request = Text$concat(request, Text$from_strn(buf, n));
+                        if (request.length > 1000000 || strstr(buf, "\r\n\r\n"))
+                            break;
+                    }
+                    request
+                }
+
+                request := HTTPRequest.from_text(request_text) or skip
+                response := handler(request):bytes()
+                inline C {
+                    if (_$response.stride != 1)
+                        Array$compact(&_$response, 1);
+                    write(_$connection, _$response.data, _$response.length);
+                    close(_$connection);
+                }
+        ))
+
+
+    sock := inline C : Int32 {
+        int s = socket(AF_INET, SOCK_STREAM, 0);
+        if (s < 0) err(1, "Couldn't connect to socket!");
+
+        int opt = 1;
+        if (setsockopt(s, SOL_SOCKET, SO_REUSEADDR, &opt, sizeof(opt)) < 0)
+            err(1, "Couldn't set socket option");
+            
+        struct sockaddr_in addr = {AF_INET, htons(_$port), INADDR_ANY};
+        if (bind(s, (struct sockaddr*)&addr, sizeof(addr)) < 0)
+            err(1, "Couldn't bind to socket");
+        if (listen(s, 8) < 0)
+            err(1, "Couldn't listen on socket");
+
+        s
+    }
+
+    repeat:
+        conn := inline C : Int32 { accept(_$sock, NULL, NULL) }
+        stop if conn < 0 
+        connections:enqueue(conn)
+
+    say("Shutting down...")
+    for w in workers:
+        w:cancel()
+
+struct HTTPRequest(method:Text, path:Text, version:Text, headers:[Text], body:Text):
+    func from_text(text:Text -> HTTPRequest?):
+        m := text:pattern_captures($Pat'{word} {..} HTTP/{..}{crlf}{..}') or return none
+        method := m[1]
+        path := m[2]:replace_pattern($Pat'{2+ /}', '/')
+        version := m[3]
+        rest := m[-1]:pattern_captures($Pat/{..}{2 crlf}{0+ ..}/) or return none
+        headers := rest[1]:split_pattern($Pat/{crlf}/)
+        body := rest[-1]
+        return HTTPRequest(method, path, version, headers, body)
+
+struct HTTPResponse(body:Text, status=200, content_type="text/plain", headers={:Text,Text}):
+    func bytes(r:HTTPResponse -> [Byte]):
+        body_bytes := r.body:bytes()
+        extra_headers := (++: "$k: $v$(\r\n)" for k,v in r.headers) or ""
+        return "
+            HTTP/1.1 $(r.status) OK$\r
+            Content-Length: $(body_bytes.length + 2)$\r
+            Content-Type: $(r.content_type)$\r
+            Connection: close$\r
+            $extra_headers
+            $\r$\n
+        ":bytes() ++ body_bytes
+
+func _content_type(file:Path -> Text):
+    when file:extension() is "html": return "text/html"
+    is "tm": return "text/html"
+    is "js": return "text/javascript"
+    is "css": return "text/css"
+    else: return "text/plain"
+
+enum RouteEntry(ServeFile(file:Path), Redirect(destination:Text)):
+    func respond(entry:RouteEntry, request:HTTPRequest -> HTTPResponse):
+        when entry is ServeFile(file):
+            body := if file:can_execute():
+                output := Command(Text(file)):get_output()!
+                "
+                    <!DOCTYPE HTML>
+                    <html>
+                    <head><title>$file</title></head>
+                    <body>
+                    <h1>$file program output</h1>
+                    <pre>$output</pre>
+                    </body>
+                    </html>
+                "
+            else:
+                file:read()!
+            return HTTPResponse(body, content_type=_content_type(file))
+        is Redirect(destination):
+            return HTTPResponse("Found", 302, headers={"Location"=destination})
+
+func load_routes(directory:Path -> {Text,RouteEntry}):
+    routes := &{:Text,RouteEntry}
+    for file in (directory ++ (./*)):glob():
+        skip unless file:is_file()
+        contents := file:read() or skip
+        server_path := "/" ++ "/":join(file:relative_to(directory).components)
+        if file:base_name() == "index.html":
+            canonical := server_path:without_suffix("index.html")
+            routes[server_path] = Redirect(canonical)
+            routes[canonical] = ServeFile(file)
+        else if file:extension() == "html":
+            canonical := server_path:without_suffix(".html")
+            routes[server_path] = Redirect(canonical)
+            routes[canonical] = ServeFile(file)
+        else if file:extension() == "tm":
+            canonical := server_path:without_suffix(".tm")
+            routes[server_path] = Redirect(canonical)
+            routes[canonical] = ServeFile(file)
+        else:
+            routes[server_path] = ServeFile(file)
+    return routes[]
+
+func main(directory:Path, port=Int32(8080)):
+    say("Serving on port $port")
+    routes := load_routes(directory)
+    !! Hosting: $routes
+
+    serve(port, func(request:HTTPRequest):
+        if handler := routes[request.path]:
+            return handler:respond(request)
+        else:
+            return HTTPResponse("Not found!", 404)
+    )
+
diff --git a/examples/http-server/sample-site/foo.html b/examples/http-server/sample-site/foo.html
new file mode 100644
index 00000000..162a7146
--- /dev/null
+++ b/examples/http-server/sample-site/foo.html
@@ -0,0 +1,6 @@
+<!DOCTYPE HTML>
+<html>
+  <body>
+    This is the <b>foo</b> page.
+  </body>
+</html>
diff --git a/examples/http-server/sample-site/hello.txt b/examples/http-server/sample-site/hello.txt
new file mode 100644
index 00000000..e965047a
--- /dev/null
+++ b/examples/http-server/sample-site/hello.txt
@@ -0,0 +1 @@
+Hello
diff --git a/examples/http-server/sample-site/index.html b/examples/http-server/sample-site/index.html
new file mode 100644
index 00000000..8e1573bb
--- /dev/null
+++ b/examples/http-server/sample-site/index.html
@@ -0,0 +1,16 @@
+<!DOCTYPE HTML>
+<html>
+  <head>
+    <title>HTTP Example</title>
+    <link rel="stylesheet" href="styles.css">
+  </head>
+  <body>
+    <p>
+    Hello <b>world!</b>
+    </p>
+
+    <p>
+    Try going to <a href="/random">/random</a> or <a href="/foo">/foo</a> or <a href="/hello.txt">/hello.txt</a>
+    </p>
+  </body>
+</html>
diff --git a/examples/http-server/sample-site/random.tm b/examples/http-server/sample-site/random.tm
new file mode 100755
index 00000000..7d183ee9
--- /dev/null
+++ b/examples/http-server/sample-site/random.tm
@@ -0,0 +1,5 @@
+#!/bin/env tomo
+use random
+
+func main():
+    say("Random: $(random:int(1,100))")
diff --git a/examples/http-server/sample-site/styles.css b/examples/http-server/sample-site/styles.css
new file mode 100644
index 00000000..f15d25de
--- /dev/null
+++ b/examples/http-server/sample-site/styles.css
@@ -0,0 +1,11 @@
+body{
+  margin:40px auto;
+  max-width:650px;
+  line-height:1.6;
+  font-size:18px;
+  color:#444;
+  padding:0 10px;
+}
+h1,h2,h3{
+  line-height:1.2
+}