basis/http/server/redirection/redirection.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors combinators namespaces strings
   4 logging urls http http.server http.server.responses ;
   5 IN: http.server.redirection
   6
   7 GENERIC: relative-to-request ( url -- url' )
   8
   9 M: string relative-to-request ;
  10
  11 M: url relative-to-request
  12     url get
  13         clone
  14         f >>query
  15     swap derive-url ensure-port ;
  16
  17 : <custom-redirect> ( url code message -- response )
  18     <trivial-response>
  19         swap dup url? [ relative-to-request ] when
  20         "location" set-header ;
  21
  22 \ <custom-redirect> DEBUG add-input-logging
  23
  24 : <permanent-redirect> ( url -- response )
  25     301 "Moved Permanently" <custom-redirect> ;
  26
  27 : <temporary-redirect> ( url -- response )
  28     307 "Temporary Redirect" <custom-redirect> ;