# A-scan - Scanner de puertos
#
# Autor: Nahual de Raza-Mexicana
#	 (T. Nahual)
#
#
# Por hacer:
#
#	Escaneo de subnets y una funcion socket	compilada y opcional;
#	la funcion estandar de Tcl es demasiado lenta, inclusive para
#	rastreo de un solo host dado que me es imposible acortar su
#	plazo de conexion.

# Problemas:
#
#	Este programa fue dise~ado para trabajar con Tcl/Tk 8.0+. Trabajara
#	bien con versiones anteriores, pero se~alaran un error cuando se
#	intente crear una ventana ya existente; esto es porque existe un
#	problema con el comando 'destroy' en interpretes anteriores a la
#	serie 8.x. Existe una solucion a esto en los comentarios que hay dentro
#	del codigo, si es que no se desea escalar a un interprete mas reciente.
#
#
#

proc Main {} {

	wm title . "A-scan - Raza-Mexicana Team"
	wm resizable . 0 1

	frame .main -borderwidth 5
	pack .main -side top
	focus -force .main

	label .main.l_host -text Host: -padx 0
	entry .main.e_host -width 20 -relief sunken -textvariable HOST
	label .main.l_startport -text "Start Port:"
	entry .main.e_startport -width 5 -relief sunken -textvariable SPORT
	label .main.l_endport -text "End Port:"
	entry .main.e_endport -width 5 -relief sunken -textvariable EPORT
	label .main.l_outfile -text File:
	entry .main.e_outfile -width 10 -relief sunken -textvariable OUTFILE

	pack .main.l_host -side left
	pack .main.e_host -side left
	pack .main.l_startport -side left
	pack .main.e_startport -side left
	pack .main.l_endport -side left
	pack .main.e_endport -side left
	pack .main.l_outfile -side left
	pack .main.e_outfile -side left -padx 3

	button .main.b_scan -text Scan -foreground "#336633" -command {ScanProcess $HOST $SPORT $EPORT $OUTFILE}
	button .main.b_close -text Close -command exit
	button .main.b_about -text About -command About
	button .main.b_stop -text Stop -foreground red -command {set STOPBIT 0}
	pack .main.b_scan -side left -ipady 14
	pack .main.b_stop -side left -ipady 14
	pack .main.b_close -side bottom -ipadx 2
	pack .main.b_about -side bottom -ipadx 1

	global WIN
	set WIN [ScrolledWindow .t_outfilewindow -height 6]
	pack .t_outfilewindow -side top -fill both -expand true

	bind all <Control-c> exit

}

proc ScanProcess {H SP EP F} {

	global CP
	set ECODE [ErrorHandler $H $SP $EP $F]

	if {$ECODE == 1} {
		set RANGE [expr $EP-$SP+1]
		set CP $SP
		wm title . "Scanning for active ports..."
		PortScan $H $SP $EP $F $RANGE
	}
}

proc PortScan {H SP EP F R} {

	global CP FID WIN STOPBIT
	string tolower $H

	if ![file exists $F] {
		set FID [open $F {WRONLY CREAT}]
		puts $FID "Host file created by A-scan\n_______________________________"
	} else {
		set FID [open $F {WRONLY APPEND}]
	}

	puts $FID "\n\n-----Portscan of host $H-----\n[clock format [clock seconds]]\n"

	set OPCOUNT 0
	while {$CP<=$EP} {
		if {[info exists STOPBIT]} {
			puts $FID "\nScan Incomplete: User Aborted"
			unset STOPBIT
			break
		}

		if {[PortCheck $H $CP] == 1} {incr OPCOUNT}
		incr CP
		update
	}

	puts $FID "\n-----End of scan-----"
	close $FID

	set FID [open $F]
	$WIN insert end [read $FID]
	close $FID

	wm title . "A-scan - Raza-Mexicana Team"

#	if [catch {toplevel .scancomplete}] {
#		destroy .scancomplete
#		toplevel .scancomplete
#	}
#
# Si tu version de Tcl/Tk es anterior a 8.0 y, por alguna razon
# no quieres actualizarla, descomentariza (bueno, no se como se dira,
# pero quita los gatos(#) pues) las 4 lineas de la instruccion 'if'
# que esta arriba, y comentariza las siguuientes dos lineas

	destroy .scancomplete
	toplevel .scancomplete

	wm title .scancomplete "Port Scan Complete"
	focus .scancomplete
	label .scancomplete.l_done -justify left -text "\
Host Scanned:\t$H\
\n\
Ports Scanned:\t[expr $CP-$SP]\
\n\
Ports Open:\t$OPCOUNT
\n\
Results stored in file $F"

	pack .scancomplete.l_done -side top -padx 5 -pady 5

	button .scancomplete.b_ok -text OK -command {destroy .scancomplete}
	pack .scancomplete.b_ok
}

proc PortCheck {H P} {

	global FID

	if ![catch {set SCANSOCK [socket $H $P]}] {
		close $SCANSOCK
		puts $FID " Active Port: $P"
		return 1
	}
}


proc ErrorHandler {H SP EP F} {

	if {$H == ""} {
		set ERR "You must enter a Host."
		DisplayError $ERR
	} elseif {$SP == ""} {
		set ERR "Please enter a Starting Port."
		DisplayError $ERR
	} elseif {$EP == ""} {
		set ERR "Please enter an Ending Port."
		DisplayError $ERR
	} elseif {$SP > $EP} {
		set ERR "Start Port must be smaller than End Port."
		DisplayError $ERR
	} elseif {$SP < 0 || $EP < 0} {
		set ERR "You cannot define negative port numbers."
		DisplayError $ERR
	} elseif {$F == ""} {
		set ERR "You must enter a file name."
		DisplayError $ERR
	} else {
		return 1
	}

}


proc DisplayError {ERR} {

	destroy .error
	toplevel .error -width 100 -height 100
	wm title .error "Error"
	focus .error
	label .error.l_input -text $ERR
	button .error.b_input -text OK -command {destroy .error}
	pack .error.l_input
	pack .error.b_input

}               


proc About {} {

#	if ![catch {toplevel .about}] {
#		destroy .about
#		toplevel .about
#
# Si tu version de Tcl/Tk es menor a 8.0 y, por X razon
# no quieres actualizarla, descomentariza las 3 lineas de
# arriba. Comentariza las siguientes 2 lineas, descomentariza
# la penultima llave de esta rutina.

		destroy .about
		toplevel .about
		wm title .about "About A-scan"
		focus .about
		message .about.m_about -justify left -text "\
Cross-platform port scanner written by T. Nahual.\n
The idea came from a discussion with CableMan, regarding\
a lack of open source, free software for Windows platforms.  \
I dislike anything related to Micro\$oft, but free software\
cannot be biased. So, not being a Win32 programmer, I wrote\
A-scan in platform independant Tcl/Tk to help out.\
\n\n\
A-scan, Copyright (C) 2001 Tecuhtli Nahual/RMHT\n\
A-scan comes with ABSOLUTELY NO WARRANTY; for details\
read the GNU General Public License, available from\
the Free Software Foundation. This is free software,\
and you are welcome to redistribute it under certain\
conditions;  contact the FSF for details."

		pack .about.m_about -side top -padx 5 -pady 5

		button .about.b_ok -text OK -command {destroy .about}
		pack .about.b_ok

#	}	
}

proc ScrolledWindow { FR args } {

	frame $FR
	eval {text $FR.t_text -wrap none -yscrollcommand [list $FR.yscroll set]} $args
	scrollbar $FR.yscroll -orient vertical -command [list $FR.t_text yview]
	grid $FR.t_text $FR.yscroll -sticky news
	grid rowconfigure $FR 0 -weight 1
	grid columnconfigure $FR 0 -weight 1
	return $FR.t_text
}

Main

# FIN