From: Tim Vaughan <tgvaughan@gmail.com>
Date: Fri, 31 May 2019 20:31:13 +0000 (+0200)
Subject: Git example uses new argument style.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=0c9bb3bc20b37663004e37a3a3a69747f5acb326;p=scratchy.git

Git example uses new argument style.

Also added basic checking to ensure path to chosen repo
stays within git-root-dir.
---

diff --git a/examples/browse-git.scm b/examples/browse-git.scm
index 02e7554..a5d9e7f 100755
--- a/examples/browse-git.scm
+++ b/examples/browse-git.scm
@@ -8,17 +8,21 @@
           srfi-13)
 
   (define git-base-url "git://MY.GIT.SERVER/")
-  (define git-base-dir "/PATH/TO/REPOS/")
+  (define git-base-dir "/PATH/TO/GIT/REPOS/")
+
 
   (define (git . args)
-    (with-current-working-directory
-     (list git-base-dir repo)
-     (lambda ()
-       (let-values (((in-port out-port id) (process "git" args)))
-         (let ((result (read-lines in-port)))
-           (close-input-port in-port)
-           (close-output-port out-port)
-           result)))))
+    (let ((repo-pathname (make-pathname git-base-dir repo)))
+      (if (not (string-prefix? git-base-dir (normalize-pathname repo-pathname)))
+          (error "Invalid git repository."))
+      (with-current-working-directory
+       repo-pathname
+       (lambda ()
+         (let-values (((in-port out-port id) (process "git" args)))
+           (let ((result (read-lines in-port)))
+             (close-input-port in-port)
+             (close-output-port out-port)
+             result))))))
 
   (define (serve-tree)
     (let ((entries (git "ls-tree" branch path))
@@ -51,15 +55,14 @@
                 (list (if (eq? type 'tree) 1 0)
                       file
                       (conc "browse-git.scm|" type "|" repo "|" branch "|"
-                            file-path
-                            (if (eq? type 'tree) "/" "")))))
+                            file-path))))
             entries))))
 
   (define (serve-blob)
     (for-each
      (lambda (line)
        (print line "\r"))
-     (git "cat-file" "blob" (conc branch "|" path)))
+     (git "cat-file" "blob" (conc branch ":" path)))
     (print ".\r"))
 
   (let ((type (string->symbol type-str)))