Ticket #1838: redirect.scm

(import spiffy intarweb uri-common)

; Generates a handler that can be used in vhost-map that will cause all requests to that URL to be rewritten to the domain specified in 'to'.
(define (canonicalise-domain to)
  (let ((to (uri-reference to)))
   (assert (equal? '(/ "") (uri-path to)))
   (assert (null? (uri-query to)))
   ; We don't see fragments on the server and choose not to care about usernames and password fields.
    (lambda (continue)
      (let* ((old-u (request-uri (current-request)))
             (new-u (update-uri old-u
                                scheme: (or (uri-scheme to) (uri-scheme old-u))
                                port:   (or (uri-port   to) (uri-port   old-u))
                                host:   (or (uri-host   to) (uri-host   old-u)))))
        (with-headers `((location ,new-u))
                      (lambda () (send-status 'moved-permanently)))))))

(vhost-map `(("localhost"
              . ,(canonicalise-domain "https://posttestserver.dev"))))
(server-port 8080)
(start-server)