netdisco/Netdisco/bin/netdisco-deploy

#!/usr/bin/env perl

our $home;

BEGIN {
  # try really hard to find a localenv if one isn't already in place.
  $home = ($ENV{NETDISCO_HOME} || $ENV{HOME});

  if (!exists $ENV{PERL_LOCAL_LIB_ROOT}) {
      use File::Spec;
      my $localenv = File::Spec->catfile($FindBin::RealBin, 'localenv');
      exec($localenv, $0, @ARGV) if -f $localenv;
      $localenv = File::Spec->catfile($home, 'perl5', 'bin', 'localenv');
      exec($localenv, $0, @ARGV) if -f $localenv;

      die "Sorry, can't find libs required for App::Netdisco.\n"
        if !exists $ENV{PERLBREW_PERL};
  }
}

use FindBin;
FindBin::again();
use Path::Class;

BEGIN {
  # stuff useful locations into @INC and $PATH
  my $location = $FindBin::RealBin;

  unshift @INC,
    dir($location)->parent->subdir('lib')->stringify,
    dir($location, 'lib')->stringify;

  use Config;
  $ENV{PATH} = $location . $Config{path_sep} . $ENV{PATH};
}

use App::Netdisco;
use Dancer ':script';
use Dancer::Plugin::DBIC 'schema';

info "App::Netdisco version $App::Netdisco::VERSION loaded.";

use 5.010_000;
use Term::UI;
use Term::ReadLine;

use Archive::Extract;
$Archive::Extract::PREFER_BIN = 1;
use HTTP::Tiny;
use Try::Tiny;
use Encode;

=head1 NAME

netdisco-deploy - Database, OUI and MIB deployment for Netdisco

=head1 USAGE

This script deploys the Netdisco database schema, OUI data, and MIBs. Each of
these is an optional service which the user is asked to confirm.

Pre-existing requirements are that there be a database table created and a
user with rights to create tables in that database. Both the table and user
name must match those configured in your environment YAML file (default
C<~/environments/deployment.yml>).

This script will download the latest MAC address vendor prefix data from the
Internet, and update the OUI table in the database. Hence Internet access is
required to run the script.

Similarly the latest Netdisco MIB bundle is also downloaded, placed into the
user's home directory (or C<$ENV{NETDISCO_HOME}>), and Netdisco reconfigured
for its use.

=cut

say 'This is the Netdisco II deployment script.';
say '';
say 'Before we continue, the following prerequisites must be in place:';
say ' * Database added to PostgreSQL for Netdisco';
say ' * User added to PostgreSQL with rights to the Netdisco Database';
say ' * "~/environments/deployment.yml" file configured with Database dsn/user/pass';
say ' * A full backup of any existing Netdisco database data';
say ' * Internet access (for OUIs and MIBs)';
say '';
say 'You will be asked to confirm all changes to your system.';
say '';

my $term = Term::ReadLine->new('netdisco');
my $bool = $term->ask_yn(
  prompt => 'So, is all the above in place?', default => 'n',
);

exit(0) unless $bool;

say '';
$bool = $term->ask_yn(
  prompt => 'Would you like to deploy or upgrade your database schema?', default => 'n',
);
deploy_db() if $bool;

my $users = schema('netdisco')->resultset('User');
if ($users->count == 0 and setting('no_auth')) {
    say '';
    $bool = $term->ask_yn(
      prompt => 'Would you like the default web user to have Admin rights (discover, etc)?',
      default => 'n',
    );

    if ($bool) {
        $users->create({
          username => 'guest',
          admin => 'true',
          port_control => 'true',
        });
    }
    else {
        say '';
        $bool = $term->ask_yn(
          prompt => 'Would you like the default web user to have Port Control rights?',
          default => 'n',
        );
        if ($bool) {
            $users->create({
              username => 'guest',
              port_control => 'true',
            });
        }
    }
}

say '';
$bool = $term->ask_yn(
  prompt => 'Download and update vendor MAC prefixes (OUI data)?', default => 'n',
);
deploy_oui() if $bool;

say '';
my $default_mibhome = dir($home, 'netdisco-mibs');
if (setting('mibhome') and setting('mibhome') ne $default_mibhome) {
  my $mibhome = $term->get_reply(
    print_me => "MIB home options:",
    prompt   => "Download and update MIB files to...?",
    choices  => [setting('mibhome'), $default_mibhome, 'Skip this.'],
    default  => 'Skip this.',
  );
  deploy_mibs($mibhome) if $mibhome and $mibhome ne 'Skip this.';
}
else {
  $bool = $term->ask_yn(
    prompt => "Download and update MIB files?", default => 'n',
  );
  deploy_mibs($default_mibhome) if $bool;
}

sub deploy_db {
  system 'netdisco-db-deploy';
  say 'DB schema update complete.';
}

sub deploy_oui {
  my $schema = schema('netdisco');
  $schema->storage->disconnect;

  my $url = 'http://standards.ieee.org/develop/regauth/oui/oui.txt';
  my $resp = HTTP::Tiny->new->get($url);
  my %data = ();

  if ($resp->{success}) {
      foreach my $line (split /\n/, $resp->{content}) {
          if ($line =~ m/^\s*(.{2}-.{2}-.{2})\s+\(hex\)\s+(.*)\s*$/i) {
              my ($oui, $company) = ($1, $2);
              $oui =~ s/-/:/g;
              my $abbrev = shorten($company);
              $data{lc($oui)}{'company'} = $company;
              $data{lc($oui)}{'abbrev'}  = $abbrev;
          }
      }

      if ((scalar keys %data) > 15_000) {
          $schema->txn_do(sub{
            $schema->resultset('Oui')->delete;
            $schema->resultset('Oui')->populate([
                          map {
                              {   oui     => $_,
                                  company => $data{$_}{'company'},
                                  abbrev  => $data{$_}{'abbrev'}
                              }
                              } keys %data
            ]);
          });
      }
  }

  say 'OUI update complete.';
}

# This subroutine is from Wireshark's make-manuf
# http://anonsvn.wireshark.org/wireshark/trunk/tools/make-manuf
sub shorten {
    my $manuf = shift;

    $manuf = decode "utf8", $manuf, Encode::FB_CROAK;
    $manuf = " " . $manuf . " ";

    # Remove any punctuation
    $manuf =~ tr/',.()/    /;

    # & isn't needed when Standalone
    $manuf =~ s/ \& / /g;

    # Remove any "the", "inc", "plc" ...
    $manuf
        =~ s/\s(the|inc|incorporated|plc||systems|corp|corporation|s\/a|a\/s|ab|ag|kg|gmbh|co|company|limited|ltd|holding|spa)(?= )//gi;

    # Convert to consistent case
    $manuf =~ s/(\w+)/\u\L$1/g;

    # Remove all spaces
    $manuf =~ s/\s+//g;

  # Truncate all names to a reasonable length, say, 8 characters.
  # If the string contains UTF-8, this may be substantially more than 8 bytes.
    $manuf = substr( $manuf, 0, 8 );

    return encode( "utf8", $manuf );
}

sub deploy_mibs {
  my $mibhome = dir(shift);

  my $url = 'http://downloads.sourceforge.net/project/netdisco/netdisco-mibs/latest-snapshot/netdisco-mibs-snapshot.tar.gz';
  my $file = file($home, 'netdisco-mibs-snapshot.tar.gz');
  my $resp = HTTP::Tiny->new->mirror($url, $file);

  if ($resp->{success}) {
      my $ae = Archive::Extract->new(archive => $file, type => 'tgz');
      $ae->extract(to => $mibhome->parent->stringify);
      unlink $file;
  }

  say 'MIBs update complete.';
}

exit 0;