.inspircd.inc

   1 #!/usr/bin/perl
   2 #       +------------------------------------+
   3 #       | Inspire Internet Relay Chat Daemon |
   4 #       +------------------------------------+
   5 #
   6 #  InspIRCd: (C) 2002-2009 InspIRCd Development Team
   7 # See: http://www.inspircd.org/wiki/index.php/Credits
   8 #
   9 # This program is free but copyrighted software; see
  10 #          the file COPYING for details.
  11 #
  12 # ---------------------------------------------------
  13 #
  14 use POSIX;
  15
  16 my $basepath    =       "@BASE_DIR@";
  17 my $confpath    =       "@CONFIG_DIR@/";
  18 my $binpath     =       "@BINARY_DIR@";
  19 my $libpath     =       "@LIBRARY_DIR@";
  20 my $valgrindlogpath     =       "$basepath/valgrindlogs";
  21 my $executable  =       "@EXECUTABLE@";
  22 my $version     =       "@VERSION@";
  23
  24 # Lets see what they want to do.. Set the variable (Cause i'm a lazy coder)
  25 my $arg = shift(@ARGV);
  26 my $conf = $confpath . "inspircd.conf";
  27 for my $a (@ARGV)
  28 {
  29         if ($a =~ m/^--config=(.*)$/)
  30         {
  31                 $conf = $1;
  32                 last;
  33         }
  34 }
  35 getpidfile($conf);
  36
  37 # System for naming script command subs:
  38 # cmd_<name> - Normal command for use by users.
  39 # dev_<name> - Developer commands.
  40 # hid_<name> - Hidden commands (ie Cheese-Sandwich)
  41 # Ideally command subs shouldn't return.
  42
  43 my $subname = $arg;
  44 $subname =~ s/-/_/g;
  45 my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
  46 if (!defined($sub))
  47 {
  48         print STDERR "Invalid command or none given.\n";
  49         cmd_help();
  50         exit 1;
  51 }
  52 else
  53 {
  54         $sub->(@ARGV);
  55         exit 0;
  56 }
  57
  58 sub cmd_help()
  59 {
  60         @subs = grep { $_ =~ m/^(cmd|dev)_/ && defined(main->can($_)) } keys(%::);
  61         my @cmds = grep /^cmd_/, @subs;
  62         my @devs = grep /^dev_/, @subs;
  63         local $_;
  64         $_ =~ s/^(cmd|dev)_// foreach (@cmds, @devs);
  65         $_ =~ s/_/-/g foreach (@cmds, @devs);
  66         print STDERR "Usage: ./inspircd (" . join("|", @cmds) . ")\n";
  67         print STDERR "Developer arguments: (" . join("|", @devs) . ")\n";
  68         exit 0;
  69 }
  70
  71 sub cmd_status()
  72 {
  73         if (getstatus() == 1) {
  74                 my $pid = getprocessid();
  75                 print "InspIRCd is running (PID: $pid)\n";
  76                 exit();
  77         } else {
  78                 print "InspIRCd is not running. (Or PID File not found)\n";
  79                 exit();
  80         }
  81 }
  82
  83 sub cmd_rehash()
  84 {
  85         if (getstatus() == 1) {
  86                 my $pid = getprocessid();
  87                 system("kill -HUP $pid >/dev/null 2>&1");
  88                 print "InspIRCd rehashed (pid: $pid).\n";
  89                 exit();
  90         } else {
  91                 print "InspIRCd is not running. (Or PID File not found)\n";
  92                 exit();
  93         }
  94 }
  95
  96 sub cmd_cron()
  97 {
  98         if (getstatus() == 0) { goto &cmd_start(); }
  99         exit();
 100 }
 101
 102 sub cmd_version()
 103 {
 104         print "InspIRCd version: $version\n";
 105         exit();
 106 }
 107
 108 sub cmd_restart(@)
 109 {
 110         cmd_stop();
 111         unlink($pidfile) if (-e $pidfile);
 112         goto &cmd_start;
 113 }
 114
 115 sub hid_cheese_sandwich()
 116 {
 117         print "Creating Cheese Sandwich..\n";
 118         print "Done.\n";
 119         exit();
 120 }
 121
 122 sub cmd_start(@)
 123 {
 124         # Check to see its not 'running' already.
 125         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
 126         # If we are still alive here.. Try starting the IRCd..
 127         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
 128         print "$binpath/$executable is not executable\n" and return 0 unless(-f "$binpath/$executable" && -x "$binpath/$executable");
 129
 130         exec { "$binpath/$executable" } "$binpath/$executable", @_;
 131         die "Failed to start IRCd: $!\n";
 132 }
 133
 134 sub dev_debug(@)
 135 {
 136         # Check to see its not 'running' already.
 137         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
 138
 139         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
 140         print "$binpath/$executable is not executable\n" and return 0 unless(-f "$binpath/$executable" && -x "$binpath/$executable");
 141
 142         # Check we have gdb
 143         checkgdb();
 144
 145         # If we are still alive here.. Try starting the IRCd..
 146         exec {gdb} 'gdb', "--command=$basepath/.gdbargs", '--args', "$binpath/$executable", qw(-nofork -debug), @_;
 147         die "Failed to start GDB: $!\n";
 148 }
 149
 150 sub dev_screendebug(@)
 151 {
 152         # Check to see its not 'running' already.
 153         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
 154
 155         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
 156
 157         #Check we have gdb
 158         checkgdb();
 159         checkscreen();
 160
 161         # If we are still alive here.. Try starting the IRCd..
 162         print "Starting InspIRCd in `screen`, type `screen -r` when the ircd crashes to view the gdb output and get a backtrace.\n";
 163         print "Once you're inside the screen session press ^C + d to re-detach from the session\n";
 164         exec {screen} qw(screen -m -d gdb), "--comand=$basepath/.gdbargs", '-args', "$binpath/$executable", qw(-nofork -debug -nolog), @_;
 165         die "Failed to start screen: $!\n";
 166 }
 167
 168 sub dev_valdebug(@)
 169 {
 170         # Check to see its not 'running' already.
 171         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
 172
 173         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
 174         print "$binpath/$executable is not executable\n" and return 0 unless(-f "$binpath/$executable" && -x "$binpath/$executable");
 175
 176         # Check we have valgrind and gdb
 177         checkvalgrind();
 178         checkgdb();
 179
 180         # If we are still alive here.. Try starting the IRCd..
 181         # May want to do something with these args at some point: --suppressions=.inspircd.sup --gen-suppressions=yes
 182         # Could be useful when we want to stop it complaining about things we're sure aren't issues.
 183         exec {valgrind} qw(valgrind -v --tool=memcheck --leak-check=yes --db-attach=yes --num-callers=10), "$binpath/$executable", qw(-nofork -debug -nolog), @_;
 184         die "Failed to start valgrind: $!\n";
 185 }
 186
 187 sub dev_valdebug_unattended(@)
 188 {
 189         # NOTE: To make sure valgrind generates coredumps, set soft core limit in /etc/security/limits.conf to unlimited
 190         # Check to see its not 'running' already.
 191         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
 192
 193         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
 194         print "$binpath/$executable is not executable\n" and return 0 unless(-f "$binpath/$executable" && -x "$binpath/$executable");
 195
 196         # Check we have valgrind and gdb
 197         checkvalgrind();
 198         checkgdb();
 199
 200         # If we are still alive here.. Try starting the IRCd..
 201         # May want to do something with these args at some point: --suppressions=.inspircd.sup --gen-suppressions=yes
 202         # Could be useful when we want to stop it complaining about things we're sure aren't issues.
 203         #
 204         # NOTE: Saving the debug log (redirected stdout), while useful, is a potential security risk AND one hell of a spacehog. DO NOT SAVE THIS WHERE EVERYONE HAS ACCESS!
 205         # Redirect stdout to /dev/null if you're worried about the security.
 206         #
 207         my $pid = fork;
 208         if ($pid == 0) {
 209                 POSIX::setsid();
 210                 use Fcntl;
 211                 -d $valgrindlogpath or mkdir $valgrindlogpath or die "Cannot create $valgrindlogpath: $!\n";
 212                 my $suffix = strftime("%Y%m%d-%H%M%S", localtime(time)) . ".$$";
 213                 open STDIN, '<', '/dev/null' or die "Can't redirect STDIN to /dev/null: $!\n";
 214                 sysopen STDOUT, "$valgrindlogpath/out.$suffix", O_WRONLY | O_CREAT | O_NOCTTY | O_APPEND, 0600 or die "Can't open $valgrindlogpath/out.$suffix: $!\n";
 215                 sysopen STDERR, "$valgrindlogpath/valdebug.$suffix", O_WRONLY | O_CREAT | O_NOCTTY | O_APPEND, 0666 or die "Can't open $valgrindlogpath/valdebug.$suffix: $!\n";
 216                 exec {valgrind} qw(valgrind -v --tool=memcheck --leak-check=yes --num-callers=10 --time-stamp=yes --log-fd=2), "$binpath/$executable", qw(-nofork -debug -nolog), @_;
 217                 die "Can't execute valgrind: $!\n";
 218         }
 219 }
 220
 221 sub dev_screenvaldebug(@)
 222 {
 223         # Check to see its not 'running' already.
 224         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
 225
 226         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
 227         print "$binpath/$executable is not executable\n" and return 0 unless(-f "$binpath/$executable" && -x "$binpath/$executable");
 228
 229         #Check we have gdb
 230         checkvalgrind();
 231         checkgdb();
 232         checkscreen();
 233
 234         # If we are still alive here.. Try starting the IRCd..
 235         print "Starting InspIRCd in `screen`, type `screen -r` when the ircd crashes to view the valgrind and gdb output and get a backtrace.\n";
 236         print "Once you're inside the screen session press ^C + d to re-detach from the session\n";
 237         exec {screen} qw(screen -m -d valgrind -v --tool=memcheck --leak-check=yes --db-attach=yes --num-callers=10), "$binpath/$executable", qw(-nofork -debug -nolog), @_;
 238         die "Failed to start screen: $!\n";
 239 }
 240
 241 sub cmd_stop()
 242 {
 243         if (getstatus() == 0) { print "InspIRCd is not running. (Or PID File not found)\n"; return 0; }
 244         # Get to here, we have something to kill.
 245         my $pid = getprocessid();
 246         print "Stopping InspIRCd (pid: $pid)...\n";
 247         my $maxwait = (`ps -o command $pid` =~ /valgrind/i) ? 30 : 5;
 248         kill TERM => $pid or die "Cannot terminate IRCd: $!\n";
 249         for (1..$maxwait) {
 250                 sleep 1;
 251                 if (getstatus() == 1) {
 252                         print "InspIRCd Stopped.\n";
 253                         return;
 254                 }
 255         }
 256         print "InspIRCd not dying quietly -- forcing kill\n";
 257         kill KILL => $pid;
 258         exit 0;
 259 }
 260
 261 ###
 262 # Generic Helper Functions.
 263 ###
 264
 265 # GetPidfile Version 2 - Now With Include Support..
 266 # I beg for months for include support in insp, then..
 267 # when it is added, it comes around and BITES ME IN THE ASS,
 268 # because i then have to code support into this script.. Evil.
 269
 270 # Craig got bitten in the ass again --
 271 # in 1.1 beta the include file is manditory, therefore
 272 # if we cant find it, default to %conf%/inspircd.pid.
 273 # Note, this also contains a fix for when the pid file is
 274 # defined, but defined in a comment (line starts with #)
 275 # -- Brain
 276
 277 sub getpidfile
 278 {
 279         my ($file) = @_;
 280         # Before we start, do we have a PID already? (Should never occur)
 281         if ($pid ne "") {
 282                 return;
 283         }
 284         # Are We using a relative path?
 285         if ($file !~ /^\//) {
 286                 # Convert it to a full path.
 287                 $file = $confpath . $file;
 288         }
 289
 290         # Have we checked this file before?
 291         for (my $i = 0; $i < $filesparsed; $i++) {
 292                 if ($filesparsed[$i] eq $file) {
 293                         # Already Parsed, Possible recursive loop..
 294                         return;
 295                 }
 296         }
 297
 298         # If we get here, Mark as 'Read'
 299         $filesparsed[$filesparsed] = $file;
 300
 301         # Open the File..
 302         open INFILE, "< $file" or die "Unable to open file $file included in configuration\n";
 303         # Grab entire file contents..
 304         my(@lines) = <INFILE>;
 305         # Close the file
 306         close INFILE;
 307
 308         # remove trailing spaces
 309         chomp(@lines);
 310         foreach $i (@lines) {
 311                 # clean it up
 312                 $i =~ s/[^=]+=\s(.*)/\1/;
 313                 # Does this file have a pid?
 314                 if (($i =~ /<pid file=\"(\S+)\">/i) && ($i !~ /^#/))
 315                 {
 316                         # Set the PID file and return.
 317                         $pidfile = $1;
 318                         return;
 319                 }
 320         }
 321
 322         # If we get here, NO PID FILE! -- Check for includes
 323         foreach $i (@lines) {
 324                 $i =~ s/[^=]+=\s(.*)/\1/;
 325                 if (($i =~ s/\<include file=\"(.+?)\"\>//i) && ($i !~ /^#/))
 326                 {
 327                         # Decend into that file, and check for PIDs.. (that sounds like an STD ;/)
 328                         getpidfile($1);
 329                         # Was a PID found?
 330                         if ($pidfile ne "") {
 331                                 # Yes, Return.
 332                                 return;
 333                         }
 334                 }
 335         }
 336
 337         # End of includes / No includes found. Using default.
 338         $pidfile = $confpath . "inspircd.pid";
 339 }
 340
 341 sub getstatus {
 342         my $pid = getprocessid();
 343         return 0 if $pid == 0;
 344         return kill 0, $pid;
 345 }
 346
 347
 348 sub getprocessid {
 349         my $pid;
 350         open PIDFILE, "< $pidfile" or return 0;
 351         while($i = <PIDFILE>)
 352         {
 353                 $pid = $i;
 354         }
 355         close PIDFILE;
 356         return $pid;
 357 }
 358
 359 sub checkvalgrind
 360 {
 361         unless(`valgrind --version`)
 362         {
 363                 print "Couldn't start valgrind: $!\n";
 364                 exit;
 365         }
 366 }
 367
 368 sub checkgdb
 369 {
 370         unless(`gdb --version`)
 371         {
 372                 print "Couldn't start gdb: $!\n";
 373                 exit;
 374         }
 375 }
 376
 377 sub checkscreen
 378 {
 379         unless(`screen --version`)
 380         {
 381                 print "Couldn't start screen: $!\n";
 382                 exit;
 383         }
 384 }
 385
 386 sub checkxmllint
 387 {
 388         open(FH, "xmllint|") or die "Couldn't start xmllint: $!\n";
 389 }
 390
 391 sub cmd_checkconf()
 392 {
 393         checkxmllint();
 394         validateconf($conf);
 395         print "Config check complete\n";
 396         exit 0;
 397 }
 398
 399 sub validateconf
 400 {
 401         my ($file) = @_;
 402
 403         # Are We using a relative path?
 404         if ($file !~ /^\//) {
 405                 # Convert it to a full path..
 406                 $file = $confpath . $file;
 407         }
 408
 409         # Have we checked this file before?
 410         for (my $i = 0; $i < $filechecked; $i++) {
 411                 if ($filechecked[$i] eq $file) {
 412                         # Already Parsed, Possible recursive loop..
 413                         return;
 414                 }
 415         }
 416
 417         # If we get here, Mark as 'Read'
 418         $filechecked[$filechecked] = $file;
 419
 420         # Open the File..
 421         open INFILE, "< $file" or die "Unable to open file $file\n";
 422         # Grab entire file contents..
 423         my(@lines) = <INFILE>;
 424         # Close the file
 425         close INFILE;
 426
 427         # remove trailing spaces
 428         chomp(@lines);
 429
 430         my @newlines = ();
 431         my @blanks = ();
 432         my $conline;
 433
 434         push @newlines, "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>";
 435 #       push @newlines, "<!DOCTYPE config SYSTEM \"".$confpath."inspircd.dtd\">";
 436         push @newlines, "<config>";
 437
 438         foreach $i (@lines)
 439         {
 440                 # remove trailing newlines
 441                 chomp($i);
 442
 443                 # convert tabs to spaces
 444                 $i =~ s/\t/ /g;
 445
 446                 # remove leading spaces
 447                 $i =~ s/^ *//;
 448
 449                 # remove comments
 450                 $i =~ s/^#.*//;
 451
 452                 # remove trailing #s
 453                 $i =~ s/(.*)#$/\1/;
 454
 455                 # remove trailing comments
 456                 my $line = "";
 457                 my $quote = 0;
 458                 for (my $j = 0; $j < length($i); $j++)
 459                 {
 460                         if (substr($i,$j, 1) eq '"') { $quote = ($quote) ? 0 : 1; } elsif (substr($i,$j, 1) eq "#" && !$quote) { last; }
 461                         $line .= substr($i,$j, 1);
 462                 }
 463                 $i = $line;
 464
 465                 # remove trailing spaces
 466                 $i =~ s/ *$//;
 467
 468                 # setup incf for include check and clean it up, since this breaks parsing use local var
 469                 my $incf = $i;
 470                 $incf =~ s/[^=]+=\s(.*)/\1/;
 471
 472                 # include file?
 473                 if (($incf =~ s/\<include file=\"(.+?)\"\>//i) && ($incf !~ /^#/))
 474                 {
 475                         # yes, process it
 476                         validateconf($1);
 477                 }
 478
 479                 if ($i =~ /^<.*/ && $conline =~ /^<.*/)
 480                 {
 481                         push @newlines, $conline;
 482                         push @newlines, @blanks;
 483                         $conline = $i;
 484                 }
 485
 486                 if ($i =~ /^<.*>$/)
 487                 {
 488                         $i =~ s/(.*)>$/\1 \/>/;
 489                         push @newlines, $i;
 490                 }
 491                 elsif ($i =~ /.*>$/)
 492                 {
 493                         $conline .= " $i";
 494                         $conline =~ s/(.*)>$/\1 \/>/;
 495                         push @blanks, "";
 496                         push @newlines, $conline;
 497                         push @newlines, @blanks;
 498                         $conline = "";
 499                         undef @blanks;
 500                 }
 501                 elsif ($i =~ /^<.*/)
 502                 {
 503                         $conline = $i;
 504                 }
 505                 elsif ($conline =~ /^<.*/ && $i)
 506                 {
 507                         $conline .= " $i";
 508                         push @blanks, "";
 509                 }
 510                 else
 511                 {
 512                         if ($conline)
 513                         {
 514                                 push @blanks, $i;
 515                         }
 516                         else
 517                         {
 518                                 push @newlines, $i;
 519                         }
 520                 }
 521         }
 522         if ($conline)
 523         {
 524                 push @newlines, $conline;
 525                 push @newlines, @blanks;
 526         }
 527
 528         push @newlines, "</config>";
 529
 530         my $tmpfile;
 531         do
 532         {
 533                 $tmpfile = tmpnam();
 534         } until sysopen(TF, $tmpfile, O_RDWR|O_CREAT|O_EXCL|O_NOFOLLOW, 0700);
 535
 536         foreach $n (@newlines)
 537         {
 538                 print TF "$n\n";
 539         }
 540         close TF;
 541
 542         my @result = `xmllint -noout $tmpfile 2>&1`;
 543         chomp(@result);
 544
 545         my $skip = 0;
 546         foreach $n (@result)
 547         {
 548                 if ($skip)
 549                 {
 550                         $skip = 0;
 551                         next;
 552                 }
 553                 $n =~ s/$tmpfile\:\d*\: *//g;
 554                 if ($n =~ /.*config>.*/)
 555                 {
 556                         $n = "";
 557                         $skip = 1;
 558                 }
 559
 560                 if ($n && !$skip)
 561                 {
 562                         if ($n =~ /line \d*/)
 563                         {
 564                                 my $lineno = $n;
 565                                 $lineno =~ s/.*line (\d*).*/\1/;
 566                                 $lineno = $lineno-2;
 567                                 $n =~ s/line (\d*)/line $lineno/;
 568                         }
 569                         print "$file : $n\n";
 570                 }
 571         }
 572         unlink($tmpfile);
 573 }