contrib/check_ica_metaframe_pub_apps.pl

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