Artifact cfaf5bf4e429a87099ca75273cee7b2805ed4bea:

• File main.tcl — part of check-in [5dcad0ff2a] at 2014-01-25 08:40:13 on branch trunk — Updated to register console handler, which seems to be enough to cause cleanup routines to usually run (user: rkeene, size: 3217) [annotate] [blame] [check-ins using]

#! /usr/bin/env tclsh

package require starkit
starkit::startup

lappend auto_path [file join $::starkit::topdir twapi]

package require twapi

# Determine platform to install driver for
## http://blogs.msdn.com/b/david.wang/archive/2006/03/26/howto-detect-process-bitness.aspx
if {[info exists ::env(PROCESSOR_ARCHITEW6432)]} {
	set arch $::env(PROCESSOR_ARCHITEW6432)
} else {
	if {[info exists ::env(PROCESSOR_ARCHITECTURE)]} {
		set arch $::env(PROCESSOR_ARCHITECTURE)
	} else {
		set arch "x86"
	}
}
switch -- [string tolower $arch] {
	"x86" {
		set bits "32"
	}
	default {
		set bits "64"
	}
}

# Determine temp directory
if {[info exists ::env(TEMP)]} {
	set tmpdir $::env(TEMP)
} elseif {[info exists ::env(TMPDIR)]} {
	set tmpdir $::env(TMPDIR)
} else {
	if {$tcl_platform(platform) == "windows"} {
		set tmpdir {C:/TEMP}
	} else {
		set tmpdir /tmp
	}
}

# Determine interface to lookup
set dest_parm_idx [lsearch -exact $argv "-i"]
if {$dest_parm_idx != -1} {
	incr dest_parm_idx

	set dest_chk [lindex $argv $dest_parm_idx]
	if {[string match "*.*.*.*" $dest_chk] || [string match "*:*:*" $dest_chk]} {
		set dest $dest_chk

		## Determine the index to specified destination
		set iface_idx 1
		catch {
			set iface_idx [::twapi::get_outgoing_interface $dest]
		}
		if {$iface_idx == ""} {
			set iface_idx 1
		}

		## Determine the NPF name for the adapter found above
		set iface_adapter [lindex [::twapi::get_netif_info $iface_idx -adaptername] 1]
		set iface_npf "\\Device\\NPF_${iface_adapter}"

		set argv [lreplace $argv $dest_parm_idx $dest_parm_idx $iface_npf]
	}
}

# Determine name of temporary directory
for {set i 0} {$i < 20} {incr i} {
	append random_bin [format %c [expr {int(rand() * 256)}]]
}
binary scan $random_bin H* random

set srcdir [file join $::starkit::topdir files]
set dstdir [file join $tmpdir tcpdump-temp-$random]

proc cleanup {} {
	# Cleanup
	catch {
		::twapi::stop_service npf
	}
	catch {
		::twapi::delete_service npf
	}
	catch {
		file delete -force -- $::dstdir
	}
}

# Install exit handler to cleanup
rename exit _exit
proc exit args {
	cleanup
	_exit {*}$args
}

twapi::set_console_control_handler exit

# Run tcpdump
set exit 1
set npf_failed 0
if {[catch {
	## Create directory
	file delete -force -- $dstdir
	file mkdir $dstdir

	## Copy files to directory
	set filesdir [file join $dstdir files]
	file copy -- $srcdir $filesdir

	## Delete extraneous service
	catch {
		::twapi::stop_service npf
	}

	catch {
		::twapi::delete_service npf
	}

	## Install driver and start service
	if {[catch {
		set driver [file join $filesdir npf${bits}.sys]
		set driver [file nativename $driver]
		::twapi::create_service npf $driver -displayname "WinPcap Packet Driver (NPF)" -servicetype kernel_driver -starttype demand_start -errorcontrol ignore

		set started [::twapi::start_service npf -wait 60000]
		if {!$started} {
			error "npf did not start"
		}
	} npf_err]} {
		set npf_failed 1
	}

	## Launch tcpdump with the apropriate parameters
	set tcpdumpexe [file join $filesdir tcpdump.exe]
	exec -- $tcpdumpexe {*}$argv >&@ stdout

	set exit 0
} err]} {
	if {$npf_failed} {
		puts "NPF Failed: $npf_err"
		puts "Failed: $err"
	}

	set exit 1
}

# Terminate
exit $exit