aliens/tekuti
1
0
Fork 0
Code Activity

redo reindexing to be more erlangy

Browse source
This commit is contained in:
Andy Wingo 2008-02-12 23:09:55 +01:00
parent da58b95476
commit 8c52717d5d
3 changed files with 55 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
src/tekuti
View file

@ -39,11 +39,8 @@ exec guile $GUILE_FLAGS -l $0 -e main "$@"
(tekuti mod-lisp)
(tekuti web))
(define (handle-request headers post-data)
(let ((heads (fetch-heads `(posts . ,reindex-posts)
`(categories . ,reindex-categories))))
(let-headers
headers ((method "method") (path "url"))
(define (handle-request headers post-data index)
(let-headers headers ((method "method") (path "url"))
(url-relative-path-case
method path
((POST admin new-post)
@ -64,8 +61,21 @@ exec guile $GUILE_FLAGS -l $0 -e main "$@"
(page-debug headers))
((POST search)
(unimplemented 'search))
(else (page-not-found path))))))
(else (page-not-found path)))))
(define (maybe-reindex old-master old-index)
(let ((master (git-rev-parse "master")))
(values
master
(if (equal? master old-master)
old-index
(acons 'master master
(map (lambda (k reindex)
(cons k (reindex master)))
(list 'posts 'categories)
(list reindex-posts reindex-categories)))))))
(define (main args)
(ensure-git-repo)
(event-loop handle-request))
(event-loop handle-request maybe-reindex))

24
tekuti/git.scm
View file

@ -34,7 +34,7 @@
#:use-module (ice-9 regex) ; hack
#:export (git git* ensure-git-repo git-ls-tree git-ls-subdirs
parse-metadata parse-commit commit-utc-timestamp
commit-parents make-tree fetch-heads))
commit-parents make-tree git-rev-parse))
(define (call-with-pipe pipe proc)
(unwind-protect
@ -148,25 +148,3 @@
(define (git-rev-parse rev)
(string-trim-both (git "rev-parse" rev)))
(define (fetch-heads . heads)
(let ((master (git-rev-parse "master")))
(acons
'master master
(map (lambda (spec)
(let ((ref (car spec)) (reindex (cdr spec)))
(let ((head (false-if-exception
(git-rev-parse (car spec)))))
(cons
ref
(if (and head (member master (commit-parents head)))
head
(and=> (reindex master)
(lambda (new)
(if (not (false-if-exception
(if head
(git "update-ref" ref new head)
(git "branch" ref new))))
(dbg "couldn't update ref ~a to ~a" ref new))
new)))))))
heads))))

24
tekuti/mod-lisp.scm
View file

@ -26,6 +26,7 @@
(define-module (tekuti mod-lisp)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 receive)
#:use-module (sxml simple)
#:use-module (sxml transform)
#:use-module (tekuti url)
@ -57,14 +58,14 @@
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "
"\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"))
(define (connection-received socket sockaddr handle-request)
(define (connection-received socket sockaddr index handle-request)
(let ((headers (read-headers socket))
(post-data "")) ;; blocks: (read-delimited "" socket)))
(dbg "~a" headers)
(catch #t
(lambda ()
(let ((sxml (handle-request headers post-data)))
(let ((sxml (handle-request headers post-data index)))
(write-headers '(("Status" . "200 OK")
("Content-Type" . "text/html"))
socket)
@ -78,16 +79,23 @@
(close-port socket)))
(define (event-loop handle-request)
(define (with-socket proc)
(pk 'listening)
(let ((socket (socket PF_INET SOCK_STREAM 0)))
(bind socket AF_INET (inet-aton *host*) *port*)
(listen socket *backlog*)
(unwind-protect
(let lp ((pair (accept socket)))
(pk pair)
(connection-received (car pair) (cdr pair) handle-request)
(pk 'done)
(lp (accept socket)))
(proc socket)
(shutdown socket 2))))
(define (event-loop handle-request maybe-reindex)
(with-socket
(lambda (socket)
(let lp ((old-cookie #f) (old-index #f))
(let* ((pair (accept socket))
(fd (car pair))
(sockaddr (cdr pair)))
(receive
(cookie index) (maybe-reindex old-cookie old-index)
(connection-received (car pair) (cdr pair) index handle-request)
(lp cookie index)))))))