App-Netsync

 view release on metacpan or  search on metacpan

lib/App/Netsync.pm  view on Meta::CPAN

                    }
                    @if2serial{@$port2if} = @port2serial;
                };
                my $brocade = sub { # FOUNDRY-SN-SWITCH-GROUP-MIB
                    my ($port2if) = App::Netsync::SNMP::get1 ([['.1.3.6.1.4.1.1991.1.1.3.3.1.1.38' => 'snSwPortIfIndex']],$session);
                    my @port2serial;
                    {
                        my ($port2umi) = App::Netsync::SNMP::get1 ([['.1.3.6.1.4.1.1991.1.1.3.3.1.1.39' => 'snSwPortDescr']],$session);
                        my %module2serial;
                        {
                            my ($serials,$modules) = App::Netsync::SNMP::get1 ([['.1.3.6.1.4.1.1991.1.1.1.4.1.1.2' => 'snChasUnitSerNum']],$session); #XXX FOUNDRY-SN-AGENT-MIB?
                            @module2serial{@$modules} = @$serials;
                        }
                        foreach (@$port2umi) {
                            push (@port2serial,$module2serial{$+{'unit'}}) if m{^(?<unit>[0-9]+)(/[0-9]+)+$};
                        }
                    }
                    @if2serial{@$port2if} = @port2serial;
                };
                my %stack_vendors = (
                    'cisco'   => $cisco,
                    'brocade' => $brocade,
                    'foundry' => $brocade,
                    'unsupported' => sub {
                        warn $vendor.' stacks are not supported.';
                    },
                );
                ($stack_vendors{$vendor} || $stack_vendors{'unsupported'})->();
            }

            foreach my $if (keys %if2serial) { # Filter out interfaces without an associated serial.
                $serial2if2ifName{$if2serial{$if}}{$if} = $if2ifName{$if} if defined $if2serial{$if};
            }
        }
    }
    return \%serial2if2ifName;
}




################################################################################




sub recognize { # A recognizable node has a serial that netsync can retrieve.
    my (@nodes) = @_;

    my $serial_count = 0;
    foreach my $node (@nodes) {

        # Establish a connection to the node.
        my ($session,$info) = App::Netsync::SNMP::Info $node->{'ip'};
        if (defined $info) {
            $node->{'session'} = $session;
            $node->{'info'}    = $info;
        }
        else { # Otherwise, consider it inactive.
            note ($config{'NodeLog'},node_string ($node).' inactive');
            say node_string ($node).' inactive' if $config{'Verbose'};
            next;
        }

        # Retrieve the serials of devices at the node.
        my $serial2if2ifName = device_interfaces ($node->{'info'}->vendor,$node->{'session'});
        if (defined $serial2if2ifName) {
            my @serials = keys %$serial2if2ifName;
            note ($config{'NodeLog'},node_string ($node).' '.join (' ',@serials));
            node_initialize ($node,$serial2if2ifName);
            $serial_count += @serials;
        }
        else { # Otherwise, consider the device unrecognized.
            note ($config{'NodeLog'},node_string ($node).' unrecognized');
            say node_string ($node).' unrecognized' if $config{'Verbose'};
            next;
        }

        # Show the user what's been found if necessary.
        node_dump $node if $config{'Verbose'};
    }
    return $serial_count;
}


=head2 discover

search the network for active nodes

B<Arguments>

I<[ ( $node_source [, $host_pattern ] ) ]>

=over 3

=item node_source

where to get nodes from (DNS, STDIN, or a filename)

default: DNS

=item host_pattern

a regular expression to match hostnames from the list of retrieved nodes

default: [^.]+

=back

=cut

sub discover {
    warn 'too many arguments' if @_ > 2;
    my ($node_source,$host_pattern) = @_;
    $node_source  //= 'DNS';
    $host_pattern //= '[^.]+';

    my $nodes = {};

    unless ($config{'Quiet'}) {
        print 'discovering';
        print ' (using '.(($node_source eq 'DNS') ? 'DNS' : 'STDIN').')';
        print '...';
        print (($config{'Verbose'}) ? "\n" : (' 'x$config{'DeviceOrder'}).'0');
    }

    my @zone;
    { # Retrieve relevant nodes.
        my %inputs = (
            'DNS' => sub {
                unless (defined $config{'DNS'}) {
                    warn 'DNS has not been configured.';
                    return undef;
                }
                if (defined $config{'DNS'}{'nameservers'}) {

lib/App/Netsync.pm  view on Meta::CPAN

=head2 identify

identify discovered nodes in a database

B<Arguments>

I<( \%nodes [, $data_source [, $auto_match ] ] )>

=over 3

=item nodes

the discovered nodes to identify

=item data_source

the location of the database (DB or a filename)

default: DB

=item auto_match

whether to enable interface automatching

default: 0

=back

=cut

sub identify {
    warn 'too few arguments'  if @_ < 1;
    warn 'too many arguments' if @_ > 3;
    my ($nodes,$data_source,$auto_match) = @_;
    $data_source //= 'DB';
    $auto_match  //= 0;

    unless ($config{'Quiet'}) {
        print 'identifying';
        print ' (using '.$data_source.')...';
        print (($config{'Verbose'}) ? "\n" : (' 'x$config{'DeviceOrder'}).'0');
    }

    my @data;
    { # Retrieve database.

        unless (defined $config{'DeviceField'}    and
                defined $config{'InterfaceField'} and
                defined $config{'InfoFields'}) {
            warn 'Database fields have not been configured.';
            return undef;
        }

        # Initialize output table headers.
        my $fields = $config{'DeviceField'}.','.$config{'InterfaceField'};
        $fields .= ','.join (',',sort @{$config{'InfoFields'}});

        my %inputs = (
            'DB' => sub {
                my %drivers = DBI->installed_drivers;
                say $_ foreach values %drivers; exit; #XXX debug
                unless (defined $config{'DB'}) {
                    warn 'A database has not been configured.';
                    return undef;
                }

                # Connect to the database.
                my $DSN  =       'dbi:'.$config{'DBMS'};
                   $DSN .=     ':host='.$config{'Server'};
                   $DSN .=     ';port='.$config{'Port'};
                   $DSN .= ';database='.$config{'Database'};
                my $db = DBI->connect($DSN,$config{'Username'},$config{'Password'},$config{'DB'});
                my $query = $db->prepare('SELECT '.$fields.' FROM '.$config{'Table'});
                $query->execute;
                @data = @{$query->fetchall_arrayref({})};
                $db->disconnect;
            },
            'default' => sub { # Read a CSV file specified with the database option (-d).
                open (my $db,'<',$data_source);

                my $parser = Text::CSV->new;
                chomp (my @fields = split (',',<$db>));
                $parser->column_names(@fields);

                # Filter out fields that are not needed,
                # and verify the presence of necessary fields.
                my $removed_field_count = 0;
                foreach my $i (keys @fields) {
                    $i -= $removed_field_count;
                    unless ($fields =~ /(^|,)$fields[$i](,|$)/) {
                        ++$removed_field_count;
                        splice (@fields,$i,1);
                    }
                }
                die 'incompatible database' unless @fields == scalar split (',',$fields);

                foreach my $row (@{$parser->getline_hr_all($db)}) {
                    my $entry = {};
                    $entry->{$_} = $row->{$_} foreach @fields;
                    push (@data,$entry);
                }

                close $db;
            },
        );
        ($inputs{$data_source} || $inputs{'default'})->();
    }

    my $conflict_count = 0;
    {
        my %identified; # $identified{$serial} == $node

        ROW : foreach my $row (@data) {
            my $valid = [
                $config{'DeviceField'},
                $config{'InterfaceField'},
            ];
            foreach my $field (@$valid) { # Verify necessary fields aren't empty.
                next ROW unless defined $row->{$field} and $row->{$field} =~ /\S+/; # Otherwise, skip to the next entry.
            }

lib/App/Netsync.pm  view on Meta::CPAN

 ---------------------------------------------------------              (device)

=cut

sub update {
    warn 'too few arguments'  if @_ < 1;
    warn 'too many arguments' if @_ > 1;
    my ($nodes) = @_;

    unless ($config{'Quiet'}) {
        print 'updating';
        print ' (using '.$config{'SyncOID'}.')...';
        print (($config{'Verbose'}) ? "\n" : (' 'x$config{'DeviceOrder'}).'0');
    }

    my ($successful_update_count,$failed_update_count) = (0,0);
    foreach my $ip (keys %$nodes) {
        my $node = $nodes->{$ip};
        foreach my $serial (keys %{$node->{'devices'}}) {
            my $device = $node->{'devices'}{$serial};
            next unless $device->{'identified'}; # Only update identified devices.

            foreach my $ifName (keys %{$device->{'interfaces'}}) {
                my $interface = $device->{'interfaces'}{$ifName};
                next unless $interface->{'identified'}; # Only update identified interfaces.

                # Format the info to be pushed.
                my $update = '';
                my $empty = 1;
                foreach my $field (sort keys %{$interface->{'info'}}) {
                    $update .= "," unless $update eq '';
                    $update .= $field.':'.$interface->{'info'}{$field};
                    $empty = 0 if defined $interface->{'info'}{$field} and $interface->{'info'}{$field} =~ /[\S]+/;
                }
                $update = '' if $empty;

                my $note = interface_string ($interface).' ('.$interface->{'IID'}.')';
                my $error = App::Netsync::SNMP::set ($config{'SyncOID'},$interface->{'IID'},$update,$node->{'session'});
                unless ($error) { # Log a successful update.
                    $update =~ s/\n/,/g;
                    $update =~ s/\s+//g;
                    $update =~ s/:,/:(empty),/g;
                    note ($config{'UpdateLog'},$note.' '.$update);
                    ++$successful_update_count;

                    unless ($config{'Quiet'}) {
                        if ($config{'Verbose'}) {
                            interface_dump $interface;
                        }
                        else {
                            print  "\b"x$config{'DeviceOrder'};
                            printf ('%'.$config{'DeviceOrder'}.'d',$successful_update_count);
                        }
                    }
                }
                else { # Log a failed update.
                    note ($config{'UpdateLog'},$note.' error: '.$error);
                    ++$failed_update_count;

                    if ($config{'Verbose'}) {
                        say interface_string ($interface).' failed';
                        say ((' 'x$config{'Indent'}).$error);
                    }
                }
            }
        }
    }

    # Show the user how many nodes have been updated if necessary.
    unless ($config{'Quiet'}) {
        print $successful_update_count if $config{'Verbose'};
        print ' successful';
        print ' ('.$failed_update_count.' failed)' if $failed_update_count > 0;
        print "\n";
    }
}


=head1 AUTHOR

David Tucker, C<< <dmtucker at ucsc.edu> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-netsync at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-Netsync>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

 perldoc App::Netsync

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Netsync>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/App-Netsync>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/App-Netsync>

=item * Search CPAN

L<http://search.cpan.org/dist/App-Netsync/>

=back

=head1 LICENSE

Copyright 2013 David Tucker.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published



( run in 1.107 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )