136 lines
3 KiB
Tcl
136 lines
3 KiB
Tcl
|
# ipc.tcl
|
||
|
|
# Copyright (C) 2004 Red Hat, Inc.
|
||
|
|
#
|
||
|
|
# This program is free software; you can redistribute it and/or modify it
|
||
|
|
# under the terms of the GNU General Public License (GPL) as published by
|
||
|
|
# the Free Software Foundation; either version 2 of the License, or (at
|
||
|
|
# your option) any later version.
|
||
|
|
#
|
||
|
|
# This program is distributed in the hope that it will be useful,
|
||
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
# GNU General Public License for more details.
|
||
|
|
|
||
|
|
# ----------------------------------------------------------------------
|
||
|
|
# Implements IPC for multiple Insight instances, allowing any Insight
|
||
|
|
# to send commands to all other Insights on the same host.
|
||
|
|
#
|
||
|
|
# PUBLIC METHODS:
|
||
|
|
#
|
||
|
|
# send $cmd - sends $cmd to all Insights
|
||
|
|
#
|
||
|
|
# ----------------------------------------------------------------------
|
||
|
|
|
||
|
|
itcl::class Iipc {
|
||
|
|
|
||
|
|
private variable socklist
|
||
|
|
private variable portnum 9909
|
||
|
|
private variable serversock
|
||
|
|
|
||
|
|
constructor {} {
|
||
|
|
init
|
||
|
|
}
|
||
|
|
|
||
|
|
destructor {
|
||
|
|
debug
|
||
|
|
foreach sock $socklist {
|
||
|
|
catch {::close $sock}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$serversock != "0"} {
|
||
|
|
catch {::close $serversock}
|
||
|
|
}
|
||
|
|
set ::iipc 0
|
||
|
|
}
|
||
|
|
|
||
|
|
private method init {} {
|
||
|
|
debug "iipc init"
|
||
|
|
set socklist {}
|
||
|
|
set serversock 0
|
||
|
|
set portnum [pref get gdb/ipc/port]
|
||
|
|
if {[catch {socket -server [code $this accept] $portnum} serversock]} {
|
||
|
|
debug "server already exists. Connecting to it."
|
||
|
|
set socklist [socket localhost $portnum]
|
||
|
|
fconfigure $socklist -buffering line -blocking 0
|
||
|
|
fileevent $socklist readable [code $this read $socklist]
|
||
|
|
}
|
||
|
|
set ::iipc 1
|
||
|
|
}
|
||
|
|
|
||
|
|
# accept new connection to server
|
||
|
|
private method accept {sock addr port} {
|
||
|
|
debug "accepting connecting from $sock -> $addr:$port"
|
||
|
|
fconfigure $sock -buffering line -blocking 0
|
||
|
|
lappend socklist $sock
|
||
|
|
fileevent $sock readable [code $this sread $sock]
|
||
|
|
}
|
||
|
|
|
||
|
|
private method read {s} {
|
||
|
|
if [eof $s] {
|
||
|
|
debug "The server died on $s!!"
|
||
|
|
catch {::close $s}
|
||
|
|
init
|
||
|
|
return
|
||
|
|
}
|
||
|
|
gets $s res
|
||
|
|
debug "Server: $res"
|
||
|
|
switch $res {
|
||
|
|
quit { gdb_force_quit }
|
||
|
|
stop { gdbtk_stop }
|
||
|
|
run { gdbtk_run }
|
||
|
|
default {
|
||
|
|
catch {gdb_immediate "$res"}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# server read method. Reads data then forwards
|
||
|
|
# it to all listening sockets.
|
||
|
|
private method sread {s} {
|
||
|
|
if [eof $s] {
|
||
|
|
close $s
|
||
|
|
return
|
||
|
|
}
|
||
|
|
gets $s res
|
||
|
|
if {$res != ""} {
|
||
|
|
debug "Got: $res"
|
||
|
|
foreach sock $socklist {
|
||
|
|
if {$s != $sock} {
|
||
|
|
if {[catch {puts $sock $res}]} {
|
||
|
|
close $sock
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
switch $res {
|
||
|
|
quit { gdb_force_quit }
|
||
|
|
stop { gdbtk_stop }
|
||
|
|
run { gdbtk_run }
|
||
|
|
default {
|
||
|
|
catch {gdb_immediate "$res"}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# send data to all sockets.
|
||
|
|
public method send {cmd} {
|
||
|
|
debug "send $cmd"
|
||
|
|
foreach sock $socklist {
|
||
|
|
if {[catch {puts $sock $cmd}]} {
|
||
|
|
close $sock
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
private method close {s} {
|
||
|
|
debug "closing socket $s"
|
||
|
|
set socklist [lremove $socklist $s]
|
||
|
|
catch {::close $s}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|