From fb26896560dbdfa80eb517d157e9afd2562e1f8e Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sun, 29 Jan 2023 16:56:43 +0000
Subject: web: Do not temporarily checkout repository when serving it.

Now that snippet source texts are interred into the xapian index, the
web server does not need a repository checkout.

* bin/tissue (tissue-web): Do not temporarily checkout repositories
being served.
* tissue/web/server.scm (handler): Do not change into repository
directory.
* tissue/git.scm (call-with-temporary-checkouts): Delete function.
* .dir-locals.el (scheme-mode): Unregister it.
---
 bin/tissue | 41 ++++++++++++++++++-----------------------
 1 file changed, 18 insertions(+), 23 deletions(-)

(limited to 'bin')

diff --git a/bin/tissue b/bin/tissue
index f9524ac..606e36d 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -266,29 +266,24 @@ Serve repositories specified in CONFIG-FILE over HTTP.
                             (default-configuration))))
        (when (assq-ref args 'listen-repl)
          (start-repl (assq-ref args 'listen-repl)))
-       (let* ((state-directory (assq-ref args 'state-directory))
-              (hosts (assq-ref args 'hosts)))
-         (call-with-temporary-checkouts (map (match-lambda
-                                               ((name _ ...)
-                                                (string-append state-directory "/" name "/repository")))
-                                             hosts)
-           (lambda checkouts
-             (start-web-server (listen->socket-address (assq-ref args 'listen))
-                               (map (match-lambda*
-                                      (((name parameters ...) repository-directory)
-                                       ;; Add CSS, repository directory,
-                                       ;; website directory, xapian
-                                       ;; directory settings for each host.
-                                       (parameterize ((%current-git-repository
-                                                       (repository-open repository-directory)))
-                                         (cons name
-                                               `((project . ,(load-config))
-                                                 (repository-directory . ,repository-directory)
-                                                 (website-directory . ,(string-append state-directory "/" name "/website"))
-                                                 (xapian-directory . ,(string-append state-directory "/" name "/xapian"))
-                                                 ,@parameters)))))
-                                    hosts
-                                    checkouts)))))))))
+       (start-web-server (listen->socket-address (assq-ref args 'listen))
+                         (map (match-lambda
+                                ((name parameters ...)
+                                 ;; Add CSS, repository directory,
+                                 ;; website directory, xapian
+                                 ;; directory settings for each host.
+                                 (let* ((state-directory (assq-ref args 'state-directory))
+                                        (repository-directory
+                                         (string-append state-directory "/" name "/repository")))
+                                   (parameterize ((%current-git-repository
+                                                   (repository-open repository-directory)))
+                                     (cons name
+                                           `((project . ,(load-config))
+                                             (repository-directory . ,repository-directory)
+                                             (website-directory . ,(string-append state-directory "/" name "/website"))
+                                             (xapian-directory . ,(string-append state-directory "/" name "/xapian"))
+                                             ,@parameters))))))
+                              (assq-ref args 'hosts)))))))
 
 (define tissue-web-dev
   (match-lambda*
-- 
cgit v1.2.3