#!/opt/bin/perl5.004 -w

use Socket;
use strict;
require 'getopts.pl';

use vars qw($opt_h $opt_d $opt_w);

my $tmax = 25;

&Getopts("hwd") || $opt_h || die "Use -h for help\n";
if( $opt_h ){
    print <<"END";
USAGE: $0 [-hdw] ip_address [port]

  -h   : print this screen
  -d   : hexdump packets sent and received
  -w   : wait for more then one response. By default will
	 wait for up to $tmax seconds for a single response.

  ip_address : address to connect to
  port       : (optional) port to connect to. Default 7777


END
    exit(0);
}

my $prompt = "[hybrid]% ";
my $cmd = '';
my $dest = shift || die "An ip address must be specified. Use -h for help\n";
my $ipaddr = inet_aton( $dest ) || die "Invalid address specified: $dest\n";
my $port = shift || 7777;
my $saddr= sockaddr_in( $port, $ipaddr);

socket(S, PF_INET, SOCK_DGRAM, getprotobyname('udp') ) or 
  die "Can't create send socket. $!\n";

while( ($cmd = &GetInput($prompt)) !~ /^q(uit){0,1}$/i ){
  DoCmd($cmd);
}

exit 0;

# not sure if this is necessary or not
sub GetCode {
  my %prefixes = 
     ( connect => 0x02,
       qamstat => 0x03,
       exit    => 0x07,
       asys    => 0x08,
       'telco ati3'   => 0x09,
       config  => 0x17,
       'telco AT' => 0x06 );
     
  my ($cmd) = @_;

  my @match = grep( $cmd =~ /^$_/, keys %prefixes );

  @match or return 0x01;

  return $prefixes{$match[0]};
}

sub GetInput {
   my($prompt)=shift;
   my($limit)=20;
   my($line);

   while($limit--){
      ((-t STDIN) and (-t STDOUT)) or die "Not interactive\n";

      print "$prompt";
      chomp($line = (<STDIN>));
      $line =~ s/^\s*//;
      $line =~ s/\s*$//;
      
      return $line if $line;
   }

   die "Prompt limit exceeded.\n";
}

sub DoCmd {
  my $cmd = shift;

  my $ret = SendCmd($cmd);
  unless( defined($ret) and  $ret > 0 ){
    warn "Error sending datagram. $!\n";
    return;
  }
  
  my ($rout, $rin) = ("","");
  vec($rin,fileno(S),1) = 1;
  
  my $tlimit = time + 25;
  my $tout;
  my $count = 0;

  while( ($tout = $tlimit - time) > 0 ) {
    my $rc = select($rout=$rin,undef,undef,$tout );
    if ( $rc == 0 ){
      $count or warn "Error receiving datagram. Timed out\n";
      return;
    }
    
    $rc < 0 and next;
    
    my $msg;
    unless( recv(S,$msg,1024,0) ){
      warn "Error receiving datagram.  $!\n";
      return;
    }
    
    $count++;

    $opt_d and hexdump( length($msg), $msg, "\nreceived:\n" );
    
    print unpack("a*", substr($msg,18) ), "\n";

    $opt_w or return;
  }
}

sub SendCmd {
  my $cmd = shift;
  my $len = length($cmd);
  
  my $framelen = 20 + 2 + 6 + $len + 1; # hdr, cmdlen, nulls,cms, nul
  my $msg = pack( "C28a${len}C4", 
		  0x00, 0x00, 0x01, GetCode($cmd), 
		  0x00, 0x00, 0x00, 0x00, 
		  0x00, 0x00, 0x00, 0x01, 
		  0xff, 0xff, 0xff, 0xff, 
		  0x00, 0x00, 0x0f, 0x0a,
		  (($len >> 8) & 0xff), ($len & 0xff), 0x00, 0x00, 
		  0x00, 0x00, 0x00, 0x00, 
		  $cmd, 
		  0x00, 0x00, 0x00, 0x00 );
  
  $opt_d and hexdump( $framelen, $msg, "\nsending:\n" );

  return send(S, substr($msg,0,$framelen), 0, $saddr );
}

sub hexdump {
   my($bytes,$msg,$hdr)=@_;
   my($len,$data,$offset,@array);
   $offset = 0;
   
   $hdr and print $hdr;

   while ($bytes >= 16){
      $data = substr($msg,0,16);
      $msg = substr($msg,16);
      @array = unpack('N4', $data);
      $data =~ tr/\0-\37\177-\377/./;
      printf "%8.8lx    %8.8lx %8.8lx %8.8lx %8.8lx    |%s|\n",
      $offset, @array, $data;
      $offset += 16;
      $bytes -= 16;
   }
   
   if ($bytes) {
      my($Pad) = 16 - $bytes;           # pad printed data w /blanks
      printf "%8.8lx    ", $offset;
      $data = substr($msg,0,$bytes);
      @array = unpack("C$bytes", $msg); # unpack bytes
      $data =~ y/\0-\37\177-\377/./;    # convert originals to printable
      # watch for stripped trailing null
      $data .= '.' x ($bytes - length($data)) if($bytes > length($data));
      $data =~ s/[^ -~]/./g;             # convert this stuff to '.'
      $data .= ' ' x $Pad;
      # watch for stripped trailing null
      push(@array,(0x0) x ($bytes - scalar(@array))) if($bytes >@array);
      @array = map { sprintf('%2.2x',$_); } @array; # convert unpacked to hex
      push(@array, ('  ') x $Pad );
      printf "%s%s%s%s %s%s%s%s %s%s%s%s %s%s%s%s    |%s|\n",
      @array, $data;
   }
}