Tcl DBus Interface

Check-in [70d7950f3e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix error when a method deletes its own path.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | master
Files: files | file ages | folders
SHA3-256:70d7950f3edda9174590cf851d988d2b06dd9a94722ff041bf468b82823256bb
User & Date: schelte 2015-12-12 20:11:01
Context
2016-05-22
09:27
The generate command doesn't always correctly determine whether the result of the signal body should be interpreted as a single value or a list. check-in: ad58136c89 user: schelte tags: trunk, master
2015-12-12
20:11
Fix error when a method deletes its own path. check-in: 70d7950f3e user: schelte tags: trunk, master
2015-12-02
20:08
- Nodes without any methods, signals, or properties would prevent any underlying nodes from being discovered via introspection - Deleting a node should also delete any child nodes check-in: 248e7aa88c user: schelte tags: trunk, master
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to dbif.tcl.

617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
...
993
994
995
996
997
998
999



1000
1001
1002
1003
1004
1005
1006
    }
    dbus listen $bus $path $intf.$name [list dbus::dbif::signals $bus]
}

# Send a response to a DBus message
#
proc dbus::dbif::respond {response id result {name ""}} {
    variable info; variable dbif
    if {![info exists info($id)]} {
	error "Message ID $id does not exist"
    }
    dict with info($id) {}
    expire $id
    if {$noreply} return
    set dict [dict get $dbif($bus,$path,$interface) methods $member,$signature]
    dict with dict {
	if {$response eq "error"} {
	    if {$name eq ""} {
		dbus error $bus $sender $serial $result
	    } else {
		dbus error $bus -name $name $sender $serial $result
	    }
	} elseif {[llength $out] == 2} {
................................................................................
    }
    set dict [dict get $dbif($bus,$path,$interface) methods $member,$signature]

    set id message[incr msgid]
    # Allow 25 seconds for the application to provide a response
    set afterid [after $timeout [list dbus::dbif::expire $id]]
    set info($id) [dict merge $data [dict create bus $bus afterid $afterid]]



    dict with dict {
    	if {[catch {interp eval $interp \
	  [list uplevel #0 $command [linsert $args 0 $id]]} result opts]} {
	    respond error $id $result
	} elseif {$async || [async $opts]} {
    	    # Keep the message information around for a bit more
	} elseif {$noreply} {







|






<
|







 







>
>
>







617
618
619
620
621
622
623
624
625
626
627
628
629
630

631
632
633
634
635
636
637
638
...
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
    }
    dbus listen $bus $path $intf.$name [list dbus::dbif::signals $bus]
}

# Send a response to a DBus message
#
proc dbus::dbif::respond {response id result {name ""}} {
    variable info
    if {![info exists info($id)]} {
	error "Message ID $id does not exist"
    }
    dict with info($id) {}
    expire $id
    if {$noreply} return

    dict with resp {
	if {$response eq "error"} {
	    if {$name eq ""} {
		dbus error $bus $sender $serial $result
	    } else {
		dbus error $bus -name $name $sender $serial $result
	    }
	} elseif {[llength $out] == 2} {
................................................................................
    }
    set dict [dict get $dbif($bus,$path,$interface) methods $member,$signature]

    set id message[incr msgid]
    # Allow 25 seconds for the application to provide a response
    set afterid [after $timeout [list dbus::dbif::expire $id]]
    set info($id) [dict merge $data [dict create bus $bus afterid $afterid]]
    # Store a copy of the information needed to provide a response. This
    # information would otherwise be lost if the code deletes its own path.
    dict set info($id) resp $dict
    dict with dict {
    	if {[catch {interp eval $interp \
	  [list uplevel #0 $command [linsert $args 0 $id]]} result opts]} {
	    respond error $id $result
	} elseif {$async || [async $opts]} {
    	    # Keep the message information around for a bit more
	} elseif {$noreply} {