===================================================================
RCS file: /cvs/trango/Net-Telnet-Trango/scripts/update_trango.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- trango/Net-Telnet-Trango/scripts/update_trango.pl	2005/11/16 03:28:42	1.1
+++ trango/Net-Telnet-Trango/scripts/update_trango.pl	2005/11/16 05:26:37	1.2
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $RedRiver$
+# $RedRiver: update_trango.pl,v 1.1 2005/11/16 03:28:42 andrew Exp $
 ########################################################################
 # update_trango.pl *** Updates trango foxes with a new firmware
 # 
@@ -9,4 +9,188 @@
 use warnings;
 
 use Net::Telnet;
+use Net::TFTP;
+use YAML;
+
+my @Foxes = (
+  '10.100.3.8',
+#  '10.100.3.11',
+#  '10.100.3.12',
+#  '10.100.3.13',
+);
+
+my $password = 'password';
+
+my $new_file  = 'fsu53_2p0a2H0003D05101403.s19';
+my $new_ver   = 'FSU 1p06H0003D04111001';
+my $new_cksum = 'x1D28DCC4';
+
+my $max_tries = 3;
+
+
+
+
+
+
+foreach my $fox (@Foxes) {
+  print "getting temp from Fox: $fox\n";
+  ## Connect and login.
+  my $host = new Net::Telnet (Timeout => 5,
+                              Prompt => '/#> *$/');
+  $host->open($fox);
+  $host->dump_log('dump.log');
+
+  ## Login to remote host.
+  $host->waitfor(
+    -match => '/password: ?$/i',
+    -errmode => "return",
+  ) or die "problem connecting to host ($fox): ", $host->lastline;
+  $host->print($password);
+  $host->waitfor(
+    -match => $host->prompt,
+    -errmode => "return",
+  ) or die "login ($fox) failed: ", $host->lastline;
+  
+
+  ## Send commands
+  if ( upload($host, $new_file) ) {
+    $host->send('reboot');
+  } else {
+    $host->send('exit');
+  }
+  $host->close;
+}
+
+sub upload
+{
+  my $host = shift;
+  my $file = shift;
+  my $ver = get_ver($host);
+
+  if (
+    $ver->{'Firmware Version'} eq $new_ver && 
+    $ver->{'Checksum'}         eq $new_cksum
+  ) {
+    print "Already updated!";
+    return 1;
+  }
+
+  my $try = 0;
+  while (1) {
+    $try++;
+
+    enable_tftpd($host) || die "Couldn't enable tftpd";
+
+    # use tftp to push the file up
+
+    # waitfor some sort of output
+    # make sure it says 'Success.' otherwise error
+    
+    my $results = check_tftpd($host);
+    # check the 'File Length' against ???
+
+    # 'updateflash mainimage $old_cksum $new_cksum'
+    # OR
+    # 'save mainimage [current firmware checksum] [new firmware checksum]'
+    # waitfor a prompt, look at the end of the output for 'Success.' otherwise
+    # error.
+    # decode_lines to get 'Checksum' to see if it matches $new_cksum
+    
+    $ver = get_ver($host);
+    # check versions
+    
+
+    if ($try >= $max_tries) {
+      warn "Couldn't update in $max_tries tries!";
+      return undef;
+    }
+  }
+}
+
+sub get_ver
+{
+  my $host = shift;
+  return cmd($host, 'ver');
+}
+
+sub enable_tftpd
+{
+  my $host = shift;
+
+  my $vals = cmd($host, 'tftpd on');
+
+  if ($vals->{'Tftpd'} eq 'listen') {
+    return 1;
+  } else {
+    return undef;
+  }
+}
+
+sub check_tftpd
+{
+  my $host = shift;
+  return cmd($host, 'tftpd');
+}
+
+sub cmd
+{
+  my $host   = shift;
+  my $string = shift;
+
+  my @lines = $host->cmd($string);
+
+  my $vals = decode_lines(@lines);
+  return $vals;
+}
+
+sub decode_lines
+{
+  ### XXX ver has 2 Checksums.  one for FPGA and one for Firmware.  DOH!
+  my @lines = @_;
+
+  my %conf;
+
+  my $key = '';
+  my $val = '';
+  my $in_key = 0;
+  my $in_val = 0;
+
+  foreach my $line (@lines) {
+    my @chars = split //, $line;
+
+    foreach my $c (@chars) {
+      next if $c eq "\r";
+      next if $c eq "\n";
+
+      if ($c eq '[') {
+        $in_key = 1;
+        $in_val = 0;
+        if ($key) {
+          $val =~ s/\s+$//;
+          $conf{$key} = $val;
+          $key = '';
+          $val = '';
+        }
+
+      } elsif ($c eq ']') {
+        $in_val = 1;
+        $in_key = 0;
+        $c = shift @chars;
+
+      } elsif ($in_key) {
+        $key .= $c;
+
+      } elsif ($in_val) {
+        $val .= $c;
+      }
+    }
+  }
+  print Dump \%conf;
+
+  if (%conf) {
+    return \%conf;
+  } else {
+    return \@lines;
+  }
+}