Hi I am fairly new to Perl and as an improvement exercise I decided to write a script to actively detect rogue DHCP servers. I would appreciate any feedback on how to improve this.A couple of specifc questions/areas: (1) Is there a better way to terminate the child processes or is what I have done reasonable? (2) Should I be concerned about chaining subroutines. for example, I call pkt_capture wihtin main, then process_pkt with pkt_capture, and finally email_alert within process_packet? (3) My initial goal was to try to implement this using OO but soon got lost. I understand Perl OO but I just couldn't decide on what type of object to create, what were the attributes and methods.

#!/usr/bin/perl

use warnings;
use strict;

use Net::RawIP;
use vars qw($AUTOLOAD);
use POSIX qw(strftime);
use Net::SMTP;

my %config_info = ( 
    trusted_servers => ['X.X.X.X'], # add trusted servers here
    chaddr => 'XX:XX:XX:XX:XX:XX', # MAC Address of sending interface
    log_file => '/tmp/log.tmp',
    smtp_server => 'X.X.X.X',
    probe_frequency => 600,
    interface => 'eth0',
    email_notification => 'xxx@xxx.com',
);

daemonize();

while (1) {

    # generate a unique transaction ID 

    $config_info{transaction_id} = int(rand(99999999)); 
    
    my $pid = fork();

    if (not defined($pid)) {
        die "No resources available to fork.\n";
    }
    elsif ($pid == 0) {
        my $p = pkt_capture(\%config_info);
    }
    elsif ($pid) {
        $SIG{CHLD} = 'IGNORE';
        sleep 5; # wait for 5 secs to allow capture process to establi
+sh
        send_discover(\%config_info);
            sleep 10; # wait for 10 secs to allow capture
        kill(9, $pid);    
    }

    sleep $config_info{probe_frequency};

} # end of contionuous while loop

sub daemonize {

    my $pid = fork;
    exit if $pid;
    die "Resouces not available\n" unless (defined($pid));
    POSIX::setsid() or die "Can't start a new session: $!\n";

}

sub send_discover {

    my ($config_info) = @_;
    my ($k, $v);
    
    my $chaddr = $config_info->{chaddr};
    my $xid = $config_info->{transaction_id};
    my $int = $config_info->{interface};

    my $op = 1;
    my $htype = 1;
    my $hlen = 6;
    my $hops = 0,
    my $secs = 0;
    my $flags = 0;
    my @ciaddr = ('0','0','0','0');
    my @yiaddr = ('0','0','0','0');
    my @siaddr = ('0','0','0','0');
    my @giaddr = ('0','0','0','0');
    my $sname = 0;
    my $file = 0;
    
    # Pad MAC address with 10 "0" and then convert Hex MAC address and
+ padding to Dec

    my @macaddr = split(/:/, $chaddr);

    push(@macaddr, 0) for (1..10);

    my @chaddr = map { hex($_) } @macaddr; 

    # Preparation of the Options field
    # The first four octets of the 'options' field of the DHCP message
+ contain 
    # the (decimal) values 99, 130, 83 and 99, respectively (this is t
+he same 
    # magic cookie as is defined in RFC 1497 [17]).  
    
    my @options_magic = (99, 130, 83, 99); #DHCP Magic Cookie - RFC 14
+97

    my @options = (53,1,1); # Discover packet

    my $options_end = 255; # 255 indicates the end of the options sect
+ion

    my $data = pack "C4 H8 H4 H4 C4 C4 C4 C4 C16 H128 H256 C4 C3 C", $
+op, $htype, $hlen, $hops, $xid, $secs, $flags, @ciaddr, @yiaddr, @sia
+ddr, @giaddr, @chaddr, $sname, $file, @options_magic, @options, $opti
+ons_end;

    my $ip_pkt = Net::RawIP->new({udp => {}});

    $ip_pkt->set({
            ip => {
                    saddr => '0.0.0.0',
                    daddr => '255.255.255.255',
            },
            udp => {
                source => 68,
            dest   => 67,
            data   => $data,
        },
        });

        $ip_pkt->ethnew("$int");
        $ip_pkt->ethset(source => $chaddr, dest => 'ff:ff:ff:ff:ff:ff'
+);
        $ip_pkt->ethsend;
    
}

sub pkt_capture {

    my ($config_info) = @_;
    my $int = $config_info->{interface};

    my $n = new Net::RawIP;
     my $p = $n->pcapinit("$int", "udp port 68 and ether dst $config_i
+nfo->{chaddr}", 1500, 30);
    $p = loop($p, 10, \&process_pkt, $config_info);

}

sub process_pkt {

    my $config_info = $_[0]; 
    my $raw_pkt = $_[2];
    my (@dhcpsrv, @netmask, %packet, %opts);

    my @trusted_servers = @{$config_info->{trusted_servers}};

           my $raw_data = unpack "H*", $raw_pkt;

    my $timestamp = strftime("%d %b %Y - %H:%M:%S\t",localtime(time())
+); 
    
    %packet = (

        dest_mac => join(':', unpack ("(a2)*" , substr($raw_data, 0, 1
+2))),
        src_mac => join(':', unpack ("(a2)*" , substr($raw_data, 12, 1
+2))),
        src_ip => join('.', map (hex($_), unpack("(a2)*", substr($raw_
+data, 52, 8)))),
        dest_ip => join('.', map (hex($_), unpack("(a2)*", substr($raw
+_data, 60, 8)))),
        src_udp => hex(substr($raw_data, 68, 4)),
        dest_udp => hex(substr($raw_data, 72, 4)),
        xid => substr($raw_data,92,8),
        ciaddr => join('.', (map hex($_), (unpack "(a2)*", substr($raw
+_data, 108, 8)))),
        yiaddr => join('.', (map hex($_), (unpack "(a2)*", substr($raw
+_data, 116, 8)))),
        siaddr => join('.', (map hex($_), (unpack "(a2)*", substr($raw
+_data, 124, 8)))),
        giaddr => join('.', (map hex($_), (unpack "(a2)*", substr($raw
+_data, 132, 8)))),
    );

    my @options = unpack("(a2)*", substr($raw_data, (index($raw_data, 
+"63825363") + 8)));

    # find options area
        
    for (my $i = 0; $i <= $#options; $i++) {

        my $option = hex($options[$i++]);

        last if ($option == 255); # end of DHCP Options

        my $length = $options[$i++]; # i = 0
    
        my $offset = hex($length) + $i;
    
        for (my $k = $i; $k <= ($offset - 1); $k++ ) {
            
            push(@{$opts{$option}}, $options[$k]);

        }
            
        $i = $offset - 1;
        
    }

    # Format the most common options into their standard units

    while (my ($k, $v) = each %opts) {

        # Options relating to IP Addresses need to be changed to the d
+otted-decimal notation

        if (($k == 54) || ($k == 1)) {
            $opts{$k} = join('.', map hex($_), @{$opts{$k}});
        }    

        # Options relating to time are defined as an unsigned 32 bit i
+nteger        

        if (($k == 51) || ($k == 59) || ($k ==58)) {
            $opts{$k} = unpack "N*", (pack "H*", join('', @{$opts{$k}}
+));
        }

    }

    $packet{options} = \%opts;

    open(TEMP, ">>$config_info->{log_file}");
    
    select(TEMP);

    unless (grep(/$packet{siaddr}/, @trusted_servers)) { 

        print "---------- $timestamp -----------\n";
        my ($k, $v);    
        print "$k\t$v\n" while (($k, $v) = each %packet);    

        print "Client IP Address (ciaddr) $packet{ciaddr}\n";
        print "Your IP Address (yiaddr) $packet{yiaddr}\n";
        print "Server IP Address (siaddr) $packet{siaddr}\n";
        print "Gateway IP Address (giaddr) $packet{giaddr}\n";
    
        for my $key (keys %opts) {

            print $key, " ", dhcp_option($key),"\t";
            if (ref($opts{$key}) =~ m/ARRAY/) {
                print $_, " " foreach (@{$opts{$key}});
            }
            elsif (ref($opts{$key}) !~ /ARRAY/) {
                print $opts{$key};
            }
            print "\n";

        }

        print "---------------------------------\n";
        
        email_alert(\%packet, $config_info);
    
    }

    elsif (grep(/$packet{siaddr}/, @trusted_servers)) {

        print "---------- $timestamp -----------\n";
        
        print "Response received from valid DHCP Server\n";

        print "-----------------------------------\n";
    }
    
    select(STDOUT);
    close(TEMP);

}

sub dhcp_msg_type {

    my $opt_code = shift;

    my %types = (

         "01" => "DHCPDISCOVER",
             "02" => "DHCPOFFER",
             "03" => "DHCPREQUEST",
             "04" => "DHCPDECLINE",
             "05" => "DHCPACK",
             "06" => "DHCPNAK",
             "07" => "DHCPRELEASE",
             "08" => "DHCPINFORM",
    
    );

    return $types{$opt_code};
}

sub dhcp_option {

    my $opt_num = shift;
    
    my %dhcp_options = (

        1 =>  "Subnet Mask ",
        3 =>  "Router ",
        4 =>  "Time Server ",
        5 =>  "Name Server ",
        6 =>  "Domain Name Server ",
        11 =>  "Resource Location Server ",
        12 =>  "Host Name ",
        15 =>  "Domain Name ",
        43 =>  "Vendor specific information ",
        50 =>  "Requested IP Address ",
        51 =>  "IP address lease time",
        52 =>  "Option overload",
        53 =>  "DHCP message type",
        54 =>  "Server identifier",
        55 =>  "Parameter request list",
        56 =>  "Message ",
        57 =>  "Maximum DHCP message size ",
        58 =>  "Renew time value ",
        59 =>  "Rebinding time value ",

    );

    if ($dhcp_options{$opt_num}) {
        return $dhcp_options{$opt_num};
    }
    else  {
        return "Unknown Option";
    } 
}

sub email_alert {

    my ($packet_info, $config_info) = @_;

    my $smtp = Net::SMTP->new($config_info{smtp_server});
    $smtp->mail($ENV{USER});
    $smtp->to($config_info{email_notification});
    $smtp->data();
    $smtp->datasend("To: $config_info{email_notification}\n");
    $smtp->datasend("\n");
    $smtp->datasend("Untrusted DHCP Server identified $packet_info->{s
+iaddr}\n\n");
    $smtp->datasend("IP Address offered $packet_info->{yiaddr}\n\n");
    $smtp->datasend("DHCP Message Type: ", dhcp_msg_type(@{$packet_inf
+o->{options}->{53}}), "\n");    

    $smtp->datasend("DHCP Options\n\n");
    while (my ($k, $v) = each %{$packet_info->{options}}) { 
        if (ref($v) =~ m/ARRAY/) {
            $smtp->datasend("$k\t", dhcp_option($k), "\t@$v\n");
        }
        elsif (ref($v) !~ m/ARRAY/) {
            $smtp->datasend("$k\t", dhcp_option($k), "\t$v\n");
        }
    }
    $smtp->dataend();

    $smtp->quit;
}
[download]