From d5c1667374cb5e4ea016395e9f2b2ae89c5f6216 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sat, 28 Jan 2023 23:48:15 +0000
Subject: bin: Pass temporary checkout to server handler.

* bin/tissue (tissue-web): Pass temporary checkout of git repository,
not merely a bare repository, to server handler.
---
 bin/tissue | 43 +++++++++++++++++++++++++------------------
 1 file changed, 25 insertions(+), 18 deletions(-)

(limited to 'bin')

diff --git a/bin/tissue b/bin/tissue
index 606e36d..4ba69e7 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -266,24 +266,31 @@ Serve repositories specified in CONFIG-FILE over HTTP.
                             (default-configuration))))
        (when (assq-ref args 'listen-repl)
          (start-repl (assq-ref args 'listen-repl)))
-       (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)))))))
+       (let* ((state-directory (assq-ref args 'state-directory))
+              (hosts (assq-ref args 'hosts)))
+         (call-with-current-directory state-directory
+           (lambda ()
+             (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)))))))))))
 
 (define tissue-web-dev
   (match-lambda*
-- 
cgit v1.2.3