users.scm
(module users mzscheme
        (require "hwikireq.scm")
        (require "config.scm")
        (require "context.scm")
        (provide users
                 user-name
                 user-account
                 user-pass
                 user-role)

        (define (user-name u)
          (user-account u))

        (define (user-account u)
          (car u))

        (define (user-pass u)
          (cadr u))

        (define (user-role u)
          (caddr u))

        (def-class
         (this (users context))
         (supers)
         (private
          (define _paths (cfile context))
          
          (define _users (list (list "admin" "admin" 'admin)))

          (define (lock)
            #t)

          (define (unlock)
            #t)

          (define (load)
            (let ((fh (with-handlers ((exn:fail? (lambda (exn) #f)))
                        (open-input-file (-> _paths filename 'admin "users")))))
              (if (not (eq? fh #f))
                  (begin
                    (set! _users (read fh))
                    (close-input-port fh)))))

          (define (save)
            (let ((fh (open-output-file (-> _paths filename 'admin "users") 'replace)))
              (write _users fh)
              (close-output-port fh)))

          )
         (public
          (define (set-user user pass role)
            (lock)
            (load)
            (set! _users (cons (list user pass role)
                               (letrec ((f (lambda (users)
                                             (if (null? users)
                                                 (list)
                                                 (if (string-ci=? user (caar users))
                                                     (f (cdr users))
                                                     (cons (car users) (f (cdr users))))))))
                                 (f _users))))
            (save)
            (unlock))

          (define (check user pass)
            (load)
            (letrec ((f (lambda (users)
                          (if (null? users)
                              'not-found
                              (if (string-ci=? user (caar users))
                                  (if (string-ci=? pass (cadar users))
                                      (caddar users)
                                      'wrong-pass)
                                  (f (cdr users)))))))
              (f _users)))

          (define (set-editor user pass)
            (set-user user pass 'editor))

          (define (set-admin user pass)
            (set-user user pass 'admin))

          (define (users)
            (load)
            _users)

          (define (exists? name)
            (letrec ((f (lambda (U)
                          (if (null? U)
                              #f
                              (if (string-ci=? name (user-name (car U)))
                                  #t
                                  (f (cdr U)))))))
              (f (users))))

          (define (set-pass name pass)
            (letrec ((f (lambda (U)
                          (if (null? U)
                              (list)
                              (if (string-ci=? name (user-name (car U)))
                                  (cons (list name pass (user-role (car U)))
                                        (f (cdr U)))
                                  (cons (car U) (f (cdr U))))))))
              (set! _users (f (users)))
              (save)))

          (define (remove-user name)
            (letrec ((f (lambda (U)
                          (if (null? U)
                              (list)
                              (if (string-ci=? name (user-name (car U)))
                                  (f (cdr U))
                                  (cons (car U) (f (cdr U))))))))
              (set! _users (f (users)))
              (save)))

          )
         (constructor)
         )


        ) ; end-module