diff --git a/1991.fs b/1991.fs index 05fb311..a5276d2 100644 --- a/1991.fs +++ b/1991.fs @@ -18,6 +18,13 @@ wordlist constant routes r> set-current then ; +\ Public directory +: pubvar create 0 , 0 , ; +pubvar public +: set-public-path ( addr u -- ) + public 2! ; +: get-public-path ( -- addr u ) + public 2@ ; \ Internal request handling : read-request ( socket -- addr u ) pad 4096 read-socket ; @@ -25,24 +32,37 @@ wordlist constant routes : send-response ( addr u socket -- ) dup >r write-socket r> close-socket ; -: or-404 ( addr u -- 404addr 404u ) - 2drop - s\" HTTP/1.1 404 Not Found\n Content-Type: text/plain\n\n 404" ; - : requested-route ( addr u -- routeaddr routeu ) bl scan 1- swap 1+ swap 2dup bl scan swap drop - ; +: file-exists? ( addr u -- addr u bool ) + 2dup file-status nip 0= ; + +: serve-file ( addr u -- addr u ) + slurp-file ; + : either-resolve ( addr u -- resolveaddr resolveu ) s" GET" search if requested-route - find-route dup if - execute + 2dup find-route dup if + >r 2drop r> \ keep xt, drop the route string + execute \ execute the user's route handler else - 0 exit \ continue to 404 + drop \ drop the xt + get-public-path 2swap s+ \ see if route exists in public dir + file-exists? if + serve-file \ collect file contents + else + exit \ continue to 404 + then then s\" HTTP/1.1 200 OK\n Content-Type: text/html\n\n" 2swap s+ rdrop exit then ; +: or-404 ( addr u -- 404addr 404u ) + 2drop + s\" HTTP/1.1 404 Not Found\n Content-Type: text/plain\n\n 404" ; + : prepare-response ( addr u -- returnaddr returnu) either-resolve or-404 ;