;; Script to browse locally-hosted URLs (lambda (type-str repo branch path) (import (chicken string) (chicken process) (chicken io) (chicken pathname) srfi-13) (define git-base-url "git://GIT-SERVER-URL/") (define git-base-dir "/PATH/TO/GIT/REPOS/") (define (git . args) (with-current-working-directory (conc 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))))) (define (serve-tree) (let ((entries (git "ls-tree" branch path)) (references (git "show-ref" "--heads"))) (append (list (conc "Git repository for " 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 "git.scm:tree:" repo ":" refname ":" path)))) references) (list "" "Files:") (map (lambda (entry) (let* ((l (string-split entry "\t")) (type (string->symbol (cadr (string-split (car l) " ")))) (file (cadr l))) (list (if (eq? type 'tree) 1 0) file (conc "git.scm:" type ":" repo ":" branch ":" file (if (eq? type 'tree) "/" ""))))) entries) (list "------")))) (define (serve-blob) (for-each (lambda (line) (print line "\r")) (git "cat-file" "blob" (conc branch ":" path))) (print ".\r")) (let ((type (string->symbol type-str))) (case type ((tree) (serve-tree)) ((blob) (serve-blob)) (else (error "Unsupported git object.")))))