#!/usr/bin/perl 

# Ed Rolison 15/06/02
# ed@nightstalker.net
# If it doesn't work, please let me know, I've only had access to my environment
# so I'm not 100% sure.
#
# No liability accepted for problems, mistakes, inaccuracies or nuclear war.
#
# If you want to mess around with this script, then please feel free to do so.
# however, if you add anything 'funky' then I'd really appreciate hearing about it.
#
# Oh, and if you do ever make huge amounts of money out of it, cut me in :)
# version 1.6 ish. Some bug fixes on version 1.5

use IO::Socket::INET;
use IO::Select;
use FileHandle;
use strict;

#configuration section

if ( !defined $ENV{'BBHOME'} ) { die "Bigbrother environment not set" }
my $debug = 0;
my $timeout = 2;
my $test_count = 2;
my $date = `$ENV{'DATE'}`;
my $buffer_size = 1500; # buffer size used for 'recv' calls.

#a word of warning - at the moment these test _will_ match substrings
#of the applications. So if you have something like 'Desktop' and 'DesktopFull'
#Desktop will match on either. I'll probably fix this in a later version.

#a 'single' target will be assumed to be a broadcast address for a cluster.
#that's probably not right, but I've got a local subnet cluster, and
#a remote cluster that I can't broadcast to. So this works well enough.
#feel free to hack in support for discriminating between broadcast/standalone though....
 

my (%tests) = 
(
  'citrix' =>  #this is the name of the 'machine that this test appears to 
               #be from in the bb display
  {
    testname => 'icaclstr',       #hopefully fairly obvious - which column in BB
    target => [ "10.10.127.255" ],  
                               #either a list of servers, or a broadcast address
    red_published_apps =>           # apps which trigger a 'red' when down
      [ "Desktop,"Metaphase", "SAP" ],
    yellow_published_apps =>        #apps which trigger a 'yellow' when down.
      [ "Desktop_2000", "RSCatalogue", "GSI", "IExplorer" ],
 
    longlist => 0, # this is for if you have many published applications.
                   # if you set it, it won't do any harm, but may slow the test
		   # down a little. (Since it does a 'recv' twice instead of 
                   # once and therefore may have to wait for a timeout).
  },
  'site2' =>
  {
    testname => 'icaclstr',
    target => [ "tsl01", "tsl02", "tsl03", "tsl04", "tsl05", 
		"tsl06", "tsl07", "tsl08", "tsl09", "tsl10" ],
   #page red_published_apps => [ "BaaN GUI", "Citrix Shadowing", "DCS Time", 
 	 		    #"pagepage"Desktop_WBH", "Dragon", "Fracas Client",
			    #"FrontPage 2000", "Image Composer",
			    #"Metaphase WBH", "Microsoft Publisher",
			    #"Microstation SE", "MiniTab", 
			    #"O2 Cleaview Data", "Open Plan Desktop",
			    #"OpenPlan Professional", 
			    #"Paperview Cabinet Viewer",
			    #"Project2000", "ViShadow", ],
    red_published_apps => [ "Desktop" ],
    yellow_published_apps => [ "iGrafx", "Printers", "SHE 2000 Professional" ],
    longlist => 1,
  },
  'site3' =>
  {
    testname => 'icaclstr',
    target => [ "tsl01.remote.com", 
     "tsl02.remote.site.com", "tslknu03.knu.uk.power.alstom.com", 
     "tsl04.remote.site.com", "tslknu05.knu.uk.power.alstom.com",
                "tsl06.remote.site.com", ],
    red_published_apps => [ "Applications", "Athena", "AthenaFR", 
             "BlackPoint Recharge", "BPA CBPMS", "ComSite stats", 
             "Desktop_E&CS", "Desktop_KNU", "DMS", "Doc Archive", 
             "Engineering Costs Database", "Engineering Data Warehouse", 
  	     "EOMR Oracle Application", "Equipment Database Eqp_v2",
	     "Fortis Edit Station", "Fortis View Station", 
             "GL Loader for Oracle Financials", "Hypersnap DX-4", "Icepac27", 
             "Internet Explorer", "CBPMS", "ICM", "Lotus Notes",
             "Microsoft Access", "Microsoft Excel", "Microsoft PowerPoint", 
             "Microsoft Word", "PMS", "PMS Reports", 
             "Sure Track", "User Manager for Domains", 
             "Visio", "Visio2000", "vnc viewer", ], 
             #"smartsketch", 
    yellow_published_apps => [  ],
    longlist => 2,
  },
  'sap' =>
  {
    testname => 'sap',
    target => [ "tsg11", "tsg12", ],
    red_published_apps => [ "SAP_NSC" ],
    yellow_published_apps => [ ],
    longlist => 0,
  },
  'ad-uk' =>
  {
    testname => 'icaclstr',
    target => [ "tsgnsc01.ad.uk.alstom.com", ],
    red_published_apps => [ "Desktop" ],
    yellow_published_apps => [ ],
    longlist => 0,
  },
);

#End user config.

#ica port number. 
my $ica_port = 1604;             #what port ICA runs on. Unlikely to change.

#definitions of query strings. Change at your own risk :)
#this info was gathered with tcpdump whilst trying to use an ICA client,
#so I'm not 100% sure of what each value is.
my $app_response_offset = 0x28;
my @bcast_helo = 
  ( 0x1e,0x00,0x01,0x30,0x02,0xfd,0xa8,0xe3,0x00,0x02,0xf5,0x95,0x9f,0xf5,0x30,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0x00,0x00 );
my @bcast_query_app = 
  ( 0x24,0x00,0x01,0x32,0x02,0xfd,0xa8,0xe3,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x21,0x00,0x02,0x00,0x00,0x00,0x00,0x00, 0x00 );

my @direct_helo = 
  ( 0x20,0x00,0x01,0x30,0x02,0xfd,0xa8,0xe3,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 );

my @direct_query_app = ( 0x2c,0x00,0x02,0x32,0x02,0xfd,0xa8,0xe3,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x21,0x00,0x02,0x00,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 );

if ( $debug == 1 )
{
  print "*** Running in test mode\n";
}

#we open 2 UDP ports - one to send the 'search' and the other to query the app list.
#my $UDP_HELO = IO::Socket::INET -> new ( Proto => "udp" ) || die "Socket failure: $!";
my $UDP_QUERY = IO::Socket::INET -> new ( Proto => "udp" ) || die "Socket failure: $!";

#select is here to allow us to set timeouts on the connections. Otherwise they 
#just 'stop' until a server appears.
#my $select_helo = IO::Select -> new ($UDP_HELO) || die "Select failure: $!";
my $select_query = IO::Select -> new ($UDP_QUERY) || die "Select failure: $!";
my $send_addr ;

#helo needs to be broadcast, but query does not.
#$UDP_HELO -> sockopt(SO_BROADCAST, 1 );
#autoflush both.
#$UDP_HELO -> autoflush(1);
$UDP_QUERY -> autoflush(1);

my ( $color, $line2, $remote_host, $buff, $buff2, $raddr, $rport, $rhost, 
     @remote_response, $master_browser );
#right, run through the %tests hash above, and test each of the machines listed.
foreach my $test_target ( keys ( %tests ) )
{
  $color = "clear";
  $line2 = "";
  if ( $debug ) { print "testing $test_target\n" };
  $buff = "";
  $buff2 = "";
  my $this_test = 0;
  #If the first test fails, (as it sometimes does, UDP being unreliable)
  #then it'll retry up to $test_count times (see at the top).
  while ( $this_test <= $test_count && !$buff ) 
  {
    if ( $debug ) { print "Running test: ", $this_test,"\n" };
    $this_test++;
    #if we have multiple targets, we probe each of them until we get a 
    #response...
    foreach my $destination ( @ { $tests{$test_target}{target} } ) 
    {
      my $UDP_HELO = IO::Socket::INET -> new ( Proto => "udp" ) or die "Socket failure: $!";
      $UDP_HELO -> autoflush(1);
      my $select_helo = IO::Select -> new ( $UDP_HELO ) or die "Select failure: $!";
      my @query_message = @bcast_helo;
      #if we haven't got a response yet, try this one.
      if ( !$buff ) 
      {
        if ( $debug ) { print "Querying $destination for master browser\n"; }
        $send_addr = sockaddr_in("$ica_port", inet_aton("$destination") );
        if ( "$debug" ) { print "sent\n"; }
        if ( $#{ $tests{$test_target}{target} } > 1)
        {
          @query_message = @direct_helo;
        }
        $UDP_HELO -> send ( pack ("C"x $#query_message, @query_message), 0, $send_addr ); 
        if ( $select_helo -> can_read($timeout) )
        {
          $remote_host = $UDP_HELO -> recv($buff, $buffer_size, 0 );
        }
      } # if (!$buff)
    close $UDP_HELO;
    } #foreach destination
  } # if test count loop
  #ok we've looped several times, looking for a response. If we don't have one 
  #yet, we simply mark the whole lot as being unavailable.
  if ( $buff )
  {
    ($rport, $raddr) = sockaddr_in ( $remote_host );
    $rhost = gethostbyaddr ( $raddr, AF_INET );
    my @tmpbuf = unpack ("C" x length($buff), $buff );
    if ( $debug )
    {
      print "$rhost (", unpack("CCCC", $raddr),"):$rport responded with: ",length($buff), " bytes\n";
      foreach (@tmpbuf)
      {
        printf ("%02X ", $_ );
      }
      print "\n";
    } #if debug

    #now we have a response, then we need to figure out the master browser, and 
    #query it for published applications...

    $master_browser = "$tmpbuf[32].$tmpbuf[33].$tmpbuf[34].$tmpbuf[35]";
     
    #ok should probably error check this, because it's remotely possible
    #that a server response might be completely wrong...
      
    $color="green";
    if ( $debug ) { print "Master browser = $master_browser\n" } ;

    $send_addr = sockaddr_in($ica_port, inet_aton("$master_browser") );
    my @query_message;
    if ( $#{ $tests{$test_target}{target} } > 1)
    {
       if ( $debug ) { print "using directed query\n" };
       @query_message = @direct_query_app;
     }
     else
     {
       if ( $debug ) { print "using broadcast query\n" };
       @query_message = @bcast_query_app;
     }
   
    #now we send the appropriate query string, to the master browser we've found.
    $buff = "";
    while ( $this_test <= $test_count && !$buff ) 
    {
      $UDP_QUERY -> send ( pack ("C"x $#query_message, @query_message), 0, $send_addr ); 
      if ( $select_query -> can_read($timeout) )
      {
        $remote_host = $UDP_QUERY -> recv($buff, $buffer_size, 0 );
      }
      #this is icky, because i _most_ situations, there isn't going to be
      #any more data... but we have a server with a LONG published apps list
      #which takes two packets to deliver. Good eh?
      while ( $tests{$test_target}{longlist}-- > 0 &&  $select_query -> can_read($timeout) )
      #if ( $tests{$test_target}{longlist} && $select_query -> can_read($timeout) )
      {
	$UDP_QUERY -> recv($buff2, $buffer_size, 0 );
        if ( $buff2 )
          {
             $buff = join ("", $buff, $buff2);
          }
      }
    } #while test_count
    if ($buff)  #eg if we got a response from a couple of retries of the app query
    {
      ($rport, $raddr) = sockaddr_in ( $remote_host );
      $rhost = gethostbyaddr ( $raddr, AF_INET );
      @tmpbuf = unpack ("C" x length($buff), $buff );
      if ( $debug )
      {
        print "$rhost:$rport responded to app query with: ",length($buff), " bytes\n";
        foreach (@tmpbuf)
        {
          printf ("%02X ",$_ );
        }
        print "\n";
      } #debug

      #now we strip out the icky null chars. This is what makes the pattern
      #matching on the app list less selective. The problem is that some
      #serves return an app list in ASCII, and others return it in unicode...
      #stripping the nulls is the easiest way of converting it to a common format.
      my @newbuf;
      foreach my $value (@tmpbuf)
      {
        if ( $value > 31 )
        { 
          push(@newbuf, $value);
        }
      }
      #now after trashing the nulls, we need to append one as a string terminator.
      push(@newbuf, 0 );
      @tmpbuf=@newbuf;

      my $app_list = join("", pack("C" x $#tmpbuf, @tmpbuf ) );
      if ( $debug ) { print "Recieved list of applications: $app_list\n" };
 
      $line2 = "";
      #yellow first, so a red overrides it...
      foreach my $app (@{$tests{$test_target}{yellow_published_apps}} )
      {
        my $app_test = $app_list;
        if ( $app_test =~ /$app/ )
        {
          $line2 = join ( "", $line2, "         $app is available.\n" );  
        }
        else
        {
          $line2 = join ( "", $line2, "WARNING: $app is unavailable.\n" );
          $color = "yellow";
        }
      } #foreach
      foreach my $app (@{$tests{$test_target}{red_published_apps}} )
      {
        my $app_test = $app_list;
        if ( $app_test =~ /$app/ )
        {
          $line2 = join ( "", "         $app is available.\n", $line2 );
        }
        else
        {
          $line2 = join ( "", "WARNING: $app is unavailable.\n", $line2 );
          $color = "red";
        }
      } #foreach
      sleep $timeout; #because otherwise we can get responses from the WRONG servers. DOH
    } # if ( !$buff)
    else
    {
      $color = "red";
      $line2 = "WARNING: No response from master browser."
    }
    
  } #if !$buff - so we skip this chunk if there was no response from any of our master browsers, since
   #there's not point trying to get an app list...   
  else
  {
    $color = "red";
    $line2 = "WARNING: NO response recieved to discovery messages.\n";
  }   
  my $line ="status $test_target.$tests{$test_target}{testname} $color $date\n";
  $line = join ("", $line, "Response from master browser: $master_browser\n\n",
                    "Citrix Published Applications:\n", $line2 );
  if ( $debug )
  {
    print "$line";
#    `$ENV{'BB'} $ENV{'BBDISP'} \"$line\"`;
  }
  else
  {
    `$ENV{'BB'} $ENV{'BBDISP'} \"$line\"`;
  }
} #foreach
close $UDP_QUERY;