"Fossies" - the Fresh Open Source Software Archive

Member "pandora_server/lib/PandoraFMS/Recon/Util.pm" (15 Sep 2021, 3693 Bytes) of package /linux/misc/pandorafms_server-7.0NG.757.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Util.pm" see the Fossies "Dox" file reference documentation.

    1 #!/usr/bin/perl
    2 # (c) √Ārtica ST 2016 <info@artica.es>
    3 # Utility functions for the network topology discovery modules.
    4 
    5 package PandoraFMS::Recon::Util;
    6 use strict;
    7 use warnings;
    8 
    9 # Default lib dir for RPM and DEB packages.
   10 use lib '/usr/lib/perl5';
   11 
   12 use Socket qw/inet_aton/;
   13 
   14 our @ISA = ("Exporter");
   15 our %EXPORT_TAGS = ( 'all' => [qw( )] );
   16 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
   17 our @EXPORT = qw(
   18   enterprise_new
   19   ip_to_long
   20   mac_matches
   21   mac_to_dec
   22   parse_mac
   23   subnet_matches
   24 );
   25 
   26 ################################################################################
   27 # Return an Enterprise Recon object.
   28 ################################################################################
   29 sub enterprise_new($$) {
   30     my ($class, $arguments) = @_;
   31 
   32     my @args;
   33     if (ref($arguments) eq "HASH") {
   34         @args = %{$arguments};
   35     }
   36     if (ref($arguments) eq "ARRAY") {
   37         @args = @{$arguments};
   38     }
   39 
   40     # Try to load the module
   41     if ($^O eq 'MSWin32') {
   42         # If the Windows service dies the service is stopped, even inside an eval ($RUN is set to 0)!
   43         eval 'local $SIG{__DIE__}; require '.$class.';';
   44     }else {
   45         eval 'require '.$class.';';
   46     }
   47     if ($@) {
   48         # Not loaded.
   49         return undef;
   50     }
   51 
   52     return new $class(@args);
   53 }
   54 
   55 
   56 ################################################################################
   57 # Return the numeric representation of the given IP address.
   58 ################################################################################
   59 sub ip_to_long($) {
   60     my $ip_address = shift;
   61 
   62     return unpack('N', inet_aton($ip_address));
   63 }
   64 
   65 ################################################################################
   66 # Returns 1 if the two given MAC addresses are the same.
   67 ################################################################################
   68 sub mac_matches($$) {
   69     my ($mac_1, $mac_2) = @_;
   70 
   71     if (parse_mac($mac_1) eq parse_mac($mac_2)) {
   72         return 1;
   73     }
   74 
   75     return 0;
   76 }
   77 
   78 ################################################################################
   79 # Convert a MAC address to decimal dotted notation.
   80 ################################################################################
   81 sub mac_to_dec($) {
   82     my $mac = shift;
   83 
   84     my $dec_mac = '';
   85     my @elements = split(/:/, $mac);
   86     foreach my $element (@elements) {
   87         $dec_mac .= unpack('s', pack 's', hex($element)) .  '.';
   88     }
   89     chop($dec_mac);
   90 
   91     return $dec_mac;
   92 }
   93 
   94 ################################################################################
   95 # Make sure all MAC addresses are in the same format (00 11 22 33 44 55 66).
   96 ################################################################################
   97 sub parse_mac($) {
   98     my ($mac) = @_;
   99 
  100     # Remove leading and trailing whitespaces.
  101     $mac =~ s/(^\s+)|(\s+$)//g;
  102 
  103     # Replace whitespaces and dots with colons.
  104     $mac =~ s/\s+|\./:/g;
  105 
  106     # Convert hex digits to uppercase.
  107     $mac =~ s/([a-f])/\U$1/g;
  108 
  109     # Add a leading 0 to single digits.
  110     $mac =~ s/^([0-9A-F]):/0$1:/g;
  111     $mac =~ s/:([0-9A-F]):/:0$1:/g;
  112     $mac =~ s/:([0-9A-F])$/:0$1/g;
  113 
  114     return $mac;
  115 }
  116 
  117 ################################################################################
  118 # Returns 1 if the given IP address belongs to the given subnet.
  119 ################################################################################
  120 sub subnet_matches($$;$) {
  121     my ($ipaddr, $subnet, $mask) = @_;
  122     my ($netaddr, $netmask);
  123 
  124     # Decimal dot notation mask.
  125     if (defined($mask)) {
  126         $netaddr = $subnet;
  127         $netmask = ip_to_long($mask);
  128     }
  129 
  130     # CIDR notation.
  131     else {
  132         ($netaddr, $netmask) = split('/', $subnet);
  133         return 0 unless defined($netmask);
  134 
  135         # Convert the netmask to a numeric format.
  136         $netmask = -1 << (32 - $netmask);
  137     }
  138 
  139     if ((ip_to_long($ipaddr) & $netmask) == (ip_to_long($netaddr) & $netmask)) {
  140         return 1;
  141     }
  142 
  143     return 0;
  144 }
  145 
  146 1;
  147 __END__
  148