forked from james/jtm.dev
THis is just whatever I was working on a few months ago.
parent
f42bbc9ad5
commit
5480b1feee
|
@ -0,0 +1,3 @@
|
|||
[submodule "xexprs"]
|
||||
path = xexprs
|
||||
url = https://github.com/lijerom/xexprs
|
|
@ -0,0 +1,73 @@
|
|||
#lang racket/base
|
||||
(require racket/tcp)
|
||||
(require racket/string)
|
||||
|
||||
; I don't know what the hell is going on but I can't find any useful docs on anything, so... fuck it!
|
||||
(define (string-empty? str)
|
||||
(eq? (string-length str) 0))
|
||||
|
||||
(define (string-index str c)
|
||||
(define (string-index-p i)
|
||||
(if (or (eq? (string-length str) i) (eq? (string-ref str i) c)) i
|
||||
(string-index-p (+ i 1))))
|
||||
(string-index-p 0))
|
||||
|
||||
(define (string-cut str c)
|
||||
(define index (string-index str c))
|
||||
(values (substring str 0 index) (substring str (+ index 1))))
|
||||
|
||||
; Fucking hell
|
||||
(define (string-split str c)
|
||||
(define-values (head tail) (string-cut str c))
|
||||
(if (string-empty? tail)
|
||||
(list head)
|
||||
(cons (head (string-split tail c)))))
|
||||
|
||||
(define (parse-request line)
|
||||
(string-split line #\ ))
|
||||
|
||||
(define (parse-header line)
|
||||
(define-values (head tail) (string-cut line #\:))
|
||||
(cons (string->symbol head) tail))
|
||||
|
||||
(define (read-headers in)
|
||||
(define (read-header)
|
||||
(define line (read-line in))
|
||||
(if (or (eof-object? line) (string-empty? line)) (list)
|
||||
(cons (parse-header line) (read-header in))))
|
||||
(make-immutable-hash (read-header)))
|
||||
|
||||
(define (serve handler #:port (port 8080))
|
||||
(define listener (tcp-listen port 4 #t))
|
||||
(define (handle in out)
|
||||
(define request-line (parse-request (read-line in)))
|
||||
(define request-headers (read-headers in))
|
||||
(define message-body "") ; Temporary
|
||||
|
||||
(display (handler request-line request-headers message-body) out)
|
||||
|
||||
(close-input-port in)
|
||||
(close-output-port out))
|
||||
(define (loop)
|
||||
(define-values (in out) (tcp-accept listener))
|
||||
(thread (λ () (handle in out)))
|
||||
(loop))
|
||||
(loop))
|
||||
|
||||
(define status/ok '(200 "OK"))
|
||||
|
||||
(define (headers->string headers)
|
||||
(define (header->string header)
|
||||
(string-append (symbol->string (car header)) ": " (cdr header)))
|
||||
(string-join (map header->string (hash->list headers)) "\r\n"))
|
||||
|
||||
(define (response (body "") #:status (status status/ok) #:headers (headers '()))
|
||||
(string-append
|
||||
"HTTP/1.0 " (number->string (car status)) (cadr status) "\r\n"
|
||||
(headers->string headers) "\r\n\r\n"
|
||||
body))
|
||||
|
||||
(define (my-handler req headers body)
|
||||
(response "<html><body>test</body></html>" #:headers (make-immutable-hash '(Content-Type "text/html; charset=UTF-8"))))
|
||||
|
||||
(serve my-handler)
|
|
@ -0,0 +1 @@
|
|||
Subproject commit 2026c23aa83b6dd7f9bb03e38185a850ec6a2aac
|
Loading…
Reference in New Issue