"Fossies" - the Fresh Open Source Software Archive

Member "pandora_server/lib/PandoraFMS/Recon/Util.pm" (11 May 2023, 3706 Bytes) of package /linux/misc/pandorafms_server-7.0NG.771.tar.gz:

    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 BEGIN { push @INC, '/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