From 316325e01f929f70c7a31b7b65cd5082ff638957 Mon Sep 17 00:00:00 2001 From: plugd Date: Mon, 19 Jul 2021 13:51:04 +0200 Subject: [PATCH] Maintain a persistent environment for evals. This allows us to avoid import-related memory leaks by importing required modules only once at startup. --- rags.scm | 31 ++++++++++++++++++++++++++----- 1 file changed, 26 insertions(+), 5 deletions(-) diff --git a/rags.scm b/rags.scm index ef4726f..6eacfc4 100644 --- a/rags.scm +++ b/rags.scm @@ -36,6 +36,9 @@ ("png" "image/png") ("mp3" "audio/mpeg"))) +(define eval-env-file "eval-env.scm") +(define eval-env (interaction-environment)) + (define (process-request config request-line) (let ((uri (uri-normalize-path-segments (absolute-uri request-line)))) (cond @@ -144,7 +147,7 @@ (with-current-working-directory working-directory (lambda () - (eval expression)))) + (eval expression eval-env)))) (('shell command) (with-current-working-directory working-directory @@ -160,7 +163,7 @@ (define (serve-script config uri) ;; Scripts are responsible for the entire response, including header (let* ((path (document-path config uri)) - (proc (eval (with-input-from-file path read)))) + (proc (eval (with-input-from-file path read) eval-env))) (with-current-working-directory (pathname-directory (document-path config uri)) (lambda () @@ -190,13 +193,31 @@ "Port: '" (config-port config) "'\n" "Root directory: '" (config-root-dir config) "'\n" "Cert file: '" (config-certfile config) "'\n" - "Key file: '" (config-keyfile config) "'\n" - "\n" - "Gemini server listening ...") + "Key file: '" (config-keyfile config) "'\n") + (print* "Dropping privilages ... ") (drop-privs config) + (print "done") + + (print* "Setting up environment ... ") + (setup-env config) + (print "done") + + (print "\nGemini server listening ...") (server-loop listener config)) +(define (setup-env config) + (with-current-working-directory + (config-root-dir config) + (lambda () + (if (and (file-exists? eval-env-file) (file-readable? eval-env-file)) + (with-input-from-file eval-env-file + (lambda () + (let loop ((next-expr (read))) + (unless (eof-object? next-expr) + (eval next-expr eval-env) + (loop (read)))))))))) + (define (drop-privs config) (let ((uid (config-uid config)) (gid (config-gid config))) -- 2.20.1