34 lines
		
	
	
		
			906 B
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			34 lines
		
	
	
		
			906 B
		
	
	
	
		
			Factor
		
	
	
! Copyright (C) 2009 Slava Pestov.
 | 
						|
! See http://factorcode.org/license.txt for BSD license.
 | 
						|
USING: accessors http.server http.server.dispatchers 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 ;
 |