logging added.

service.rkt

@@ -7,6 +7,7 @@
 ;; services and actions.
 
 (require net/http-client
+         simple-log
          net/url
          racket/list
          racket/port
@@ -15,6 +16,8 @@
          "private/model.rkt"
          "private/xml.rkt")
 
+(sl-def-log upnp-soap)
+
 (provide upnp-service?
          upnp-service-kind
          upnp-service-type
@@ -151,6 +154,7 @@
           services))))
 
 (define (read-xml-url location)
+  (dbg-upnp-soap "Reading UPnP XML description from ~a" location)
   (call/input-url
    (string->url location)
    (lambda (url)
@@ -159,6 +163,7 @@
      (xml->xexpr (document-element (read-xml in))))))
 
 (define (read-service-actions service)
+  (dbg-upnp-soap "Reading actions for service ~a" (upnp-service-service-type service))
   (let ([location (upnp-service-scpd-url service)])
     (unless location
       (raise-arguments-error 'upnp-service-actions
@@ -184,6 +189,7 @@
                service
                (lambda ()
                  (let ([actions (read-service-actions service)])
+                   (dbg-upnp-soap "Caching ~a actions for service ~a" (length actions) (upnp-service-service-type service))
                    (hash-set! action-cache service actions)
                    actions))))))
 
@@ -291,6 +297,7 @@
         (raise-arguments-error 'upnp-service-call
                                "controlURL has no host"
                                "controlURL" control-url))
+      (dbg-upnp-soap "SOAP request action=~a service=~a control-url=~a arguments=~s bytes=~a" action-name service-type control-url arguments (bytes-length body))
       (let-values ([(status response-headers in)
                     (http-sendrecv host
                                    (url-request-target url-value)
@@ -299,9 +306,10 @@
                                    #:method #"POST"
                                    #:headers headers
                                    #:data body)])
-        (values (http-status-code status)
-                response-headers
-                (read-response-body in))))))
+        (let ([code (http-status-code status)]
+              [response-body (read-response-body in)])
+          (dbg-upnp-soap "SOAP response action=~a status=~a bytes=~a" action-name code (bytes-length response-body))
+          (values code response-headers response-body))))))
 
 (define (bytes->xexpr body)
   (call-with-input-bytes
@@ -318,6 +326,7 @@
             (and description-element (xexpr-text description-element #f)))))
 
 (define (raise-upnp-error service action code description)
+  (err-upnp-soap "UPnP action ~a failed, code=~a, description=~a, service=~a" action (or code "unknown") (or description "unknown") (upnp-service-service-type service))
   (raise
    (exn:fail:upnp
     (format "UPnP action ~a failed~a: ~a"
@@ -377,6 +386,7 @@
                   (send-soap-request service action-name arguments)])
       (cond
         [(and status (<= 200 status 299))
+         (dbg-upnp-soap "UPnP action ~a completed successfully" action-name)
          (if (zero? (bytes-length body))
              (hash)
              (response-result (bytes->xexpr body) service action-name))]