ACE/bin/PerlACE/TestTarget_LVRT.pm

   1 #!/usr/bin/env perl
   2 #
   3 # TestTarget_LVRT - how to manage the test environment on a LabVIEW RT target.
   4 #
   5 # We can FTP files to and from the LabVIEW target, but there's no NFS or
   6 # SMB shares.
   7 # Most information about the target itself is specified via environment
   8 # variables. Environment variables with settings are named using the target's
   9 # config name with a specific suffix. The current environment variables are:
  10 #   <config-name>_IPNAME - the host name/IP of the target.
  11 #   <config-name>_CTLPORT- the TCP port number to connect to for the test
  12 #                          controller. If this is not set, port 8888 is used.
  13 #   <config-name>_FSROOT - the root of the filesystem on the target where
  14 #                          ACE files will be created from (cwd, if you will).
  15 #                          If this is not set, "\ni-rt" is used as the root.
  16 #
  17 # Each of these settings are stored in a member variable of the same name in
  18 # each object. The process objects can access them using, e.g.,
  19 # $self->{TARGET}->{IPNAME}.
  20 #
  21 # This class also makes an FTP object available to process objects that are
  22 # created. FTP is set up before creating a process object and can be used to
  23 # transfer files to and from the LVRT target.
  24
  25 package PerlACE::TestTarget_LVRT;
  26 our @ISA = "PerlACE::TestTarget";
  27
  28 ### Constructor and Destructor
  29
  30 sub new
  31 {
  32     my $proto = shift;
  33     my $config_name = shift;
  34     my $class = ref ($proto) || $proto;
  35     my $self = {};
  36     bless ($self, $class);
  37     $self->GetConfigSettings($config_name);
  38     my $targethost;
  39     my $env_name = $config_name.'_IPNAME';
  40     if (exists $ENV{$env_name}) {
  41         $targethost = $ENV{$env_name};
  42     }
  43     else {
  44         print STDERR "You must define target hostname/IP with $env_name\n";
  45         undef $self;
  46         return undef;
  47     }
  48
  49     $env_name = $config_name.'_CTLPORT';
  50     if (exists $ENV{$env_name}) {
  51         $self->{CTLPORT} = $ENV{$env_name};
  52     }
  53     else {
  54         print STDERR "Warning: no $env_name variable; falling back to ",
  55                      "port 8888\n";
  56         $self->{CTLPORT} = 8888;
  57     }
  58
  59     $env_name = $config_name.'_FSROOT';
  60     my $fsroot = '\\ni-rt\\system';
  61     if (exists $ENV{$env_name}) {
  62         $fsroot = $ENV{$env_name};
  63     }
  64     else {
  65         print STDERR "Warning: no $env_name variable; falling back ",
  66                      "to $fsroot\n";
  67     }
  68     $self->{FSROOT} = $fsroot;
  69
  70     $self->{REBOOT_CMD} = $ENV{'ACE_REBOOT_LVRT_CMD'};
  71     if (!defined $self->{REBOOT_CMD}) {
  72         $self->{REBOOT_CMD} = 'I_Need_A_Reboot_Command';
  73     }
  74     $self->{REBOOT_TIME} = $ENV{'ACE_LVRT_REBOOT_TIME'};
  75     if (!defined $self->{REBOOT_TIME}) {
  76         $self->{REBOOT_TIME} = 200;
  77     }
  78
  79     $self->{REBOOT_TIME} = $ENV{'ACE_RUN_LVRT_REBOOT_TIME'};
  80     if (!defined $self->{REBOOT_TIME}) {
  81         $self->{REBOOT_TIME} = 200;
  82     }
  83     $self->{REBOOT_NEEDED} = undef;
  84
  85     $self->{FTP} = new Net::FTP ($targethost);
  86     $self->{IPNAME} = $targethost;
  87     if (!defined $self->{FTP}) {
  88         print STDERR "Error opening FTP to $targethost: $@\n";
  89         $self->{REBOOT_NEEDED} = 1;
  90         undef $self;
  91         return undef;
  92     }
  93     $self->{FTP}->login("","");
  94
  95     return $self;
  96 }
  97
  98 sub DESTROY
  99 {
 100     my $self = shift;
 101
 102     # Reboot if needed; set up clean for the next test.
 103     if (defined $self->{REBOOT_NEEDED} && $self->{REBOOT_CMD}) {
 104         $self->RebootNow;
 105     }
 106
 107     # See if there's a log; should be able to retrieve it from rebooted target.
 108     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 109       print STDERR "LVRT target checking for remaining log...\n";
 110     }
 111     $self->GetStderrLog();
 112     if (defined $self->{FTP}) {
 113         $self->{FTP}->close;
 114         $self->{FTP} = undef;
 115     }
 116 }
 117
 118 ##################################################################
 119
 120 sub LocalFile ($)
 121 {
 122     my $self = shift;
 123     my $file = shift;
 124     my $newfile = $self->{FSROOT} . '\\' . $file;
 125     print STDERR "LVRT LocalFile for $file is $newfile\n";
 126     return $newfile;
 127 }
 128
 129 sub DeleteFile ($)
 130 {
 131     my $self = shift;
 132     $self->{FTP}->login("","");
 133     foreach my $file (@_) {
 134       my $newfile = $self->LocalFile($file);
 135       $self->{FTP}->delete($newfile);
 136     }
 137 }
 138
 139 sub GetFile ($)
 140 {
 141     # Use FTP to retrieve the file from the target; should still be open.
 142     # If only one name is given, use it for both local and remote (after
 143     # properly LocalFile-ing it). If both names are given, assume the caller
 144     # knows what he wants and don't adjust the paths.
 145     my $self = shift;
 146     my $remote_file = shift;
 147     my $local_file = shift;
 148     if (!defined $local_file) {
 149         $local_file = $remote_file;
 150         $remote_file = $self->LocalFile($local_file);
 151     }
 152     $self->{FTP}->ascii();
 153     if ($self->{FTP}->get($remote_file, $local_file)) {
 154         return 0;
 155     }
 156     return -1;
 157 }
 158
 159 sub WaitForFileTimed ($)
 160 {
 161     my $self = shift;
 162     my $file = shift;
 163     my $timeout = shift;
 164     my $newfile = $self->LocalFile($file);
 165     my $targetport = $self->{CTLPORT};
 166     my $target = new Net::Telnet(Errmode => 'return');
 167     if (!$target->open(Host => $self->{IPNAME}, Port => $targetport)) {
 168         print STDERR "ERROR: target $self->{IPNAME}:$targetport: ",
 169                       $target->errmsg(), "\n";
 170         return -1;
 171     }
 172     my $cmdline = "waitforfile $newfile $timeout";
 173     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 174       print "-> $cmdline\n";
 175     }
 176     $target->print("$cmdline");
 177     my $reply;
 178     # Add a small comms delay factor to the timeout
 179     $timeout = $timeout + 2;
 180     $reply = $target->getline(Timeout => $timeout);
 181     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 182       print "<- $reply\n";
 183     }
 184     $target->close();
 185     if ($reply eq "OK\n") {
 186         return 0;
 187     }
 188     return -1;
 189 }
 190
 191 sub CreateProcess ($)
 192 {
 193     my $self = shift;
 194     my $process = new PerlACE::ProcessLVRT ($self, @_);
 195     return $process;
 196 }
 197
 198 sub GetStderrLog ($)
 199 {
 200     my $self = shift;
 201     # Tell the target to snapshot the stderr log; if there is one, copy
 202     # it up here and put it out to our stderr.
 203     my $targetport = $self->{CTLPORT};
 204     my $target = new Net::Telnet(Errmode => 'return');
 205     if (!$target->open(Host => $self->{IPNAME}, Port => $targetport)) {
 206         print STDERR "ERROR: target $self->{IPNAME}:$targetport: ",
 207                       $target->errmsg(), "\n";
 208         return;
 209     }
 210     my $cmdline = "snaplog";
 211     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 212         print "-> $cmdline\n";
 213     }
 214     $target->print("$cmdline");
 215     my $reply;
 216     $reply = $target->getline();
 217     if (defined $ENV{'ACE_TEST_VERBOSE'}) {
 218         print "<- $reply\n";
 219     }
 220     $target->close();
 221     if ($reply eq "NONE\n") {
 222         return;
 223     }
 224     chomp $reply;
 225     if (undef $self->{FTP}) {
 226         $self->{FTP} = new Net::FTP ($self->{IPNAME});
 227         if (!defined $self->{FTP}) {
 228             print STDERR "$@\n";
 229             return -1;
 230         }
 231         $self->{FTP}->login("","");
 232     }
 233     $self->{FTP}->ascii();
 234     if ($self->{FTP}->get($reply, "stderr.txt")) {
 235         $self->{FTP}->delete($reply);
 236         open(LOG, "stderr.txt");
 237         while (<LOG>) {
 238             print STDERR;
 239         }
 240         close LOG;
 241         unlink "stderr.txt";
 242     }
 243     return;
 244 }
 245
 246 # Copy a file to the target. Adjust for different types (DLL, EXE, TEXT)
 247 # and debug/non (for DLLs). Additionally, a file can be removed when this
 248 # object is deleted, or left in place.
 249 sub NeedFile ($)
 250 {
 251     my $self = shift;
 252 }
 253
 254 # Need a reboot when this target is destroyed.
 255 sub NeedReboot ($)
 256 {
 257     my $self = shift;
 258     $self->{REBOOT_NEEDED} = 1;
 259 }
 260
 261 # Reboot target
 262 sub RebootNow ($)
 263 {
 264     my $self = shift;
 265     $self->{REBOOT_NEEDED} = undef;
 266     print STDERR "Attempting to reboot target...\n";
 267     if (defined $self->{FTP}) {
 268         $self->{FTP}->close;
 269         $self->{FTP} = undef;
 270     }
 271     system ($self->{REBOOT_CMD});
 272     sleep ($self->{REBOOT_TIME});
 273 }
 274
 275 # Reboot now then try to restore the FTP connection.
 276 sub RebootReset ($)
 277 {
 278     my $self = shift;
 279     $self->RebootNow;
 280     my $targethost = $self->{IPNAME};
 281     $self->{FTP} = new Net::FTP ($targethost);
 282     if (!defined $self->{FTP}) {
 283         print STDERR "Error reestablishing FTP to $targethost: $@\n";
 284     }
 285     else {
 286         $self->{FTP}->login("","");
 287     }
 288 }
 289
 290 sub KillAll ($)
 291 {
 292     my $self = shift;
 293     my $procmask = shift;
 294     PerlACE::ProcessLVRT::kill_all ($procmask, $self);
 295 }
 296
 297 1;