#!/usr/bin/env perl

use strict;
use warnings;

our $home;

BEGIN {
  use FindBin;
  FindBin::again();

  $home = ($ENV{NETDISCO_HOME} || $ENV{HOME});

  # try to find a localenv if one isn't already in place.
  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};
  }
}

BEGIN {
  use Path::Class;

  # stuff useful locations into @INC and $PATH
  unshift @INC,
    dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
    dir($FindBin::RealBin, 'lib')->stringify;

  use Config;
  $ENV{PATH} = $FindBin::RealBin . $Config{path_sep} . $ENV{PATH};
}

use App::Netdisco;
use Dancer ':script';
use Dancer::Plugin::DBIC 'schema';
use Dancer::Plugin::Passphrase;
use App::Netdisco::Util::Statistics ();

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

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

use Archive::Extract;
$Archive::Extract::PREFER_BIN = 1;
use File::Slurper 'read_lines';
use HTTP::Tiny;
use Digest::MD5;
use Try::Tiny;
use File::Path ();
use File::Copy ();
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
F<~/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 and placed into
the user's home directory (or C<$ENV{NETDISCO_HOME}>).

If you upgrade Netdisco make sure you run this script again to make sure
your config remains compatible.

Before each upgrade also review the
L<Release notes|https://github.com/netdisco/netdisco/wiki/Release-Notes> since
additional steps might be required!

=cut

print color 'bold cyan';
say 'This is the Netdisco 2 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 'If you are upgrading Netdisco 2 read the release notes:';
say 'https://github.com/netdisco/netdisco/wiki/Release-Notes';
say 'There you will find required and incompatible changes';
say 'which are not covered by this script.';
say '';
say 'You will be asked to confirm all changes to your system.';
say '';
print color 'reset';

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

exit(0) unless $bool;

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

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';
  print color 'bold blue';
  say 'DB schema update complete.';
  print color 'reset';

  print color 'bold blue';
  print 'Updating statistics... ';
  App::Netdisco::Util::Statistics::update_stats();
  say 'done.';
  print color 'reset';

  if (not setting('safe_password_store')) {
      say '';
      print color 'bold red';
      say '*** WARNING: Weak password hashes are being stored in the database! ***';
      say '*** WARNING: Please add "safe_password_store: true" to your ~/environments/deployment.yml file. ***';
      print color 'reset';
  }

  sub _make_password {
    my $pass = (shift || passphrase->generate_random);
    if (setting('safe_password_store')) {
        return passphrase($pass)->generate;
    }
    else {
        return Digest::MD5::md5_hex($pass),
    }
  }

  # set up initial admin user
  my $users = schema('netdisco')->resultset('User');
  if ($users->search({-bool => 'admin'})->count == 0) {
      say '';
      print color 'bold green';
      say 'We need to create a user for initial login. This user will be a full Administrator.';
      say 'Afterwards, you can go to Admin -> User Management to manage users.';
      print color 'reset';
      say '';

      my ($name, $pass) = get_userpass($term);
      $users->create({
        username => $name,
        password => _make_password($pass),
        admin => 'true',
        port_control => 'true',
      });

      print color 'bold blue';
      say 'New user created.';
      print color 'reset';
  }

  # set initial dancer web session cookie key
  schema('netdisco')->resultset('Session')->find_or_create(
    {id => 'dancer_session_cookie_key', a_session => \'md5(random()::text)'},
    {key => 'primary'},
  );
}

sub get_userpass {
  my $upterm = shift;
  my $name = $upterm->get_reply(prompt => 'Username: ');
  my $pass = $upterm->get_reply(prompt => 'Password: ');

  unless ($name and $pass) {
    say 'username and password cannot be empty, please try again.';
    ($name, $pass) = get_userpass($upterm);
  }

  return ($name, $pass);
}

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

  if (@ARGV) {
      @lines = File::Slurper::read_lines($ARGV[0]);
  }
  else {
      my $url = 'https://raw.githubusercontent.com/netdisco/upstream-sources/master/ieee/oui.txt';
      my $resp = HTTP::Tiny->new->get($url);
      @lines = split /\n/, $resp->{content};
  }

  if (scalar @lines > 50) {
      foreach my $line (@lines) {
          if ($line =~ m/^\s*(.{2}-.{2}-.{2})\s+\(hex\)\s+(.*)\s*$/i) {
              my ($oui, $company) = ($1, $2);
              $oui =~ s/-/:/g;
              $company =~ s/[\r\n]//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 => Encode::decode('UTF-8', $data{$_}{'company'}),
                                  abbrev  => Encode::decode('UTF-8', $data{$_}{'abbrev'}),
                              }
                              } keys %data
            ]);
          });
      }

      print color 'bold blue';
      say 'OUI update complete.';
  }
  else {
      print color 'bold red';
      say 'OUI update failed!';
  }

  print color 'reset';
}

# This subroutine is based on 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) unless @ARGV;
    $manuf = " " . $manuf . " ";

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

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

    # remove junk whitespace
    $manuf =~ s/\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;

    # Deviating from make-manuf for HP
    $manuf =~ s/Hewlett[-]?Packard/Hp/;

    # Truncate all names to first two words max 20 chars
    if (length($manuf) > 21) {
        my @twowords = grep {defined} (split ' ', $manuf)[0 .. 1];
        $manuf = join ' ', @twowords;
    }

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

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

sub deploy_mibs {
  my $mibhome = dir(shift); # /path/to/netdisco-mibs
  my $fail = 0;

  my $latest = 'https://github.com/netdisco/netdisco-mibs/releases/latest';
  my $resp = HTTP::Tiny->new->get($latest);

  if ($resp->{url} =~ m/([0-9.]+)$/) {
    my $ver = $1;
    my $url = "https://github.com/netdisco/netdisco-mibs/releases/download/${ver}/netdisco-mibs.tar.gz";
    my $file = file($home, 'netdisco-mibs.tar.gz');
    $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);

      my $from = file($mibhome->parent->stringify, "netdisco-mibs-$ver");
      my $to = file($mibhome->parent->stringify, 'netdisco-mibs');

      if (-d $from) {
        File::Path::remove_tree($to, { verbose => 0 });
        File::Copy::move($from, $to);
      }
      unlink $file;
    }
    else { ++$fail }
  }
  else { ++$fail }

  if ($fail) {
    print color 'bold red';
    say 'MIB download failed!';
  }
  else {
    print color 'bold blue';
    say 'MIBs update complete.';
  }

  print color 'reset';
}

exit 0;