X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scratchy.git;a=blobdiff_plain;f=examples%2Fbrowse-git.scm;h=75b940c15ba58166190a572f3f498d88c30703bb;hp=02e755470dc5a96f76db66e01f52034136b00a08;hb=b415f682a8bbb14d01e8cd132ab16afbdd13d4c8;hpb=8cd0d616945d5ca6ae8d9a74a36d334b8870458f diff --git a/examples/browse-git.scm b/examples/browse-git.scm index 02e7554..75b940c 100755 --- a/examples/browse-git.scm +++ b/examples/browse-git.scm @@ -8,21 +8,26 @@ 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)) - (references (git "show-ref" "--heads"))) + (references (git "show-ref" "--heads")) + (commits (git "rev-list" "--abbrev-commit" "-n5" branch))) (append (list (conc "Git repository " repo) @@ -38,8 +43,19 @@ refname) (conc "browse-git.scm|tree|" repo "|" refname "|" path)))) references) - (list "" - (conc "-----= Files [" path "] =-----")) + (list + "" + (conc "-----= Recent Commits [" branch "] =-----")) + (map (lambda (commit) + (list + 1 + (conc (if (equal? branch commit) "*" "") + (car (git "show" "-s" "--format=%s (%ar)" commit))) + (conc "browse-git.scm|tree|" repo "|" commit "|" path))) + commits) + (list + "" + (conc "-----= Files [" path "] =-----")) (map (lambda (entry) (let* ((l (string-split entry "\t")) (type (string->symbol (cadr (string-split (car l) " ")))) @@ -59,7 +75,7 @@ (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)))