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