[BACK]Return to update_trango.pl CVS log [TXT][DIR] Up to [local] / trango / Net-Telnet-Trango / scripts

File: [local] / trango / Net-Telnet-Trango / scripts / update_trango.pl (download)

Revision 1.2, Wed Nov 16 05:26:37 2005 UTC (18 years, 8 months ago) by andrew
Branch: MAIN
Changes since 1.1: +185 -1 lines

a good framework so far, and add some documents to help in the future.  Plus some copies of firmware to test with

#!/usr/bin/perl
# $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
# 
# 2005.11.15 #*#*# andrew fresh <andrew@mad-techies.org>
########################################################################
use strict;
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;
  }
}