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