#!/bin/sh
-# restart using wish \
+# restart using wish -*- mode: tcl; tab-width: 8; -*- \
exec wish $0 ${1+"$@"}
# sockspy: copyright tom poindexter 1998
# sockspy: copyright Keith Vetter 2002
-# tpoindex@nyx.net
+# tpoindex@nyx.net
# version 1.0 - december 10, 1998
# version 2.0 - January, 2002 by Keith Vetter
# KPV Nov 01, 2002 - added proxy mode
# 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
#
# spy on conversation between a tcp client and server
#
# usage: sockspy clientPort serverHost serverPort
-# -or- sockspy -proxy proxyPort
-# clientPort - port to which clients connect
-# serverHost - machine where real server runs
-# serverPort - port on which real server listens
+# -or- sockspy -proxy proxyPort
+# clientPort - port to which clients connect
+# serverHost - machine where real server runs
+# serverPort - port on which real server listens
#
# e.g. to snoop on http connections to a web server:
-# sockspy 8080 www.some.com 80
+# sockspy 8080 www.some.com 80
# then client web browser should use a url like:
-# http://localhost:8080/index.html
-# (or set your browser's proxy to use 8080 on the sockspy machine)
+# http://localhost:8080/index.html
+# (or set your browser's proxy to use 8080 on the sockspy machine)
-catch {package require uri} ;# Error handled below
+catch {package require uri} ;# Error handled below
array set state {
- version 2.4
+ version 2.5
+ extract 0
bbar 1
ascii 1
autoscroll 1
msg ""
fixed {}
fixedbold {}
+ fontSize 9
playback ""
gui 0
listen ""
title "not connected"
proxy 0
fname ""
+ time 1
+ timeFormat ""
+ timeFormatDefault "%H:%M:%S "
}
+
+# variables to save across runs
+set saveList {
+ state(extract)
+ state(bbar)
+ state(ascii)
+ state(autoscroll)
+ state(autowrap)
+ state(proxy)
+ state(fname)
+ state(time)
+ state(timeFormat)
+ state(fontSize)
+ extract(client)
+ extract(server)
+ extract(meta2)
+ SP(proxyPort)
+ SP(clntPort)
+ SP(servPort)
+ SP(servHost)
+}
+
array set colors {client green server cyan meta red meta2 yellow}
array set SP {proxyPort 8080 clntPort 8080 servHost "" servPort 80}
+
set extract(client) {^(GET |POST |HEAD )}
set extract(server) {^(HTTP/|Location: |Content-)}
-#set extract(meta) {.}
set extract(meta2) {.}
+#set extract(meta) {.}
+
##+##########################################################################
#
# createMain -- Creates the display
proc createMain {} {
global state colors tcl_platform
- if {! $state(gui)} return
-
- set state(fixed) [font create -family courier -size 10]
- set state(fixedbold) [font create -family courier -size 10 -weight bold]
- if {"$tcl_platform(platform)" == "windows"} {
- doFont -1
- }
+ wm withdraw .
+
+ set state(fixed) [font create -family courier -size $state(fontSize)]
+ set state(fixedbold) [font create -family courier -size $state(fontSize) \
+ -weight bold]
+
wm title . "SockSpy -- $state(title)"
wm resizable . 1 1
- wm protocol . WM_DELETE_WINDOW Shutdown ;# So we shut down cleanly
+ wm protocol . WM_DELETE_WINDOW Shutdown ;# So we shut down cleanly
#
# Set up the menus
.m add cascade -menu .m.view -label "View" -underline 0
.m add cascade -menu .m.help -label "Help" -underline 0
- 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
+ menu .m.file
+ .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 -tearoff 0
+ menu .m.view
.m.view add command -label " Clear" -underline 1 -command clearOutput
.m.view add separator
.m.view add checkbutton -label " ButtonBar" -variable state(bbar) \
- -underline 1 -command ButtonBar
+ -underline 1 -command ButtonBar
.m.view add checkbutton -label " Extract Window" -variable state(extract) \
- -underline 1 -command ToggleExtract
+ -underline 1 -command ToggleExtract
.m.view add separator
.m.view add command -label " + Font" -command [list doFont 1]
.m.view add command -label " - Font" -command [list doFont -1]
.m.view add separator
.m.view add radiobutton -label " Hex" -underline 1 \
- -variable state(ascii) -value 0 -command redraw
+ -variable state(ascii) -value 0 -command redraw
.m.view add radiobutton -label " ASCII" -underline 1 \
- -variable state(ascii) -value 1 -command redraw
+ -variable state(ascii) -value 1 -command redraw
.m.view add separator
.m.view add checkbutton -label " Autoscroll" -underline 5 \
- -variable state(autoscroll)
+ -variable state(autoscroll)
.m.view add checkbutton -label " Autowrap" -underline 5 \
- -variable state(autowrap) -command ToggleWrap
+ -variable state(autowrap) -command ToggleWrap
.m.view add checkbutton -label " Capture" -underline 5 \
- -variable state(capture) -command ToggleCapture
+ -variable state(capture) -command ToggleCapture
+ .m.view add separator
+ .m.view add checkbutton -label " Time" \
+ -variable state(time) -command redraw
+ .m.view add command -label " Time Format ..." -command timestampWindow
menu .m.help -tearoff 0
.m.help add command -label Help -underline 1 -command Help
frame .bbar
frame .cmd -relief sunken -bd 2
radiobutton .cmd.hex -text Hex -variable state(ascii) \
- -value 0 -command redraw
+ -value 0 -command redraw
radiobutton .cmd.ascii -text ASCII -variable state(ascii) \
- -value 1 -command redraw
+ -value 1 -command redraw
checkbutton .cmd.autos -text Autoscroll -variable state(autoscroll)
checkbutton .cmd.autow -text Autowrap -variable state(autowrap) \
- -command ToggleWrap
+ -command ToggleWrap
checkbutton .cmd.capture -text Capture -variable state(capture) \
- -command ToggleCapture
+ -command ToggleCapture
+ checkbutton .cmd.time -text Time -variable state(time) \
+ -command redraw
button .cmd.clear -text Clear -command clearOutput
#button .cmd.incr -text "+ Font" -command [list doFont 1]
#button .cmd.decr -text "- Font" -command [list doFont -1]
button .cmd.kill -text Exit -command Shutdown
pack .cmd -side top -fill x -pady 5 -in .bbar
pack .cmd.kill .cmd.save .cmd.clear .cmd.autow .cmd.autos .cmd.capture \
- -side right -padx 3 -pady 3
+ .cmd.time \
+ -side right -padx 3 -pady 3
#label .title -relief ridge -textvariable state(title)
#.title config -font "[.title cget -font] bold"
label .stat -textvariable state(msg) -relief ridge -anchor w
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"
+ -yscrollcommand ".yscroll set" -xscrollcommand ".xscroll set"
foreach t [array names colors] {
- .out tag configure $t -background $colors($t) -borderwidth 2 \
- -relief raised -lmargin1 5 -lmargin2 5
+ .out tag configure $t -background $colors($t) -borderwidth 2 \
+ -relief raised -lmargin1 5 -lmargin2 5
+ .out tag configure time_$t -background $colors($t) -borderwidth 2 \
+ -relief raised -lmargin1 5 -lmargin2 5 -font $state(fixedbold)
}
- .out tag raise sel ;# Selection is most prominent
+ .out tag configure client2 -font $state(fixedbold)
+ .out tag raise sel ;# Selection is most prominent
grid .bbar - -row 0 -sticky ew
grid .out .yscroll -row 1 -sticky news
grid .xscroll -row 2 -sticky ew
grid .stat - -row 3 -sticky ew
- grid rowconfigure . 1 -weight 1
+ grid rowconfigure . 1 -weight 1
grid columnconfigure . 0 -weight 1
bind .out <Control-l> clearOutput
global state colors
if {[winfo exists .extract]} {
- wm deiconify .extract
- return
+ wm deiconify .extract
+ return
}
set top ".extract"
toplevel $top
wm title $top "SockSpy Extract"
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}]"
+ wm geom $top "+[expr {$wx+35+[winfo width .]}]+[expr {$wy+15}]"
}
frame $top.top -bd 2 -relief ridge
entry $top.top.me -textvariable extract(meta2) -bg $colors(meta2)
text $top.out -width 80 -height 20 -font $state(fixed) -bg beige \
- -setgrid 1 -wrap none -yscrollcommand [list $top.yscroll set] \
- -xscrollcommand [list $top.xscroll set]
+ -setgrid 1 -wrap none -yscrollcommand [list $top.yscroll set] \
+ -xscrollcommand [list $top.xscroll set]
foreach t [array names colors] {
- $top.out tag configure $t -background $colors($t) -borderwidth 2 \
- -relief raised -lmargin1 5 -lmargin2 5
+ $top.out tag configure $t -background $colors($t) -borderwidth 2 \
+ -relief raised -lmargin1 5 -lmargin2 5
+ $top.out tag configure time_$t -background $colors($t) -borderwidth 2 \
+ -relief raised -lmargin1 5 -lmargin2 5 -font $state(fixedbold)
}
- $top.out tag raise sel ;# Selection is most prominent
+ $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]
grid $top.top - -row 0 -sticky ew -ipady 10
grid $top.out $top.yscroll -sticky news
- grid $top.xscroll -sticky ew
+ grid $top.xscroll -sticky ew
- grid rowconfigure $top 1 -weight 1
+ grid rowconfigure $top 1 -weight 1
grid columnconfigure $top 0 -weight 1
grid $top.top.c $top.top.ce -row 0 -sticky ew
- grid $top.top.s $top.top.se -sticky ew
- grid $top.top.m $top.top.me -sticky ew
+ grid $top.top.s $top.top.se -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
}
#
proc doFont {delta} {
global state
- set size [font configure $state(fixed) -size]
- incr size $delta
- font configure $state(fixed) -size $size
- font configure $state(fixedbold) -size $size
+ incr state(fontSize) $delta
+ font configure $state(fixed) -size $state(fontSize)
+ font configure $state(fixedbold) -size $state(fontSize)
}
##+##########################################################################
#
proc clearOutput {} {
global state
if {$state(gui)} {
- .out delete 0.0 end
- catch {.extract.out delete 0.0 end}
+ .out delete 0.0 end
+ catch {.extract.out delete 0.0 end}
}
set state(playback) ""
}
proc redraw {} {
global state
- set save_as $state(autoscroll) ;# Disable autoscrolling
+ set save_as $state(autoscroll) ;# Disable autoscrolling
set state(autoscroll) 0
- set p $state(playback) ;# Save what gets displayed
- clearOutput ;# Erase current screen
- foreach {who data} $p { ;# Replay the input stream
- insertData $who $data 1
+ set p $state(playback) ;# Save what gets displayed
+ clearOutput ;# Erase current screen
+ foreach {who data time} $p { ;# Replay the input stream
+ insertData $who $data $time 1
}
set state(autoscroll) $save_as
}
global state but
set but -1
- after 1 {set but [tk_dialog .what "SockSpy Save" "Save which window?" \
- questhead 2 server client both cancel]}
- after 1 tk_dialogFIX
- vwait but
+ set but [tk_dialog .what "SockSpy Save" "Save which window?" \
+ questhead 2 server client both cancel]
if {$but == -1 || $but == 3} {
- return
+ return
}
set file [tk_getSaveFile -parent . -initialfile $state(fname)]
if {$file == ""} return
set state(fname) $file
if {[catch {open $file w} fd]} {
- tk_messageBox -message "file $file cannot be opened" -icon error \
- -type ok
- return
+ tk_messageBox -message "file $file cannot be opened" -icon error \
+ -type ok
+ return
}
fconfigure $fd -translation binary
- foreach {who data} $state(playback) {
- if {$who == "meta" || $who == "meta2"} continue
- if {$but == 2 || ($but == 0 && $who == "server") || \
- ($but == 1 && $who == "client")} {
- puts $fd $data
- }
+ foreach {who data time} $state(playback) {
+ if {$who == "meta" || $who == "meta2"} continue
+ if {$but == 2 || ($but == 0 && $who == "server") || \
+ ($but == 1 && $who == "client")} {
+ if {$state(time)} {
+ puts $fd [timestamp $time]
+ }
+ puts $fd $data
+ }
}
close $fd
bell
}
##+##########################################################################
#
-# tk_dialogFIX
-#
-# tk_dialog is SOOO ugly. This is a bit of a hack to at least put
-# some padding around the buttons. This probably will break under
-# future versions hence the catch.
-#
-proc tk_dialogFIX {} {
- if {[winfo exists .what] == 0} { ;# Don't do anything...
- after 200 tk_dialogFix ;# ...until window is mapped
- } else {
- catch {grid configure .what.button0 -pady 10}
- }
-}
-##+##########################################################################
-#
# printable -- Replaces all unprintable characters into dots.
#
proc printable {s {spaces 0}} {
regsub -all {[^\x09\x20-\x7e]} $s "." n
if {$spaces} {
- regsub -all { } $n "_" n
+ regsub -all { } $n "_" n
}
return $n;
}
# insertData -- Inserts data into the output window. WHO tells us if it is
# from the client, server or meta.
#
-proc insertData {who data {force 0}} {
+proc insertData {who data {time {}} {force 0}} {
global state
array set prefix {meta = meta2 = client > server <}
- DoExtract $who $data ;# Display any extracted data
- if {! $force && ! $state(capture)} return ;# No display w/o capture on
- lappend state(playback) $who $data ;# Save for redraw and saving
+ if {$time == ""} { ;# If not set, then set to now
+ set time [clock seconds]
+ }
+ set timestamp [timestamp $time]
+
+ DoExtract $who $data $timestamp ;# Display any extracted data
+ if {! $force && ! $state(capture)} return ;# No display w/o capture on
+ lappend state(playback) $who $data $time ;# Save for redraw and saving
if {$state(ascii) || [regexp {^meta2?$} $who] } {
- regsub -all \r $data "" data
- foreach line [split $data \n] {
- set line [printable $line]
- set tag $who
- if {$tag == "client" && [regexp -nocase {^get |^post } $line]} {
- lappend tag client2
- }
- if {$state(gui)} {
- .out insert end "$line\n" $tag
- } else {
- puts "$prefix($who)$line"
- }
- }
- } else { ;# Hex output
- while {[string length $data]} {
- set line [string range $data 0 15]
- set data [string range $data [string length $line] end]
- binary scan $line H* hex
- regsub -all {([0-9a-f][0-9a-f])} $hex {\1 } hex
- set line [format "%-48.48s %-16.16s\n" $hex [printable $line 1]]
- if {$state(gui)} {
- .out insert end $line $who
- } else {
- puts "$prefix(who)$line"
- }
- }
+ regsub -all \r $data "" data
+ foreach line [split $data \n] {
+ set line [printable $line]
+ set tag $who
+ if {$tag == "client" && [regexp -nocase {^get |^post } $line]} {
+ lappend tag client2
+ }
+ if {$state(gui)} {
+ .out insert end "$timestamp" time_$tag "$line\n" $tag
+ } else {
+ puts "$timestamp$prefix($who)$line"
+ }
+ }
+ } else { ;# Hex output
+ while {[string length $data]} {
+ set line [string range $data 0 15]
+ set data [string range $data [string length $line] end]
+ binary scan $line H* hex
+ regsub -all {([0-9a-f][0-9a-f])} $hex {\1 } hex
+ set line [format "%-48.48s %-16.16s\n" $hex [printable $line 1]]
+ if {$state(gui)} {
+ .out insert end "$timestamp" time_$who "$line" $who
+ } else {
+ puts "$timestamp$prefix(who)$line"
+ }
+ }
}
if {$state(autoscroll) && $state(gui)} {
- .out see end
+ .out see end
+ }
+}
+##+##########################################################################
+#
+# timestampInit -- Initialize timestamp support
+#
+proc timestampInit {} {
+ global state
+
+ set state(timeFormat) $state(timeFormatDefault)
+}
+##+##########################################################################
+#
+# timestamp -- Produce printable timestamps
+#
+# Note that it is the user's responsibility to make sure the
+# user-supplied format ends with a delimiter or separator such as a
+# space or colon. The timestamp code itself checks whether or not it
+# should do anything to simplify the many different places in the code
+# from which can be called.
+
+proc timestamp {time} {
+ global state
+
+ if {! $state(time)} { return "" }
+ return [clock format $time -format $state(timeFormat)]
+}
+##+###########################################################################
+#
+# timestampWindow -- Dialog for the user to configure the timestamp format.
+#
+proc timestampWindow {} {
+ global state
+
+ set state(oldTimeFormat) $state(timeFormat)
+
+ set w .tf2
+ destroy .tf
+ toplevel .tf
+ wm title .tf "SockSpy Time Format"
+
+ set txt "Edit the format used for timestamps. "
+ append txt "See Tcl's clock command documentation for a complete "
+ append txt "description of acceptable formats."
+
+ frame .tf.top -bd 2 -relief raised -padx 5
+
+ message .tf.t -aspect 500 -text $txt
+ label .tf.l -text "Format: "
+ entry .tf.e -textvariable state(timeFormat)
+ button .tf.default -text Default -width 10 -command {tfButton default}
+ button .tf.ok -text OK -width 10 -command {tfButton ok}
+ button .tf.cancel -text Cancel -width 10 -command {tfButton cancel}
+
+ grid .tf.top -row 0 -column 0 -columnspan 4 -sticky ew -padx 10 -pady 10
+ grid columnconfigure .tf 0 -weight 1
+ grid x .tf.default .tf.ok .tf.cancel -padx 5 -sticky ew
+ grid rowconfigure .tf 2 -minsize 8
+
+ grid .tf.t - -in .tf.top -row 0
+ grid .tf.l .tf.e -in .tf.top -row 1 -pady 10 -sticky ew
+ grid columnconfigure .tf.top 1 -weight 1
+ grid columnconfigure .tf.top 2 -minsize 10
+
+ focus .tf.e
+ .tf.e icursor end
+ .tf.e select range 0 end
+}
+##+##########################################################################
+#
+# tfButton -- handles button clicks on the timestamp dialog
+#
+proc tfButton {who} {
+ if {$who == "defaut"} {
+ set ::state(timeFormat) $::state(timeFormatDefault)
+ } elseif {$who == "ok"} {
+ destroy .tf
+ redraw
+ } elseif {$who == "cancel"} {
+ set ::state(timeFormat) $::state(oldTimeFormat)
+ destroy .tf
}
}
##+##########################################################################
# Puts up an informational message both in the output window and
# in the status window.
#
-proc INFO {msg {who meta} {display 0}} {
+proc INFO {msg {who meta} {time {}} {display 0}} {
global state
set state(msg) $msg
- insertData $who $msg $display
+ insertData $who $msg $time $display
}
proc ERROR {emsg} {
if {$::state(gui)} {
- tk_messageBox -title "SockSpy Error" -message $emsg -icon error
+ tk_messageBox -title "SockSpy Error" -message $emsg -icon error
} else {
- puts $emsg
+ puts $emsg
}
}
##+##########################################################################
global state
set data [read $fromSock]
if {[string length $data] == 0} {
- close $fromSock
- catch { close $toSock }
- insertData meta "----- closed connection -----"
- INFO "waiting for new connection..."
- return
- }
- if {$toSock == ""} { ;# Not connected yet
- ProxyConnect $fromSock $data ;# Do proxy forwarding
+ close $fromSock
+ catch { close $toSock }
+ insertData meta "----- closed connection -----"
+ INFO "waiting for new connection..."
+ return
+ }
+ if {$toSock == ""} { ;# Not connected yet
+ ProxyConnect $fromSock $data ;# Do proxy forwarding
} else {
- catch { puts -nonewline $toSock $data } ;# Forward if we have a socket
+ catch { puts -nonewline $toSock $data } ;# Forward if we have a socket
}
insertData $who $data
update
set line1 [lindex [split $data \r] 0]
set bad [regexp -nocase {(http:[^ ]+)} $line1 => uri]
if {$bad == 0} {
- INFO "ERROR: cannot extract URI from '$line1'"
- close $fromSock
- insertData meta "----- closed connection -----"
- insertData meta "waiting for new connection..."
+ INFO "ERROR: cannot extract URI from '$line1'"
+ close $fromSock
+ insertData meta "----- closed connection -----"
+ insertData meta "waiting for new connection..."
}
- set state(uri) $uri ;# For debugging
+ set state(uri) $uri ;# For debugging
array set URI [::uri::split $uri]
if {$URI(port) == ""} { set URI(port) 80 }
set bad [catch {set sockServ [socket $URI(host) $URI(port)]} reason]
if {$bad} {
- set msg "cannot connect to $URI(host):$URI(port) => $reason"
- INFO $msg
- close $fromSock
- ERROR $msg
- insertData meta "----- closed connection -----"
- insertData meta "waiting for new connection..."
- return
+ set msg "cannot connect to $URI(host):$URI(port) => $reason"
+ INFO $msg
+ close $fromSock
+ ERROR $msg
+ insertData meta "----- closed connection -----"
+ insertData meta "waiting for new connection..."
+ return
}
INFO "fowarding to $URI(host):$URI(port)" meta2
fileevent $fromSock readable \
- [list sockReadable $fromSock $sockServ client]
+ [list sockReadable $fromSock $sockServ client]
fconfigure $sockServ -blocking 0 -buffering none -translation binary
fileevent $sockServ readable \
- [list sockReadable $sockServ $fromSock server]
+ [list sockReadable $sockServ $fromSock server]
puts -nonewline $sockServ $data
}
##+##########################################################################
INFO "connect from [fconfigure $sockClnt -sockname] $port" meta2
if {$state(proxy) || $SP(servHost) == {} || $SP(servHost) == "none"} {
- set sockServ ""
+ set sockServ ""
} else {
- set n [catch {set sockServ [socket $SP(servHost) $SP(servPort)]} reason]
- if {$n} {
- INFO "cannot connect: $reason"
- close $sockClnt
- ERROR "cannot connect to $SP(servHost) $SP(servPort): $reason"
- insertData meta "----- closed connection -----"
- insertData meta "waiting for new connection..."
-
- }
- INFO "connecting to $SP(servHost):$SP(servPort)" meta2
+ set n [catch {set sockServ [socket $SP(servHost) $SP(servPort)]} reason]
+ if {$n} {
+ INFO "cannot connect: $reason"
+ close $sockClnt
+ ERROR "cannot connect to $SP(servHost) $SP(servPort): $reason"
+ insertData meta "----- closed connection -----"
+ insertData meta "waiting for new connection..."
+
+ }
+ INFO "connecting to $SP(servHost):$SP(servPort)" meta2
}
;# Configure connection to the client
fconfigure $sockClnt -blocking 0 -buffering none -translation binary
fileevent $sockClnt readable \
- [list sockReadable $sockClnt $sockServ client]
+ [list sockReadable $sockClnt $sockServ client]
;# Configure connection to the server
if {[string length $sockServ]} {
- fconfigure $sockServ -blocking 0 -buffering none -translation binary
- fileevent $sockServ readable \
- [list sockReadable $sockServ $sockClnt server]
+ fconfigure $sockServ -blocking 0 -buffering none -translation binary
+ fileevent $sockServ readable \
+ [list sockReadable $sockServ $sockClnt server]
}
}
##+##########################################################################
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
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
+ set n [catch {close $state(listen)} emsg]
+ if {$n} { INFO "socket close error: $emsg"}
+ set state(listen) ""
+ update ;# Need else socket below fails
}
# Listen on clntPort or proxyPort for incoming connections
set n [catch {set state(listen) [socket -server clntConnect $port]} emsg]
if {$n} {
- INFO "socket open error: $emsg"
- set state(title) "not connected"
- set rval 0
+ INFO "socket open error: $emsg"
+ set state(title) "not connected"
+ set rval 0
} else {
- if {$state(proxy)} {
- set state(title) "proxy localhost:$SP(proxyPort)"
- } else {
- set state(title) "localhost:$SP(clntPort) <--> "
- append state(title) "$SP(servHost):$SP(servPort)"
- }
- INFO $state(title)
- INFO "waiting for new connection..."
+ if {$state(proxy)} {
+ set state(title) "proxy localhost:$SP(proxyPort)"
+ } else {
+ set state(title) "localhost:$SP(clntPort) <--> "
+ append state(title) "$SP(servHost):$SP(servPort)"
+ }
+ INFO $state(title)
+ INFO "waiting for new connection..."
}
wm title . "SockSpy -- $state(title)"
return $rval
proc GetSetup {} {
global state SP ok
array set save [array get SP]
- set ok 0 ;# Assume cancelling
+ set ok 0 ;# Assume cancelling
;# Put in some default values
if {![string length $SP(proxyPort)]} {set SP(proxyPort) 8080}
- if {![string length $SP(clntPort)]} {set SP(clntPort) 8080}
- if {![string length $SP(servPort)]} {set SP(servPort) 80}
+ if {![string length $SP(clntPort)]} {set SP(clntPort) 8080}
+ if {![string length $SP(servPort)]} {set SP(servPort) 80}
if {! $state(gui)} {
- catch {close $state(listen)}
-
- set d "no" ; if {$state(proxy)} { set d yes }
- set p [Prompt "Proxy mode" $d]
- if {[regexp -nocase {^y$|^yes$} $p]} {
- set state(proxy) 1
- set SP(proxyPort) [Prompt "proxy port" $SP(proxyPort)]
- } else {
- set state(proxy) 0
- set SP(clntPort) [Prompt "Client port" $SP(clntPort)]
- set SP(servHost) [Prompt "Server host" $SP(servHost)]
- set SP(servPort) [Prompt "Server port" $SP(servPort)]
- }
- DoListen
- return
+ catch {close $state(listen)}
+
+ set d "no" ; if {$state(proxy)} { set d yes }
+ set p [Prompt "Proxy mode" $d]
+ if {[regexp -nocase {^y$|^yes$} $p]} {
+ set state(proxy) 1
+ set SP(proxyPort) [Prompt "proxy port" $SP(proxyPort)]
+ } else {
+ set state(proxy) 0
+ set SP(clntPort) [Prompt "Client port" $SP(clntPort)]
+ set SP(servHost) [Prompt "Server host" $SP(servHost)]
+ set SP(servPort) [Prompt "Server port" $SP(servPort)]
+ }
+ DoListen
+ return
}
destroy .dlg
toplevel .dlg
- wm title .dlg "Sockspy Setup"
+ wm title .dlg "SockSpy Setup"
wm geom .dlg +176+176
#wm transient .dlg .
append msg "protocol to dynamically determine the server and\n"
append msg "port to forward data to."
- #labelframe .dlg.fforward -text "Fixed Server Forwarding"
- #labelframe .dlg.fproxy -text "HTTP Proxy"
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
+ -variable state(proxy) -value 0 -anchor w -command GetSetup2
label .dlg.fl1 -text "Client Port:" -anchor e
entry .dlg.fe1 -textvariable SP(clntPort)
entry .dlg.fe3 -textvariable SP(servPort)
radiobutton .dlg.proxy -text "Use HTTP Proxying" \
- -variable state(proxy) -value 1 -anchor w -command GetSetup2
+ -variable state(proxy) -value 1 -anchor w -command GetSetup2
label .dlg.pl1 -text "Proxy Port:" -anchor e
entry .dlg.pe1 -textvariable SP(proxyPort)
- button .dlg.ok -text OK -width 10 -command [list ValidForm 1]
+
+ label .dlg.cllabel -text "Command Line Equivalent"
+ entry .dlg.clvar -textvariable SP(cmdLine) \
+ -borderwidth 2 -relief sunken
+ # -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]
grid .dlg.top -row 0 -column 0 -columnspan 3 -sticky ew -padx 10 -pady 10
grid rowconfigure .dlg 2 -minsize 8
pack .dlg.msg -in .dlg.top -side top -fill x -padx 10 -pady 5
- pack .dlg.fforward .dlg.fproxy -in .dlg.top -side top -fill x \
- -padx 10 -pady 10
+ pack .dlg.fforward .dlg.fproxy .dlg.fcmdline -in .dlg.top \
+ -side top -fill x -padx 10 -pady 10
+ grid .dlg.cllabel -in .dlg.fcmdline -row 0 -column 0 -sticky w
+ grid .dlg.clvar -in .dlg.fcmdline -row 1 -column 0 -sticky ew
+ grid columnconfigure .dlg.fcmdline 0 -weight 1
+ # no need for row/col configure
+
grid .dlg.proxy - - -in .dlg.fproxy -sticky w
grid x .dlg.pl1 .dlg.pe1 -in .dlg.fproxy -sticky ew
grid columnconfigure .dlg.fproxy 0 -minsize .2i
grid rowconfigure .dlg.fforward 4 -minsize 10
raise .dlg
- bind .dlg.forward <Return> [bind all <Key-Tab>]
+ bind .dlg.forward <Return> [bind all <Key-Tab>]
bind .dlg.proxy <Return> [bind all <Key-Tab>]
bind .dlg.fe1 <Return> [bind all <Key-Tab>]
bind .dlg.fe2 <Return> [bind all <Key-Tab>]
GetSetup2
.dlg.pe1 icursor end
.dlg.fe2 icursor end
+
+ # trace all variables involved in the Setup window
+ trace variable state(proxy) w cmdlineUpdate
+ trace variable SP w cmdlineUpdate
+ cmdlineUpdate SP servHost w
+
if {$state(proxy)} { focus -force .dlg.pe1 } { focus -force .dlg.fe2 }
raise .dlg
wm deiconify .
if {$ok} {
- DoListen
+ DoListen
} else {
- array set SP [array get save]
+ array set SP [array get save]
}
}
+##+##########################################################################
+#
+# GetSetup2 -- toggles between forwarding and proxying modes in the dialog
+#
proc GetSetup2 {} {
global state
array set s {1 normal 0 disabled}
.dlg.pl1 config -state $s(1)
.dlg.pe1 config -state $s(1)
foreach w {1 2 3} {
- .dlg.fl$w config -state $s(0)
- .dlg.fe$w config -state $s(0)
+ .dlg.fl$w config -state $s(0)
+ .dlg.fe$w config -state $s(0)
}
}
-proc ValidForm {kill} {
+##+##########################################################################
+#
+# ValidForm -- if setup dialog has valid entries then kill the dialog
+#
+proc ValidForm {} {
global state SP ok
set ok 0
if {$state(proxy)} {
- if {$SP(proxyPort) != ""} {set ok 1}
+ if {$SP(proxyPort) != ""} {set ok 1}
} elseif {$SP(clntPort) !="" && $SP(servHost) !="" && $SP(servPort) !=""} {
- set ok 1
+ set ok 1
}
- if {$ok && $kill} {destroy .dlg}
+ if {$ok} {destroy .dlg}
return $ok
}
+##+#########################################################################
+#
+# cmdlineUpdate
+#
+# cmdlineUpdate watches the connection variables and updates the command-line
+# equivalent.
+#
+proc cmdlineUpdate {X elt X} {
+ global SP
+
+ # Check that port values are integers and that server host is not empty.
+ if {$::state(proxy)} {
+ set SP(cmdLine) "sockspy -proxy $SP(proxyPort)"
+ if {! [string is integer -strict $SP(proxyPort)]} {
+ set SP(cmdLine) "none (invalid proxy port above)"
+ }
+ return
+ }
+
+ if {$SP(servHost) == ""} {
+ set SP(cmdLine) "none (invalid server host above)"
+ return
+ }
+ foreach elt {clntPort servPort} lbl {"client port" "server port"} {
+ if {! [string is integer -strict $SP($elt)]} {
+ set SP(cmdLine) "none (invalid $lbl above)"
+ return
+ }
+ }
+ set SP(cmdLine) "sockspy $SP(clntPort) $SP(servHost) $SP(servPort)"
+}
##+##########################################################################
#
# Prompt -- Non-gui way to get input from the user.
#
proc Prompt {prompt {default ""}} {
if {$default != ""} {
- puts -nonewline "$prompt ($default): "
+ puts -nonewline "$prompt ($default): "
} else {
- puts -nonewline "$prompt: "
+ puts -nonewline "$prompt: "
}
flush stdout
set n [gets stdin line]
if {$n == 0 && $default != ""} {
- set line $default
+ set line $default
}
return $line
}
global state
catch {close $state(listen)}
+ stateSaveReal ;# save all state info NOW!
exit
}
##+##########################################################################
proc ButtonBar {} {
global state
- if {$state(bbar)} { ;# Need to add button bar
- pack .cmd -side top -fill x -pady 5 -in .bbar
+ if {$state(bbar)} { ;# Need to add button bar
+ pack .cmd -side top -fill x -pady 5 -in .bbar
} else {
- pack forget .cmd
- .bbar config -height 1 ;# Need this to give remove gap
+ pack forget .cmd
+ .bbar config -height 1 ;# Need this to give remove gap
}
}
##+##########################################################################
proc ToggleExtract {{how 0}} {
global state
- if {$how == -1} { ;# Hard kill
- destroy .extract
- set state(extract) 0
- return
+ if {$how == -1} { ;# Hard kill
+ destroy .extract
+ set state(extract) 0
+ return
}
if {$state(extract)} {
- createExtract
+ createExtract
} else {
- catch {wm withdraw .extract}
+ catch {wm withdraw .extract}
}
}
##+##########################################################################
proc ToggleCapture {} {
global state
if {$state(capture)} {
- INFO "Data capture display enabled" meta
- .out config -bg white
+ INFO "Data capture display enabled" meta
+ .out config -bg white
} else {
- INFO "Data capture display disabled" meta 1
- .out config -bg grey88
+ INFO "Data capture display disabled" meta 1
+ .out config -bg grey88
}
}
##+##########################################################################
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 "then connects to the real server. Data from the client is passed "
- append m "onto the server, and data from the server is passed onto the "
+ append m "on to the server, and data from the server is passed onto the "
append m "client.\n\n"
append m "Along the way, the data streams are also displayed in text "
append m "widget with data sent from the client displayed in green, data "
append m "from the server in blue and connection metadata in red. The data "
- append m "can be displayed as printable ASCII strings, or as a hex dump "
- append m "format of both hex and printable characters.\n\n"
+ 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
set m "Why might you want to use SockSpy? Debugging tcp client/server "
append m "programs, examining protocols and diagnosing network problems "
append m "are top candidates. Perhaps you just want to figure out how "
- append m "somethings work. I've used it to bypass firewalls, to rediscover "
+ append m "something works. I've used it to bypass firewalls, to rediscover "
append m "my lost smtp password, to access a news server on a remote "
- append m "network, etc.\n\nIt's not a replacement for heavy duty tools "
+ append m "network, etc.\n\nIt's not a replacement for heavy-duty tools "
append m "such as 'tcpdump' and other passive packet sniffers. On the "
- append m "other hand, SockSpy doesn't require any special priviledges to "
+ 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
set m "To start SockSpy in text mode without a GUI:\n"
.help.t insert end $m n
- set m "$ tclsh sockspy <listen-port> <server-host> <server-port>\n or\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
append m "dialog, or by specifying -proxy on the command line.\n\n"
.help.t insert end "Proxy Mode\n" header $m n
- set m "The extract window lets you extract out specific parts of the "
- append m "data stream. As data arrives from the client, server or as "
- append m "metadata it gets matched against the appropriate regular "
- append m "expression filter. If it matches, then the data gets displayed "
+ 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 "metadata, it gets matched against the appropriate regular "
+ 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
#
# DoExtract -- Displays any data matching the RE in the extract window
#
-proc DoExtract {who data} {
+proc DoExtract {who data timestamp} {
global state extract
if {! $state(gui)} return
regsub -all \r $data "" data
foreach line [split $data \n] {
- if {$extract($who) == ""} continue
- catch {
- if {[regexp -nocase $extract($who) $line]} {
- .extract.out insert end "$line\n" $who
- }
- }
+ if {$extract($who) == ""} continue
+ catch {
+ if {[regexp -nocase $extract($who) $line]} {
+ .extract.out insert end "$timestamp" time_$who
+ .extract.out insert end "$line\n" $who
+ }
+ }
}
if {$state(autoscroll)} {
- .extract.out see end
+ .extract.out see end
}
}
+##+##########################################################################
+#
+# stateRestore - Initialize save/restore package and do restore.
+#
+proc stateRestore {} {
+ global env state SP extract
+
+ switch $::tcl_platform(platform) "macintosh" {
+ set stateFile [file join $env(PREF_FOLDER) "SockSpy Preferences"]
+ } "windows" {
+ set stateFile [file join $env(HOME) "sockspy.cfg"]
+ } "unix" {
+ if {[info exists env(DOTDIR)]} {
+ set stateFile [file join $env(DOTDIR) .sockspy]
+ } else {
+ set stateFile [file join $env(HOME) .sockspy]
+ }
+ }
+
+ # complain only if it exists and we fail to read it successsfully
+ if {[file exists $stateFile]} {
+ uplevel #0 source $stateFile
+ }
+
+ set state(stateFile) $stateFile
+
+ foreach v $::saveList {
+ trace variable $v w stateSave
+ }
+}
+##+#########################################################################
+#
+# stateSave and stateSaveReal - Save program state.
+#
+# Two procs are used to do this. stateSave is called to schedule the save.
+# stateSaveReal is called to actually do the save.
+#
+# stateSave schedules the save a short time in the future to avoid interfering
+# with the UI. This is especially a problem with the "extract" variables which
+# aren't edited from a modal dialogue and thus have no associated "OK" button
+# to tell us when to save them. (The alternative would be to save them after
+# every keystroke - yuk.)
+#
+proc stateSave {a b c} {
+ catch {after cancel $::state(saveId)}
+ set ::state(saveId) [after 5000 stateSaveReal]
+}
+
+proc stateSaveReal {} {
+ global state SP extract
+
+ # silently ignore open failure
+ if {[catch {open $state(stateFile) w} sf]} return
+
+ set now [clock format [clock seconds] -format %c]
+ puts $sf "# SockSpy Initialization File"
+ puts $sf "# Written by SockSpy $state(version) on $now."
+ puts $sf "#"
+ puts $sf "# Warning: If you edit this file while SockSpy is running, "
+ puts $sf "# edits will be lost! Also, only edit the lines already here. "
+ puts $sf "# If you add procs or more variables, they will not be saved."
+
+ puts $sf ""
+ foreach v $::saveList {
+ puts $sf "set $v \"[string map {[ \\[ \\ \\\\} [set $v]]\""
+ }
+ close $sf
+}
+
################################################################
################################################################
################################################################
set state(gui) [info exists tk_version]
if {[catch {package present uri}]} {
ERROR "ERROR: SockSpy requires the uri package from tcllib."
- exit 0
+ exit 1
}
-if {$state(gui)} { wm withdraw . }
-createMain
+timestampInit
+stateRestore
+
+if {$state(gui)} createMain
-if {[lindex $argv 0] == "-go"} {
+if {[lindex $argv 0] == "-local"} {
set argv [list 8080 localhost 80]
set argc 3
}
if {[lindex $argv 0] == "-proxy"} {
set state(proxy) 1
if {$argc == 2} {
- set SP(proxyPort) [lindex $argv 1]
- DoListen
+ set SP(proxyPort) [lindex $argv 1]
+ DoListen
} else {
- GetSetup
+ GetSetup
}
} else {
- set state(proxy) 0
if {$argc >= 1} { set SP(clntPort) [lindex $argv 0] }
if {$argc >= 2} { set SP(servHost) [lindex $argv 1] }
if {$argc >= 3} { set SP(servPort) [lindex $argv 2] }
if {$argc >= 3} {
- DoListen
+ DoListen
} else {
- GetSetup
+ GetSetup
}
}
+if {$state(extract)} createExtract
+
if {! $state(gui)} {
- vwait forever ;# tclsh needs this
+ vwait forever ;# tclsh needs this
} else {
wm deiconify .
}
projects / sockspy / commitdiff