make/template/inspircd

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