#!/usr/local/bin/wish
#
# 2003-10-18  Umberto Salsi <salsi@icosaedro.it>
# www.icosaedro.it

set PROG_NAME [exec basename $argv0]
set VERSION "1.1"
set PREFS "$env(HOME)/.$PROG_NAME.prefs"

# imposta default:
set terminal "xterm -hold -e"
set interface lo
set more_protocol_info 0
set parse_packets 0
set print_time 0
set save_on_exit 1
set show_ascii_too 0
set show_hex 0
set show_host_name 0
set show_net_name 0
set show_port_name 0
set snaplens 68
set verbosity 0

set filter_hosts 0
set host1 "[info hostname]"
set host2 ""

set filter_proto 0
set proto1 "--"
set proto2 "--"
set proto3 "--"

set filter_port 0
set port1 ""
set port2 ""
set port3 ""

set no_promisc 0
set drop_privileges 0
set user ""
set print_link_level 0

set decrypt 0
set decrypt_algo "none"
set decrypt_secret ""
set decrypt_save_secret 0

set undecoded_nfs 0


set padx 10
set pady 10

set butw 10

set font_norm "Helvetica 12"
set font_em "Helvetica 12 bold"
set font_but "Helvetica 12 bold"

############################################
##
## Dialog box std
##
############################################

proc Errore { msg } {
	tk_dialog .zzz "Error" $msg error 0 "OK"
}


proc Avviso { msg } {
	tk_dialog .zzz "Notice" $msg info 0 "OK"
}


#############################################
##
## Std Exec
##
#############################################

proc Exec { cmd varName } {
	upvar $varName var
	if { [catch {eval $cmd} var] } {
		Errore "Failed to execute the command:\n\n    $cmd\n\nbecause:\n\n$var"
		return 0
	} else {
		return 1
	}
}


####################################
##
## StdXxx
##
####################################

proc StdButt { path name cmd } {
	global font_but
	button $path -text $name -width 10 -command $cmd -font $font_but
	#pack $path
}


proc StdEntry { w label varname width args } {
	global font_norm
	frame $w
	#pack $w
	label $w.l -text $label -font $font_norm
	pack $w.l -side left
	entry $w.v -textvariable $varname -background white -width $width
	pack $w.v -side left
	if { [string length $args] > 0 } {
		label $w.l2 -text $args -font $font_norm
		pack $w.l2 -side left
	}
}


proc Premi { bottone } {
	$bottone configure -relief sunken ;# premi il bottone
	update ;# aggiorna finestra
	after 500 ;# aspetta mezzo secondo
	$bottone configure -relief raised ;# rilascia il bottone
	$bottone invoke ;# esegue comando associato al bottone
}



proc add_slashes_sh { s } {
#
# Converte la stringa $s in una stringa interpretabile letteralmente
# dallo shell.
#
	regsub -all "\\\\" $s "\\\\\\\\"  s
	regsub -all "\""   $s "\\\""  s
	#regsub -all "\\("  $s "\\("   s
	#regsub -all "\\)"    $s "\\\\)" s
	regsub -all "\\\$" $s "\\\\\$"    s
	regsub -all "`"    $s "\\\\`" s
	return $s
}


proc build_cmd {} {
	global interface \
		filter_hosts host1 host2 \
		filter_ports port1 port2 port3 \
		filter_proto proto1 proto2 proto3 \
		more_protocol_info \
		no_promisc \
		drop_privileges user \
		print_link_level \
		decrypt decrypt_algo decrypt_secret \
		undecoded_nfs \
		parse_packets \
		print_time \
		show_ascii_too \
		show_hex \
		show_host_name \
		show_net_name \
		show_port_name \
		snaplens \
		verbosity \

	# BUG: qui fai il parsing della stringa $snaplens.
	if { $snaplens < 68 || $snaplens > 65535 } {
		Errore "Value out of the range \[68,65535\] for the number of bytes to snap.\n\nForcing to the nearest limit."
		if { $snaplens < 0 } {
			set snaplens 68
		} else {
			set snaplens 65535
		}
	}
	set cmd "tcpdump -i $interface -s $snaplens -l"

	#
	# filtri:
	#

	set filter ""
	proc add_factor { x } {
		upvar filter filter
		if { [string compare $x ""] == 0 } {
			return
		}
		if { [string compare $filter ""] == 0 } {
			set filter "\\( $x \\)"
		} else {
			set filter "$filter and \\( $x \\)"
		}
	}
	proc add_term { x } {
		if { [string compare $x ""] == 0 } {
			return
		}
		upvar term term
		if { [string compare $term ""] == 0 } {
			set term $x
		} else {
			set term "$term or $x"
		}
	}
	if { $filter_hosts } {
		set term ""
		if { "/$host1" > "/" } { add_term "host $host1" }
		if { "/$host2" > "/" } { add_term "host $host2" }
		add_factor $term
	}
	if { $filter_proto } {
		set term ""
		if { "/$proto1" != "/--" } { add_term "ip proto \\\\$proto1" }
		if { "/$proto2" != "/--" } { add_term "ip proto \\\\$proto2" }
		if { "/$proto3" != "/--" } { add_term "ip proto \\\\$proto3" }
		add_factor $term
	}
	if { $filter_ports } {
		set term ""
		if { "/$port1" > "/" } { add_term "port $port1" }
		if { "/$port2" > "/" } { add_term "port $port2" }
		if { "/$port3" > "/" } { add_term "port $port3" }
		add_factor $term
	}


	if { $no_promisc } {
		set cmd "$cmd -p"
	}
	if { $drop_privileges } {
		set cmd "$cmd -U \"[add_slashes_sh $user]\""
	}
	if { $print_link_level } {
		set cmd "$cmd -e"
	}
	if { $decrypt } {
		set cmd "$cmd -E $decrypt_algo:\"[add_slashes_sh $decrypt_secret]\""
	}
	if { $undecoded_nfs } {
		set cmd "$cmd -u"
	}

	if { $parse_packets } {
		if { $show_host_name } {
			#if { $show_port_name } {
			#} else {
			#}
			if { $show_net_name } {
				set cmd "$cmd -a"
			}
		} else {
			set cmd "$cmd -nn"
		}
		if { ! $more_protocol_info } {
			set cmd "$cmd -q"
		}
		if { ! $print_time } {
			set cmd "$cmd -t"
		}
		switch -- $verbosity {
			1 { set cmd "$cmd -v" }
			2 { set cmd "$cmd -vv" }
			3 { set cmd "$cmd -vvv" }
		}
		if { $show_hex } {
			set cmd "$cmd -x"
			if { $show_ascii_too } {
				set cmd "$cmd -X"
			}
		}
		set cmd "$cmd $filter"
	} else {
		set cmd "$cmd -w - $filter | cat -vt"
	}
	return "$cmd"
}


proc ShowCmd {} {
	set cmd [build_cmd]
	Avviso "The resulting command is:\n\n    $cmd"
}


proc add_slashes { s } {
#
# Converte la stringa $s in una stringa interpretabile letteralmente
# da tcl.
#
	regsub -all "\\\\" $s "\\\\\\\\" s
	regsub -all "\\\[" $s "\\\[" s
	regsub -all "\\\$" $s "\\\$"  s
	regsub -all "\""   $s "\\\"" s
	return $s
}


proc Execute {} {
	global terminal
	set cmd [build_cmd]
	#puts "COMANDO:\n$cmd"
	eval exec [add_slashes $terminal] sh -c \"[add_slashes $cmd]\" &
}


proc save_prefs {} {
	global \
		PREFS PROG_NAME VERSION \
		interface \
		terminal \
		filter_hosts host1 host2 \
		filter_ports port1 port2 port3 \
		filter_proto proto1 proto2 proto3 \
		more_protocol_info \
		no_promisc \
		drop_privileges user \
		print_link_level \
		decrypt decrypt_algo decrypt_secret decrypt_save_secret \
		undecoded_nfs \
		parse_packets \
		print_time \
		save_on_exit \
		show_ascii_too \
		show_hex \
		show_host_name \
		show_net_name \
		show_port_name \
		snaplens \
		verbosity \
	
	if { ! $save_on_exit } {
		return
	}

	if { ! [Exec "open $PREFS w" fd] } {
		return
	}
	puts $fd "# This file is generated by $PROG_NAME v. $VERSION"
	puts $fd "set terminal \"[add_slashes $terminal]\""
	puts $fd "set interface \"[add_slashes $interface]\""
	puts $fd "set filter_hosts $filter_hosts"
	puts $fd "set host1 \"[add_slashes $host1]\""
	puts $fd "set host2 \"[add_slashes $host2]\""
	puts $fd "set filter_proto $filter_proto"
	puts $fd "set proto1 $proto1"
	puts $fd "set proto2 $proto2"
	puts $fd "set proto3 $proto3"
	puts $fd "set filter_ports $filter_ports"
	puts $fd "set port1 \"[add_slashes $port1]\""
	puts $fd "set port2 \"[add_slashes $port2]\""
	puts $fd "set port3 \"[add_slashes $port3]\""
	puts $fd "set show_ascii_too $show_ascii_too"
	puts $fd "set more_protocol_info $more_protocol_info"
	puts $fd "set no_promisc $no_promisc"
	puts $fd "set drop_privileges $drop_privileges"
	puts $fd "set user \"[add_slashes $user]\""
	puts $fd "set print_link_level $print_link_level"
	puts $fd "set decrypt $decrypt"
	puts $fd "set decrypt_algo $decrypt_algo"
	if { $decrypt_save_secret } {
		puts $fd "set decrypt_secret \"[add_slashes $decrypt_secret]\""
	}
	puts $fd "set decrypt_save_secret $decrypt_save_secret"
	puts $fd "set undecoded_nfs $undecoded_nfs"
	puts $fd "set parse_packets $parse_packets"
	puts $fd "set print_time $print_time"
	puts $fd "set save_on_exit $save_on_exit"
	puts $fd "set show_hex $show_hex"
	puts $fd "set show_host_name $show_host_name"
	puts $fd "set show_net_name $show_net_name"
	puts $fd "set show_port_name $show_port_name"
	puts $fd "set snaplens \"[add_slashes $snaplens]\""
	puts $fd "set verbosity $verbosity"
	Exec "close $fd" err
}


proc Usage {} {
	Notice"$PROG_NAME - menu interface to tcpdump\n\nUsage:  $PROG_NAME [-h] [--help] [interface]"
}


####################################
##
## Controlled Frames
##
####################################

# Routines di utilita' per creare frames il cui contenuto e' attivo
# in dipendenza di una certa condizione logica.

proc ControlledFrame { f e args } {
#
# Crea un frame controllato. $f e' il path voluto. $e e' l'espressione
# logica che se valutata vera rende il contenuto del frame attivo.
# Ritorna $f.
#
# Struttura creata:
#
#     label $f.ctrl: il campo "-text" contiene l'espressione logica
#     frame $f.space: crea l'indentazione verso destra
#
	set compound 0
	set indent 0
	if { [info exists args] } {
		foreach opt $args {
			switch -exact -- $opt {
				-compound { set compound 1 }
				-indent   { set indent 1 }
				default { puts "ControlledFrame: unknown option '$opt': ignore" }
			}
		}
	}
	frame $f
	pack $f -anchor nw -fill x
	label $f.ctrl -text $e
	if { $compound } {
		if { $indent } {
			frame $f.space -width 3
			pack $f.space -side left
			frame $f.tbar -width 20 -height 1 -background gray
			pack $f.tbar -side left -anchor nw
		}
		frame $f.vbar -width 1 -background gray
		pack $f.vbar -side left -fill y
		frame $f.bbar -width 20 -height 1 -background gray
		pack $f.bbar -side bottom -anchor nw
	} elseif { $indent } {
		frame $f.space -width 30
		pack $f.space -side left
	}
	return $f
}


proc SetWidgetVisibility { widget active } {
#
# Imposta le caratteristiche del $widget secondo il flag $active.
# Se $widget e' un frame, procede ricorsivamente, cercando in ogni
# frame l'eventuale presenza di una label .ctrl creata con ControlledFrame.
#
	if { $active } {
		set bg red
		set fg black
		set state normal
		set selectcolor red
		set entryfg black
		set entrybg white
	} else {
		set bg yellow
		set fg gray50
		set state disabled
		set selectcolor "#ffd0d0"
		set entryfg gray
		set entrybg "#e0e0e0"
	}
	switch [winfo class $widget] {

		Checkbutton { $widget configure -fg $fg -activeforeground $fg -state $state -selectcolor $selectcolor}

		Entry       { $widget configure -fg $entryfg -bg $entrybg -state $state }

		Label       { $widget configure -fg $fg }

		Menubutton  { $widget configure -state $state }

		Frame {
			if { $active && [winfo exists $widget.ctrl] } {
				set expr [$widget.ctrl cget -text]
				set a [uplevel #0 $expr]
			} else {
				set a $active
			}
			foreach o [winfo children $widget] {
				#puts "   child: $o"
				SetWidgetVisibility $o $a
			}
		}

		##default { puts "widget: $widget, class: [winfo class $widget]" }

	}
}


proc SetWidgetTreeActiveState_CallBack { var_name dummy op } {
# Proc accessoria di TraceVar.
	global sub_frames
	foreach f $sub_frames($var_name) {
		SetWidgetVisibility $f 1 
	}
}


proc TraceVar { var frame } {
#
# Imposta il tracing della variabile di nome $var: se il suo valore cambia,
# imposta lo stato corrispondente per il frame $frame e per tutti gli
# altri widget in esso contenuti.
# Esegue anche l'impostazione iniziale dello stato dei widget, per cui
# questa proc va chiamata solo *dopo* che tutti i sub-widget sono stati
# creati.
#
# Il frame $frame e ogni sub-frame deve contenere un widget di classe "label"
# il cui campo # "-text" contiene l'expressione logica il cui valore e'
# 0=frame disattivo, oppure 1=frame attivo.
#
# Variabili globali usate: array sub_frames(), che contiene l'associazione
# tra il nome della variabile (indice) e il frame/widget controllato.
#
	global sub_frames
	if { [info exists sub_frames($var)] } {
		# esiste gia' un altro frame controllato da $var; aggiungi questo:
		lappend sub_frames($var) $frame
	} else {
		set sub_frames($var) [list $frame]
	}
	SetWidgetTreeActiveState_CallBack $var dummy w
	upvar $var x
	trace variable x w SetWidgetTreeActiveState_CallBack
}

#
#
##### Fine Controlled Frames


####################################
##
## Cards Index
##
####################################

proc NewCardIndex { f } {
#
# Crea il frame $f dove crea la struttura per un nuovo card index:
#
#     frame $f
#     frame $f.but (per i bottoni)
#     frame $f.cards (per le schede)
#
	frame $f
	frame $f.but
	pack $f.but -anchor nw
	frame $f.cards -relief sunken -border 2
	pack $f.cards -anchor nw -fill both -expand true
	return $f
}


set hmax 0
set vmax 0

proc ShowCard { c s } {
#
# Attiva la scheda di nome $s nel frame contenitore $c:
# - disattiva tutti i bottoni del frame $c.but
# - attiva il bottone $c.but.$s
# - disattiva tutti i frames dentro al frame $c.card
# - attiva il frame $c.cards.$s
#
# Struttura di widget:
# - frame $c: contenitore di tutte le schede e dei bottoni
# - frame $c.but: frame dei bottoni
# - frame $c.cards: frame delle schede, ogni scheda un frame
#

	global hmax vmax

	# disattiva tutti i bottoni del frame $c.but
	foreach b [winfo children $c.but] {
		$b configure -relief raised
	}
	# attiva il bottone $c.but.$s:
	$c.but.$s configure -relief sunken
	# disattiva tutti i frames dentro al frame $c.card:
	foreach f [winfo children $c.cards] {
		pack forget $f
	}
	# attiva il frame $c.cards.$s:
	pack $c.cards.$s -anchor nw -padx 5 -pady 5


	return

	set f $c.cards.$s
	set h [winfo width $f]
	set v [winfo height $f]
	if { $h > $hmax } {
		set hmax $h
		$f configure -width $hmax
		puts Opps
	}
	if { $v > $vmax } {
		set vmax $v
		$f configure -height $vmax
		puts Opps
	}
	puts "$h, $v, $hmax, $vmax"
}


proc AddCard { ci name text } {
#
# Crea una nuova card.
# Ritorna il frame della card creata.
#
	button $ci.but.$name -text $text -command "ShowCard $ci $name"
	$ci.but.$name configure -relief sunken
	pack $ci.but.$name -side left
	frame $ci.cards.$name
	return $ci.cards.$name
}

#
#
###### Fine di Card Index



##
##
##  MAIN
##
##


wm title . "$PROG_NAME v. $VERSION"
wm resizable . 0 0

pack [frame .top   -height $pady] -side top
#pack [frame .bot   -height $pady] -side bottom
pack [frame .left  -width  $padx] -side left
pack [frame .right -width  $padx] -side right

#
# Bottoniera:
#

frame .b
pack .b -side bottom -fill x

StdButt .b.close Close { save_prefs; exit }
StdButt .b.show_cmd "Show Cmd" ShowCmd
StdButt .b.execute Execute Execute
pack .b.close .b.execute -padx $padx -pady $pady -side right
pack .b.show_cmd -side left

.b.execute configure -default active
bind . <Return> {Premi .b.execute}
bind . <KP_Enter> {Premi .b.execute}
bind . <Escape> {Premi .b.close}



# carica default:
if { [file exists $PREFS] } {
	source $PREFS
}

set arg1 [lindex $argv 0]
if { [string compare $arg1 "-h"] == 0 || [string compare $arg1 "--help"] == 0 } {
	Usage
} else {
	if { [string length $arg1] > 0 } {
		set interface $arg1
	}
}



set ci [NewCardIndex .ci]
pack $ci -fill both -expand true

#
# Card "Main":
#

set main [AddCard $ci main Main]

StdEntry $main.interface "Interface:" interface 5
pack $main.interface -anchor nw

StdEntry $main.snaplens "No. of bytes to snarf from the packet (from 68 to 65535):" snaplens 6 B
pack $main.snaplens -anchor nw

checkbutton $main.parse -text "Parse packets:" -variable parse_packets -font $font_norm
pack $main.parse -anchor nw


set f [ControlledFrame $main.parsef {expr $parse_packets} -indent -compound]
checkbutton $f.print_time -text "Print a timestamp in each dump line" -variable print_time -font $font_norm
pack $f.print_time -anchor nw

checkbutton $f.more_protocol_info -text "Print more protocol information on output" -variable more_protocol_info -font $font_norm
pack $f.more_protocol_info -anchor nw

checkbutton $f.show_host_name -text "Convert host addresses to names:" -variable show_host_name -font $font_norm
pack $f.show_host_name -anchor nw

set g [ControlledFrame $f.show_host_namef {expr $show_host_name} -indent]
checkbutton $g.show_net_name -text "Attempt to convert network and broadcast addresses to names" -variable show_net_name -font $font_norm
pack $g.show_net_name -anchor nw
checkbutton $g.show_port_name -text "Convert protocol and port numbers to names" -variable show_port_name -font $font_norm
pack $g.show_port_name -anchor nw
TraceVar show_host_name $g


checkbutton $f.show_hex -text "Print each packet (minus its link level header) in hex:" -variable show_hex -font $font_norm
pack $f.show_hex -anchor nw

set h [ControlledFrame $f.show_hexf {expr $show_hex} -indent]
checkbutton $h.show_ascii_too -text "Print ascii too" -variable show_ascii_too -font $font_norm
pack $h.show_ascii_too -anchor nw
TraceVar show_hex $h

frame $f.verbosity
pack $f.verbosity -anchor nw
label $f.verbosity.l -text "Verbosity level:" -font $font_norm
pack $f.verbosity.l -side left
tk_optionMenu $f.verbosity.d verbosity 0 1 2 3
pack $f.verbosity.d -side left

TraceVar parse_packets $f

checkbutton $main.save_on_exit -text "Save settings on exit to the file $PREFS" -variable save_on_exit -font $font_norm
pack $main.save_on_exit -anchor nw



#
# Card "Filters":
#

set filters [AddCard $ci filters Filters]

checkbutton $filters.filter_hosts -text "Hosts to filter:" -variable filter_hosts -font $font_norm
pack $filters.filter_hosts -anchor nw
set f [ControlledFrame $filters.filter_hostsf {expr $filter_hosts} -indent]
StdEntry $f.host1 "" host1 20
pack $f.host1 -side left
StdEntry $f.host2 "" host2 20
pack $f.host2 -side left -padx $padx
TraceVar filter_hosts $f

checkbutton $filters.filter_proto -text "Protocols to filter:" -variable filter_proto -font $font_norm
pack $filters.filter_proto -anchor nw
set f [ControlledFrame $filters.filter_protof {expr $filter_proto} -indent]
set protocols "-- ah esp icmp icmp6 igmp igrp pim tcp udp"
eval tk_optionMenu $f.proto1 proto1 $protocols
pack $f.proto1 -side left
eval tk_optionMenu $f.proto2 proto2 $protocols
pack $f.proto2 -side left -padx $padx
eval tk_optionMenu $f.proto3 proto3 $protocols
pack $f.proto3 -side left
TraceVar filter_proto $f


checkbutton $filters.filter_ports -text "Ports to filter (use numbers like 20, 80, ... or names like ftp, http, ...):" -variable filter_ports -font $font_norm
pack $filters.filter_ports -anchor nw
set f [ControlledFrame $filters.filter_portsf {expr $filter_ports} -indent]
StdEntry $f.port1 "" port1 6
pack $f.port1 -side left
StdEntry $f.port2 "" port2 6
pack $f.port2 -side left -padx $padx
StdEntry $f.port3 "" port3 6
pack $f.port3 -side left
TraceVar filter_ports $f


#
# Crea scheda "Advanced"
#

set adv [AddCard $ci adv Advanced]

checkbutton $adv.no_promisc -text "Don't put the interface into promiscuous mode" -variable no_promisc -font $font_norm
pack $adv.no_promisc -anchor nw

set f $adv.drop_privileges
frame $f
pack $f -anchor nw
checkbutton $f.c -text "Drops root privileges to user:" -variable drop_privileges -font $font_norm
pack $f.c -side left
set g [ControlledFrame $f.u {expr $drop_privileges}]
StdEntry $g.u "" user 8
pack $g.u -side left
TraceVar drop_privileges $g

checkbutton $adv.link -text "Print the link-level header" -variable print_link_level -font $font_norm
pack $adv.link -anchor nw

checkbutton $adv.decrypt -text "Decrypt IPsec ESP packets:" -variable decrypt -font $font_norm
pack $adv.decrypt -anchor nw
set f [ControlledFrame $adv.decryptf {expr $decrypt} -indent]
label $f.algol -text "Algorithm:" -font $font_norm
pack $f.algol -side left
tk_optionMenu $f.algo decrypt_algo none des-cbc 3des-cbc blowfish-cbc rc3-cbc cast128-cbc
pack $f.algo -side left
StdEntry $f.secret "Secret:" decrypt_secret 15 
pack $f.secret -side left
checkbutton $f.save -text "save" -variable decrypt_save_secret -font $font_norm
pack $f.save -side left
TraceVar decrypt $f

checkbutton $adv.undecoded_nfs -text "Print undecoded NFS handles" -variable undecoded_nfs -font $font_norm
pack $adv.undecoded_nfs -anchor nw

StdEntry $adv.terminal "Terminal:" terminal 30
pack $adv.terminal -anchor nw

#
# Crea scheda "About":
#

set about [AddCard $ci about About]
label $about.title -text "
$PROG_NAME v. $VERSION"
message $about.msg -font $font_norm -aspect 110 -text "
Copyright 2003 by Umberto Salsi

Email: salsi@icosaedro.it

WEB: http://www.icosaedro.it

This is public domain software.  You are free to copy, distribute and modify it as you like, provided that in your modified version this copyright message be removed or updated with YOUR name and YOUR copyright conditions.

Use at your own risk.


ACKNOLEDGMENTS

The original authors of tcpdump are: Van Jacobson, Craig Leres and Steven McCann. It is currently being maintained by tcpdump.org.

Tcl/Tk was created by John Ousterhout and it was enhanced and extended by a variety of programmers over The Net.
"
pack $about.title
pack $about.msg
# Intercetta la chiusura della finestra:
wm protocol . WM_DELETE_WINDOW {.b.close invoke}

ShowCard $ci main

#
##### Fine!