Maintain a persistent environment for evals.

This allows us to avoid import-related memory leaks
by importing required modules only once at startup.

diff --git a/rags.scm b/rags.scm
index ef4726f..6eacfc4 100644 (file)
--- 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)))