summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xcontrib/check_citrix431
1 files changed, 431 insertions, 0 deletions
diff --git a/contrib/check_citrix b/contrib/check_citrix
new file mode 100755
index 0000000..42d582e
--- /dev/null
+++ b/contrib/check_citrix
@@ -0,0 +1,431 @@
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
24use strict ;
25
26use IO::Socket;
27use IO::Select;
28use FileHandle;
29use Getopt::Long ;
30
31use vars qw($opt_H $opt_B $opt_W $opt_T $debug @citrix_servers $crit_pub_apps $warn_pub_apps $long_list);
32use utils qw(%ERRORS &print_revision &support &usage);
33
34my $PROGNAME = 'check_citrix' ;
35
36sub print_help ();
37sub print_usage ();
38sub help ();
39sub version ();
40
41delete @ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
42
43# You might have to change this...
44
45use constant PACKET_TIMEOUT => 1;
46 # Number of seconds to wait for further UDP packets
47use constant TEST_COUNT => 2;
48 # Number of datagrams sent without reply
49use constant BUFFER_SIZE => 1500;
50 # buffer size used for 'recv' calls.
51use 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).
56use constant ICA_PORT => 1604;
57 # what port ICA runs on. Unlikely to change.
58
59# End user config.
60
61Getopt::Long::Configure('bundling', 'no_ignore_case');
62GetOptions
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
76my $broadcast_addr = $1 if $opt_B and $opt_B =~ m#(\d+\.\d+\.\d+\.\d+)# ;
77usage("Invalid broadcast address: $opt_B\n") if $opt_B and not defined($broadcast_addr) ;
78
79usage("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
82my @target = defined $broadcast_addr ? ($broadcast_addr) : @citrix_servers ;
83
84usage("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
87my $Timeout = $opt_T if defined $opt_T ;
88$Timeout = PACKET_TIMEOUT unless defined $Timeout ;
89$long_list = LONG_LIST unless defined $long_list ;
90
91my @crit_pub_apps = $crit_pub_apps ? split(/,/, $crit_pub_apps) : () ;
92my @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
98my @bcast_helo = &tethereal2list(<<'End_of_Tethereal_trace', '1e') ;
990020 ff ff 04 d6 06 44 00 26 4a 76 1e 00 01 30 02 fd .....D.&Jv...0..
1000030 a8 e3 00 02 f5 95 9f f5 30 07 00 00 00 00 00 00 ........0.......
1010040 00 00 00 00 00 00 01 00
102End_of_Tethereal_trace
103
104my @bcast_query_app = &tethereal2list(<<'End_of_Tethereal_trace', '24') ;
1050020 64 17 04 50 06 44 00 2c 85 6a 24 00 01 32 02 fd d..P.D.,.j$..2..
1060030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
1070040 00 00 00 00 00 00 21 00 02 00 00 00 00 00 ......!......
108End_of_Tethereal_trace
109
110my @direct_helo = &tethereal2list(<<'End_of_Tethereal_trace', '20') ;
1110020 64 17 05 0f 06 44 00 28 ab b5 20 00 01 30 02 fd d....D.(.. ..0..
1120030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
1130040 00 00 00 00 00 00 00 00 00 00
114End_of_Tethereal_trace
115
116my @direct_query_app = &tethereal2list(<<'End_of_Tethereal_trace', '2c') ;
1170020 64 17 05 10 06 44 00 34 7a 9a 2c 00 02 32 02 fd d....D.4z.,..2..
1180030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
1190040 00 00 00 00 00 00 21 00 02 00 01 00 00 00 00 00 ......!.........
1200050 00 00 00 00 00 00
121End_of_Tethereal_trace
122
123my $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
128my $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
135my ($remote_host, $buff, $buff2, $raddr, $rport, $rhost, @remote_response);
136my (@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
144while ( ++$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
170unless ( $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 );
177my @tmpbuf = unpack('C*', $buff );
178if ( $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
186my $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
191print "Master browser = $master_browser\n" if $debug ;
192
193$send_addr = sockaddr_in(ICA_PORT, inet_aton($master_browser));
194
195if ( $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
208print "Querying master browser for published application list\n" if $debug ;
209
210while ( ++$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
236unless ( $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 );
245if ( $debug ) {
246 print "$rhost:$rport responded to app query with: ",length($buff), " bytes\n";
247 &dump($buff) ;
248} #debug
249
250my $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
263my (@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
272print qq(Received list of applications: "$clean_app_list".\n) if $debug ;
273
274if ( 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
280if ( 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
286my @x = (@crit_pub_apps, @warn_pub_apps) ;
287my $blah = ( scalar(@x) == 1 ? 'the published application "' . join(',', @x) . '" is available' :
288 'the published applications "' . join(',', @x) . '" are available' ) ;
289
290print qq(Ok. Citrix master browser "$master_browser" reported that $blah.\n) ;
291exit $ERRORS{OK} ;
292
293# sleep $Timeout;
294 # because otherwise we can get responses from
295 # the WRONG servers. DOH
296close $Udp;
297
298
299sub 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
303sub print_help () {
304 print_revision($PROGNAME,'$Revision$ ');
305 print "Copyright (c) 2002 Ed Rolison/Tom De Blende/Karl DeBisschop/S Hopcroft
306
307Perl Check Citrix plugin for NetSaint.
308
309Returns OK if the Citrix master browser returns a 'published application' list that contain names specified by the -W or -P options
310
311The 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
350sub version () {
351 print_revision($PROGNAME,'$Revision$ ');
352 exit $ERRORS{'OK'};
353}
354
355sub help () {
356 print_help();
357 exit $ERRORS{'OK'};
358}
359
360sub 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
395sub 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
413sub 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