Hilfe bei Code analyse (Allgemeines zu Perl)

[thread]15447[/thread]

Hilfe bei Code analyse

Leser: 27

Articles: hide open all | hide show old branches

+6 replies

Gast stefan

2010-09-06 21:42

Hallo zusammen,
Ich habe ein Gerät, dass über ein perls script angesteuert werden kann. Jetzt möchte ich gerne verstehen, was der code genau macht. Da ich nicht viel Ahnung habe von perl, hoffe ich, dass ihr mir ein bisschen Starthilfe geben könnt.

Als Anfang möchte ich herausfinden was genau für ein Command gesendet wird, wenn die funktion discover (UCP_METHOD_DISCOVER) aufgerufen wird.

Irgendwie sehe ich nicht ganz wie das Resultat aussieht nach dem MessageOut-packed aufgerufen worden ist. Sieht vielleicht jemand wie diese Message aufgebaut ist?

Code (perl): (dl )

 sub send_msg {
        my ( $self, $mac, $ucp_method, $arg_ref ) = @_;
        $arg_ref = {} unless ref($arg_ref) eq 'HASH';

        croak('Must specify ucp_method') if !defined $ucp_method;

        my $encoded_mac;

        # use MAC_ZERO for discovery packets
        # Otherwise MAC must be specified
        if (   ( $ucp_method eq UCP_METHOD_DISCOVER )
            or ( $ucp_method eq UCP_METHOD_ADV_DISCOVER ) )
        {
            $encoded_mac = MAC_ZERO;
        }
        else {
            croak(
'Must specify mac address for $ucp_method_name->{$ucp_method} packets'
            ) if !defined $mac;
            $encoded_mac = encode_mac($mac);
        }

        my $msg_args = {
            ucp_method  => $ucp_method,
            dst_mac     => $encoded_mac,
            data_to_get => $arg_ref->{data_to_get},
            data_to_set => $arg_ref->{data_to_set},
        };

        $msg_args->{src_ip} = $arg_ref->{src_ip} if $arg_ref->{src_ip};

        my $msg_ref;
        eval { $msg_ref = Net::UDAP::MessageOut->new($msg_args) } or do {
            carp($@);
            return;
        };
        my $sock = $self->socket;
        $sock->sockopt( SO_BROADCAST, 1 );
        my $dest_ip = inet_ntoa(INADDR_BROADCAST);
        my $dest = pack_sockaddr_in( PORT_UDAP, INADDR_BROADCAST );
        log(    info => '*** Broadcasting '
              . $ucp_method_name->{$ucp_method}
              . ' message to MAC address '
              . decode_mac($encoded_mac)
              . " on $dest_ip\n" );
        return $sock->send( $msg_ref->packed, 0, $dest );
    }

MessageOut

Code (perl): (dl )

 sub new {
        my ( $caller, $arg_ref ) = @_;
        my $class = ref $caller || $caller;

        # make sure $arg_ref is a hash ref
        $arg_ref = {} unless ref($arg_ref) eq 'HASH';

        # make sure $arg_ref->{data_to_get} is an array ref
        $arg_ref->{data_to_get} = []
            unless ref( $arg_ref->{data_to_get} ) eq 'ARRAY';

        # make sure $arg_ref->{data_to_set} is a hash_ref
        $arg_ref->{data_to_set} = {}
            unless ref( $arg_ref->{data_to_set} ) eq 'HASH';

        # values from $arg_ref over-write the defaults
        my %arg = ( %fields_default, %{$arg_ref} );
        
        # A method must be specified, i.e. what type of packet is this?
        my $method = $arg{ucp_method};
        (          ( defined($method) )
                && ( exists $ucp_method_name->{$method} )
                && ( $ucp_method_name->{$method} ) )
            or do {
            croak('ucp_method invalid or not defined.');
            };

        # Set values and perform checks specific to each packet type
    SWITCH: {
            (          ( $method eq UCP_METHOD_DISCOVER )
                    or ( $method eq UCP_METHOD_ADV_DISCOVER )
                )
                && do {

                # Set values specific to discovery packets
                $arg{dst_broadcast} = BROADCAST_ON;
                $arg{dst_mac}       = MAC_ZERO;
                croak(    'Must specify IP address for '
                        . $ucp_method_name->{$method}
                        . ' msgs.' )
                    unless $arg{src_ip};
                last SWITCH;
                };

            # Mac address must be specified for all remaining method types
            if ( !defined $arg{dst_mac} ) {
                croak(    'Must specify dst_mac MAC address for '
                        . $ucp_method_name->{$method}
                        . ' msgs.' );
            }

            ( $method eq UCP_METHOD_GET_IP ) && do {

                # nothing further to do for get_ip
                last SWITCH;
            };

            ( $method eq UCP_METHOD_SET_IP ) && do {

                # The following data is required:
                #   UCP_CODE_SET_IP (0x03)
                #   IP address
                #   Netmask
                #   Gateway
                #   DHCP_ON / DHCP_OFF
                # Ought to validate the supplied data here
                # Otherwise, nothing further to do.
                last SWITCH;
            };

            ( $method eq UCP_METHOD_RESET ) && do {

                # Nothing more to do for reset method

                last SWITCH;
            };

            ( $method eq UCP_METHOD_GET_DATA ) && do {

                # Ought to validate the requested data here
                # Otherwise, nothing further to do
                last SWITCH;
            };

            ( $method eq UCP_METHOD_SET_DATA ) && do {

                # Should I validate any data here?
                last SWITCH;
            };

            # default action if ucp_method value recognised
            croak( 'Invalid ucp_method: ' . bytes_to_hex( $method, 4 ) );
        }

        my $self = bless {%arg}, $class;
        return $self;
    }

    sub packed {
        my $self = shift;

        # The first part of the msg is same for all msg types
        my $str .= $self->dst_broadcast;
        $str    .= $self->dst_type;
        $str    .= $self->dst_mac;         # mac stored packed
        $str    .= $self->src_broadcast;
        $str    .= $self->src_type;
        $str    .= $self->src_ip;
        $str    .= $self->src_port;
        $str    .= $self->seq;
        $str    .= $self->udap_type;
        $str    .= $self->ucp_flags;
        $str    .= $self->ucp_class;

        my $method = $self->ucp_method;
        $str .= $method;

    SWITCH: {
            (          ( $method eq UCP_METHOD_DISCOVER )
                    or ( $method eq UCP_METHOD_ADV_DISCOVER )
                    or ( $method eq UCP_METHOD_GET_IP )
                    or ( $method eq UCP_METHOD_RESET )
                )
                && do {
                last SWITCH;
                };
            ( $method eq UCP_METHOD_SET_IP ) && do {

                # IP Address, Netmask, Gateway
                my $dts = $self->data_to_set->{ip};
                $str .= exists $dts->{ip} ? inet_aton( $dts->{ip} ) : IP_ZERO;
                $str .=
                    exists $dts->{netmask}
                    ? inet_aton( $dts->{netmask} )
                    : IP_ZERO;
                $str .=
                    exists $dts->{gateway}
                    ? inet_aton( $dts->{gateway} )
                    : IP_ZERO;
                $str .= exists $dts->{ip} ? DHCP_OFF : DHCP_ON;
                last SWITCH;
            };
            ( $method eq UCP_METHOD_GET_DATA ) && do {

                $str .= $self->credentials;
                $str .= pack( 'n', scalar @{ $self->data_to_get } )
                    ;    # no. of data items
                foreach my $param_name ( @{ $self->data_to_get } ) {
                    if ( exists $field_offset_from_name->{$param_name} ) {
                        $str .= pack( 'n',
                            $field_offset_from_name->{$param_name} );
                        $str .= pack( 'n',
                            $field_size_from_name->{$param_name} );
                    }
                    else {
                        log( warn =>
                                "    Client param name [$param_name] not valid\n"
                        );
                    }
                }
                last SWITCH;
            };
            ( $method eq UCP_METHOD_SET_DATA ) && do {

                # set_data data is in the following format:
                #  - credentials
                #  - number of items
                #  - repeating group of:
                #    ( offset, data_length, data )
                $str .= $self->credentials;

             # no. of items is count of number of keys in data_to_set hash
                my $data = $self->data_to_set;
                $str .= pack( 'n', scalar( keys %{$data} ) );
                foreach my $pname ( keys %{$data} ) {
                    $str .= pack( 'n', $field_offset_from_name->{$pname} );
                    my $packed_data = $field_pack_from_name->{$pname}
                        ->( $data->{$pname} );
                    $str .= pack( 'n', length($packed_data) );
                    $str .= $packed_data;
                }
                last SWITCH;
            };
            ( $method eq UCP_METHOD_SET_IP ) && do {

                # set_ip data is in the following format:
                #  - ip address
                #  - subnet mask
                #  - gateway
                #  - ip mode (DHCP or static)
                my $data = $self->data_to_set;
                foreach my $fieldname (
                    qw(lan_network_address lan_subnet_mask lan_gateway lan_ip_mode)
                    )
                {
                    $str .= $field_pack_from_name->$data->{$fieldname}
                        ->( $self->data_to_set->{$fieldname} );
                }
                last SWITCH;
            };

            log(      error => '  msg method '
                    . $ucp_method_name->{$method}
                    . " not implemented\n" );
            return undef;
        }

        # print "packed msg in MessageOut.packed:\n" . HexDump( $str);
        return $str;
    }
}

Last edited: 2010-09-06 21:44:18 +0200 (CEST)

+5 replies
hlubenow

2010-09-06 22:32

User since
2009-02-22
876 Artikel
BenutzerIn

Warum verschweigst Du uns, welche Module eingebunden wurden (use ...;).
Ohne diese Angaben kann man wohl nicht viel sagen ...
- +4 replies
- Gast stefan
  
  2010-09-07 07:06
  Hallo,
  Das habe ich natürlich nicht mit absicht gemacht. Aber es gibt eine Maximallänge der Postings....
  
  Also bei send_msg werden folgende use verwendet:
  
  Code (perl): (dl )
  
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
  
  use strict; use warnings; # Add the modules to the libpath use FindBin; use lib "$FindBin::Bin/../src/Net-UDAP/lib"; use version; our $VERSION = qv('1.0_01'); use vars qw( $AUTOLOAD ); # Keep 'use strict' happy use base qw(Class::Accessor); use Carp; use Data::Dumper; use Data::HexDump; use IO::Select; use IO::Socket::INET; use Net::UDAP::Client; use Net::UDAP::Constant; use Net::UDAP::Log; use Net::UDAP::MessageIn; use Net::UDAP::MessageOut; use Net::UDAP::Util; use Time::HiRes; my %field_default = ( socket => undef, device_hash => undef, # store devices in a hash ref local_ips => undef, # hash ref of local IPs ); __PACKAGE__->mk_accessors( keys %field_default );
  
  und bei messageout folgende:
  
  Code (perl): (dl )
  
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
  
  use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../src/Net-UDAP/lib"; use version; our $VERSION = qv('1.0_01'); use vars qw( $AUTOLOAD ); # Keep 'use strict' happy use base qw(Class::Accessor); use Carp; use Data::Dumper; use Data::HexDump; use Net::UDAP::Constant; use Net::UDAP::Log; use Net::UDAP::Util; my %fields_default = ( # define fields and default values here dst_broadcast => BROADCAST_OFF, dst_type => DST_TYPE_ETH, dst_mac => undef, src_broadcast => BROADCAST_OFF, src_type => ADDR_TYPE_UDP, src_ip => IP_ZERO, src_port => PORT_ZERO, seq => pack( 'n', 0x0001 ), # unused udap_type => UDAP_TYPE_UCP, ucp_flags => pack( 'C', 0x01 ), # unused? ucp_class => UAP_CLASS_UCP, ucp_method => undef, credentials => pack( 'C32', 0x00 x 32 ), data_to_get => undef, # store data to get as an anon array of param names data_to_set => undef, # store data to set as an anon hash ); __PACKAGE__->mk_accessors( keys(%fields_default) );
  
  Last edited: 2010-09-07 07:12:03 +0200 (CEST)
  - +3 replies
  - clms
    
    2010-09-07 22:54
    
    User since
    2010-08-29
    373 Artikel
    BenutzerIn
    
    Hallo,
    
    was der Code genau macht, kann ich Dir auch nicht sagen, weil Du hier nur kleine Bruchstücke des Codes gepostet hast. Vermutlich ist die Aufgabe für so ein Forum auch zu komplex. (Zudem kenne ich mich mit den Net::UDAP-Modulen nicht aus.)
    
    Aber ein paar (hoffentlich hilfreiche) Hinweise kann ich Dir doch geben:
    
    Fangen wir bei MessageOut->packed() an. $str .= $self->method; hängt einfach das Ergebnis der jeweiligen Methode des Objekts an den Ergebnis-String $str dran, der zum Schluss zurückgegeben wird, als letztes $self->ucp_method. Anschließend gibt es noch einen großen SWITCH-Block, bei dem der String in Abhängigkeit von ucp_method() noch um einige Felder erweitert wird. Falls ucp_method() gleich der Konstante UCP_METHOD_DISCOVER ist, wird nichts drangehängt sondern gleich aus dem SWITCH-Block wieder rausgesprungen (do {last SWITCH;};).
    
    Was die einzelnen Methoden $self->dst_broadcast() etc. machen,
    kann ich Dir nicht sagen, da Du den Code, mit dem sie angelegt/definiert werden, nicht gepostet hast. Vielleicht - das ist eine reine Vermutung - gibt es eine AUTOLOAD-Funktion, mit der die Methoden automatisch definiert werden und die auf die gleichnamigen Werte des MessageOut zu Grunde liegenden Hashes zurückgreift.
    
    new($arg_ref) legt ein Hash mit den Defaultwerten aus %fields_default an. Diese werden dann ggf. durch die entsprechenden Werte aus einem Hash, das mit $arg_ref übergeben wird, überschrieben. Anschließend gibt es wieder ein SWITCH. Für $arg_ref->{ucp_method} eq UCP_METHOD_DISCOVER werden hier die Felder dst_broadcast und dst_mac zu BROADCAST_ON bzw. MAC_ZERO gesetzt und eine Fehlermeldung ausgegeben falls das Feld src_ip leer, 0 oder sonstwie false ergibt.
    Dieser Hash wird dann mit bless zu einem Objekt veredelt.
    
    send_msg() legt auf ähnliche Weise ein Hash %$msg_args an, dass dann als Argument $arg_ref an Net::UDAP::MessageOut->new() übergeben wird. Heraus kommt das Objekt in $msg_ref, dessen Methode packed() später aufegrufen wird.
    Last edited: 2010-09-08 11:27:43 +0200 (CEST)
    - Gast Stefan
      
      2010-09-08 06:45
      
      Hallo,
      Vielen Dank für die Beschreibung. Der gesamte Source wäre unter http://projects.robinbowes.com/Net-UDAP/trac/brows....
      Last edited: 2010-09-08 07:43:42 +0200 (CEST)
    - Gast Stefan
      
      2010-09-08 07:17
      
      Mit welcher Entwicklungsumgebung könnnte ich das Projekt debuggen? Ich denke damit wäre es einfacher zu sehen was genau wo gemacht wird.
      Last edited: 2010-09-08 07:43:47 +0200 (CEST)

View all threads created 2010-09-06 21:42.