rewrite the CLI transport to provide an API

lib/App/Netdisco/Transport/CLI.pm

@@ -18,67 +18,99 @@ App::Netdisco::Transport::CLI
 
 =head1 DESCRIPTION
 
-Singleton for CLI connections modelled after L<App::Netdisco::Transport::SNMP> but currently 
-with minimal functionality. Returns a L<Net::OpenSSH> instance for a given device IP. Limited 
-to device_auth stanzas tagged sshcollector. Always returns a new connection which the caller 
-is supposed to close (or it will be closed when going out of scope)
+Returns an object which has an active SSH connection which can be used
+for some actions such as arpnip.
+
+ my $cli = App::Netdisco::Transport::CLI->session_for( ... );
 
 =cut
 
+__PACKAGE__->attributes(qw/ sessions /);
 
 sub init {
   my ( $class, $self ) = @_;
+  $self->sessions( {} );
   return $self;
 }
 
-=head1 session_for( $ip, $tag )
+=head1 session_for( $ip )
 
-Given an IP address and a tag, returns an L<Net::OpenSSH> instance configured for and
-connected to that device, as well as the C<device_auth> entry that was chosen for the device.  
+Given an IP address, returns an object instance configured for and connected
+to that device.
 
 Returns C<undef> if the connection fails.
 
 =cut
 
-sub session_for {
-  my ($class, $ip, $tag) = @_;
-  my $device = get_device($ip) or return undef;
+{
+  package MySession;
+  use Moo;
 
-  my $device_auth = [grep { $_->{tag} eq $tag } @{setting('device_auth')}];
+  has 'ssh'  => ( is => 'rw' );
+  has 'auth' => ( is => 'rw' );
+  has 'platform' => ( is => 'rw' );
 
-  # Currently just the first match is used. Warn if there are more.
-  my $selected_auth = $device_auth->[0];
-
-  if (@{$device_auth} > 1){
-    warning sprintf " [%s] Transport::CLI - found %d matching entries in device_auth, using the first one", 
-      $device->ip, scalar @{$device_auth};
+  sub arpnip {
+    my $self = shift;
+    $self->platform->arpnip(@_, $self->ssh, $self->auth);
   }
+}
+
+sub session_for {
+  my ($class, $ip) = @_;
+
+  my $device = get_device($ip) or return undef;
+  my $sessions = $class->instance->sessions or return undef;
+
+  return $sessions->{$device->ip} if exists $sessions->{$device->ip};
+  debug sprintf 'cli session cache warm: [%s]', $device->ip;
+
+  my $auth = (setting('device_auth') || []);
+  if (1 != scalar @$auth) {
+    error sprintf " [%s] require only one matching auth stanza", $device->ip;
+    return undef;
+  }
+  $auth = $auth->[0];
 
   my @master_opts = qw(-o BatchMode=no);
-  push(@master_opts, @{$selected_auth->{ssh_master_opts}}) if $selected_auth->{ssh_master_opts};
+  push(@master_opts, @{$auth->{ssh_master_opts}})
+    if $auth->{ssh_master_opts};
 
+  $Net::OpenSSH::debug = ~0 if setting('log') eq 'debug';
   my $ssh = Net::OpenSSH->new(
     $device->ip,
-    user => $selected_auth->{username},
-    password => $selected_auth->{password},
+    user => $auth->{username},
+    password => $auth->{password},
     timeout => 30,
     async => 0,
     default_stderr_file => '/dev/null',
     master_opts => \@master_opts
   );
 
-  my $CONFIG = config();
-  $Net::OpenSSH::debug = ~0 if $CONFIG->{log} eq 'debug';
-
-  if ($ssh->error){
-    error sprintf " [%s] Transport::CLI - ssh connection error [%s]", $device->ip, $ssh->error;
+  if ($ssh->error) {
+    error sprintf " [%s] ssh connection error [%s]", $device->ip, $ssh->error;
     return undef;
-  }elsif (!$ssh){
-    error sprintf " [%s] Transport::CLI - Net::OpenSSH instantiation error", $device->ip;
-    return undef;
-  }else{
-    return ($ssh, $selected_auth);
   }
+  elsif (! $ssh) {
+    error sprintf " [%s] Net::OpenSSH instantiation error", $device->ip;
+    return undef;
+  }
+
+  my $platform = "App::Netdisco::SSHCollector::Platform::" . $auth->{platform};
+  my $happy = false;
+  try {
+    Module::Load::load $platform;
+    $happy = true;
+  } catch { error $_ };
+  return unless $happy;
+
+  my $sess = MySession->new(
+    ssh  => $ssh,
+    auth => $auth,
+    platform => $platform->new(),
+  );
+
+  return ($sessions->{$device->ip} = $sess);
 }
 
 true;

lib/App/Netdisco/Transport/SNMP.pm

@@ -25,7 +25,7 @@ App::Netdisco::Transport::SNMP
 Singleton for SNMP connections. Returns cached L<SNMP::Info> instance for a
 given device IP, or else undef. All methods are class methods, for example:
 
- App::Netdisco::Transport::SNMP->reader_for( ... );
+ my $snmp = App::Netdisco::Transport::SNMP->reader_for( ... );
 
 =cut