mirror of
https://github.com/urlysses/1991.git
synced 2024-11-01 07:50:56 +11:00
Generalize header words and start implementing content-types based on extensions
This commit is contained in:
parent
a9c21097b8
commit
11a53a7d14
76
1991.fs
76
1991.fs
@ -2,6 +2,17 @@
|
|||||||
|
|
||||||
include unix/socket.fs
|
include unix/socket.fs
|
||||||
|
|
||||||
|
\ Helper words
|
||||||
|
: +s ( addr1 u1 addr2 u2 -- addr3 u3 ) \ like s+ but prepend rather than append.
|
||||||
|
2swap s+ ;
|
||||||
|
: exchange ( a1 a2 -- )
|
||||||
|
2dup c@ swap c@ rot c! swap c! ;
|
||||||
|
: reverse ( caddr u -- ) \ reverse a string
|
||||||
|
1- bounds begin 2dup > while
|
||||||
|
2dup exchange
|
||||||
|
-1 /string
|
||||||
|
repeat 2drop ;
|
||||||
|
|
||||||
\ User-defined routing
|
\ User-defined routing
|
||||||
wordlist constant routes
|
wordlist constant routes
|
||||||
: find-route ( addr u -- data )
|
: find-route ( addr u -- data )
|
||||||
@ -26,8 +37,43 @@ pubvar public
|
|||||||
: get-public-path ( -- addr u )
|
: get-public-path ( -- addr u )
|
||||||
public 2@ ;
|
public 2@ ;
|
||||||
|
|
||||||
|
\ Request's Content-Type
|
||||||
|
pubvar RequestContentType
|
||||||
|
: set-content-type ( addr u -- )
|
||||||
|
RequestContentType 2! ;
|
||||||
|
: get-content-type ( -- addr u )
|
||||||
|
RequestContentType 2@ ;
|
||||||
|
|
||||||
|
: ctype? ( addr u -- )
|
||||||
|
s" html" compare 0= if
|
||||||
|
s" text/html"
|
||||||
|
else
|
||||||
|
s" text/plain"
|
||||||
|
then ;
|
||||||
|
|
||||||
\ Internal request handling
|
\ Internal request handling
|
||||||
: read-request ( socket -- addr u ) pad 4096 read-socket ;
|
: HTTP/1.1 s" HTTP/1.1 " ;
|
||||||
|
|
||||||
|
: response-status ( u -- addr u )
|
||||||
|
dup case \ get status code info
|
||||||
|
200 of s" OK" endof
|
||||||
|
404 of s" Not Found" endof
|
||||||
|
endcase
|
||||||
|
s\" \n" s+
|
||||||
|
rot s>d <# #s #> +s \ convert status code to string and prepend to info
|
||||||
|
HTTP/1.1 +s ; \ prepend HTTP/1.1
|
||||||
|
|
||||||
|
: content-type ( addr u -- caddr cu )
|
||||||
|
s" Content-Type: " +s \ Prepend to the provided content type
|
||||||
|
s\" \n\n" s+ ; \ Append 2 new lines
|
||||||
|
|
||||||
|
: set-header ( u addr u -- raddr ru ) \ Accepts status code and content type string
|
||||||
|
rot response-status \ Set response status
|
||||||
|
2swap content-type \ Set content-type
|
||||||
|
s+ ; \ Join
|
||||||
|
|
||||||
|
: read-request ( socket -- addr u )
|
||||||
|
pad 4096 read-socket ;
|
||||||
|
|
||||||
: send-response ( addr u socket -- )
|
: send-response ( addr u socket -- )
|
||||||
dup >r write-socket r> close-socket ;
|
dup >r write-socket r> close-socket ;
|
||||||
@ -38,30 +84,48 @@ pubvar public
|
|||||||
: file-exists? ( addr u -- addr u bool )
|
: file-exists? ( addr u -- addr u bool )
|
||||||
2dup file-status nip 0= ;
|
2dup file-status nip 0= ;
|
||||||
|
|
||||||
|
: .extension ( addr u -- addr u )
|
||||||
|
2dup reverse \ reverse the file name
|
||||||
|
2dup s" ." search \ search for the first occurance of "."
|
||||||
|
if
|
||||||
|
swap drop - \ remove the "." from the search results
|
||||||
|
else
|
||||||
|
s" txt"
|
||||||
|
then
|
||||||
|
2dup reverse ; \ reverse reversed extension
|
||||||
|
|
||||||
|
: serve-file-type ( addr u -- )
|
||||||
|
.extension ctype? set-content-type ;
|
||||||
|
|
||||||
: serve-file ( addr u -- addr u )
|
: serve-file ( addr u -- addr u )
|
||||||
slurp-file ;
|
slurp-file ;
|
||||||
|
|
||||||
|
: 404content-type s" txt" ctype? ;
|
||||||
|
: 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
|
||||||
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
|
||||||
execute \ execute the user's route handler
|
execute \ execute the user's route handler
|
||||||
else
|
else
|
||||||
drop \ drop the xt
|
drop \ drop the null xt
|
||||||
get-public-path 2swap s+ \ see if route exists in public dir
|
get-public-path +s \ see if route exists in public dir
|
||||||
file-exists? if
|
file-exists? if
|
||||||
serve-file \ collect file contents
|
2dup serve-file \ collect file contents
|
||||||
|
2swap serve-file-type \ set the file type
|
||||||
else
|
else
|
||||||
exit \ continue to 404
|
exit \ continue to 404
|
||||||
then
|
then
|
||||||
then
|
then
|
||||||
s\" HTTP/1.1 200 OK\n Content-Type: text/html\n\n" 2swap s+
|
200 get-content-type set-header +s
|
||||||
rdrop exit then ;
|
rdrop exit then ;
|
||||||
|
|
||||||
: or-404 ( addr u -- 404addr 404u )
|
: or-404 ( addr u -- 404addr 404u )
|
||||||
2drop
|
2drop
|
||||||
s\" HTTP/1.1 404 Not Found\n Content-Type: text/plain\n\n 404" ;
|
404 404content-type set-header 404html s+ ;
|
||||||
|
|
||||||
: prepare-response ( addr u -- returnaddr returnu)
|
: prepare-response ( addr u -- returnaddr returnu)
|
||||||
either-resolve or-404 ;
|
either-resolve or-404 ;
|
||||||
|
Loading…
Reference in New Issue
Block a user