hwiki-mzrpc.scm
(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))))))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        )