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:
parent
11a53a7d14
commit
299eef6ecc
29
1991.fs
29
1991.fs
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user