#!/usr/bin/perl

use strict;
use Tk;
use IO::Socket;
my ($sfile, $nfrm, $entry, $file, $but, $fromport, $toport, $neww, $nwww, $hlpm, $flmn, $menu, $save, $mw, $mid, $win, $prt, $l);
$save = "0";
$mw = MainWindow->new();
$mw->configure(-background => 'black');
$mw->title(" Perl/Tk Port Scanner");
$menu = $mw->Frame(-relief => 'groove', -border => 3, -background => 'grey')->pack('-side' => 'top', -fill => 'x');
$flmn = $menu->Menubutton(-text => 'File', -tearoff => 0, -background => 'grey', -activebackground => 'white', -foreground => 'black')->pack(-side => 'left');
$hlpm = $menu->Menubutton(-text => 'Help', -tearoff => 0, -background => 'grey', -activebackground => 'white', -foreground => 'black')->pack(-side => 'right');
$neww = $mw->Frame(-background => 'black')->pack(-side => 'top', -fill => 'x');
$nwww = $neww->Frame(-background => 'black')->pack(-side => 'left', pady => 9, padx => 8);
$hlpm->command(-label => 'Info', -activebackground => 'black', -foreground => 'black', -activeforeground => 'green', -command => sub{info()});
#$hlpm->command(-label => 'Help', -activebackground => 'black', -foreground => 'black', -activeforeground => 'green', -command => sub{help()});
$hlpm->separator();
#$hlpm->command(-label => 'Ports', -activebackground => 'black', -foreground => 'black', -activeforeground => 'green', -command => sub{ports()});
#$hlpm->command(-label => 'Upgrade', -activebackground => 'black', -foreground => 'black', -activeforeground => 'green', -command => sub{upgrade()});
$flmn->command(-label => 'Scan', -activebackground => 'black', -foreground => 'black', -activeforeground => 'green', -command => sub{scan($entry, $fromport, $toport, $file)});
$flmn->command(-label => 'Info', -activebackground => 'black', -foreground => 'black', -activeforeground => 'green', -command => sub{info()});
$flmn->separator();
$flmn->command(-label => 'Exit', -activebackground => 'black', -foreground => 'black', -activeforeground => 'green', -command => [$mw,'destroy']);
$nwww->Label(-background => 'black', -relief => 'sunken', -foreground => 'green', -text => "Hostname/IP:")->pack;
$nwww->Label(-background => 'black', -relief => 'sunken', -foreground => 'green', -text => "Starting port:")->pack;
$nwww->Label(-background => 'black', -relief => 'sunken', -foreground => 'green', -text => "End port:")->pack;
$nwww->Label(-background => 'black', -relief => 'sunken', -foreground => 'green', -text => "File to write to:")->pack;
$nwww->Label(-background => 'black', -relief => 'sunken', -foreground => 'green', -text => "Write to file?")->pack;
$nfrm = $neww->Frame(-background => 'black')->pack(-side => 'left', -pady => 2, -padx => 15);
$entry = $nfrm->Entry(-background => 'white', -foreground => 'black', -borderwidth => 2, -relief => 'sunken', -width => 30)->pack;
$entry->insert('end', "localhost");
$fromport = $nfrm->Entry(-background => 'white', -foreground => 'black', -borderwidth => 2, -relief => 'sunken', -width => 6)->pack;
$fromport->insert('end', "1");
$toport = $nfrm->Entry(-background => 'white', -foreground => 'black', -borderwidth => 2, -relief => 'sunken', -width => 6)->pack;
$toport->insert('end', "1024");
$file = $nfrm->Entry(-background => 'grey', -foreground => 'grey', -borderwidth => 2, -width => 30)->pack;
$nfrm->Checkbutton(-background => 'white', -command => sub{save()})->pack;
$but = $mw->Frame(-borderwidth => 0,  -background => 'black', -relief => 'groove')->pack(-side => 'top', -fill => 'x');
$but->Button(-background => 'black', -foreground => 'white', -text => 'Info', -command => sub{info()})->pack(-side => 'left');
$but->Button(-background => 'black', -foreground => 'white', -text => 'Scan', -command => sub{scan($entry, $fromport, $toport, $file)})->pack(-side => 'left');
#$prt = $mw->Label(-text => "Waiting for acknowledgement...", -foreground => 'green', -background => 'black', -pady => 4)->pack();
$but->Button(-background => 'black', -foreground => 'white', -text => 'Exit', -command => [$mw,'destroy'])->pack(-side => 'right');
$mid = $mw->Frame(-background => 'black', -foreground => 'green')->pack(-side => 'top', -fill => 'y', -expand => 'y');
$win = $mid->Frame(-background => 'black', -foreground => 'green')->pack(-side => 'left', pady => 2, padx => 2);
#$mw->Photo('imggif', -file => "lxban.gif");
#$l = $mw->Label('-image' => 'imggif', -border => 0)->pack;
MainLoop;
sub scan {
 my ($entry, $fromport, $toport, $file, $scan, $true, $con, $top1);
 ($entry, $fromport, $toport, $file) = @_;
 if ($save %2 != 0) {
  $sfile = get $file;
 }
 $sentry = get $entry;
 $sfromport = get $fromport;
 $stoport = get $toport;
 $scan;
 do {
  $true = "0";
  $con = IO::Socket::INET->new(
  Proto => "tcp",
  PeerAddr => $sentry,
  PeerPort => $sfromport) or $true++;
  if ($true == "0") {
   $scan .= "Port $sfromport open\n";
   if ($save == 1) {
    if ($sfile eq "") {
     $sfile = "/tmp/tkscan.log";
    }
    open(FILE, ">>$sfile");
    print FILE "Port $sfromport open on $sentry\n";
   }
  }
  $sfromport++;
 }
 while ($sfromport <= $stoport);
 if ($save %2 != 0) {
  close(FILE);
 }
 $top1 = $mw->Toplevel;
 $top1->title(" Ports");
 $top1->Label(-text => "Ports open on $sentry\n\n$scan")->pack;
}
sub info {
 my $top2 = $mw->Toplevel;
 $top2->Label(-text => "Perl/Tk port scanner\nwritten by samy\n\nhttp://www.LucidX.com\n")->pack;
}
sub save {
 $save++;
 if ($save %2 != 0) {
  $file->configure(-background => 'white', -foreground => 'black', -relief => 'sunken');
  $file->delete(0, 'end');
  $file->insert('end', "/tmp/tkscan.log");
 }
 else {
  $file->configure(-background => 'grey', -foreground => 'grey');
  $file->delete(0, 'end');
 }
}