summaryrefslogtreecommitdiffstats
path: root/contrib/check_citrix
blob: 42d582ebbc14e193e6e18026e6488dbfbf84b5c2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
#!/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 ;
}