]> git.netwichtig.de Git - user/henk/code/inspircd.git/blob - .inspircd.inc
Add protocol api functions: PI->WriteChannelPrivmsg() and PI->WriteChannelNotice...
[user/henk/code/inspircd.git] / .inspircd.inc
1 #!/usr/bin/perl
2 #       +------------------------------------+
3 #       | Inspire Internet Relay Chat Daemon |
4 #       +------------------------------------+
5 #
6 #      (C) 2002-2007 InspIRCd Development Team
7 #   http://www.inspircd.org/wiki/index.php/Credits
8 #
9 # Written by Craig Edwards, Craig McLure, and others.
10 # This program is free but copyrighted software; see
11 #            the file COPYING for details.
12 #
13 # ---------------------------------------------------
14 use POSIX;
15
16 my $basepath    =       "@BASE_DIR@";
17 my $confpath    =       "@CONFIG_DIR@/";
18 my $binpath     =       "@BINARY_DIR@";
19 my $libpath     =       "@LIBRARY_DIR@";
20 my $executable  =       "@EXECUTABLE@";
21 my $version     =       "@VERSION@";
22 my @filesparsed;
23 my @filechecked;
24
25 # Lets see what they want to do.. Set the variable (Cause i'm a lazy coder)
26 my $arg = $ARGV[0];
27 getpidfile($confpath."inspircd.conf");
28
29 if ($arg eq "start") { start(); exit(); }
30 if ($arg eq "debug") { debug(); exit(); }
31 if ($arg eq "screendebug") { screendebug(); exit() }
32 if ($arg eq "valdebug") { valdebug(); exit(); }
33 if ($arg eq "screenvaldebug") { screenvaldebug(); exit(); }
34 if ($arg eq "stop") { stop(); exit(); }
35 if ($arg eq "status") {
36         if (getstatus() == 1) {
37                 my $pid = getprocessid();
38                 print "InspIRCd is running (PID: $pid)\n";
39                 exit();
40         } else {
41                 print "InspIRCd is not running. (Or PID File not found)\n";
42                 exit();
43         }
44 }
45 if ($arg eq "rehash") {
46         if (getstatus() == 1) {
47                 my $pid = getprocessid();
48                 system("kill -HUP $pid >/dev/null 2>&1");
49                 print "InspIRCd rehashed (pid: $pid).\n";
50                 exit();
51         } else {
52                 print "InspIRCd is not running. (Or PID File not found)\n";
53                 exit();
54         }
55 }
56
57 if ($arg eq "cron") {
58         if (getstatus() == 0) { start(); }
59         exit();
60 }
61
62 if ($arg eq "version") {
63         print "InspIRCd version: $version\n";
64         exit();
65 }
66
67 if ($arg eq "restart") {
68         stop();
69         unlink($pidfile) if (-e $pidfile);
70         start();
71         # kthxbye();
72         exit();
73 }
74
75 if ($arg eq "checkconf") {
76         checkconf();
77         exit();
78 }
79
80 if ($arg eq "Cheese-Sandwich") {
81         print "Creating Cheese Sandwich..\n";
82         print "Done.\n";
83         exit();
84 }
85
86 ###
87 # If we get here.. bad / no parameters.
88 ###
89 print "Invalid Argument: $arg\n";
90 print "Usage: inspircd (start|stop|restart|rehash|status|cron|checkconf|version)\n";
91 print "Developer arguments: (debug|screendebug|valdebug|screenvaldebug)\n";
92 exit();
93
94 ###
95 # Generic Helper Functions.
96 ###
97
98 sub start {
99         # Check to see its not 'running' already.
100         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
101         # If we are still alive here.. Try starting the IRCd..
102         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
103
104         system("$binpath/$executable");
105         return 1;
106 }
107
108 sub debug {
109         # Check to see its not 'running' already.
110         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
111
112         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
113
114         # Check we have gdb
115         checkgdb();
116
117         # If we are still alive here.. Try starting the IRCd..
118         system("gdb --command=$basepath/.gdbargs --args $binpath/$executable -nofork -debug -nolog");
119 }
120
121 sub screendebug
122 {
123         # Check to see its not 'running' already.
124         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
125
126         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
127
128         #Check we have gdb
129         checkgdb();
130         checkscreen();
131
132         # If we are still alive here.. Try starting the IRCd..
133         print "Starting InspIRCd in `screen`, type `screen -r` when the ircd crashes to view the gdb output and get a backtrace.\n";
134         print "Once you're inside the screen session press ^C + d to re-detach from the session\n";
135         system("screen -m -d gdb --command=$basepath/.gdbargs --args $binpath/$executable -nofork -debug -nolog");
136 }
137
138 sub valdebug
139 {
140         # Check to see its not 'running' already.
141         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
142
143         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
144
145         # Check we have valgrind and gdb
146         checkvalgrind();
147         checkgdb();
148
149         # If we are still alive here.. Try starting the IRCd..
150         # May want to do something with these args at some point: --suppressions=.inspircd.sup --gen-suppressions=yes
151         # Could be useful when we want to stop it complaining about things we're sure aren't issues.
152         system("valgrind -v --tool=memcheck --leak-check=yes --db-attach=yes --num-callers=10 $binpath/$executable -nofork -debug -nolog");
153 }
154
155 sub screenvaldebug
156 {
157         # Check to see its not 'running' already.
158         if (getstatus() == 1) { print "InspIRCd is already running.\n"; return 0; }
159
160         print "$binpath/$executable doesn't exist\n" and return 0 unless(-e "$binpath/$executable");
161
162         #Check we have gdb
163         checkvalgrind();
164         checkgdb();
165         checkscreen();
166
167         # If we are still alive here.. Try starting the IRCd..
168         print "Starting InspIRCd in `screen`, type `screen -r` when the ircd crashes to view the valgrind and gdb output and get a backtrace.\n";
169         print "Once you're inside the screen session press ^C + d to re-detach from the session\n";
170         system("screen -m -d valgrind -v --tool=memcheck --leak-check=yes --db-attach=yes --num-callers=10 $binpath/$executable -nofork -debug -nolog");
171 }
172
173 sub stop {
174         if (getstatus() == 0) { print "InspIRCd is not running. (Or PID File not found)\n"; return 0; }
175         # Get to here, we have something to kill.
176         my $pid = getprocessid();
177         print "Stopping InspIRCd (pid: $pid)...\n";
178         system("kill -TERM $pid >/dev/null 2>&1");
179         # Give it a second to exit
180         sleep(1);
181         if (getstatus() == 1)
182         {
183                 print "InspIRCd not dying quietly -- forcing kill\n";
184                 system("kill -9 $pid >/dev/null 2>&1");
185         }
186         print "InspIRCd Stopped.\n";
187 }
188
189 # GetPidfile Version 2 - Now With Include Support..
190 # I beg for months for include support in insp, then..
191 # when it is added, it comes around and BITES ME IN THE ASS,
192 # because i then have to code support into this script.. Evil.
193
194 # Craig got bitten in the ass again --
195 # in 1.1 beta the include file is manditory, therefore
196 # if we cant find it, default to %conf%/inspircd.pid.
197 # Note, this also contains a fix for when the pid file is
198 # defined, but defined in a comment (line starts with #)
199 # -- Brain
200
201 sub getpidfile {
202   my ($file) = @_;
203   # Before we start, do we have a PID already? (Should never occur)
204   if ($pid ne "") {
205     return;
206   }
207   # Are We using a relative path?
208   if ($file !~ /^\//) {
209     # Convert it to a full path..
210     $file = $confpath . $file;
211   }
212
213   # Have we checked this file before?
214   for (my $i = 0; $i < $filesparsed; $i++) {
215     if ($filesparsed[$i] eq $file) {
216       # Already Parsed, Possible recursive loop..
217       return;
218     }
219   }
220
221   # If we get here, Mark as 'Read'
222   $filesparsed[$filesparsed] = $file;
223
224   # Open the File..
225   open INFILE, "< $file" or die "Unable to open file $file\n";
226   # Grab entire file contents..
227   my(@lines) = <INFILE>;
228   # Close the file
229   close INFILE;
230
231   # remove trailing spaces
232   chomp(@lines);
233   foreach $i (@lines) {
234     # clean it up
235     $i =~ s/[^=]+=\s(.*)/\1/;
236     # Does this file have a pid?
237     if (($i =~ /<pid file=\"(\S+)\">/i) && ($i !~ /^#/))
238     {
239       # Set the PID file and return.
240       $pidfile = $1;
241       return;
242     }
243   }
244
245   # If we get here, NO PID FILE! -- Check for includes
246   foreach $i (@lines) {
247     $i =~ s/[^=]+=\s(.*)/\1/;
248     if (($i =~ s/\<include file=\"(.+?)\"\>//i) && ($i !~ /^#/))
249     {
250       # Decend into that file, and check for PIDs.. (that sounds like an STD ;/)
251       getpidfile($1);
252       # Was a PID found?
253       if ($pidfile ne "") {
254         # Yes, Return.
255         return;
256       }
257     }
258   }
259
260   # End of includes / No includes found. Using default.
261   $pidfile = $confpath . "inspircd.pid";
262 }
263
264 sub getstatus {
265         my $pid = getprocessid();
266         if ($pid == 0) { return 0; }
267         $status = system("kill -0 $pid >/dev/null 2>&1") / 256;
268         if ($status == 0) { return 1; }
269         else { return 0; }
270 }
271
272
273 sub getprocessid {
274         my $pid;
275         open PIDFILE, "< $pidfile" or return 0;
276         while($i = <PIDFILE>)
277         {
278                 $pid = $i;
279         }
280         close PIDFILE;
281         return $pid;
282 }
283
284 sub checkvalgrind
285 {
286         unless(`valgrind --version`)
287         {
288                 print "Couldn't start valgrind: $!\n";
289                 exit;
290         }
291 }
292
293 sub checkgdb
294 {
295         unless(`gdb --version`)
296         {
297                 print "Couldn't start gdb: $!\n";
298                 exit;
299         }
300 }
301
302 sub checkscreen
303 {
304         unless(`screen --version`)
305         {
306                 print "Couldn't start screen: $!\n";
307                 exit;
308         }
309 }
310
311 sub checkxmllint
312 {
313         open(FH, "xmllint|") or die "Couldn't start xmllint: $!\n";
314 }
315
316 sub checkconf
317 {
318         checkxmllint();
319         validateconf($confpath."inspircd.conf");
320         print "Config check complete\n";
321 }
322
323 sub validateconf
324 {
325         my ($file) = @_;
326
327         # Are We using a relative path?
328         if ($file !~ /^\//) {
329                 # Convert it to a full path..
330                 $file = $confpath . $file;
331         }
332
333         # Have we checked this file before?
334         for (my $i = 0; $i < $filechecked; $i++) {
335                 if ($filechecked[$i] eq $file) {
336                         # Already Parsed, Possible recursive loop..
337                         return;
338                 }
339         }
340
341         # If we get here, Mark as 'Read'
342         $filechecked[$filechecked] = $file;
343
344         # Open the File..
345         open INFILE, "< $file" or die "Unable to open file $file\n";
346         # Grab entire file contents..
347         my(@lines) = <INFILE>;
348         # Close the file
349         close INFILE;
350
351         # remove trailing spaces
352         chomp(@lines);
353
354         my @newlines = ();
355         my @blanks = ();
356         my $conline;
357
358         push @newlines, "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>";
359 #       push @newlines, "<!DOCTYPE config SYSTEM \"".$confpath."inspircd.dtd\">";
360         push @newlines, "<config>";
361
362         foreach $i (@lines)
363         {
364                 # remove trailing newlines
365                 chomp($i);
366
367                 # convert tabs to spaces
368                 $i =~ s/\t/ /g;
369
370                 # remove leading spaces
371                 $i =~ s/^ *//;
372
373                 # remove comments
374                 $i =~ s/^#.*//;
375
376                 # remove trailing #s
377                 $i =~ s/(.*)#$/\1/;
378
379                 # remove trailing comments
380                 my $line = "";
381                 my $quote = 0;
382                 for (my $j = 0; $j < length($i); $j++)
383                 {
384                         if (substr($i,$j, 1) eq '"') { $quote = ($quote) ? 0 : 1; } elsif (substr($i,$j, 1) eq "#" && !$quote) { last; }
385                         $line .= substr($i,$j, 1);
386                 }
387                 $i = $line;
388
389                 # remove trailing spaces
390                 $i =~ s/ *$//;
391
392                 # setup incf for include check and clean it up, since this breaks parsing use local var
393                 my $incf = $i;
394                 $incf =~ s/[^=]+=\s(.*)/\1/;
395
396                 # include file?
397                 if (($incf =~ s/\<include file=\"(.+?)\"\>//i) && ($incf !~ /^#/))
398                 {
399                         # yes, process it
400                         validateconf($1);
401                 }
402
403                 if ($i =~ /^<.*/ && $conline =~ /^<.*/)
404                 {
405                         push @newlines, $conline;
406                         push @newlines, @blanks;
407                         $conline = $i;
408                 }
409
410                 if ($i =~ /^<.*>$/)
411                 {
412                         $i =~ s/(.*)>$/\1 \/>/;
413                         push @newlines, $i;
414                 }
415                 elsif ($i =~ /.*>$/)
416                 {
417                         $conline .= " $i";
418                         $conline =~ s/(.*)>$/\1 \/>/;
419                         push @blanks, "";
420                         push @newlines, $conline;
421                         push @newlines, @blanks;
422                         $conline = "";
423                         undef @blanks;
424                 }
425                 elsif ($i =~ /^<.*/)
426                 {
427                         $conline = $i;
428                 }
429                 elsif ($conline =~ /^<.*/ && $i)
430                 {
431                         $conline .= " $i";
432                         push @blanks, "";
433                 }
434                 else
435                 {
436                         if ($conline)
437                         {
438                                 push @blanks, $i;
439                         }
440                         else
441                         {
442                                 push @newlines, $i;
443                         }
444                 }
445         }
446         if ($conline)
447         {
448                 push @newlines, $conline;
449                 push @newlines, @blanks;
450         }
451
452         push @newlines, "</config>";
453
454         my $tmpfile;
455         do
456         {
457                 $tmpfile = tmpnam();
458         } until sysopen(TF, $tmpfile, O_RDWR|O_CREAT|O_EXCL|O_NOFOLLOW, 0700);
459
460         foreach $n (@newlines)
461         {
462                 print TF "$n\n";
463         }
464         close TF;
465
466         my @result = `xmllint -noout $tmpfile 2>&1`;
467         chomp(@result);
468
469         my $skip = 0;
470         foreach $n (@result)
471         {
472                 if ($skip)
473                 {
474                         $skip = 0;
475                         next;
476                 }
477                 $n =~ s/$tmpfile\:\d*\: *//g;
478                 if ($n =~ /.*config>.*/)
479                 {
480                         $n = "";
481                         $skip = 1;
482                 }
483
484                 if ($n && !$skip)
485                 {
486                         if ($n =~ /line \d*/)
487                         {
488                                 my $lineno = $n;
489                                 $lineno =~ s/.*line (\d*).*/\1/;
490                                 $lineno = $lineno-2;
491                                 $n =~ s/line (\d*)/line $lineno/;
492                         }
493                         print "$file : $n\n";
494                 }
495         }
496         unlink($tmpfile);
497 }