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

47
tekuti/projects.scm
View file

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