Commit 682bca22 authored by Mike Hibler's avatar Mike Hibler

Support for RESTCONF API used by new Dell OS10-based switches (S5248F-ON).

Could be vastly improved, but it works for what we need to do.
parent eb8b1b87
#
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
# Copyright (c) 2000-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -40,8 +40,9 @@ LIB_STUFF = snmpit_intel.pm \
snmpit_nortel.pm snmpit_hp.pm snmpit_apcon.pm \
snmpit_arista.pm snmpit_arista_switch_daemon.py \
snmpit_mellanox.pm MLNX_XMLGateway.pm \
snmpit_force10.pm force10_expect.pm snmpit_h3c.pm \
snmpit_libNetconf.pm snmpit_netscout.pm
snmpit_force10.pm force10_expect.pm \
snmpit_dellrest.pm dell_rest.pm \
snmpit_h3c.pm snmpit_libNetconf.pm snmpit_netscout.pm
#
# Force dependencies on the scripts so that they will be rerun through
......
#!/usr/bin/perl -w
#
# Copyright (c) 2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LGPL
#
# This file is part of the Emulab network testbed software.
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU Lesser General Public License as published by
# the Free Software Foundation; either version 2.1 of the License, or (at
# your option) any later version.
#
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
# License for more details.
#
# You should have received a copy of the GNU Lesser General Public License
# along with this file. If not, see <http://www.gnu.org/licenses/>.
#
# }}}
#
#
# Module for Dell OS10 Enterprise RESTCONF API.
# XXX taken from FreeNAS REST API support and probably very similar to other
# REST APIs...
#
package dell_rest;
use strict;
use English;
use HTTP::Tiny;
use JSON::PP;
use MIME::Base64;
use Data::Dumper;
use Socket;
$| = 1; # Turn off line buffering on output
sub new($$$$)
{
# The next two lines are some voodoo taken from perltoot(1)
my $proto = shift;
my $class = ref($proto) || $proto;
my $name = shift;
my $debugLevel = shift;
my $userpass = shift; # username and password
#
# Create the actual object
#
my $self = {};
#
# Set the defaults for this object
#
if (defined($debugLevel)) {
$self->{DEBUG} = $debugLevel;
} else {
$self->{DEBUG} = 0;
}
$self->{NAME} = $name;
($self->{USERNAME}, $self->{PASSWORD}) = split(/:/, $userpass);
if (!$self->{USERNAME} || !$self->{PASSWORD}) {
warn "dell_rest: ERROR: must pass in username AND password!\n";
return undef;
}
if ($self->{DEBUG}) {
print "dell_rest initializing for $self->{NAME}, " .
"debug level $self->{DEBUG}\n" ;
}
# Make it a class object
bless($self, $class);
return $self;
}
#
# Make a request via the RESTCONF API.
# $method is "GET", "PUT", "POST", or "DELETE"
# $path is the resource path, e.g., "interfaces/ethernet"
# $datap is a reference to a hash of KEY=VALUE input content (default is ())
# $exstat is the expected success status code if not the method default
# $errorp is a reference to a string, used to return error string if !undef
# Return value is the decoded (as a hash) JSON KEY=VALUE returned by request
# Returns undef on failure.
#
sub call($$$;$$$$)
{
my ($self,$method,$path,$datap,$exstat,$errorp,$raw) = @_;
my %data = $datap ? %$datap : ();
my ($datastr,$paramstr);
my %status = (
"GET" => 200,
"PUT" => 200,
"POST" => 201,
"DELETE" => 204,
"PATCH" => 204
);
my $auth = $self->{USERNAME} . ":" . $self->{PASSWORD};
my $server = $self->{NAME};
if (%data > 0) {
$datastr = encode_json(\%data);
} else {
$datastr = "";
}
my $url = "https://$server/restconf/data/$path";
# we want to know with basic debugging whenever we go to the switch
print STDERR "dell_rest: make RESTAPI call to $server\n"
if ($self->{DEBUG});
print STDERR "$server: REQUEST: method=$method URL=$url\nCONTENT=$datastr\n"
if ($self->{DEBUG} > 3);
my %headers = (
"Accept" => "application/json",
"Authorization" => "Basic " . MIME::Base64::encode_base64($auth, "")
);
if ($method eq "POST" || $method eq "PATCH") {
$headers{"Content-Type"} = "application/json";
}
my $http = HTTP::Tiny->new("timeout" => 10);
my %options = ("headers" => \%headers, "content" => $datastr);
my $res = $http->request($method, $url, \%options);
print STDERR "$server: RESPONSE: ", Dumper($res), "\n"
if ($self->{DEBUG} > 3);
$exstat = $status{$method}
if (!defined($exstat));
if ($res->{'success'} && $res->{'status'} == $exstat) {
if (exists($res->{'headers'}{'content-type'}) &&
($res->{'headers'}{'content-type'} eq "application/json" ||
$res->{'headers'}{'content-type'} eq "application/yang-data+json")) {
return $raw ?
$res->{'content'} : JSON::PP->new->decode($res->{'content'});
}
if (!exists($res->{'content'})) {
return {};
}
if (!ref($res->{'content'})) {
return { "content" => $res->{'content'} };
}
my $msg = "Unparsable content: " . Dumper($res->{'content'});
if ($errorp) {
$$errorp = $msg;
} else {
warn("*** ERROR: dell_rest: $msg");
}
return undef;
}
if ($res->{'reason'}) {
my $content;
if (exists($res->{'content'}) &&
exists($res->{'headers'}{'content-type'})) {
my $ctype = $res->{'headers'}{'content-type'};
if ($ctype eq "text/plain") {
$content = $res->{'content'};
} elsif ($ctype eq "application/json" ||
$ctype eq "application/yang-data+json") {
my $cref =
JSON::PP->new->decode($res->{'content'});
if ($cref && ref $cref) {
if (exists($cref->{'ietf-restconf:errors'}) &&
exists($cref->{'ietf-restconf:errors'}->{'error'})) {
$content = $cref->{'ietf-restconf:errors'}->{'error'};
$content = @{$content}[0]->{'error-message'};
}
} elsif ($cref) {
$content = $cref;
} else {
$content = $res->{'content'};
}
}
}
my $msg = "Request failed: " . $res->{'reason'};
if ($content) {
$msg .= "\nRESTCONF error: $content";
}
if ($errorp) {
$$errorp = $msg;
} else {
warn("*** ERROR: dell_rest: $msg");
}
return undef;
}
my $msg = "Request failed: " . Dumper($res);
if ($errorp) {
$$errorp = $msg;
} else {
warn("*** ERROR: dell_rest: $msg");
}
return undef;
}
#
# Create a perl hash (suitable for JSON encoding) representing a new VLAN.
#
sub makeVlanSpec($$$)
{
my ($self,$tag,$name) = @_;
my $vname = "vlan$tag";
my $vlanhash = {
"interface" => [{
"type" => "iana-if-type:l2vlan",
"enabled" => JSON::PP::true,
"description" => "$name",
"name" => "$vname"
}]
};
return $vlanhash;
}
sub addPortsVlanSpec($$$$)
{
my ($self,$tag,$uportref,$tportref) = @_;
my $vname = "vlan$tag";
my @uports = ($uportref ? @{$uportref} : ());
my @tports = ($tportref ? @{$tportref} : ());
my $vlanhash = {
"interface" => [{
"name" => "$vname",
}]
};
if (@uports) {
$vlanhash->{"interface"}->[0]->{"dell-interface:untagged-ports"} = [@uports];
}
if (@tports) {
$vlanhash->{"interface"}->[0]->{"dell-interface:tagged-ports"} = [@tports];
}
return $vlanhash;
}
sub trunkPortSpec($$)
{
my ($self,$iface) = @_;
my $porthash = {
"interface" => [{
"name" => "$iface",
"dell-interface:mode" => "MODE_L2HYBRID"
}]
};
return $porthash;
}
sub enablePortSpec($$$)
{
my ($self,$iface,$state) = @_;
my $porthash = {
"interface" => [{
"name" => "$iface",
"enabled" => $state
}]
};
return $porthash;
}
#!/usr/bin/perl
#
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
# Copyright (c) 2000-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -391,6 +391,11 @@ foreach my $name (keys %portMap) {
$device = new snmpit_mellanox($name);
last;
};
/dellrest/ && do {
require snmpit_dellrest;
$device = new snmpit_dellrest($name);
last;
};
/force10/ && do {
require snmpit_force10;
$device = new snmpit_force10($name);
......@@ -407,6 +412,11 @@ foreach my $name (keys %portMap) {
goto skip;
}
if (!$device) {
warn "ERROR: could not create object for switch type '$type', skipping some ports\n";
goto skip;
}
my @results = $device->getFields(\@ports,\@oids);
foreach my $result (@results) {
......
#!/usr/bin/perl -w
#
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
# Copyright (c) 2000-2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LGPL
#
......@@ -1596,8 +1596,8 @@ sub doListPorts($) {
#
our ($port,$enabled,$up,$speed,$duplex);
print << "END";
Port Enabled Up Speed Duplex
--------------------------------------------
Port Enabled Up Speed Duplex
------------------------------------------------
END
# make port field much longer because we use the 'triple' format of port string
format portlist =
......@@ -1859,12 +1859,12 @@ sub doGetStats($) {
# See perlform(1) for help with formats
#
print << "END";
In InUnicast InNUnicast In In Unknown Out OutUnicast OutNUcast Out Out OutQueue
Port Octets Packets Packets Discards Errors Protocol Octets Packets Packets Discards Errors Length
---------------------------------------------------------------------------------------------------------------------------------------------
In InUnicast InNUnicast In In Unknown Out OutUnicast OutNUcast Out Out OutQueue
Port Octets Packets Packets Discards Errors Protocol Octets Packets Packets Discards Errors Length
-------------------------------------------------------------------------------------------------------------------------------------------------
END
format stats =
@<<<<<<<< @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>>
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>> @>>>>>>>>>
$port, $inoctets, $inunicast,$innunicast,$indiscards,$inerr, $inunk, $outoctets,$outunicast,$outnunicast,$outdiscards,$outerr,$outq
.
$FORMAT_NAME = 'stats';
......
#!/usr/bin/perl -w
#
# Copyright (c) 2019 University of Utah and the Flux Group.
#
# {{{EMULAB-LGPL
#
# This file is part of the Emulab network testbed software.
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU Lesser General Public License as published by
# the Free Software Foundation; either version 2.1 of the License, or (at
# your option) any later version.
#
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
# License for more details.
#
# You should have received a copy of the GNU Lesser General Public License
# along with this file. If not, see <http://www.gnu.org/licenses/>.
#
# }}}
#
#
# snmpit module for Dell OS10 switches supporting RESTCONF interface.
#
# Behavior/requirements of OS10:
#
# port in access mode, must have an access vlan
# port in trunk mode, needs no access vlan or trunk vlans
# port in trunk mode with no access vlan, will get put in vlan1 when
# switched to access mode
# port in trunk mode with access vlan, will leave port in that access
# vlan when switched to access mode
#
# NOTE: when putting a port in trunk mode, be sure to remove access vlan
# if it is vlan1 or if trunk is in "equal" mode.
#
package snmpit_dellrest;
use strict;
use Data::Dumper;
$| = 1; # Turn off line buffering on output
use English;
use SNMP;
use URI::Escape;
use snmpit_lib;
use Port;
use dell_rest;
# Just... Don't.
BEGIN { libtblog::tblog_stop_capture(); }
# Most are defined in snmpit_lib, let's not repeat or change
#my $PORT_FORMAT_IFINDEX = 1;
#my $PORT_FORMAT_MODPORT = 2;
#my $PORT_FORMAT_NODEPORT = 3;
#my $PORT_FORMAT_PORT = 4;
#my $PORT_FORMAT_PORTINDEX = 5;
my $PORT_FORMAT_NATIVE = 6;
#
# XXX safety net: make sure we don't remove this vlan from any trunk.
#
# This is the Emulab/CloudLab/Powder hardware management VLAN. We don't want
# to lose contact with any far-flung, hard to access Powder end-point switches.
#
my $SACRED_VLAN = 10;
#
# Creates a new object.
#
# usage: new($classname,$devicename,$debuglevel)
# returns a new object, blessed into the snmpit_dellrest class.
#
sub new($$$)
{
# The next two lines are some voodoo taken from perltoot(1)
my $proto = shift;
my $class = ref($proto) || $proto;
my $name = shift; # the name of the switch, e.g. e1200a
my $debugLevel = shift;
#
# Create the actual object
#
my $self = {};
#
# Set the defaults for this object
#
if (defined($debugLevel)) {
$self->{DEBUG} = $debugLevel;
} else {
$self->{DEBUG} = 0;
}
$self->{NAME} = $name;
#
# Get config options from the database
#
my $options = getDeviceOptions($self->{NAME});
if (!$options) {
warn "ERROR: Getting switch options for $self->{NAME}\n";
return undef;
}
$self->{MIN_VLAN} = $options->{'min_vlan'};
$self->{MAX_VLAN} = $options->{'max_vlan'};
if (!exists($options->{"username"}) || !exists($options->{"password"})) {
warn "ERROR: No credentials found for OS10 switch $self->{NAME}\n";
return undef;
}
#
# Get devicetype from database
#
$self->{TYPE} = getDeviceType($self->{NAME});
my $swcreds = $options->{"username"} . ":" . $options->{"password"};
$self->{ROBJ} = dell_rest->new($self->{NAME}, $debugLevel, $swcreds);
if (!$self->{ROBJ}) {
warn "ERROR: Could not create REST object for $self->{NAME}\n";
return undef;
}
#
# PortInfo...um, info
#
$self->{GOTPORTINFO} = 0;
$self->{PORTS} = {}; # All physcial, non-management ports
$self->{VLANS} = {}; # Vlan port devices
$self->{PORTCHANS} = {}; # Port-channel devices
$self->{ACCESS} = {}; # "access mode" ports
$self->{TRUNK} = {}; # "trunk mode" ports
$self->{IFINDEX} = {}; # port -> if-index map
$self->{IFINDEXMAP} = {}; # ifindex -> port map
# XXX some stats
$self->{CALLGETINFO} = 0;
$self->{CACHEGETINFO} = 0;
$self->{CALLOTHER} = 0;
bless($self,$class);
return $self;
}
sub DESTROY($)
{
my ($self) = @_;
my $id = "$self->{NAME}";
my $gicalls = $self->{CALLGETINFO};
my $gihits = $self->{CACHEGETINFO};
my $ocalls = $self->{CALLOTHER};
print "$id: RESTCONF calls: $gicalls getinfo ($gihits cached), $ocalls other.\n";
}
#
# Prints out a debugging message, but only if debugging is on. If a level is
# given, the debuglevel must be >= that level for the message to print. If
# the level is omitted, 1 is assumed
#
# Usage: debug($self, $message, $level)
#
sub debug($$;$) {
my $self = shift;
my $string = shift;
my $debuglevel = shift;
if (!(defined $debuglevel)) {
$debuglevel = 1;
}
if ($self->{DEBUG} >= $debuglevel) {
print STDERR $string;
}
}
##############################################################################
## Internal / Utility Functions Section
##
#
# Port names are of the form <type><node>[/<slot>/<port>[:<subport]]
# Sort them by type lexigraphically and then by node/slot/port/subport
# numerically in that order.
#
sub portSort($$)
{
my ($a,$b) = @_;
my (@aa,@ba);
if ($a =~ /^([^\d]+)(\d+)(?:\/(\d+)\/(\d+)(?:\:(\d+))?)?$/) {
@aa = ($1,$2,$3,$4,$5);
} else {
return $a cmp $b;
}
if ($b =~ /^([^\d]+)(\d+)(?:\/(\d+)\/(\d+)(?:\:(\d+))?)?$/) {
@ba = ($1,$2,$3,$4,$5);
} else {
return $a cmp $b;
}
my $rv = ($aa[0] cmp $ba[0]);
return $rv if $rv;
if ($aa[0] eq "port-channel" || $aa[0] eq "vlan") {
return ($aa[1] <=> $ba[1]);
}
$aa[4] = 0 if (!defined $aa[4]);
$ba[4] = 0 if (!defined $ba[4]);
return ($aa[1] <=> $ba[1] ||
$aa[2] <=> $ba[2] ||
$aa[3] <=> $ba[3] ||
$aa[4] <=> $ba[4]);
}
#
# XXX Crap! I was hoping to get by without the old if-index, but snmpit_stack
# uses them to identify port channels. The RESTCONF interface exposes these
# via the interface-state target, but I don't want to make another expensive
# API call just to get that. Plus last time I did this, the call returned
# JSON that could not be parsed by the Perl JSON package (some "unprintable"
# chars in the media-policy-table).
#
# So we are just going to make them up for now with a very simple algorithm:
#
# regular-port: ((slot * port * 5) + subport) + 1
# where subport is zero if the port is not broken out, 1-4 otherwise
# and the final "+1" is just so no port maps to zero (which indicates failure).
#
# port-channel: (port-channel-node + 1000)
# where "node" is the number in the name and
# "+1000" to avoid collisions with port ifindexes.
#
# port-channel: (vlan-node + 2000)
# where "node" is the number in the name and
# "+2000" to avoid collisions with port/port-channel ifindexes.
#
sub mapPortToIndex($$)
{
my ($self, $iface) = @_;
my $id = "$self->{NAME}::mapPortToIndex()";
my $index = 0;
if ($iface !~ /^([^\d]+)(\d+)(?:\/(\d+)\/(\d+)(?:\:(\d+))?)?$/) {
warn "$id: ERROR: Cannot parse '$iface'.\n";
return 0;
}
my ($type,$node,$slot,$port,$subport) = ($1,$2,$3,$4,$5);
if ($type eq "port-channel") {
$index = $node + 1000;
}
elsif ($type eq "vlan") {
$index = $node + 2000;
}
elsif ($type eq "ethernet") {
$subport = 0 if (!defined($subport));
$index = ($slot * $port * 5) + $subport + 1;
}
else {
warn "$id: ERROR: Cannot map '$iface' to ifindex.\n";
return 0;
}
return $index;
}
sub getOnePortInfo($$;$)
{
my ($self, $iface, $silent) = @_;
my $id = "$self->{NAME}::getOnePortInfo()";
my $error = "";
$self->debug("$id: entering\n");
my $path = "interfaces/interface=" . uri_escape($iface);
my $json = $self->{ROBJ}->call("GET", $path, undef, undef, \$error);
if (!$json) {
if (!$silent) {
warn "$id: ERROR: Could not read '$iface' interface information:\n".
$error . "\n";
}
return undef;
}
$self->debug("$id: '$path' call returns:\n" . Dumper($json), 4);
return $json;
}
sub getPortInfo($)
{
my $self = shift;
my $id = "$self->{NAME}::getPortInfo()";
$self->debug("$id: entering, usecache=". ($self->{GOTPORTINFO} ? 1 : 0). "\n");
$self->{CALLGETINFO}++;
if ($self->{GOTPORTINFO}) {
$self->{CACHEGETINFO}++;
return 1;
}
my $path = "interfaces";
my $json = $self->{ROBJ}->call("GET", $path);
if (!$json) {
warn "$id: ERROR: Could not read interface information.\n";
return 0;
}
$self->debug("$id: '$path' call returns:\n" . Dumper($json), 4);
if (exists($json->{"ietf-interfaces:interfaces"})) {
foreach my $iface (@{$json->{"ietf-interfaces:interfaces"}->{"interface"}}) {
my $name = $iface->{"name"};
my $type = $iface->{"type"};
my $enabled = (!exists($iface->{"enabled"}) || $iface->{"enabled"}) ? 1 : 0;
my $ix;
#
#
# Ethernet
# Modes:
# <none>: "switchport access vlan ...", aka an untagged port
# MODE_L2DISABLED: "no switchport", aka part of a port channel?
# MODE_L2HYBRID: "switchport mode trunk", aka a trunk port
#
if ($type eq "iana-if-type:ethernetCsmacd") {
if (!exists($iface->{"dell-interface:mode"})) {
$self->{PORTS}{$name}->{"enabled"} = $enabled;
$self->{ACCESS}{$name}->{"avlan"} = 0;
$ix = $self->mapPortToIndex($name);
$self->{IFINDEX}{$name} = $ix;
$self->{IFINDEXMAP}{$ix} = $name;
} elsif ($iface->{"dell-interface:mode"} eq "MODE_L2HYBRID") {
$self->{PORTS}{$name}->{"enabled"} = $enabled;
$self->{TRUNK}{$name}->{"vlans"} = [];
$ix = $self->mapPortToIndex($name);
$self->{IFINDEX}{$name} = $ix;
$self->{IFINDEXMAP}{$ix} = $name;
} elsif ($iface->{"dell-interface:mode"} eq "MODE_L2DISABLED") {
# probably part of a port-channel, not counted as a port
;
} else {
my $mode = $iface->{"dell-interface:mode"};
warn "$id: interface '$name' has unknown mode '$mode', ignored\n";
}
}
# Vlans
elsif ($type eq "iana-if-type:l2vlan") {
if ($name =~ /^vlan(\d+)$/) {
$self->{VLANS}{$name}->{"tag"} = $1;
if (exists($iface->{"description"})) {
$self->{VLANS}{$name}->{"ename"} = $iface->{"description"};
} else {
$self->{VLANS}{$name}->{"ename"} = $name;