What: dbus
Where: https://chiselapp.com/user/schelte/repository/dbus 
Description: The DBus project provides a Tcl interface to the dbus message
        bus system. It allows Tcl programs to send and receive dbus signals,
        as well as invoke and respond to dbus method calls.
Updated: 01/2018
Contact: Schelte Bron

package require dbus
dbus connect
dbus call -dest org.freedesktop.Notifications /org/freedesktop/Notifications \
        org.freedesktop.DBus.Introspectable Introspect

    <method name="Notify">
      <annotation value="QVariantMap" name="com.trolltech.QtDBus.QtTypeName.In6"/>
      <arg direction="out" type="u"/>
      <arg direction="in" type="s" name="app_name"/>
      <arg direction="in" type="u" name="replaces_id"/>
      <arg direction="in" type="s" name="app_icon"/>
      <arg direction="in" type="s" name="summary"/>
      <arg direction="in" type="s" name="body"/>
      <arg direction="in" type="as" name="actions"/>
      <arg direction="in" type="a{sv}" name="hints"/>
      <arg direction="in" type="i" name="timeout"/>
    </method>

dbus call -dest org.freedesktop.Notifications -signature susssasa{sv}i \
        /org/freedesktop/Notifications org.freedesktop.Notifications Notify \
        "My App" 0 "" "Message" "Hello, World!" {} {} -1

[D-BUS Service]
Name=tk.tcl.wiki.foo
Exec=/usr/local/bin/foo.tcl

<!DOCTYPE busconfig PUBLIC "-//freedesktop//DTD D-BUS Bus Configuration 1.0//EN"
 "http://www.freedesktop.org/standards/dbus/1.0/busconfig.dtd">
<busconfig>
  <!-- User userid can own this service -->
  <policy user="userid">
    <allow own="tk.tcl.wiki.foo"/>
  </policy>

  <policy context="default">
    <allow send_interface="tk.tcl.wiki.foo"/>
    <allow receive_interface="tk.tcl.wiki.foo"/>
    <!-- Allow introspection -->
    <allow send_destination="tk.tcl.wiki.foo"
           send_interface="org.freedesktop.DBus.Introspectable"/>
  </policy>
</busconfig>

set serial [dbus call session -details \
    -handler result \
    -dest org.freedesktop.DBus \
    /org/freedesktop/DBus \
    org.freedesktop.DBus ListNames \
    ]

set serial [dbus call session -details \
    -dest org.mpris.MediaPlayer2.vlc \
    -signature ssv \
    -handler result \
    /org/mpris/MediaPlayer2 \
    org.freedesktop.DBus.Properties Set \
    org.mpris.MediaPlayer2.Player Volume \
    [list d $vol] \
    ]

package require dbus

# connect to the system bus
dbus connect system

# instrospect net.hadess.SensorProxy interface
dbus call system -dest net.hadess.SensorProxy \
          /net/hadess/SensorProxy \
          org.freedesktop.DBus.Introspectable \
          Introspect

# determine if accelermeter is supported (return a boolean value 0/1)
dbus call system -dest net.hadess.SensorProxy \
          /net/hadess/SensorProxy \
          org.freedesktop.DBus.Properties \
          Get "net.hadess.SensorProxy" "HasAccelerometer"

# listen to PropertiesChanged signal
proc handler {desc args} {
    puts $desc
    puts $args
}

# filter events and register a handler to be called on PropertiesChanged signal
dbus filter system add -interface org.freedesktop.DBus.Properties
dbus listen system /net/hadess/SensorProxy PropertiesChanged handler

# allow iio-sensor-proxy layer to send accelerometer events
dbus call system -dest net.hadess.SensorProxy \
          /net/hadess/SensorProxy \
          net.hadess.SensorProxy \
          ClaimAccelerometer

# if not in a Tk app, wait for events
vwait forever

# disable the sending of events from accelerometer
dbus call system -dest net.hadess.SensorProxy \
          /net/hadess/SensorProxy \
          net.hadess.SensorProxy \
          ReleaseAccelerometer

# unregister the handler
dbus listen system /net/hadess/SensorProxy PropertiesChanged {}

# introspect the interface
dbus call system -dest org.freedesktop.UPower \
          /org/freedesktop/UPower \
          org.freedesktop.DBus.Introspectable \
          Introspect

# Enumerates power devices
dbus call system -dest org.freedesktop.UPower \
          /org/freedesktop/UPower \
          org.freedesktop.UPower \
          EnumerateDevices

proc handler {desc args} {
    puts $desc
    puts $args
}

dbus filter system add -interface org.freedesktop.DBus.Properties
dbus listen system /org/freedektop/UPower PropertiesChanged handler

#! tclsh

package require dbus

set last_orientation        normal

proc handler {desc args} {
  if {[lindex $args 0] == "net.hadess.SensorProxy"} {
    if {[lindex $args {1 0}] == "AccelerometerOrientation"} {
      set orientation [lindex $args {1 1}]
      if {$orientation != $::last_orientation} {
        if {$orientation == "normal"} {
          puts "normal"
        } elseif {$orientation == "right-up"} {
          puts "right-up"
        } elseif {$orientation == "left-up"} {
          puts "left-up"
        } elseif {$orientation == "bottom-up"} {
          puts "bottom-up"
        }
        set ::last_orientation $orientation
      }
    }
  } elseif {[lindex $args 0] == "org.freedesktop.UPower"} {
    if {[lindex $args {1 0}] == "LidIsClosed"} {
      if {[lindex $args {1 1}] == 1} {
        puts "Lid closed"
      } else {
        puts "Lid opened"
      }
    } elseif {[lindex $args {1 0}] == "OnBattery"} {
      puts "on battery: [lindex $args {1 1}]"
    }
  }
}

dbus connect system

if {![dbus call system -dest net.hadess.SensorProxy \
                /net/hadess/SensorProxy \
                org.freedesktop.DBus.Properties\
                Get "net.hadess.SensorProxy" "HasAccelerometer"]} {
        puts "No accelerometer available"
        exit
}

puts "has accelerometer"

# listen to ChangedProperties events
dbus filter system add -interface org.freedesktop.DBus.Properties
dbus listen system /org/freedesktop/UPower PropertiesChanged handler
dbus listen system /net/hadess/SensorProxy PropertiesChanged handler
dbus call system -dest net.hadess.SensorProxy \
          /net/hadess/SensorProxy \
          net.hadess.SensorProxy \
          ClaimAccelerometer

vwait forever

# SPP echo server and client using dbus interface.
#
# Command line: <this-script> ?<MAC-address>? ?<BT-adapter>?
#
# If <MAC-address> omitted, become server, else try to connect
# to Serial Port Profile (SPP) on <MAC-address> using dbus.
#
# <BT-adapter> can be specified in cases when the connection
# shall go over another Bluetooth adapter than "hci0".
#
# The participating Bluetooth devices must have been paired and
# authorized in the systems' Bluetooth settings.
#
# Since we are using the system DBus, we need a configuration in
# "/etc/dbus-1/system.d/org.bluez.SerialPort.conf":
#
# <!DOCTYPE busconfig PUBLIC
#  "-//freedesktop//DTD D-BUS Bus Configuration 1.0//EN"
#  "http://www.freedesktop.org/standards/dbus/1.0/busconfig.dtd">
# <busconfig>
#   <policy group="bluetooth">
#     <allow own="org.bluez.SerialPort"/>
#     <allow send_destination="org.bluez.SerialPort"/>
#     <allow send_interface="org.bluez.SerialPort"/>
#   </policy>
# </busconfig>
#
# It might work partially without this configuration, though.

package require dbus
package require dbif

# UUID for Serial Port Profile (SPP).
set SPP_UUID 00001101-0000-1000-8000-00805f9b34fb

# Get destination MAC address, if any.
set MAC {}
if {[llength $argv] > 0} {
    set MAC [apply {{arg} {
        set ret {}
        if {[scan $arg %x:%x:%x:%x:%x:%x a b c d e f] == 6} {
            set a [expr {$a & 0xff}]
            set b [expr {$b & 0xff}]
            set c [expr {$c & 0xff}]
            set d [expr {$d & 0xff}]
            set e [expr {$e & 0xff}]
            set f [expr {$f & 0xff}]
            lappend ret [format %02X:%02X:%02X:%02X:%02X:%02X $a $b $c $d $e $f]
            lappend ret [format %02X_%02X_%02X_%02X_%02X_%02X $a $b $c $d $e $f]
        }
        return $ret
    }} [lindex $argv 0]]
}

# Set Bluetooth adapter.
set HCI hci0
if {[llength $argv] > 1} {
    set HCI [lindex $argv 1]
}

# Read file handler for SPP (rfcomm) socket providing "echo" semantics.
# Although we deal with an rfcomm socket we get it passed in from dbus
# as a Tcl file channel.
proc echo_service {obj} {
    set sock $::SOCK($obj)
    set close 0
    if {[catch {chan gets $sock line} count]} {
        incr close
    } elseif {$count < 0} {
        if {[chan eof $sock]} {
            incr close
        } else {
            return
        }
    } elseif {[catch {chan puts $sock $line}]} {
        incr close
    }
    if {$close} {
        chan close $sock
        unset ::SOCK($obj)
    }
}

# Restore blocking mode of standard input.
proc reset_stdin {} {
    catch {chan configure stdin -blocking $::STDIN_BLOCKING}
}

# Read lines from standard input and write to SPP (rfcomm) socket.
proc input {obj} {
    set sock $::SOCK($obj)
    set close 0
    if {[catch {chan gets stdin line} count]} {
        incr close 2
    } elseif {$count < 0} {
        if {[chan eof stdin]} {
            incr close
        } else {
            return
        }
    } elseif {[catch {chan puts $sock $line}]} {
        incr close 2
    }
    if {$close} {
        chan close $sock
        unset ::SOCK($obj)
        incr close -1
        reset_stdin
        exit $close
    }
}

# Read lines from SPP (rfcomm) socket and write to standard output.
proc output {obj} {
    set sock $::SOCK($obj)
    set close 0
    if {[catch {chan gets $sock line} count]} {
        puts stderr "Error: $count"
        incr close
    } elseif {$count < 0} {
        if {[chan eof stdin]} {
            puts stderr "EOF on socket"
            incr close
        } else {
            return
        }
    } elseif {[catch {puts $line} err]} {
        puts stderr "Error: $err"
        incr close
    }
    if {$close} {
        chan close $sock
        unset ::SOCK($obj)
        reset_stdin
        exit 1
    }
}

# Give up due to connect timeout.
proc timeout {} {
    puts "timeout."
    flush stdout
    reset_stdin
    exit 1
}

# Tclx signal handler for SIGINT.
proc sigint {} {
    reset_stdin
    exit 1
}

# Callback for ConnectProfile dbus method.
proc on_connect {msg args} {
    if {[dict get $msg messagetype] eq "error"} {
        puts "failed."
        flush stdout
        puts stderr "Error: [lindex $args 0]"
        reset_stdin
        exit 1
    }
}

# Array to keep track of SPP (rfcomm) sockets.
array set SOCK {}

# Use system dbus.
set BUS [dbus connect system]

# Provide service "tk.tcl.SerialPort" on system dbus.
set NAME [dbif connect -bus $BUS -yield -replace -noqueue tk.tcl.SerialPort]
if {$NAME eq {}} {
    puts stderr "WARNING: 'tk.tcl.SerialPort' not registered in system dbus"
}

# Watch out for new service instance.
dbif listen -bus $BUS -interface [dbus info service] \
    [dbus info path] NameLost name {
        if {$name eq "tk.tcl.SerialPort"} {
            foreach {k v} [array get ::SOCK] {
                catch {chan close $v}
            }
            reset_stdin
            exit
        }
    }

# New SPP connection coming in. Parameters are the dbus object,
# the socket handle (wrapped into a Tcl file channel), and an
# array of additional properties.
dbif method -bus $BUS -interface org.bluez.Profile1 \
    /tk/tcl/SerialPort NewConnection {obj:o sock:h props:a{sv}} {} {
        set ::SOCK($obj) $sock
        chan configure $sock -blocking 0 -buffering line
        if {$::MAC ne {}} {
            after cancel timeout
            puts "success."
            puts "Input lines of text; exit program with <Ctrl-D>.\n"
            flush stdout
            chan event $sock readable [list output $obj]
            # Remember blocking mode of standard input.
            set ::STDIN_BLOCKING [chan configure stdin -blocking]
            catch {
                package require Tclx
                signal trap SIGINT sigint
            }
            chan configure stdin -blocking 0 -buffering line
            chan event stdin readable [list input $obj]
        } else {
            chan event $sock readable [list echo_service $obj]
        }
    }

# Disconnect an SPP connection.
dbif method -bus $BUS -interface org.bluez.Profile1 \
    /tk/tcl/SerialPort RequestDisconnect {obj:o} {} {
        if {[info exists ::SOCK($obj)]} {
            catch {chan close $::SOCK($obj)}
            unset ::SOCK($obj)
        }
    }

# Register SPP and our service in profile manager.
dbus call $BUS -dest org.bluez -signature osa{sv} \
    /org/bluez org.bluez.ProfileManager1 RegisterProfile \
    /tk/tcl/SerialPort $SPP_UUID \
    [dict create AutoConnect [list b 1] \
         Name [list s SerialPort] \
         Channel [list q 1] \
         RequireAuthentication [list b 0] \
         RequireAuthorization [list b 0] \
         Service [list s $SPP_UUID]]

# Wait a while in case other instance need be torn down.
after 500
# When MAC address specified we need to initiate a connection.
if {$MAC ne {}} {
    # Try to connect to remote SPP service.
    puts -nonewline "Connecting to [lindex $MAC 0] ... "
    flush stdout
    if {[catch {
            dbus call $BUS -timeout 9000 -dest org.bluez -signature s \
                -handler on_connect \
                /org/bluez/${HCI}/dev_[lindex $MAC 1] org.bluez.Device1 \
                ConnectProfile $SPP_UUID
    } err]} {
        puts "failed."
        flush stdout
        puts stderr $err
        exit 1
    }
    # But arrange for extra timeout handling.
    after 10000 timeout
}

# Event loop.
vwait forever