From a047f4e68b502582bc176edd2d643534a2d9cc06 Mon Sep 17 00:00:00 2001 From: Jed Reynolds Date: Mon, 7 Jan 2019 15:13:15 -0800 Subject: [PATCH] updates to DUT testing scripts --- LANforge/JsonUtils.pm | 1 + json/dut_test.pl | 191 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 192 insertions(+) create mode 100755 json/dut_test.pl diff --git a/LANforge/JsonUtils.pm b/LANforge/JsonUtils.pm index aec2d343..35e10f90 100644 --- a/LANforge/JsonUtils.pm +++ b/LANforge/JsonUtils.pm @@ -74,6 +74,7 @@ sub json_request { sub json_post { my ($uri, $rh_data) = @_; my $url = xpand($uri); + print STDERR "URI $uri\n"; my $req = HTTP::Request->new("POST" => $url); $req->header('Accept' => 'application/json'); $req->header('Content-Type' => 'application/json; charset=UTF-8'); diff --git a/json/dut_test.pl b/json/dut_test.pl new file mode 100755 index 00000000..e3204093 --- /dev/null +++ b/json/dut_test.pl @@ -0,0 +1,191 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use diagnostics; +use Carp; +$SIG{ __DIE__ } = sub { Carp::confess( @_ ) }; +$SIG{ __WARN__ } = sub { Carp::confess( @_ ) }; + +# Un-buffer output +$| = 1; +use Getopt::Long; +use JSON::XS; +use HTTP::Request; +use LWP; +use LWP::UserAgent; +use Data::Dumper; +use Time::HiRes qw(usleep); +use JSON; +use lib '/home/lanforge/scripts'; +use LANforge::JsonUtils qw(logg err json_request get_links_from get_thru json_post get_port_names flatten_list); + +package main; +# Default values for ye ole cmd-line args. +our $Resource = 1; +our $quiet = "yes"; +our $Host = "localhost"; +our $Port = 8080; +our $HostUri = "http://$Host:$Port"; +our $Web = LWP::UserAgent->new; +our $Decoder = JSON->new->utf8; +our $ssid; +our $security; +our $passphrase; + +my $usage = qq("$0 --action {add|list|show|annotate|del} + # list: lists all device names + # show: shows everything about device + # annotate: updates the note for the device + --note {"double quoted stuff"} + # del: + --name {Device Under Test name} + # when adding, use: + --name {Device Under Test name} + --img {picture name: c:\\stuff.png} + --sw_version {text} + --hw_version {text} + --mgt_ip {1.1.1.1} + --model_num {blanktronix345} + --serial_num {asdf1234} + --serial_port {1.2.ttyS0} + --api_id {0-127} + --lan_port {1.1.eth1} + --wan_port {1.1.eth2} + --ssid1 --passwd1 --ssid2 --passwd2 --ssid3 --passwd3 {stuff} +); + + +my $action; +my $name = ""; +my $notes = ""; +my $img_file = ""; +my $sw_version = ""; +my $hw_version = ""; +my $mgt_ip = ""; +my $model_num = ""; +my $serial_num = ""; +my $serial_port = ""; +my $api_id = ""; +my $lan_port = ""; +my $wan_port = ""; +my $ssid1 = ""; +my $ssid2 = ""; +my $ssid3 = ""; +my $passwd1 = ""; +my $passwd2 = ""; +my $passwd3 = ""; + +my $help; +## +## M A I N +## + +GetOptions( 'host=s' => \$::Host, + 'action=s' => \$action, + 'name=s' => \$name, + 'notes=s' => \$notes, + 'img_file=s' => \$img_file, + 'sw_version=s' => \$sw_version, + 'hw_version=s' => \$hw_version, + 'mgt_ip=s' => \$mgt_ip, + 'model_num=s' => \$model_num, + 'serial_num=s' => \$serial_num, + 'serial_port=s' => \$serial_port, + 'api_id=s' => \$api_id, + 'lan_port=s' => \$lan_port, + 'wan_port=s' => \$wan_port, + 'ssid1=s' => \$ssid1, + 'ssid2=s' => \$ssid2, + 'ssid3=s' => \$ssid3, + 'passwd1=s' => \$passwd1, + 'passwd2=s' => \$passwd2, + 'passwd3=s' => \$passwd3, + 'h|help' => \$help) +|| (print($usage) && exit(1)); + +if ($help) { + print $usage; + exit 0; +} +if (!defined $action) { + print $usage; + exit 1; +} +$::HostUri = "http://$Host:$Port"; +my $DEBUGURI = "?__debug=1"; +my $uri_args = ""; # ="$DEBUG_URI"; + +our $URI = "$::HostUri/dut"; +our $Post_URI = "$::HostUri/cli-json"; + +if ($action eq "list") { + my $uri = "$::URI/list"; + my $rh = json_request($uri); + flatten_list($rh, 'duts'); + for my $rh_dut (sort keys %{$rh->{'flat_list'}}) { + print "$rh_dut\n"; + } + exit 0; +} + +if ($action eq "show") { + die ("show what DUT? use --name:\n$usage") + unless (defined $name && $name ne ""); + my $uri = "$::URI/$name"; + my $rh = json_request($uri); + print Dumper($rh->{'dut'}); + die("unable to find DUT $name") + unless(defined $rh->{'dut'}); + print Dumper($rh->{'dut'}); + exit 0; +} + +my $varnames = q(name img_file sw_version hw_version mgt_ip model_num serial_num serial_port api_id lan_port wan_port ssid1 ssid2 ssid3 passwd1 passwd2 passwd3); + +if ($action eq "add") { + die ("show what DUT? use --name:\n$usage") + unless (defined $name && $name ne ""); + my $rh_post = {}; + for my $k (sort split(' ', $varnames)) { + my $v = eval("return \$$k;"); + if ((defined $v) && ($v ne "")) { + $rh_post->{$k} = $v ; + } + else { + $rh_post->{$k} = "NA"; + } + } + print Dumper($rh_post); + my $post_uri = "$::Post_URI/add_dut$DEBUGURI"; + json_post($post_uri, $rh_post); +} + + +if ($action eq "annotate") { + die ("show what DUT? use --name:\n$usage") + unless (defined $name && $name ne ""); + die ("what notes? use --notes:\n$usage") + unless (defined $notes); + + my $rh_post = {}; + my @note_lines=(); + if ($notes eq "") { + $notes = '[BLANK]'; + } + @note_lines = split(/\r?\n/, $notes); + + if ($note_lines[0] ne "[BLANK]") { + unshift(@note_lines, "[BLANK]"); + } + print Dumper(\@note_lines); + my $post_uri = "$::Post_URI/add_dut_notes${DEBUGURI}"; + for my $note_line (@note_lines) { + print Dumper(\$note_line); + my $rh = { + 'dut' => $name, + 'text' => $note_line + }; + json_post($post_uri, $rh); + } +} +# \ No newline at end of file