relocate repo files so ND2 is the only code

bin/nd-dbic-versions

@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use FindBin;
+FindBin::again();
+use Path::Class 'dir';
+
+BEGIN {
+  # stuff useful locations into @INC
+  unshift @INC,
+    dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
+    dir($FindBin::RealBin, 'lib')->stringify;
+}
+
+use App::Netdisco;
+use Dancer ':script';
+use Dancer::Plugin::DBIC 'schema';
+
+use App::Netdisco::DB;
+use Getopt::Long;
+
+=head1 NAME
+
+nd-dbic-versions - Create DB Schema Versions for Netdisco
+
+=head1 USAGE
+
+This script creates SQL DDL files of the Netdisco database schema.
+
+If called without any CLI options, it makes one SQL DDL file which will
+initialize the complete schema to the current DBIx::Class specification.
+
+If called with the "-p <version>" option, upgrade SQL DDL command files
+are created between the specified version and the current DBIx::Class
+specification.
+
+=head1 NEW VERSION
+
+=over 4
+
+=item 1.
+
+Alter the DBIC DDL files as you wish.
+
+=item 2.
+
+Increment the Schema's C<$VERSION> number.
+
+=item 3.
+
+Run this script with "C<-p $current_db_version>".
+
+=back
+
+=cut
+
+my $sql_dir = $App::Netdisco::DB::schema_versions_dir;
+my $version = schema('netdisco')->schema_version;
+
+my ( $preversion, $help );
+GetOptions(
+  'p|preversion:s'  => \$preversion,
+) or do {
+  print <<ENDHELP;
+    $0 [-p <version>]
+
+    This script creates SQL DDL files of the Netdisco database schema.
+
+    If called without any CLI options, it makes one SQL DDL file which will
+    initialize the complete schema to the current DBIx::Class specification.
+
+    If called with the "-p <version>" option, upgrade SQL DDL command files
+    are created between the specified version and the current DBIx::Class
+    specification.
+
+    SQL DDL files are stored in:
+$sql_dir
+ENDHELP
+  exit(1);
+};
+
+schema('netdisco')->create_ddl_dir(
+  'PostgreSQL', $version, $sql_dir, $preversion );
+

bin/nd-import-topology

@@ -0,0 +1,121 @@
+#!/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 App::Netdisco;
+use Dancer ':script';
+use Dancer::Plugin::DBIC 'schema';
+
+use App::Netdisco::Util::Device 'get_device';
+use NetAddr::IP::Lite ':lower';
+use Try::Tiny;
+
+=head1 NAME
+
+nd-import-topology - Import a Nedisco 1.x Manual Topology File
+
+=head1 USAGE
+
+ ~/bin/localenv nd-import-topology /path/to/netdisco-topology.txt
+
+=head1 DESCRIPTION
+
+This helper script will read and import the content of a Netdisco 1.x format
+Manual Topology file into the Netdisco 2.x database's C<topology> table.
+
+It's safe to run the script multiple times on the same file - any new data
+will be imported.
+
+The file syntax must be like so:
+
+ left-device
+   link:left-port,right-device,right-port
+
+The devices can be either host names or IPs. Data will be imported even if the
+devices are currently unknown to Netdisco.
+
+=cut
+
+my $file = $ARGV[0];
+die "missing topology file name on command line\n" unless $file;
+
+chomp $file;
+my $dev = undef; # current device
+print "Loading topology information from $file\n";
+
+open (DEVS,'<', $file)
+  or die "topo_load_file($file): $!\n";
+
+while (my $line = <DEVS>) {
+    chomp $line;
+    $line =~ s/(?<!\\)#.*//;
+    $line =~ s/\\#/#/g;
+    $line =~ s/^\s+//g;
+    $line =~ s/\s+$//g;
+    next if $line =~ m/^\s*$/;
+    
+    if ($line =~ m/^link:(.*)/){
+        my ($from_port, $to, $to_port) = split(m/,/, $1);
+
+        unless (defined $dev) {
+            print " Skipping $line. No device yet defined!\n";
+            next;
+        }
+
+        # save Link info
+        try {
+            schema('netdisco')->txn_do(sub {
+              schema('netdisco')->resultset('Topology')->create({
+                dev1  => $dev,
+                port1 => $from_port,
+                dev2  => get_device($to)->ip,
+                port2 => $to_port,
+              });
+            });
+        };
+    }
+    elsif ($line =~ /^alias:(.*)/) {
+        # ignore aliases
+    }
+    else {
+        my $ip = NetAddr::IP::Lite->new($line)
+          or next;
+        next if $ip->addr eq '0.0.0.0';
+
+        $dev = get_device($ip->addr)->ip;
+        print " Set device: $dev\n";
+    }
+}
+
+close (DEVS);

bin/netdisco-daemon

@@ -0,0 +1,186 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+our $home;
+
+BEGIN {
+  use FindBin;
+  FindBin::again();
+
+  my $me = File::Spec->catfile($FindBin::RealBin, $FindBin::RealScript);
+  my $uid = (stat($me))[4] || 0;
+
+  $home = ($ENV{NETDISCO_HOME} || (getpwuid($uid))[7] || $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::Bin, '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 Daemon::Control;
+use Filesys::Notify::Simple;
+use File::Copy;
+
+use App::Netdisco::Environment;
+my $config = ($ENV{PLACK_ENV} || $ENV{DANCER_ENVIRONMENT}) .'.yml';
+
+my $netdisco = file($FindBin::RealBin, 'netdisco-daemon-fg');
+my @args = (scalar @ARGV > 1 ? @ARGV[1 .. $#ARGV] : ());
+
+my $log_dir = dir($home, 'logs');
+mkdir $log_dir if ! -d $log_dir;
+my $log_file = file($log_dir, 'netdisco-daemon.log');
+
+my $uid = (stat($netdisco->stringify))[4] || 0;
+my $gid = (stat($netdisco->stringify))[5] || 0;
+
+Daemon::Control->new({
+  name => 'Netdisco Daemon',
+  program  => \&restarter,
+  program_args => [@args],
+  pid_file => file($home, 'netdisco-daemon.pid'),
+  stderr_file => $log_file,
+  stdout_file => $log_file,
+  redirect_before_fork => 0,
+  uid => $uid, gid => $gid,
+})->run;
+
+# the guts of this are borrowed from Plack::Loader::Restarter - many thanks!!
+my $child = 0;
+
+sub restarter {
+  my ($daemon, @program_args) = @_;
+  $0 = 'netdisco-daemon';
+
+  $child = fork_and_start($daemon, @program_args);
+  exit(1) unless $child;
+
+  my $watcher = Filesys::Notify::Simple->new([$ENV{DANCER_ENVDIR}, $log_dir]);
+  warn "config watcher: watching $ENV{DANCER_ENVDIR} for updates.\n";
+
+  local $SIG{TERM} = sub { $child = signal_child('TERM', $child); exit(0); };
+
+  while (1) {
+      my @restart;
+
+      # this is blocking
+      $watcher->wait(sub {
+          my @events = @_;
+          @events = grep {$_->{path} eq $log_file or
+                          file($_->{path})->basename eq $config} @events;
+          return unless @events;
+          @restart = @events;
+      });
+
+      my ($hupit, $rotate) = (0, 0);
+      next unless @restart;
+
+      foreach my $f (@restart) {
+          if ($f->{path} eq $log_file) {
+              ++$rotate;
+          }
+          else {
+              warn "-- $f->{path} updated.\n";
+              ++$hupit;
+          }
+      }
+
+      rotate_logs($child, $daemon, @program_args) if $rotate;
+      if ($hupit) {
+          signal_child('TERM', $child);
+          $child = fork_and_start($daemon, @program_args);
+          exit(1) unless $child;
+      }
+  }
+}
+
+sub fork_and_start {
+  my ($daemon, @daemon_args) = @_;
+  my $pid = fork;
+  die "Can't fork: $!" unless defined $pid;
+
+  if ($pid == 0) { # child
+      $daemon->redirect_filehandles;
+      exec( $netdisco->stringify, @daemon_args );
+  }
+  else {
+      return $pid;
+  }
+}
+
+sub signal_child {
+  my ($signal, $pid) = @_;
+  return unless $signal and $pid;
+  warn "config watcher: sending $signal to the server (pid:$pid)...\n";
+  kill $signal => $pid;
+  waitpid($pid, 0);
+}
+
+sub rotate_logs {
+  my $child = shift;
+
+  return unless (-f $log_file) and
+    ((-s $log_file) > (10 * 1024768));
+
+  my @files = glob file($log_dir, '*');
+  foreach my $f (reverse sort @files) {
+      next unless $f =~ m/$log_file\.(\d)$/;
+      my $pos = $1;
+      unlink $f if $pos == 7;
+      my $next = $pos + 1;
+      (my $newf = $f) =~ s/\.$pos$/.$next/;
+      rename $f, $newf;
+  }
+
+  # if the log file's about 10M then the race condition in copy/truncate
+  # has a low risk of data loss. if the file's larger, then we rename and
+  # kill.
+  if ((-s $log_file) > (12 * 1024768)) {
+      rename $log_file, $log_file .'.1';
+      signal_child('TERM', $child);
+      $child = fork_and_start(@_);
+      exit(1) unless $child;
+  }
+  else {
+      copy $log_file, $log_file .'.1';
+      truncate $log_file, 0;
+  }
+}
+
+=head1 NAME
+
+netdisco-daemon - Job Control Daemon for Netdisco
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<App::Netdisco>
+
+=back
+
+=cut

bin/netdisco-daemon-fg

@@ -0,0 +1,109 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use FindBin;
+FindBin::again();
+use Path::Class 'dir';
+
+# get a segfault if we load this later
+use if $^O eq 'linux', 'Sys::Proctitle';
+
+BEGIN {
+  # stuff useful locations into @INC
+  unshift @INC,
+    dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
+    dir($FindBin::RealBin, 'lib')->stringify;
+
+  unshift @INC,
+    split m/:/, ($ENV{NETDISCO_INC} || '');
+}
+
+use App::Netdisco;
+use Dancer qw/:moose :script/;
+warning sprintf "App::Netdisco %s backend", ($App::Netdisco::VERSION || 'HEAD');
+
+use App::Netdisco::Util::Daemon;
+use NetAddr::IP::Lite ':lower'; # to quench AF_INET6 symbol errors
+use Role::Tiny::With;
+
+# preload all worker modules into shared memory
+use App::Netdisco::Daemon::Job ();
+use App::Netdisco::Daemon::Util ();
+use App::Netdisco::Daemon::Worker::Common ();
+use App::Netdisco::Daemon::Worker::Interactive::DeviceActions ();
+use App::Netdisco::Daemon::Worker::Interactive::PortActions ();
+use App::Netdisco::Daemon::Worker::Manager ();
+use App::Netdisco::Daemon::Worker::Poller::Arpnip ();
+use App::Netdisco::Daemon::Worker::Poller::Common ();
+use App::Netdisco::Daemon::Worker::Poller::Device ();
+use App::Netdisco::Daemon::Worker::Poller::Expiry ();
+use App::Netdisco::Daemon::Worker::Poller::Macsuck ();
+use App::Netdisco::Daemon::Worker::Poller::Nbtstat ();
+use App::Netdisco::Daemon::Worker::Poller ();
+use App::Netdisco::Daemon::Worker::Scheduler ();
+
+use MCE::Signal '-setpgrp';
+use MCE::Flow Sereal => 1;
+use MCE::Queue;
+
+# set temporary MCE files' location in home directory
+my $home = ($ENV{NETDISCO_HOME} || $ENV{HOME});
+my $tmp_dir = ($ENV{NETDISCO_TEMP} || dir($home, 'tmp'));
+mkdir $tmp_dir if ! -d $tmp_dir;
+
+# process-table text
+prctl 'netdisco-daemon: master';
+
+# shared local job queue
+my $queue = MCE::Queue->new;
+
+# support a scheduler-only node
+setting('workers')->{'no_manager'} = 1
+  if setting('workers')->{tasks} eq '0';
+
+# MCE::Util has a limit of ncpu if AUTO is used in max_workers,
+# so we parse the field ourselves.
+my $max_workers = parse_max_workers( setting('workers')->{tasks} ) || 0;
+
+mce_flow {
+  task_name => [qw/ scheduler manager poller /],
+  max_workers => [ 1, 1, $max_workers ],
+  tmp_dir => $tmp_dir,
+  on_post_exit => sub { MCE->restart_worker },
+}, _mk_wkr('Scheduler'), _mk_wkr('Manager'), _mk_wkr('Poller');
+
+sub _mk_wkr {
+  my $role = shift;
+  return sub {
+    my $self = shift;
+    $self->{queue} = $queue;
+
+    prctl sprintf 'netdisco-daemon: worker #%s %s: init', MCE->wid, lc($role);
+    info sprintf 'applying role %s to worker %s', $role, MCE->wid;
+
+    # post-fork, become manager, scheduler, poller, etc
+    Role::Tiny->apply_roles_to_object(
+      $self => "App::Netdisco::Daemon::Worker::$role");
+
+    $self->worker_begin if $self->can('worker_begin');
+    $self->worker_body;
+  };
+}
+
+=head1 NAME
+
+netdisco-daemon-fg - Job Control for Netdisco
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<App::Netdisco>
+
+=back
+
+=cut

bin/netdisco-db-deploy

@@ -0,0 +1,138 @@
+#!/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 Try::Tiny;
+
+=head1 NAME
+
+netdisco-db-deploy - Database deployment for Netdisco
+
+=head1 USAGE
+
+This script upgrades or initialises a Netdisco database schema.
+
+ ~netdisco/bin/netdisco-db-deploy [--redeploy-all]
+
+This script connects to the database and runs without user interaction. If
+there's no Nedisco schema, it is deployed. If there's an unversioned schema
+then versioning is added, and updates applied.  Otherwise only necessary
+updates are applied to an already versioned schema.
+
+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>).
+
+If you wish to force the redeployment of all database configuration, pass the
+C<--redeploy-all> argument on the command line.
+
+=head1 VERSIONS
+
+=over 4
+
+=item *
+
+Version 1 is a completely empty database schema with no tables
+
+=item *
+
+Version 2 is the "classic" Netdisco database schema as of Netdisco 1.1
+
+=item *
+
+Versions 5 to 16 add patches for Netdisco 1.2
+
+=item *
+
+Version 17 onwards deploys schema upgrades for Netdisco 2
+
+=back
+
+=cut
+
+my $schema = schema('netdisco');
+
+if (scalar @ARGV and $ARGV[0] and $ARGV[0] eq '--redeploy-all') {
+    $schema->storage->dbh_do(
+      sub {
+        my ($storage, $dbh, @args) = @_;
+        $dbh->do('DROP TABLE dbix_class_schema_versions');
+      },
+    );
+}
+
+# installs the dbix_class_schema_versions table with version "1"
+# which corresponds to an empty schema
+if (not $schema->get_db_version) {
+    $schema->install(1);
+    $schema->storage->disconnect;
+}
+
+# test for existing schema at public release version, set v=2 if so
+try {
+    $schema->storage->dbh_do(sub {
+      my ($storage, $dbh) = @_;
+      $dbh->selectrow_arrayref("SELECT * FROM device WHERE 0 = 1");
+    });
+
+    $schema->_set_db_version({version => 2})
+      if $schema->get_db_version == 1;
+    $schema->storage->disconnect;
+};
+
+# upgrade from whatever dbix_class_schema_versions says, to $VERSION
+# except that get_db_version will be 0 at first deploy
+my $db_version = ($schema->get_db_version || 1);
+my $target_version = $schema->schema_version;
+
+# one step at a time, in case user has applied local changes already
+for (my $i = $db_version; $i < $target_version; $i++) {
+    try {
+        $schema->upgrade_single_step($i, $i + 1);
+    }
+    catch {
+        warn "Error: $_"
+          if $_ !~ m/(does not exist|already exists)/;
+    };
+}
+
+exit 0;

bin/netdisco-deploy

@@ -0,0 +1,318 @@
+#!/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;
+
+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 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
+
+print color 'bold cyan';
+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 '';
+print color 'reset';
+
+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 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';
+
+  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 inital 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 = $term->get_reply(prompt => 'Username: ');
+      my $pass = $term->get_reply(prompt => 'Password: ');
+
+      $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 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;
+              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
+            ]);
+          });
+      }
+
+      print color 'bold blue';
+      say 'OUI update complete.';
+  }
+  else {
+      print color 'bold red';
+      say 'OUI update failed!';
+  }
+
+  print color 'reset';
+}
+
+# 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;
+
+    # Deviating from make-manuf for HP
+    $manuf =~ s/Hewlett[-]?Packard/Hp/;
+
+    # 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); # /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 (exists $resp->{redirects} and $resp->{url} =~ m/([0-9.]+)$/) {
+    my $ver = $1;
+    my $url = 'https://codeload.github.com/netdisco/netdisco-mibs/tar.gz/'. $ver;
+    my $file = file($home, 'netdisco-mibs-latest.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;

bin/netdisco-do

@@ -0,0 +1,462 @@
+#!/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;
+}
+
+# for netdisco app config
+use App::Netdisco;
+use App::Netdisco::Daemon::Job;
+use Dancer qw/:moose :script/;
+
+info "App::Netdisco version $App::Netdisco::VERSION loaded.";
+
+use NetAddr::IP qw/:rfc3021 :lower/;
+use App::Netdisco::Util::Device 'get_device';
+
+use Try::Tiny;
+use Pod::Usage;
+use Scalar::Util 'blessed';
+use Getopt::Long;
+Getopt::Long::Configure ("bundling");
+
+my ($device, $port, $extra, $debug);
+my ($infotrace, $snmptrace, $sqltrace) = (0, 0, 0);
+
+my $result = GetOptions(
+  'device|d=s' => \$device,
+  'port|p=s'   => \$port,
+  'extra|e=s'  => \$extra,
+  'debug|D'    => \$debug,
+  'infotrace|I+' => \$infotrace,
+  'snmptrace|S+' => \$snmptrace,
+  'sqltrace|Q+'  => \$sqltrace,
+) or pod2usage(
+  -msg => 'error: bad options',
+  -verbose => 0,
+  -exitval => 1,
+);
+
+my $CONFIG = config();
+$CONFIG->{logger} = 'console';
+$CONFIG->{log} = ($debug ? 'debug' : 'info');
+
+$ENV{INFO_TRACE} ||= $infotrace;
+$ENV{SNMP_TRACE} ||= $snmptrace;
+$ENV{DBIC_TRACE} ||= $sqltrace;
+
+# reconfigure logging to force console output
+Dancer::Logger->init('console', $CONFIG);
+
+# get requested action
+(my $action = shift @ARGV) =~ s/^set_//
+  if scalar @ARGV;
+
+unless ($action) {
+    pod2usage(
+      -msg => 'error: missing action!',
+      -verbose => 2,
+      -exitval => 2,
+    );
+}
+
+# create worker (placeholder object for the role methods)
+{
+  package MyWorker;
+
+  use Moo;
+  use Module::Load ();
+  use Data::Printer ();
+  use Scalar::Util 'blessed';
+  use NetAddr::IP qw/:rfc3021 :lower/;
+  use Dancer ':script';
+
+  use App::Netdisco::Util::SNMP ();
+  use App::Netdisco::Util::Device
+    qw/get_device delete_device renumber_device/;
+
+  with 'App::Netdisco::Daemon::Worker::Poller::Device';
+  with 'App::Netdisco::Daemon::Worker::Poller::Arpnip';
+  with 'App::Netdisco::Daemon::Worker::Poller::Macsuck';
+  with 'App::Netdisco::Daemon::Worker::Poller::Nbtstat';
+  with 'App::Netdisco::Daemon::Worker::Poller::Expiry';
+  with 'App::Netdisco::Daemon::Worker::Interactive::DeviceActions';
+  with 'App::Netdisco::Daemon::Worker::Interactive::PortActions';
+
+  eval { Module::Load::load 'App::Netdisco::Util::Graph' };
+  sub graph {
+    App::Netdisco::Util::Graph::graph();
+    return ('done', 'Generated graph data.');
+  }
+
+  use App::Netdisco::Util::NodeMonitor ();
+  sub monitor {
+    App::Netdisco::Util::NodeMonitor::monitor();
+    return ('done', 'Generated monitor data.');
+  }
+
+  sub show {
+    my ($self, $job) = @_;
+    my ($device, $port, $extra) = map {$job->$_} qw/device port extra/;
+    return ('error', 'Missing device (-d).') if !defined $device;
+
+    $extra ||= 'interfaces'; my $class = undef;
+    ($class, $extra) = split(/::([^:]+)$/, $extra);
+    if ($class and $extra) {
+        $class = 'SNMP::Info::'.$class;
+    }
+    else {
+        $extra = $class;
+        undef $class;
+    }
+    my $i = App::Netdisco::Util::SNMP::snmp_connect($device, $class);
+    Data::Printer::p($i->$extra);
+    return ('done', sprintf "Showed %s response from %s.", $extra, $device->ip);
+  }
+
+  sub delete {
+    my ($self, $job) = @_;
+    my ($device, $port, $extra) = map {$job->$_} qw/device port extra/;
+    return ('error', 'Missing device (-d).') if !defined $device;
+
+    $port = ($port ? 1 : 0);
+    delete_device($device, $port, $extra);
+    return ('done', sprintf "Deleted device %s.", $device->ip);
+  }
+
+  sub renumber {
+    my ($self, $job) = @_;
+    my ($device, $port, $extra) = map {$job->$_} qw/device port extra/;
+    return ('error', 'Missing device (-d).') if !defined $device;
+    my $old_ip = $device->ip;
+
+    my $new_ip = NetAddr::IP->new($extra);
+    unless ($new_ip and $new_ip->addr ne '0.0.0.0') {
+        return ('error', "Bad host or IP: ".($extra || '0.0.0.0'));
+    }
+
+    my $new_dev = get_device($new_ip->addr);
+    if ($new_dev and $new_dev->in_storage and ($new_dev->ip ne $device->ip)) {
+        return ('error', sprintf "Already know new device as: %s.", $new_dev->ip);
+    }
+
+    renumber_device($device, $new_ip);
+    return ('done', sprintf 'Renumbered device %s to %s (%s).',
+      $device->ip, $new_ip, ($device->dns || ''));
+  }
+
+  sub psql {
+    my ($self, $job) = @_;
+    my ($device, $port, $extra) = map {$job->$_} qw/device port extra/;
+
+    my $name = (setting('database')->{name} || 'netdisco');
+    my $host = setting('database')->{host};
+    my $user = setting('database')->{user};
+    my $pass = setting('database')->{pass};
+
+    my $portnum = undef;
+    if ($host and $host =~ m/([^;]+);port=(\d+)/) {
+        $host = $1;
+        $portnum = $2;
+    }
+
+    $ENV{PGHOST} = $host if $host;
+    $ENV{PGPORT} = $portnum if defined $portnum;
+    $ENV{PGDATABASE} = $name;
+    $ENV{PGUSER} = $user;
+    $ENV{PGPASSWORD} = $pass;
+    $ENV{PGCLIENTENCODING} = 'UTF8';
+
+    if ($extra) {
+        system('psql', '-c', $extra);
+    }
+    else {
+        system('psql');
+    }
+    return ('done', "psql session closed.");
+  }
+}
+my $worker = MyWorker->new();
+
+# belt and braces check before we go ahead
+if (not $worker->can( $action )) {
+  pod2usage(
+    -msg => (sprintf 'error: %s is not a valid action', $action),
+    -verbose => 2,
+    -exitval => 3,
+  );
+}
+
+my $net = NetAddr::IP->new($device);
+if ($device and (!$net or $net->num == 0 or $net->addr eq '0.0.0.0')) {
+    info sprintf '%s: error - Bad host, IP or prefix: %s', $action, $device;
+    exit 1;
+}
+
+my @hostlist = defined $device ? ($net->hostenum) : (undef);
+my $exitstatus = 0;
+
+foreach my $host (@hostlist) {
+    my $dev = $host ? get_device($host->addr) : undef;
+    if ($dev and not (blessed $dev and $dev->in_storage) and $action ne 'discover') {
+        info sprintf "%s: error - Don't know device: %s", $action, $host->addr;
+        next;
+    }
+
+    # what job are we asked to do?
+    my $job = App::Netdisco::Daemon::Job->new({
+      job => 0,
+      action => $action,
+      device => $dev,
+      port   => $port,
+      subaction => $extra,
+    });
+
+    # do job
+    my ($status, $log);
+    try {
+        info sprintf '%s: started at %s', $action, scalar localtime;
+        ($status, $log) = $worker->$action($job);
+    }
+    catch {
+        $status = 'error';
+        $log = "error running job: $_";
+    };
+
+    info sprintf '%s: finished at %s', $action, scalar localtime;
+    info sprintf '%s: status %s: %s', $action, $status, $log;
+    $exitstatus = 1 if !defined $status or $status eq 'error';
+}
+
+exit $exitstatus;
+
+=head1 NAME
+
+netdisco-do - Run any Netdisco job from the command-line.
+
+=head1 SYNOPSIS
+
+ ~/bin/netdisco-do <action> [-DISQ] [-d <device> [-p <port>] [-e <extra>]]
+
+=head1 DESCRIPTION
+
+This program allows you to run any Netdisco poller job from the command-line.
+
+The C<-d> option will accept a hostname (that can be resolved to an IP with
+DNS), an IP address, or IP prefix (subnets in CIDR format). It can be any
+interface on the device known to Netdisco.
+
+Note that some jobs (C<discoverall>, C<macwalk>, C<arpwalk>, C<nbtwalk>)
+simply add entries to the Netdisco job queue for other jobs, so won't seem
+to do much when you trigger them.
+
+=head1 ACTIONS
+
+=head2 discover
+
+Run a discover on the device (specified with C<-d>).
+
+ ~netdisco/bin/netdisco-do discover -d 192.0.2.1
+
+=head2 discoverall
+
+Run a discover for all known devices.
+
+=head2 macsuck
+
+Run a macsuck on the device (specified with C<-d>).
+
+ ~netdisco/bin/netdisco-do macsuck -d 192.0.2.1
+
+=head2 macwalk
+
+Run a macsuck for all known devices.
+
+=head2 arpnip
+
+Run an arpnip on the device (specified with C<-d>).
+
+ ~netdisco/bin/netdisco-do arpnip -d 192.0.2.1
+
+=head2 arpwalk
+
+Run an arpnip for all known devices.
+
+=head2 delete
+
+Delete a device (specified with C<-d>). Pass a log message for the action in
+the C<-e> parameter. Optionally request for associated nodes to be archived
+(rather than deleted) by setting the C<-p> parameter to "C<yes>" (mnemonic:
+B<p>reserve).
+
+ ~netdisco/bin/netdisco-do delete -d 192.0.2.1
+ ~netdisco/bin/netdisco-do delete -d 192.0.2.1 -e 'older than the sun'
+ ~netdisco/bin/netdisco-do delete -d 192.0.2.1 -e 'older than the sun' -p yes
+
+=head2 renumber
+
+Change the canonical IP address of a device (specified with C<-d>). Pass the
+new IP address in the C<-e> parameter. All related records such as topology,
+log and node information will also be updated to refer to the new device.
+
+Note that I<no> check is made as to whether the new IP is reachable for future
+polling.
+
+ ~netdisco/bin/netdisco-do renumber -d 192.0.2.1 -e 192.0.2.254
+
+=head2 nbtstat
+
+Run an nbtstat on the node (specified with C<-d>).
+
+ ~netdisco/bin/netdisco-do nbtstat -d 192.0.2.2
+
+=head2 nbtwalk
+
+Run an nbtstat for all known nodes.
+
+=head2 expire
+
+Run Device and Node expiry actions according to configuration.
+
+=head2 expirenodes
+
+Archive nodes on the specified device. If you want to delete nodes, set the
+C<-e> parameter to "C<no>" (mnemonic: B<e>xpire). If you want to perform the
+action on a specific port, set the C<-p> parameter.
+
+ ~netdisco/bin/netdisco-do expirenodes -d 192.0.2.1
+ ~netdisco/bin/netdisco-do expirenodes -d 192.0.2.1 -p FastEthernet0/1 -e no
+
+=head2 graph
+
+Generate GraphViz graphs for the largest cluster of devices.
+
+You'll need to install the L<Graph::Undirected> and L<GraphViz> Perl modules,
+and possibly also the C<graphviz> utility for your operating system. Also
+create a directory for the output files.
+
+ mkdir ~netdisco/graph
+ ~netdisco/bin/localenv cpanm Graph::Undirected
+ ~netdisco/bin/localenv cpanm GraphViz
+
+=head2 show
+
+Dump the content of an SNMP MIB leaf, which is useful for diagnostics and
+troubleshooting. You should provide the "C<-e>" option which is the name of
+the leaf (such as C<interfaces> or C<uptime>).
+
+If you wish to test with a device class other than that discovered, prefix the
+leaf with the class short name, for example "C<Layer3::C3550::interfaces>" or
+"C<Layer2::HP::uptime>".
+
+ ~netdisco/bin/netdisco-do show -d 192.0.2.1 -e interfaces
+ ~netdisco/bin/netdisco-do show -d 192.0.2.1 -e Layer2::HP::interfaces
+
+=head2 psql
+
+Start an interactive terminal with the Netdisco PostgreSQL database. If you
+pass an SQL statement in the C<-e> option then it will be executed.
+
+ ~netdisco/bin/netdisco-do psql
+ ~netdisco/bin/netdisco-do psql -e 'SELECT ip, dns FROM device'
+ ~netdisco/bin/netdisco-do psql -e 'COPY (SELECT ip, dns FROM device) TO STDOUT WITH CSV HEADER'
+
+=head2 location
+
+Set the SNMP location field on the device (specified with C<-d>). Pass the
+location string in the C<-e> extra parameter.
+
+ ~netdisco/bin/netdisco-do location -d 192.0.2.1 -e 'wiring closet'
+
+=head2 contact
+
+Set the SNMP contact field on the device (specified with C<-d>). Pass the
+contact name in the C<-e> extra parameter.
+
+ ~netdisco/bin/netdisco-do contact -d 192.0.2.1 -e 'tel: 555-2453'
+
+=head2 portname
+
+Set the description on a device port. Requires the C<-d> parameter (device),
+C<-p> parameter (port), and C<-e> parameter (description).
+
+ ~netdisco/bin/netdisco-do portname -d 192.0.2.1 -p FastEthernet0/1 -e 'Web Server'
+
+=head2 portcontrol
+
+Set the up/down status on a device port. Requires the C<-d> parameter
+(device), C<-p> parameter (port), and C<-e> parameter ("up" or "down").
+
+ ~netdisco/bin/netdisco-do portcontrol -d 192.0.2.1 -p FastEthernet0/1 -e up
+ ~netdisco/bin/netdisco-do portcontrol -d 192.0.2.1 -p FastEthernet0/1 -e down
+
+=head2 vlan
+
+Set the native VLAN on a device port. Requires the C<-d> parameter (device),
+C<-p> parameter (port), and C<-e> parameter (VLAN number).
+
+ ~netdisco/bin/netdisco-do vlan -d 192.0.2.1 -p FastEthernet0/1 -e 102
+
+=head2 power
+
+Set the PoE on/off status on a device port. Requires the C<-d> parameter
+(device), C<-p> parameter (port), and C<-e> parameter ("on" or "off").
+
+ ~netdisco/bin/netdisco-do power -d 192.0.2.1 -p FastEthernet0/1 -e on
+ ~netdisco/bin/netdisco-do power -d 192.0.2.1 -p FastEthernet0/1 -e off
+
+=head1 DEBUG LEVELS
+
+The flags "C<-DISQ>" can be specified, multiple times, and enable the
+following items in order:
+
+=over 4
+
+=item C<-D>
+
+Netdisco debug log level
+
+=item C<-I> or C<-II>
+
+L<SNMP::Info> trace level (1 or 2).
+
+=item C<-S> or C<-SS> or C<-SSS>
+
+L<SNMP> (net-snmp) trace level (1, 2 or 3).
+
+=item C<-Q>
+
+L<DBIx::Class> trace enabled
+
+=back
+
+=cut

bin/netdisco-rancid-export

@@ -0,0 +1,202 @@
+#!/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 App::Netdisco::Util::Permission ':all';
+
+my $settings = setting( 'rancid' );
+my $domain_suffix = setting( 'domain_suffix' ) || '';
+my $delimiter = $settings->{ 'delimiter' } || ':';
+my $down_age = $settings->{ 'down_age' } || '1 day';
+my $rancidhome = $settings->{ 'rancid_home' } || '/var/lib/rancid';
+my $config_vendormap = $settings->{ 'vendormap' } || {};
+
+my $by_ip = {};
+foreach my $g (@{$settings->{ 'by_ip' }}) {
+  $by_ip->{$g} = 1;
+}
+
+my $by_hostname = {};
+foreach my $g (@{$settings->{ 'by_hostname' }}) {
+  $by_hostname->{$g} = 1;
+}
+
+my @devices = schema('netdisco')->resultset('Device')->search({},
+  {
+    '+columns' => {
+      old => \"age(now(), last_discover) > interval '$down_age'"
+    }
+  })->all;
+
+my $groups = $settings->{ 'groups' };
+my $list = {};
+
+foreach my $d (@devices) {
+  my $old = $d->get_column( 'old' );
+  my $devgroup = 'other';
+  foreach my $g (keys %$groups) {
+    if (check_acl( $d, $groups->{$g} )) {
+      $devgroup = $g;
+      last;
+    }
+  }
+  push(@{$list->{$devgroup}}, $d);
+}
+
+my %VENDORMAP = (
+# If netdisco vendor name and rancid vendor name
+# do not map 1:1, map it here.
+# eg:
+# 'dell:2024' => 'dellnseries',
+# 'dell:3024' => 'dellnseries'
+);
+
+foreach my $group (keys %$list) {
+  open(ROUTER, ">${rancidhome}/${group}/router.db") || die "${rancidhome}/${group}/router.db: $!\n";
+  foreach my $dev (sort {$a->ip cmp $b->ip} @{$list->{$group}}) {
+    my $vendor = $dev->vendor;
+    my $vendormodel = join(':',$dev->vendor,$dev->model);
+    my $name;
+    if ( $VENDORMAP{$vendor} or $VENDORMAP{$vendormodel} ) {
+      $vendor = $VENDORMAP{$vendormodel} || $VENDORMAP{$vendor};
+    }
+    if ( $config_vendormap->{$vendor} or $config_vendormap->{$vendormodel} ) {
+      $vendor = $config_vendormap->{$vendormodel} || $config_vendormap->{$vendor};
+    }
+    if ($by_ip->{$group}) {
+      $name = $dev->ip;
+    } else {
+      $name = ($dev->dns || $dev->name);
+    }
+    if ($by_hostname->{$group}) {
+      $name =~ s/$domain_suffix$//;
+    }
+    printf ROUTER "%s$delimiter%s$delimiter%s\n", $name, $vendor,
+      $dev->get_column( 'old' ) ? "down" : "up";
+  }
+  close(ROUTER);
+}
+
+=head1 NAME
+
+netdisco-rancid-export - Generate RANCID Group Configuration
+
+=head1 CONFIGURATION
+
+This script requires some configuration to be added to your Netdisco
+"C<~/environments/deployment.yml>" file, for example:
+
+ rancid:
+   rancid_home:  /var/lib/rancid
+   down_age:     '1 day'
+   delimiter:    ':'
+   by_ip:        [ other ]
+   by_hostname:  [ other2 ]
+   groups:
+     switch:     [ 'name:.*[Ss][Ww].*' ]
+     rtr:        [ 'name:[rR]tr.*' ]
+     ap:         [ 'name:[aA][pP].*' ]
+   vendormap:
+     "dell":      force10
+     "dell:2024": dellnseries
+
+Note that C<netdisco-rancid-export> is not part of the automatic scheduler
+built in to Netdisco. You should run this script via C<cron> just after your
+periodic C<discoverall>.
+
+=head2 C<rancid_home>
+
+The location to write RANCID Group configuration files into. A subdirectory
+for each Group will be created.
+
+Default: "C</var/lib/rancid>".
+
+=head2 C<down_age>
+
+This should be the same or greater than the interval between regular discover
+jobs on your network. Devices which have not been discovered within this time
+will be marked as "C<down>" to RANCID.
+
+Default: "C<1 day>".
+
+=head2 C<delimiter>
+
+RANCID version 3 uses a semicolon as delimiter. Set this to the delimiter
+character if needed to be different from the default.
+
+Default: "C<:>".
+
+=head2 C<vendormap>
+
+If the device Vendor in Netdisco is not the same as the RANCID vendor script,
+configure a mapping here. The left hand side (key) should be the Netdisco
+vendor, the right hand side (value) should be the RANCID vendor script name.
+You can also set the Netdisco vendor to be "C<vendor:model>" for fine-grained
+control. See the synopsis for an example.
+
+=head2 C<groups>
+
+This dictionary maps RANCID Group names with configuration which will match
+devices in the Netdisco database. The configuration is the same as any of
+Netdisco's "C<*_only>" settings, and accepts IP, prefix, device property.
+
+=head2 C<by_ip>
+
+List of RANCID Groups which will have Device IPs written to the RANCID
+configuration file, instead of DNS or SNMP host names.
+
+=head2 C<by_hostname>
+
+List of RANCID Groups which will have Device Hostname written to the RANCID
+configuration file, instead of FQDN. This is done simply by stripping the
+C<domain_suffix> configuration item from the FQDN.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<App::Netdisco>
+
+=back
+
+=cut

bin/netdisco-sshcollector

@@ -0,0 +1,293 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+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;
+
+  unshift @INC,
+    split m/:/, ($ENV{NETDISCO_INC} || '');
+
+  use Config;
+  $ENV{PATH} = $FindBin::RealBin . $Config{path_sep} . $ENV{PATH};
+}
+
+use App::Netdisco;
+use App::Netdisco::Core::Arpnip 'store_arp';
+use App::Netdisco::Util::Node 'check_mac';
+use App::Netdisco::Util::DNS 'hostnames_resolve_async';
+use Dancer ':script';
+
+use Data::Printer;
+use Module::Load ();
+use Net::OpenSSH;
+use MCE::Loop Sereal => 1;
+
+use Getopt::Long;
+Getopt::Long::Configure ("bundling");
+
+my ($debug, $sqltrace) = (undef, 0);
+my $result = GetOptions(
+  'debug|D'    => \$debug,
+  'sqltrace|Q+'  => \$sqltrace,
+) or pod2usage(
+  -msg => 'error: bad options',
+  -verbose => 0,
+  -exitval => 1,
+);
+
+my $CONFIG = config();
+$CONFIG->{logger} = 'console';
+$CONFIG->{log} = ($debug ? 'debug' : 'info');
+$ENV{DBIC_TRACE} ||= $sqltrace;
+
+# reconfigure logging to force console output
+Dancer::Logger->init('console', $CONFIG);
+
+#this may be helpful with SSH issues:
+#$Net::OpenSSH::debug = ~0;
+
+MCE::Loop::init { chunk_size => 1 };
+my %stats;
+
+exit main();
+
+sub main {
+    my @input = @{ setting('sshcollector') };
+
+    my @mce_result = mce_loop {
+        my ($mce, $chunk_ref, $chunk_id) = @_;
+        my $host = $chunk_ref->[0];
+
+        my $hostlabel = (!defined $host->{hostname} or $host->{hostname} eq "-")
+            ? $host->{ip} : $host->{hostname};
+
+        if ($hostlabel) {
+            my $ssh = Net::OpenSSH->new(
+                $hostlabel,
+                user => $host->{user},
+                password => $host->{password},
+                timeout => 30,
+                async => 0,
+                master_opts => [
+                    -o => "StrictHostKeyChecking=no",
+                    -o => "BatchMode=no"
+                ],
+            );
+
+            MCE->gather( process($hostlabel, $ssh, $host) );
+        }
+    } \@input;
+
+    return 0 unless scalar @mce_result;
+
+    foreach my $host (@mce_result) {
+        $stats{host}++;
+        info sprintf ' [%s] arpnip - retrieved %s entries',
+            $host->[0], scalar @{$host->[1]};
+        store_arpentries($host->[1]);
+    }
+
+    info sprintf 'arpnip - processed %s ARP Cache entries from %s devices',
+        $stats{entry}, $stats{host};
+    return 0;
+}
+
+sub process {
+    my ($hostlabel, $ssh, $args) = @_;
+
+    my $class = "App::Netdisco::SSHCollector::Platform::".$args->{platform};
+    Module::Load::load $class;
+
+    my $device = $class->new();
+    my $arpentries = [ $device->arpnip($hostlabel, $ssh, $args) ];
+
+    # debug p $arpentries;
+    if (scalar @$arpentries) {
+        hostnames_resolve_async($arpentries);
+        return [$hostlabel, $arpentries];
+    }
+    else {
+        warning "WARNING: no entries received from <$hostlabel>";
+    }
+}
+
+sub store_arpentries {
+    my ($arpentries) = @_;
+
+    foreach my $arpentry ( @$arpentries ) {
+        # skip broadcast/vrrp/hsrp and other wierdos
+        next unless check_mac( undef, $arpentry->{mac} );
+
+        debug sprintf '  arpnip - stored entry: %s / %s',
+            $arpentry->{mac}, $arpentry->{ip};
+        store_arp({
+            node => $arpentry->{mac},
+            ip => $arpentry->{ip},
+            dns => $arpentry->{dns},
+        });
+
+        $stats{entry}++;
+    }
+}
+
+=head1 NAME
+
+netdisco-sshcollector - Collect ARP data for Netdisco from devices without
+full SNMP support
+
+=head1 SYNOPSIS
+
+ # install dependencies:
+ ~netdisco/bin/localenv cpanm --notest Net::OpenSSH Expect
+ 
+ # run manually, or add to cron:
+ ~/bin/netdisco-sshcollector [-DQ]
+
+=head1 DESCRIPTION
+
+Collects ARP data for Netdisco from devices without full SNMP support.
+Currently, ARP tables can be retrieved from the following device classes:
+
+=over 4
+
+=item * L<App::Netdisco::SSHCollector::Platform::GAIAEmbedded> - Check Point GAIA Embedded
+
+=item * L<App::Netdisco::SSHCollector::Platform::CPVSX> - Check Point VSX
+
+=item * L<App::Netdisco::SSHCollector::Platform::ACE> - Cisco ACE
+
+=item * L<App::Netdisco::SSHCollector::Platform::ASA> - Cisco ASA
+
+=item * L<App::Netdisco::SSHCollector::Platform::IOS> - Cisco IOS
+
+=item * L<App::Netdisco::SSHCollector::Platform::IOSXR> - Cisco IOS XR
+
+=item * L<App::Netdisco::SSHCollector::Platform::BigIP> - F5 Networks BigIP
+
+=item * L<App::Netdisco::SSHCollector::Platform::FreeBSD> - FreeBSD
+
+=item * L<App::Netdisco::SSHCollector::Platform::Linux> - Linux
+
+=item * L<App::Netdisco::SSHCollector::Platform::PaloAlto> - Palo Alto
+
+=back
+
+The collected arp entries are then directly stored in the netdisco database.
+
+=head1 CONFIGURATION
+
+The following should go into your Netdisco 2 configuration file, "C<<
+~/environments/deployment.yml >>"
+
+=over 4
+
+=item C<sshcollector>
+
+Data is collected from the machines specified in this setting. The format is a
+list of dictionaries. The keys C<ip>, C<user>, C<password>, and C<platform>
+are required.  Optionally the C<hostname> key can be used instead of the
+C<ip>. For example:
+
+ sshcollector:
+   - ip: '192.0.2.1'
+     user: oliver
+     password: letmein
+     platform: IOS
+   - hostname: 'core-router.example.com'
+     user: oliver
+     password: letmein
+     platform: IOS
+
+Platform is the final part of the classname to be instantiated to query the
+host, e.g. platform B<ACE> will be queried using
+C<App::Netdisco::SSHCollector::Platform::ACE>.
+
+If the password is "-", public key authentication will be attempted.
+
+=back
+
+=head1 ADDING DEVICES
+
+Additional device classes can be easily integrated just by adding and
+additonal class to the C<App::Netdisco::SSHCollector::Platform> namespace.
+This class must implement an C<arpnip($hostname, $ssh)> method which returns
+an array of hashrefs in the format
+
+ @result = ({ ip => IPADDR, mac => MACADDR }, ...) 
+
+The parameter C<$ssh> is an active C<Net::OpenSSH> connection to the host.
+Depending on the target system, it can be queried using simple methods like
+
+ my @data = $ssh->capture("show whatever")
+
+or automated via Expect - this is mostly useful for non-Linux appliances which
+don't support command execution via ssh:
+
+ my ($pty, $pid) = $ssh->open2pty or die "unable to run remote command";
+ my $expect = Expect->init($pty);
+ my $prompt = qr/#/;
+ my ($pos, $error, $match, $before, $after) = $expect->expect(10, -re, $prompt);
+ $expect->send("terminal length 0\n");
+ # etc...
+
+The returned IP and MAC addresses should be in a format that the respective
+B<inetaddr> and B<macaddr> datatypes in PostgreSQL can handle.   
+
+=head1 DEBUG LEVELS
+
+The flags "C<-DQ>" can be specified, multiple times, and enable the following
+items in order:
+
+=over 4
+
+=item C<-D>
+
+Netdisco debug log level
+
+=item C<-Q>
+
+L<DBIx::Class> trace enabled
+
+=back
+
+=head1 DEPENDENCIES
+
+=over 4
+
+=item L<App::Netdisco>
+
+=item L<Net::OpenSSH>
+
+=item L<Expect>
+
+=back
+ 
+=cut

bin/netdisco-web

@@ -0,0 +1,203 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+our $home;
+
+BEGIN {
+  use FindBin;
+  FindBin::again();
+
+  my $me = File::Spec->catfile($FindBin::RealBin, $FindBin::RealScript);
+  my $uid = (stat($me))[4] || 0;
+
+  $home = ($ENV{NETDISCO_HOME} || (getpwuid($uid))[7] || $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::Bin, '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 Daemon::Control;
+use Filesys::Notify::Simple;
+use IO::File;
+use File::Copy;
+
+use App::Netdisco::Environment;
+my $config = ($ENV{PLACK_ENV} || $ENV{DANCER_ENVIRONMENT}) .'.yml';
+
+my $netdisco = file($FindBin::RealBin, 'netdisco-web-fg');
+my @args = (scalar @ARGV > 1 ? @ARGV[1 .. $#ARGV] : ());
+
+my $uid = (stat($netdisco->stringify))[4] || 0;
+my $gid = (stat($netdisco->stringify))[5] || 0;
+
+my $log_dir = dir($home, 'logs');
+mkdir $log_dir if ! -d $log_dir;
+chown $uid, $gid, $log_dir;
+
+my $pid_file = file($home, 'netdisco-web.pid');
+my $log_file = file($log_dir, 'netdisco-web.log');
+
+# change ownership of key files to be netdisco user
+foreach my $file ($pid_file, $log_file) {
+    unless (-e $file) {
+        sysopen my $fh, $file, O_WRONLY|O_CREAT|O_NONBLOCK|O_NOCTTY;
+        print $fh '0' if $file eq $pid_file;
+        close $fh;
+    }
+    chown $uid, $gid, $file;
+}
+
+# clean old web sessions
+my $sdir = dir($home, 'netdisco-web-sessions')->stringify;
+unlink glob file($sdir, '*');
+
+Daemon::Control->new({
+  name => 'Netdisco Web',
+  program  => \&restarter,
+  program_args => [
+    '--disable-keepalive',
+    '--user', $uid, '--group', $gid,
+    @args, $netdisco->stringify
+  ],
+  pid_file => $pid_file,
+  stderr_file => $log_file,
+  stdout_file => $log_file,
+  redirect_before_fork => 0,
+  ((scalar grep { $_ =~ m/port/ } @args) ? ()
+                                         : (uid => $uid, gid => $gid)),
+})->run;
+
+# the guts of this are borrowed from Plack::Loader::Restarter - many thanks!!
+
+sub restarter {
+  my ($daemon, @program_args) = @_;
+
+  my $child = fork_and_start($daemon, @program_args);
+  exit(1) unless $child;
+
+  my $watcher = Filesys::Notify::Simple->new([$ENV{DANCER_ENVDIR}, $log_dir]);
+  warn "config watcher: watching $ENV{DANCER_ENVDIR} for updates.\n";
+
+  # TODO: starman also supports TTIN,TTOU,INT,QUIT
+  local $SIG{HUP}  = sub { signal_child('HUP',  $child); };
+  local $SIG{TERM} = sub { signal_child('TERM', $child); exit(0); };
+
+  while (1) {
+      my @restart;
+
+      # this is blocking
+      $watcher->wait(sub {
+          my @events = @_;
+          @events = grep {$_->{path} eq $log_file or
+                          file($_->{path})->basename eq $config} @events;
+          return unless @events;
+          @restart = @events;
+      });
+
+      my ($hupit, $rotate) = (0, 0);
+      next unless @restart;
+
+      foreach my $f (@restart) {
+          if ($f->{path} eq $log_file) {
+              ++$rotate;
+          }
+          else {
+              warn "-- $f->{path} updated.\n";
+              ++$hupit;
+          }
+      }
+
+      rotate_logs($child) if $rotate;
+      signal_child('HUP', $child) if $hupit;
+  }
+}
+
+sub fork_and_start {
+  my ($daemon, @starman_args) = @_;
+  my $pid = fork;
+  die "Can't fork: $!" unless defined $pid;
+
+  if ($pid == 0) { # child
+      $daemon->redirect_filehandles;
+      exec( 'starman', @starman_args );
+  }
+  else {
+      return $pid;
+  }
+}
+
+sub signal_child {
+  my ($signal, $pid) = @_;
+  return unless $signal and $pid;
+  warn "config watcher: sending $signal to the server (pid:$pid)...\n";
+  kill $signal => $pid;
+  waitpid($pid, 0);
+}
+
+sub rotate_logs {
+  my $child = shift;
+
+  return unless (-f $log_file) and
+    ((-s $log_file) > (10 * 1024768));
+
+  my @files = glob file($log_dir, '*');
+  foreach my $f (reverse sort @files) {
+      next unless $f =~ m/$log_file\.(\d)$/;
+      my $pos = $1;
+      unlink $f if $pos == 7;
+      my $next = $pos + 1;
+      (my $newf = $f) =~ s/\.$pos$/.$next/;
+      rename $f, $newf;
+  }
+
+  # if the log file's about 10M then the race condition in copy/truncate
+  # has a low risk of data loss. if the file's larger, then we rename and
+  # kill.
+  if ((-s $log_file) > (12 * 1024768)) {
+      rename $log_file, $log_file .'.1';
+      signal_child('HUP', $child);
+  }
+  else {
+      copy $log_file, $log_file .'.1';
+      truncate $log_file, 0;
+  }
+}
+
+=head1 NAME
+
+netdisco-web - Web Application Server for Netdisco
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<App::Netdisco>
+
+=back
+
+=cut

bin/netdisco-web-fg

@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+BEGIN {
+  if ($ENV{_} and $ENV{_} =~ m/netdisco-web-fg$/) {
+      die "You probably want: '~/bin/localenv starman $0 --workers=1 --disable-keepalive'\n";
+  }
+}
+
+use FindBin;
+FindBin::again();
+use Path::Class 'dir';
+
+BEGIN {
+  # stuff useful locations into @INC
+  unshift @INC,
+    dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
+    dir($FindBin::RealBin, 'lib')->stringify;
+
+  unshift @INC,
+    split m/:/, ($ENV{NETDISCO_INC} || '');
+}
+
+use App::Netdisco;
+use Dancer;
+warning sprintf "App::Netdisco %s web", ($App::Netdisco::VERSION || 'HEAD');
+
+set plack_middlewares => [
+  ['Plack::Middleware::ReverseProxy'],
+  [ Expires => (
+      content_type => [qr{^application/javascript}, qr{^text/css}, qr{image}, qr{font}],
+      expires => 'access plus 1 day',
+  )],
+  [ Static => (
+      path => qr{^/(?:javascripts|css|font|images)/},
+      root => $ENV{DANCER_PUBLIC},
+      pass_through => 1,
+  )],
+  # install Dancer::Debug for this...
+  (
+    $ENV{DANCER_DEBUG} ?
+      [ Debug => (
+          panels => [qw/Dancer::Settings Parameters Dancer::Version DBITrace/],
+      )]
+    : ()
+  )
+];
+
+use App::Netdisco::Web;
+use Plack::Builder;
+
+my $path = (setting('path') || '/');
+builder { mount $path => dance };
+
+=head1 NAME
+
+netdisco-web-fg - Web Application for Netdisco
+
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<App::Netdisco>
+
+=back
+
+=cut