1 ;; Script to browse locally-hosted URLs
3 ;; To use, replace the strings git-base-url and git-base-dir
4 ;; with the values appropriate to your system. Your git
5 ;; repository REPO should then be reachable at the selector
6 ;; browse-git.scm|REPO.
8 ;; You may optionally include a file named project-description
9 ;; in each repository, which will be displayed at the top
10 ;; of the page when the repository tree is served.
13 (let ((branch (if (< (length args) 1) "master" (list-ref args 0)))
14 (path (if (< (length args) 2) "." (list-ref args 1)))
15 (type-str (if (< (length args) 3) "tree" (list-ref args 2))))
17 (import (chicken string)
24 (define git-base-url "git://MY.GIT.SERVER/")
25 (define git-base-dir "/path/to/git/repositories/")
29 (let ((repo-pathname (make-pathname git-base-dir repo)))
30 (if (not (string-prefix? git-base-dir (normalize-pathname repo-pathname)))
31 (error "Invalid git repository."))
32 (with-current-working-directory
35 (let-values (((in-port out-port id) (process "git" args)))
36 (let ((result (read-lines in-port)))
37 (close-input-port in-port)
38 (close-output-port out-port)
42 (let ((entries (git "ls-tree" branch path))
43 (references (git "show-ref" "--heads")))
45 (list (conc "Git repository " git-base-url repo)
47 (let ((descr-file (make-pathname git-base-dir
48 (make-pathname repo "project-description"))))
49 (if (file-exists? descr-file)
50 (list "----= Description =----"
51 (with-input-from-file descr-file read-string)
54 (list "-----= Branches =-----")
56 (let ((refname (caddr (string-split ref "/"))))
59 (conc (if (equal? branch refname) "*" "")
61 (conc "browse-git.scm|" repo "|" refname "|" path "|tree"))))
64 (conc "-----= Files [" path "] =-----"))
66 (let* ((l (string-split entry "\t"))
67 (type (string->symbol (cadr (string-split (car l) " "))))
69 (file (conc (pathname-file file-path)
70 (if (pathname-extension file-path)
71 (conc "." (pathname-extension file-path))
73 (list (if (eq? type 'tree) 1 0)
75 (conc "browse-git.scm|" repo "|" branch "|"
77 (if (eq? type 'tree) "/" "")
85 (git "cat-file" "blob" (conc branch ":" path)))
88 (let ((type (string->symbol type-str)))
93 (error "Unsupported git object."))))))