summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2023-01-29 21:54:16 +0000
committerArun Isaac2023-01-29 22:40:34 +0000
commit7d9615bd0ea68118fdcff0765100cf5d73e81e58 (patch)
treeea99280507a1f1a2e011e0d9ee5fba641f6e754a
parentd2680d358df6666b4b821662e1740d9668df29af (diff)
downloadtissue-7d9615bd0ea68118fdcff0765100cf5d73e81e58.tar.gz
tissue-7d9615bd0ea68118fdcff0765100cf5d73e81e58.tar.lz
tissue-7d9615bd0ea68118fdcff0765100cf5d73e81e58.zip
git: Deprecate call-with-file-in-git.
Functions called by call-with-file-in-git may expect to read files directly off the filesystem. These functions are not all within the user's control and cannot be rewritten to do otherwise. It is more robust to provide a filesystem checkout of the git repository like these functions expect. In this commit, we deprecate call-with-file-in-git and replace calls to it with call-with-input-file. These invocations have been arranged such that they all happen at the top level of a repository checkout. * tissue/git.scm (call-with-file-in-git): Delete function. * .dir-locals.el (scheme-mode): Unregister it. * bin/tissue (tissue-show, load-config), tissue/file-document.scm (file-text, read-gemtext-document), tissue/issue.scm (read-gemtext-issue): Replace call-with-file-in-git with call-with-input-file. (pull, tissue-web): Call load-config from the top level of a repository checkout.
-rw-r--r--.dir-locals.el1
-rwxr-xr-xbin/tissue86
-rw-r--r--tissue/file-document.scm4
-rw-r--r--tissue/git.scm22
-rw-r--r--tissue/issue.scm2
5 files changed, 48 insertions, 67 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index 38e25e1..ecfaf0e 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -7,7 +7,6 @@
(indent-tabs-mode t))
(scheme-mode
(eval . (put 'call-with-current-directory 'scheme-indent-function 1))
- (eval . (put 'call-with-file-in-git 'scheme-indent-function 2))
(eval . (put 'call-with-temporary-checkout 'scheme-indent-function 1))
(eval . (put 'function-documentation 'scheme-indent-function 2))
(eval . (put 'docstring-function-documentation 'scheme-indent-function 2))
diff --git a/bin/tissue b/bin/tissue
index 7d1c4e9..57ddaee 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -108,7 +108,7 @@ Show the text of FILE.
"
(command-line-program)))
((file)
- (call-with-file-in-git (current-git-repository) file
+ (call-with-input-file file
(lambda (port)
(port-transduce
(compose
@@ -152,7 +152,7 @@ Show the text of FILE.
(define (load-config)
"Load configuration and return <tissue-configuration> object."
- (call-with-file-in-git (current-git-repository) "tissue.scm"
+ (call-with-input-file "tissue.scm"
(compose eval-string get-string-all)))
(define tissue-repl
@@ -278,7 +278,10 @@ Serve repositories specified in CONFIG-FILE over HTTP.
(parameterize ((%current-git-repository
(repository-open repository-directory)))
(cons name
- `((project . ,(load-config))
+ `((project . ,(call-with-temporary-checkout repository-directory
+ (lambda (temporary-checkout)
+ (call-with-current-directory temporary-checkout
+ load-config))))
(repository-directory . ,repository-directory)
(website-directory . ,(string-append state-directory "/" name "/website"))
(xapian-directory . ,(string-append state-directory "/" name "/xapian"))
@@ -401,44 +404,45 @@ HOSTNAME."
(format (current-error-port)
"Cloned upstream repository.~%")
repository)))))
- (let ((config (load-config)))
- (parameterize ((%aliases (tissue-configuration-aliases config)))
- (call-with-temporary-checkout (git-top-level)
- (lambda (temporary-repository-clone)
- ;; Add the top level of the git repository to the
- ;; load path since there may be user-written
- ;; modules in the repository.
- ;; TODO: Though not strictly required, it would
- ;; be better to remove the added load path once
- ;; done.
- (add-to-load-path temporary-repository-clone)
- ;; Index.
- (unless (file-exists? "xapian")
- (mkdir "xapian"))
- (let ((xapian-directory (canonicalize-path "xapian")))
- (call-with-current-directory temporary-repository-clone
- (cut index
- xapian-directory
- (tissue-configuration-indexed-documents config)))
- (format (current-error-port)
- "Indexed latest changes.~%"))
- ;; Build website.
- (let ((website-directory "website"))
- (guard (c (else (format (current-error-port)
- "Building website failed.~%")
- (raise c)))
- (call-with-temporary-directory
- (lambda (temporary-output-directory)
- (call-with-current-directory temporary-repository-clone
- (cut build-website
- temporary-output-directory
- (tissue-configuration-web-files config)))
- (delete-file-recursively website-directory)
- (rename-file temporary-output-directory
- website-directory)))
- (chmod website-directory #o755)
- (format (current-error-port)
- "Built website.~%"))))))))))))))
+ (call-with-temporary-checkout (git-top-level)
+ (lambda (temporary-repository-clone)
+ (let ((config (call-with-current-directory temporary-repository-clone
+ load-config)))
+ (parameterize ((%aliases (tissue-configuration-aliases config)))
+ ;; Add the top level of the git repository to the
+ ;; load path since there may be user-written
+ ;; modules in the repository.
+ ;; TODO: Though not strictly required, it would
+ ;; be better to remove the added load path once
+ ;; done.
+ (add-to-load-path temporary-repository-clone)
+ ;; Index.
+ (unless (file-exists? "xapian")
+ (mkdir "xapian"))
+ (let ((xapian-directory (canonicalize-path "xapian")))
+ (call-with-current-directory temporary-repository-clone
+ (cut index
+ xapian-directory
+ (tissue-configuration-indexed-documents config)))
+ (format (current-error-port)
+ "Indexed latest changes.~%"))
+ ;; Build website.
+ (let ((website-directory "website"))
+ (guard (c (else (format (current-error-port)
+ "Building website failed.~%")
+ (raise c)))
+ (call-with-temporary-directory
+ (lambda (temporary-output-directory)
+ (call-with-current-directory temporary-repository-clone
+ (cut build-website
+ temporary-output-directory
+ (tissue-configuration-web-files config)))
+ (delete-file-recursively website-directory)
+ (rename-file temporary-output-directory
+ website-directory)))
+ (chmod website-directory #o755)
+ (format (current-error-port)
+ "Built website.~%"))))))))))))))
(define tissue-pull
(match-lambda*
diff --git a/tissue/file-document.scm b/tissue/file-document.scm
index ccd6a48..f389976 100644
--- a/tissue/file-document.scm
+++ b/tissue/file-document.scm
@@ -71,7 +71,7 @@
(define (file-text file)
"Return the contents of text @var{file}."
- (call-with-file-in-git (current-git-repository) file
+ (call-with-input-file file
get-string-all))
(define-method (document-text (document <file-document>))
@@ -139,7 +139,7 @@ MSet object representing a list of search results."
"Read gemtext document from @var{file} and return a
@code{<file-document>} object."
(make <file-document>
- #:title (or (call-with-file-in-git (current-git-repository) file
+ #:title (or (call-with-input-file file
(lambda (port)
(port-transduce (tfilter-map (lambda (line)
;; The first level one
diff --git a/tissue/git.scm b/tissue/git.scm
index 4289d65..70f0de9 100644
--- a/tissue/git.scm
+++ b/tissue/git.scm
@@ -45,7 +45,6 @@
commit-author-date
git-tracked-file?
git-tracked-files
- call-with-file-in-git
file-modification-table
clone-options
call-with-temporary-checkout))
@@ -132,27 +131,6 @@ directory."
directory of @var{repository} and do not have a leading slash."
(tree-list (head-tree repository)))
-(define (call-with-file-in-git repository path proc)
- "Call PROC on an input port reading contents of PATH. PATH may refer
-to a file on the filesystem or in REPOSITORY."
- (let ((file-path (if (absolute-file-name? path)
- ;; Treat absolute paths verbatim.
- path
- ;; Treat relative paths as relative to the
- ;; top-level of the git repository.
- (string-append (dirname (repository-directory repository))
- "/" path))))
- (if (file-exists? file-path)
- ;; If file exists on the filesystem, read it.
- (call-with-input-file file-path proc)
- ;; Else, read the file from the repository.
- (let* ((path-tree-entry (tree-entry-bypath (head-tree repository)
- path))
- (path-object (tree-entry->object repository path-tree-entry))
- (blob (blob-lookup repository (object-id path-object))))
- (call-with-port (open-bytevector-input-port (blob-content blob))
- proc)))))
-
(define (commit-file-changes repository commit)
"Return a list of pairs describing files modified by COMMIT with
respect to its first parent in REPOSITORY. Each pair maps the old
diff --git a/tissue/issue.scm b/tissue/issue.scm
index ebfca52..1953cef 100644
--- a/tissue/issue.scm
+++ b/tissue/issue.scm
@@ -277,7 +277,7 @@ gemtext file."
"Read issue from gemtext @var{file} and return an @code{<issue>}
object."
(let* ((file-document (read-gemtext-document file))
- (file-details (call-with-file-in-git (current-git-repository) file
+ (file-details (call-with-input-file file
file-details))
;; Downcase keywords to make them
;; case-insensitive.