Changeset 30987 in project


Ignore:
Timestamp:
06/08/14 14:57:46 (6 years ago)
Author:
ecloud
Message:

applied Mario Goulart's patch for error handling in the call method

https://github.com/OSSystems/meta-chicken/blob/master/recipes-chicken/chicken-egg/chicken-egg-dbus-0.92/dbus-error-handling.patch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/dbus/trunk/dbus.scm

    r30440 r30987  
    339339        (define make-message (foreign-lambda message-ptr "dbus_message_new_method_call"
    340340                c-string c-string c-string c-string))
     341
     342        (define make-error
     343                (foreign-lambda* (c-pointer (struct "DBusError")) ()
     344                         "DBusError err;
     345        dbus_error_init(&err);
     346        C_return(&err);"))
     347
     348        (define free-error!
     349                (foreign-lambda* void (((c-pointer (struct "DBusError")) err))
     350                        "dbus_error_free(err);"))
     351
     352        (define (raise-dbus-error location err)
     353                (let ((err-name
     354                                         ((foreign-lambda* c-string (((c-pointer (struct "DBusError")) err))
     355                                                        "C_return(err->name);")
     356                                                err))
     357                                        (err-message
     358                                         ((foreign-lambda* c-string (((c-pointer (struct "DBusError")) err))
     359                                                        "C_return(err->message);")
     360                                                err)))
     361                        (free-error! err)
     362                        (signal
     363                         (make-composite-condition
     364                                (make-property-condition 'dbus-call)
     365                                (make-property-condition 'exn
     366                                                                                                                                 'location location
     367                                                                                                                                 'message (string-append "(" err-name "): " err-message))
     368                                ))))
     369
     370
     371        (define make-error
     372                (foreign-lambda* (c-pointer (struct "DBusError")) ()
     373                 "DBusError err;
     374                  dbus_error_init(&err);
     375                  C_return(&err);"))
     376
     377        (define free-error!
     378                (foreign-lambda* void (((c-pointer (struct "DBusError")) err))
     379                        "dbus_error_free(err);"))
     380
     381        (define (raise-dbus-error location err)
     382                (let ((err-name
     383                        ((foreign-lambda* c-string (((c-pointer (struct "DBusError")) err))
     384                                          "C_return(err->name);")
     385                         err))
     386                      (err-message
     387                       ((foreign-lambda* c-string (((c-pointer (struct "DBusError")) err))
     388                                         "C_return(err->message);")
     389                        err)))
     390                  (free-error! err)
     391                  (signal
     392                   (make-composite-condition
     393                    (make-property-condition 'dbus-call)
     394                    (make-property-condition
     395                     'exn
     396                     'location location
     397                     'message (string-append "(" err-name "): " err-message))))))
    341398
    342399        ;; todo: garbage-collect this
     
    680737                                        (iter-append-basic iter parm))  params)
    681738                                (free-iter iter)
    682                                 (and-let* ([reply-msg ((foreign-lambda* message-ptr ((connection-ptr conn) (message-ptr msg))
    683                                                         ;; idealistic code here; todo: error checking
     739                                (and-let* ([err (make-error)]
     740                                                [reply-msg ((foreign-lambda* message-ptr ((connection-ptr conn) (message-ptr msg)
     741                                                                        ((c-pointer (struct "DBusError")) err))
    684742                                                        ;; todo: timeout comes from where?  (make-parameter) maybe
    685743                                                        "DBusMessage *reply;
    686                                                         DBusError error;
    687                                                         dbus_error_init (&error);
    688                                                         reply = dbus_connection_send_with_reply_and_block(conn, msg, 5000, &error);
    689                                                         if (dbus_error_is_set (&error))
    690                                                                 fprintf (stderr, \"Error %s: %s\\n\", error.name, error.message);
    691                                                         else
    692                                                                 fprintf (stderr, \"reply signature %s\\n\", dbus_message_get_signature(reply));
     744                                                        reply = dbus_connection_send_with_reply_and_block(conn, msg, 5000, err);
    693745                                                        dbus_message_unref(msg);
    694                                                         C_return(reply);") conn msg) ]
    695                                                 [reply-iter (make-iter reply-msg)]
    696                                                 [reply-args (iter->list reply-iter)] )
    697                                         reply-args)))))
     746                                                        C_return(reply);") conn msg err) ])
     747                                        (if reply-msg
     748                                                        (let* ([reply-iter (make-iter reply-msg)]
     749                                                                                 [reply-args (iter->list reply-iter)] )
     750                                                                reply-args)
     751                                                        (raise-dbus-error 'call err)))))))
     752
    698753
    699754        (set! make-method-proxy (lambda (context name)
Note: See TracChangeset for help on using the changeset viewer.