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