- (define (serve-tree)
- (let ((entries (git "ls-tree" branch path))
- (references (git "show-ref" "--heads"))
- (commits (git "rev-list" "--abbrev-commit" "-n5" branch)))
- (append
- (list
- (conc "Git repository " repo)
- ""
- (conc "(Clone from " git-base-url repo ".)")
- ""
- "-----= Branches =-----")
- (map (lambda (ref)
- (let ((refname (caddr (string-split ref "/"))))
- (list
- 1
- (conc (if (equal? branch refname) "*" "")
- refname)
- (conc "browse-git.scm|tree|" repo "|" refname "|" path))))
- references)
- (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) " "))))
- (file-path (cadr l))
- (file (conc (pathname-file file-path)
- (if (pathname-extension file-path)
- (conc "." (pathname-extension file-path))
- ""))))
- (list (if (eq? type 'tree) 1 0)
- file
- (conc "browse-git.scm|" type "|" repo "|" branch "|"
- file-path
- (if (eq? type 'tree) "/" "")))))
- entries))))
+ (define (git . args)
+ (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))))))