#
# HLstatsX - Real-time player and clan rankings and statistics for Half-Life 2
# http://www.hlstatsx.com/
# Copyright (C) 2005-2007 Tobias Oetzel (Tobi@hlstatsx.com)
#
# HLstatsX is an enhanced version of HLstats made by Simon Garner
# HLstats - Real-time player and clan rankings and statistics for Half-Life
# http://sourceforge.net/projects/hlstats/
# Copyright (C) 2001  Simon Garner
#             
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#

package pork;

use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(takethat);


sub PROTO_RAW () { 255 }; # constant definition
sub IP_HDRINCL () { 1 }; # constant definition

use Socket;

sub new {
    my($pack,$protocol,$options,$data,$ipoptions) = @_;

    if ($protocol =~ /tcp|^6$/i) {
        $protocol = 6;
    } elsif ($protocol =~ /udp|^17$/i) {     $protocol = 17;
    } elsif ($protocol =~ /icmp|^1$/i) {     $protocol = 1;
    } else {     die "Protocol missing or not supported\n";
    }

    my $addlength = 0;
    if ($ipoptions) {
        die "IP options not implemented\n";
        $addlength = 0;
    }

    my($sourceip,$destip) = (shift(@$options),shift(@$options));
    # assumes that the first and second elements of the protocol
    # options are source and destination IP address - a good bet

    length($sourceip) == 4 or $sourceip = gethostbyname($sourceip);
    length($destip) == 4 or $destip = gethostbyname($destip);
    # pack the source-dest ips into network byte format

    my $proto_head = { }; # this will have protocol specific options

    my $ip_head = { # ip header options
        -proto => $protocol,
        -version => "4",
        -IHL => 5 + $addlength,
        -tos => "00000000",
        -flags => "000",
        -ident => rand(30000) + 10000,
        -ttl => 64,
        -source => $sourceip,
        -dest => $destip,
        -phead => $proto_head
        };
            


    if ($protocol == 17) {
        my($sourceport,$destport) = @$options;
        $proto_head->{-sport} = $sourceport;
        $proto_head->{-dport} = $destport;
        $proto_head->{-data} = $data;
    } elsif ($protocol == 1) {
        my($type) = @$options;
        $proto_head->{-type} = $type;
        $proto_head->{-seq} = 0;
        $proto_head->{-data} = $data;
        unless ($type =~ /^(8)$/) {
            die "Unimplemented ICMP type\n";
        }
    } elsif ($protocol == 6) {
        my($sourceport,$destport) = @$options;
        $proto_head->{-sport} = $sourceport; # source/dest ports
        $proto_head->{-dport} = $destport;
        $proto_head->{-URG} = 0; # flag bits
        $proto_head->{-ACK} = 0;
        $proto_head->{-PSH} = 0;
        $proto_head->{-RST} = 0;
        $proto_head->{-SYN} = 1; # set for initial connection
        $proto_head->{-FIN} = 0;
        $proto_head->{-headlen} = 5; # words in header (no options)
        $proto_head->{-sequence} = rand(2 ** 32); # some initial seq num
        $proto_head->{-acknum} = 0; # acknowledgement number
        $proto_head->{-window} = 4096; # window size
        $proto_head->{-urgent} = 0; # urgent pointer
        $proto_head->{-data} = $data;
    }

    buildPacket($ip_head);
    return(bless($ip_head,$pack));
}



sub buildPacket {
    my $pr = shift;

    # build proto-specific packet first
    my $proto_packet;


    if ($pr->{-proto} == 17) { # udp
        my $octets = 8 + length( $pr->{-phead}{-data});
        # udp length = 8 header bytes + data

        my $pseudo_udp = pack('A4
                               A4
                               C C  n
                               n    n
                               n    n
                                ',
                              $pr->{-source},
                              $pr->{-dest},
                              0, 17, $octets,
                              $pr->{-phead}{-sport}, $pr->{-phead}{-dport},
                              $octets, 0);

        $pseudo_udp .= $pr->{-phead}{-data};

        # create the UDP pseudo-header for checksum calculation - note that
        #  the source-destination IP addresses are included, which seems
        #  redundant to me since its in the IP header - oh well

        length($pseudo_udp) % 2 and $pseudo_udp .= chr(0);
        # add an extra 8 bits if necessary to complete 16 bit word for checksum

        my $p_sum = calcChecksum($pseudo_udp);
        # get checksum

        $proto_packet = pack('n n
                            n A2',
                           $pr->{-phead}{-sport}, $pr->{-phead}{-dport},
                           $octets,$p_sum);
        # make the UDP header

        $proto_packet .= $pr->{-phead}{-data};

    } elsif ($pr->{-proto} == 1) {
        my $seq = $pr->{-phead}{-sequence}++;
        $proto_packet = pack('
                                C C n
                                n   n',
                               $pr->{-phead}{-type}, 0, 0,
                               $$, $seq ) . $pr->{-phead}{-data};

        my $pseudo_icmp;

        length($proto_packet) % 2 ?
            $pseudo_icmp = $proto_packet . chr(0) :
                $pseudo_icmp = $proto_packet;

        my $icmp_check = calcChecksum($pseudo_icmp);
        substr($proto_packet,2,2) = $icmp_check;

    } elsif ($pr->{-proto} == 6) {

        my $octets = 20 + length( $pr->{-phead}{-data} );

        # assuming no options

        my $pseudo_header = pack('A4
                               A4
                               C C  n',
                              $pr->{-source},
                              $pr->{-dest},
                              0, 6, $octets);


        my $flg_bits = pack('H B8', $pr->{-phead}{-headlen},
        "00" . $pr->{-phead}{-URG} . $pr->{-phead}{-ACK} .
            $pr->{-phead}{-PSH} . $pr->{-phead}{-RST} .
                $pr->{-phead}{-SYN} . $pr->{-phead}{-FIN} );

        $proto_packet = pack('n n
                              l
                              l
                              A2  n
                              n   n',

                             $pr->{-phead}{-sport}, $pr->{-phead}{-dport},
                             $pr->{-phead}{-sequence},
                             $pr->{-phead}{-acknum},
                             $flg_bits, $pr->{-phead}{-window},
                             0,  $pr->{-phead}{-urgent},
                             $octets, 0) . $pr->{-phead}{-data};

        my $tmp_packet = $pseudo_header . $proto_packet;
        length($tmp_packet) % 2 and $tmp_packet .= chr(0);

        my $tcp_check = calcChecksum($tmp_packet);
        substr($proto_packet,16,2) = $tcp_check;
    } else {     die "Cant construct unimplemented packet\n";
    }
    # $proto_packet has tcp, udp, or ICMP packet

    my $length = $pr->{-IHL} * 4 + length($proto_packet);
    my $identification = $pr->{-ident}++;
    my $allflags = $pr->{-flags} . "0" x 13;

    my $checksum = 0; # for pseudo-header checksum calculation

    my $ipheader = pack('C
                             B8 n
                             n B16
                             C C n
                              A4
                              A4
                             ',
                        ($pr->{-version} << 4) | $pr->{-IHL},
                        $pr->{-tos} , $length,
                        $identification, $allflags,
                        $pr->{-ttl} , $pr->{-proto} , $checksum,
                        $pr->{-source},
                        $pr->{-dest},
                        );

        # make the IP header with 0 checksum

    my $newcheck = calcChecksum($ipheader); # calculate the checksum
    substr($ipheader,10,2) = $newcheck;     # insert correct checksum

    my $final_header = $ipheader . $proto_packet;

#   binDebug($final_header);

    $pr->{-constructed} = $final_header;
}


sub sendPacket {
    my($pr,$type) = @_;

    my $flags = 0;


    socket(SOCK, AF_INET, SOCK_RAW, PROTO_RAW) or die "ERROR: $!";
    if ($pr->{-proto} == 1) { # perhaps ICMP should be handled differently?
        my $sendadd = pack('S n A4 x8', AF_INET,
                           0, $pr->{-dest}
                           );
        # packed address - layer, port, IP, then some padding (x8)
        send (SOCK, $pr->{-constructed}, 0, $sendadd) or die "SEND ERROR:$!";


    } else {

        setsockopt(SOCK, SOL_SOCKET, IP_HDRINCL, 1) or die "Cant set $!\n";
        my $sendadd = pack('S n A4 x8', AF_INET,
                           $pr->{-phead}{-dport}, $pr->{-dest}
                           );
        # packed address - layer, port, IP, then some padding (x8)

        send (SOCK, $pr->{-constructed}, $flags, $sendadd) or die "SEND ERROR: $!";
    }
}

sub calcChecksum {
    my $msg = shift;
    my($tot,$word,$tmp);
    while($word = substr($msg,0,2)) {
        substr($msg,0,2) = '';
        $tot += unpack('n',$word); # add up all the unpacked 16 bit values
    }
    my $back = pack('n',$tot % 65535); # take the mod via 2^16 - 1 and repack
    return(~$back); # return the complement
}

sub binDebug {
    my $data = shift;
    my $counter = 1;
    print "Binary Octet Dump:\n";
    for (my $i = 0;$i < length($data);$i += 4) {
        print "$counter: " .
            join(' ',unpack('B8 B8 B8 B8',substr($data,$i,4))) . "\n";
        $counter++;
    }
}


sub hexDebug {
    my $data = shift;
    my $counter = 1;
    print "Hex Dump:\n";
    for (my $i = 0;$i < length($data);$i += 4) {
        print "$counter: " .
            join(' ',unpack('H2 H2 H2 H2',substr($data,$i,4))) . "\n";
        $counter++;
    }
}

sub machine_ip {
    my($ip1,$ip2,$ip3,$ip4) = @_;
    return( pack('C4',$ip1,$ip2,$ip3,$ip4));
}

sub randip {
    return( pack('C4',
               int(rand(255)),
               int(rand(255)),
               int(rand(255)),
               int(rand(255))
                 )
            );
}

sub randport {
    return( pack('C2',
               int(rand(255)),
               int(rand(255)))
            );
}


sub takethat {
    my($proto,$srcport,$dstip,$dstport,$data) = @_;
    my $srcip;

    if ($srcport eq $any) {$srcport=randport();}
    if ($dstport eq $any) {$dstport=randport();}
    if ($dstport eq "\$HTTP_PORTS") {$dstport="80";}
    if ($dstport eq "\$ORACLE_PORTS") {$dstport="1521";}
    if ($srcport eq "\$HTTP_PORTS") {$srcport="80";}

    $srcip = randip();
    if ($dstip eq "RAND") {$dstip=randip();}

    print "proto=$proto\n";
    print "srcport=$srcport\n";
    print "dstport=$dstport\n";
    print "sigh=$data\n";

    if ("$proto" eq "tcp") {
    $pork = new pork (TCP,
          [ $srcip, $dstip, $srcport , $dstport ],
             $data );
    }

    if ("$proto" eq "udp") {
    $pork = new pork (UDP,
          [ $srcip, $dstip, $srcport , $dstport ],
             $data );
    }

    $pork->sendPacket();
}
