Changeset 15664 in project


Ignore:
Timestamp:
08/31/09 08:12:56 (10 years ago)
Author:
felix
Message:

rpc server handles eof more gracefully

Location:
release/4/rpc
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/rpc/client.scm

    r15650 r15664  
    55
    66(define call (rpc:procedure 'foo "localhost"))
    7 (define fini (rpc:procedure 'fini "localhost"))
    87
    98(do ((i 10 (sub1 i)))
     
    1110  (print "-> " (call (random 100))))
    1211
    13 (fini)
    14 
    15 (sleep 3)
  • release/4/rpc/doc.scm

    r15650 r15664  
    1313     (author (url "http://www.chust.org/" "Thomas Chust"))
    1414     (history
     15      (version "1.1.1" "handles eof from client in persistent connection (felix)")
    1516      (version "1.1.0" "ported to CHICKEN 4 by felix")
    1617      (version "1.0.0" "Initial release"))
  • release/4/rpc/rpc.scm

    r15650 r15664  
    166166        (project 1)))
    167167     (let loop ()
    168        (let ((req (deserialize)))
    169          (unless (eq? req (void))
    170            (match req
    171              (('call name . params)
    172                (handle-exceptions ex
    173                    (serialize (cons 'exception ex))
    174                  (let* ((p (with-mutex name->procedure-map n->p
    175                              (hash-table-ref
    176                               n->p name
    177                               (lambda ()
    178                                 (signal
    179                                  (make-composite-condition
    180                                   (make-property-condition
    181                                    'exn
    182                                    'message "no such public procedure"
    183                                    'location 'rpc:server
    184                                    'arguments (list name))
    185                                   (make-property-condition
    186                                    'rpc)))))))
    187                         (o (open-output-string))
    188                         (e (open-output-string))
    189                         (r
    190                          (parameterize ((current-input-port
    191                                          (make-input-port
    192                                           (constantly #!eof)
    193                                           (constantly #f)
    194                                           void
    195                                           (constantly #!eof)))
    196                                         (current-output-port o)
    197                                         (current-error-port e))
    198                            (receive (apply p params)))))
    199                    (serialize
    200                     (append
    201                      (list
    202                       'results
    203                       (get-output-string o) (get-output-string e))
    204                      r)))))
    205              (any
    206               (signal
    207                (make-composite-condition
    208                 (make-property-condition
    209                  'exn
    210                  'message "request from RPC client not understood"
    211                  'location 'rpc:server
    212                  'arguments (list any))
    213                 (make-property-condition
    214                  'rpc)))))
    215            (loop)))))))
     168       (unless (eof-object? (peek-char))
     169         (let ((req (deserialize)))
     170           (unless (eq? req (void))
     171             (match req
     172               (('call name . params)
     173                (handle-exceptions ex
     174                    (serialize (cons 'exception ex))
     175                  (let* ((p (with-mutex name->procedure-map n->p
     176                                        (hash-table-ref
     177                                         n->p name
     178                                         (lambda ()
     179                                           (signal
     180                                            (make-composite-condition
     181                                             (make-property-condition
     182                                              'exn
     183                                              'message "no such public procedure"
     184                                              'location 'rpc:server
     185                                              'arguments (list name))
     186                                             (make-property-condition
     187                                              'rpc)))))))
     188                         (o (open-output-string))
     189                         (e (open-output-string))
     190                         (r
     191                          (parameterize ((current-input-port
     192                                          (make-input-port
     193                                           (constantly #!eof)
     194                                           (constantly #f)
     195                                           void
     196                                           (constantly #!eof)))
     197                                         (current-output-port o)
     198                                         (current-error-port e))
     199                            (receive (apply p params)))))
     200                    (serialize
     201                     (append
     202                      (list
     203                       'results
     204                       (get-output-string o) (get-output-string e))
     205                      r)))))
     206               (any
     207                (signal
     208                 (make-composite-condition
     209                  (make-property-condition
     210                   'exn
     211                   'message "request from RPC client not understood"
     212                   'location 'rpc:server
     213                   'arguments (list any))
     214                  (make-property-condition
     215                   'rpc)))))
     216             (loop))))))) )
    216217
    217218)
  • release/4/rpc/rpc.setup

    r15650 r15664  
    55  'rpc
    66  `("rpc.scm" "rpc.so" "rpc.import.so")
    7   '((version "1.1.0")
     7  '((version "1.1.1")
    88    (documentation "rpc.html")))
Note: See TracChangeset for help on using the changeset viewer.