33 lines
881 B
Factor
33 lines
881 B
Factor
|
! Copyright (C) 2009 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: accessors http.server kernel namespaces sequences
|
||
|
|
splitting urls ;
|
||
|
|
IN: http.server.rewrite
|
||
|
|
|
||
|
|
TUPLE: rewrite param child default ;
|
||
|
|
|
||
|
|
: <rewrite> ( -- rewrite )
|
||
|
|
rewrite new ;
|
||
|
|
|
||
|
|
M: rewrite call-responder*
|
||
|
|
over empty? [ default>> ] [
|
||
|
|
[ [ first ] [ param>> ] bi* set-param ]
|
||
|
|
[ [ rest ] [ child>> ] bi* ]
|
||
|
|
2bi
|
||
|
|
] if
|
||
|
|
call-responder* ;
|
||
|
|
|
||
|
|
TUPLE: vhost-rewrite suffix param child default ;
|
||
|
|
|
||
|
|
: <vhost-rewrite> ( -- vhost-rewrite )
|
||
|
|
vhost-rewrite new ;
|
||
|
|
|
||
|
|
: sub-domain? ( vhost-rewrite url -- subdomain ? )
|
||
|
|
swap suffix>> dup [
|
||
|
|
[ host>> canonical-host ] [ "." prepend ] bi* ?tail
|
||
|
|
] [ 2drop f f ] if ;
|
||
|
|
|
||
|
|
M: vhost-rewrite call-responder*
|
||
|
|
dup url get sub-domain?
|
||
|
|
[ over param>> set-param child>> ] [ drop default>> ] if
|
||
|
|
call-responder ;
|