check_ircd.pl 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238
  1. #!@PERL@ -w
  2. # -----------------------------------------------------------------------------
  3. # File Name: check_ircd.pl
  4. #
  5. # Author: Richard Mayhew - South Africa
  6. #
  7. # Date: 1999/09/20
  8. #
  9. #
  10. # Description: This script will check to see if an IRCD is running
  11. # about how many users it has
  12. #
  13. # Email: netsaint@splash.co.za
  14. #
  15. # -----------------------------------------------------------------------------
  16. # Copyright 1999 (c) Richard Mayhew
  17. #
  18. # If any changes are made to this script, please mail me a copy of the
  19. # changes :)
  20. #
  21. # Some code taken from Charlie Cook (check_disk.pl)
  22. #
  23. # License GPL
  24. #
  25. # -----------------------------------------------------------------------------
  26. # Date Author Reason
  27. # ---- ------ ------
  28. #
  29. # 1999/09/20 RM Creation
  30. #
  31. # 1999/09/20 TP Changed script to use strict, more secure by
  32. # specifying $ENV variables. The bind command is
  33. # still insecure through. Did most of my work
  34. # with perl -wT and 'use strict'
  35. #
  36. # test using check_ircd.pl (irc-2.mit.edu|irc.erols.com|irc.core.com)
  37. # 2002/05/02 SG Fixed for Embedded Perl
  38. #
  39. # ----------------------------------------------------------------[ Require ]--
  40. require 5.004;
  41. # -------------------------------------------------------------------[ Uses ]--
  42. use Socket;
  43. use strict;
  44. use Getopt::Long;
  45. use vars qw($opt_V $opt_h $opt_t $opt_p $opt_H $opt_w $opt_c $verbose);
  46. use vars qw($PROGNAME);
  47. use FindBin;
  48. use lib "$FindBin::Bin";
  49. use utils qw($TIMEOUT %ERRORS &print_revision &support &usage);
  50. # ----------------------------------------------------[ Function Prototypes ]--
  51. sub print_help ();
  52. sub print_usage ();
  53. sub connection ($$$$);
  54. sub bindRemote ($$);
  55. # -------------------------------------------------------------[ Enviroment ]--
  56. $ENV{'PATH'}='@TRUSTED_PATH@';
  57. $ENV{'BASH_ENV'}='';
  58. $ENV{'ENV'}='';
  59. # -----------------------------------------------------------------[ Global ]--
  60. $PROGNAME = "check_ircd";
  61. my $NICK="ircd$$";
  62. my $USER_INFO="monitor localhost localhost : ";
  63. # -------------------------------------------------------------[ connection ]--
  64. sub connection ($$$$)
  65. {
  66. my ($in_remotehost,$in_users,$in_warn,$in_crit) = @_;
  67. my $state;
  68. my $answer;
  69. print "connection(debug): users = $in_users\n" if $verbose;
  70. $in_users =~ s/\ //g;
  71. if ($in_users >= 0) {
  72. if ($in_users > $in_crit) {
  73. $state = "CRITICAL";
  74. $answer = "Critical Number Of Clients Connected : $in_users (Limit = $in_crit)\n";
  75. } elsif ($in_users > $in_warn) {
  76. $state = "WARNING";
  77. $answer = "Warning Number Of Clients Connected : $in_users (Limit = $in_warn)\n";
  78. } else {
  79. $state = "OK";
  80. $answer = "IRCD ok - Current Local Users: $in_users\n";
  81. }
  82. } else {
  83. $state = "UNKNOWN";
  84. $answer = "Server $in_remotehost has less than 0 users! Something is Really WRONG!\n";
  85. }
  86. print ClientSocket "quit\n";
  87. print $answer;
  88. exit $ERRORS{$state};
  89. }
  90. # ------------------------------------------------------------[ print_usage ]--
  91. sub print_usage () {
  92. print "Usage: $PROGNAME -H <host> [-w <warn>] [-c <crit>] [-p <port>]\n";
  93. }
  94. # -------------------------------------------------------------[ print_help ]--
  95. sub print_help ()
  96. {
  97. print_revision($PROGNAME,'@NP_VERSION@');
  98. print "Copyright (c) 2000 Richard Mayhew/Karl DeBisschop
  99. Perl Check IRCD plugin for monitoring
  100. ";
  101. print_usage();
  102. print "
  103. -H, --hostname=HOST
  104. Name or IP address of host to check
  105. -w, --warning=INTEGER
  106. Number of connected users which generates a warning state (Default: 50)
  107. -c, --critical=INTEGER
  108. Number of connected users which generates a critical state (Default: 100)
  109. -p, --port=INTEGER
  110. Port that the ircd daemon is running on <host> (Default: 6667)
  111. -v, --verbose
  112. Print extra debugging information
  113. ";
  114. }
  115. # -------------------------------------------------------------[ bindRemote ]--
  116. sub bindRemote ($$)
  117. {
  118. my ($in_remotehost, $in_remoteport) = @_;
  119. my $proto = getprotobyname('tcp');
  120. my $sockaddr;
  121. my $that;
  122. my ($name, $aliases,$type,$len,$thataddr) = gethostbyname($in_remotehost);
  123. if (!socket(ClientSocket,AF_INET, SOCK_STREAM, $proto)) {
  124. print "IRCD UNKNOWN: Could not start socket ($!)\n";
  125. exit $ERRORS{"UNKNOWN"};
  126. }
  127. $sockaddr = 'S n a4 x8';
  128. $that = pack($sockaddr, AF_INET, $in_remoteport, $thataddr);
  129. if (!connect(ClientSocket, $that)) {
  130. print "IRCD UNKNOWN: Could not connect socket ($!)\n";
  131. exit $ERRORS{"UNKNOWN"};
  132. }
  133. select(ClientSocket); $| = 1; select(STDOUT);
  134. return \*ClientSocket;
  135. }
  136. # ===================================================================[ MAIN ]==
  137. MAIN:
  138. {
  139. my $hostname;
  140. Getopt::Long::Configure('bundling');
  141. GetOptions
  142. ("V" => \$opt_V, "version" => \$opt_V,
  143. "h" => \$opt_h, "help" => \$opt_h,
  144. "v" => \$verbose,"verbose" => \$verbose,
  145. "t=i" => \$opt_t, "timeout=i" => \$opt_t,
  146. "w=i" => \$opt_w, "warning=i" => \$opt_w,
  147. "c=i" => \$opt_c, "critical=i" => \$opt_c,
  148. "p=i" => \$opt_p, "port=i" => \$opt_p,
  149. "H=s" => \$opt_H, "hostname=s" => \$opt_H);
  150. if ($opt_V) {
  151. print_revision($PROGNAME,'@NP_VERSION@');
  152. exit $ERRORS{'UNKNOWN'};
  153. }
  154. if ($opt_h) {print_help(); exit $ERRORS{'UNKNOWN'};}
  155. ($opt_H) || ($opt_H = shift @ARGV) || usage("Host name/address not specified\n");
  156. my $remotehost = $1 if ($opt_H =~ /([-.A-Za-z0-9]+)/);
  157. ($remotehost) || usage("Invalid host: $opt_H\n");
  158. ($opt_w) || ($opt_w = shift @ARGV) || ($opt_w = 50);
  159. my $warn = $1 if ($opt_w =~ /^([0-9]+)$/);
  160. ($warn) || usage("Invalid warning threshold: $opt_w\n");
  161. ($opt_c) || ($opt_c = shift @ARGV) || ($opt_c = 100);
  162. my $crit = $1 if ($opt_c =~ /^([0-9]+)$/);
  163. ($crit) || usage("Invalid critical threshold: $opt_c\n");
  164. ($opt_p) || ($opt_p = shift @ARGV) || ($opt_p = 6667);
  165. my $remoteport = $1 if ($opt_p =~ /^([0-9]+)$/);
  166. ($remoteport) || usage("Invalid port: $opt_p\n");
  167. if ($opt_t && $opt_t =~ /^([0-9]+)$/) { $TIMEOUT = $1; }
  168. # Just in case of problems, let's not hang the monitoring system
  169. $SIG{'ALRM'} = sub {
  170. print "Somthing is Taking a Long Time, Increase Your TIMEOUT (Currently Set At $TIMEOUT Seconds)\n";
  171. exit $ERRORS{"UNKNOWN"};
  172. };
  173. alarm($TIMEOUT);
  174. my ($name, $alias, $proto) = getprotobyname('tcp');
  175. print "MAIN(debug): binding to remote host: $remotehost -> $remoteport\n" if $verbose;
  176. my $ClientSocket = &bindRemote($remotehost,$remoteport);
  177. print ClientSocket "NICK $NICK\nUSER $USER_INFO\n";
  178. while (<ClientSocket>) {
  179. print "MAIN(debug): default var = $_\n" if $verbose;
  180. # DALnet,LagNet,UnderNet etc. Require this!
  181. # Replies with a PONG when presented with a PING query.
  182. # If a server doesn't require it, it will be ignored.
  183. if (m/^PING (.*)/) {print ClientSocket "PONG $1\n";}
  184. alarm(0);
  185. # Look for pattern in IRCD Output to gather Client Connections total.
  186. connection($remotehost,$1,$warn,$crit) if (m/:I have\s+(\d+)/);
  187. }
  188. print "IRCD UNKNOWN: Unknown error - maybe could not authenticate\n";
  189. exit $ERRORS{"UNKNOWN"};
  190. }