contrib/check_citrix

   1 #!/usr/bin/perl -w
   2
   3 # $Id$
   4
   5 # $Log$
   6 # Revision 1.1  2002/11/29 12:02:00  stanleyhopcroft
   7 # New plugin to check the ICA browse service (used by Citrix Metaframe servers) from
   8 # Ed Rolison and Tom De Blende.
   9 #
  10
  11 # Ed Rolison 15/06/02
  12 # ed@nightstalker.net
  13 # If it doesn't work, please let me know, I've only had access to my
  14 # environment so I'm not 100% sure.
  15 #
  16 # If you want to mess around with this script, then please feel free
  17 # to do so.
  18 # However, if you add anything 'funky' then I'd really appreciate
  19 # hearing about it.
  20 #
  21 # Oh, and if you do ever make huge amounts of money out of it, cut me
  22 # in :)
  23
  24 use strict ;
  25
  26 use IO::Socket;
  27 use IO::Select;
  28 use FileHandle;
  29 use Getopt::Long ;
  30
  31 use vars qw($opt_H $opt_B $opt_W $opt_T $debug @citrix_servers $crit_pub_apps $warn_pub_apps $long_list);
  32 use utils qw(%ERRORS &print_revision &support &usage);
  33
  34 my $PROGNAME = 'check_citrix' ;
  35
  36 sub print_help ();
  37 sub print_usage ();
  38 sub help ();
  39 sub version ();
  40
  41 delete @ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
  42
  43 # You might have to change this...
  44
  45 use constant PACKET_TIMEOUT     => 1;
  46                                 # Number of seconds to wait for further UDP packets
  47 use constant TEST_COUNT         => 2;
  48                                 # Number of datagrams sent without reply
  49 use constant BUFFER_SIZE        => 1500;
  50                                 # buffer size used for 'recv' calls.
  51 use constant LONG_LIST          => 0 ;
  52                                 # this is for if you have many published applications.
  53                                 # if you set it, it won't do any harm, but may slow the test
  54                                 # down a little. (Since it does a 'recv' twice instead of
  55                                 # once and therefore may have to wait for a timeout).
  56 use constant ICA_PORT   => 1604;
  57                                 # what port ICA runs on. Unlikely to change.
  58
  59 # End user config.
  60
  61 Getopt::Long::Configure('bundling', 'no_ignore_case');
  62 GetOptions
  63         ("V|version"     => \&version,
  64          "h|help"        => \&help,
  65          "d|debug"       => \$debug,
  66          "B|broadcast_addr:s"   => \$opt_B,
  67          "C|citrix_servers:s"   => \@citrix_servers,
  68          "L|long_list"  => \$long_list,
  69          "P|crit_pub_apps:s"    => \$crit_pub_apps,
  70          "T|Packet_timeout:i"   => \$opt_T,
  71          "W|warn_pub_apps:s"    => \$warn_pub_apps,
  72 ) ;
  73
  74 # configuration section
  75
  76 my $broadcast_addr = $1 if $opt_B and $opt_B =~ m#(\d+\.\d+\.\d+\.\d+)# ;
  77 usage("Invalid broadcast address: $opt_B\n") if $opt_B and not defined($broadcast_addr)  ;
  78
  79 usage("You must provide either the names of citrix servers or the broadcast address of the subnet containing them\n")
  80   unless (@citrix_servers or $broadcast_addr) ;
  81
  82 my @target = defined $broadcast_addr ? ($broadcast_addr) : @citrix_servers ;
  83
  84 usage("You must provide the names of the published applications that the Citrix browser should be advertising\n")
  85   unless $crit_pub_apps or $warn_pub_apps ;
  86
  87 my $Timeout = $opt_T            if defined $opt_T ;
  88 $Timeout = PACKET_TIMEOUT       unless defined $Timeout ;
  89 $long_list = LONG_LIST          unless defined $long_list ;
  90
  91 my @crit_pub_apps = $crit_pub_apps ? split(/,/, $crit_pub_apps) : () ;
  92 my @warn_pub_apps = $warn_pub_apps ? split(/,/, $warn_pub_apps) : () ;
  93
  94 # definitions of query strings. Change at your own risk :)
  95 # this info was gathered with tcpdump whilst trying to use an ICA client,
  96 # so I'm not 100% sure of what each value is.
  97
  98 my @bcast_helo = &tethereal2list(<<'End_of_Tethereal_trace', '1e') ;
  99 0020  ff ff 04 d6 06 44 00 26 4a 76 1e 00 01 30 02 fd   .....D.&Jv...0..
 100 0030  a8 e3 00 02 f5 95 9f f5 30 07 00 00 00 00 00 00   ........0.......
 101 0040  00 00 00 00 00 00 01 00
 102 End_of_Tethereal_trace
 103
 104 my @bcast_query_app = &tethereal2list(<<'End_of_Tethereal_trace', '24') ;
 105 0020  64 17 04 50 06 44 00 2c 85 6a 24 00 01 32 02 fd   d..P.D.,.j$..2..
 106 0030  a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00   ................
 107 0040  00 00 00 00 00 00 21 00 02 00 00 00 00 00         ......!......
 108 End_of_Tethereal_trace
 109
 110 my @direct_helo = &tethereal2list(<<'End_of_Tethereal_trace', '20') ;
 111 0020  64 17 05 0f 06 44 00 28 ab b5 20 00 01 30 02 fd   d....D.(.. ..0..
 112 0030  a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00   ................
 113 0040  00 00 00 00 00 00 00 00 00 00
 114 End_of_Tethereal_trace
 115
 116 my @direct_query_app = &tethereal2list(<<'End_of_Tethereal_trace', '2c') ;
 117 0020  64 17 05 10 06 44 00 34 7a 9a 2c 00 02 32 02 fd   d....D.4z.,..2..
 118 0030  a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00   ................
 119 0040  00 00 00 00 00 00 21 00 02 00 01 00 00 00 00 00   ......!.........
 120 0050  00 00 00 00 00 00
 121 End_of_Tethereal_trace
 122
 123 my $Udp =  IO::Socket::INET->new( Proto => 'udp' ) || die "Socket failure: $!";
 124
 125 # select is here to allow us to set timeouts on the connections.  Otherwise they
 126 # just 'stop' until a server appears.
 127
 128 my $select =  IO::Select->new($Udp) || die "Select failure: $!";
 129
 130 # helo needs to be broadcast, but query does not.
 131
 132 $Udp->sockopt(SO_BROADCAST, 1 );
 133 $Udp->autoflush(1);
 134
 135 my ($remote_host, $buff, $buff2, $raddr, $rport, $rhost, @remote_response);
 136 my (@query_message, $send_addr, $this_test) ;
 137
 138 $buff = $buff2 = '';
 139 $this_test = 0;
 140
 141 # If there is no response to the first helo packet it will be resent
 142 # up to TEST_COUNT (see at the top).
 143
 144 while ( ++$this_test <= TEST_COUNT && !$buff ) {
 145
 146   print "Sending helo datagram. datagram number: ", $this_test, "\n" if $debug ;
 147
 148   # if we have multiple targets, we probe each of them until we get a
 149   # response...
 150
 151   foreach my $destination (@target) {
 152      @query_message = ( $broadcast_addr ? @bcast_helo : @direct_helo) ;
 153      print "Querying $destination for master browser\n" if  $debug  ;
 154      $send_addr = sockaddr_in(ICA_PORT, inet_aton($destination) );
 155      &dump(pack('C*', @query_message)) if $debug ;
 156      $Udp->send( pack('C*', @query_message), 0, $send_addr );
 157      if ( $select->can_read($Timeout) ) {
 158        $remote_host = $Udp->recv($buff, BUFFER_SIZE, 0 );
 159      }
 160
 161      last if $buff ;
 162      sleep 1 ;
 163
 164   } # foreach destination
 165 } # while loop
 166
 167 # ok we've looped several times, looking for a response. If we don't have one
 168 # yet, we simply mark the whole lot as being unavailable.
 169
 170 unless ( $buff ) {
 171   print "Failed. No response to helo datagram (master browser query) from ", $broadcast_addr ? $broadcast_addr : "@citrix_servers", ".\n" ;
 172   exit $ERRORS{CRITICAL} ;
 173 }
 174
 175 ($rport, $raddr) = sockaddr_in( $remote_host );
 176 $rhost = gethostbyaddr( $raddr, AF_INET );
 177 my @tmpbuf = unpack('C*', $buff );
 178 if ( $debug ) {
 179   print "$rhost:$rport responded with: ",length($buff), " bytes\n";
 180   &dump($buff) ;
 181 } #if debug
 182
 183 # now we have a response, then we need to figure out the master browser, and
 184 # query it for published applications...
 185
 186 my $master_browser = join '.', @tmpbuf[32..35] ;
 187
 188 # ok should probably error check this, because it's remotely possible
 189 # that a server response might be completely wrong...
 190
 191 print "Master browser = $master_browser\n" if  $debug ;
 192
 193 $send_addr = sockaddr_in(ICA_PORT, inet_aton($master_browser));
 194
 195 if ( $broadcast_addr ) {
 196   print "using broadcast query\n" if $debug ;
 197   @query_message = @bcast_query_app;
 198 } else {
 199   print "using directed query\n" if $debug ;
 200   @query_message = @direct_query_app;
 201 }
 202
 203 # now we send the appropriate query string, to the master browser we've found.
 204
 205 $buff = '';
 206 $this_test = 0 ;
 207
 208 print "Querying master browser for published application list\n" if  $debug  ;
 209
 210 while ( ++$this_test <= TEST_COUNT && !$buff ) {
 211   print "Sending application query datagram.  datagram number: ", $this_test, "\n" if $debug ;
 212   &dump(pack('C*', @query_message)) if $debug ;
 213   $Udp->send( pack ('C*', @query_message), 0, $send_addr );
 214
 215   if ( $select->can_read($Timeout) ) {
 216     $remote_host = $Udp->recv($buff, BUFFER_SIZE, 0 );
 217     # $buff = substr($buff, 32) ;
 218                                                 # Hope that ICA preamble is first 32 bytes
 219    }
 220
 221   # long application lists are delivered in multiple packets
 222
 223   my $buff2 = '' ;
 224   while ( $long_list && $select->can_read($Timeout) ) {
 225     $remote_host = $Udp->recv($buff2, BUFFER_SIZE, 0 );
 226     $buff .= $buff2 if $buff2 ;
 227     # $buff .= substr($buff2, 32) if $buff2 ;
 228                                                 # Hope that ICA preamble is first 32 bytes
 229   }
 230
 231   last if $buff ;
 232   sleep 1 ;
 233
 234 } # while test_count
 235
 236 unless ( $buff ) {
 237   print "Failed. No response to application query datagram from ", $master_browser, ".\n" ;
 238   exit $ERRORS{CRITICAL} ;
 239 }
 240
 241 # we got a response from a couple of retries of the app query
 242
 243 ($rport, $raddr) = sockaddr_in ( $remote_host );
 244 $rhost = gethostbyaddr ( $raddr, AF_INET );
 245 if ( $debug ) {
 246   print "$rhost:$rport responded to app query with: ",length($buff), " bytes\n";
 247   &dump($buff) ;
 248 } #debug
 249
 250 my $app_list = $buff ;
 251                                                 # delete nulls in unicode
 252                                                 # but only if there is unicode (usually from
 253                                                 # broadcast query)
 254
 255 $app_list =~ s/(?:(\w| |-)\x00)/$1/g
 256   if $app_list =~ /(?:(?:(?:\w| |-)\x00){3,})/ ;
 257                                                 # FIXME an application name is
 258                                                 # 3 or more unicoded characters
 259
 260                                                 # FIXME locale
 261                                                 # extract null terminated strings
 262
 263 my (@clean_app_list, $clean_app_list) ;
 264 $clean_app_list = join(',', @clean_app_list = $app_list =~ m#([A-Za-z](?:\w| |-|[ÄÖÜäöüß])+?(?=\x00))#g ) ;
 265
 266                                                 # patch for German umlauts et al from Herr Mike Gerber.
 267
 268 # $clean_app_list = join(',', @clean_app_list = $app_list =~ m#([A-Z](?:\w| |-)+?(?=\x00))#g ) ;
 269
 270                                                 # FIXME everyones apps don't start with caps
 271
 272 print qq(Received list of applications: "$clean_app_list".\n) if $debug ;
 273
 274 if ( scalar @crit_pub_apps and my @missing = &simple_diff(\@clean_app_list, \@crit_pub_apps) ) {
 275   print qq(Failed. "@missing" not found in list of published applications),
 276         qq( "$clean_app_list" from master browser "$master_browser".\n) ;
 277   exit $ERRORS{CRITICAL} ;
 278 }
 279
 280 if ( my @missing = &simple_diff(\@clean_app_list, \@warn_pub_apps) ) {
 281   print qq(Warning. "@missing" not found in list of published applications),
 282         qq( "$clean_app_list" from master browser "$master_browser".\n) ;
 283   exit $ERRORS{WARNING} ;
 284 }
 285
 286 my @x = (@crit_pub_apps, @warn_pub_apps) ;
 287 my $blah = ( scalar(@x) == 1 ? 'the published application "' . join(',', @x) . '" is available' :
 288                                'the published applications "' . join(',', @x) . '" are available' ) ;
 289
 290 print qq(Ok. Citrix master browser "$master_browser" reported that $blah.\n) ;
 291 exit $ERRORS{OK} ;
 292
 293 # sleep $Timeout;
 294                                                 # because otherwise we can get responses from
 295                                                 # the WRONG servers. DOH
 296 close $Udp;
 297
 298
 299 sub print_usage () {
 300         print "Usage: $PROGNAME (-B <broadcast_address>| -C <citrix_server>..) -W <pub_app1,pub_app2..> -P <pub_app1,pub_app2,>\n";
 301 }
 302
 303 sub print_help () {
 304         print_revision($PROGNAME,'$Revision$ ');
 305         print "Copyright (c) 2002 Ed Rolison/Tom De Blende/Karl DeBisschop/S Hopcroft
 306
 307 Perl Check Citrix plugin for NetSaint.
 308
 309 Returns OK if the Citrix master browser returns  a 'published application' list that contain names specified by the -W or -P options
 310
 311 The plugin works by
 312   If the -B option is specified, sending a broadcast helo to find the address of the Citrix master browser in the specified subnet.
 313     return critical if there is no reply;
 314   Else if the -C option is specified
 315     send a direct helo to the specified server until there is a response (containing the address of the Citrix master browser)
 316
 317   Query the master browser (using a 'broadcast published applications query ' if -B) and compare the published applications returned
 318     to those specified by -W and -P options
 319
 320   return Critical if the published applications specified by -P is not a subset of the query responses;
 321   return Warning  if the published applications specified by -W is not a subset of the query responses;
 322   return OK
 323
 324 ";
 325         print_usage();
 326         print '
 327 -B, --broadcast_address=STRING
 328    The broadcast address that should contain Citrix master browser. This option takes precedence over -C.
 329 -C, --citrix_server:STRING
 330    Optional __name(s)__ of Citrix servers that could be the master browser (used when broadcast not possible).
 331 -L, --long_list
 332    Set this if you have heaps of published applications (ie more than will fit in _one_ UDP packet)
 333 -P, --crit_published_app=STRING
 334    Optional comma separated list of published application that must be in the response from the master browser.
 335    Check returns critical otherwise.
 336 -T, --packet-timeout:INTEGER
 337    Time to wait for UDP packets (default 1 sec).
 338 -W, --warn_published_app=STRING
 339    Optional comma separated list of published application that should be in the response from the master browser.
 340    Check returns warning otherwise.
 341 -d, --debug
 342    Debugging output.
 343 -h, --help
 344    This stuff.
 345
 346 ';
 347         support();
 348 }
 349
 350 sub version () {
 351         print_revision($PROGNAME,'$Revision$ ');
 352         exit $ERRORS{'OK'};
 353 }
 354
 355 sub help () {
 356         print_help();
 357         exit $ERRORS{'OK'};
 358 }
 359
 360 sub dump {
 361   my ($x) = shift @_ ;
 362   my (@x, @y, $y, $i, $rowcount) ;
 363   my ($nr, $j, $number_in_row, $number_of_bytes) ;
 364   my $dump ;
 365
 366   $number_in_row = 16 ;
 367   $number_of_bytes = length $x ;
 368   $nr = 0 ;
 369
 370   # styled on tethereal.
 371
 372   foreach $j (1 .. int( $number_of_bytes / $number_in_row) ) {
 373     $y = substr($x, ($j - 1)*$number_in_row, $number_in_row) ;
 374     @y = unpack("C*", $y) ;
 375     $y =~ tr /\x00-\x19/./ ;
 376     $rowcount = sprintf("%4.4x", ($j - 1) * 0x10 ) ;
 377     $dump .= sprintf "%s  %s   %s\n", $rowcount, join(" ", map { sprintf "%2.2x", $_} @y), $y ;
 378     $nr++ ;
 379   }
 380
 381   if ( $number_of_bytes % $number_in_row > 0 ) {
 382     my $spaces_to_text = $number_in_row * 3 - 1 + 3 ;
 383     $rowcount = sprintf("%4.4x", $nr * 0x10 ) ;
 384     $y = substr($x, $nr * $number_in_row ) ;
 385     @y = unpack("C*", $y) ;
 386     my $bytes = join(" ", map { sprintf "%2.2x", $_} @y) ;
 387     my $spaces = ' ' x ($spaces_to_text - length($bytes)) ;
 388     $dump .= sprintf "%s  %s%s%s\n", $rowcount, $bytes, $spaces, $y ;
 389   }
 390
 391   print $dump, "\n" ;
 392
 393 }
 394
 395 sub tethereal2list {
 396   my ($tethereal_dump, $start_byte) = @_ ;
 397
 398   # return an array containing qw(0xef 0xab 0x00 ...) from a tethereal trace.
 399   # skip all stuff until the first byte given by $start_byte.
 400
 401   return undef unless $tethereal_dump =~ /\d\d\d\d  \S\S(?: \S\S){1,15}/ ;
 402
 403   my $hex_start_byte = hex($start_byte) ;
 404   my @x = $tethereal_dump =~ m#(.+)#g ;
 405   my @y = map unpack("x6 a47", $_), @x ;
 406   my @z = map { my $y = $_; $y =~ s/(\S\S)/hex($1)/eg; my @a = split(' ', $y); @a  } @y ;
 407   shift @z, while $z[0] ne $hex_start_byte ;
 408
 409   @z ;
 410
 411 }
 412
 413 sub simple_diff {
 414
 415   my ( $a_list, $b_list) = @_ ;
 416
 417   # simple set difference 'Recipe 4.7 Perl Cookbook', Christiansen and Torkington
 418
 419   my (%seen, @missing) ;
 420
 421   @seen{@$a_list} = () ;
 422
 423   foreach my $item (@$b_list) {
 424     push @missing, $item unless exists $seen{$item} ;
 425   }
 426
 427   @missing ;
 428 }
 429
 430
 431