contrib/check_ica_metaframe_pub_apps.pl

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