#!/usr/bin/perl 
#
#  sl0scan v0.1
#   perl spoofer/scanner 
#   based on lego 
#
#  written by miff  Jan 1999
#
#  i wrote this in response to all the 
#  email i got from lego saying: 
#  "i'm not getting a response from the 
#  portscan!!&^@#$"
#
#  this version requests the following:
#       - which ports to scan
#       - how many fake hosts to use
#       - the "real" ip (any sniffable ip)
#       - an optional file of "real" fakes
#       - when to insert the real scan
#
#  you are responsible for sniffing the response, 
#  at this point.  maybe that'll be automatic
#  in the future.
#
# shouts:  b_, X, kubiak, shinex, xyg, ReDragon, #9mm
#  also:  Clovis  (where ya at h0mez?)
#
# best musical artist:  mike patton.
#

use Socket;
use strict      qw(refs, subs);

my $delay = 1;  # delay in seconds between scans.  its really important
#               not to end up with a synflood here, that will break the 
#               scan.  use a large real fake file to avoid DoS.

my $input, $dummy;
print "Welcome to sl0scan, the slowest scanner on the net.\n";
print "This program sends out a deluge of fake scans, and inserts \n";
print " a real scan somewhere in between.  In this version, you \n";
print " must fire up a sniffer and watch for the responses to \n";
print " the real scan...  Hope you know what to look for \n";
print "\n";
print "ready?\n";
$dummy = <>;
print "good.  here's where we axe you the 5 imp0tent questi0nz:\n\n";
print "1.)  what is the IP ADDY or HOSTNAME of the target? \n";
$input = <>;
chop $input;
$target_box = $input;
print "got $input.\n\n\n";
print "2.)  what be the true source of the scan? (any sniffable ip will do) \n";
$input = <>;
chop $input;
$true_source = $input;
print "got $input.\n\n\n";
print "3.)  how many fakes should we dump on this homies fro? \n";
print "note:  number of fakes will directly affect the sl0ness of the scan\n";
print " to the tune of at least 1 second per host.  we don wanna dos here.. \n";
print " otoh, lots of fakes increase your invisibility \n";
$input = <>;
chop $input;
$num_fakes = $input;
print "got $input.  <-- hope that was a number...\n\n\n";
print "4.)  which ports should we check?  (IMPORTANT) \n";
print " i recommend as few as possible, as this will *really* slow shit down\n";
print "enter ports in the following format:  COMMA DELIMITED, indicate ranges with dash\n";
print " example:  i want to scan ports 22 23 25 80 and 130-140.  i say: \n";
print "22,23,25,80,130-140\n";
print "avoid spaces and extra shit.  save that for another time. \n";
$input = <>;
chop $input;
$portlist = $input;
print "got $input. <-- if you screwed that up, bad shit is gonna happen.\n\n\n";
print "5.)  At what sequence would you like the real scan inserted? \n";
print "note:  this number must be <= the total number of fakes...\n";
$input = <>;
chop $input;
$real_seq = $input;
$real_seq--;  #gotta decrement; we start wit 0
print "got $input.  <-- hope that was a number...\n\n\n";
print "6.)  ok last one.  Would you like to use a file of desired fakes?\n";
print "this gives you the advantage of choosing the fake ips, and \n";
print "avoiding the situation that all of the fake scans came from \n";
print "non-existent ips.  i'd recommend using a large file here \n\n";
print "also, if you use all fake ips, even with the one second delay, \n";
print "you stand a greater chance of DOS'ing the target.  which is bad.\n\n";
print "fyi, the format for the file is 1 ip or hostname per line, no extra shit. \n\n";
print " IF YOU WANT TO USE SUCH A FILE, enter the filename here:\n";
$input = <>;
chop $input;
$frofile = $input;
print "got $input.  <-- hope that was a real file...\n\n\n";
print "OK FOO, WE READY.  YOU READY?\n";
$dummy = <>;

my @frobobs;
my $frocount = -1;
# ok, first order of bidniss:  lets get that file open if it exists:
if ($frofile ne '') {
  if (-e $frofile) {
        #we got a file...
        open (FROFILE, $frofile) || die "cant open file, kid";
        while ($input = <FROFILE>) {
                chop $input;
                $frocount++;
                @frobobs[$frocount] = $input;
        }
        close (FROFILE);
        # while we're at it, lets cal the percent of total fakes:
        $fro_percent = $frocount * 100 / $num_fakes;
  }
}  

my $scancount = 0;
my $src_box, $src_port;
srand(time ^ $$);

while ($scancount < $num_fakes) {
        # main driver routine
        if ($scancount == $real_seq) {
                #this is the real deal
                print "real scan!! (from $true_source) \n\n";
                $src_box = $true_source;
        } else {
                # grab a random number between 0 and $num_fakes
                if ($randum > $frocount) { 
                        #create one
                        my $rand1 = int(rand(230)) + 20;
                        my $rand2 = int(rand(255));
                        my $rand3 = int(rand(255));
                        my $rand4 = int(rand(255));
                        $src_box = $rand1 . "." . $rand2 . "." . $rand3 . "." . $rand4;
                        #for debugging:
                        print "scan from $src_box \n";
                } else {
                        # use the array
                        $randum = int(rand($num_fakes));
                        $src_box = @frobobs[$randum];
                        print "we gon fro from $src_box \n";
                }
        }
        # now send the scan
        sc4n($target_box,$portlist,$src_box,$fake_port);
        
        # now sleep to avoid DoS:
        sleep($delay);

        $scancount++;
}


sub sc4n  {
        my ($dest_host,$dest_ports,$src_host,$src_port) = @_;

        #print "in scan, got $dest_host,$dest_ports,$src_host,$src_port\n\n";

        #set constants:
        my ($PROTO_RAW) = 255; # from /etc/protocols
        my ($PROTO_IP) = 0;  #ditto
        my ($IP_HDRINCL) = 1;  #we set the ip header, thanks

        #look up mah shit...
        $dest_host = (gethostbyname($dest_host))[4];
        $src_host = (gethostbyname($src_host))[4];

        #time to open a raw socket....
        socket(S, AF_INET, SOCK_RAW, $PROTO_RAW) || die $!;

        #raw socket should be open...
        #now set the bad boy up...
        setsockopt(S, $PROTO_IP, $IP_HDRINCL, 1);  

        # here we need to interpret the port list:
        my @ports1 = split (",",$dest_ports);

        my $psplit,$rcount,$range_low,$range_hi;
        my $p2count = 0;
        my @ports2;
        my @range;

        foreach $psplit (@ports1) {
                if ($psplit =~ '-') {
                        # we have a range
                        @range = split("-",$psplit);
                        $range_low = @range[0];
                        $range_hi = @range[1];
                        $rcount = $range_low;
                        while ($rcount <= $range_hi) {
                                @ports2[$p2count] = $rcount;
                                $p2count++;
                                $rcount++;
                        }
                } else {
                        @ports2[$p2count] = $psplit;
                        $p2count++;
                }
        }

        my $port;

        foreach $port (@ports2) {
                #build a tcp header:

                #vary the ports in here...
                $src_port = int(rand(60000));
                
                my ($packet) = givehead($src_host, $src_port, $dest_host, $port, $data);
                #bust out the destination...
                my ($dest) = pack('S n a4 x8', AF_INET, $port, $dest_host);
                #send a fux0ring packet 
                send (S,$packet,0, $dest);
        }

}

sub givehead {
        my ($src_host, $src_port, $dest_host, $dest_port, $data) = @_;

        #HERE WE PLAY WITH THE INSIDES OF THE TCP PIECE
        #AND CALC THE TCP HDR CHECKSUM.
        my $hdr_cksum = 0;  # we set it to 0 so we can calculate it
        my $zero = 0;  #might need a zero from time to time
        my $proto_tcp = 6;  # the protocol number for tcp
        my ($tcplength) = 20; # 20 byte tcp hdr; no data
        # IF YOU ADD DATA, MAKE SURE TO ADD ITS PACKED LENGTH
        # TO THE TCPLENGTH HERE!!!
        # all of the source and destination infoz is passed to us
        # screw wit it in the parent routine...
        my $syn = 790047533;  # random syn;  try to keep it under 32 bits :)
        my $ack = 0;  # zero ack;  try to keep it under 32 bits :)
        my $tcp_4bit_hdrlen = "5"; # 5 * 32bit (4 byte) = 20 bytes
        my $tcp_4bit_reserved = 0; # reserved for 0 
        my $hdr_n_reserved = $tcp_4bit_hdrlen . $tcp_4bit_reserved;  # pack them together
        my $tcp_urg_bit = 0;  # URGENT POINTER BIT
        my $tcp_ack_bit = 0;  # ACKNOWLEDGEMENT FIELD BIT
        my $tcp_psh_bit = 0;  # PUSH REQUEST BIT
        my $tcp_rst_bit = 0;  # RST (RESET CONNXION) BIT
        my $tcp_syn_bit = 1;  # SYN FLAG BIT  #its a syn!!
        my $tcp_fin_bit = 0;  # FIN FLAG BIT
        # here we put together 2 reserved fields and the 6 flags to pack as binary.
        my $tcp_codebits = $zero . $zero . $tcp_urg_bit . $tcp_ack_bit . $tcp_psh_bit .
                $tcp_rst_bit . $tcp_syn_bit . $tcp_fin_bit;
        my $tcp_windowsize = 124;  # default window size
        my $tcp_urgent_pointer = 0;  # urgent pointer


        # the following is not a tcp header per se, but a pseudo header
        # used to calculate the tcp checksum.  yes, its a pain in the ass.
        my ($pseudo_tcp) = pack ('a4 a4 C C 
                                n n n 
                                N N 
                                H2 B8
                                n v n',
                        $src_host,$dest_host,$zero,$proto_tcp,
                        $tcplength,$src_port,$dest_port,
                        $syn,$ack,
                        $hdr_n_reserved,$tcp_codebits,
                        $tcp_windowsize,$zero,$tcp_urgent_pointer);

        my ($tcp_chksum) = &checkfro($pseudo_tcp);


        # PLAY WITH THE INNARDS OF THE IP PIECE HERE!!!
        my $ip_version = "4";  # (nybble) tcp/ip version number (current is 4)
        my $ip_hedlen = "5";  # (nybble) number of 32-bit words in ip header
        my $ver_n_hlen = $ip_version . $ip_hedlen; # we pack 2 nybbles together
        my $ip_tos = "00";  # (byte) ip type-of-service
        my ($totlength) = $tcplength + 20; #tcp + 20 byte ip hdr ##
        ## we'll pack totlength into 2 bytes in the packet
        my $ip_fragment_id = 31337;  # 2 bytes as well.
        my $ip_3bit_flags = "010"; # ip fragmentation flags (3 bits) (frag, do not frag)
        my $ip_13bit_fragoffset = "0000000000000";  #fragment offset
        my $ip_flags_n_frags = $ip_3bit_flags . $ip_13bit_fragoffset;
        my $ip_ttl = 64;  # 64 seconds / hops
        # we have proto_tcp from above...  my $proto_tcp = 6;
        # we have hdr_checksum from above...
        # all source and destination infoz is passed to us (it
        #  gets set in parent routine)
        # change $syn and $ack above in tcp section
        # in fact, everything else in the packet is set above.
        

        my ($hdr) = pack ('H2 H2 n n 
                           B16 C2 
                           n a4 a4 
                           n n 
                           N N 
                           H2 B8
                           n v n',
                $ver_n_hlen, $ip_tos, $totlength, $ip_fragment_id, 
                $ip_flags_n_frags,$ip_ttl, $proto_tcp,  
                $hdr_cksum, $src_host, $dest_host, 
                # end of ip header, begin tcp header
                $src_port, $dest_port, 
                $syn,$ack,
                $hdr_n_reserved,$tcp_codebits,
                $tcp_windowsize,$tcp_chksum,$tcp_urgent_pointer);

        return $hdr;
}

sub checkfro {
        #dis sekzhun robbed from someplace else....
    my (
        $msg            # The message to checkfro
        ) = @_;
    my ($len_msg,       # Length of the message
        $num_short,     # The number of short words in the message
        $short,         # One short word
        $chk            # The checkfro
        );

    $len_msg = length($msg);
    $num_short = $len_msg / 2;
    $chk = 0;
    foreach $short (unpack("S$num_short", $msg))
    {
        $chk += $short;
    }                                   # Add some lead 
    $chk += unpack("C", substr($msg, $len_msg - 1, 1)) if $len_msg % 2;
    $chk = ($chk >> 16) + ($chk & 0xffff);      # bust out mah fro pic
    return(~(($chk >> 16) + $chk) & 0xffff);    # spray some jheri
}


