#!/usr/bin/perl =head1 NAME dhcprobe -- find (rogue) DHCP servers on your network =head1 SYNOPSIS dhcprobe {-d} {-q} {-x } {-t } =head1 DESCRIPTION dhcprobe does only one thing: It broadcasts out a DHCP DISCOVER packet to the local network and lists what servers responded. In general, if we see responses from more than one DHCP server this indicates a problem, one of them is probably a rogue. =head1 OPTIONS -d debug -q quiet operation: no output to STDOUT, return code only -x exclude responses from this IP address from the results -t default is 3 seconds =head1 RETURN CODE dhcprobe will return as its return code the number of DHCP responses received, not counting servers excluded by -x. =head1 SEE ALSO For various reasons we chose not to make use of existing perl modules Net::DHCP::Packet and Net::DHCPClient. However we did use those modules for ideas and information. =head1 AUTHOR Alexander Aminoff, alex_aminoff@alum.mit.edu =head1 COPYRIGHT Copyright 2010, shared by the National Bureau of Economic Research and Alexander Aminoff =cut use IO::Socket::INET; use Getopt::Std; my $XID = 'PRBE'; # must be exactly 4 bytes getopts('dqx:t:') or die "unknown option"; my $debug = $opt_d; my $exclude = $opt_x; my $quiet = $opt_q; my $timeout = $opt_t || 3; my $ifconfig = `/sbin/ifconfig -a`; # this works on FreeBSD and FC Linux # we guess that the first ethernet address is the one we want to use # ether is FreeBSD, HWaddr is Linux $ifconfig =~ m/\s+(ether|HWaddr) (\S+)/ or die "Could not determine my ethernet MAC address"; my $ether = $2; my $packet = discover_packet($ether); print "About to start socket\n" if $debug; my $sock = IO::Socket::INET->new( LocalPort => 68, Broadcast => 1, Proto => 'udp', ); $sock or die "Could not create sending socket: $! $@"; # thanks to David N. Blank-Edelman and Lincoln Stein # who pointed out in their respective books that # if you set the PeerAddr to the broadcast address then # you won't be able to recv anything. So we have to # craft a IP/port combo to pass to send. my $toaddr = sockaddr_in('67',inet_aton('255.255.255.255')); print "About to send DHCPDISCOVER packet\n" if $debug; $sock->send($packet,0,$toaddr) or die "Could not send packet: $!"; print "Waiting for UDP messages\n" if $debug; my $num = 0; $SIG{ALRM} = sub { print "Reached timeout, exiting with status $num\n" if $debug; exit $num; }; alarm $timeout; while($sock->recv($bytes,4096)) { my $peerip = $sock->peerhost; if ($peerip eq $exclude) { print "skipping excluded response from $peerip\n" if $debug; next; } my $op = unpack('C',substr($bytes,0,1)); my $xid = unpack('A4',substr($bytes,4,4)); my $ciaddr = inet_ntoa(substr($bytes,12,4)); my $yiaddr = inet_ntoa(substr($bytes,16,4)); my $siaddr = inet_ntoa(substr($bytes,20,4)); my $giaddr = inet_ntoa(substr($bytes,24,4)); my $sname = substr($bytes,40,64); if ($xid ne $XID) { # somehow we are seeing a response to someone elses discover print "skipping response with different XID: $xid\n" if $debug; next; } print "op:$op\nxid:$xid\nciaddr:$ciaddr\nyiaddr:$yiaddr\nsiaddr:$siaddr\ngiadddr:$giaddr\nsname:$sname\n" if $debug; print "DHCP server at $peerip offered $yiaddr\n" unless $quiet; $num++; } die "recv failed for some reason: $!"; sub discover_packet { my $macaddr = shift; my $bytes = undef; $bytes .= pack('C',1); # op $bytes .= pack('C',1); # htype $bytes .= pack('C',6); # hlen $bytes .= pack('C',0); # hops $bytes .= $XID; # xid $bytes .= pack('S',0); # secs $bytes .= pack('S',0); # flags $bytes .= inet_aton('0.0.0.0'); $bytes .= inet_aton('0.0.0.0'); $bytes .= inet_aton('0.0.0.0'); $bytes .= inet_aton('0.0.0.0'); $bytes .= str2mac($macaddr); $bytes .= pack('C64', unpack('C64','')); # server host name $bytes .= pack('C128', unpack('C128','')); # boot file name $bytes .= pack('C4', 99,130,83,99); # DHCP magic cookie $bytes .= pack('CCC', 53,1,1 ); # this is the DHCP discover code $bytes .= pack('C2', 255, 0); # end tag return $bytes; } sub str2mac { my @a = split /:/, shift; for ( 1..10 ) { push @a, '0'; } map { $_ = hex($_); } @a; return pack 'C16',@a; }