summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xcontrib/check_ica_metaframe_pub_apps.pl382
1 files changed, 382 insertions, 0 deletions
diff --git a/contrib/check_ica_metaframe_pub_apps.pl b/contrib/check_ica_metaframe_pub_apps.pl
new file mode 100755
index 0000000..cc1325b
--- /dev/null
+++ b/contrib/check_ica_metaframe_pub_apps.pl
@@ -0,0 +1,382 @@
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
13use strict ;
14
15use IO::Socket;
16use IO::Select;
17use Getopt::Long ;
18
19my ($bcast_addr, $timeout, $debug, @citrix_servers, $crit_pub_apps, $warn_pub_apps, $long_list) ;
20
21use lib qw(/usr/local/nagios/libexec) ;
22use utils qw(%ERRORS &print_revision &support &usage) ;
23use packet_utils qw(&pdump &tethereal) ;
24
25my $PROGNAME = 'check_ica_metaframe_pub_apps' ;
26
27sub print_help ();
28sub print_usage ();
29sub help ();
30sub version ();
31
32 # You might have to change this...
33
34my $PACKET_TIMEOUT = 1;
35 # Number of seconds to wait for further UDP packets
36my $TEST_COUNT = 2;
37# Number of datagrams sent without reply
38my $BUFFER_SIZE = 1500;
39 # buffer size used for 'recv' calls.
40my $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).
45my $ICA_PORT = 1604;
46 # what port ICA runs on. Unlikely to change.
47
48Getopt::Long::Configure('bundling', 'no_ignore_case');
49GetOptions
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
62my $broadcast_addr = $1 if $bcast_addr and $bcast_addr =~ m#(\d+\.\d+\.\d+\.\d+)# ;
63usage("Invalid broadcast address: $bcast_addr\n")
64 if $bcast_addr and not defined($broadcast_addr) ;
65
66usage("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
69my @target = defined $broadcast_addr ? ($broadcast_addr) : @citrix_servers ;
70
71usage("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
74my $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
81my @crit_pub_apps = $crit_pub_apps ? split(/,/, $crit_pub_apps) : () ;
82my @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
88my $bcast_helo = &tethereal(<<'End_of_Tethereal_trace', '1e') ;
890020 ff ff 04 d6 06 44 00 26 4a 76 1e 00 01 30 02 fd .....D.&Jv...0..
900030 a8 e3 00 02 f5 95 9f f5 30 07 00 00 00 00 00 00 ........0.......
910040 00 00 00 00 00 00 01 00 .......
92End_of_Tethereal_trace
93
94my $bcast_query_app = &tethereal(<<'End_of_Tethereal_trace', '24') ;
950020 64 17 04 50 06 44 00 2c 85 6a 24 00 01 32 02 fd d..P.D.,.j$..2..
960030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
970040 00 00 00 00 00 00 21 00 02 00 00 00 00 00 ......!......
98End_of_Tethereal_trace
99
100my $direct_helo = &tethereal(<<'End_of_Tethereal_trace', '20') ;
1010020 64 17 05 0f 06 44 00 28 ab b5 20 00 01 30 02 fd d....D.(.. ..0..
1020030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
1030040 00 00 00 00 00 00 00 00 00 00 .........
104End_of_Tethereal_trace
105
106my $direct_query_app = &tethereal(<<'End_of_Tethereal_trace', '2c') ;
1070020 64 17 05 10 06 44 00 34 7a 9a 2c 00 02 32 02 fd d....D.4z.,..2..
1080030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
1090040 00 00 00 00 00 00 21 00 02 00 01 00 00 00 00 00 ......!.........
1100050 00 00 00 00 00 00 ......
111End_of_Tethereal_trace
112
113my $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
119my $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
124my ($remote_host, $buff, $buff2, $raddr, $rport, $rhost, @remote_response);
125my ($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
133while ( ++$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
163unless ( $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 );
170my @tmpbuf = unpack('C*', $buff );
171if ( $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
179my $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
184print "Master browser = $master_browser\n"
185 if $debug ;
186
187$send_addr = sockaddr_in($ICA_PORT, inet_aton($master_browser));
188
189if ( $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
204print "Querying master browser for published application list\n"
205 if $debug ;
206
207while ( ++$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
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 &pdump($buff) ;
248}
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)
273 if $debug ;
274
275if ( 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
281if ( 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
287my @x = (@crit_pub_apps, @warn_pub_apps) ;
288my $blah = ( scalar(@x) == 1
289 ? 'the published application "' . join(',', @x) . '" is available'
290 : 'the published applications "' . join(',', @x) . '" are available' ) ;
291
292print qq(Ok. Citrix master browser "$master_browser" reported that $blah.\n) ;
293exit $ERRORS{OK} ;
294
295 # sleep $Timeout;
296 # because otherwise we can get responses from
297 # the WRONG servers. DOH
298close $Udp;
299
300
301sub 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
305sub print_help () {
306 print_revision($PROGNAME,'$Revision$ ');
307 print "Copyright (c) 2002 Ed Rolison/Tom De Blende/S Hopcroft
308
309Perl Check Citrix plugin for Nagios.
310
311Returns OK if the Citrix master browser returns a 'published application' list that contain names specified by the -W or -P options
312
313The 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
352sub version () {
353 print_revision($PROGNAME,'$Revision$ ');
354 exit $ERRORS{'OK'};
355}
356
357sub help () {
358 print_help();
359 exit $ERRORS{'OK'};
360}
361
362
363sub simple_diff {
364
365my ( $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