Re: [Chicken-users] Re: fatal bug in xml-rpc

[felix winkelmann]

On 12/5/06, Daishi Kato <address@hidden> wrote:
> Hi,
>
> Unfortunately, something keeps me raise an error.

Does this work?

(define (add-rpc-resource url)
 (set! rpc-url-list (cons url rpc-url-list))
 (http:add-resource
  url
  (lambda (r _)
    (let* ([data (http:request-body r)]
            [data (if (string? data)
                      (with-input-from-string data (cut SSAX:XML->SXML
(current-input-port) '()))
                      data) ] )
      (handle-exceptions ex
           (write-fault-response ex)
         (match data
vvvvvvv
           [(or `(*TOP* (*PI*  . _) (|methodCall| ,mname . ,params))
                `(*TOP* (|methodCall| ,mname . ,params)) )
^^^^^^
            (match mname
              [`(|methodName| ,name)
               (let* ([url (http:request-url r)]
                      [m (lookup-method name url)] )
                 (if m
                     (match params
                       [`((params (param ,x) ...))
                        (receive results (call-proc m (map 
xml-rpc:unmarshall-value x))
                          (write-result-response results) ) ]
                       [()
                        (receive results (call-proc m '())
                          (write-result-response results) ) ]
                       [r (xml-rpc:error invalid-parameter-format-code "invalid
parameter format" r)] )
                     (write-undefined-method-response name) ) ) ]
              [r (xml-rpc:error invalid-rpc-format-code "invalid rpc format" 
r)] ) ]
           [r (xml-rpc:error invalid-rpc-format-code "invalid rpc format" r)]
) ) ) ) ) )


cheers,
felix


--
http://galinha.ucpel.tche.br:8081/blog/blog.ssp