Browse Source

Implement basic file serving from public/

TODO:
+ set appropriate MIME types
1991
urlysses 7 years ago
parent
commit
2eef80dd5d
1 changed files with 27 additions and 7 deletions
  1. +27
    -7
      1991.fs

+ 27
- 7
1991.fs View File

@@ -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 ;



Loading…
Cancel
Save