summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/tissue43
1 files changed, 25 insertions, 18 deletions
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*