Commit 5283d83f authored by Kirk Webb's avatar Kirk Webb

Mellanox XML gateway adapter/wrapper module.

This module wraps the Mellanox XML-gateway API, an "interesting" sort of
interface offered up by Mellanox switches running MLNX-OS.  This module
handles all of the connection setup and XML encoding / decoding.  Users
of the module pass in arrays of commands to run, and arrays of results
are returned.  All commands in lists passed to a single call() invocation
will be passed along together to be invoked, in order, on the switch.
Mixtures of 'get', 'set-*', and 'action' commands are allowed.

This check-in also includes a test harness for this module.

Sample use:

my $gw = MLNX_XMLGateway->new("user:pass@switch.somehost.org");
my @cmds = (
  ["get", "/some/REST/path"],
  ["set-create", "/some/REST/path/to/create"],
  ["set-modify", "/some/REST/path/to/modify=newvalue"],
  ["action", "/some/REST/action/path", {var => value, ...}]
);

$results = eval { $gw->call(\@cmds) };

if ($@) {
  die "error: $@";
}

foreach my $res (@$results) {
  # path, type, value
  print "@$res\n";
}
parent 3341066c
#!/usr/bin/perl -w
#
# Copyright (c) 2013 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/>.
#
# }}}
#
# Simple test harness for the MLNX-gateway module.
use MLNX_XMLGateway;
use Getopt::Std;
use strict;
my @get_test1 = (
["name", "Basic 'get' Test #1"],
["get","/mlnxos/v1/api_version"],
["get","/mlnxos/v1/chassis/model"],
["get","/mlnxos/v1/chassis/pn"],
["get","/mlnxos/v1/chassis/fans/FAN/1/speed"],
["get","/mlnxos/v1/vsr/default_vsr/vlans/*"],
["submit"]
);
my @get_test2 = (
["name","Interface name 'get' Test #2"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces_by_name/*"],
["submit"]
);
my @pget_test1 = (
["name", "Port 'get' Test (Eth1/8) #1"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/enabled"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/type"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/mtu"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/vlans/pvid"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/vlans/mode"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/vlans/allowed/*"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/physical_location"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/supported_speed"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/configured_speed"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/actual_speed"],
["submit"]
);
my @pget_test2 = (
["name", "Port 'get' Test (Po1) #2"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/13826/enabled"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/13826/type"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/13826/vlans/pvid"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/13826/vlans/mode"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/13826/vlans/allowed/*"],
["submit"]
);
my @vlan_test1 = (
["name", "Vlan Creation Test #1"],
["action","/mlnxos/v1/vsr/default_vsr/vlans/add",{vlan_id => 666}],
["set-modify","/mlnxos/v1/vsr/default_vsr/vlans/666/name=testvlan"],
["get","/mlnxos/v1/vsr/default_vsr/vlans/*"],
["submit"],
["action","/mlnxos/v1/vsr/default_vsr/vlans/delete",{vlan_id => 666}],
["get","/mlnxos/v1/vsr/default_vsr/vlans/*"],
["submit"]
);
my @port_test1 = (
["name", "Port Toggle Test (Eth1/8) #1"],
["set-modify","/mlnxos/v1/vsr/default_vsr/interfaces/101/enabled=false"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/enabled"],
["submit"],
["set-modify","/mlnxos/v1/vsr/default_vsr/interfaces/101/enabled=true"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/enabled"],
["submit"]
);
my @vport_test1 = (
["name", "Vlan + Port Test (Eth1/8) #1"],
["action","/mlnxos/v1/vsr/default_vsr/vlans/add",{vlan_id => 666}],
["set-modify","/mlnxos/v1/vsr/default_vsr/vlans/666/name=testvlan"],
["set-modify","/mlnxos/v1/vsr/default_vsr/interfaces/101/vlans/pvid=666"],
["get","/mlnxos/v1/vsr/default_vsr/vlans/*"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/vlans/pvid"],
["submit"],
["action","/mlnxos/v1/vsr/default_vsr/vlans/delete",{vlan_id => 666}],
["set-modify","/mlnxos/v1/vsr/default_vsr/interfaces/101/vlans/pvid=53"],
["get","/mlnxos/v1/vsr/default_vsr/vlans/*"],
["get","/mlnxos/v1/vsr/default_vsr/interfaces/101/vlans/pvid"],
["submit"]
);
# List the tests to run here.
my @testsets = (\@get_test1, \@pget_test1);
my %opts = ();
if (!getopts("a:d:",\%opts)) {
print "Usage: $0 -a <uri_auth_string> -d <level>\n";
exit 1;
}
my $auth = "";
my $debug = 0;
$auth = $opts{'a'} or die "Must specify an auth string!";
$debug = $opts{'d'} if $opts{'d'};
my $gateway = MLNX_XMLGateway->new($auth);
$gateway->debug($debug) if $debug;
foreach my $tlist (@testsets) {
my @cmdset = ();
my @results = ();
my $testname = "unnamed";
foreach my $cmd (@{$tlist}) {
TESTSW1: for ((@{$cmd})[0]) {
/^name$/ && do {
$testname = (@{$cmd})[1];
print "========== Running Test: $testname ==========\n";
last TESTSW1;
};
/^submit$/ && do {
push @results, $gateway->call(\@cmdset);
@cmdset = ();
last TESTSW1;
};
# Default
push @cmdset, $cmd;
}
}
print "--- Results:\n";
my $i = 1;
foreach my $reslist (@results) {
print "* Submission $i:\n";
foreach my $res (@$reslist) {
print "@$res\n";
}
++$i;
}
print "\n";
}
......@@ -23,9 +23,8 @@
# }}}
#
# Mellanox XML-Gateway handler class. Hides all of the connection
# management, method invocation, and response parsing goo from the caller.
# management, XML method invocation, and response parsing goo from the caller.
package MLNX_XMLGateway;
......@@ -38,14 +37,18 @@ use strict;
$| = 1; # Turn off line buffering on output
my $DEBUG = 0;
my $MLNX_GATEWAY_PATH = "/xtree";
my $MLNX_AUTH_PATH = '/admin/launch?script=rh&template=login&action=login';
my $MLNX_CHECK_RPATH = "/mlnxos/v1/chassis/model";
my %MLNX_ACTIONS = ("action" => 1,
"get" => 1,
"set-create" => 1,
"set-modify" => 1,
"set-delete" => 1);
#
# Create a new Mellanox XML-Gateway object. $authority is an authority
# component for an HTTP URI. e.g., 'user:pass@hostname[:port]'
......@@ -96,6 +99,54 @@ sub DESTROY($) {
$self->{'CONN'} = undef;
}
#
# Set/unset/query debug level
#
sub debug($;$) {
my ($self,$level) = @_;
if (defined($level)) {
$level =~ /^\d+$/ or
die "Debug level must be a positive integer or zero!";
$DEBUG = $level;
}
return $DEBUG;
}
#
# Debug print wrapper function
#
sub debugpr($;$) {
my ($msg, $level) = @_;
# Default to debug level '1' if not specified.
$level ||= 1;
if ($DEBUG >= $level) {
print $msg;
}
}
#
# Pretty print a parsed XML::LibXML DOM object. Requires a separate
# perl module. Assumes you are passing in a valid DOM object!
#
sub XMLPrettyPrint($) {
my ($xmldom,) = @_;
my $retstr;
eval { require XML::LibXML::PrettyPrint };
if ($@) {
$retstr = "-> Can't pretty print: XML::LibXML::PrettyPrint not found.";
} else {
my $pp = XML::LibXML::PrettyPrint->new(indent_string => " ");
$retstr = $pp->pretty_print($xmldom->documentElement()->cloneNode(1))->toString();
}
return $retstr;
}
#
# Establish an authenticated session with the XML gateway on the switch.
# Users of this module should not call this method directly.
......@@ -107,24 +158,39 @@ sub connect($) {
my $user = $self->{'USER'};
my $pass = $self->{'PASS'};
# See if we have a connection, and if it is still valid/active.
# See if we already have a connection, and if it is still valid.
if (defined($self->{'CONN'})) {
my $ccache = $self->{'CONN'}->conn_cache();
$ccache->prune(); # test the connection, and remove if closed.
if (scalar($ccache->get_connections()) == 1) {
# Existing connection is valid - pass it back to the caller.
return $self->{'CONN'};
} else {
# De-alloc the connection object. We will try to reconnect
# and authenticate again below.
$ccache = undef;
# Do a quick check to make sure we have a valid session.
my $checkdom = XMLEncodeCallStack(
[XMLEncodeCall("get",$MLNX_CHECK_RPATH),]);
my $resp = $self->{'CONN'}->post($self->{'URI'},
Content => $checkdom->serialize());
my $resp2 =
eval { XMLDecodeResponse(
XML::LibXML->load_xml(string =>
$resp->decoded_content())) };
if ($@ || scalar(@{$resp2}) == 0) {
if ($@) {
debugpr "Failed connection test message:\n$@\n";
} elsif (!scalar(@{$resp2})) {
debugpr "No response to basic get [$MLNX_CHECK_RPATH] ...\n";
}
$resp2 = $resp = $checkdom = undef;
$self->{'CONN'} = undef;
warn "Cached connection invalid. Attempting to reconnect.\n";
} else {
return $self->{'CONN'};
}
}
my $ua = LWP::UserAgent->new();
$ua->conn_cache(LWP::ConnCache->new()); # need an http 1.1 session.
$ua->cookie_jar({});
$ua->cookie_jar({}); # need to store the session cookie.
# Enable debug output from www user agent if debug level is high.
if ($DEBUG > 3) {
$ua->add_handler("request_send", sub { shift->dump; return });
$ua->add_handler("response_done", sub { shift->dump; return });
}
# Create a new URI with the host defined in the URI created via
# the constructor.
......@@ -140,14 +206,26 @@ sub connect($) {
'f_password' => $pass
);
# Make the call and check that it went through OK. Die if not.
# XXX: may want to put in some retry logic, and/or check for timeout.
# If there is a valid "session" cookie sent back, then we're good
# to go. Note: Almost unbelievably, if authentication fails, then
# the web service on the switch will return a "200" code along
# with some big old long login page. On success, it returns a
# code "302". Really Mellanox?
my $authres = $ua->post($authuri, \%form);
if ($authres->code != 302) {
die "Failed to authenticate to ". $authuri->host() .": ".
$authres->dump();
my $valid_session = 0;
$ua->cookie_jar()->scan(
sub {
my ($version, $key, $val, $path, $domain, $port,
$path_spec, $secure, $expires, $discard, $hash) = @_;
debugpr("scanning cookie: $domain: $key => $val\n", 2);
$valid_session = 1 if ($key eq "session");
});
if (!$valid_session) {
die "Failed to authenticate to ". $authuri->host();
}
# Connected. Stash the LWP::UserAgent object and pass it back to caller.
debugpr "Successfully connected to ". $authuri->host() ."\n";
$self->{'CONN'} = $ua;
return $ua;
}
......@@ -178,7 +256,7 @@ sub call($$) {
}
# will die() if it encounters a problem, which we let flow through.
return $self->DispatchCallStack(XMLEncodeCallStack(@callstack));
return $self->DispatchCallStack(XMLEncodeCallStack(\@callstack));
}
#
......@@ -195,19 +273,29 @@ sub XMLEncodeCall($$;$) {
exists($MLNX_ACTIONS{$action})
or die "Unknown call type: $action";
$restpath =~ qr|^(/[\w\*]+){1,}/?$|
$restpath =~ qr|^(/[\w\*=]+){1,}/?$|
or die "REST-path does not look valid: $restpath";
if (defined($arguments) && ref($arguments) eq "HASH") {
$action ne "action" && $action ne "set-modify"
and die "Must NOT supply arguments hash with 'set-create', 'set-delete' or 'get' calls.";
$action ne "action"
and die "Must NOT supply an arguments hash with 'set-*' or 'get' calls.";
# Append arguments on to the REST-path.
while (my ($arg_name,$arg_val) = each %{$arguments}) {
$restpath .= "|${arg_name}=${arg_val}";
}
} else {
$action eq "action" || $action eq "set-modify"
and die "Must supply an arguments hash with 'action' or 'set-modify' calls.";
$action eq "action"
and die "Must supply an arguments hash with 'action' calls.";
}
# Print out some debug stuff, if requested.
if ($DEBUG > 1) {
debugpr "XML Encoding: $action, $restpath\n";
if (defined($arguments)) {
while (my ($k,$v) = each %$arguments) {
debugpr "\tArg: $k => $v\n";
}
}
}
# Conjure a partial XML tree for this call.
......@@ -225,10 +313,10 @@ sub XMLEncodeCall($$;$) {
# individual calls passed in (preserving their order). Meant for
# internal use by this module.
#
sub XMLEncodeCallStack(@) {
my @callstack = @_;
sub XMLEncodeCallStack($) {
my ($callstack,) = @_;
scalar(@callstack) > 0
scalar(@{$callstack}) > 0
or die "Must pass in at least one call to add";
# Create the boilerplate that wraps the RPCs to send.
......@@ -248,10 +336,16 @@ sub XMLEncodeCallStack(@) {
$areq->appendChild($nodes);
# drop in each of the call nodes (created by XMLEncodeCall()).
foreach my $call (@callstack) {
foreach my $call (@{$callstack}) {
$nodes->appendChild($call);
}
# Pretty print the XML if debug level is sufficiently high.
# Requires another module that is not part of core XML::LibXML.
if ($DEBUG > 2) {
debugpr "Encoded XML Call Stack:\n". XMLPrettyPrint($dom) ."\n";
}
return $dom;
}
......@@ -271,10 +365,7 @@ sub DispatchCallStack($$) {
Content => $dom->serialize());
if ($resp->is_error()) {
print "Error while calling XML-gateway. XML callstack:\n".
$dom->serialize() ."\n\n".
"Server output: ". $resp->dump() ."\n";
die "Error dispatching call stack.";
die "Error dispatching call stack: ". $resp->status_line();
}
# Parse the XML encoded response from the gateway into a DOM object.
......@@ -282,9 +373,12 @@ sub DispatchCallStack($$) {
my $respdom = eval { XML::LibXML->load_xml(string =>
$resp->decoded_content()) };
if ($@) {
print "Invalid gateway response (not XML?). Full HTTP contents:\n".
$resp->dump() ."\n";
die "Invalid gateway response (not XML?).";
die "Invalid gateway response (not XML?): $@";
}
# Purty print the response.
if ($DEBUG > 2) {
debugpr "XML Response from switch:\n". XMLPrettyPrint($dom) ."\n";
}
# Allow any die() exceptions to just flow on through.
......@@ -313,7 +407,7 @@ sub XMLDecodeResponse($) {
my $nodes_xlist = $respdom->findnodes("//nodes/node");
# Return an empty list of there aren't any data nodes in the response.
return () if !defined($nodes_xlist);
return [] if !defined($nodes_xlist);
# Process the list of data nodes. Extract the path,type,value
# tuples from the XML and return these as a list of anonymous arrays.
......@@ -331,5 +425,5 @@ sub XMLDecodeResponse($) {
$value->string_value()];
});
return @nodelist;
return \@nodelist;
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment