neingeist
/
arduinisten
Archived
1
0
Fork 0
You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

136 lines
3.0 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}
}
}