From d22cda7ea80777aa9ed10ec9b2917b9762fe5fe5 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Mon, 6 May 2019 23:38:13 +0200 Subject: [PATCH] More allowances for broken clients. --- burrower.scm | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/burrower.scm b/burrower.scm index 62aa853..fa8e166 100644 --- a/burrower.scm +++ b/burrower.scm @@ -91,7 +91,7 @@ ((or (= (string-length l) 0) (string-suffix? "/" l)) 1) ((has-suffix? l ".txt" ".org" ".md") 0) ((has-suffix? l ".png" ".jpg" ".gif" ".bmp" ".tif" ".tga") 'I) - ((has-suffix? l "?.scm") 7) + ((has-suffix? l "?.scm" "%3f.scm") 7) ((has-prefix? l "url:" "/url:") 'h) (else 9)))) @@ -161,7 +161,8 @@ (error "File not found." filename)))) (define (serve-query selector arguments config) - (let ((filename (make-pathname (config-root-dir config) selector))) + (let ((filename (make-pathname (config-root-dir config) + (string-translate* selector '(("%3f" . "?")))))) (if (and (legal-filename? filename config) (= (length arguments) 1)) (with-input-from-file filename @@ -177,12 +178,18 @@ (define (serve-url selector config) (let ((url (substring selector 4))) (print - "If you are seeing this page, your gopher browser does not\r\n" - "properly support URL directory entries or cannot follow such\r\n" - "links. To view the link you requested, use a web browser to\r\n" - "open the follwing url:\r\n" - "\r\n" - url "\r\n"))) + "Redirection" + "" + "" + "

If you are seeing this page, your gopher browser does not " + "properly support URL directory entries or cannot follow such " + "links.

" + "

If you are viewing this page using a web browser, you should " + "be redirected shortly. Otherwise, you can manually open the " + "the follwing url:\n" + "\n" + "" url "\n" + ""))) ;;; Index rendering -- 2.20.1