diff options
Diffstat (limited to 'contrib/check_citrix')
| -rwxr-xr-x | contrib/check_citrix | 431 |
1 files changed, 0 insertions, 431 deletions
diff --git a/contrib/check_citrix b/contrib/check_citrix deleted file mode 100755 index 42d582eb..00000000 --- a/contrib/check_citrix +++ /dev/null @@ -1,431 +0,0 @@ -#!/usr/bin/perl -w - -# $Id$ - -# $Log$ -# Revision 1.1 2002/11/29 12:02:00 stanleyhopcroft -# New plugin to check the ICA browse service (used by Citrix Metaframe servers) from -# Ed Rolison and Tom De Blende. -# - -# 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. -# -# 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 :) - -use strict ; - -use IO::Socket; -use IO::Select; -use FileHandle; -use Getopt::Long ; - -use vars qw($opt_H $opt_B $opt_W $opt_T $debug @citrix_servers $crit_pub_apps $warn_pub_apps $long_list); -use utils qw(%ERRORS &print_revision &support &usage); - -my $PROGNAME = 'check_citrix' ; - -sub print_help (); -sub print_usage (); -sub help (); -sub version (); - -delete @ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; - -# You might have to change this... - -use constant PACKET_TIMEOUT => 1; - # Number of seconds to wait for further UDP packets -use constant TEST_COUNT => 2; - # Number of datagrams sent without reply -use constant BUFFER_SIZE => 1500; - # buffer size used for 'recv' calls. -use constant LONG_LIST => 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). -use constant ICA_PORT => 1604; - # what port ICA runs on. Unlikely to change. - -# End user config. - -Getopt::Long::Configure('bundling', 'no_ignore_case'); -GetOptions - ("V|version" => \&version, - "h|help" => \&help, - "d|debug" => \$debug, - "B|broadcast_addr:s" => \$opt_B, - "C|citrix_servers:s" => \@citrix_servers, - "L|long_list" => \$long_list, - "P|crit_pub_apps:s" => \$crit_pub_apps, - "T|Packet_timeout:i" => \$opt_T, - "W|warn_pub_apps:s" => \$warn_pub_apps, -) ; - -# configuration section - -my $broadcast_addr = $1 if $opt_B and $opt_B =~ m#(\d+\.\d+\.\d+\.\d+)# ; -usage("Invalid broadcast address: $opt_B\n") if $opt_B and not defined($broadcast_addr) ; - -usage("You must provide either the names of citrix servers or the broadcast address of the subnet containing them\n") - unless (@citrix_servers or $broadcast_addr) ; - -my @target = defined $broadcast_addr ? ($broadcast_addr) : @citrix_servers ; - -usage("You must provide the names of the published applications that the Citrix browser should be advertising\n") - unless $crit_pub_apps or $warn_pub_apps ; - -my $Timeout = $opt_T if defined $opt_T ; -$Timeout = PACKET_TIMEOUT unless defined $Timeout ; -$long_list = LONG_LIST unless defined $long_list ; - -my @crit_pub_apps = $crit_pub_apps ? split(/,/, $crit_pub_apps) : () ; -my @warn_pub_apps = $warn_pub_apps ? split(/,/, $warn_pub_apps) : () ; - -# 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 @bcast_helo = &tethereal2list(<<'End_of_Tethereal_trace', '1e') ; -0020 ff ff 04 d6 06 44 00 26 4a 76 1e 00 01 30 02 fd .....D.&Jv...0.. -0030 a8 e3 00 02 f5 95 9f f5 30 07 00 00 00 00 00 00 ........0....... -0040 00 00 00 00 00 00 01 00 -End_of_Tethereal_trace - -my @bcast_query_app = &tethereal2list(<<'End_of_Tethereal_trace', '24') ; -0020 64 17 04 50 06 44 00 2c 85 6a 24 00 01 32 02 fd d..P.D.,.j$..2.. -0030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ -0040 00 00 00 00 00 00 21 00 02 00 00 00 00 00 ......!...... -End_of_Tethereal_trace - -my @direct_helo = &tethereal2list(<<'End_of_Tethereal_trace', '20') ; -0020 64 17 05 0f 06 44 00 28 ab b5 20 00 01 30 02 fd d....D.(.. ..0.. -0030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ -0040 00 00 00 00 00 00 00 00 00 00 -End_of_Tethereal_trace - -my @direct_query_app = &tethereal2list(<<'End_of_Tethereal_trace', '2c') ; -0020 64 17 05 10 06 44 00 34 7a 9a 2c 00 02 32 02 fd d....D.4z.,..2.. -0030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................ -0040 00 00 00 00 00 00 21 00 02 00 01 00 00 00 00 00 ......!......... -0050 00 00 00 00 00 00 -End_of_Tethereal_trace - -my $Udp = 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 = IO::Select->new($Udp) || die "Select failure: $!"; - -# helo needs to be broadcast, but query does not. - -$Udp->sockopt(SO_BROADCAST, 1 ); -$Udp->autoflush(1); - -my ($remote_host, $buff, $buff2, $raddr, $rport, $rhost, @remote_response); -my (@query_message, $send_addr, $this_test) ; - -$buff = $buff2 = ''; -$this_test = 0; - -# If there is no response to the first helo packet it will be resent -# up to TEST_COUNT (see at the top). - -while ( ++$this_test <= TEST_COUNT && !$buff ) { - - print "Sending helo datagram. datagram number: ", $this_test, "\n" if $debug ; - - # if we have multiple targets, we probe each of them until we get a - # response... - - foreach my $destination (@target) { - @query_message = ( $broadcast_addr ? @bcast_helo : @direct_helo) ; - print "Querying $destination for master browser\n" if $debug ; - $send_addr = sockaddr_in(ICA_PORT, inet_aton($destination) ); - &dump(pack('C*', @query_message)) if $debug ; - $Udp->send( pack('C*', @query_message), 0, $send_addr ); - if ( $select->can_read($Timeout) ) { - $remote_host = $Udp->recv($buff, BUFFER_SIZE, 0 ); - } - - last if $buff ; - sleep 1 ; - - } # foreach destination -} # while 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. - -unless ( $buff ) { - print "Failed. No response to helo datagram (master browser query) from ", $broadcast_addr ? $broadcast_addr : "@citrix_servers", ".\n" ; - exit $ERRORS{CRITICAL} ; -} - -($rport, $raddr) = sockaddr_in( $remote_host ); -$rhost = gethostbyaddr( $raddr, AF_INET ); -my @tmpbuf = unpack('C*', $buff ); -if ( $debug ) { - print "$rhost:$rport responded with: ",length($buff), " bytes\n"; - &dump($buff) ; -} #if debug - -# now we have a response, then we need to figure out the master browser, and -# query it for published applications... - -my $master_browser = join '.', @tmpbuf[32..35] ; - -# ok should probably error check this, because it's remotely possible -# that a server response might be completely wrong... - -print "Master browser = $master_browser\n" if $debug ; - -$send_addr = sockaddr_in(ICA_PORT, inet_aton($master_browser)); - -if ( $broadcast_addr ) { - print "using broadcast query\n" if $debug ; - @query_message = @bcast_query_app; -} else { - print "using directed query\n" if $debug ; - @query_message = @direct_query_app; -} - -# now we send the appropriate query string, to the master browser we've found. - -$buff = ''; -$this_test = 0 ; - -print "Querying master browser for published application list\n" if $debug ; - -while ( ++$this_test <= TEST_COUNT && !$buff ) { - print "Sending application query datagram. datagram number: ", $this_test, "\n" if $debug ; - &dump(pack('C*', @query_message)) if $debug ; - $Udp->send( pack ('C*', @query_message), 0, $send_addr ); - - if ( $select->can_read($Timeout) ) { - $remote_host = $Udp->recv($buff, BUFFER_SIZE, 0 ); - # $buff = substr($buff, 32) ; - # Hope that ICA preamble is first 32 bytes - } - - # long application lists are delivered in multiple packets - - my $buff2 = '' ; - while ( $long_list && $select->can_read($Timeout) ) { - $remote_host = $Udp->recv($buff2, BUFFER_SIZE, 0 ); - $buff .= $buff2 if $buff2 ; - # $buff .= substr($buff2, 32) if $buff2 ; - # Hope that ICA preamble is first 32 bytes - } - - last if $buff ; - sleep 1 ; - -} # while test_count - -unless ( $buff ) { - print "Failed. No response to application query datagram from ", $master_browser, ".\n" ; - exit $ERRORS{CRITICAL} ; -} - -# we got a response from a couple of retries of the app query - -($rport, $raddr) = sockaddr_in ( $remote_host ); -$rhost = gethostbyaddr ( $raddr, AF_INET ); -if ( $debug ) { - print "$rhost:$rport responded to app query with: ",length($buff), " bytes\n"; - &dump($buff) ; -} #debug - -my $app_list = $buff ; - # delete nulls in unicode - # but only if there is unicode (usually from - # broadcast query) - -$app_list =~ s/(?:(\w| |-)\x00)/$1/g - if $app_list =~ /(?:(?:(?:\w| |-)\x00){3,})/ ; - # FIXME an application name is - # 3 or more unicoded characters - - # FIXME locale - # extract null terminated strings - -my (@clean_app_list, $clean_app_list) ; -$clean_app_list = join(',', @clean_app_list = $app_list =~ m#([A-Za-z](?:\w| |-|[ÄÖÜäöüß])+?(?=\x00))#g ) ; - - # patch for German umlauts et al from Herr Mike Gerber. - -# $clean_app_list = join(',', @clean_app_list = $app_list =~ m#([A-Z](?:\w| |-)+?(?=\x00))#g ) ; - - # FIXME everyones apps don't start with caps - -print qq(Received list of applications: "$clean_app_list".\n) if $debug ; - -if ( scalar @crit_pub_apps and my @missing = &simple_diff(\@clean_app_list, \@crit_pub_apps) ) { - print qq(Failed. "@missing" not found in list of published applications), - qq( "$clean_app_list" from master browser "$master_browser".\n) ; - exit $ERRORS{CRITICAL} ; -} - -if ( my @missing = &simple_diff(\@clean_app_list, \@warn_pub_apps) ) { - print qq(Warning. "@missing" not found in list of published applications), - qq( "$clean_app_list" from master browser "$master_browser".\n) ; - exit $ERRORS{WARNING} ; -} - -my @x = (@crit_pub_apps, @warn_pub_apps) ; -my $blah = ( scalar(@x) == 1 ? 'the published application "' . join(',', @x) . '" is available' : - 'the published applications "' . join(',', @x) . '" are available' ) ; - -print qq(Ok. Citrix master browser "$master_browser" reported that $blah.\n) ; -exit $ERRORS{OK} ; - -# sleep $Timeout; - # because otherwise we can get responses from - # the WRONG servers. DOH -close $Udp; - - -sub print_usage () { - print "Usage: $PROGNAME (-B <broadcast_address>| -C <citrix_server>..) -W <pub_app1,pub_app2..> -P <pub_app1,pub_app2,>\n"; -} - -sub print_help () { - print_revision($PROGNAME,'$Revision$ '); - print "Copyright (c) 2002 Ed Rolison/Tom De Blende/Karl DeBisschop/S Hopcroft - -Perl Check Citrix plugin for NetSaint. - -Returns OK if the Citrix master browser returns a 'published application' list that contain names specified by the -W or -P options - -The plugin works by - If the -B option is specified, sending a broadcast helo to find the address of the Citrix master browser in the specified subnet. - return critical if there is no reply; - Else if the -C option is specified - send a direct helo to the specified server until there is a response (containing the address of the Citrix master browser) - - Query the master browser (using a 'broadcast published applications query ' if -B) and compare the published applications returned - to those specified by -W and -P options - - return Critical if the published applications specified by -P is not a subset of the query responses; - return Warning if the published applications specified by -W is not a subset of the query responses; - return OK - -"; - print_usage(); - print ' --B, --broadcast_address=STRING - The broadcast address that should contain Citrix master browser. This option takes precedence over -C. --C, --citrix_server:STRING - Optional __name(s)__ of Citrix servers that could be the master browser (used when broadcast not possible). --L, --long_list - Set this if you have heaps of published applications (ie more than will fit in _one_ UDP packet) --P, --crit_published_app=STRING - Optional comma separated list of published application that must be in the response from the master browser. - Check returns critical otherwise. --T, --packet-timeout:INTEGER - Time to wait for UDP packets (default 1 sec). --W, --warn_published_app=STRING - Optional comma separated list of published application that should be in the response from the master browser. - Check returns warning otherwise. --d, --debug - Debugging output. --h, --help - This stuff. - -'; - support(); -} - -sub version () { - print_revision($PROGNAME,'$Revision$ '); - exit $ERRORS{'OK'}; -} - -sub help () { - print_help(); - exit $ERRORS{'OK'}; -} - -sub dump { - my ($x) = shift @_ ; - my (@x, @y, $y, $i, $rowcount) ; - my ($nr, $j, $number_in_row, $number_of_bytes) ; - my $dump ; - - $number_in_row = 16 ; - $number_of_bytes = length $x ; - $nr = 0 ; - - # styled on tethereal. - - foreach $j (1 .. int( $number_of_bytes / $number_in_row) ) { - $y = substr($x, ($j - 1)*$number_in_row, $number_in_row) ; - @y = unpack("C*", $y) ; - $y =~ tr /\x00-\x19/./ ; - $rowcount = sprintf("%4.4x", ($j - 1) * 0x10 ) ; - $dump .= sprintf "%s %s %s\n", $rowcount, join(" ", map { sprintf "%2.2x", $_} @y), $y ; - $nr++ ; - } - - if ( $number_of_bytes % $number_in_row > 0 ) { - my $spaces_to_text = $number_in_row * 3 - 1 + 3 ; - $rowcount = sprintf("%4.4x", $nr * 0x10 ) ; - $y = substr($x, $nr * $number_in_row ) ; - @y = unpack("C*", $y) ; - my $bytes = join(" ", map { sprintf "%2.2x", $_} @y) ; - my $spaces = ' ' x ($spaces_to_text - length($bytes)) ; - $dump .= sprintf "%s %s%s%s\n", $rowcount, $bytes, $spaces, $y ; - } - - print $dump, "\n" ; - -} - -sub tethereal2list { - my ($tethereal_dump, $start_byte) = @_ ; - - # return an array containing qw(0xef 0xab 0x00 ...) from a tethereal trace. - # skip all stuff until the first byte given by $start_byte. - - return undef unless $tethereal_dump =~ /\d\d\d\d \S\S(?: \S\S){1,15}/ ; - - my $hex_start_byte = hex($start_byte) ; - my @x = $tethereal_dump =~ m#(.+)#g ; - my @y = map unpack("x6 a47", $_), @x ; - my @z = map { my $y = $_; $y =~ s/(\S\S)/hex($1)/eg; my @a = split(' ', $y); @a } @y ; - shift @z, while $z[0] ne $hex_start_byte ; - - @z ; - -} - -sub simple_diff { - - my ( $a_list, $b_list) = @_ ; - - # simple set difference 'Recipe 4.7 Perl Cookbook', Christiansen and Torkington - - my (%seen, @missing) ; - - @seen{@$a_list} = () ; - - foreach my $item (@$b_list) { - push @missing, $item unless exists $seen{$item} ; - } - - @missing ; -} - - - |