1
0
mirror of https://github.com/urlysses/1991.git synced 2024-11-26 11:38:05 +11:00

Add filetype syntax (register and find).

This commit is contained in:
urlysses 2017-02-16 23:03:37 -05:00
parent 11a53a7d14
commit 299eef6ecc

29
1991.fs
View File

@ -44,13 +44,30 @@ pubvar RequestContentType
: get-content-type ( -- addr u ) : get-content-type ( -- addr u )
RequestContentType 2@ ; RequestContentType 2@ ;
: ctype? ( addr u -- ) : filetype: ( addr u "extension" -- ) \ takes a content-type and the extension
s" html" compare 0= if create here over 1+ allot place
s" text/html" does> count ;
: get-filetype ( addr u -- caddr cu ) \ takes an extension, looks to find a definition
find-name dup if
name>int
execute
else else
drop
s" text/plain" s" text/plain"
then ; then ;
s" text/plain" filetype: txt \ txt should always be defined
s" text/html" filetype: html
s" text/css" filetype: css
s" text/javascript" filetype: js
s" image/png" filetype: png
s" image/gif" filetype: gif
s" image/jpeg" filetype: jpg
s" image/jpeg" filetype: jpeg
s" image/x-icon" filetype: ico
\ Internal request handling \ Internal request handling
: HTTP/1.1 s" HTTP/1.1 " ; : HTTP/1.1 s" HTTP/1.1 " ;
@ -95,17 +112,17 @@ pubvar RequestContentType
2dup reverse ; \ reverse reversed extension 2dup reverse ; \ reverse reversed extension
: serve-file-type ( addr u -- ) : serve-file-type ( addr u -- )
.extension ctype? set-content-type ; .extension get-filetype set-content-type ;
: serve-file ( addr u -- addr u ) : serve-file ( addr u -- addr u )
slurp-file ; slurp-file ;
: 404content-type s" txt" ctype? ; : 404content-type txt ;
: 404html s" 404"; : 404html s" 404";
: either-resolve ( addr u -- resolveaddr resolveu ) : either-resolve ( addr u -- resolveaddr resolveu )
s" GET" search if s" GET" search if
s" html" ctype? set-content-type \ reset the request's content-type s" html" get-filetype set-content-type \ reset the request's content-type
requested-route requested-route
2dup find-route dup if 2dup find-route dup if
>r 2drop r> \ keep xt, drop the route string >r 2drop r> \ keep xt, drop the route string