# $Id: Diag.pm,v 1.14 2004/10/18 19:45:55 xy128994 Exp $
# Copyright 2003,2004  Sun Microsystems, Inc., All Rights Reserved.
#
# This file is for ESM 2.1 use of diags with tab format. See diagx
# for current diag implementation.
package Client::Diag;
use Client;
use Debug;
use AutoForm;
use Scheduler;
use TO;
use Report;
use Diag;
use Client::Diagx;
use Java::JavaDiags;
use LockManager;
use strict;

use vars qw ($TT);
$TT = "ST";

use Data::Dumper;

# Return a list of diagnostic test options for either a device type or
# for a given device with options specific for the given device.
sub list {
  my($q) = @_;
  my $format = $q->{format} || "tab";
  if ($format eq "xml"){
	 Diagx::list($q);
	 return;
  }

  my($comp, $tests, $dev, $x, $key0);
  my($renv, $devices, $hosts, $notifs) = PDM::ConfigFile->read();

  my($err,$af) = AutoForm->new("System/Tests", {noInfo => 1});
  my $key      = $q->{key};
  my $devType  = $q->{type};
  my $testNo   = $q->{test};
  my $cnt=1;

  my $mode = $q->{mode};

  if ($key) {
     Debug->logLine("Client::Diag::list for $key test $testNo");

     my $to = TO->readExistingTopo("MERGE-MASTER") || TO->readExistingTopo();
     my($type, $k) = split(/\:/, $key);
     $dev = $to->nodeByName($key);
     if (!$dev) {
         print Client->error($format, 109, "Device $key not found in topology, need to re-create the snapshot.");
         return;
     }

     Debug->logLine("Client::Diag::list dev=$dev key=$key type=$type");

     $tests = Tasks->ST_getTestList($af, $type, $dev, "e");
     if ($#$tests < 0) {
         print Client->error($format, 110, "No test available for $key");
         return;
     }

     print Client->http_OK();
     print "#<pre>\n";
     require Diag;
     foreach my $t (@$tests) {
       my $testName = $t->{info}{sectionName};
       my $c = $af->commandByName($testName);
       my($form_err, $form_data) = Diag->validation($c, $testName, $to, $dev,
																	 {}, "preForm");
       # if we are in storade mode, keep parameters as is
       if ($mode ne "storade") {
         $form_data->{'#PASSES'} = 1;
       }
       my($cn, $reg_select, $all, $all_reg, $node, $multiple) =
          Diag->register_list($type, $af, $t->sectionName() , $dev, "e",
										{mode => 'list'});
       &printit($af, $t, $cnt, $reg_select, $form_data);
       $cnt++;
     }
     print "#Done\n";
     return;
  }

  Debug->logLine("Client::Diag::list for $devType");

  print Client->http_OK();
  print "#<pre>\n";
  $Data::Dumper::Indent = 1;

# BY DEFAULT, SHOW RACK-LEVEL TESTS
  my $mgmtLevel = $q->{mgmtLevel};
  $mgmtLevel = "DS" if (!$devType && !$mgmtLevel);

  foreach my $com ($af->commandList()) {
     my $c = $af->commandByName($com);
     my $info = $c->info();
     next if ($devType && $info->{devType} ne $devType);
     next if ($mgmtLevel eq "DS" && $info->{devType} ne $renv->{solution});
     &printit($af, $c, $cnt);
     $cnt++;
     print "\n";
  }
  print "#Done\n";
}

sub printit {
  my($af, $c, $cnt, $regs, $form_data) = @_;
  my($x);
     my $info = $c->info();
     foreach my $v (sort keys %$info) {
         print "test.$cnt.info.$v\t$info->{$v}\n";
     }
     if ($regs) {
       $regs =~ s/\t/\|/g;
       print  "test.$cnt.opt.0.desc\tRegister\n".
              "test.$cnt.opt.0.name\tRegister\n".
              "test.$cnt.opt.0.opt\tregister\n".
              "test.$cnt.opt.0.type\tselect\n".
              "test.$cnt.opt.0.values\t$regs\n";
     }
     my $opts = $c->{opts};
     for ($x=0; $x <= $#$opts; $x++) {
         my $opt = $opts->[$x];
         foreach my $v (sort keys %$opt) {
             my $V = exists $form_data->{$opt->{$v}} ? $form_data->{$opt->{$v}} : $opt->{$v};
             print "test.$cnt.opt.$x.$v\t$V\n";
         }
     }
     if ($info->{defaults}) {
        my $c = $af->commandByName("DEFAULTS");
        my $def_opts = $c->{opts};
        for ($x=0; $x <= $#$def_opts; $x++) {
            my $opt = $def_opts->[$x];
            foreach my $v (sort keys %$opt) {
               my $V = exists $form_data->{$opt->{$v}} ? $form_data->{$opt->{$v}} : $opt->{$v};
               print "test.$cnt.opt." . ($#$opts +1+$x) . ".$v\t$V\n";
            }
        }
     }
}

# GO=Client::Diag::run&key=sve:sdasda&test=se_configcheck&opt_verbose=on&opt_register=port1:1:192..

sub run {
  my($q) = @_;

  if (!$q->{NO_LOG}) {
    open(O, ">". System->get_home() . "/log/Client_Diag_run.input");
    require Data::Dumper;
    print O Data::Dumper::Dumper($q);
    close(O);
  }

  my $format = $q->{format} || "tab";
  if ($format eq "xml"){
	 Diagx::run($q);
	 return;
  }

  my $key = $q->{key};
  if (!$key) {
	 print Client->errno(211, [$key], {format => "tab"});
	 return;
  }

  my($type, $k) = split(/\:/, $key);
  my $lease = LockManager->new();
  $lease->cleanLocks();
  my $lockInfo = $lease->read($k);
  if ($lockInfo){
	 print Client->errno(204, [$key], {format => "tab"});
	 return;
  }

  $q->{format} = "tab";
  my $jerror = Java::JavaDiags::run($q);
  if (!$jerror){
	 return;
  }

  my($comp, $tests, $dev, $x);
  my($renv, $devices, $hosts, $notifs) = PDM::ConfigFile->read();
  my $selected_test = $q->{test};

  # check if the host was passed in or not. If not we assume the localhost
  my $host;
  if (defined($q->{hostname})) {
    $host = $q->{hostname};
  } else {
    $host = $renv->{hostname};
  }

  $q->{register} = $q->{opt_register} if ($q->{opt_register});
 
  my $to = TO->readExistingTopo("MERGE-MASTER") || TO->readExistingTopo();
  my $dev = $to->nodeByName($key);

  if (!$dev) {
    Debug->logLine("Client::Diag::run $key not found in topo!");
    print Client->error($format, 111, "Device $key not found in topo!");
    return;
  }

  my($af_err,$af) = AutoForm->new("System/Tests", {noInfo => 1});

  my $af_test = $af->commandByName($selected_test);

  my($valid_err, $run_err, $text, $pid, $test_command, $opts ) = 
         Diag->run($af, $host, $q, $af_test, $selected_test, $to, $dev, "$key:e", 1);  # quiet


  if ($valid_err) {
    Debug->logLine("Client::Diag::run Validation Error: $valid_err");
      print Client->error($format, 111,"Validation Error: $test_command: $valid_err");
      return;
  }
  if ($text) {
    Debug->logLine("Client::Diag::run Command: $text");
    print Client->http_OK();
      print "Command: $text<br>";
      return;
  }

  if ($run_err) {
    Debug->logLine("Client::Diag::run $test_command: $run_err");
      print Client->error($format, 111,"$test_command: $run_err");
      return;
  } else {
      print Client->http_OK();
      if ($q->{DIRECT}) {
         return $pid;
      } else {
	Debug->logLine("Client::Diag::run $key $pid");
         print "OK $pid\n";
      }
   }
}

# returns status and report itself

sub status {
  my($q) = @_;

  my $format = $q->{format} || "tab";
  if ($format eq "xml"){
	 Diagx::status($q);
	 return;
  }

  print Client->http_OK();
  my($renv, $devices, $hosts, $notifs) = PDM::ConfigFile->read();
  my $selected_test = $q->{test};
  my $host = $renv->{hostname};
  my $pid  = $q->{pid};

  my ($info, $pro, $out, $err) = Scheduler->read($TT, $host, $pid) ;

  print "#<pre>\n";
  foreach my $v (sort keys %$info) {
     if ($v eq "info" ){  
        my $sub = $info->{$v};
        foreach my $v1 (sort keys %$sub) {
           print "info.details.$v1\t$sub->{$v1}\n";
        }
     } else {
        print "info.$v\t$info->{$v}\n";
     }
  }
  my($x, $y);
  for ($x=0; $x <= $#$err; $x++) {
      print "error.$x.value\t$err->[$x]";
  }
  for ($x=0; $x <= $#$out; $x++) {
      my $rc = $out->[$x]{rc}; chomp($rc);
      print "process.$x.rc\t$rc\n";
      print "process.$x.date\t$out->[$x]{date}\n";
      print "#OUTPUT $x\n";
      print "$out->[$x]{output}\n";
  }
  print "#Done\n";
}

# Abort a running test given a pid.
sub abort {
  my($q) = @_;
  my $format = $q->{format} || "tab";
  if ($format eq "xml"){
	 Diagx::abort($q);
	 return;
  }

  print Client->http_OK();
  my($renv, $devices, $hosts, $notifs) = PDM::ConfigFile->read();
  my $pid  = $q->{pid};

  # check if the host was passed in or not. If not we assume the localhost
  my $host;
  if (defined($q->{hostname})) {
    $host = $q->{hostname};
  } else {
    $host = $renv->{hostname};
  }

  my ($info, $pro, $out, $err) = Scheduler->read($TT, $host, $pid) ;

  print "#<pre>\n";
  my $done = Scheduler->kill($TT,$pid, $host , {child => 1, signal => 15});
  if (!$done) {
    print "ERROR $Scheduler::ERROR\n";
  } else {
    print "OK killed\n";
  }
  Debug->logLine("Client::Diag::abort $pid $done $Scheduler::ERROR");
}

# Exclude following tests from linktest if one node is of the following:
my $LT_EXCLUDE = ",hub,d2,group,inrange,dsp,";

# Create a list of nodes to exclude from linktest if both nodes
# are the same type.
my $LT_EXCLUDE_END_NODE = ",mcdata,";

sub runLinkTest {

  my($q) = @_;
  my (@T, @K, @P);
  my(@node, @PORT, $x);
  #my($renv, $devices, $hosts, $notifs) = PDM::ConfigFile->read();
  my $Config = PDM::ConfigFile->read();

  ($T[1], $K[1], $P[1]) = split(/:/, $q->{start});
  ($T[2], $K[2], $P[2]) = split(/:/, $q->{end});

  print Client->http_OK();

  if ( index($LT_EXCLUDE, ",$T[1],") >= 0){
    print Client->error("xml", 1001, "$T[1]");
    return;
  }
  if ( index($LT_EXCLUDE, ",$T[2],") >= 0){
    print Client->error("xml", 1001, "$T[2]");
    return;
  }
  
  if ( index($LT_EXCLUDE_END_NODE, ",$T[1],") >= 0 &&
       index($LT_EXCLUDE_END_NODE, ",$T[2],") >= 0 ) {
    print Client->error("xml", 1002, "$T[1],$T[2]");
    return;
  }

  my $list = Scheduler->processList("ST", "*", 'O');
  if ($#$list >= 0) {
    print Client->error("xml", 1003, "$#$list");
    return;
  }

  my $to = TO->readExistingTopo("MERGE-MASTER") || TO->readExistingTopo();
  ($node[1], $PORT[1]) = $to->nodeByName($q->{start});
  ($node[2], $PORT[2]) = $to->nodeByName($q->{end});
  if (!$node[1] || !$node[2]) {
     print Client->error("xml", 1004, "");
     return;
  }

  my (@PARM, $dev1, $dev2, $ip, $fc, $ix);
  my ($warns, $errs);
  
  my $isl = 0;
  if ($T[1] eq "switch" && $T[2] eq "switch") {
    my $ports = $node[1]->port();
    my $l = "$T[2]:$K[2]";
    foreach my $p (@$ports) {
      if (substr($p, 0 , length($l)) eq $l) {
	$isl++;
      }
     }
  }


  for ($ix = 1; $ix <= 2; $ix++) {
    my $n      = $node[$ix];
    my $class0 = $n->class0();
    if ($T[$ix] eq "host") {
      my $ip     = $n->info("ipno") || substr($n->info("name"),5);
      my $pi     = $n->portInfo();
      my $path   = $pi->[$PORT[$ix]]{path};
      my $bitMode = $n->info("bitMode");
      $path = substr($path,1) if (substr($path,0,1) eq " ");
      $PARM[$ix] = "type=hba|ip=$ip|path=$path|monHost=$ip|bitMode=$bitMode|key=$n->{info}{name}";
      
    } elsif ($class0 eq "switch") {
      $dev1 = $Config->deviceByKey($K[$ix]);
      if (!$dev1) {
	$warns .= "switch:$K[$ix] not in ConfigFile, may not be monitored, ";
      }
      my $ni = $n->{info};
      my $monH = $dev1->{hostIpno} || $n->info("host");
      if ($ni->{sw_remote_fcaddr} && $ni->{sw_remote_fcaddr} ne "0x0" &&
	  $dev1->{primary} ) {
	$ip = $ni->{sw_ipAddr_remote} || $ni->{IPAddress};
        $fc = $ni->{sw_remote_fcaddr};
      } else {
	$ip = $ni->{sw_ipAddr} || $ni->{IPAddress};
	$fc = "";
      }
      my $tt = $n->type();
      $PARM[$ix] = "type=$tt|ip=$ip|monHost=$monH|port=$PORT[$ix]|fcaddr=$fc|WWN=$K[$ix]|name=$dev1->{name}|key=$dev1->{key}";
            
    } else {
      my $logical;
      my $pi = $node[$ix]->portInfo();
      my $di = $node[$ix]->diskInfo();
      $dev1 = $Config->deviceByKey($K[$ix]);
      if (!$dev1) {
	$warns .= "$T[$ix]:$K[$ix] not in ConfigFile, may not be monitored, ";
      }

      my $po = $PORT[$ix];
      my $po2 = ($po == 0)? 1:0;
      my $monH = $pi->[$po]{dataHost};
      if (!$monH) {
	if ($n->info("host_type") eq "ib") {
	  $monH = $n->info("host");
	} elsif ($n->info("host2_type") eq "ib") {
	  $monH = $n->info("host2");
	} else {
	  $errs .= "<tr><td nowrap><small>-Cannot find InBand host to test " . $n->name() . "</td>";
	}
      }
      my $name = $dev1->{name};
      if ($T[$ix] eq "a5k") {
	for ($x=0; $x <= 10; $x++ ) {
	  $logical = $di->{"f$x"}{LogicalPath} ;
	  last if ($logical);
	  $logical = $di->{"r$x"}{LogicalPath} ;
	  last if ($logical);
	}
      } else {
	$logical = $pi->[$po]{LogicalPath} || $pi->[$po2]{LogicalPath};
	if ($logical ne $pi->[$po]{LogicalPath}) {
	  $warns .= "No LogicalPath available on " . $n->name() . " port:" . ($po+1) ;
	}
      }
      if (!$logical) {
	$errs .= "<tr><td nowrap><small>-No LogicalPath for Port:$PORT[$ix] of ". $n->name(). "</td>";
      }
      my $ctrl = "|ctrl_model=$dev1->{ctrl_model}" if ($dev1->{ctrl_model});
      $PARM[$ix] = "type=$T[$ix]|port=$po|logical=$logical|ip=$dev1->{ipno}$ctrl|monHost=$monH|portWWN=1|name=$name|key=$dev1->{key}";
      
    }
  }


  #$q->{PATTERN} = "0x7e7e7e7e" if (!$q->{PATTERN});
  #$q->{PTYPE} = "critical" if (!$q->{PTYPE});

  my ($com1, $opts);
  my $renv = $Config->renv();

  if (!$PARM[1] || !$PARM[2]) {
    print Client->error("xml", 1005, "");
  } else {
    my $test_command = "linktest -a $PARM[1] -b $PARM[2]";
    $opts = ($q->{VERBOSE})? "-v ": "";
    $opts .= ($q->{STRESS})? "-s " : "";
    $opts .= ($q->{PTYPE})  ? "-T \"$q->{PTYPE}\" " : "";
    $opts .= ($q->{PATTERN})? "-p \"$q->{PATTERN}\" " : "";
    $opts .= ($isl)? "-I $isl " : "";

    rename "/tmp/last_linktest_command.1" , "/tmp/last_linktest_command.2";
    rename "/tmp/last_linktest_command" , "/tmp/last_linktest_command.1";
    open(O, ">/tmp/last_linktest_command");
    print O "linktest $opts -a \"$PARM[1]\" -b \"$PARM[2]\" \n";
    close(O);
  
    my($err, $pid) = Scheduler->run('ST', $renv->{hostname}, "linktest",
				    "$opts -a \"$PARM[1]\" -b \"$PARM[2]\"", "",0, 1, $q->{EMAIL}, 1, 
				    { 
				     ports    => "",
				     target   => $q->{start},
				     target2  => $q->{end},
				     dev_type => $T[1],
				     node     => $q->{start},
				     key      => $q->{start},
				     comp     => "",
				    }, 10);
    if ($err) {
      print Client->error("xml", 1006, Client->xmlEncode($err));
    } else {
      print "<RUNLINKTEST>$pid</RUNLINKTEST>";
    }
  }

}

sub getQuestion {
  
   my($q) = @_;

   print Client->http_OK();

   my($renv, $devices, $hosts, $notifs) = PDM::ConfigFile->read();

   my $pid  = $q->{pid} + 0;
   my $host;
   if (defined($q->{hostname})) {
     $host = $q->{hostname};
   } else {
     $host = $renv->{hostname};
   }
   my $prefix = uc(substr($q->{prefix},0,2)) || "ST";

   my ($question, $prs, $text) = Scheduler->getQuestion($prefix, $host, $pid);
  
   print "<QUESTIONS> \n";
   foreach my $p (@$prs) {
     my(@s) = split(/\=/, $p);
     print "<VALUE ID=\"$s[0]\">$s[1]</VALUE> \n";
   }
   print "</QUESTIONS> \n";   
}

sub answerQuestion {
  my($q) = @_;

  print Client->http_OK();
  my($renv, $devices, $hosts, $notifs) = PDM::ConfigFile->read();

  my $host;
  if (defined($q->{hostname})) {
    $host = $q->{hostname};
  } else {
    $host = $renv->{hostname};
  }

  my $prefix = uc(substr($q->{prefix},0,2)) || "ST";

  Scheduler->answer($prefix, $host, $q->{pid}, $q->{QUESTION});
  # Synchronizing Test Ouput
  sleep(6);
  print "<ANSWERQUESTION>$q->{pid}, $q->{QUESTION}</ANSWERQUESTION> \n";
}

1;
