Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Revised Dhcpclient Module

by drip (Beadle)
on Jun 04, 2008 at 05:17 UTC ( [id://690063]=perlquestion: print w/replies, xml ) Need Help??

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

hello perl monks...i need your comments suggestions on this..i posted this 2 months ago i think...and here's the revision..this is a DHCP client module which is for testing purposes..and here's the code:

package Net::DHCP::Packet::Client; use strict; use warnings; use 5.8.8; use Net::PcapUtils; use NetPacket::Ethernet; use NetPacket::IP; use NetPacket::UDP; use Net::RawIP; use Net::DHCP::Packet; use Net::DHCP::Constants; sub new { my $class=shift; my $self= {}; my %args = @_; bless ($self,$class); exists($args{Server}) ? $self->setserverid($args{Server}) : $self- +>setserverid("0.0.0.0"); exists($args{Requestip}) ? $self->setrequestip($args{Requestip}) : + $self->setrequestip("0.0.0.0"); exists($args{Releaseip}) ? $self->setreleaseip($args{Releaseip}) : + $self->setreleaseip("0.0.0.0"); exists($args{State}) ? $self->setstate($args{State}) : $self->sets +tate("INIT"); exists($args{Interface}) ? $self->setinterface($args{Interface}) : + $self->setinterface("em0"); exists($args{Mac}) ? $self->setmac($args{Mac}) : $self->setmac(gen +mac()); exists($args{Xid}) ? $self->setxid($args{Xid}) : $self->setxid(tra +nsactionid()); return $self; } sub getserverid{ my $self=shift; $self->{SERVER}; } sub setserverid{ my $self = shift; if (@_){ $self->{SERVER} = shift } die "Cant set server id:$!" unless $self->{SERVER}=~/[0-9]+\.[ +0-9]+\.[0-9]+\.[0-9]+/ig; } sub getrequestip{ my $self=shift; $self->{REQIP}; } sub setrequestip{ my $self = shift; if (@_){ $self->{REQIP} = shift } die "Cant Set Requestip:$!" unless $self->{REQIP}=~/[0-9]+\.[0 +-9]+\.[0-9]+\.[0-9]+/ig; } sub getreleaseip{ my $self=shift; $self->{RELIP}; } sub setreleaseip{ my $self = shift; if (@_){ $self->{RELIP} = shift } die "Cant Set Releaseip:$!" unless $self->{RELIP}=~/[0-9]+\.[0 +-9]+\.[0-9]+\.[0-9]+/ig; } sub getstate{ my $self= shift; $self->{STATE}; } sub setstate{ my $self = shift; if (@_){ $self->{STATE} = shift } die "Cant Set State:$!" unless $self->{STATE}=~/INIT|Request|R +elease|Discover/ig; } sub getinterface{ my $self=shift; $self->{INTERFACE}; } sub setinterface{ my $self = shift; if (@_){ $self->{INTERFACE} = shift } else{ print "No Input Value for Interface, Using Default Value"; } } sub getmac{ my $self=shift; $self->{MACADDRESS}; } sub setmac{ my $self= shift; if(@_){ $self->{MACADDRESS}=shift } else{ print "No Input Value, Using Random Generated MacAddress \n"; } } sub getxid{ my $self=shift; $self->{XID}; } sub setxid{ my $self= shift; if(@_){ $self->{XID}=shift } else{ print "No Input Value, Using Default Value:\n"; } } sub genmac{ my $test_mac="004d"; my $a=0; while($a++<4){ $test_mac.= sprintf("%x",int rand 16); $test_mac.= sprintf("%x",int rand 16); } return $test_mac; } sub transactionid{ my $xid=int(rand(0xFFFFFFFF)); return $xid; } sub createpacket{ my $self=shift; my $state = $self->getstate(); my $p; my $data; if ( $state eq 'Release'){ $p= Net::DHCP::Packet->new(op => '1', hlen=> '6', htype=> '1', hops => '0'); $p->chaddr($self->getmac()); $p->xid($self->getxid()); $p->isDhcp(); $p->ciaddr($self->getreleaseip()); $p->addOptionValue(DHO_DHCP_MESSAGE_TYPE(), 7); $p->addOptionValue(DHO_DHCP_SERVER_IDENTIFIER(), $self->ge +tserverid()); $data=$p->serialize(); return $data; } elsif ( $state eq 'Request'){ $p= Net::DHCP::Packet->new(op => '1', hlen=> '6', htype=> '1', hops => '0'); $p->chaddr($self->getmac()); $p->xid($self->getxid()); $p->isDhcp(); $p->addOptionValue(DHO_DHCP_MESSAGE_TYPE(), 3) +; $p->addOptionValue(DHO_DHCP_SERVER_IDENTIFIER( +),$self->getserverid()); $p->addOptionValue(DHO_DHCP_REQUESTED_ADDRESS( +),$self->getrequestip()); $data=$p->serialize(); return $data; } elsif ( $state eq 'Discover'){ $p= Net::DHCP::Packet->new(op => '1', hlen=> '6', htype=> '1', hops => '0'); $p->chaddr($self->getmac()); $p->xid($self->getxid()); $p->isDhcp(); $p->addOptionValue(DHO_DHCP_MESSAGE_TYPE(), 1) +; $p->addOptionValue(DHO_DHCP_REQUESTED_ADDRESS( +),$self->getrequestip()); $data=$p->serialize(); return $data; } else{ $p= Net::DHCP::Packet->new(op => '1', hlen=> '6', htype=> '1', hops => '0'); $p->chaddr($self->getmac()); $p->xid($self->getxid()); $p->isDhcp(); $p->addOptionValue(DHO_DHCP_MESSAGE_TYPE(), 1) +; $p->addOptionValue(DHO_DHCP_REQUESTED_ADDRESS( +),$self->getrequestip()); $data=$p->serialize(); return $data; } } sub packetsend{ my $self= shift; my $data=$self->createpacket(); my $n =Net::RawIP->new({ ip=> { saddr => '0.0.0.0', daddr => '255.255.255.255', }, udp => { source => 68, dest => 67, data => $data } }); my $mac= $self->getmac(); my @macar = split //, $mac; my $i; my $macjoin; my $counter=0; foreach $i (@macar){ $macjoin.=$i; $counter++; if($counter%2==0){ $macjoin.=":"; } } chop($macjoin); $n->ethnew($self->getinterface()); $n->ethset( source => $macjoin, dest => 'ff:ff:ff:ff:ff:ff'); $n->ethsend; if ( $self->getstate() eq 'Request'|| $self->getstate() eq 'Discov +er' || $self->getstate() eq 'INIT'){ if($self->getstate() eq 'INIT'){ my $reply=$self->getreply(); $self->serverid($reply->{src_ip}); $self->requestip($reply->{dest_ip}); $self->state('Request'); $self->createpacket(); $self->printpacket(); $self->packetsend(); } $self->getreply(); exit(); } } sub printpacket{ my $self=shift; my $data=$self->createpacket(); my $p= Net::DHCP::Packet->new($data); print $p->toString(); } sub getreply{ my $self=shift; my $packetcap1= Net::PcapUtils::open( FILTER =>'udp' , DEV => geti +nterface(), SNAPLEN => 400); my ($packetcap)=Net::PcapUtils::next($packetcap1); my $ethpack=NetPacket::Ethernet->decode($packetcap); my $ipack=NetPacket::IP->decode($ethpack->{data}); my $udpack=NetPacket::UDP->decode($ipack->{data}); my $capture=Net::DHCP::Packet->new($udpack->{data}); my $smac=sprintf ($ethpack->{src_mac}); my $dmac=sprintf ($ethpack->{dest_mac}); my $srcmac= sprintf("%s%s:%s%s:%s%s:%s%s:%s%s:%s%s", split//, $sma +c); my $destmac= sprintf("%s%s:%s%s:%s%s:%s%s:%s%s:%s%s", split//, $dm +ac); print ("====================BOOT REPLY========================\n") +; print "\n"; print $ipack->{src_ip} . "=====>" . $ipack->{dest_ip} . "(id : $ip +ack->{id}, ttl: $ipack->{ttl})" . "\n"; print "UDP Source: $udpack->{src_port} ==> UDP Destination: $udpa +ck->{dest_port} \n"; print "UDP Length: $udpack->{len}, UDP Data Length:", length($udpa +ck->{data})," \n"; print "UDP Checksum: $udpack->{cksum} \n"; print "\n"; print "Source Mac address is : ".$srcmac."=====>"; print "Destination Mac address is: " . $destmac."\n"; my $ethtype=sprintf("%0.4x", $ethpack->{type}); print "Ethertype: ". $ethtype . "\n"; print "\n"; print ("====================UDP PACKET========================\n") +; print $capture->toString()."\n"; return $ipack; } 1;

P.S tachyonII please do comment on this one...applied the things you suggested before...=) thanks in advance

update: anyone else who would like to comment/suggest? i would really appreciate it..=)

Replies are listed 'Best First'.
Re: Revised Dhcpclient Module
by Khen1950fx (Canon) on Jun 04, 2008 at 09:13 UTC
    I've been trying to analyse your module for awhile now; however, I've encountered some problems. The biggest problem, at least on my system, is that Net::Pcap won't compile on my shared perls, 5.8.8, 5.9.5, and 5.10.0. I have two static perls, ActivePerl-5.8 and ActivePerl-5.10, and Net::Pcap compiled ok on them.

    I ran your module using diagnostics. It didn't spit out any error messages. How about some code to see if it works?

    Lastly, I'd recommend the Perl and Net::Pcap tutorial by rob_au to get some more ideas.

    update: I checked the bugs on rt. The module's author suggested trying Net::Pcap 0.14. I tried it on my shared perls, and it installed on all three. Now, my problem is with dhcpd. I'm on FC6 and it should start by running /sbin/service dhcpd start, but it doesn't. I'm redoing all the config files now.

      you need to have a dhcp server ready.. here's a sample code..
      my $p=Net::DHCP::Packet::Client->new(Server =>'192.168.1.1', State => 'Request', Interface => 'eth0', Requestip => '192.168.1.3') $p->printpacket(); $p->packetsend();
      please do not forget to change the interface to correspond to your interface card..

      update: please do tell me the results once you get it up and running..=)

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others perusing the Monastery: (2)
As of 2025-02-09 02:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Which URL do you most often use to access this site?












    Results (95 votes). Check out past polls.