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