From: Pat Thoyts Date: Thu, 26 Nov 2009 23:41:21 +0000 (+0000) Subject: sockspy version 2.5 X-Git-Tag: v2.5 X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=517df25d7e068ffee8e8c481f735598b7a8a0fd2;p=sockspy sockspy version 2.5 This version is not in cvs but is the current release in the zip archive. Signed-off-by: Pat Thoyts --- diff --git a/bin/sockspy.tcl b/bin/sockspy.tcl index 852c412..6e2f870 100644 --- a/bin/sockspy.tcl +++ b/bin/sockspy.tcl @@ -1,33 +1,36 @@ #!/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 @@ -36,19 +39,47 @@ array set state { 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 @@ -56,16 +87,15 @@ set extract(meta2) {.} 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 @@ -76,34 +106,38 @@ proc createMain {} { .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 @@ -115,14 +149,16 @@ proc createMain {} { 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] @@ -130,7 +166,8 @@ proc createMain {} { 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 @@ -141,18 +178,21 @@ proc createMain {} { 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 clearOutput @@ -168,15 +208,15 @@ proc createExtract {} { 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 @@ -188,26 +228,28 @@ proc createExtract {} { 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 } @@ -217,11 +259,10 @@ proc createExtract {} { # 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) } ##+########################################################################## # @@ -230,8 +271,8 @@ proc doFont {delta} { 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) "" } @@ -244,13 +285,13 @@ proc clearOutput {} { 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 } @@ -264,57 +305,43 @@ proc saveOutput {} { 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; } @@ -323,44 +350,130 @@ proc printable {s {spaces 0}} { # 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 } } ##+########################################################################## @@ -370,16 +483,16 @@ proc insertData {who data {force 0}} { # 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 } } ##+########################################################################## @@ -390,16 +503,16 @@ proc sockReadable {fromSock toSock who} { 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 @@ -415,30 +528,30 @@ proc ProxyConnect {fromSock data} { 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 } ##+########################################################################## @@ -453,30 +566,30 @@ proc clntConnect {sockClnt ip port} { 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] } } ##+########################################################################## @@ -490,14 +603,14 @@ proc DoListen {} { 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 @@ -506,18 +619,18 @@ proc DoListen {} { 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 @@ -529,34 +642,34 @@ proc DoListen {} { 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 . @@ -566,14 +679,13 @@ proc GetSetup {} { 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) @@ -583,10 +695,16 @@ proc GetSetup {} { 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 @@ -596,9 +714,14 @@ proc GetSetup {} { 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 @@ -616,7 +739,7 @@ proc GetSetup {} { grid rowconfigure .dlg.fforward 4 -minsize 10 raise .dlg - bind .dlg.forward [bind all ] + bind .dlg.forward [bind all ] bind .dlg.proxy [bind all ] bind .dlg.fe1 [bind all ] bind .dlg.fe2 [bind all ] @@ -626,6 +749,12 @@ proc GetSetup {} { 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 @@ -633,11 +762,15 @@ proc GetSetup {} { 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} @@ -646,36 +779,71 @@ proc GetSetup2 {} { .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 } @@ -687,6 +855,7 @@ proc Shutdown {} { global state catch {close $state(listen)} + stateSaveReal ;# save all state info NOW! exit } ##+########################################################################## @@ -696,11 +865,11 @@ proc Shutdown {} { 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 } } ##+########################################################################## @@ -710,15 +879,15 @@ proc ButtonBar {} { 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} } } ##+########################################################################## @@ -737,11 +906,11 @@ proc ToggleWrap {} { 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 } } ##+########################################################################## @@ -776,24 +945,24 @@ proc Help {} { 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 @@ -812,7 +981,7 @@ proc Help {} { set m "To start SockSpy in text mode without a GUI:\n" .help.t insert end $m n - set m "$ tclsh sockspy \n or\n" + set m "$ tclsh sockspy \n or\n" append m "$ tclsh sockspy -proxy \n\n" .help.t insert end $m fixed @@ -831,10 +1000,10 @@ proc Help {} { 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 @@ -867,7 +1036,7 @@ proc About {} { # # 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 @@ -876,17 +1045,87 @@ proc DoExtract {who data} { 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 +} + ################################################################ ################################################################ ################################################################ @@ -894,13 +1133,15 @@ proc DoExtract {who data} { 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 } @@ -908,25 +1149,26 @@ if {[lindex $argv 0] == "-go"} { 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 . }