Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Dhcpclient module

by drip (Beadle)
on Mar 27, 2008 at 08:02 UTC ( [id://676652]=perlquestion: print w/replies, xml ) Need Help??

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

Hullo..its me again..
i have been using Perl for 3 months now(still a novice, so please forgive me if my code looks bad)..and i'm trying to make a module..which is a Dhcpclient..(yes, there are modules in CPAN for a Dhcpclient, but for now i want to create my own module to broaden my knowledge).

Right now i am stuck and not quite sure if i am doing the right thing and before i proceed with this module i need to know if i am on the right track....
and i humbly ask for your guidance on this one so that i can achieve my goal(learning perl).

Here's my code:

package Dhcpclient; use strict; use warnings; 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->serverid($args{Server}) : $self->{S +ERVER} = "0.0.0.0"; exists($args{Requestip}) ? $self->requestip($args{Requestip}) : $s +elf->{REQIP} = "0.0.0.0"; exists($args{Releaseip}) ? $self->releaseip($args{Releaseip}) : $s +elf->{RELIP} = "0.0.0.0"; exists($args{State}) ? $self->state($args{State}) : $self->{STATE} + = "INIT"; exists($args{Interface}) ? $self->interface($args{Interface}) : $s +elf->{INTERFACE} = "eth0"; exists($args{Mac}) ? $self->genmac($args{Mac}) : $self->{MACADDRES +S} = genmac(); return $self; } sub serverid { my $self = shift; if (@_) { $self->{SERVER} = shift} return $self->{SERVER}; } sub requestip { my $self = shift; if (@_) {$self->{REQIP} = shift} return $self->{REQIP}; } sub releaseip { my $self = shift; if (@_) {$self->{RELIP} = shift} return $self->{RELIP}; } sub state { my $self = shift; if (@_) {$self->{STATE} = shift} return $self->{STATE}; } sub interface { my $self = shift; if (@_) { $self->{INTERFACE} = shift} return $self->{INTERFACE}; } 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 createpacket { my $self=shift; my $state = $self->{STATE}; my $p; my $data; if ( $state eq 'Release') { $p= Net::DHCP::Packet->new(op => '1', hlen=> '6', htype=> '1', hops => '0'); $p->chaddr($self->{MACADDRESS}); $p->xid(int(rand(0xFFFFFFFF))); $p->isDhcp(); $p->ciaddr($self->{RELIP}); $p->addOptionValue(DHO_DHCP_MESSAGE_TYPE(), 7); $p->addOptionValue(DHO_DHCP_SERVER_IDENTIFIER(), $self->{S +ERVER}); $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->{MACADDRESS}); $p->xid(int(rand(0xFFFFFFFF))); $p->isDhcp(); $p->addOptionValue(DHO_DHCP_MESSAGE_TYPE(), 3) +; $p->addOptionValue(DHO_DHCP_SERVER_IDENTIFIER( +), $self->{SERVER}); $p->addOptionValue(DHO_DHCP_REQUESTED_ADDRESS( +), $self->{REQIP}); $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->{MACADDRESS}; 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->{INTERFACE}); $n->ethset( source => $macjoin, dest => 'ff:ff:ff:ff:ff:ff'); $n->ethsend; if ($self->{STATE} eq 'Request') { $self->getack(); } } sub printpacket { my $self=shift; my $data=$self->createpacket(); my $p= Net::DHCP::Packet->new($data); print $p->toString(); } sub getack { my $self=shift; my $packetcap1= Net::PcapUtils::open( FILTER =>'udp' , DEV => $sel +f->{INTERFACE}, SNAPLEN => 400); my ($packetcap, %hdr)=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"; } 1;

i would really appreciate any advice,comments,suggestions or opinion on what i am doing. i know i still have a lot to learn...again i humbly seek your guidance..

Thanks in advance..

Replies are listed 'Best First'.
Re: Dhcpclient module
by pc88mxer (Vicar) on Mar 27, 2008 at 16:41 UTC
    Here is something I find odd:
    exists($args{Server}) ? $self->serverid($args{Server}) : $self->{SERVE +R} = "0.0.0.0";
    This is better written as:
    $self->serverid($args{Server} || "0.0.0.0");
    Not only is it more succinct, but it also observes the encapsulation that you've created with the serverid accessor.

    Otherwise, where are you stuck?

      thank you for the suggestion ^_^...i am stuck because i am not quite sure if what i am doing is right..
      1.)is it ok if i use a lot of modules to create another module?is that advisable?
      2.)would it be better if i use pack/unpack(i still need to learn it though) to decode the packet rather than using the modules?
      3.)how do i use the full potential of OOP?
      =)

        1) It's perfectly fine to build upon the work of others. OOP was developed with the idea of making it easy to reuse software.

        2) Becoming comfortable with pack and unpack is always a good idea, but using a CPAN module is fine too, if it solves your problem.

        3) Mastering the full potential of OOP could take a lifetime. In fact, I doubt anyone knows what its full potential really is. I would suggest incrementally improving your OOP skills whenever you can. Look at other people's code, and see how they solve problems using OOP. OOP techniques are especially helpful in managing the complexities that occur in large programs. Also look at modules that get used a lot like the standard modules which come with perl. Their interfaces have been carefully crafted to make them useful in a general purpose setting. As you see more examples of well-written OOP code, you should get a feel for when certain methods are better than others. The OOP system in perl is very flexible, so it's difficult to lay down hard and fast rules about when to do things one way or another.

        My main question, though, is: does your code work the way you want it to?

Re: Dhcpclient module
by tachyon-II (Chaplain) on Mar 28, 2008 at 14:25 UTC

    I find you code virtually unreadable partly because of the semi-random positioning of the braces (in a style I personally dislike) but mostly because of the definitively random indentation..

    Dual function getters/setters have supporters and detractors. I tend to write single function ones like this:

    sub get_serverid { $_[0]->{SERVER} } sub set_serverid { $_[0]->{SERVER} = $_[1] } sub get_requestip { $_[0]->{REQIP} } sub set_requestip { $_[0]->{REQIP} = $_[1] } etc

    Short and sweet. Note that you don't need return. Perl returns the last value evaluated in a sub automagically. Anyone who knows perl will know what these functions do. Even if you don't read perl they are documenting what they are supposed to do by their very name. While they are marginally less readable on the raw function side they are totally self documenting on the usage side. You can also add error checking to ensure logical arguments are passed to setters.

    You can make them longer by doing (and this is standard perl indentation brace positioning BTW):

    sub set_widget { my ($self, $arg) = @_; die "Can't set_widget to "$arg"\n" unless $arg =~ m/something/; $self->{WIDGET} = $arg; }

    Anyway if you are going to take the time to encapsulate then directly accessing objects like my $state = $self->{STATE}; at the start of create_packet() is a definite no no. my $state = $self->get_state; says it all. You are breaking encapsulation all over the place even though you have get/set methods. $self->{MACADDRESS} (you forgot to code a get/set for that) and $self->{INTERFACE} appear all over the place. They should be $self->get_mac $self->get_interface.....

      i was not quite aware of the indentation.i was just writing the code and was trying to do it the way i can read it..(since it is not done yet, but it works though)..
      i'll just have to change the the indentation later..thanks for your opinion ..i'll try applying your suggestions to the code..

      btw, on the sub new i set
      $self->{INTERFACE},$self->{MACADDRESS} etc. to get default
      values if there are no arguments being passed ...that is why
      i used $self->{MACADDRESS} $self->{INTERFACE} etc (incase the user does not pass any argument)..maybe i'm wrong..kindly check the sub new again please...

        Indentation is not something to fix later. The whole idea is to make code more readable so you don't confuse yourself when you write it and people reading it don't get confused. I suggest you run it through perltidy. The fact that it works has nothing to do with indentation. See obfuscation for unreadable code that works just fine.

        With OO you write accessors and then use them EXCLUSIVELY. The accessors provide the INTERFACE. By doing this you are free to change whatever you want about your internal object representation - so long as the accessors work the same all will be well with any code using your code.

        Debug this:

        my $interface = $obj->interrface; $obj->{INTERRFACE} = $new_interface;
Re: Dhcpclient module
by drip (Beadle) on Apr 01, 2008 at 03:27 UTC
    so should i do it like this?
    set_serverid{ my $self=shift; if(@_) {$self->{SERVER} = shift} } getserverid{ $self->{SERVER}; } $serverid=getserverid();

    dont know much about the correct indentation..i'll read more on that...

      You could but it should look like this with "standard/common" perl indentation and some error checking. Also if you are going to set_xxx you should get_xxx, not getxxx or getXxx to be conSistent:

      set_serverid { my $self = shift; if (@_) { $self->{SERVER} = shift; } else { die "No argument passed to set_serverid!\n"; } } get_serverid { my $self = shift; $self->{SERVER}; }

      shift syntax works fine for $self but often you might like to do a bit more error checking in your setters:

      set_serverid { my ($self,$id) = @_; if (defined $id) { die "Invalid value for id '$id' in set_serverid!\n" unless $id > 0 and $id < 255; $self->{SERVER} = $id; } else { die "No argument passed to set_serverid!\n"; } }

      As noted I like to start off with very simple accessors like:

      sub get_serverid { $_[0]->{SERVER} } sub set_serverid { $_[0]->{SERVER} = $_[1] } sub get_requestip { $_[0]->{REQIP} } sub set_requestip { $_[0]->{REQIP} = $_[1] }

      The thing I like about this is that you can see typos in the hash key names very easily. Unless you are doing formal error checking on the set side you don't really need more.

        Thank you very much...i learned a great deal from you...
        i will post the revised code later after i finish my other task...
        and hope you will check it out...
        just to make sure if everything is in the right place... ;) thanks....

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (4)
As of 2024-04-19 03:32 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found