diff options
| author |  Andy Wingo | 2008-02-08 16:59:45 +0100 |
|---|---|---|
| committer | Andy Wingo | 2008-02-08 16:59:45 +0100 |
| commit | 2cae173de9153ab87b16d722127754bac9a007c4 (patch) | |
| tree | d059e1dfdf49553165da7808643f6fc52b819a24 /src | |
| parent | 44a54a345486a0ca6dedd581660050beccdd0312 (diff) | |
| download | tekuti-2cae173de9153ab87b16d722127754bac9a007c4.tar.gz tekuti-2cae173de9153ab87b16d722127754bac9a007c4.zip | |
first working server
Diffstat (limited to 'src')
| -rwxr-xr-x | src/tekuti | 57 |
1 files changed, 56 insertions, 1 deletions
@@ -29,4 +29,59 @@ exec guile $GUILE_FLAGS -s $0 "$@" ;;; Code: -(top-repl) +(use-modules (ice-9 rdelim)) +(debug-enable 'backtrace) + +(define *host* "127.0.0.1") +(define *port* 8081) +(define *backlog* 5) + +(define *socket* (socket PF_INET SOCK_STREAM 0)) +(bind *socket* AF_INET (inet-aton *host*) *port*) +(listen *socket* *backlog*) + +(define (dbg fmt . args) + (apply format (current-error-port) fmt args)) + +(define (strip-headers socket) + (define (read-line*) + (let ((line (read-line socket))) + (if (eof-object? line) + (error "unexpected eof") + line))) + (let lp ((keys '()) (values '())) + (let ((k (read-line*))) + (if (string=? k "end") + (reverse (map cons keys values)) + (lp (cons k keys) (cons (read-line*) values)))))) + +(define (output-headers headers) + (for-each + (lambda (k v) + (format #t "~a\n~a\n" k v)) + (map car headers) (map cdr headers)) + (display "end\n")) + +(define (handle-request headers post-data) + (output-headers '(("Status" . "200 OK") + ("Content-Type" . "text/html"))) + (display "<html><head><title>hello</title><body><p>hello world</p></body>")) + +(define (connection-received socket sockaddr) + (let ((headers (strip-headers socket)) + (post-data "")) ;; blocks: (read-delimited "" socket))) + (dbg "~a" headers) + (with-output-to-port socket + (lambda () + (handle-request headers post-data))) + (close-port socket))) + +(define (event-loop) + (pk 'listening) + (let ((pair (accept *socket*))) + (pk pair) + (connection-received (car pair) (cdr pair)) + (pk 'done) + (event-loop))) + +(event-loop) |