package Scheduler;
#<copyright>
# ----------------------------------------------------------
# Sun Proprietary/Confidential Code
# Copyright 2001, Sun Microsystems, Inc. All rights reserved.
# ----------------------------------------------------------
#</copyright>


use Util;
use strict;
use Debug;
use Tasks;
use Data::Dumper;
use System;
use Util::Http;
use POSIX ":sys_wait_h";


sub cleanUp {
  my($class, $days) = @_;

  Util->cleanUpDir("DATA/Proc", $days);

}
use vars qw ($ERROR $SAVE_CB $SAVE_DATA $SAVE_RC $RASTEST );

$RASTEST = "rasTest_";

#
# runs synchro., will wait 30 minutes, 
# rc=0
# output lines
#  ->syncRun($host, $command, 10, 
#              {progressHandler => \&printit, refreshRate => 10});

sub syncRun {
  my($class, $host, $command, $to, $arg) = @_;
  my ($rc,$l);
  $to = 60*30 if (!$to);

  my $renv = System->get_renv();
  $host = $renv->{hostname} if (!$host);

#### LOCAL COMMAND

  if ($renv->{hostname} eq $host || $host eq Util->name2ip()) {
     my($status, $out, $pid) = &get_localRun( {command => $command, , 
                                                   to => $to, 
                                          refreshRate => $arg->{refreshRate},
                                      progressHandler => $arg->{progressHandler},
                                            } );
     return {rc => $status, data => $out};
  }

#### REMOTE COMMAND

  $command = Util->encode($command);
  my($hd, $callback);
  $SAVE_RC = $SAVE_CB = $SAVE_DATA = undef;

  if ($arg->{progressHandler}) {
    $hd       = "&progressHandler=1";
    $SAVE_CB  = $arg->{progressHandler};
    $callback = \&callback;
  }
  $rc = Util::Http->cgiCommand($host, 
       "Scheduler::localRun&command=$command&HTTP=1&to=$to$hd&refreshRate=$arg->{refreshRate}", 
        $to+10, $callback);
  if ($arg->{progressHandler}) {
    $rc = $SAVE_RC . $SAVE_DATA;
  }

  my $ix = index($rc, "\n");
  if ($ix < 0) {
     return {rc => 98, "No return code in answer"};
  }
  my $line1 = substr($rc,0,$ix);
  $line1 =~ /RC=(\d+)/;
  return {rc => $1, data => substr($rc,$ix+1)} ;
}

sub callback {
  my($s) = @_;
  if (substr($s,0,9) eq "PROGRESS:") {
     &$SAVE_CB(substr($s,9));
     $SAVE_DATA .= substr($s,9);
  } else {
     $SAVE_RC .= $s;
  }
}
  

sub log {
  my($l) = @_;
  open(O2, ">>/tmp/xx"); print O2 "$l\n"; close(O2);
}

sub get_localRun {
  my($q) = @_;
  my($status, $O, $w, $out, $child_rc, $child_sig, $line, $kill, $F);

  my $command = $q->{command};
  my $to      = $q->{to} || (10*60);
  my $refresh = $q->{refreshRate} || 20;
  my $handler = $q->{progressHandler};
  if ($q->{HTTP}) {
     $command = Util->decode($command);
     select(STDOUT); $| = 1;
     #print "\n";
  }

  my $pid = fork();
  if (!$pid) {
     $F = "/tmp/ras_run_$$";
     select(STDOUT); $|=1;
     exec(System->get_home() . $command . " >$F 2>&1");

  } else { # parent
     $F = "/tmp/ras_run_$pid";
     my $cnt = 0;
     my $seek = 0;
     my $start = time;
     while (1) {
        $w = waitpid($pid, &WNOHANG);
        $status = $?;
        if ($w == $pid) {
           last;
        } elsif ($w == -1) {
           print "process $pid does not exist!\n"; last;
        }
        sleep($refresh);

        if ($handler) {
            ($seek, $out) = display_new($F, $seek);
            if ($q->{HTTP}) {
               print "PROGRESS:$out" if ($out);
            } else {
               &$handler($out);
            }
        }
        if (time - $start > $to + 2) {
           $kill = 1;
           last;
        }
     }
     if ($kill) {
        kill 9, $pid if ($pid);
        $status = 99;
        $O = "Process $pid was killed, timeout ($to) exceeded";
     } else {
        $child_rc = $status >> 8;
        $child_sig = $status & 127;
     }
  }
  my($l);

  if (!$kill && (!$handler || !$q->{HTTP})) {
     if (open(OO, $F)) {
        while ($l = <OO>) {
          $O .= $l;
        } 
        close(OO);
     } else {
        $O = "Error opening $F:$!";
     }
  }
  unlink $F;
  if ($q->{HTTP}) {
     print "RC=$status\n";
     print "$O" if (!$handler);
  } else {
    return ($status, $O, $pid);
  }
}

sub display_new {
  my($F, $seek) = @_;
  open(FILE, $F);
  seek(FILE, $seek, 0) if ($seek);
  my ($out, $tell, $line);
  for ($tell = tell(FILE); $line = <FILE>; $tell = tell(FILE)) {
      $out .= $line;
  }
  $seek = $tell if ($tell && $tell != $seek);
  close(FILE);
  return ($seek, $out);
}


#
# my ($err,$pid) = Scheduler->run(
#         $task_type,$host, $test_command, $opts, $registers, $passes, {info}, 10);
#
#   I_PID : Info file, stored on master only, after requesting the command
#   S_PID : script that contains the command to run.
#   O_PID : output of the command to run.
#   E_PID : STDERR of the command
#   P_PID : contains the running state of the command (START/STOP) and the time
#   Q_PID : Question file (expert)
#   A_PID : Answer file (expert)


sub run {
  my($class, $task_type, $host, $command, 
     $opts, $opts2, $concurrent, $interactive, $email, $passes, $info2,  $to , $args) = @_;
  my($pid, $rc);
  $to = 30 if (!$to);
  $concurrent = 1 if (!$concurrent);

  my($renv) = System->get_renv();
  $host = $renv->{hostname} if (!$host);
  my $now = Util->get_today();
  $task_type = substr($task_type,0,2);
#print "opts=$opts2<br>";

  my $info = {
      start_date => $now,
      host    => $host,
      email   => $email, 
      status  => 'O',
      passes  => $passes,
      concurrent => $concurrent,
      interactive => $interactive,
      start_tick => time,
      task_type => $task_type,
      command => $command,
      opts    => $opts,
      opts2   => $opts2,
      info    => $info2,
      };
  
   
  my $CD = System->get_home() . "/DATA/Proc/$host";
  if (!-d $CD) {
    mkdir $CD, 0777 ;
  }
  # RUN ON THE MASTER
  if ($host eq $renv->{hostname} || $renv->{solution} ne "N" ) {
     $rc = &get_run({ command => $command, opts => $opts, opts2 => $opts2, 
                       concurrent => $concurrent, 
                             host => $host,
		      interactive => $interactive,
                            email => $email, 
                         NOFORK  => $args->{NOFORK},
                           passes => $passes,
                           target => $info2->{target}, 
                         dev_type => $info2->{dev_type},
                               to => $to, 
                         task_type => $task_type
                    } );
  } else { # RUN ON A SLAVE
     my $master = $renv->{hostname};
     $opts = Util->encode($opts);
     $opts2 = Util->encode($opts2);
     my $ipno0 = Util->name2ip() || $master;

     my $ip_port = System->get_rasport();
     $ipno0 .= ":$ip_port" if ($ip_port);

     my $command = "Scheduler::run&master=$ipno0&command=$command&opts=$opts&opts2=$opts2&task_type=$task_type&HTTP=1&passes=$passes&email=$email&target=$info2->{target}&concurrent=$concurrent&host=$host&dev_type=$info2->{dev_type}";
     my $Config = PDM::ConfigFile->read();
     my $ipno = $Config->findIpNo($host) || $host;

     $rc = Util::Http->getCommand($ipno, $command, 10, $args);
     unlink "$CD/list";
  }
  if ($rc =~ /ERR /) {
     return ($rc, undef);

  } elsif ($rc =~ /OK (\d+)/) {
    $rc = $1;
    $info->{pid} = $rc;
    my $FF = "$CD/I_${task_type}_$rc";
    open(O, ">$FF");
    $Data::Dumper::Indent = 1;
    print O Dumper($info);
    close(O);
    chmod 0664, $FF;
    return (undef, $rc);

  } else {
     return ("ERR: Invalid PID: $rc", undef);
  }
}

sub appendClose {
  my($file, $txt) = @_;
  if (open(OX, ">>$file")) {
     print OX $txt;
     close(OX);
  }
}

sub schedLog {
  my($txt) = @_;
  if (open(OX, ">>" .  System->get_home() . "/log/scheduler.log")) {
     print OX $txt;
     close(OX);
  }
}
  
sub fix_args {
  my($task_type, $opts, $el) = @_;
  my $o1;
  eval {
    my $f = "${task_type}_options";
    $o1 = Tasks->$f($opts, $el);
  };
  $o1 = "$opts $el" if (!$o1);
  return $o1;
}

sub testDone {
  my($file, $ERR, $now, $el, $loop, $PASS, $T, $ERROR) = @_;
  appendClose($file, "$$\tDONE\t$now\t$el\t$ERR\n");
  if ($ERR == 143) {
     $$T = "ABORTED: Test was manually stopped on Pass $loop of $PASS";
     appendClose($file, "$$\tKILL-15\t$now\n");
     $$ERROR = $ERR;
     return 1;
  }elsif ($ERR == 140) {
     $$T = "ISOLATED: Test isolated to FRU(s) on pass $PASS";
     appendClose($file, "$$\tKILL-15\t$now\n");
     $$ERROR = $ERR;
     return 1;
  } elsif ($ERR) {
     $$T = "FAILED on Pass $loop of $PASS";
     appendClose($file, "$$\tKILL-15\t$now\n");
     $$ERROR = $ERR;
     return 1;
  }
  return 0;
}

sub create_tmp_file {
  my($pid, $file) = @_;
  my $dir = System->get_home() . "/DATA/tmp/$RASTEST$pid";
  mkdir $dir, 0777 if (!-d $dir);
  $file = "single" if (!$file);
  return "$dir/$file";
} 

sub start_concurrent {
  my($command1, $el, $task_type, $opts, $MAP) = @_;

  my $o1 = &fix_args($task_type, $opts, $el);
  my $pid2;
  if (($pid2 = fork()) == 0) {
     my $TMP = &create_tmp_file(getppid, $$);  # child
     exec("$command1 $o1 >> $TMP 2>&1");

  } else {
     # Parent
     $MAP->{$pid2} = $el || 1;

  }
}


#
# need to get the PID before this can work
#
sub get_runS {
  my($q) = @_;
  my $pid;
  my $file = System->writeQ($q);
  system(System->get_home() .  "/sbin/rundiag -f $file&");

  if ($q->{HTTP}) {
     print "\n\nOK $pid <END_OF_DATA>\n";
  } else {
     return "OK $pid";                      #   return OK
  }
}



#
#  make sure that command is relative to the dir. for this task_type.
#
sub get_run {
  my($q) = @_;
  my ($pid);


  my $L = Labels->read("Scheduler");
  my $log;
  foreach my $x (keys %$q) {
     $log .= " $x => \"$q->{$x}\",";
  }
  chop($log) if ($log);
  &schedLog("Scheduler::get_run({$log}); \n");
  #print "&nbsp;<br>\n";

  if ($q->{NOFORK} ||  ($pid = fork()) == 0) {  # child

      $SIG{CHLD} = 'DEFAULT';
      my $command = $q->{command};
      my $opts    = $q->{opts};
      my $opts2   = $q->{opts2};
      my $master  = $q->{master};
      my $duration= $q->{duration}; # minutes
      my $dev_type= $q->{dev_type};
      my $email   = $q->{email};
      my $target  = $q->{target};
      my $concurrent = $q->{concurrent} || 1;
      my $interactive = $q->{interactive};
      my $task_type = $q->{task_type};
      my $passes  = $q->{passes} || 1;
      $passes += 0;
      if (!$q->{NOFORK})  {
        close(STDIN); 
        close(STDERR);
        close(STDOUT) if (!$ENV{FCGI});
      }
      $0 = "rastest";
      my($renv) = PDM::ConfigFile->read();
      System->set_renv($renv);

      my $mailer = $renv->{mailer} || "/usr/bin/mail";
      my $host = $q->{host} || $renv->{hostname};
      my($acronym) = $renv->{GSV_ACRONYM};
      my $D = System->get_home() . "/DATA/Proc/$host";
      if (!-d $D) {
        mkdir $D, 0777 ;
      }
      my $pp = "${task_type}_$$";

      unlink("$D/P_$pp");
      unlink("$D/O_$pp");
      appendClose("$D/P_$pp","$$\tSTART\t" . Util->get_today() . "\t$command\t$opts\t$host\n");

      if ($interactive) {
         if ($master) {  
            my $w = $master;
            $w .= ":" . System->get_rasport() if (index($w, ":") < 0);
            $opts = "-W $w /$D/Q_$pp $opts";
         } else {
            $opts = "-W $D/Q_$pp $opts";
         }
      }

      my @list;
      if (!$opts2) {
         $list[0] = "";
      } else {
         @list = split(/\t/, $opts2);
      }
      my $cnt=1;
      my $command1;
      eval {
         my $f = "${task_type}_command";
         $command1 = Tasks->$f($command);
      };
      my $format = "+\%Y-\%m-\%d %H:%M:%S";
      $command1 = $command if (!$command1);
      my $loop = 0;
      my($now, $x);
      my $stime = time;
      my ($ERR, $A, $T, $ERROR);

      $ERROR = 0;
      my $PASS = $passes;
      my $done = 0;

      # make sure user aborted run file doesn't exist prior to run
      if (-r "/tmp/userAbortedRun"){
         unlink("/tmp/userAbortedRun");
      }

      while (1) {
         $now = Util->get_today();
         $loop++;
         # appendClose("$D/O_$pp", "#PASS $loop of $PASS\n");
         if ($concurrent == 1) {            # no concurrency 
           appendClose("$D/O_$pp", "Test started: \n");
           for ($x = 0; $x <= $#list; $x++) {
              my $el = $list[$x];
              my $o1 = &fix_args($task_type, $opts, $el);
              appendClose("$D/O_$pp", "#OUTPUT $el\n");

              #system("$command1 $o1 >> $D/O_$pp 2>&1");
              my $TMP = &create_tmp_file($$);
	      system("$command1 $o1 >> $TMP 2>&1");


	      $ERR = $?;
              $A .= "$ERR,"; $A = substr($A, 0, 1000);

	      if (-r "/tmp/userAbortedRun"){
	         # User aborted this run 
		 unlink("/tmp/userAbortedRun");
		 $ERR = 143; # Make sure error is set to abort value
	      }


	      if( ($loop == 1 ) || ($ERR)  || ($loop == $PASS)) {
		 #only save first, last and failing runs
                 open(W2, ">>$D/O_$pp");
                 my $l;
                 if (open(O2, $TMP)) {
                    while ($l = <O2>) {
                       print W2 $l;
                    } 
                    close(O2);
                 }
                 close(W2);
		 appendClose("$D/O_$pp", "\n");
	      }
	      unlink( $TMP );

              $now = Util->get_today();
              $done = &testDone("$D/P_$pp", $ERR, $now, $el, $loop, $PASS, \$T, \$ERROR);
              last if ($done);    
           }
         } else {
           appendClose("$D/O_$pp", "#PASS $loop of $PASS\n");
	   # concurrent tests
           my (%MAP, $y);
           my $current = 0;
           while (1) {                       # loop until all devices are done.
             for ($y = 1; $y <= $concurrent; $y++) {
                my $el = $list[$current]; $current++;
                &start_concurrent($command1, $el, $task_type, $opts, \%MAP);
                last if ($current > $#list);
             }

	     my $kid;
             while ( keys %MAP ) {  

		# Wait for a child to finish
	        $kid = wait();
		$now = Util->get_today();
		$ERR=$?;
		$A .= "$ERR,"; $A = substr($A, 0, 1000);

		if($kid == -1) {
		   # There were no more children to wait for ?
		   if (-r "/tmp/userAbortedRun"){
	              # User aborted this run 
		      unlink("/tmp/userAbortedRun");
	           }
		   # Someone must have manually killed processes 
		   $ERR=143;
		   appendClose("$D/O_$pp", "\n\n$L->{manual_kill}\n\n");
		   $done = &testDone("$D/P_$pp", $ERR, $now, 0, $loop, $PASS, \$T, \$ERROR);
		   last;
		}

                if (-r "/tmp/userAbortedRun"){
	          # User aborted this run 
		  unlink("/tmp/userAbortedRun");
		  # Make sure error is set to abort value
		  $ERR = 143;
	        }

		if($ERR) {
		   appendClose("$D/O_$pp", "\n\n$L->{failed_test_output}\n\n");
		}						  
                appendClose("$D/O_$pp", "#OUTPUT $MAP{$kid}\n");
                my $TMP = &create_tmp_file($$, $kid);
	        if (($loop == 1 ) || ($ERR)  || ($loop == $PASS)) {
		   #only save first and failing runs
                   open(W2, ">>$D/O_$pp");
                   my $l;
                   if (open(O2, $TMP)) {
                      while ($l = <O2>) {
                         print W2 $l;
                      } 
                      close(O2);
                   }
                   close(W2);
		   appendClose("$D/O_$pp", "\n");
		}

	        if($ERR) {
		   appendClose("$D/O_$pp", "\n\n$L->{failed_end}\n\n");
		}

                $done = &testDone("$D/P_$pp", $ERR, $now, $MAP{$kid}, $loop, $PASS, \$T, \$ERROR);
                delete $MAP{$kid};
		unlink( $TMP);
		if(!$ERROR) {
                   if ($current <= $#list) {
                      my $el = $list[$current]; $current++;
                      &start_concurrent($command1, $el, $task_type, $opts, \%MAP);
                   }                
		}
                my @Z = %MAP;
                last if ($#Z < 0);

             }
             last if ($done);
             last if ($current > $#list);
	     last if ($ERROR);
	     
           }
           my @kill;
           foreach my $x (keys %MAP) { 
              push(@kill, $x);
           }
           if ($#kill >= 0) {
             kill 9, @kill;
           }
         }
         last if ($done);
	 last if ($ERROR);
         last if ($passes && $loop >= $passes);
         last if ($duration && ((time - $stime) >= ($duration * 60))) ;
      }
      if (!$ERROR) {
         $T = "PASSED $loop of $PASS time(s)";
	 $A = "0,";
      } else {
         $A = $ERROR;
      }
      appendClose("$D/P_$pp", "$$\tSTOP\t$now\t$A");
      unlink "$D/E_$pp" if (-z "$D/E_$pp");
      system("/bin/rm -r " . System->get_home() . "/DATA/tmp/$RASTEST$$");

      if ($email) {
         my $clean_opt = $opts;
         my $hn = $renv->{hostname};
         $clean_opt =~ s/passwd=[^\s\=\|]+//;
         my $text =<<EOF;
From: $acronym
Subject: $command on $hn\n
Test      : $command
Host      : $hn
Target    : $target
Status    : $T
Options   : $clean_opt
Device(s) : \n$opts2\n
EOF
          my(@out1, $l);
          open(O2, "$D/O_$pp");
   	  @out1 = <O2>;
   	  close(O2);
   	  foreach my $l (@out1) {
            $text .= $l;
          }


          #$text .= <O2>; close(O2);
          use Mail;
          Mail->mail($email, $renv->{hostname}, "Storage A.D.E. Diagnostic", $text, 10);
          #Util->run_command("$mailer $email", "mail", 10, { data => $text});
      }
      if ($master) {  # my $master = Util->findMaster()) 
         if ($renv->{solution} eq "N") {
	   $master = Util->findMaster();
         }
         my $err3 = Util::Http->sendFile($master, "Proc/$host/P_$pp", 10);
         Debug->err(TEXT => "Scheduler::send_file: $err3") if ($err3);
	 my $err4 = Util::Http->sendFile($master, "Proc/$host/O_$pp", 10);
      }
      exit(0);

#  END OF CHILD 
#####################################

  } elsif($pid > 0) {      # Parent:
      $SIG{CHLD} = 'IGNORE';
      
  } else {                           # Fork Error:
      $pid = "ERR Cannot start $q->{command}";
  }

out:
  if ($q->{HTTP}) {
     print "\n\nOK $pid <END_OF_DATA>\n";
  } else {
     return "OK $pid";                      #   return OK
  }
}

sub archive {
  my($class, $task_type, $pid, $host) = @_;
  my($renv) = System->get_renv();
  $host = $renv->{hostname} if (!$host);
  my $pp = $task_type . "_$pid";
  my $O = System->get_home() . "/DATA/Proc/$host";
  my $N = System->get_home() . "/DATA/ProcArchive/$host";
  my $today = Util->get_today();
  $today =~ s/ /_/g;

  mkdir $N, 0777 if (!-d $N);
  rename "$O/P_$pp", "$N/P_${pp}_$today";
  rename "$O/I_$pp", "$N/I_${pp}_$today";

  if (-f "$O/O_$pp") {
     rename "$O/O_$pp", "$N/O_${pp}_$today";
  } elsif ($host ne $renv->{hostname}) { 
     my $text = $class->getFile('ST',$host, $pid, 'O');
     if ($text) {
        open(O,  ">$N/I_${pp}_$today");
        print O $text;
        close(O);
     }
  }
}

# $text = Scheduler->getFile('ST','ccadieux.central.sun.com',1212, 'O'); # get O file

sub getFile {
  my($class, $task_type, $host, $pid, $type) = @_;
  $ERROR = undef;
  my($renv) = System->get_renv();
  $host = $renv->{hostname} if (!$host);
  my $D = System->get_home() . "/Proc/$host";
  my $pp = $task_type . "_$pid";
  my $F = "$D/${type}_$pp";
  if ($host eq $renv->{hostname}) {
     if (open(O, $F)) {
        my @lines = <O>; close(O);
        return join('', @lines);
     } else {
        return undef;
     }
  } else {
     my $Config = PDM::ConfigFile->read();
     my $ipno = $Config->findIpNo($host) || $host;
     my ($err, $rc) = Util::Http->readFile($ipno, "Proc/$host/$F", 10);
     $ERROR = $err;
     return $rc;
  }

}


sub delete {
  my($class, $task_type, $pid, $host) = @_;
  my($renv) = System->get_renv();
  $host = $renv->{hostname} if (!$host);
  my $pp = $task_type . "_$pid";
  my $d = System->get_home() . "/DATA/Proc/$host";
  unlink "$d/P_$pp";
  unlink "$d/I_$pp";
  unlink "$d/E_$pp";
  unlink "$d/O_$pp";
  unlink "$d/S_$pp";

  if  ($host ne $renv->{hostname}) {
     my $Config = PDM::ConfigFile->read();
     my $ipno = $Config->findIpNo($host) || $host;
     my $rc = Util::Http->deleteFile($ipno, "Proc/$host/&filter=??$pp", 10);
  }
  return "OK";
}

#  kill the process and maybe the children (child=>1) 
#  Scheduler->kill("ST", 1212, 'switch', 'ccadieux', {signal => 15, child => 1 });
#
sub kill {
  my($class, $task_type, $pid,  $host, $arg) = @_;
  my $rc;
  my($renv) = System->get_renv();
  my $signal = $arg->{signal} || 15;
  my $child = $arg->{child};
  $host  = $renv->{hostname} if (!$host);
  $ERROR = undef;
  $rc = $class->syncProcess($task_type, $pid, $host);
  if ($rc != 2) { 
     $ERROR = "$pid already stopped";
     return undef;
  }

  if ($host eq $renv->{hostname}) {
     $rc = &get_kill({pid => $pid, signal => $signal, child => $child});
  } else {
     my $command = "Scheduler::kill&pid=$pid&signal=$signal&child=$child&HTTP=1";
     my $Config = PDM::ConfigFile->read();
     my $ipno = $Config->findIpNo($host) || $host;
     $rc = Util::Http->getCommand($ipno, $command, 10);
  }
  if ($rc =~ /OK/) {
     return 1;
  } else {
     $ERROR = $rc;
     return undef;
  }
}

sub get_kill {
  my($q) = @_;
  my $pid   = $q->{pid};
  my $sig   = $q->{signal};
  my $child = $q->{child};
  my($found, $cpid);
  my $rc = "OK";
  # create a kill flag file that will be used by run to determine
  # if user has aborted the testing
  open(O, ">/tmp/userAbortedRun");
  close(O);

  if ($child) {
     my(@procs) = `/bin/ps -ef`;
     foreach my $proc (@procs) {
       $proc = Util->ltrim($proc);
       my(@b) = split(/\s+/, $proc);
       if ($b[2] eq $pid) {
	  # kill any children of this child
	  $rc = &get_kill({pid => $b[1], signal => $sig, child => 1});

          $found = $b[1];
          CORE::kill $sig, $found;
          sleep 1;
          $cpid .= ",$found" if (-d "/proc/$found");
       }
     }
     $rc = "ER failed to kill children: $cpid" if ($cpid);

  } else {
     CORE::kill $sig, $pid;
     sleep 1;
     $rc = "ER failed to kill pid: $pid " if (-d "/proc/$pid");
  }
 
  if ($q->{HTTP}) {
     print "\n$rc";
  } else {
     return $rc;
  }
}

sub processExist {
  my($class, $pid, $host, $arg) = @_;
  my $rc;

  my ($atime, $secs) = Util->processTime($pid, $host, $arg);
  return $atime;
}


#
# status = O=open, C=Close, OQ = Open-waiting-for-question

# $info = Scheduler->readInfo($host, 'ST_8888');
# $info = Scheduler->readInfo($host, 'ST_8888_date', {archive => 1});
# $info = {
#          'end_date' => '2001-08-09 11:27:40',
#          'status' => 'C',
#          'task_type' => 'ST',
#          'rc' => '96,',
#          'opts' => '-v -p 1 -i 1 -f -o xfer=2000,passes=10000,choicepattern=Critical...',
#          'start_tick' => 997378279,
#          'opts2' => 'qlc0-sw0-f1-e2',
#          'start_date' => '2001-08-09 11:31:19',
#          'info' => {
#                      'ports' => 'port2',
#                      'dev_type' => 'switch',
#                      'key' => '100000c0dd0057aa',
#                      'node' => 'port',
#                      'comp' => 'e'
#                    },
#          'pid' => '4867_2001-08-13_09:28:21',
#          'host' => 'diag245.central.sun.com',
#          'command' => 'switchtest'
#        };

#  pid = "ST_121212"

sub readInfo {
  my($class, $host, $pid, $arg) = @_;  
  my ($VAR1, $pid0);
  my $Proc = $arg->{archive}? "ProcArchive": "Proc";

  my $renv = System->get_renv();
  $host = $renv->{hostname} if (!$host);

  my($D) = System->get_home() . "/DATA/$Proc/$host";
  if (open(O, "$D/I_$pid")) {
    $pid0 = substr($pid, 3);
    my @l = <O>; close(O);
    eval "@l";
  } else {
    return undef;
  }
  my $finish = 0;
  $VAR1->{pid} = $pid0;

  if (open(O, "$D/P_$pid")) {
     my @l = <O>; close(O);
     my(@start, @end, $y);
     @start = split(/\t/, $l[0]);
     chop($start[5]);
     for ($y =0; $y <= $#l; $y++ ){
        if ($l[$y] =~ /\tKILL-(\d+)\t(.*)/) {
           $VAR1->{kill}   = "$1, $2";

        } elsif ($l[$y] =~ /\tSTOP\t/) {
           chomp($l[$y]);
           @end = split(/\t/, $l[$y]);
           $finish = 1;
           $VAR1->{status}   = 'C';
           $VAR1->{end_date} = $end[2];
           $VAR1->{rc}       = $end[3];
	}elsif ($l[$y] =~ /\tSTART\t/) {
           chomp($l[$y]);
           @end = split(/\t/, $l[$y]);
           $VAR1->{start_date_P} = $end[2];
        }


     }
  }
  if (-f "$D/Q_$pid" && $VAR1->{status} ne 'C') {
     $VAR1->{status} = "OQ";
  } elsif (!$VAR1->{status}) {
     $VAR1->{status} = "O";
  }
  bless ($VAR1, 'SC_processInfo');
  return $VAR1;
}

# make a question, called by linktest, wait for the answer
# need a valid Qfile (absolute path) to start
#
sub QandA {
  my($class, $qfile0, $question, $to) = @_;
  my($host, $qfile);
 
  $to = 60 if (!$to);
  my($renv) = System->get_renv();
  #my $AProc = "Proc/$host/A_${task_type}_$pid";

  if (index($qfile0, ":") > 0) {
    ($host, $qfile) = split(/\:/, $qfile0, 2);
  } else {
    $qfile = $qfile0;
  }
  my($Q) = $qfile;
  my $ix = rindex($Q, "/");
  my $A = substr($Q, 0, $ix) . "/A" . substr($Q, $ix+2);

  $host = $renv->{hostname} if (!$host);
  unlink $A;

  if ($renv->{hostname} eq $host) {
    open(OO, ">$Q");
    print OO $question;
    close(OO);  

  } else {
    my $f  = substr($qfile, index($qfile, "/DATA/") + 6);
    my $rc = Util->getCommand("DATAF&file=$f&DATA=$question");
  }
  my $tot;
  while (1) {
     if (-f $A) {
        open(OO, $A);
        my $ans = <OO>; close(OO);
        chop($ans) if (substr($ans,-1) eq "\n");
        return lc($ans);
     } else {
        sleep 4;
        $tot += 4;
        if ($tot > $to) {
           $ERROR = "Timeout";
           return undef;
        }
     }
  }
}

# returns text and html-prompts from "y=Yes|1=One|q=Quit|n=No"
# ($question, $prompts, $text) = $pc->getQuestion("ST", $host, "1212");

sub getQuestion {
  my($class, $task_type, $host, $pid) = @_;
  my($D) = System->get_home() . "/DATA/Proc/$host/Q_${task_type}_$pid";
  my ( @prompts);
  my $question = "Enter ";
  if (open(O, $D)) {
     my @l = <O>;
     close(O);
     my $text = join("", @l[0..$#l-1]);
     my $p = $l[$#l];
     my $value;
     my  @P = split(/\|/, $p);
     my  $cnt = 1;
     foreach my $x (@P) {
        if ($x =~ /\=/) {
          my($v, $desc) = split(/\=/, $x);
          $question .= "'$desc', ";
          $value = "$v=$desc";
        } else {
          $question .= "'$x', ";
          $value = "$cnt=$x";
          $cnt++;
        }
        push(@prompts, $value) ;
     }
     return ($question, \@prompts, $text);
        
  } else {
     return ();
  }
}

sub answer {
  my($class, $task_type, $host, $pid, $answer) = @_;
  my($l);
  my($Q) = System->get_home() . "/DATA/Proc/$host/Q_${task_type}_$pid";
  my($O) = System->get_home() . "/DATA/Proc/$host/O_${task_type}_$pid";
  my($A) = System->get_home() . "/DATA/Proc/$host/A_${task_type}_$pid";

#  open(O, $Q);
#  open(W, ">>$O");
#  while ($l = <O>) {
#    print W $l;
#  }
#  close(O); close(W);
  unlink $Q;

  if ($host eq System->hostname() ) {
     open(O, ">$A") ;
     print O $answer if ($answer);
     close(O);

  } else {
     my($err, $ans)  = Util::Http->saveFile($host, "Proc/$host/A_${task_type}_$pid",
                              $answer, 10);
     if ($ans !~ /OK/) {
         return "Failed to push $host/A_${task_type}_$pid: $err";
     }
  }
  return undef;
}

  

sub processMap {
  my($class, $task_type) = @_;
  my(%MAP);

  my $D = System->get_home() . "/DATA/Proc";
  opendir(O, $D);
  my @dirs  = readdir(O); closedir(O);
  foreach my $host (@dirs) {
     next if (!-d "$D/$host");
     my $D1 = "$D/$host";
     if (opendir(O, $D1)) {
        my @dirs2  = readdir(O); closedir(O);
        foreach my $f (sort @dirs2) {
            next if (substr($f,0,2) ne "I_");
            my $i = $class->readInfo($host, substr($f,2));
            my $info = $i->{info};
            next if (!$info);
            my $key = $info->{dev_type} . ":" . $info->{key};
            if (!exists($MAP{$key}) ) {
                $MAP{$key}[0] = $i;
            } else {
                my $m = $MAP{$key};
                $MAP{$key}[$#$m+1] = $i;
            }
        }
     }
  }
  my($x, %MAP2);
  foreach my $k (keys %MAP) {
     my $v = $MAP{$k};
     my(@N) = ();
     for ($x=0; $x <= $#$v; $x++ ) {
        my $el = $v->[$x];
        push(@N, "$el->{start_date}|$x");
     }
     $x = 0;
     foreach my $n (sort @N) {
        my($date, $ix) = split(/\|/, $n);
        $MAP2{$k}[$x] = $v->[$ix];
        $x++;
     }
        
  }
  return \%MAP2;
}

#pid | command | arg | host | start | end | err

#   my $list = Scheduler->processList("ST", 'ccadieux', 'O') ;
#   my $list = Scheduler->processList("ST", 'ccadieux', {status => 'O'});  # or C=close
#   my $list = Scheduler->processList("ST", '*', {status => 'O'});
#   default is all processes.
#   processList will run on the master if need be.


sub processList {
  my($class, $task_type, $host, $arg) = @_;
  my($sync, $status, $PLIST);
  my $master = Util->findMaster();
  my $VAR1;
  if ($arg && !ref($arg)) {
    $status = $arg;
  } elsif ($arg) {
    $status = $arg->{status}; # O = Open, C=Close
    $PLIST = $arg->{plist};
  }

  if ($master) {
     my $rc = Util::Http->getCommand($master, "Scheduler::processList&task_type=$task_type&host=$host&status=$status&HTTP=1");
     if (!$rc) {
        return [];
     } else {
        eval $rc;
        return $VAR1;
     }

  } else {
     return get_processList({ task_type => $task_type, host => $host, status => $status, plist => $PLIST });
  }
}

sub get_processList {
  my($q) = @_;
  my $task_type = $q->{task_type};
  my $host      = $q->{host};
  my $status    = $q->{status};
  my $PLIST     = $q->{PLIST};

  my($renv) = System->get_renv();
  my($rc, @out, $x, $VAR1, @com, $finish);
  $host = $renv->{hostname} if (!$host);

  #
  # NOSYNC (local or remote)
#   pid command arg host start-date end-date return-code
  #
  my $D1 = System->get_home() . "/DATA/Proc";
  opendir(O, $D1);
  my @dirs  = readdir(O); closedir(O);
  foreach my $dhost (@dirs) {
     next if ($dhost ne $host && $host ne "*");
     my $D = "$D1/$dhost";
     next if (!-d $D);
     opendir(O, $D);
     my @d = readdir(O); closedir(O);
     my $origx = -2;
     for ($x=0; $x <= $#d; $x++) {
          if ($d[$x] =~ /^I_$task_type/) {
            my $df = $d[$x];
            my $pid = substr($df,2);
	    my $rpid = substr($df, 5);
            my $i = Scheduler->readInfo( $dhost, $pid);
            if ($i) {
              next if (!$i->{command});
              if ($status && substr($i->{status},0,length($status)) ne $status) {
                 if (!$PLIST || index(",$PLIST,", ",". substr($pid,3) . ",") < 0) {
                   next;
                 }
              }
	      if($status =~ /O/){ # only sync process if it is still open/running
	         my $retstat = Scheduler->syncProcess($task_type, $rpid, $dhost);
		 if($x != $origx){
		   # Do this file/process again since it has been synced
		   $origx = $x;
		   $x--;
		 }
	      }

              push(@out, $i);
            }
          }
     }
  }
  if ($q->{HTTP}) {
require Data::Dumper;
    print Data::Dumper::Dumper(\@out);
  } else {
    return \@out;
  }
}
     

#
# will get and store the O_file in the master.
# expect pid = "12345", no task_type

sub read {
  my($class, $task_type, $host, $pid, $arg) = @_;
  my(@p1, @p2, @a, @out, @err, $rc, $x, @pro, $VAR1, @info, $err);

  my $Proc = $arg->{archive}? "ProcArchive": "Proc";
  my $renv = System->get_renv();
  $host    = $renv->{hostname} if (!$host);
  my $pp   = $task_type . "_$pid";
  my $D    = System->get_home() . "/DATA/$Proc/$host";
  my $info = $class->readInfo($host, $pp, $arg);

  return () if (!$info);
  my($o_done, $p_done);

  if (open(O, "$D/P_$pp")) {
     @pro = <O> ; close(O); 
     $p_done = 1;
  }
  if (open(O, "$D/O_$pp")) {
     @out = <O> ; close(O); 
     $o_done = 1;
  }
  if ($host eq $renv->{hostname}) {  # local
     if (open(O, "$D/O_$pp")) {
        @out = <O> ; close(O);
     }
     my $TMP = System->get_home() . "/DATA/tmp/$RASTEST$pid";
     if (opendir(DIR, $TMP)) {
       my @parentfiles = readdir(DIR);
       closedir(DIR);
       foreach my $file (@parentfiles){
          next if (substr($file,0,1) eq ".");
          if (open(OO, "$TMP/$file")) {
             my @tmp = <OO>; close(OO);
             push(@out, "\n\n");
             push(@out, @tmp);
          }
       }
     }
     if (open(O, "$D/E_$pp")) {
        @err = <O> ; close(O);
     }

  } elsif (!$o_done) {
     my $Config = PDM::ConfigFile->read();
     my $ipno = $Config->findIpNo($host) || $host;
     my ($err, $rc) = Util::Http->readFile($ipno, "Proc/$host/&filter=??$pp", 10, $arg);
     if ($err) {
        $ERROR = $err;
        return ();
     }
     my $in;
     @a = split(/\n/, $rc);
     my $st_done;
     for ($x=0; $x <= $#a; $x++) {
        if (substr($a[$x],0,8) eq "#FILE P_") {
           $in = "P";

        } elsif (substr($a[$x],0,8) eq "#FILE S_") {
           $in = "S";

        } elsif (substr($a[$x],0,8) eq "#FILE I_") {
           $in = "I";

        } elsif (substr($a[$x],0,8) eq "#FILE O_") {
           $in = "O";

        } elsif (substr($a[$x],0,8) eq "#FILE E_") {
           $in = "E";

        } elsif ($in eq "O") {
           push(@out, "$a[$x]\n");

        } elsif ($in eq "E") {
           push(@err, "$a[$x]\n");

        } elsif ($in eq "P" && !$p_done) {
           push(@pro, "$a[$x]\n");
           $st_done = 1 if ($a[$x] =~ /\tSTOP\t/);
        }
     }
     # Added single for file to end of line for Bugid 5093366
     my($err2, $tmp) = Util::Http->readFile($ipno, "tmp/$RASTEST$pid/single", 10);
     push(@out, $tmp);

     if ($info->{status} eq "C") {# done, can copy files locally
        open(O, ">$D/O_$pp");
        print O join("", @out);
        close(O);
        if (!$p_done) {
           open(O, ">$D/P_$pp");
           print O join("", @pro);
           close(O);
        }
        #$info = $class->readInfo($host, $pp, $arg);
     }
  }
  
  my (@O);
  my $o_cnt = -1;
  foreach my $l (@out) {
     if ($l =~ /^#OUTPUT (.*)/) {
         $o_cnt++;
         $O[$o_cnt]{register} = $1;
     } elsif($l =~ /^#PASS (.*)/) {
         my $endl = $1;
         $O[$o_cnt+1]{run_num} = "PASS $endl";
	 $O[$o_cnt]{output} .= $l;
     }else {
         $o_cnt = 0 if ($o_cnt < 0);
         $O[$o_cnt]{output} .= $l;
     }
  }
  $o_cnt = -1;
  foreach my $l (@pro) {
     my($pid, $state, $date, $reg, $rc) = split(/\t/, $l);
     if ($state eq "DONE") {
           $o_cnt++;
           $O[$o_cnt]{rc} = $rc;
           $O[$o_cnt]{date} = $date;
     }
  }
  return ($info, \@pro, \@O, \@err);
 
}

#
# verify that the process still exist, mark the P file accordingly.

# return 1: needed to sync , added STOP 999,  now STOPPED
# return 0: nothing to do, already STOPPED
# return 2: still running. all fine

sub syncProcess {
  my($class, $task_type, $pid, $host, $arg) = @_;
  my $rc = 2;
  $ERROR = undef;
  my($renv) = System->get_renv();
  my $localhost = $renv->{hostname};

  $host     = $localhost if (!$host);
  my $D1    = System->get_home() . "/DATA/Proc";
  my $PFILE = "/$host/P_${task_type}_$pid";
  my $OFILE = "/$host/O_${task_type}_$pid";

  if (! -f "$D1/$host/I_${task_type}_$pid") {
    return 0;
  }
  my $Config = PDM::ConfigFile->read();
  my $ipno = ($renv->{solution} ne "N") ? "" : 
             ($Config->findIpNo($host) || $host);

  if ($host ne $localhost && $renv->{solution} eq "N") {
     Util::Http->receiveFile($ipno, "/Proc/$PFILE","",$arg);
     Util::Http->receiveFile($ipno, "/Proc/$OFILE","",$arg);
  }
  if (open(OO, "$D1/$PFILE")) {
    my ($l, $last);
    while ($l = <OO>) {
       if ($l =~ /\tSTOP/) { # process already stopped
         close(OO);
         return 0;
       }
    }
    close(OO);
  }
  my $ex = Scheduler->processExist($pid, $ipno, $arg);
  # MAY NEED TO CHECK PFILE AGAIN
  if (!$ex) {
     open(OO, ">>$D1/$PFILE");
     print OO $pid . "\tSTOP\t" . Util->get_today() . "\t999\n";
     close(OO);
     $ERROR = "marking Pfile of $pid 'STOP'";
     $rc = 1;
  }
  # if ($host ne $localhost) {
  #   Util::Http->sendFile($host, "Proc/$PFILE");
  # }
  return $rc;
}

package SC_Process;

sub read {
  my($pro) = @_;

  return Scheduler->read($pro->{task_type}, $pro->{host}, $pro->{pid});
}

package SC_processInfo;

# field is optional

# 2001-11-26 11:50:42, 2001-11-27 13:07:14
sub durationHMS {
  my($info) = @_;
  my $sd = substr($info->{start_date}, 8,2);
  my $ed = substr($info->{end_date},   8,2);
  my $st = substr($info->{start_date}, 11);
  my $et = substr($info->{end_date},   11);

  my $duration = substr($et,0,2) * 3600 + substr($et,3,2) * 60 + 
                 substr($et,6,2) - 
               (substr($st,0,2) * 3600 + substr($st,3,2) * 60 + substr($st,6,2));

  my $hours = int($duration / 3600) + ($ed - $sd) * 24;
  $duration -= ($hours * 3600);
  my $mins = int($duration / 60);
  $duration -= ($mins * 60);
  my $secs = $duration;
  my $dur  = "$hours:$mins:$secs";
  return $dur;
}

  
sub info {
  my($class, $field) = @_;

  if ($field) {
    return $class->{info}{$field};
  } else {
    return $class->{info};
  }
}

#  status: O= running, S=success, F=failed
sub status {
  my($p) = @_;

  if (substr($p->{status},0,1) eq "O") {
     return "O";
  } elsif ($p->{rc} =~ /^[0,]+$/) {
     return "S";
  } else {
     return "F"; 
  }
}

sub statusText {
  my($p) = @_;

  if ($p->{status} eq "O") {
     return "<b>Running</b></font>";
  } elsif ($p->{rc} =~ /^[0,]+$/) {
     return "<font color=green><b>OK</b></font>";
  } elsif ($p->{rc} =~ /143/) {
     return "<font color=red><b>ABORTED</b></font>";
  } elsif ($p->{rc} =~ /140/) {
     return "<font color=red><b>ISOLATED</b></font>";
  }else {
     return "<font color=red><b>FAIL</b></font>";
  }
}


1;
