Index: example.scm ================================================================== --- example.scm +++ example.scm @@ -21,20 +21,19 @@ ;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ;; SOFTWARE. -(eval-when (eval load) - (require-library webgate)) +(require-library webgate) ;; Use -extend at-expr during compilation! (eval-when (eval) (import (only webgate-utils use-at-read-table)) (use-at-read-table #:list-arguments? #t)) (import - webgate (only webgate-utils uri-encode)) + webgate (only webgate-utils base64-encode)) (define common-head '@head{ @meta[(charset "utf-8")] @meta[(name "viewport") (content "width=device-width, initial-scale=1.0")] @@ -50,11 +49,14 @@ '@{ @script[(src "/js/jquery.min.js")] @script[(src "/js/bootstrap.min.js")] }) -(define-resource (root parameters) +(define-resource (root* parameters) + (make-redirect-response 301 (resource-uri root))) + +(define-resource (root "root" parameters) (make-html-response 200 `@html{ @,common-head @body{ @@ -131,12 +133,12 @@ ((class "label notice")) "Image Content:") " " (img ((src ,(string-append - "data:" type "," - (uri-encode + "data:" type ";base64," + (base64-encode (message-body msg)))))))) (else `(span (span ((class "label notice")) Index: webgate-core.scm ================================================================== --- webgate-core.scm +++ webgate-core.scm @@ -201,14 +201,20 @@ (h1 ,status-line) (p ,message)))) #:status-message status-message #:headers headers)) -(define (make-redirect-response target #!optional permanent?) - (make-error-response - (if permanent? 301 307) `(a ((href ,target)) ,target) - #:headers `(("Location" . ,target)))) +(define make-redirect-response + (case-lambda + ((status target) + (make-error-response + status `(a ((href ,target)) ,target) + #:headers `(("Location" . ,target)))) + ((target) + (make-error-response + 302 `(a ((href ,target)) ,target) + #:headers `(("Location" . ,target)))))) (define (write-response rsp #!optional (port (current-output-port))) (fprintf port "Status: ~a ~a\r\n" (response-status rsp) (response-status-message rsp))