diff options
| -rwxr-xr-x | bin/tissue | 43 |
1 files changed, 25 insertions, 18 deletions
@@ -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* |