# KPV Dec 21, 2002 - added extract window
# version 2.5 - February, 2003 by Don Libes
# DL Jan/Feb, 2003 - added date support, state save/restore, cmdline display
+# Pat Thoyts - 2007 - added theming / ttk support.
#
# spy on conversation between a tcp client and server
#
catch {package require uri} ;# Error handled below
+# Handle the various versions of tile/ttk
+variable useTile
+if {[package provide Tk] ne ""} {
+ if {![info exists useTile]} {
+ variable useTile 1
+ variable NS "::ttk"
+ if {[llength [info commands ::ttk::*]] == 0} {
+ if {![catch {package require tile 0.8}]} {
+ # we're all good
+ } elseif {![catch {package require tile 0.7}]} {
+ # tile to ttk compatability
+ interp alias {} ::ttk::style {} ::style
+ interp alias {} ::ttk::setTheme {} ::tile::setTheme
+ interp alias {} ::ttk::themes {} ::tile::availableThemes
+ interp alias {} ::ttk::LoadImages {} ::tile::LoadImages
+ } else {
+ set useTile 0
+ set NS "::tk"
+ }
+ } else {
+ # we have ttk in tk85
+ }
+ if {$useTile && [tk windowingsystem] eq "aqua"} {
+ # use native scrollbars on the mac
+ if {[llength [info commands ::ttk::_scrollbar]] == 0} {
+ rename ::ttk::scrollbar ::ttk::_scrollbar
+ interp alias {} ::ttk::scrollbar {} ::tk::scrollbar
+ }
+ }
+ # Ensure that Tk widgets are available in the tk namespace. This is useful
+ # if we are using Ttk widgets as sometimes we need the originals.
+ #
+ if {[llength [info commands ::tk::label]] < 1} {
+ foreach cmd { label entry text canvas menubutton button frame labelframe \
+ radiobutton checkbutton scale scrollbar} {
+ rename ::$cmd ::tk::$cmd
+ interp alias {} ::$cmd {} ::tk::$cmd
+ }
+ }
+ }
+}
+
array set state {
- version 2.5
+ version 2.6
extract 0
bbar 1
ascii 1
#
proc createMain {} {
global state colors tcl_platform
+ variable NS
wm withdraw .
- set state(fixed) [font create -family courier -size $state(fontSize)]
- set state(fixedbold) [font create -family courier -size $state(fontSize) \
- -weight bold]
+ # See if we can find a better font than the TkFixedFont or courier
+ if {[lsearch -exact [font names] TkFixedFont] != -1} {
+ eval [linsert [font configure TkFixedFont] 0 font create SockspyFont]
+ } else {
+ font create SockspyFont -family courier
+ }
+ set families [font families]
+ switch -exact -- [tk windowingsystem] {
+ aqua { set preferred {Monaco 9} }
+ win32 { set preferred {ProFontWindows 8 Consolas 8} }
+ default { set preferred {} }
+ }
+ foreach {family size} $preferred {
+ if {[lsearch -exact $families $family] != -1} {
+ font configure SockspyFont -family $family -size $size
+ break
+ }
+ }
+
+ font configure SockspyFont -size $state(fontSize)
+ set state(fixed) SockspyFont
+ set state(fixedbold) [eval [list font create SockspyBold] \
+ [font configure SockspyFont] -weight bold]
+
wm title . "SockSpy -- $state(title)"
wm resizable . 1 1
.m add cascade -menu .m.view -label "View" -underline 0
.m add cascade -menu .m.help -label "Help" -underline 0
- menu .m.file
+ menu .m.file -tearoff 0
.m.file add command -label "Save ..." -underline 0 -command saveOutput
.m.file add command -label "Reconnect ..." -underline 0 -command GetSetup
.m.file add separator
.m.file add command -label "Exit" -underline 1 -command Shutdown
- menu .m.view
+ menu .m.view -tearoff 0
.m.view add command -label " Clear" -underline 1 -command clearOutput
.m.view add separator
.m.view add checkbutton -label " ButtonBar" -variable state(bbar) \
#
# Title and status window
#
- frame .bbar
- frame .cmd -relief sunken -bd 2
- radiobutton .cmd.hex -text Hex -variable state(ascii) \
+ ${NS}::frame .bbar
+ ${NS}::frame .cmd ;#-relief sunken -borderwidth 2
+ ${NS}::radiobutton .cmd.hex -text Hex -variable state(ascii) \
-value 0 -command redraw
- radiobutton .cmd.ascii -text ASCII -variable state(ascii) \
+ ${NS}::radiobutton .cmd.ascii -text ASCII -variable state(ascii) \
-value 1 -command redraw
- checkbutton .cmd.autos -text Autoscroll -variable state(autoscroll)
- checkbutton .cmd.autow -text Autowrap -variable state(autowrap) \
+ ${NS}::checkbutton .cmd.autos -text Autoscroll -variable state(autoscroll)
+ ${NS}::checkbutton .cmd.autow -text Autowrap -variable state(autowrap) \
-command ToggleWrap
- checkbutton .cmd.capture -text Capture -variable state(capture) \
+ ${NS}::checkbutton .cmd.capture -text Capture -variable state(capture) \
-command ToggleCapture
- checkbutton .cmd.time -text Time -variable state(time) \
- -command redraw
- button .cmd.clear -text Clear -command clearOutput
+ ${NS}::checkbutton .cmd.time -text Time -variable state(time) \
+ -command redraw
+ ${NS}::button .cmd.clear -text Clear -command clearOutput -width -6
#button .cmd.incr -text "+ Font" -command [list doFont 1]
#button .cmd.decr -text "- Font" -command [list doFont -1]
- button .cmd.save -text Save -command saveOutput
- button .cmd.kill -text Exit -command Shutdown
- pack .cmd -side top -fill x -pady 5 -in .bbar
+ ${NS}::button .cmd.save -text Save -command saveOutput -width -6
+ ${NS}::button .cmd.kill -text Exit -command Shutdown -width -6
+ pack .cmd -side top -fill x -pady 2 -in .bbar
pack .cmd.kill .cmd.save .cmd.clear .cmd.autow .cmd.autos .cmd.capture \
- .cmd.time \
- -side right -padx 3 -pady 3
+ .cmd.time -side right -padx 1 -pady 1
#label .title -relief ridge -textvariable state(title)
#.title config -font "[.title cget -font] bold"
- label .stat -textvariable state(msg) -relief ridge -anchor w
+ ${NS}::label .stat -textvariable state(msg) -anchor w
#
# Now for the output area of the display
#
- scrollbar .yscroll -orient vertical -command {.out yview}
- scrollbar .xscroll -orient horizontal -command {.out xview}
- text .out -width 80 -height 50 -font $state(fixed) -bg white -setgrid 1 \
- -yscrollcommand ".yscroll set" -xscrollcommand ".xscroll set"
+ ${NS}::scrollbar .yscroll -orient vertical -command {.out yview}
+ ${NS}::scrollbar .xscroll -orient horizontal -command {.out xview}
+ text .out -width 80 -height 43 -font $state(fixed) -background white -setgrid 1 \
+ -yscrollcommand ".yscroll set" -xscrollcommand ".xscroll set" -borderwidth 1
foreach t [array names colors] {
- .out tag configure $t -background $colors($t) -borderwidth 2 \
+ .out tag configure $t -background $colors($t) -borderwidth 1 \
-relief raised -lmargin1 5 -lmargin2 5
- .out tag configure time_$t -background $colors($t) -borderwidth 2 \
+ .out tag configure time_$t -background $colors($t) -borderwidth 1 \
-relief raised -lmargin1 5 -lmargin2 5 -font $state(fixedbold)
}
.out tag configure client2 -font $state(fixedbold)
bind .out <Control-l> clearOutput
bind all <Alt-c> {console show}
+ bind all <Control-F2> {console show}
focus .out
wm geometry . +10+10
+ wm deiconify .
}
##+##########################################################################
#
#
proc createExtract {} {
global state colors
-
- if {[winfo exists .extract]} {
- wm deiconify .extract
+ variable NS
+
+ set top .extract
+ if {[winfo exists $top]} {
+ wm deiconify $top
return
}
- set top ".extract"
+
toplevel $top
+ wm withdraw $top
wm title $top "SockSpy Extract"
+ wm transient $top .
wm protocol $top WM_DELETE_WINDOW [list ToggleExtract -1]
if {[regexp {(\+[0-9]+)(\+[0-9]+)$} [wm geom .] => wx wy]} {
wm geom $top "+[expr {$wx+35+[winfo width .]}]+[expr {$wy+15}]"
}
- frame $top.top -bd 2 -relief ridge
- label $top.top.c -text "Client Filter" -anchor e
+ ${NS}::frame $top.top
+ ${NS}::label $top.top.c -text "Client Filter" -anchor e
entry $top.top.ce -textvariable extract(client) -bg $colors(client)
- label $top.top.s -text "Server Filter" -anchor e
+ ${NS}::label $top.top.s -text "Server Filter" -anchor e
entry $top.top.se -textvariable extract(server) -bg $colors(server)
- label $top.top.m -text "Metadata Filter" -anchor e
+ ${NS}::label $top.top.m -text "Metadata Filter" -anchor e
entry $top.top.me -textvariable extract(meta2) -bg $colors(meta2)
- text $top.out -width 80 -height 20 -font $state(fixed) -bg beige \
+ text $top.out -width 80 -height 20 -font $state(fixed) \
-setgrid 1 -wrap none -yscrollcommand [list $top.yscroll set] \
-xscrollcommand [list $top.xscroll set]
foreach t [array names colors] {
}
$top.out tag raise sel ;# Selection is most prominent
- scrollbar $top.yscroll -orient vertical -command [list $top.out yview]
- scrollbar $top.xscroll -orient horizontal -command [list $top.out xview]
+ ${NS}::scrollbar $top.yscroll -orient vertical -command [list $top.out yview]
+ ${NS}::scrollbar $top.xscroll -orient horizontal -command [list $top.out xview]
grid $top.top - -row 0 -sticky ew -ipady 10
grid $top.out $top.yscroll -sticky news
grid $top.xscroll -sticky ew
grid $top.top.m $top.top.me -sticky ew
grid columnconfigure $top.top 1 -weight 1
grid columnconfigure $top.top 2 -minsize 10
+ wm deiconify $top
}
##+##########################################################################
#
global state SP
set rval 1
- catch {close $state(sockClnt)} ;# Only the last open connection
+ catch {close $state(sockClnt)} ;# Only the last open connection
- ;# Close old listener if it exists
+ # Close old listener if it exists
if {$state(listen) != ""} {
set n [catch {close $state(listen)} emsg]
if {$n} { INFO "socket close error: $emsg"}
set state(listen) ""
- update ;# Need else socket below fails
+ update ;# Need else socket below fails
}
# Listen on clntPort or proxyPort for incoming connections
INFO $state(title)
INFO "waiting for new connection..."
}
- wm title . "SockSpy -- $state(title)"
+ if {$state(gui)} {
+ wm title . "SockSpy -- $state(title)"
+ }
return $rval
}
##+##########################################################################
#
proc GetSetup {} {
global state SP ok
+ variable NS
array set save [array get SP]
set ok 0 ;# Assume cancelling
destroy .dlg
toplevel .dlg
+ wm withdraw .dlg
wm title .dlg "SockSpy Setup"
+ wm transient .dlg .
wm geom .dlg +176+176
- #wm transient .dlg .
- label .dlg.top -bd 2 -relief raised
+ ${NS}::label .dlg.top
set msg "You can configure SockSpy to either forward data\n"
append msg "a fixed server and port or to use the HTTP Proxy\n"
append msg "protocol to dynamically determine the server and\n"
append msg "port to forward data to."
- frame .dlg.fforward
- frame .dlg.fproxy
- frame .dlg.fcmdline
-
- label .dlg.msg -text $msg -justify left
- radiobutton .dlg.forward -text "Use fixed server forwarding" \
- -variable state(proxy) -value 0 -anchor w -command GetSetup2
- label .dlg.fl1 -text "Client Port:" -anchor e
- entry .dlg.fe1 -textvariable SP(clntPort)
-
- label .dlg.fl2 -text "Server Host:" -anchor e
- entry .dlg.fe2 -textvariable SP(servHost)
- label .dlg.fl3 -text "Server Port:" -anchor e
- entry .dlg.fe3 -textvariable SP(servPort)
+ ${NS}::frame .dlg.fforward
+ ${NS}::frame .dlg.fproxy
+ ${NS}::frame .dlg.fcmdline
+
+ ${NS}::label .dlg.msg -text $msg -justify left
+ ${NS}::radiobutton .dlg.forward -text "Use fixed server forwarding" \
+ -variable state(proxy) -value 0 -command GetSetup2
+ if {$NS ne "::ttk"} { .dlg.forward configure -anchor w }
+ ${NS}::label .dlg.fl1 -text "Client Port:" -anchor e
+ ${NS}::entry .dlg.fe1 -textvariable SP(clntPort)
+
+ ${NS}::label .dlg.fl2 -text "Server Host:" -anchor e
+ ${NS}::entry .dlg.fe2 -textvariable SP(servHost)
+ ${NS}::label .dlg.fl3 -text "Server Port:" -anchor e
+ ${NS}::entry .dlg.fe3 -textvariable SP(servPort)
- radiobutton .dlg.proxy -text "Use HTTP Proxying" \
- -variable state(proxy) -value 1 -anchor w -command GetSetup2
- label .dlg.pl1 -text "Proxy Port:" -anchor e
- entry .dlg.pe1 -textvariable SP(proxyPort)
-
- label .dlg.cllabel -text "Command Line Equivalent"
- entry .dlg.clvar -textvariable SP(cmdLine) \
- -borderwidth 2 -relief sunken
+ ${NS}::radiobutton .dlg.proxy -text "Use HTTP Proxying" \
+ -variable state(proxy) -value 1 -command GetSetup2
+ if {$NS ne "::ttk"} {.dlg.proxy configure -anchor w}
+ ${NS}::label .dlg.pl1 -text "Proxy Port:" -anchor e
+ ${NS}::entry .dlg.pe1 -textvariable SP(proxyPort)
+
+ ${NS}::label .dlg.cllabel -text "Command Line Equivalent"
+ ${NS}::entry .dlg.clvar -textvariable SP(cmdLine)
# -state readonly doesn't seem to work, sigh
- button .dlg.ok -text OK -width 10 -command ValidForm
- button .dlg.cancel -text Cancel -width 10 -command [list destroy .dlg]
+ ${NS}::button .dlg.ok -text OK -width 10 -command ValidForm
+ ${NS}::button .dlg.cancel -text Cancel -width 10 -command [list destroy .dlg]
- grid .dlg.top -row 0 -column 0 -columnspan 3 -sticky ew -padx 10 -pady 10
+ grid .dlg.top -row 0 -column 0 -columnspan 3 -sticky ew -padx 2 -pady 2
grid columnconfigure .dlg 0 -weight 1
- grid x .dlg.ok .dlg.cancel -padx 10
+ grid x .dlg.ok .dlg.cancel -padx 2
grid configure .dlg.ok -padx 0
grid rowconfigure .dlg 2 -minsize 8
- pack .dlg.msg -in .dlg.top -side top -fill x -padx 10 -pady 5
+ pack .dlg.msg -in .dlg.top -side top -fill x -padx 2 -pady 1
pack .dlg.fforward .dlg.fproxy .dlg.fcmdline -in .dlg.top \
- -side top -fill x -padx 10 -pady 10
+ -side top -fill x -padx 2 -pady 2
grid .dlg.cllabel -in .dlg.fcmdline -row 0 -column 0 -sticky w
grid .dlg.clvar -in .dlg.fcmdline -row 1 -column 0 -sticky ew
if {$state(proxy)} { focus -force .dlg.pe1 } { focus -force .dlg.fe2 }
raise .dlg
+ wm deiconify .dlg
tkwait window .dlg
- wm deiconify .
+ wm deiconify .
if {$ok} {
DoListen
# Help -- a simple help system
#
proc Help {} {
- destroy .help
- toplevel .help
- wm title .help "SockSpy Help"
- wm geom .help "+[expr {[winfo x .] + 50}]+[expr {[winfo y .] + 50}]"
-
- text .help.t -relief raised -wrap word -width 70 -height 25 \
- -padx 10 -pady 10 -cursor {} -yscrollcommand {.help.sb set}
- scrollbar .help.sb -orient vertical -command {.help.t yview}
- button .help.dismiss -text Dismiss -command {destroy .help}
- pack .help.dismiss -side bottom -pady 10
- pack .help.sb -side right -fill y
- pack .help.t -side top -expand 1 -fill both
-
- set bold "[font actual [.help.t cget -font]] -weight bold"
- set fixed "[font actual [.help.t cget -font]] -family courier"
- .help.t tag config title -justify center -foregr red -font "Times 20 bold"
- .help.t tag configure title2 -justify center -font "Times 12 bold"
- .help.t tag configure header -font $bold
- .help.t tag configure n -lmargin1 15 -lmargin2 15
- .help.t tag configure fixed -font $fixed -lmargin1 25 -lmargin2 55
-
- .help.t insert end "SockSpy\n" title
- .help.t insert end "Authors: Tom Poindexter and Keith Vetter\n\n" title2
+ variable NS
+ set dlg .help
+ destroy $dlg
+ toplevel $dlg -class Dialog
+ wm withdraw $dlg
+ wm title $dlg "SockSpy Help"
+ wm transient $dlg .
+ wm geom $dlg "+[expr {[winfo x .] + 50}]+[expr {[winfo y .] + 50}]"
+
+ set txt [text $dlg.t -relief raised -wrap word -width 70 -height 25 \
+ -padx 10 -pady 10 -cursor {} -yscrollcommand [list $dlg.sb set]]
+ ${NS}::scrollbar $dlg.sb -orient vertical -command [list $dlg.t yview]
+ ${NS}::button $dlg.dismiss -text Dismiss -command [list destroy $dlg]
+ pack $dlg.dismiss -side bottom -pady 10
+ pack $dlg.sb -side right -fill y
+ pack $dlg.t -side top -expand 1 -fill both
+
+ set bold "[font actual [$txt cget -font]] -weight bold"
+ set fixed "[font actual [$txt cget -font]] -family courier"
+ $txt tag config title -justify center -foregr red -font "Times 20 bold"
+ $txt tag configure title2 -justify center -font "Times 12 bold"
+ $txt tag configure header -font $bold
+ $txt tag configure n -lmargin1 15 -lmargin2 15
+ $txt tag configure fixed -font $fixed -lmargin1 25 -lmargin2 55
+
+ $txt insert end "SockSpy\n" title
+ $txt insert end "Authors: Tom Poindexter and Keith Vetter\n\n" title2
set m "SockSpy lets you watch the conversation of a tcp client and server. "
append m "SockSpy acts much like a gateway: it waits for a tcp connection, "
append m "from the server in blue and connection metadata in red. The data "
append m "can be displayed as printable ASCII or both hex and "
append m "printables.\n\n"
- .help.t insert end "What is SockSpy?\n" header $m n
+ $txt insert end "What is SockSpy?\n" header $m n
set m "Why might you want to use SockSpy? Debugging tcp client/server "
append m "programs, examining protocols and diagnosing network problems "
append m "other hand, SockSpy doesn't require any special privileges to "
append m "run (unless of course, you try to listen on a Unix reserved tcp "
append m "port less than 1024.)\n\n"
- .help.t insert end "Why Use SockSpy?\n" header $m n
+ $txt insert end "Why Use SockSpy?\n" header $m n
set m "Just double click on SockSpy to start it. You will be prompted for "
append m "various connection parameters described below.\n\n"
append m "command line. This is also how you can run SockSpy in text mode "
append m "without a GUI.\n\n"
append m "To start SockSpy from the command line:\n"
- .help.t insert end "How to Use SockSpy\n" header $m n
+ $txt insert end "How to Use SockSpy\n" header $m n
set m "$ sockspy <listen-port> <server-host> <server-port>\n or\n"
append m "$ sockspy -proxy <proxy-port>\n\n"
- .help.t insert end $m fixed
+ $txt insert end $m fixed
set m "To start SockSpy in text mode without a GUI:\n"
- .help.t insert end $m n
+ $txt insert end $m n
set m "$ tclsh sockspy <listen-port> <server-host> <server-port>\n or\n"
append m "$ tclsh sockspy -proxy <proxy-port>\n\n"
- .help.t insert end $m fixed
+ $txt insert end $m fixed
set m "<listen-port>: the tcp port on which to listen. Clients should "
append m "connect to this port.\n"
append m "<server-host>: the host where the real server runs.\n"
append m "<server-port>: the tcp port on which the real server listens.\n"
append m "<proxy-port>: the tcp port on which to listen in proxy-mode.\n\n"
- .help.t insert end $m n
+ $txt insert end $m n
set m "In proxy mode SockSpy works like a simple HTTP proxy server. "
append m "Instead of forwarding to a fixed server and port, it follows the "
append m "first line of HTTP request.\n\n"
append m "You can turn on proxy mode by selecting it in the SockSpy Setup "
append m "dialog, or by specifying -proxy on the command line.\n\n"
- .help.t insert end "Proxy Mode\n" header $m n
+ $txt insert end "Proxy Mode\n" header $m n
set m "The extract window lets you extract specific parts of the "
append m "data stream. As data arrives from the client, server, or as "
append m "expression filter. If it matches, the data gets displayed "
append m "in the extract window. (Malformed regular expression are "
append m "silently ignored.)\n\n"
- .help.t insert end "Extract Window\n" header $m n
+ $txt insert end "Extract Window\n" header $m n
set m "To spy on HTTP connections to a server, type:\n"
- .help.t insert end "Example\n" header $m n
- .help.t insert end " sockspy 8080 www.some.com 80\n" fixed
- .help.t insert end "and point your browser to\n" n
- .help.t insert end " http://localhost:8080/index.html\n\n" fixed
- .help.t insert end "Alternatively, you could configure your browser to " n
- .help.t insert end "use localhost and port 8000 as its proxy, and then " n
- .help.t insert end "type:\n" n
- .help.t insert end " sockspy -proxy 8000\n" fixed
- .help.t insert end "and user your browser normally.\n" n
-
- .help.t config -state disabled
+ $txt insert end "Example\n" header $m n
+ $txt insert end " sockspy 8080 www.some.com 80\n" fixed
+ $txt insert end "and point your browser to\n" n
+ $txt insert end " http://localhost:8080/index.html\n\n" fixed
+ $txt insert end "Alternatively, you could configure your browser to " n
+ $txt insert end "use localhost and port 8000 as its proxy, and then " n
+ $txt insert end "type:\n" n
+ $txt insert end " sockspy -proxy 8000\n" fixed
+ $txt insert end "and user your browser normally.\n" n
+ $txt config -state disabled
+ wm deiconify $dlg
}
##+##########################################################################
#
timestampInit
stateRestore
-if {$state(gui)} createMain
+if {$state(gui)} { createMain }
if {[lindex $argv 0] == "-local"} {
set argv [list 8080 localhost 80]
projects / sockspy / commitdiff