summaryrefslogtreecommitdiffstats
path: root/contrib/check_ica_metaframe_pub_apps.pl
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/check_ica_metaframe_pub_apps.pl')
-rwxr-xr-xcontrib/check_ica_metaframe_pub_apps.pl381
1 files changed, 0 insertions, 381 deletions
diff --git a/contrib/check_ica_metaframe_pub_apps.pl b/contrib/check_ica_metaframe_pub_apps.pl
deleted file mode 100755
index 0edbdca..0000000
--- a/contrib/check_ica_metaframe_pub_apps.pl
+++ /dev/null
@@ -1,381 +0,0 @@
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
12use strict ;
13
14use IO::Socket;
15use IO::Select;
16use Getopt::Long ;
17
18my ($bcast_addr, $timeout, $debug, @citrix_servers, $crit_pub_apps, $warn_pub_apps, $long_list) ;
19
20use lib qw(/usr/local/nagios/libexec) ;
21use utils qw(%ERRORS &print_revision &support &usage) ;
22use packet_utils qw(&pdump &tethereal) ;
23
24my $PROGNAME = 'check_ica_metaframe_pub_apps' ;
25
26sub print_help ();
27sub print_usage ();
28sub help ();
29sub version ();
30
31 # You might have to change this...
32
33my $PACKET_TIMEOUT = 1;
34 # Number of seconds to wait for further UDP packets
35my $TEST_COUNT = 2;
36# Number of datagrams sent without reply
37my $BUFFER_SIZE = 1500;
38 # buffer size used for 'recv' calls.
39my $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).
44my $ICA_PORT = 1604;
45 # what port ICA runs on. Unlikely to change.
46
47Getopt::Long::Configure('bundling', 'no_ignore_case');
48GetOptions
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
61my $broadcast_addr = $1 if $bcast_addr and $bcast_addr =~ m#(\d+\.\d+\.\d+\.\d+)# ;
62usage("Invalid broadcast address: $bcast_addr\n")
63 if $bcast_addr and not defined($broadcast_addr) ;
64
65usage("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
68my @target = defined $broadcast_addr ? ($broadcast_addr) : @citrix_servers ;
69
70usage("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
73my $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
80my @crit_pub_apps = $crit_pub_apps ? split(/,/, $crit_pub_apps) : () ;
81my @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
87my $bcast_helo = &tethereal(<<'End_of_Tethereal_trace', '1e') ;
880020 ff ff 04 d6 06 44 00 26 4a 76 1e 00 01 30 02 fd .....D.&Jv...0..
890030 a8 e3 00 02 f5 95 9f f5 30 07 00 00 00 00 00 00 ........0.......
900040 00 00 00 00 00 00 01 00 .......
91End_of_Tethereal_trace
92
93my $bcast_query_app = &tethereal(<<'End_of_Tethereal_trace', '24') ;
940020 64 17 04 50 06 44 00 2c 85 6a 24 00 01 32 02 fd d..P.D.,.j$..2..
950030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
960040 00 00 00 00 00 00 21 00 02 00 00 00 00 00 ......!......
97End_of_Tethereal_trace
98
99my $direct_helo = &tethereal(<<'End_of_Tethereal_trace', '20') ;
1000020 64 17 05 0f 06 44 00 28 ab b5 20 00 01 30 02 fd d....D.(.. ..0..
1010030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
1020040 00 00 00 00 00 00 00 00 00 00 .........
103End_of_Tethereal_trace
104
105my $direct_query_app = &tethereal(<<'End_of_Tethereal_trace', '2c') ;
1060020 64 17 05 10 06 44 00 34 7a 9a 2c 00 02 32 02 fd d....D.4z.,..2..
1070030 a8 e3 00 00 00 00 00 00 00 00 00 00 00 00 00 00 ................
1080040 00 00 00 00 00 00 21 00 02 00 01 00 00 00 00 00 ......!.........
1090050 00 00 00 00 00 00 ......
110End_of_Tethereal_trace
111
112my $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
118my $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
123my ($remote_host, $buff, $buff2, $raddr, $rport, $rhost, @remote_response);
124my ($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
132while ( ++$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
162unless ( $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 );
169my @tmpbuf = unpack('C*', $buff );
170if ( $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
178my $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
183print "Master browser = $master_browser\n"
184 if $debug ;
185
186$send_addr = sockaddr_in($ICA_PORT, inet_aton($master_browser));
187
188if ( $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
203print "Querying master browser for published application list\n"
204 if $debug ;
205
206while ( ++$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
235unless ( $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 );
244if ( $debug ) {
245 print "$rhost:$rport responded to app query with: ", length($buff), " bytes\n";
246 &pdump($buff) ;
247}
248
249my $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
262my (@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
271print qq(Received list of applications: "$clean_app_list".\n)
272 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
288 ? 'the published application "' . join(',', @x) . '" is available'
289 : 'the published applications "' . join(',', @x) . '" are available' ) ;
290
291print qq(Ok. Citrix master browser "$master_browser" reported that $blah.\n) ;
292exit $ERRORS{OK} ;
293
294 # sleep $Timeout;
295 # because otherwise we can get responses from
296 # the WRONG servers. DOH
297close $Udp;
298
299
300sub 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
304sub print_help () {
305 print_revision($PROGNAME,'$Revision: 1098 $ ');
306 print "Copyright (c) 2002 Ed Rolison/Tom De Blende/S Hopcroft
307
308Perl Check Citrix plugin for Nagios.
309
310Returns OK if the Citrix master browser returns a 'published application' list that contain names specified by the -W or -P options
311
312The 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
351sub version () {
352 print_revision($PROGNAME,'$Revision: 1098 $ ');
353 exit $ERRORS{'OK'};
354}
355
356sub help () {
357 print_help();
358 exit $ERRORS{'OK'};
359}
360
361
362sub simple_diff {
363
364my ( $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