#!/bin/perl

# ^^ this is /usr/local/bin on our AIX boxes...if you execute it and get
# "command not found" errors you have the wrong path for perl

# Author: Kevin Sherlock (USWEST Dex, Omaha, NE)
# email: ksherlo@uswest.com      

# date		name		notes
# 12/20/96	K.Sherlock	original posting to comp.database.sybase
# 07/30/97	T.Boss		cleaned up code, added uname clause and
#   operating system determinance, added SunOS TLI string deciphering.
#   fixed up socket programming based on C.bodley's ph code, ported to Solaris
# 08/13/97	T.Boss		tested on Aix a bit...unsuccessfully. :)

require 'getopts.pl';
use Socket;

# This script originally written for HP/UX, will also work for Aix by default
# functionality exists for Solaris and SunOS now.  Future: test functionality
# for other o/s's and confirm perl version

$uname=`uname -s`;
chomp($uname);

select(STDOUT); $| = 1;         # make unbuffered

# usage information; prints out if a bad option is used or if you call
# sybping -h or -H

$usage = "\nusage: sybping [-S servername] [-I interfaces] [-a] [-v]\n" .
  "\n\$SYBASE and \$DSQUERY are used for defaults for -S and -I switches\n" .
  "  a = Pings all SQL Servers found in interfaces file (Overrides -S)\n" .
  "  v = Verbose behaviour printing to stdout in following format:\n" .
  "Servername:Hostname:Port:Status\n" .
  "    where Status is one of SUCCEEDED|FAILED|NOT_FOUND\n\n";

&Getopts('S:I:vahH') || die "$usage";
$opt_S = "$ENV{DSQUERY}" unless $opt_S;
$opt_S = "0" if $opt_a;
$opt_v = "0" unless $opt_v;
$opt_I = "$ENV{SYBASE}/interfaces" unless $opt_I;
die "$usage" if ( $opt_h || $opt_H );                 

open (INTERFACES,"$opt_I") || die "Can't open interfaces file $opt_I: $!\n";

$found_one = 0;
while ( $line =  ) {
   chomp($line);
   if ( $line =~ /^\w+\b/) {
      #printf "$line\n";
      ($SqlServer) = split(/\s+/,$line);
   }

# Below, \t could be replaced by \s+, but tab is supposed to be
# the only white space allowed before "query".
# ie.    elsif ( $line =~ /^\s+query\b/ )

   elsif ( $line =~ /^\tquery\b/ ) {

# Interface file examples:
# HP/UX
# SERVER_NAME 5 5
#         query tcp ether 255.255.255.0 3000
#         master tcp ether 255.255.255.0 3000
# Aix:
# servername
#         query tcp ether hostname 2025
#         master tcp ether hostname 2025
# Solaris:
# SERVER_NAME
#         query tli tcp /dev/tcp \x000207ec89bb788c0000000000000000
#         master tli tcp /dev/tcp \x000207ec89bb788c0000000000000000

      if ($uname eq "SunOS") {
         ($tab,$query,$tli,$tcp,$dev,$cust_string ) = split(/\s+/,$line);
         #printf "$tab,$query,$tli,$tcp,$dev,$cust_string\n";
      }
      else {
         ($tab,$query,$tcp,$ether,$hostname,$port ) = split(/\s+/,$line);
      }
      if ($uname eq "SunOS") {
         $hexport=substr($cust_string,6,4);
         $port = hex($hexport);

         $hexoctet1=substr($cust_string,10,2);
         $hexoctet2=substr($cust_string,12,2);
         $hexoctet3=substr($cust_string,14,2);
         $hexoctet4=substr($cust_string,16,2);
         $octet1=hex($hexoctet1);
         $octet2=hex($hexoctet2);
         $octet3=hex($hexoctet3);
         $octet4=hex($hexoctet4);
         $remote_ip = "$octet1.$octet2.$octet3.$octet4";
      }
      &ping_it if ( $SqlServer eq $opt_S || $opt_a );
   }
}
close(INTERFACES);

if ( !$found_one ) {                 
   print "$opt_S\:\:\:NOT_FOUND\n" if $opt_v;
   exit 1;
}
exit 0;

sub ping_it {
   $found_one = 1;

   if ($uname eq "SunOS") {

# commented out lines b/c we really don't need to bind locally to 
# connect remotely...we only need to bind locally if we're sending and
# receiving information.

      $sockaddr='Sna4x8';
      ($name,$aliases,$proto)=getprotobyname('tcp');
      ($name,$aliases,$type,$length,$remaddr)=gethostbyname("$remote_ip");
      $rem=pack($sockaddr,AF_INET,$port,$remaddr);
      socket(FH,AF_INET,SOCK_STREAM,$proto) 
         || print "sybping couldn't create a socket: $!\n";

      #($name,$aliases,$type,$length,$locaddr)=gethostbyname("max.cc.nih.gov");
      #$loc=pack($sockaddr,AF_INET,0,$locaddr);
      #bind(FH,$loc)
      #   || print "sybping couldn't bind: $!\n";
   }
   else {
      if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
      die "No port" unless $port;
      $iaddr   = inet_aton($hostname) || die "no host: $remote";
      $paddr   = sockaddr_in($port, $iaddr);
      $proto   = getprotobyname('tcp');
      socket(FH, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
   }

   print "$SqlServer:$remote_ip:$port:\n" if $opt_v;
   if (connect(FH,$rem)) {
      print "SUCCEEDED connect: $!\n" if $opt_v ;
      close(FH) || die "FAILED close: $!\n";
      exit 0 unless $opt_a;
   }
   else {
      print "FAILED connect: $!\n" if $opt_v ;
      exit 1 unless $opt_a;                 
   }
}