Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Advice on script

by doylebobs (Novice)
on Oct 21, 2011 at 03:25 UTC ( #932812=perlquestion: print w/replies, xml ) Need Help??

doylebobs has asked for the wisdom of the Perl Monks concerning the following question:

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; }

Replies are listed 'Best First'.
Re: Advice on script
by CountZero (Bishop) on Oct 21, 2011 at 06:35 UTC
    CPAN offers a number of DHCP-related modules: DHCP modules, so you do not have to re-invent the wheel.

    CountZero

    A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

Re: Advice on script
by williams554 (Sexton) on Oct 21, 2011 at 05:06 UTC

    Is there some reason you can't use nmap?

    nmap -sU 10.0.0.0-254 -p 67-68

    Just wondering...Rob

      DHCP requests are sent to a broadcast address so that you can find an IP without having one or at least without knowing the address of the DHCP server. In this case, the "good" network might be 10.0.0.0/24, and you could scan that, but when someone plugs in a random wireless router it is likely to have and hand out IPs in the 192.168.1.0/24 network which the nmap scan wouldn't find.

      l8rZ,
      --
      andrew

      This was just an exercise to get more familiar with Perl. Bob

Re: Advice on script
by hbm (Hermit) on Oct 21, 2011 at 14:11 UTC

    A few minor comments:

    1. For clarity, why not call this 'macaddr' instead of 'chaddr'? (Same for my $chaddr, etc.)
      chaddr => 'XX:XX:XX:XX:XX:XX', # MAC Address of sending interface
    2. sleep 5; # wait for 5..., etc. is obvious. How about:
      sleep 5; # allow capture process to establish sleep 10; # allow capture
    3. In this sequence, you don't need two arrays, and you can simplify a couple things:
      #my @macaddr = split(/:/, $chaddr); my @chaddr = split(/:/, $chaddr); #push(@macaddr, 0) for (1..10); push(@chaddr,(0)x10); #my @chaddr = map { hex($_) } @macaddr; @chaddr = map { hex } @chaddr; # or combined, using the clearer(?) @macaddr: @macaddr = map { hex } (split/:/,'10:FF:2B:40:8C:FE'), (0)x10;
    4. You are modifying $i throughout this loop! In fact, you have a comment (# i = 0) that is certainly untrue the first pass, and may never be true.
      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; }
    5. A thought on printing:
      for my $key (keys %opts) { print $key, " ", dhcp_option($key),"\t"; if (ref($opts{$key}) =~ m/ARRAY/) { print $_, " " foreach (@{$opts{$key}}); } # NOTE: elsif can just be else, as a string # necessarily does or does not match /ARRAY/ elsif (ref($opts{$key}) !~ /ARRAY/) { print $opts{$key}; } print "\n"; } # OR (untested): for my $key (keys %opts) { print "$key ", dhcp_option($key), "\t", ( ref($opts{$key}) =~ /ARRAY/ ? join" ", @{$opts{$key}} : $opts{$key} ) "\n"; }
      In your point 4, I think that all the $i++ are intentional, although a bad fit for the for loop. If my refactoring is correct, then I recommend this equivalent code:
      while (@options) { my $option = hex shift @options; last if $option == 255; # end of DHCP Options my $length = hex shift @options; push @{$opts{$option}}, splice( @options, 0, $length ); }
Re: Advice on script
by doylebobs (Novice) on Oct 25, 2011 at 00:22 UTC

    Thanks to all who responded, particularly, to Util and hbm, and their suggestions. The use of splice and the ternary "?:" were inspirational. I think I need to read the perldocs again as the next step towards improving my code.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://932812]
Approved by planetscape
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2021-11-27 23:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?