(module rpc-client mzscheme
        (require (planet "fifo.scm" ("oesterholt" "datastructs.plt" 1 0)))
        (require (planet "spod.scm" ("oesterholt" "roos.plt" 1 0)))
        (require "rpc-marshal.scm")
        (require "rpc-io.scm")
        (require "rpc-log.scm")
        (provide rpc-call
                 rpc-symbol-call
                 rpc-connect
                 rpc-disconnect
                 rpc-global-connect
                 rpc-global-disconnect
                 rpc-global-handle!
                 rpc-shutdown
                 rpc-force-shutdown
                 rpc-connected
                 rpc-chalenge
                 rpc-message
                 rpc-notifications-handler
                 rpc-valid?
                 rpc-diagnose
                 rpc-client-define
                 rpc-client-documentation
                 rpc-local-define
                 rpc-global-handle
                 )
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; Internal stuff
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define GLOBAL-CLIENT-HANDLE #f)
        
        (define-struct %mzrpc
                       (valid message from-server to-server hasher notifications-handler reader-fifo reader diagnose))
        
        (define-syntax rpc-error?
          (syntax-rules ()
            ((_ h) (eq? (car h) 'error))))
        
        (define-syntax rpc-error-message 
          (syntax-rules ()
            ((_ h) (cadr h))))
        
        (define-syntax rpc-value
          (syntax-rules ()
            ((_ h) (cadr h))))
        
        (define (internal-rpc-call handle f args)
          (if (rpc-valid? handle)
              (let ((A (map rpc-marshal args)))
                (let ((R (write* (cons f A) (%mzrpc-to-server handle) )))
                  ;(rpc-log-debug R)
                  (if (io-error? R)
                      (begin
                        (set-%mzrpc-valid! handle #f)
                        (set-%mzrpc-diagnose! handle 'io-error)
                        (set-%mzrpc-message! handle "mzrpc: i/o error with host while writing.")
                        (rpc-log-error "Result of rpc call: io-error; message: " (%mzrpc-message handle))
                        '%rpc-error)
                      (begin
                        (let ((R (fifo-(%mzrpc-reader-fifo handle))))
                          (if (wrong-input? R)
                              (begin
                                (set-%mzrpc-valid! handle #f)
                                (set-%mzrpc-diagnose! handle 'io-error)
                                (set-%mzrpc-message! handle "mzrpc: i/o error with host while reading.")
                                (rpc-log-error "Result of rpc call: wrong-input; message: " (%mzrpc-message handle))
                                '%rpc-error)
                          (if (rpc-error? R)
                              (begin
                                (set-%mzrpc-diagnose! handle 'call-error)
                                (set-%mzrpc-message! handle (format "mzrpc: error returned from server: ~a" (rpc-error-message R)))
                                (rpc-log-error "Result of rpc call: rpc-error; message: " (%mzrpc-message handle))
                                '%rpc-error)
                              (rpc-de-marshal (rpc-value R)))))))))
              (error "mzrpc: invalid handle.")))
              
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; Exported stuff
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (spod-module-def)
        (spod-module-add (s= "rpc-client"))

        (define (reader handle)
          (let ((R (read* (%mzrpc-from-server handle))))
            (if (or (eof-object? R) (eq? R '%rpc-wrong-input%))
                (begin
                  (set-%mzrpc-valid! handle #f)
                  (set-%mzrpc-diagnose! handle 'io-error)
                  (set-%mzrpc-message! handle "reader thead: connection with server lost")
                  #f)
                (if (rpc-notify? R)
                    (let ((h (%mzrpc-notifications-handler handle)))
                      (if (procedure? h) (h (rpc-de-marshal (cadr R))))
                      (reader handle))
                    (begin
                      (fifo+ (%mzrpc-reader-fifo handle) R)
                      (reader handle))))))
        
        ;;;; * rpc-connect
        (spod-module-add (s=== "(rpc-connect  host port user pass notification-handler . pass-hasher) : rpc-handle")
                         (sp "Connects to host <host> on port <port> with account <user> and password <pass>")
                         (sp "The notification-handler must be #f if no notifications from the server are handled, otherwise "
                             "the notification handler must be a function of one argument. The server can send notifications "
                             "to clients. They depend on the server. The client can handle these notifications using the given "
                             "notification handler.")
                         (sp "The pass-hasher is a function that is called with a password and a chalenge. The function must "
                             "be used to hash the password and the chalenge together.")
                         (sp "This function tries to login right away. If the login fails, " (s% "rpc-valid?") " will return #f.")
                         (sp "The result of " (s% "rpc-connect") " is a handle. " (s% "rpc-valid?") " returns #t, if the handle "
                             "is valid, #f otherwise.")
                         )
        (define (rpc-connect host port user pass notification-handler . pass-hasher)
          (let ((hasher (if (null? pass-hasher)
                            (lambda (pass chalenge) pass))))
            (let ((handle (with-handlers ((exn:fail:network? (lambda (exn)
                                                               (make-%mzrpc #f
                                                                            (format "Cannot connect to host ~s on port ~s" host port)
                                                                            #f #f
                                                                            hasher
                                                                            notification-handler
                                                                            (fifo)
                                                                            #f
                                                                            'no-connect)) ))
                                       (call-with-values (lambda () (tcp-connect host port))
                                                         (lambda (from-server to-server)
                                                           (make-%mzrpc #t "" 
                                                                        from-server to-server 
                                                                        hasher 
                                                                        notification-handler
                                                                        (fifo)
                                                                        #f
                                                                        'ok
                                                                        ))))))
            (if (rpc-valid? handle)
                (begin
                  (let ((welcome (read* (%mzrpc-from-server handle))))
                    (set-%mzrpc-reader! handle (thread (lambda () (reader handle))))
                    (let ((chalenge (rpc-chalenge handle)))
                      (let ((R (rpc-call handle rpc-login user ((%mzrpc-hasher handle) pass chalenge))))
                        (if (not (eq? R #f))
                            handle
                            (begin
                              (set-%mzrpc-valid! handle #f)
                              (set-%mzrpc-diagnose! handle 'wrong-password)
                              (set-%mzrpc-message! handle (format "Cannot login for user ~s" user))
                              handle)))))))
            handle)))
        
        
        ;;;; * rpc-notifications-handler
        (spod-module-add (s=== "(rpc-notifications-handler handle F)")
                         (sp "Sets the notification handler for the given client handle to a new function.")
                         (sp "Returns handle."))
        (define (rpc-notifications-handler handle F)
          (set-%mzrpc-notifications-handler! handle F)
          handle)
        
        ;;;; * rpc-disconnect
        (spod-module-add (s=== "(rpc-disconnect handle)")
                         (sp "Disconnects from the mzrpc server.")
                         (sp "Returns 'io-error if a not valid handle is given, but closes the TCP connection, and"
                             "kills a started thread")
                         (sp "Returns 'disconnected"))
        (define (rpc-disconnect handle)
          (let ((R (if (rpc-valid? handle)
                       (let ((r (rpc-call handle rpc-end)))
                         (kill-thread (%mzrpc-reader handle))
                         'disconnected)
                       (begin
                         (if (not (eq? (%mzrpc-reader handle) #f ))
                             (kill-thread (%mzrpc-reader handle)))
                         'io-error))))
            (if (eq? (rpc-diagnose handle) 'no-connect)
                R
                (begin
                  (close-input-port (%mzrpc-from-server handle))
                  (close-output-port (%mzrpc-to-server handle))
                  R))))
        
        ;;;; * rpc-shutdown
        (spod-module-add (s=== "(rpc-shutdown handle)")
                         (sp "If the user is autorised to do so (i.e. has 'admin level), enables the user to "
                             "shutdown the server if no other clients are connected.")
                         (sp "Returns 'forbidden, if the user is not of autorisation type 'admin")
                         (sp "Returns 'clients-connected, if more than 1 client is connected.")
                         (sp "Returns 'io-error if a not valid handle is given, but closes the TCP connection")
                         (sp "Returns 'ok and shuts down the server, otherwise")
                         )
        (define (rpc-shutdown handle)
          (let ((R (if (rpc-valid? handle)
                       (let ((r (rpc-call handle rpc-shutdown)))
                         (kill-thread (%mzrpc-reader handle))
                         r)
                       'io-error)))
            (close-input-port (%mzrpc-from-server handle))
            (close-output-port (%mzrpc-to-server handle))
            R))
          
        ;;;; * rpc-force-shutdown
        (spod-module-add (s=== "(rpc-shutdown handle)")
                         (sp "If the user is autorised to do so (i.e. has 'admin level), enables the user to "
                             "shutdown the server if no other clients are connected.")
                         (sp "Returns 'forbidden, if the user is not of autorisation type 'admin")
                         (sp "Returns 'clients-connected, if more than 1 client is connected.")
                         (sp "Returns 'io-error if a not valid handle is given, but closes the TCP connection")
                         (sp "Returns 'ok and shuts down the server, otherwise"))
        (define (rpc-force-shutdown handle)
          (let ((R (if (rpc-valid? handle)
                       (let ((r (rpc-call handle rpc-force-shutdown)))
                         (kill-thread (%mzrpc-reader handle))
                         r)
                       'io-error)))
            (close-input-port (%mzrpc-from-server handle))
            (close-output-port (%mzrpc-to-server handle))
            R))
        
        ;;;; * rpc-chalenge
        (define (rpc-chalenge handle)
          (rpc-call handle rpc-chalenge))
        
        ;;;; * rpc-valid?
        (spod-module-add (s=== "(rpc-valid? handle)")
                         (sp "Returns #t, if the handle is valid.")
                         (sp "Returns #f, otherwise."))
        (define (rpc-valid? handle)
          (%mzrpc-valid handle))
        
        ;;;; * rpc-diagnose
        (spod-module-add (s=== "(rpc-diagnose handle)")
                         (sp "Returns 'no-connect, if the server could not be connected (on the tcp/ip level)")
                         (sp "Returns 'wrong-password, if one cannot login with the given user (on mzrpc level)")
                         (sp "Returns 'io-error, if an io-error occured during operation (on the tcp/ip level)")
                         (sp "Returns 'call-error, if an error occured during a call to the server (on the rpc level)")
                         (sp "Returns 'ok, if nothing is wrong"))
        (define (rpc-diagnose handle)
          (%mzrpc-diagnose handle))
        
        ;;;; * rpc-message
        (spod-module-add (s=== "(rpc-message handle)")
                         (sp "Returns the last error message associated with the handle."))
        (define (rpc-message handle)
          (%mzrpc-message handle))
        
        ;;;; * rpc-symbol-call
        (spod-module-add (s=== "(rpc-symbol-call handle f:symbol ...)")
                         (sp "RPCs function f with arguments ...")
                         (sp "Returns whatever f would return if no error occured.")
                         (sp "Returns '%rpc-error, if an error is returned (wrong function call).")
                         (sp "Returns '%rpc-fatal, if a problem some other problem has occured, handle will have been invalidated.")
                         (sp "Raises an error if called with an invalid handle."))
        (define (rpc-symbol-call handle f . args)
          (internal-rpc-call handle f args))
        
        ;;;; * rpc-call
        (spod-module-add (s=== "(rpc-call handle f ...)")
                         (sp "Scheme syntax that calls " (s% "rpc-symbol-call") " with 'f."))
        (define-syntax rpc-call
          (syntax-rules ()
            ((_ handle f)
             (rpc-symbol-call handle 'f))
            ((_ handle f a1 ...)
             (rpc-symbol-call handle 'f a1 ...))))
        
        ;;;; * rpc-connected
        (spod-module-add (s=== "(rpc-connected handle)")
                         (sp "Returns the number of clients connected to the server."))
        (define (rpc-connected handle)
          (rpc-call handle rpc-connected))
        
        ;;;; * rpc-global-connect
        (spod-module-add (s=== "(rpc-global-connect host port user pass notification-handler . pass-hasher) : handle")
                         (sp "Calls " (s% "rpc-connect") " and sets the global handler for this program to the returned handle.")
                         (sp "Returns the global handle."))
        (define (rpc-global-connect . args)
          (set! GLOBAL-CLIENT-HANDLE (apply rpc-connect args))
          GLOBAL-CLIENT-HANDLE)
        
        ;;;; * rpc-global-handle
        (spod-module-add (s=== "(rpc-global-handle)")
                         (sp "Returns the current global RPC handle (or #f if no global handle is set)."))
        (define (rpc-global-handle)
          GLOBAL-CLIENT-HANDLE)
        
        ;;;; * rpc-global-disconnect
        (spod-module-add (s=== "(rpc-global-disconnect)")
                         (sp "Calls rpc-disconnect with the global handle from the mzrpc server."))
        (define (rpc-global-disconnect)
          (rpc-disconnect GLOBAL-CLIENT-HANDLE))
        
        ;;;; * rpc-global-handle!
        (spod-module-add (s=== "(rpc-global-handle! handle)")
                         (sp "(Re)set the global handle to <handle>")
                         (sp "Returns handle."))
        (define (rpc-global-handle! h)
          (set! GLOBAL-CLIENT-HANDLE h)
          h)
        
        ;;;; * rpc-client-define
        (spod-module-add (s=== "(rpc-client-define)")
                         (sp "The same as define, but defines an rpc function that uses the "
                             "global client handler for calling the equivalent with " (s% "rpc-define") " "
                             "defined function at the server side."))
        (define-syntax rpc-client-define
          (syntax-rules ()
            ((_ (f))
             (define (f)
               (rpc-symbol-call GLOBAL-CLIENT-HANDLE 'f)))
            ((_ (f a1 ...))
             (define (f a1 ...)
               (rpc-symbol-call GLOBAL-CLIENT-HANDLE 'f a1 ...)))
            ))
        
        
        ;;;; * rpc-local-define
        (spod-module-add (s=== "(rpc-local-define)")
                         (sp "The same as define, but defines an rpc function that uses a local "
                             "client handler for calling the equivalent with " (s% "rpc-define") " "
                             "defined function at the server side.")
                         (sp "Example: ")
                         (ssyn "scm" 8)
                         (sp " (rpc-local-define (rpc-plus a b))\n"
                             " (let ((handle (rpc-connect \"server.server.org\" 4304 \"user\" \"pass\" #f)))\n"
                             "    (display (format \"~a~%\" (rpc-plus handle 3 4))\n" 
                             "    (rpc-disconnect handle))"))
        (define-syntax rpc-local-define
          (syntax-rules (handle)
            ((_ (f))
             (define (f handle)
               (rpc-symbol-call handle 'f)))
            ((_ (f a1 ...))
             (define (f handle a1 ...)
               (rpc-symbol-call handle 'f a1 ...)))
            ))

        ;;;; * rpc-client-documentation
        (define %module-doc (spod-module-doc))
        (define (rpc-client-documentation)
          %module-doc)
        
        
        );;;; module-end