aliens/tekuti
1
0
Fork 0
Code Activity

Only show permitted projects and subdirs

Browse source 
Permitted in this context means read access for projects and
execute (list) access for sub directories.
This commit is contained in:
Tom Willemsen 2012-09-11 22:15:17 +02:00
parent cf5d90a257
commit 3c72a6ffb2
1 changed files with 30 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
tekuti/projects.scm
View file

@ -25,9 +25,12 @@
(lambda (name stat) (lambda (name stat)
(not (file-exists? (string-append name "/config"))))))) (not (file-exists? (string-append name "/config")))))))
(define (project-dir project)
(string-append *projects-dir* "/" project))
(define (project-description project) (define (project-description project)
(let ((dfile-name (let ((dfile-name
(string-append *projects-dir* "/" project "/description"))) (string-append (project-dir project) "/description")))
(if (file-exists? dfile-name) (if (file-exists? dfile-name)
(with-input-from-file dfile-name (with-input-from-file dfile-name
(lambda () (lambda ()
@ -36,8 +39,7 @@
(define (git-last-update project) (define (git-last-update project)
"Check when the last update upstream was." "Check when the last update upstream was."
(let* ((dfile-name (let* ((dfile-name (project-dir project))
(string-append *projects-dir* "/" project))
(pipe (open-input-pipe (pipe (open-input-pipe
(string-append (string-append
"git --git-dir=" dfile-name "git --git-dir=" dfile-name
@ -48,18 +50,19 @@
"never" "never"
relative-last-update))) relative-last-update)))
(define (project->row project) (define (project->row dir project)
`(tr `(tr
(td ,project) (td ,project)
(td ,(project-description project)) (td ,(project-description project))
(td ,(git-last-update project)) (td ,(git-last-update project))
(td ""))) (td "")))
(define (project-list->table list lvl) (define (project-list->table top-dir list lvl)
(let ((head (car list)) (let ((head (car list))
(body (cadr list))) (body (cadr list)))
`((,(string->symbol (string-append "h" (number->string lvl))) ,head) `((,(string->symbol (string-append "h" (number->string lvl))) ,head)
(table (@ (class "table table-condensed table-striped")) (table
(@ (class "table table-condensed table-striped"))
(thead (thead
(tr (tr
(th "Name") (th "Name")
@ -67,10 +70,20 @@
(th "Last update") (th "Last update")
(th ""))) (th "")))
(tbody (tbody
,@(map project->row (filter string? body)))) ,@(map (lambda (elt)
,@(map (lambda (elt) (project-list->table elt (1+ lvl))) (project->row top-dir elt))
(filter list? body))))) (filter (lambda (elt)
(and (string? elt)
(access? (string-append top-dir "/" elt) R_OK)))
body))))
,@(map (lambda (elt) (project-list->table
(string-append top-dir (car elt)) elt (1+ lvl)))
(filter
(lambda (elt)
(and (list? elt)
(access? (string-append top-dir (car elt)) X_OK)))
body)))))
(define (page-projects request body index) (define (page-projects request body index)
(respond (project-list->table (list-projects) 1) (respond (project-list->table *projects-dir* (list-projects) 1)
#:extra-headers '((pragma . (no-cache (broccoli . "tastyy")))))) #:extra-headers '((pragma . (no-cache (broccoli . "tastyy"))))))