From fdce37f4be71360bea1ebd0ed864ebffed84265d Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Thu, 28 May 2020 12:28:56 +0200 Subject: [PATCH] Added basic supprt for scripts. --- rags.scm | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/rags.scm b/rags.scm index c3ac60a..177c7b5 100644 --- a/rags.scm +++ b/rags.scm @@ -26,7 +26,15 @@ (define file-types '(("gmi" "text/gemini" "charset=utf-8") ("txt" "text/plain" "charset=utf-8") - ("xml" "text/xml" "charset=utf-8"))) + ("csv" "text/csv" "charset=utf-8") + ("html" "text/html" "charset=utf-8") + ("xml" "text/xml" "charset=utf-8") + ("pdf" "application/pdf") + ("zip" "application/zip") + ("jpg" "image/jpeg") + ("jpeg" "image/jpeg") + ("png" "image/png") + ("mp3" "audio/mpeg"))) (define (process-request config request-line) (let ((uri (uri-normalize-path-segments (absolute-uri request-line)))) @@ -44,6 +52,8 @@ ((and (document-path-directory? config uri) (uri-lacks-trailing-slash? uri)) (redirect-permanent (uri-with-trailing-slash uri))) + ((document-script? config uri) + (serve-script config uri)) (else (serve-document config uri))))) @@ -62,6 +72,12 @@ (define (document-available? config uri) (file-exists? (document-path config uri))) +(define (document-script? config uri) + (let ((path (document-path config uri))) + (and (file-exists? path) + (file-executable? path) + (equal? (pathname-extension path) "scm")))) + (define (document-path-directory? config uri) (directory-exists? (document-path-raw config uri))) @@ -131,6 +147,12 @@ (close-output-port out-port)))))) (else (error "Unknown element type.")))) +(define (serve-script config uri) + ;; Scripts are responsible for the entire response, including header + (let ((path (document-path config uri))) + (apply (eval (with-input-from-file path read)) + (list uri)))) + (define (with-current-working-directory directory thunk) (let ((old-wd (current-directory)) (result 'none)) -- 2.20.1