(use extras dbus)

(define udisks-context
  (make-context
   bus: system-bus
   interface: 'org.freedesktop.UDisks
   service: 'org.freedesktop.UDisks
   path: '/org/freedesktop/UDisks))

;; This works
;; (print (call udisks-context "EnumerateDevices"))

(enable-polling-thread! bus: system-bus)

(register-method udisks-context "DeviceAdded"
                 (lambda args
                   (printf "DeviceAdded args: ~S" args)))

(poll-for-message bus: system-bus)


;; $ csi -s udisks.scm
;;
;; Error: (assq) bad argument type: #f
;;
;;         Call history:
;;
;;         <syntax>          (##core#quote org.freedesktop.UDisks)
;;         <syntax>          (quote org.freedesktop.UDisks)
;;         <syntax>          (##core#quote org.freedesktop.UDisks)
;;         <syntax>          (quote /org/freedesktop/UDisks)
;;         <syntax>          (##core#quote /org/freedesktop/UDisks)
;;         <eval>    (make-context bus: system-bus interface: (quote org.freedesktop.UDisks) service: (quote org.freedesk......
;;         <syntax>          (enable-polling-thread! bus: system-bus)
;;         <eval>    (enable-polling-thread! bus: system-bus)
;;         <syntax>          (register-method udisks-context "DeviceAdded" (lambda args (printf "DeviceAdded args: ~S" args)))
;;         <syntax>          (lambda args (printf "DeviceAdded args: ~S" args))
;;         <syntax>          (##core#lambda args (printf "DeviceAdded args: ~S" args))
;;         <syntax>          (##core#begin (printf "DeviceAdded args: ~S" args))
;;         <syntax>          (printf "DeviceAdded args: ~S" args)
;;         <eval>    (register-method udisks-context "DeviceAdded" (lambda args (printf "DeviceAdded args: ~S" args)))
;;         <syntax>          (poll-for-message bus: system-bus)
;;         <eval>    (poll-for-message bus: system-bus)    <--

$ csi -s udisks.scm

Error: (assq) bad argument type: #f

        Call history:

        dbus.scm:809: ##sys#gc    
        dbus.scm:832: g1354       
        dbus.scm:201: find-callback       
        dbus.scm:674: ##sys#peek-c-string         
        dbus.scm:689: string?->symbol     
        dbus.scm:245: string->symbol      
        dbus.scm:677: ##sys#peek-c-string         
        dbus.scm:690: string?->symbol     
        dbus.scm:245: string->symbol      
        dbus.scm:680: ##sys#peek-c-string         
        dbus.scm:691: string?->symbol     
        dbus.scm:245: string->symbol      
        dbus.scm:686: ##sys#peek-c-string         
        dbus.scm:692: string?->symbol     
        dbus.scm:245: string->symbol      
        dbus.scm:701: tassq             <--

(use extras dbus)

;; dbus returns #(#<unsupported-type >) to represent empty container
;; values
(define (empty-dbus-value? val)
  (and (vector? val)
       (> (vector-length val) 0)
       (unsupported-type? (vector-ref val 0))))


(define (dbus-value property properties)
  (let ((val (alist-ref property properties equal?)))
    (cond ((empty-dbus-value? val)
           value-not-set)
          ((variant? val)
           (let ((data (variant-data val)))
             (if (empty-dbus-value? data)
                 value-not-set
                 data)))
          (else val))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define udisks-context
  (make-context
   bus: system-bus
   interface: 'org.freedesktop.UDisks
   service: 'org.freedesktop.UDisks
   path: '/org/freedesktop/UDisks))

(define (handle-new-device object-path)
  (let* ((dev-ctx (make-context
                   bus: system-bus
                   interface: 'org.freedesktop.DBus.Properties
                   service: 'org.freedesktop.UDisks
                   path: (object-path->string object-path)))
         (props/vals
          (vector->list
           (car (call dev-ctx "GetAll" "org.freedesktop.UDisks.Device"))))
         (drive-model (dbus-value "DriveModel" props/vals))
         (device-file (dbus-value "DeviceFile" props/vals))
         (removable? (dbus-value "DeviceIsRemovable" props/vals))
         (fs? (dbus-value "IdUsage" props/vals))
         (fs-type (dbus-value "IdType" props/vals))
         (media-available? (dbus-value "DeviceIsMediaAvailable" props/vals))
         (partition? (dbus-value "DeviceIsPartition" props/vals))
         (partition-label (dbus-value "PartitionLabel" props/vals))
         (partition-number (dbus-value "PartitionNumber" props/vals)))

    (print "====================================================================================")
    (pp `((drive-model ,drive-model)
          (device-file ,device-file)
          (removable?  ,removable?)
          (fs?         ,fs?)
          (fs-type     ,fs-type)
          (media-available? ,media-available?)
          (partition?  ,partition?)
          (partition-label ,partition-label)
          (partition-number ,partition-number)))
    (print "====================================================================================")
    ))


(register-signal-handler udisks-context
                         "DeviceAdded"
                         handle-new-device)

(enable-polling-thread! bus: system-bus enable: #f)

(let loop ()
  (poll-for-message bus: system-bus timeout: 100)
  (loop))