(module hwiki-mzrpc mzscheme
(require (planet "mzrpc.scm" ("oesterholt" "mzrpc.plt" 1 0)))
(require "users.scm")
(require "page.scm")
(require "context.scm")
(require "debug.scm")
(provide start-hwiki-rpc-server)
(rpc-define (hwiki-put-page! client-obj (_context string?) (_pagename string?) (_html string?))
(let ((C (context)))
(-> C context! _context)
(let ((P (default-page C _pagename)))
(-> P template! "spod")
(debug "hwiki-put-page!:page-name=" (-> P name))
(let ((part (-> (-> P get-template) get-part "main")))
(debug "hwiki-put-page !:part=" part)
(-> P contents! part _html)
#t))))
(define re-login (regexp "([^:]*)[:][:](.*)"))
(define (hwiki-login __user _pass _chalenge)
(let ((M (regexp-match re-login __user)))
(if (eq? M #f)
#f
(let ((_context (cadr M))
(_user (caddr M)))
(let ((C (context)))
(-> C context! _context)
(let ((U (users C)))
(let ((R (-> U check _user _pass)))
(if (or (eq? R 'wrong-pass)
(eq? R 'not-found))
#f
R))))))))
(define RPC-SERVER #f)
(define (start-hwiki-rpc-server)
(if (not (eq? (getenv "HWIKI_RPC") #f))
(begin
(set! RPC-SERVER (rpc-server 7713 hwiki-login))
(-> RPC-SERVER add '(admin editor) hwiki-put-page!)
(thread (lambda () (-> RPC-SERVER run))))))
)