From aadb0c8602819fe3dbaf7a283c4f7697f1971641 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Thu, 28 May 2020 13:28:01 +0200 Subject: [PATCH] Modularized some of the header code. Goal is to make these functions useful for scripts. --- rags.scm | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/rags.scm b/rags.scm index 177c7b5..ecc8618 100644 --- a/rags.scm +++ b/rags.scm @@ -63,6 +63,9 @@ (define (redirect-permanent new-uri) (print "30 " (uri->string new-uri) "\r")) +(define (serve-query prompt) + (print "10 " prompt "\r")) + (define (uri-lacks-trailing-slash? uri) (not (string-null? (last (uri-path uri))))) @@ -90,18 +93,25 @@ (if (directory-exists? path) (make-pathname path "index.gmi") path))) + +(define (ext->mime ext) + (let* ((mime-detected (assoc ext file-types))) + (cdr (if mime-detected + mime-detected + (assoc "txt" file-types))))) + +(define (serve-document-header mime) + (print "20 " (string-intersperse mime ";") "\r")) (define (serve-document config uri) (let* ((path (document-path config uri)) (ext (pathname-extension path)) - (mime-detected (assoc ext file-types)) - (mime (if mime-detected mime-detected (assoc "txt" file-types))) - (mime-type (cadr mime))) - (print "20 " (string-intersperse (cdr mime) ";") "\r") + (mime (ext->mime ext))) + (serve-document-header mime) (cond ((file-executable? path) (serve-text-dynamic path)) ; Binary-files can also be generated here, but the source is dynamic text - ((string-prefix? "text/" mime-type) + ((string-prefix? "text/" (car mime)) (serve-text-plain path)) (else (serve-binary path))))) -- 2.20.1