2010-03-13 01:06:41 -05:00
|
|
|
! Copyright (C) 2008, 2010 Slava Pestov.
|
2008-06-02 16:00:03 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2016-07-10 18:26:58 -04:00
|
|
|
USING: accessors fry http io io.encodings.utf8 io.files
|
|
|
|
io.streams.string kernel math math.parser parser sequences
|
|
|
|
splitting unicode words xml.syntax xml.writer ;
|
2008-06-02 16:00:03 -04:00
|
|
|
IN: http.server.responses
|
|
|
|
|
|
|
|
: <content> ( body content-type -- response )
|
|
|
|
<response>
|
|
|
|
200 >>code
|
|
|
|
"Document follows" >>message
|
2010-03-13 01:06:41 -05:00
|
|
|
utf8 >>content-encoding
|
2008-06-02 16:00:03 -04:00
|
|
|
swap >>content-type
|
|
|
|
swap >>body ;
|
2014-03-28 18:17:06 -04:00
|
|
|
|
|
|
|
: <text-content> ( body -- response )
|
|
|
|
"text/plain" <content> ;
|
2014-04-22 16:47:25 -04:00
|
|
|
|
|
|
|
: <html-content> ( body -- response )
|
|
|
|
"text/html" <content> ;
|
|
|
|
|
2008-06-02 16:00:03 -04:00
|
|
|
: trivial-response-body ( code message -- )
|
2009-01-30 20:28:16 -05:00
|
|
|
<XML
|
|
|
|
<html>
|
|
|
|
<body>
|
|
|
|
<h1><-> <-></h1>
|
|
|
|
</body>
|
|
|
|
</html>
|
|
|
|
XML> write-xml ;
|
2008-06-02 16:00:03 -04:00
|
|
|
|
|
|
|
: <trivial-response> ( code message -- response )
|
|
|
|
2dup [ trivial-response-body ] with-string-writer
|
2014-04-22 16:47:25 -04:00
|
|
|
<html-content>
|
2008-06-02 16:00:03 -04:00
|
|
|
swap >>message
|
|
|
|
swap >>code ;
|
|
|
|
|
2016-07-10 18:26:58 -04:00
|
|
|
<<
|
|
|
|
"vocab:http/server/responses/http-status-codes.txt"
|
|
|
|
utf8 file-lines [ [ blank? ] trim ] map
|
|
|
|
dup [ "Value" head? ] find drop 1 + tail
|
|
|
|
[ "Unassigned" swap subseq? ] reject
|
|
|
|
[
|
|
|
|
"[RFC" over start head " " split1 [ blank? ] trim
|
|
|
|
[
|
|
|
|
[
|
|
|
|
"<" ">" surround create-word-in dup reset-generic
|
|
|
|
] keep string>number
|
|
|
|
] dip '[ _ _ <trivial-response> ] ( -- response )
|
|
|
|
define-declared
|
|
|
|
] each
|
|
|
|
>>
|