implementation of first per port control - untested

Netdisco/lib/Netdisco/PortControl/Actions.pm

@@ -3,6 +3,55 @@ package Netdisco::PortControl::Actions;
 use Netdisco::Util ':port_control';
 use Try::Tiny;
 
+sub portcontrol {
+  my ($self, $job) = @_;
+
+  my $ip = $job->device;
+  my $pn = $job->port;
+  (my $dir = $job->subaction) =~ s/-\w+//;
+
+  try {
+      my $port = get_port($ip, $pn)
+        or return _error("Unknown port name [$pn] on device [$ip]");
+
+      my $reconfig_check = port_reconfig_check($port);
+      return _error("Cannot alter port: $reconfig_check")
+        if length $reconfig_check;
+
+      # snmp connect using rw community
+      my $info = snmp_connect($ip)
+        or return _error("Failed to connect to device [$ip] to control port");
+
+      my $iid = get_iid($port)
+        or return _error("Failed to get port ID for [$pn] from [$ip]");
+
+      my $rv = $info->set_i_up_admin(lc($dir), $iid);
+
+      return _error("Failed to set [$pn] port status to [$dir] on [$ip]")
+        if !defined $rv;
+
+      # confirm the set happened
+      $info->clear_cache;
+      my $state = ($info->i_up_admin($iid) || '');
+      if ($state ne $dir) {
+          return _error("Verify of [$pn] port status failed on [$ip]: $state");
+      }
+
+      # get device details from db
+      my $device = $port->device
+        or return _error("Updated [$pn] port status on [$ip] but failed to update DB");
+
+      # update netdisco DB
+      $device->update({up_admin => $state});
+
+      return _done("Updated [$pn] port status on [$ip] to [$state]");
+  }
+  catch {
+      return _error("Failed to update [$pn] port status on [$ip]: $_");
+  };
+}
+
+
 sub set_location {
   my ($self, $job) = @_;
   return $self->_set_generic($job->device, 'location', $job->subaction);
@@ -34,7 +83,7 @@ sub _set_generic {
       $info->clear_cache;
       my $new_data = ($info->$slot || '');
       if ($new_data ne $data) {
-          return _error("Verify of $slot update failed on [$ip]");
+          return _error("Verify of $slot update failed on [$ip]: $new_data");
       }
 
       # get device details from db

Netdisco/lib/Netdisco/Util.pm

@@ -12,13 +12,18 @@ use Try::Tiny;
 use base 'Exporter';
 our @EXPORT = ();
 our @EXPORT_OK = qw/
-  is_discoverable
   load_nd_config
-  get_device
+  is_discoverable
+  is_vlan_interface port_has_phone
+  get_device get_port get_iid
+  vlan_reconfig_check port_reconfig_check
   snmp_connect
   sort_port
 /;
-our %EXPORT_TAGS = (port_control => [qw/get_device snmp_connect/]);
+our %EXPORT_TAGS = (port_control => [qw/
+  get_device get_port snmp_connect
+  port_reconfig_check
+/]);
 
 =head1 Netdisco::Util
 
@@ -126,12 +131,92 @@ sub get_device {
     ->find({ip => $alias->ip});
 }
 
-sub _build_mibdirs {
+sub get_port {
-  my $mibhome  = var('nd_config')->{_}->{mibhome};
+  my ($device, $portname) = @_;
-  (my $mibdirs = var('nd_config')->{_}->{mibdirs}) =~ s/\s+//g;
 
-  $mibdirs =~ s/\$mibhome/$mibhome/g;
+  # accept either ip or dbic object
-  return [ split /,/, $mibdirs ];
+  $device = get_device($device)
+    if not ref $device;
+
+  my $port = schema('Netdisco')->resultset('DevicePort')
+    ->find({ip => $device->ip, port => $portname});
+
+  return $port;
+}
+
+sub get_iid {
+  my ($info, $port) = @_;
+
+  # accept either port name or dbic object
+  $port = $port->port if ref $port;
+
+  my $interfaces = $info->interfaces;
+  my %rev_if     = reverse %$interfaces;
+  my $iid        = $rev_if{$port};
+
+  return $iid;
+}
+
+sub is_vlan_interface {
+  my $port = shift;
+
+  my $is_vlan  = (($port->type and
+    $port->type =~ /^(53|propVirtual|l2vlan|l3ipvlan|135|136|137)$/i)
+    or ($port->port and $port->port =~ /vlan/i)
+    or ($port->name and $port->name =~ /vlan/i)) ? 1 : 0;
+
+  return $is_vlan;
+}
+
+sub port_has_phone {
+  my $port = shift;
+
+  my $has_phone = ($port->remote_type
+    and $port->remote_type =~ /ip.phone/i) ? 1 : 0;
+
+  return $has_phone;
+}
+
+sub vlan_reconfig_check {
+  my $port = shift;
+  my $ip = $port->ip;
+  my $name = $port->port;
+  my $nd_config = var('nd_config')->{_};
+
+  my $is_vlan = is_vlan_interface($port);
+
+  # vlan (routed) interface check
+  return "forbidden: [$name] is a vlan interface on [$ip]"
+    if $is_vlan;
+
+  return "forbidden: not permitted to change native vlan"
+    if not $nd_config->{vlanctl};
+
+  return;
+}
+
+sub port_reconfig_check {
+  my $port = shift;
+  my $ip = $port->ip;
+  my $name = $port->port;
+  my $nd_config = var('nd_config')->{_};
+
+  my $has_phone = has_phone($port);
+  my $is_vlan   = is_vlan_interface($port);
+
+  # uplink check
+  return "forbidden: port [$name] on [$ip] is an uplink"
+    if $port->remote_type and not $has_phone and not $nd_config->{allow_uplinks};
+
+  # phone check
+  return "forbidden: port [$name] on [$ip] is a phone"
+    if $has_phone and $nd_config->{portctl_nophones};
+
+  # vlan (routed) interface check
+  return "forbidden: [$name] is a vlan interface on [$ip]"
+    if $is_vlan and not $nd_config->{portctl_vlans};
+
+  return;
 }
 
 =head2 snmp_connect( $ip )
@@ -185,6 +270,14 @@ sub snmp_connect {
   return $info;
 }
 
+sub _build_mibdirs {
+  my $mibhome  = var('nd_config')->{_}->{mibhome};
+  (my $mibdirs = var('nd_config')->{_}->{mibdirs}) =~ s/\s+//g;
+
+  $mibdirs =~ s/\$mibhome/$mibhome/g;
+  return [ split /,/, $mibdirs ];
+}
+
 =head2 sort_port( $a, $b )
 
 Sort port names of various types used by device vendors. Interface is as