parent
f605367c1a
commit
96b485294f
|
@ -263,7 +263,7 @@
|
||||||
(request-method req))
|
(request-method req))
|
||||||
|
|
||||||
(if loc
|
(if loc
|
||||||
(if (uri-has-protocol? (string-trim loc))
|
(if (absolute-url? (url-string->http-url (string-trim loc)))
|
||||||
(make-error-response (status-code moved-perm) req loc)
|
(make-error-response (status-code moved-perm) req loc)
|
||||||
(make-redirect-response (string-trim loc)))
|
(make-redirect-response (string-trim loc)))
|
||||||
;; Send the response header back to the client
|
;; Send the response header back to the client
|
||||||
|
@ -286,9 +286,6 @@
|
||||||
(make-writer-body (lambda (out options)
|
(make-writer-body (lambda (out options)
|
||||||
(copy-inport->outport script-port out)))))
|
(copy-inport->outport script-port out)))))
|
||||||
|
|
||||||
(define (uri-has-protocol? loc)
|
|
||||||
(if (http-url-host (url-string->http-url loc)) #t #f))
|
|
||||||
|
|
||||||
(define (extract-status-code-and-text status req)
|
(define (extract-status-code-and-text status req)
|
||||||
(with-fatal-error-handler*
|
(with-fatal-error-handler*
|
||||||
(lambda (c d)
|
(lambda (c d)
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
;;; HTTP 1.1 Request-URI parsing and unparsing -*- Scheme -*-
|
;;; HTTP 1.1 Request-URI parsing and unparsing -*- Scheme -*-
|
||||||
|
|
||||||
;;; Copyright (c) 2005 by Viola Brunner.
|
;;; This file is part of the Scheme Untergrund Networking package.
|
||||||
|
|
||||||
;;; For copyright information, see the file COPYING which comes with
|
;;; For copyright information, see the file COPYING which comes with
|
||||||
;;; the distribution.
|
;;; the distribution.
|
||||||
|
|
||||||
|
@ -252,6 +253,9 @@
|
||||||
(path http-url-path)
|
(path http-url-path)
|
||||||
(query http-url-query))
|
(query http-url-query))
|
||||||
|
|
||||||
|
;;; Is http-url of the form http_URL, i.e. absolute?
|
||||||
|
(define (absolute-url? http-url)
|
||||||
|
(http-url-host http-url))
|
||||||
|
|
||||||
;;; parse a HTTP 1.1. Request_URI into a http-url record
|
;;; parse a HTTP 1.1. Request_URI into a http-url record
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue