File main.tcl artifact 3ddbc51628 part of check-in 41372cf67d

#! /usr/bin/env tclsh

package require starkit
starkit::startup

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

package require twapi

# 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
	}
}
set tmpdir "C:/TEMP"

# 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]
	}
}

# Copy files neeed to 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 tcpdmp-$random]

file delete -force -- $dstdir

# Run tcpdump
set exit 1
set start_npf_service 0
set npf_failed 0
if {[catch {
	set filesdir [file join $dstdir files]

	exec cmd /c mkdir [file nativename $dstdir]
	exec cmd /c mkdir [file nativename $filesdir]

	file copy -- {*}[glob -directory $srcdir *] $filesdir

	## Delete extraneous service
	if {[::twapi::service_exists npf]} {
		if {![catch {
			::twapi::stop_service npf
		}]} {
			set start_npf_service 1
		}
	}

	catch {
		::twapi::stop_service npf_tcpdump
	}

	catch {
		::twapi::delete_service npf_tcpdump
	}

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

puts [exec net start npf_tcpdump]
		::twapi::start_service npf_tcpdump
puts [exec net start npf_tcpdump]
	} npf_err]} {
		set npf_failed 1
	}

	after 5000

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

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

	puts "Failed: $::errorInfo"

	set exit 1
}

# Debug
puts [exec net stop npf_tcpdump]
puts [exec net start npf_tcpdump]

# Cleanup
catch {
	::twapi::stop_service npf_tcpdump
}
catch {
	::twapi::delete_service npf_tcpdump
}

if {$start_npf_service} {
	catch {
		::twapi::start_service npf
	}
}

catch {
	file delete -force -- $dstdir
}

# Terminate
exit $exit