--- /dev/null
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+\f
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+\f
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+\f
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+\f
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
--- /dev/null
+The majority of this code is written from scratch for
+SurrealServices/SrSv, however some modules from CPAN have been imported
+into our tree, and/or modified for our use.
+
+SurrealServices has the following copyrights:
+
+Copyright tabris@surrealchat.net (tabris@tabris.net) 2004, 2005, 2006, 2007, 2008
+Copyright saturn@surrealchat.net 2004, 2005, 2006, 2007, 2008
+Copyright errietta@hotmail.com 2008
+
+We do not claim ownership of the following modules which we have
+imported into our tree:
+
+Digest::SHA::PurePerl
+
+Crypt::SaltedHash is no longer in this project, its code has been
+replaced.
+
+Date::Parse
--- /dev/null
+# Date::Parse $Id: //depot/TimeDate/lib/Date/Parse.pm#22 $
+#
+# Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+# software; you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+
+package Date::Parse;
+
+require 5.000;
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+use Time::Local;
+use Carp;
+use Time::Zone;
+use Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&strtotime &str2time &strptime);
+
+$VERSION = "2.27";
+
+my %month = (
+ january => 0,
+ february => 1,
+ march => 2,
+ april => 3,
+ may => 4,
+ june => 5,
+ july => 6,
+ august => 7,
+ september => 8,
+ sept => 8,
+ october => 9,
+ november => 10,
+ december => 11,
+ );
+
+my %day = (
+ sunday => 0,
+ monday => 1,
+ tuesday => 2,
+ tues => 2,
+ wednesday => 3,
+ wednes => 3,
+ thursday => 4,
+ thur => 4,
+ thurs => 4,
+ friday => 5,
+ saturday => 6,
+ );
+
+my @suf = (qw(th st nd rd th th th th th th)) x 3;
+@suf[11,12,13] = qw(th th th);
+
+#Abbreviations
+
+map { $month{substr($_,0,3)} = $month{$_} } keys %month;
+map { $day{substr($_,0,3)} = $day{$_} } keys %day;
+
+my $strptime = <<'ESQ';
+ my %month = map { lc $_ } %$mon_ref;
+ my $daypat = join("|", map { lc $_ } reverse sort keys %$day_ref);
+ my $monpat = join("|", reverse sort keys %month);
+ my $sufpat = join("|", reverse sort map { lc $_ } @$suf_ref);
+
+ my %ampm = (
+ 'a' => 0, # AM
+ 'p' => 12, # PM
+ );
+
+ my($AM, $PM) = (0,12);
+
+sub {
+
+ my $dtstr = lc shift;
+ my $merid = 24;
+
+ my($year,$month,$day,$hh,$mm,$ss,$zone,$dst,$frac);
+
+ $zone = tz_offset(shift) if @_;
+
+ 1 while $dtstr =~ s#\([^\(\)]*\)# #o;
+
+ $dtstr =~ s#(\A|\n|\Z)# #sog;
+
+ # ignore day names
+ $dtstr =~ s#([\d\w\s])[\.\,]\s#$1 #sog;
+ $dtstr =~ s/,/ /g;
+ $dtstr =~ s#($daypat)\s*(den\s)?# #o;
+ # Time: 12:00 or 12:00:00 with optional am/pm
+
+ return unless $dtstr =~ /\S/;
+
+ if ($dtstr =~ s/\s(\d{4})([-:]?)(\d\d?)\2(\d\d?)(?:[Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
+ ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$3-1,$4,$5,$7,$8,$9);
+ }
+
+ unless (defined $hh) {
+ if ($dtstr =~ s#[:\s](\d\d?):(\d\d?)(:(\d\d?)(?:\.\d+)?)?\s*(?:([ap])\.?m?\.?)?\s# #o) {
+ ($hh,$mm,$ss) = ($1,$2,$4 || 0);
+ $merid = $ampm{$5} if $5;
+ }
+
+ # Time: 12 am
+
+ elsif ($dtstr =~ s#\s(\d\d?)\s*([ap])\.?m?\.?\s# #o) {
+ ($hh,$mm,$ss) = ($1,0,0);
+ $merid = $ampm{$2};
+ }
+ }
+
+ if (defined $hh and $hh <= 12 and $dtstr =~ s# ([ap])\.?m?\.?\s# #o) {
+ $merid = $ampm{$1};
+ }
+
+
+ unless (defined $year) {
+ # Date: 12-June-96 (using - . or /)
+
+ if ($dtstr =~ s#\s(\d\d?)([\-\./])($monpat)(\2(\d\d+))?\s# #o) {
+ ($month,$day) = ($month{$3},$1);
+ $year = $5 if $5;
+ }
+
+ # Date: 12-12-96 (using '-', '.' or '/' )
+
+ elsif ($dtstr =~ s#\s(\d+)([\-\./])(\d\d?)(\2(\d+))?\s# #o) {
+ ($month,$day) = ($1 - 1,$3);
+
+ if ($5) {
+ $year = $5;
+ # Possible match for 1995-01-24 (short mainframe date format);
+ ($year,$month,$day) = ($1, $3 - 1, $5) if $month > 12;
+ return if length($year) > 2 and $year < 1901;
+ }
+ }
+ elsif ($dtstr =~ s#\s(\d+)\s*($sufpat)?\s*($monpat)# #o) {
+ ($month,$day) = ($month{$3},$1);
+ }
+ elsif ($dtstr =~ s#($monpat)\s*(\d+)\s*($sufpat)?\s# #o) {
+ ($month,$day) = ($month{$1},$2);
+ }
+
+ # Date: 961212
+
+ elsif ($dtstr =~ s#\s(\d\d)(\d\d)(\d\d)\s# #o) {
+ ($year,$month,$day) = ($1,$2-1,$3);
+ }
+
+ $year = $1 if !defined($year) and $dtstr =~ s#\s(\d{2}(\d{2})?)[\s\.,]# #o;
+
+ }
+
+ # Zone
+
+ $dst = 1 if $dtstr =~ s#\bdst\b##o;
+
+ if ($dtstr =~ s#\s"?([a-z]{3,4})(dst|\d+[a-z]*|_[a-z]+)?"?\s# #o) {
+ $dst = 1 if $2 and $2 eq 'dst';
+ $zone = tz_offset($1);
+ return unless defined $zone;
+ }
+ elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?):?(\d\d)?(00)?\s# #o) {
+ my $m = defined($4) ? "$2$4" : 0;
+ my $h = "$2$3";
+ $zone = defined($1) ? tz_offset($1) : 0;
+ return unless defined $zone;
+ $zone += 60 * ($m + (60 * $h));
+ }
+
+ if ($dtstr =~ /\S/) {
+ # now for some dumb dates
+ if ($dtstr =~ s/^\s*(ut?|z)\s*$//) {
+ $zone = 0;
+ }
+ elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) {
+ my $m = defined($4) ? "$2$4" : 0;
+ my $h = "$2$3";
+ $zone = defined($1) ? tz_offset($1) : 0;
+ return unless defined $zone;
+ $zone += 60 * ($m + (60 * $h));
+ }
+
+ return if $dtstr =~ /\S/o;
+ }
+
+ if (defined $hh) {
+ if ($hh == 12) {
+ $hh = 0 if $merid == $AM;
+ }
+ elsif ($merid == $PM) {
+ $hh += 12;
+ }
+ }
+
+ $year -= 1900 if defined $year && $year > 1900;
+
+ $zone += 3600 if defined $zone && $dst;
+ $ss += "0.$frac" if $frac;
+
+ return ($ss,$mm,$hh,$day,$month,$year,$zone);
+}
+ESQ
+
+use vars qw($day_ref $mon_ref $suf_ref $obj);
+
+sub gen_parser
+{
+ local($day_ref,$mon_ref,$suf_ref,$obj) = @_;
+
+ if($obj)
+ {
+ my $obj_strptime = $strptime;
+ substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
+ shift; # package
+ESQ
+ my $sub = eval "$obj_strptime" or die $@;
+ return $sub;
+ }
+
+ eval "$strptime" or die $@;
+
+}
+
+*strptime = gen_parser(\%day,\%month,\@suf);
+
+sub str2time
+{
+ my @t = strptime(@_);
+
+ return undef
+ unless @t;
+
+ my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
+ my @lt = localtime(time);
+
+ $hh ||= 0;
+ $mm ||= 0;
+ $ss ||= 0;
+
+ my $frac = $ss - int($ss);
+ $ss = int $ss;
+
+ $month = $lt[4]
+ unless(defined $month);
+
+ $day = $lt[3]
+ unless(defined $day);
+
+ $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
+ unless(defined $year);
+
+ return undef
+ unless($month <= 11 && $day >= 1 && $day <= 31
+ && $hh <= 23 && $mm <= 59 && $ss <= 59);
+
+ my $result;
+
+ if (defined $zone) {
+ $result = eval {
+ local $SIG{__DIE__} = sub {}; # Ick!
+ timegm($ss,$mm,$hh,$day,$month,$year);
+ };
+ return undef
+ if !defined $result
+ or $result == -1
+ && join("",$ss,$mm,$hh,$day,$month,$year)
+ ne "595923311169";
+ $result -= $zone;
+ }
+ else {
+ $result = eval {
+ local $SIG{__DIE__} = sub {}; # Ick!
+ timelocal($ss,$mm,$hh,$day,$month,$year);
+ };
+ return undef
+ if !defined $result
+ or $result == -1
+ && join("",$ss,$mm,$hh,$day,$month,$year)
+ ne join("",(localtime(-1))[0..5]);
+ }
+
+ return $result + $frac;
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Date::Parse - Parse date strings into time values
+
+=head1 SYNOPSIS
+
+ use Date::Parse;
+
+ $time = str2time($date);
+
+ ($ss,$mm,$hh,$day,$month,$year,$zone) = strptime($date);
+
+=head1 DESCRIPTION
+
+C<Date::Parse> provides two routines for parsing date strings into time values.
+
+=over 4
+
+=item str2time(DATE [, ZONE])
+
+C<str2time> parses C<DATE> and returns a unix time value, or undef upon failure.
+C<ZONE>, if given, specifies the timezone to assume when parsing if the
+date string does not specify a timezome.
+
+=item strptime(DATE [, ZONE])
+
+C<strptime> takes the same arguments as str2time but returns an array of
+values C<($ss,$mm,$hh,$day,$month,$year,$zone)>. Elements are only defined
+if they could be extracted from the date string. The C<$zone> element is
+the timezone offset in seconds from GMT. An empty array is returned upon
+failure.
+
+=head1 MULTI-LANGUAGE SUPPORT
+
+Date::Parse is capable of parsing dates in several languages, these are
+English, French, German and Italian.
+
+ $lang = Date::Language->new('German');
+ $lang->str2time("25 Jun 1996 21:09:55 +0100");
+
+=head1 EXAMPLE DATES
+
+Below is a sample list of dates that are known to be parsable with Date::Parse
+
+ 1995:01:24T09:08:17.1823213 ISO-8601
+ 1995-01-24T09:08:17.1823213
+ Wed, 16 Jun 94 07:29:35 CST Comma and day name are optional
+ Thu, 13 Oct 94 10:13:13 -0700
+ Wed, 9 Nov 1994 09:50:32 -0500 (EST) Text in ()'s will be ignored.
+ 21 dec 17:05 Will be parsed in the current time zone
+ 21-dec 17:05
+ 21/dec 17:05
+ 21/dec/93 17:05
+ 1999 10:02:18 "GMT"
+ 16 Nov 94 22:28:20 PST
+
+=head1 LIMITATION
+
+Date::Parse uses Time::Local internally, so is limited to only parsing dates
+which result in valid values for Time::Local::timelocal
+
+=head1 BUGS
+
+When both the month and the date are specified in the date as numbers
+they are always parsed assuming that the month number comes before the
+date. This is the usual format used in American dates.
+
+The reason why it is like this and not dynamic is that it must be
+deterministic. Several people have suggested using the current locale,
+but this will not work as the date being parsed may not be in the format
+of the current locale.
+
+My plans to address this, which will be in a future release, is to allow
+the programmer to state what order they want these values parsed in.
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+# $Id: //depot/TimeDate/lib/Date/Parse.pm#22 $
+
--- /dev/null
+package Digest::SHA::PurePerl;
+
+require 5.003000;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use integer;
+use FileHandle;
+
+$VERSION = '5.45';
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = (); # see "SHA and HMAC-SHA functions" below
+
+# If possible, inherit from Digest::base (which depends on MIME::Base64)
+
+*addfile = \&_Addfile;
+
+eval {
+ require MIME::Base64;
+ require Digest::base;
+ push(@ISA, 'Digest::base');
+};
+if ($@) {
+ *hexdigest = \&_Hexdigest;
+ *b64digest = \&_B64digest;
+}
+
+# ref. src/sha.c and sha/sha64bit.c from Digest::SHA
+
+my $MAX32 = 0xffffffff;
+my $TWO32 = 4294967296;
+
+my $uses64bit = (((1 << 16) << 16) << 16) << 15;
+
+
+my @H01 = ( # SHA-1 initial hash value
+ 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476,
+ 0xc3d2e1f0
+);
+
+my @H0224 = ( # SHA-224 initial hash value
+ 0xc1059ed8, 0x367cd507, 0x3070dd17, 0xf70e5939,
+ 0xffc00b31, 0x68581511, 0x64f98fa7, 0xbefa4fa4
+);
+
+my @H0256 = ( # SHA-256 initial hash value
+ 0x6a09e667, 0xbb67ae85, 0x3c6ef372, 0xa54ff53a,
+ 0x510e527f, 0x9b05688c, 0x1f83d9ab, 0x5be0cd19
+);
+
+my(@H0384, @H0512); # filled in later if $uses64bit
+
+# Routines with a "_c_" prefix return Perl code-fragments which are
+# eval'ed at initialization. This technique emulates the behavior
+# of the C preprocessor, allowing the optimized transform code from
+# Digest::SHA to be more easily translated into Perl.
+
+sub _c_SL32 { # code to shift $x left by $n bits
+ my($x, $n) = @_;
+ "($x << $n)"; # even works for 64-bit integers
+ # since the upper 32 bits are
+ # eventually discarded in _digcpy
+}
+
+sub _c_SR32 { # code to shift $x right by $n bits
+ my($x, $n) = @_;
+ my $mask = (1 << (32 - $n)) - 1;
+ "(($x >> $n) & $mask)"; # "use integer" does arithmetic
+ # shift, so clear upper bits
+}
+
+sub _c_Ch { my($x, $y, $z) = @_; "($z ^ ($x & ($y ^ $z)))" }
+sub _c_Pa { my($x, $y, $z) = @_; "($x ^ $y ^ $z)" }
+sub _c_Ma { my($x, $y, $z) = @_; "(($x & $y) | ($z & ($x | $y)))" }
+
+sub _c_ROTR { # code to rotate $x right by $n bits
+ my($x, $n) = @_;
+ "(" . _c_SR32($x, $n) . " | " . _c_SL32($x, 32 - $n) . ")";
+}
+
+sub _c_ROTL { # code to rotate $x left by $n bits
+ my($x, $n) = @_;
+ "(" . _c_SL32($x, $n) . " | " . _c_SR32($x, 32 - $n) . ")";
+}
+
+sub _c_SIGMA0 { # ref. NIST SHA standard
+ my($x) = @_;
+ "(" . _c_ROTR($x, 2) . " ^ " . _c_ROTR($x, 13) . " ^ " .
+ _c_ROTR($x, 22) . ")";
+}
+
+sub _c_SIGMA1 {
+ my($x) = @_;
+ "(" . _c_ROTR($x, 6) . " ^ " . _c_ROTR($x, 11) . " ^ " .
+ _c_ROTR($x, 25) . ")";
+}
+
+sub _c_sigma0 {
+ my($x) = @_;
+ "(" . _c_ROTR($x, 7) . " ^ " . _c_ROTR($x, 18) . " ^ " .
+ _c_SR32($x, 3) . ")";
+}
+
+sub _c_sigma1 {
+ my($x) = @_;
+ "(" . _c_ROTR($x, 17) . " ^ " . _c_ROTR($x, 19) . " ^ " .
+ _c_SR32($x, 10) . ")";
+}
+
+sub _c_M1Ch { # ref. Digest::SHA sha.c (sha1 routine)
+ my($a, $b, $c, $d, $e, $k, $w) = @_;
+ "$e += " . _c_ROTL($a, 5) . " + " . _c_Ch($b, $c, $d) .
+ " + $k + $w; $b = " . _c_ROTL($b, 30) . ";\n";
+}
+
+sub _c_M1Pa {
+ my($a, $b, $c, $d, $e, $k, $w) = @_;
+ "$e += " . _c_ROTL($a, 5) . " + " . _c_Pa($b, $c, $d) .
+ " + $k + $w; $b = " . _c_ROTL($b, 30) . ";\n";
+}
+
+sub _c_M1Ma {
+ my($a, $b, $c, $d, $e, $k, $w) = @_;
+ "$e += " . _c_ROTL($a, 5) . " + " . _c_Ma($b, $c, $d) .
+ " + $k + $w; $b = " . _c_ROTL($b, 30) . ";\n";
+}
+
+sub _c_M11Ch { my($k, $w) = @_; _c_M1Ch('$a', '$b', '$c', '$d', '$e', $k, $w) }
+sub _c_M11Pa { my($k, $w) = @_; _c_M1Pa('$a', '$b', '$c', '$d', '$e', $k, $w) }
+sub _c_M11Ma { my($k, $w) = @_; _c_M1Ma('$a', '$b', '$c', '$d', '$e', $k, $w) }
+sub _c_M12Ch { my($k, $w) = @_; _c_M1Ch('$e', '$a', '$b', '$c', '$d', $k, $w) }
+sub _c_M12Pa { my($k, $w) = @_; _c_M1Pa('$e', '$a', '$b', '$c', '$d', $k, $w) }
+sub _c_M12Ma { my($k, $w) = @_; _c_M1Ma('$e', '$a', '$b', '$c', '$d', $k, $w) }
+sub _c_M13Ch { my($k, $w) = @_; _c_M1Ch('$d', '$e', '$a', '$b', '$c', $k, $w) }
+sub _c_M13Pa { my($k, $w) = @_; _c_M1Pa('$d', '$e', '$a', '$b', '$c', $k, $w) }
+sub _c_M13Ma { my($k, $w) = @_; _c_M1Ma('$d', '$e', '$a', '$b', '$c', $k, $w) }
+sub _c_M14Ch { my($k, $w) = @_; _c_M1Ch('$c', '$d', '$e', '$a', '$b', $k, $w) }
+sub _c_M14Pa { my($k, $w) = @_; _c_M1Pa('$c', '$d', '$e', '$a', '$b', $k, $w) }
+sub _c_M14Ma { my($k, $w) = @_; _c_M1Ma('$c', '$d', '$e', '$a', '$b', $k, $w) }
+sub _c_M15Ch { my($k, $w) = @_; _c_M1Ch('$b', '$c', '$d', '$e', '$a', $k, $w) }
+sub _c_M15Pa { my($k, $w) = @_; _c_M1Pa('$b', '$c', '$d', '$e', '$a', $k, $w) }
+sub _c_M15Ma { my($k, $w) = @_; _c_M1Ma('$b', '$c', '$d', '$e', '$a', $k, $w) }
+
+sub _c_W11 { my($s) = @_; '$W[' . (($s + 0) & 0xf) . ']' }
+sub _c_W12 { my($s) = @_; '$W[' . (($s + 13) & 0xf) . ']' }
+sub _c_W13 { my($s) = @_; '$W[' . (($s + 8) & 0xf) . ']' }
+sub _c_W14 { my($s) = @_; '$W[' . (($s + 2) & 0xf) . ']' }
+
+sub _c_A1 {
+ my($s) = @_;
+ my $tmp = _c_W11($s) . " ^ " . _c_W12($s) . " ^ " .
+ _c_W13($s) . " ^ " . _c_W14($s);
+ "((\$tmp = $tmp), (" . _c_W11($s) . " = " . _c_ROTL('$tmp', 1) . "))";
+}
+
+# The following code emulates the "sha1" routine from Digest::SHA sha.c
+
+my $sha1_code = '
+
+my($K1, $K2, $K3, $K4) = ( # SHA-1 constants
+ 0x5a827999, 0x6ed9eba1, 0x8f1bbcdc, 0xca62c1d6
+);
+
+sub _sha1 {
+ my($self, $block) = @_;
+ my(@W, $a, $b, $c, $d, $e, $tmp);
+
+ @W = unpack("N16", $block);
+ ($a, $b, $c, $d, $e) = @{$self->{H}};
+' .
+ _c_M11Ch('$K1', '$W[ 0]' ) . _c_M12Ch('$K1', '$W[ 1]' ) .
+ _c_M13Ch('$K1', '$W[ 2]' ) . _c_M14Ch('$K1', '$W[ 3]' ) .
+ _c_M15Ch('$K1', '$W[ 4]' ) . _c_M11Ch('$K1', '$W[ 5]' ) .
+ _c_M12Ch('$K1', '$W[ 6]' ) . _c_M13Ch('$K1', '$W[ 7]' ) .
+ _c_M14Ch('$K1', '$W[ 8]' ) . _c_M15Ch('$K1', '$W[ 9]' ) .
+ _c_M11Ch('$K1', '$W[10]' ) . _c_M12Ch('$K1', '$W[11]' ) .
+ _c_M13Ch('$K1', '$W[12]' ) . _c_M14Ch('$K1', '$W[13]' ) .
+ _c_M15Ch('$K1', '$W[14]' ) . _c_M11Ch('$K1', '$W[15]' ) .
+ _c_M12Ch('$K1', _c_A1( 0) ) . _c_M13Ch('$K1', _c_A1( 1) ) .
+ _c_M14Ch('$K1', _c_A1( 2) ) . _c_M15Ch('$K1', _c_A1( 3) ) .
+ _c_M11Pa('$K2', _c_A1( 4) ) . _c_M12Pa('$K2', _c_A1( 5) ) .
+ _c_M13Pa('$K2', _c_A1( 6) ) . _c_M14Pa('$K2', _c_A1( 7) ) .
+ _c_M15Pa('$K2', _c_A1( 8) ) . _c_M11Pa('$K2', _c_A1( 9) ) .
+ _c_M12Pa('$K2', _c_A1(10) ) . _c_M13Pa('$K2', _c_A1(11) ) .
+ _c_M14Pa('$K2', _c_A1(12) ) . _c_M15Pa('$K2', _c_A1(13) ) .
+ _c_M11Pa('$K2', _c_A1(14) ) . _c_M12Pa('$K2', _c_A1(15) ) .
+ _c_M13Pa('$K2', _c_A1( 0) ) . _c_M14Pa('$K2', _c_A1( 1) ) .
+ _c_M15Pa('$K2', _c_A1( 2) ) . _c_M11Pa('$K2', _c_A1( 3) ) .
+ _c_M12Pa('$K2', _c_A1( 4) ) . _c_M13Pa('$K2', _c_A1( 5) ) .
+ _c_M14Pa('$K2', _c_A1( 6) ) . _c_M15Pa('$K2', _c_A1( 7) ) .
+ _c_M11Ma('$K3', _c_A1( 8) ) . _c_M12Ma('$K3', _c_A1( 9) ) .
+ _c_M13Ma('$K3', _c_A1(10) ) . _c_M14Ma('$K3', _c_A1(11) ) .
+ _c_M15Ma('$K3', _c_A1(12) ) . _c_M11Ma('$K3', _c_A1(13) ) .
+ _c_M12Ma('$K3', _c_A1(14) ) . _c_M13Ma('$K3', _c_A1(15) ) .
+ _c_M14Ma('$K3', _c_A1( 0) ) . _c_M15Ma('$K3', _c_A1( 1) ) .
+ _c_M11Ma('$K3', _c_A1( 2) ) . _c_M12Ma('$K3', _c_A1( 3) ) .
+ _c_M13Ma('$K3', _c_A1( 4) ) . _c_M14Ma('$K3', _c_A1( 5) ) .
+ _c_M15Ma('$K3', _c_A1( 6) ) . _c_M11Ma('$K3', _c_A1( 7) ) .
+ _c_M12Ma('$K3', _c_A1( 8) ) . _c_M13Ma('$K3', _c_A1( 9) ) .
+ _c_M14Ma('$K3', _c_A1(10) ) . _c_M15Ma('$K3', _c_A1(11) ) .
+ _c_M11Pa('$K4', _c_A1(12) ) . _c_M12Pa('$K4', _c_A1(13) ) .
+ _c_M13Pa('$K4', _c_A1(14) ) . _c_M14Pa('$K4', _c_A1(15) ) .
+ _c_M15Pa('$K4', _c_A1( 0) ) . _c_M11Pa('$K4', _c_A1( 1) ) .
+ _c_M12Pa('$K4', _c_A1( 2) ) . _c_M13Pa('$K4', _c_A1( 3) ) .
+ _c_M14Pa('$K4', _c_A1( 4) ) . _c_M15Pa('$K4', _c_A1( 5) ) .
+ _c_M11Pa('$K4', _c_A1( 6) ) . _c_M12Pa('$K4', _c_A1( 7) ) .
+ _c_M13Pa('$K4', _c_A1( 8) ) . _c_M14Pa('$K4', _c_A1( 9) ) .
+ _c_M15Pa('$K4', _c_A1(10) ) . _c_M11Pa('$K4', _c_A1(11) ) .
+ _c_M12Pa('$K4', _c_A1(12) ) . _c_M13Pa('$K4', _c_A1(13) ) .
+ _c_M14Pa('$K4', _c_A1(14) ) . _c_M15Pa('$K4', _c_A1(15) ) .
+
+' $self->{H}->[0] += $a; $self->{H}->[1] += $b; $self->{H}->[2] += $c;
+ $self->{H}->[3] += $d; $self->{H}->[4] += $e;
+}
+';
+
+eval($sha1_code);
+
+sub _c_M2 { # ref. Digest::SHA sha.c (sha256 routine)
+ my($a, $b, $c, $d, $e, $f, $g, $h, $w) = @_;
+ "\$T1 = $h + " . _c_SIGMA1($e) . " + " . _c_Ch($e, $f, $g) .
+ " + \$K256[\$i++] + $w; $h = \$T1 + " . _c_SIGMA0($a) .
+ " + " . _c_Ma($a, $b, $c) . "; $d += \$T1;\n";
+}
+
+sub _c_M21 { _c_M2('$a', '$b', '$c', '$d', '$e', '$f', '$g', '$h', $_[0]) }
+sub _c_M22 { _c_M2('$h', '$a', '$b', '$c', '$d', '$e', '$f', '$g', $_[0]) }
+sub _c_M23 { _c_M2('$g', '$h', '$a', '$b', '$c', '$d', '$e', '$f', $_[0]) }
+sub _c_M24 { _c_M2('$f', '$g', '$h', '$a', '$b', '$c', '$d', '$e', $_[0]) }
+sub _c_M25 { _c_M2('$e', '$f', '$g', '$h', '$a', '$b', '$c', '$d', $_[0]) }
+sub _c_M26 { _c_M2('$d', '$e', '$f', '$g', '$h', '$a', '$b', '$c', $_[0]) }
+sub _c_M27 { _c_M2('$c', '$d', '$e', '$f', '$g', '$h', '$a', '$b', $_[0]) }
+sub _c_M28 { _c_M2('$b', '$c', '$d', '$e', '$f', '$g', '$h', '$a', $_[0]) }
+
+sub _c_W21 { my($s) = @_; '$W[' . (($s + 0) & 0xf) . ']' }
+sub _c_W22 { my($s) = @_; '$W[' . (($s + 14) & 0xf) . ']' }
+sub _c_W23 { my($s) = @_; '$W[' . (($s + 9) & 0xf) . ']' }
+sub _c_W24 { my($s) = @_; '$W[' . (($s + 1) & 0xf) . ']' }
+
+sub _c_A2 {
+ my($s) = @_;
+ "(" . _c_W21($s) . " += " . _c_sigma1(_c_W22($s)) . " + " .
+ _c_W23($s) . " + " . _c_sigma0(_c_W24($s)) . ")";
+}
+
+# The following code emulates the "sha256" routine from Digest::SHA sha.c
+
+my $sha256_code = '
+
+my @K256 = ( # SHA-224/256 constants
+ 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5,
+ 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5,
+ 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3,
+ 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174,
+ 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc,
+ 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da,
+ 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7,
+ 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967,
+ 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13,
+ 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85,
+ 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3,
+ 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070,
+ 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5,
+ 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3,
+ 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208,
+ 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2
+);
+
+sub _sha256 {
+ my($self, $block) = @_;
+ my(@W, $a, $b, $c, $d, $e, $f, $g, $h, $i, $T1);
+
+ @W = unpack("N16", $block);
+ ($a, $b, $c, $d, $e, $f, $g, $h) = @{$self->{H}};
+' .
+ _c_M21('$W[ 0]' ) . _c_M22('$W[ 1]' ) . _c_M23('$W[ 2]' ) .
+ _c_M24('$W[ 3]' ) . _c_M25('$W[ 4]' ) . _c_M26('$W[ 5]' ) .
+ _c_M27('$W[ 6]' ) . _c_M28('$W[ 7]' ) . _c_M21('$W[ 8]' ) .
+ _c_M22('$W[ 9]' ) . _c_M23('$W[10]' ) . _c_M24('$W[11]' ) .
+ _c_M25('$W[12]' ) . _c_M26('$W[13]' ) . _c_M27('$W[14]' ) .
+ _c_M28('$W[15]' ) .
+ _c_M21(_c_A2( 0)) . _c_M22(_c_A2( 1)) . _c_M23(_c_A2( 2)) .
+ _c_M24(_c_A2( 3)) . _c_M25(_c_A2( 4)) . _c_M26(_c_A2( 5)) .
+ _c_M27(_c_A2( 6)) . _c_M28(_c_A2( 7)) . _c_M21(_c_A2( 8)) .
+ _c_M22(_c_A2( 9)) . _c_M23(_c_A2(10)) . _c_M24(_c_A2(11)) .
+ _c_M25(_c_A2(12)) . _c_M26(_c_A2(13)) . _c_M27(_c_A2(14)) .
+ _c_M28(_c_A2(15)) . _c_M21(_c_A2( 0)) . _c_M22(_c_A2( 1)) .
+ _c_M23(_c_A2( 2)) . _c_M24(_c_A2( 3)) . _c_M25(_c_A2( 4)) .
+ _c_M26(_c_A2( 5)) . _c_M27(_c_A2( 6)) . _c_M28(_c_A2( 7)) .
+ _c_M21(_c_A2( 8)) . _c_M22(_c_A2( 9)) . _c_M23(_c_A2(10)) .
+ _c_M24(_c_A2(11)) . _c_M25(_c_A2(12)) . _c_M26(_c_A2(13)) .
+ _c_M27(_c_A2(14)) . _c_M28(_c_A2(15)) . _c_M21(_c_A2( 0)) .
+ _c_M22(_c_A2( 1)) . _c_M23(_c_A2( 2)) . _c_M24(_c_A2( 3)) .
+ _c_M25(_c_A2( 4)) . _c_M26(_c_A2( 5)) . _c_M27(_c_A2( 6)) .
+ _c_M28(_c_A2( 7)) . _c_M21(_c_A2( 8)) . _c_M22(_c_A2( 9)) .
+ _c_M23(_c_A2(10)) . _c_M24(_c_A2(11)) . _c_M25(_c_A2(12)) .
+ _c_M26(_c_A2(13)) . _c_M27(_c_A2(14)) . _c_M28(_c_A2(15)) .
+
+' $self->{H}->[0] += $a; $self->{H}->[1] += $b; $self->{H}->[2] += $c;
+ $self->{H}->[3] += $d; $self->{H}->[4] += $e; $self->{H}->[5] += $f;
+ $self->{H}->[6] += $g; $self->{H}->[7] += $h;
+}
+';
+
+eval($sha256_code);
+
+sub _sha512_placeholder { return }
+my $sha512 = \&_sha512_placeholder;
+
+my $_64bit_code = '
+
+BEGIN { $^W = 0 } # suppress warnings triggered by 64-bit constants
+
+my @K512 = (
+ 0x428a2f98d728ae22, 0x7137449123ef65cd, 0xb5c0fbcfec4d3b2f,
+ 0xe9b5dba58189dbbc, 0x3956c25bf348b538, 0x59f111f1b605d019,
+ 0x923f82a4af194f9b, 0xab1c5ed5da6d8118, 0xd807aa98a3030242,
+ 0x12835b0145706fbe, 0x243185be4ee4b28c, 0x550c7dc3d5ffb4e2,
+ 0x72be5d74f27b896f, 0x80deb1fe3b1696b1, 0x9bdc06a725c71235,
+ 0xc19bf174cf692694, 0xe49b69c19ef14ad2, 0xefbe4786384f25e3,
+ 0x0fc19dc68b8cd5b5, 0x240ca1cc77ac9c65, 0x2de92c6f592b0275,
+ 0x4a7484aa6ea6e483, 0x5cb0a9dcbd41fbd4, 0x76f988da831153b5,
+ 0x983e5152ee66dfab, 0xa831c66d2db43210, 0xb00327c898fb213f,
+ 0xbf597fc7beef0ee4, 0xc6e00bf33da88fc2, 0xd5a79147930aa725,
+ 0x06ca6351e003826f, 0x142929670a0e6e70, 0x27b70a8546d22ffc,
+ 0x2e1b21385c26c926, 0x4d2c6dfc5ac42aed, 0x53380d139d95b3df,
+ 0x650a73548baf63de, 0x766a0abb3c77b2a8, 0x81c2c92e47edaee6,
+ 0x92722c851482353b, 0xa2bfe8a14cf10364, 0xa81a664bbc423001,
+ 0xc24b8b70d0f89791, 0xc76c51a30654be30, 0xd192e819d6ef5218,
+ 0xd69906245565a910, 0xf40e35855771202a, 0x106aa07032bbd1b8,
+ 0x19a4c116b8d2d0c8, 0x1e376c085141ab53, 0x2748774cdf8eeb99,
+ 0x34b0bcb5e19b48a8, 0x391c0cb3c5c95a63, 0x4ed8aa4ae3418acb,
+ 0x5b9cca4f7763e373, 0x682e6ff3d6b2b8a3, 0x748f82ee5defb2fc,
+ 0x78a5636f43172f60, 0x84c87814a1f0ab72, 0x8cc702081a6439ec,
+ 0x90befffa23631e28, 0xa4506cebde82bde9, 0xbef9a3f7b2c67915,
+ 0xc67178f2e372532b, 0xca273eceea26619c, 0xd186b8c721c0c207,
+ 0xeada7dd6cde0eb1e, 0xf57d4f7fee6ed178, 0x06f067aa72176fba,
+ 0x0a637dc5a2c898a6, 0x113f9804bef90dae, 0x1b710b35131c471b,
+ 0x28db77f523047d84, 0x32caab7b40c72493, 0x3c9ebe0a15c9bebc,
+ 0x431d67c49c100d4c, 0x4cc5d4becb3e42b6, 0x597f299cfc657e2a,
+ 0x5fcb6fab3ad6faec, 0x6c44198c4a475817);
+
+@H0384 = (
+ 0xcbbb9d5dc1059ed8, 0x629a292a367cd507, 0x9159015a3070dd17,
+ 0x152fecd8f70e5939, 0x67332667ffc00b31, 0x8eb44a8768581511,
+ 0xdb0c2e0d64f98fa7, 0x47b5481dbefa4fa4);
+
+@H0512 = (
+ 0x6a09e667f3bcc908, 0xbb67ae8584caa73b, 0x3c6ef372fe94f82b,
+ 0xa54ff53a5f1d36f1, 0x510e527fade682d1, 0x9b05688c2b3e6c1f,
+ 0x1f83d9abfb41bd6b, 0x5be0cd19137e2179);
+
+sub _c_SL64 { my($x, $n) = @_; "($x << $n)" }
+
+sub _c_SR64 {
+ my($x, $n) = @_;
+ my $mask = (1 << (64 - $n)) - 1;
+ "(($x >> $n) & $mask)";
+}
+
+sub _c_ROTRQ {
+ my($x, $n) = @_;
+ "(" . _c_SR64($x, $n) . " | " . _c_SL64($x, 64 - $n) . ")";
+}
+
+sub _c_SIGMAQ0 {
+ my($x) = @_;
+ "(" . _c_ROTRQ($x, 28) . " ^ " . _c_ROTRQ($x, 34) . " ^ " .
+ _c_ROTRQ($x, 39) . ")";
+}
+
+sub _c_SIGMAQ1 {
+ my($x) = @_;
+ "(" . _c_ROTRQ($x, 14) . " ^ " . _c_ROTRQ($x, 18) . " ^ " .
+ _c_ROTRQ($x, 41) . ")";
+}
+
+sub _c_sigmaQ0 {
+ my($x) = @_;
+ "(" . _c_ROTRQ($x, 1) . " ^ " . _c_ROTRQ($x, 8) . " ^ " .
+ _c_SR64($x, 7) . ")";
+}
+
+sub _c_sigmaQ1 {
+ my($x) = @_;
+ "(" . _c_ROTRQ($x, 19) . " ^ " . _c_ROTRQ($x, 61) . " ^ " .
+ _c_SR64($x, 6) . ")";
+}
+
+my $sha512_code = q/
+sub _sha512 {
+ my($self, $block) = @_;
+ my(@N, @W, $a, $b, $c, $d, $e, $f, $g, $h, $T1, $T2);
+
+ @N = unpack("N32", $block);
+ ($a, $b, $c, $d, $e, $f, $g, $h) = @{$self->{H}};
+ for ( 0 .. 15) { $W[$_] = (($N[2*$_] << 16) << 16) | $N[2*$_+1] }
+ for (16 .. 79) { $W[$_] = / .
+ _c_sigmaQ1(q/$W[$_- 2]/) . q/ + $W[$_- 7] + / .
+ _c_sigmaQ0(q/$W[$_-15]/) . q/ + $W[$_-16] }
+ for ( 0 .. 79) {
+ $T1 = $h + / . _c_SIGMAQ1(q/$e/) .
+ q/ + (($g) ^ (($e) & (($f) ^ ($g)))) +
+ $K512[$_] + $W[$_];
+ $T2 = / . _c_SIGMAQ0(q/$a/) .
+ q/ + ((($a) & ($b)) | (($c) & (($a) | ($b))));
+ $h = $g; $g = $f; $f = $e; $e = $d + $T1;
+ $d = $c; $c = $b; $b = $a; $a = $T1 + $T2;
+ }
+ $self->{H}->[0] += $a; $self->{H}->[1] += $b; $self->{H}->[2] += $c;
+ $self->{H}->[3] += $d; $self->{H}->[4] += $e; $self->{H}->[5] += $f;
+ $self->{H}->[6] += $g; $self->{H}->[7] += $h;
+}
+/;
+
+eval($sha512_code);
+$sha512 = \&_sha512;
+
+';
+
+eval($_64bit_code) if $uses64bit;
+
+sub _SETBIT {
+ my($self, $pos) = @_;
+ my @c = unpack("C*", $self->{block});
+ $c[$pos >> 3] = 0x00 unless defined $c[$pos >> 3];
+ $c[$pos >> 3] |= (0x01 << (7 - $pos % 8));
+ $self->{block} = pack("C*", @c);
+}
+
+sub _CLRBIT {
+ my($self, $pos) = @_;
+ my @c = unpack("C*", $self->{block});
+ $c[$pos >> 3] = 0x00 unless defined $c[$pos >> 3];
+ $c[$pos >> 3] &= ~(0x01 << (7 - $pos % 8));
+ $self->{block} = pack("C*", @c);
+}
+
+sub _BYTECNT {
+ my($bitcnt) = @_;
+ $bitcnt > 0 ? 1 + (($bitcnt - 1) >> 3) : 0;
+}
+
+sub _digcpy {
+ my($self) = @_;
+ my @dig;
+ for (@{$self->{H}}) {
+ push(@dig, (($_>>16)>>16) & $MAX32) if $self->{alg} >= 384;
+ push(@dig, $_ & $MAX32);
+ }
+ $self->{digest} = pack("N" . ($self->{digestlen}>>2), @dig);
+}
+
+sub _sharewind {
+ my($self) = @_;
+ my $alg = $self->{alg};
+ $self->{block} = ""; $self->{blockcnt} = 0;
+ $self->{blocksize} = $alg <= 256 ? 512 : 1024;
+ for (qw(lenll lenlh lenhl lenhh)) { $self->{$_} = 0 }
+ $self->{digestlen} = $alg == 1 ? 20 : $alg/8;
+ if ($alg == 1) { $self->{sha} = \&_sha1; $self->{H} = [@H01] }
+ elsif ($alg == 224) { $self->{sha} = \&_sha256; $self->{H} = [@H0224] }
+ elsif ($alg == 256) { $self->{sha} = \&_sha256; $self->{H} = [@H0256] }
+ elsif ($alg == 384) { $self->{sha} = $sha512; $self->{H} = [@H0384] }
+ elsif ($alg == 512) { $self->{sha} = $sha512; $self->{H} = [@H0512] }
+ push(@{$self->{H}}, 0) while scalar(@{$self->{H}}) < 8;
+ $self;
+}
+
+sub _shaopen {
+ my($alg) = @_;
+ my($self);
+ return unless grep { $alg == $_ } (1, 224, 256, 384, 512);
+ return if ($alg >= 384 && !$uses64bit);
+ $self->{alg} = $alg;
+ _sharewind($self);
+}
+
+sub _shadirect {
+ my($bitstr, $bitcnt, $self) = @_;
+ my $savecnt = $bitcnt;
+ my $offset = 0;
+ my $blockbytes = $self->{blocksize} >> 3;
+ while ($bitcnt >= $self->{blocksize}) {
+ &{$self->{sha}}($self, substr($bitstr, $offset, $blockbytes));
+ $offset += $blockbytes;
+ $bitcnt -= $self->{blocksize};
+ }
+ if ($bitcnt > 0) {
+ $self->{block} = substr($bitstr, $offset, _BYTECNT($bitcnt));
+ $self->{blockcnt} = $bitcnt;
+ }
+ $savecnt;
+}
+
+sub _shabytes {
+ my($bitstr, $bitcnt, $self) = @_;
+ my($numbits);
+ my $savecnt = $bitcnt;
+ if ($self->{blockcnt} + $bitcnt >= $self->{blocksize}) {
+ $numbits = $self->{blocksize} - $self->{blockcnt};
+ $self->{block} .= substr($bitstr, 0, $numbits >> 3);
+ $bitcnt -= $numbits;
+ $bitstr = substr($bitstr, $numbits >> 3, _BYTECNT($bitcnt));
+ &{$self->{sha}}($self, $self->{block});
+ $self->{block} = "";
+ $self->{blockcnt} = 0;
+ _shadirect($bitstr, $bitcnt, $self);
+ }
+ else {
+ $self->{block} .= substr($bitstr, 0, _BYTECNT($bitcnt));
+ $self->{blockcnt} += $bitcnt;
+ }
+ $savecnt;
+}
+
+sub _shabits {
+ my($bitstr, $bitcnt, $self) = @_;
+ my($i, @buf);
+ my $numbytes = _BYTECNT($bitcnt);
+ my $savecnt = $bitcnt;
+ my $gap = 8 - $self->{blockcnt} % 8;
+ my @c = unpack("C*", $self->{block});
+ my @b = unpack("C" . $numbytes, $bitstr);
+ $c[$self->{blockcnt}>>3] &= (~0 << $gap);
+ $c[$self->{blockcnt}>>3] |= $b[0] >> (8 - $gap);
+ $self->{block} = pack("C*", @c);
+ $self->{blockcnt} += ($bitcnt < $gap) ? $bitcnt : $gap;
+ return($savecnt) if $bitcnt < $gap;
+ if ($self->{blockcnt} == $self->{blocksize}) {
+ &{$self->{sha}}($self, $self->{block});
+ $self->{block} = "";
+ $self->{blockcnt} = 0;
+ }
+ return($savecnt) if ($bitcnt -= $gap) == 0;
+ for ($i = 0; $i < $numbytes - 1; $i++) {
+ $buf[$i] = (($b[$i] << $gap) & 0xff) | ($b[$i+1] >> (8 - $gap));
+ }
+ $buf[$numbytes-1] = ($b[$numbytes-1] << $gap) & 0xff;
+ _shabytes(pack("C*", @buf), $bitcnt, $self);
+ $savecnt;
+}
+
+sub _shawrite {
+ my($bitstr, $bitcnt, $self) = @_;
+ return(0) unless $bitcnt > 0;
+ no integer;
+ if (($self->{lenll} += $bitcnt) >= $TWO32) {
+ $self->{lenll} -= $TWO32;
+ if (++$self->{lenlh} >= $TWO32) {
+ $self->{lenlh} -= $TWO32;
+ if (++$self->{lenhl} >= $TWO32) {
+ $self->{lenhl} -= $TWO32;
+ if (++$self->{lenhh} >= $TWO32) {
+ $self->{lenhh} -= $TWO32;
+ }
+ }
+ }
+ }
+ use integer;
+ my $blockcnt = $self->{blockcnt};
+ return(_shadirect($bitstr, $bitcnt, $self)) if $blockcnt == 0;
+ return(_shabytes ($bitstr, $bitcnt, $self)) if $blockcnt % 8 == 0;
+ return(_shabits ($bitstr, $bitcnt, $self));
+}
+
+sub _shafinish {
+ my($self) = @_;
+ my $LENPOS = $self->{alg} <= 256 ? 448 : 896;
+ _SETBIT($self, $self->{blockcnt}++);
+ while ($self->{blockcnt} > $LENPOS) {
+ if ($self->{blockcnt} < $self->{blocksize}) {
+ _CLRBIT($self, $self->{blockcnt}++);
+ }
+ else {
+ &{$self->{sha}}($self, $self->{block});
+ $self->{block} = "";
+ $self->{blockcnt} = 0;
+ }
+ }
+ while ($self->{blockcnt} < $LENPOS) {
+ _CLRBIT($self, $self->{blockcnt}++);
+ }
+ if ($self->{blocksize} > 512) {
+ $self->{block} .= pack("N", $self->{lenhh} & $MAX32);
+ $self->{block} .= pack("N", $self->{lenhl} & $MAX32);
+ }
+ $self->{block} .= pack("N", $self->{lenlh} & $MAX32);
+ $self->{block} .= pack("N", $self->{lenll} & $MAX32);
+ &{$self->{sha}}($self, $self->{block});
+}
+
+sub _shadigest { my($self) = @_; _digcpy($self); $self->{digest} }
+
+sub _shahex {
+ my($self) = @_;
+ _digcpy($self);
+ join("", unpack("H*", $self->{digest}));
+}
+
+sub _shabase64 {
+ my($self) = @_;
+ _digcpy($self);
+ my $b64 = pack("u", $self->{digest});
+ $b64 =~ s/^.//mg;
+ $b64 =~ s/\n//g;
+ $b64 =~ tr|` -_|AA-Za-z0-9+/|;
+ my $numpads = (3 - length($self->{digest}) % 3) % 3;
+ $b64 =~ s/.{$numpads}$// if $numpads;
+ $b64;
+}
+
+sub _shadsize { my($self) = @_; $self->{digestlen} }
+
+sub _shacpy {
+ my($to, $from) = @_;
+ $to->{alg} = $from->{alg};
+ $to->{sha} = $from->{sha};
+ $to->{H} = [@{$from->{H}}];
+ $to->{block} = $from->{block};
+ $to->{blockcnt} = $from->{blockcnt};
+ $to->{blocksize} = $from->{blocksize};
+ for (qw(lenhh lenhl lenlh lenll)) { $to->{$_} = $from->{$_} }
+ $to->{digestlen} = $from->{digestlen};
+ $to;
+}
+
+sub _shadup { my($self) = @_; my($copy); _shacpy($copy, $self) }
+
+sub _shadump {
+ my $file = shift;
+ $file = "-" if (!defined($file) || $file eq "");
+
+ my $fh = FileHandle->new($file, "w") or return;
+ my $self = shift;
+ my $is32bit = $self->{alg} <= 256;
+ my $fmt = $is32bit ? ":%08x" : ":%016x";
+
+ printf $fh "alg:%d\n", $self->{alg};
+
+ printf $fh "H";
+ for (@{$self->{H}}) { printf $fh $fmt, $is32bit ? $_ & $MAX32 : $_ }
+
+ printf $fh "\nblock";
+ my @c = unpack("C*", $self->{block});
+ push(@c, 0x00) while scalar(@c) < ($self->{blocksize} >> 3);
+ for (@c) { printf $fh ":%02x", $_ }
+
+ printf $fh "\nblockcnt:%u\n", $self->{blockcnt};
+
+ printf $fh "lenhh:%lu\n", $self->{lenhh} & $MAX32;
+ printf $fh "lenhl:%lu\n", $self->{lenhl} & $MAX32;
+ printf $fh "lenlh:%lu\n", $self->{lenlh} & $MAX32;
+ printf $fh "lenll:%lu\n", $self->{lenll} & $MAX32;
+
+ close($fh);
+ $self;
+}
+
+sub _match {
+ my($fh, $tag) = @_;
+ my @f;
+ while (<$fh>) {
+ s/^\s+//;
+ s/\s+$//;
+ next if (/^(#|$)/);
+ @f = split(/[:\s]+/);
+ last;
+ }
+ shift(@f) eq $tag or return;
+ return(@f);
+}
+
+sub _shaload {
+ my $file = shift;
+ $file = "-" if (!defined($file) || $file eq "");
+
+ my $fh = FileHandle->new($file, "r") or return;
+
+ my @f = _match($fh, "alg") or return;
+ my $self = _shaopen(shift(@f)) or return;
+
+ @f = _match($fh, "H") or return;
+ my $numxdigits = $self->{alg} <= 256 ? 8 : 16;
+ for (@f) { $_ = "0" . $_ while length($_) < $numxdigits }
+ for (@f) { $_ = substr($_, 1) while length($_) > $numxdigits }
+ @{$self->{H}} = map { $self->{alg} <= 256 ? hex($_) :
+ ((hex(substr($_, 0, 8)) << 16) << 16) |
+ hex(substr($_, 8)) } @f;
+
+ @f = _match($fh, "block") or return;
+ for (@f) { $self->{block} .= chr(hex($_)) }
+
+ @f = _match($fh, "blockcnt") or return;
+ $self->{blockcnt} = shift(@f);
+ $self->{block} = substr($self->{block},0,_BYTECNT($self->{blockcnt}));
+
+ @f = _match($fh, "lenhh") or return;
+ $self->{lenhh} = shift(@f);
+ @f = _match($fh, "lenhl") or return;
+ $self->{lenhl} = shift(@f);
+ @f = _match($fh, "lenlh") or return;
+ $self->{lenlh} = shift(@f);
+ @f = _match($fh, "lenll") or return;
+ $self->{lenll} = shift(@f);
+
+ close($fh);
+ $self;
+}
+
+# ref. src/hmac.c from Digest::SHA
+
+sub _hmacopen {
+ my($alg, $key) = @_;
+ my($self);
+ $self->{isha} = _shaopen($alg) or return;
+ $self->{osha} = _shaopen($alg) or return;
+ if (length($key) > $self->{osha}->{blocksize} >> 3) {
+ $self->{ksha} = _shaopen($alg) or return;
+ _shawrite($key, length($key) << 3, $self->{ksha});
+ _shafinish($self->{ksha});
+ $key = _shadigest($self->{ksha});
+ }
+ $key .= chr(0x00)
+ while length($key) < $self->{osha}->{blocksize} >> 3;
+ my @k = unpack("C*", $key);
+ for (@k) { $_ ^= 0x5c }
+ _shawrite(pack("C*", @k), $self->{osha}->{blocksize}, $self->{osha});
+ for (@k) { $_ ^= (0x5c ^ 0x36) }
+ _shawrite(pack("C*", @k), $self->{isha}->{blocksize}, $self->{isha});
+ $self;
+}
+
+sub _hmacwrite {
+ my($bitstr, $bitcnt, $self) = @_;
+ _shawrite($bitstr, $bitcnt, $self->{isha});
+}
+
+sub _hmacfinish {
+ my($self) = @_;
+ _shafinish($self->{isha});
+ _shawrite(_shadigest($self->{isha}),
+ $self->{isha}->{digestlen} << 3, $self->{osha});
+ _shafinish($self->{osha});
+}
+
+sub _hmacdigest { my($self) = @_; _shadigest($self->{osha}) }
+sub _hmachex { my($self) = @_; _shahex($self->{osha}) }
+sub _hmacbase64 { my($self) = @_; _shabase64($self->{osha}) }
+
+# SHA and HMAC-SHA functions
+
+my @suffix_extern = ("", "_hex", "_base64");
+my @suffix_intern = ("digest", "hex", "base64");
+
+my($i, $alg);
+for $alg (1, 224, 256, 384, 512) {
+ for $i (0 .. 2) {
+ my $fcn = 'sub sha' . $alg . $suffix_extern[$i] . ' {
+ my $state = _shaopen(' . $alg . ') or return;
+ for (@_) { _shawrite($_, length($_) << 3, $state) }
+ _shafinish($state);
+ _sha' . $suffix_intern[$i] . '($state);
+ }';
+ eval($fcn);
+ push(@EXPORT_OK, 'sha' . $alg . $suffix_extern[$i]);
+ $fcn = 'sub hmac_sha' . $alg . $suffix_extern[$i] . ' {
+ my $state = _hmacopen(' . $alg . ', pop(@_)) or return;
+ for (@_) { _hmacwrite($_, length($_) << 3, $state) }
+ _hmacfinish($state);
+ _hmac' . $suffix_intern[$i] . '($state);
+ }';
+ eval($fcn);
+ push(@EXPORT_OK, 'hmac_sha' . $alg . $suffix_extern[$i]);
+ }
+}
+
+# OOP methods
+
+sub hashsize { my $self = shift; _shadsize($self) << 3 }
+sub algorithm { my $self = shift; $self->{alg} }
+
+sub add {
+ my $self = shift;
+ for (@_) { _shawrite($_, length($_) << 3, $self) }
+ $self;
+}
+
+sub digest {
+ my $self = shift;
+ _shafinish($self);
+ my $rsp = _shadigest($self);
+ _sharewind($self);
+ $rsp;
+}
+
+sub _Hexdigest {
+ my $self = shift;
+ _shafinish($self);
+ my $rsp = _shahex($self);
+ _sharewind($self);
+ $rsp;
+}
+
+sub _B64digest {
+ my $self = shift;
+ _shafinish($self);
+ my $rsp = _shabase64($self);
+ _sharewind($self);
+ $rsp;
+}
+
+sub new {
+ my($class, $alg) = @_;
+ $alg =~ s/\D+//g if defined $alg;
+ if (ref($class)) { # instance method
+ unless (defined($alg) && ($alg != $class->algorithm)) {
+ _sharewind($class);
+ return($class);
+ }
+ my $self = _shaopen($alg) or return;
+ return(_shacpy($class, $self));
+ }
+ $alg = 1 unless defined $alg;
+ my $self = _shaopen($alg) or return;
+ bless($self, $class);
+ $self;
+}
+
+sub clone {
+ my $self = shift;
+ my $copy = _shadup($self) or return;
+ bless($copy, ref($self));
+ return($copy);
+}
+
+*reset = \&new;
+
+sub add_bits {
+ my($self, $data, $nbits) = @_;
+ unless (defined $nbits) {
+ $nbits = length($data);
+ $data = pack("B*", $data);
+ }
+ _shawrite($data, $nbits, $self);
+ return($self);
+}
+
+sub _bail {
+ my $msg = shift;
+
+ require Carp;
+ Carp::croak("$msg: $!");
+}
+
+sub _addfile {
+ my ($self, $handle) = @_;
+
+ my $n;
+ my $buf = "";
+
+ while (($n = read($handle, $buf, 4096))) {
+ $self->add($buf);
+ }
+ _bail("Read failed") unless defined $n;
+
+ $self;
+}
+
+sub _Addfile {
+ my ($self, $file, $mode) = @_;
+
+ return(_addfile($self, $file)) unless ref(\$file) eq 'SCALAR';
+
+ $mode = defined($mode) ? $mode : "";
+ my ($binary, $portable) = map { $_ eq $mode } ("b", "p");
+ my $text = -T $file;
+
+ local *FH;
+ open(FH, "<$file") or _bail("Open failed");
+ binmode(FH) if $binary || $portable;
+
+ unless ($portable && $text) {
+ $self->_addfile(*FH);
+ close(FH);
+ return($self);
+ }
+
+ my ($n1, $n2);
+ my ($buf1, $buf2) = ("", "");
+
+ while (($n1 = read(FH, $buf1, 4096))) {
+ while (substr($buf1, -1) eq "\015") {
+ $n2 = read(FH, $buf2, 4096);
+ _bail("Read failed") unless defined $n2;
+ last unless $n2;
+ $buf1 .= $buf2;
+ }
+ $buf1 =~ s/\015?\015\012/\012/g; # DOS/Windows
+ $buf1 =~ s/\015/\012/g; # early MacOS
+ $self->add($buf1);
+ }
+ _bail("Read failed") unless defined $n1;
+ close(FH);
+
+ $self;
+}
+
+sub dump {
+ my $self = shift;
+ my $file = shift || "";
+
+ _shadump($file, $self) or return;
+ return($self);
+}
+
+sub load {
+ my $class = shift;
+ my $file = shift || "";
+ if (ref($class)) { # instance method
+ my $self = _shaload($file) or return;
+ return(_shacpy($class, $self));
+ }
+ my $self = _shaload($file) or return;
+ bless($self, $class);
+ return($self);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Digest::SHA::PurePerl - Perl implementation of SHA-1/224/256/384/512
+
+=head1 SYNOPSIS
+
+In programs:
+
+ # Functional interface
+
+ use Digest::SHA::PurePerl qw(sha1 sha1_hex sha1_base64 ...);
+
+ $digest = sha1($data);
+ $digest = sha1_hex($data);
+ $digest = sha1_base64($data);
+
+ $digest = sha256($data);
+ $digest = sha384_hex($data);
+ $digest = sha512_base64($data);
+
+ # Object-oriented
+
+ use Digest::SHA::PurePerl;
+
+ $sha = Digest::SHA::PurePerl->new($alg);
+
+ $sha->add($data); # feed data into stream
+
+ $sha->addfile(*F);
+ $sha->addfile($filename);
+
+ $sha->add_bits($bits);
+ $sha->add_bits($data, $nbits);
+
+ $sha_copy = $sha->clone; # if needed, make copy of
+ $sha->dump($file); # current digest state,
+ $sha->load($file); # or save it on disk
+
+ $digest = $sha->digest; # compute digest
+ $digest = $sha->hexdigest;
+ $digest = $sha->b64digest;
+
+From the command line:
+
+ $ shasum files
+
+ $ shasum --help
+
+=head1 SYNOPSIS (HMAC-SHA)
+
+ # Functional interface only
+
+ use Digest::SHA::PurePerl qw(hmac_sha1 hmac_sha1_hex ...);
+
+ $digest = hmac_sha1($data, $key);
+ $digest = hmac_sha224_hex($data, $key);
+ $digest = hmac_sha256_base64($data, $key);
+
+=head1 ABSTRACT
+
+Digest::SHA::PurePerl is a complete implementation of the NIST
+Secure Hash Standard. It gives Perl programmers a convenient way
+to calculate SHA-1, SHA-224, SHA-256, SHA-384, and SHA-512 message
+digests. The module can handle all types of input, including
+partial-byte data.
+
+=head1 DESCRIPTION
+
+Digest::SHA::PurePerl is written entirely in Perl. If your platform
+has a C compiler, you should install the functionally equivalent
+(but much faster) L<Digest::SHA> module.
+
+The programming interface is easy to use: it's the same one found
+in CPAN's L<Digest> module. So, if your applications currently
+use L<Digest::MD5> and you'd prefer the stronger security of SHA,
+it's a simple matter to convert them.
+
+The interface provides two ways to calculate digests: all-at-once,
+or in stages. To illustrate, the following short program computes
+the SHA-256 digest of "hello world" using each approach:
+
+ use Digest::SHA::PurePerl qw(sha256_hex);
+
+ $data = "hello world";
+ @frags = split(//, $data);
+
+ # all-at-once (Functional style)
+ $digest1 = sha256_hex($data);
+
+ # in-stages (OOP style)
+ $state = Digest::SHA::PurePerl->new(256);
+ for (@frags) { $state->add($_) }
+ $digest2 = $state->hexdigest;
+
+ print $digest1 eq $digest2 ?
+ "whew!\n" : "oops!\n";
+
+To calculate the digest of an n-bit message where I<n> is not a
+multiple of 8, use the I<add_bits()> method. For example, consider
+the 446-bit message consisting of the bit-string "110" repeated
+148 times, followed by "11". Here's how to display its SHA-1
+digest:
+
+ use Digest::SHA::PurePerl;
+ $bits = "110" x 148 . "11";
+ $sha = Digest::SHA::PurePerl->new(1)->add_bits($bits);
+ print $sha->hexdigest, "\n";
+
+Note that for larger bit-strings, it's more efficient to use the
+two-argument version I<add_bits($data, $nbits)>, where I<$data> is
+in the customary packed binary format used for Perl strings.
+
+The module also lets you save intermediate SHA states to disk, or
+display them on standard output. The I<dump()> method generates
+portable, human-readable text describing the current state of
+computation. You can subsequently retrieve the file with I<load()>
+to resume where the calculation left off.
+
+To see what a state description looks like, just run the following:
+
+ use Digest::SHA::PurePerl;
+ Digest::SHA::PurePerl->new->add("Shaw" x 1962)->dump;
+
+As an added convenience, the Digest::SHA::PurePerl module offers
+routines to calculate keyed hashes using the HMAC-SHA-1/224/256/384/512
+algorithms. These services exist in functional form only, and
+mimic the style and behavior of the I<sha()>, I<sha_hex()>, and
+I<sha_base64()> functions.
+
+ # Test vector from draft-ietf-ipsec-ciph-sha-256-01.txt
+
+ use Digest::SHA::PurePerl qw(hmac_sha256_hex);
+ print hmac_sha256_hex("Hi There", chr(0x0b) x 32), "\n";
+
+=head1 NIST STATEMENT ON SHA-1
+
+I<NIST was recently informed that researchers had discovered a way
+to "break" the current Federal Information Processing Standard SHA-1
+algorithm, which has been in effect since 1994. The researchers
+have not yet published their complete results, so NIST has not
+confirmed these findings. However, the researchers are a reputable
+research team with expertise in this area.>
+
+I<Due to advances in computing power, NIST already planned to phase
+out SHA-1 in favor of the larger and stronger hash functions (SHA-224,
+SHA-256, SHA-384 and SHA-512) by 2010. New developments should use
+the larger and stronger hash functions.>
+
+ref. L<http://www.csrc.nist.gov/pki/HashWorkshop/NIST%20Statement/Burr_Mar2005.html>
+
+=head1 PADDING OF BASE64 DIGESTS
+
+By convention, CPAN Digest modules do B<not> pad their Base64 output.
+Problems can occur when feeding such digests to other software that
+expects properly padded Base64 encodings.
+
+For the time being, any necessary padding must be done by the user.
+Fortunately, this is a simple operation: if the length of a Base64-encoded
+digest isn't a multiple of 4, simply append "=" characters to the end
+of the digest until it is:
+
+ while (length($b64_digest) % 4) {
+ $b64_digest .= '=';
+ }
+
+To illustrate, I<sha256_base64("abc")> is computed to be
+
+ ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0
+
+which has a length of 43. So, the properly padded version is
+
+ ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0=
+
+=head1 EXPORT
+
+None by default.
+
+=head1 EXPORTABLE FUNCTIONS
+
+Provided your Perl installation supports 64-bit integers, all of
+these functions will be available for use. Otherwise, you won't
+be able to perform the SHA-384 and SHA-512 transforms, both of
+which require 64-bit operations.
+
+I<Functional style>
+
+=over 4
+
+=item B<sha1($data, ...)>
+
+=item B<sha224($data, ...)>
+
+=item B<sha256($data, ...)>
+
+=item B<sha384($data, ...)>
+
+=item B<sha512($data, ...)>
+
+Logically joins the arguments into a single string, and returns
+its SHA-1/224/256/384/512 digest encoded as a binary string.
+
+=item B<sha1_hex($data, ...)>
+
+=item B<sha224_hex($data, ...)>
+
+=item B<sha256_hex($data, ...)>
+
+=item B<sha384_hex($data, ...)>
+
+=item B<sha512_hex($data, ...)>
+
+Logically joins the arguments into a single string, and returns
+its SHA-1/224/256/384/512 digest encoded as a hexadecimal string.
+
+=item B<sha1_base64($data, ...)>
+
+=item B<sha224_base64($data, ...)>
+
+=item B<sha256_base64($data, ...)>
+
+=item B<sha384_base64($data, ...)>
+
+=item B<sha512_base64($data, ...)>
+
+Logically joins the arguments into a single string, and returns
+its SHA-1/224/256/384/512 digest encoded as a Base64 string.
+
+It's important to note that the resulting string does B<not> contain
+the padding characters typical of Base64 encodings. This omission is
+deliberate, and is done to maintain compatibility with the family of
+CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
+
+=back
+
+I<OOP style>
+
+=over 4
+
+=item B<new($alg)>
+
+Returns a new Digest::SHA::PurePerl object. Allowed values for
+I<$alg> are 1, 224, 256, 384, or 512. It's also possible to use
+common string representations of the algorithm (e.g. "sha256",
+"SHA-384"). If the argument is missing, SHA-1 will be used by
+default.
+
+Invoking I<new> as an instance method will not create a new object;
+instead, it will simply reset the object to the initial state
+associated with I<$alg>. If the argument is missing, the object
+will continue using the same algorithm that was selected at creation.
+
+=item B<reset($alg)>
+
+This method has exactly the same effect as I<new($alg)>. In fact,
+I<reset> is just an alias for I<new>.
+
+=item B<hashsize>
+
+Returns the number of digest bits for this object. The values are
+160, 224, 256, 384, and 512 for SHA-1, SHA-224, SHA-256, SHA-384,
+and SHA-512, respectively.
+
+=item B<algorithm>
+
+Returns the digest algorithm for this object. The values are 1,
+224, 256, 384, and 512 for SHA-1, SHA-224, SHA-256, SHA-384, and
+SHA-512, respectively.
+
+=item B<clone>
+
+Returns a duplicate copy of the object.
+
+=item B<add($data, ...)>
+
+Logically joins the arguments into a single string, and uses it to
+update the current digest state. In other words, the following
+statements have the same effect:
+
+ $sha->add("a"); $sha->add("b"); $sha->add("c");
+ $sha->add("a")->add("b")->add("c");
+ $sha->add("a", "b", "c");
+ $sha->add("abc");
+
+The return value is the updated object itself.
+
+=item B<add_bits($data, $nbits)>
+
+=item B<add_bits($bits)>
+
+Updates the current digest state by appending bits to it. The
+return value is the updated object itself.
+
+The first form causes the most-significant I<$nbits> of I<$data>
+to be appended to the stream. The I<$data> argument is in the
+customary binary format used for Perl strings.
+
+The second form takes an ASCII string of "0" and "1" characters as
+its argument. It's equivalent to
+
+ $sha->add_bits(pack("B*", $bits), length($bits));
+
+So, the following two statements do the same thing:
+
+ $sha->add_bits("111100001010");
+ $sha->add_bits("\xF0\xA0", 12);
+
+=item B<addfile(*FILE)>
+
+Reads from I<FILE> until EOF, and appends that data to the current
+state. The return value is the updated object itself.
+
+=item B<addfile($filename [, $mode])>
+
+Reads the contents of I<$filename>, and appends that data to the current
+state. The return value is the updated object itself.
+
+By default, I<$filename> is simply opened and read; no special modes
+or I/O disciplines are used. To change this, set the optional I<$mode>
+argument to one of the following values:
+
+ "b" read file in binary mode
+
+ "p" use portable mode
+
+The "p" mode is handy since it ensures that the digest value of
+I<$filename> will be the same when computed on different operating
+systems. It accomplishes this by internally translating all newlines
+in text files to UNIX format before calculating the digest; on the other
+hand, binary files are read in raw mode with no translation whatsoever.
+
+For a fuller discussion of newline formats, refer to CPAN module
+L<File::LocalizeNewlines>. Its "universal line separator" regex forms
+the basis of I<addfile>'s portable mode processing.
+
+=item B<dump($filename)>
+
+Provides persistent storage of intermediate SHA states by writing
+a portable, human-readable representation of the current state to
+I<$filename>. If the argument is missing, or equal to the empty
+string, the state information will be written to STDOUT.
+
+=item B<load($filename)>
+
+Returns a Digest::SHA::PurePerl object representing the intermediate
+SHA state that was previously dumped to I<$filename>. If called
+as a class method, a new object is created; if called as an instance
+method, the object is reset to the state contained in I<$filename>.
+If the argument is missing, or equal to the empty string, the state
+information will be read from STDIN.
+
+=item B<digest>
+
+Returns the digest encoded as a binary string.
+
+Note that the I<digest> method is a read-once operation. Once it
+has been performed, the Digest::SHA::PurePerl object is automatically
+reset in preparation for calculating another digest value. Call
+I<$sha-E<gt>clone-E<gt>digest> if it's necessary to preserve the
+original digest state.
+
+=item B<hexdigest>
+
+Returns the digest encoded as a hexadecimal string.
+
+Like I<digest>, this method is a read-once operation. Call
+I<$sha-E<gt>clone-E<gt>hexdigest> if it's necessary to preserve
+the original digest state.
+
+This method is inherited if L<Digest::base> is installed on your
+system. Otherwise, a functionally equivalent substitute is used.
+
+=item B<b64digest>
+
+Returns the digest encoded as a Base64 string.
+
+Like I<digest>, this method is a read-once operation. Call
+I<$sha-E<gt>clone-E<gt>b64digest> if it's necessary to preserve
+the original digest state.
+
+This method is inherited if L<Digest::base> is installed on your
+system. Otherwise, a functionally equivalent substitute is used.
+
+It's important to note that the resulting string does B<not> contain
+the padding characters typical of Base64 encodings. This omission is
+deliberate, and is done to maintain compatibility with the family of
+CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
+
+=back
+
+I<HMAC-SHA-1/224/256/384/512>
+
+=over 4
+
+=item B<hmac_sha1($data, $key)>
+
+=item B<hmac_sha224($data, $key)>
+
+=item B<hmac_sha256($data, $key)>
+
+=item B<hmac_sha384($data, $key)>
+
+=item B<hmac_sha512($data, $key)>
+
+Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
+with the result encoded as a binary string. Multiple I<$data>
+arguments are allowed, provided that I<$key> is the last argument
+in the list.
+
+=item B<hmac_sha1_hex($data, $key)>
+
+=item B<hmac_sha224_hex($data, $key)>
+
+=item B<hmac_sha256_hex($data, $key)>
+
+=item B<hmac_sha384_hex($data, $key)>
+
+=item B<hmac_sha512_hex($data, $key)>
+
+Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
+with the result encoded as a hexadecimal string. Multiple I<$data>
+arguments are allowed, provided that I<$key> is the last argument
+in the list.
+
+=item B<hmac_sha1_base64($data, $key)>
+
+=item B<hmac_sha224_base64($data, $key)>
+
+=item B<hmac_sha256_base64($data, $key)>
+
+=item B<hmac_sha384_base64($data, $key)>
+
+=item B<hmac_sha512_base64($data, $key)>
+
+Returns the HMAC-SHA-1/224/256/384/512 digest of I<$data>/I<$key>,
+with the result encoded as a Base64 string. Multiple I<$data>
+arguments are allowed, provided that I<$key> is the last argument
+in the list.
+
+It's important to note that the resulting string does B<not> contain
+the padding characters typical of Base64 encodings. This omission is
+deliberate, and is done to maintain compatibility with the family of
+CPAN Digest modules. See L</"PADDING OF BASE64 DIGESTS"> for details.
+
+=back
+
+=head1 SEE ALSO
+
+L<Digest>, L<Digest::SHA>
+
+The Secure Hash Standard (FIPS PUB 180-2) can be found at:
+
+L<http://csrc.nist.gov/publications/fips/fips180-2/fips180-2withchangenotice.pdf>
+
+The Keyed-Hash Message Authentication Code (HMAC):
+
+L<http://csrc.nist.gov/publications/fips/fips198/fips-198a.pdf>
+
+=head1 AUTHOR
+
+ Mark Shelor <mshelor@cpan.org>
+
+=head1 ACKNOWLEDGMENTS
+
+The author is particularly grateful to
+
+ Gisle Aas
+ Chris Carey
+ Jim Doble
+ Julius Duque
+ Jeffrey Friedl
+ Robert Gilmour
+ Brian Gladman
+ Adam Kennedy
+ Andy Lester
+ Alex Muntada
+ Steve Peters
+ Chris Skiscim
+ Martin Thurn
+ Gunnar Wolf
+ Adam Woodbury
+
+for their valuable comments and suggestions.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2003-2007 Mark Shelor
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+L<perlartistic>
+
+=cut
--- /dev/null
+You will need to have all of these installed:
+
+* Perl 5.8 and standard modules. (threads no longer required)
+ NOTE: Many linux distros place Perl's standard modules in a separate
+ package from Perl itself.
+* MySQL 4.1 or 5.0. 5.1 and up are not supported.
+* Event module from CPAN
+* Date::Parse module from CPAN
+Both the Event and Date::Parse modules should be available
+in your favourite distro.
+
+1. Create a MySQL database and user for services to use. Ask
+your system administrator or see the MySQL manual for instructions.
+
+2. Make sure your IRCd is configured correctly.
+
+3. Type: cp -a config-example config
+Then edit the config files for your network.
+
+4. Type: ./db-setup.pl
+
+5. Type: ./services.pl
+
+6. Register your nick, then type: ./addroot.pl <yournick>
--- /dev/null
+This code is Copyright saturn@surrealchat.net and tabris@surrealchat.net
+
+© 2004-2006 saturn@surrealchat.net and tabris@surrealchat.net
+
+Terms are as in COPYING
+
--- /dev/null
+ SurrealServices is a full replacement for services like
+Auspice or Anope, offering NickServ, ChanServ, MemoServ,
+BotServ, OperServ. But it is more than that, it also has a
+plugin/module system akin to NeoStats. Additionally it is
+multithreaded to eliminate the problems with timers not expiring
+properly as well as not block everything on a complex or slow
+database query.
+
+You can contact us on irc.surrealchat.net #dev.lounge or via email:
+tabris@surrealchat.net or saturn@surrealchat.net
+
+-----------------------------------------------------------------------
+CONFIGURATION TIPS
+
+SrSv does not support ziplinks nor SSL, so it should be hosted on the
+same box as the hub, or at least the same local network.
+
+-----------------------------------------------------------------------
+NUMBER OF PROCESSES
+
+We recommend that you leave the "procs" setting at 4 for
+uniprocessor and dual processor servers. Our benchmarks have
+shown that increasing it above 4 does not provide any benefit.
+
+You may set "procs" to 0 for use on shell servers with a
+limit on the number of background processes. Be aware that
+certain SecurityBot features may cause unacceptable lag when
+running in single-process mode. This issue will be fixed in a
+future release.
+
+-----------------------------------------------------------------------
+MODULE CONFIGURATION
+
+"country" must be loaded AFTER services, and requires that you run
+country-table.pl before using it.
+
+We recommend you run country-table.pl daily in crontab.
+
+"geoip" is like country, but:
+a) a much larger set of tables.
+b) should not be loaded with country.
+c) requires utils/geoip.pl to be run at least once.
+d) Don't bother running geoip.pl more often than monthly in a crontab.
+e) the datafiles are generally updated on the first of the month
+f) geoip uses GeoLite City from MaxMind. We do not grant you a license to use it
+ and are not responsible for any consequences of your using it.
+
--- /dev/null
+ SrSv nee SurrealServices is currently being developed
+with UnrealIRCd 3.2.x in mind. As such many assumptions may be
+in place even if we did not intend there to be. This will
+probably make porting difficult, if not impossible. We, the
+coders, would like to apologize in advance for this fact.
+
+ This is an unfortunate consequence of only having
+UnrealIRCd at our immediate disposal. We would welcome patches
+to clean up such difficulties, as long as they remain
+sufficiently clean/readable and do not introduce assumptions
+incompatible with other ircds that SrSv is attempting to work
+with.
+
+ Among the assumptions to be noted are that all of your
+ircds are properly configured and that the configurations are
+uniform throughout your irc-network. We believe that this is a
+necessary aspect of a properly maintained network, and as such
+should not be an undue burden.
+
+ Further of note is that SrSv does not have a full
+capability list for ircds and such may be necessary for
+portability (if your ircd does not support things like WATCH,
+SILENCE, etc).
+
+ IRC Networks known to be using SrSv as of this date
+(20060904):
+ irc.talkingirc.net
+ irc.surrealchat.net (duh)
+ irc.webchatting.com
+
+ We would appreciate any success reports from other networks,
+contact us on irc.surrealchat.net #dev.lounge or via email:
+tabris@surrealchat.net or saturn@surrealchat.net
--- /dev/null
+SecurityBot is an all-purpose Security Maintenance System.
+
+It has TOR banning, DroneBL-Blacklist Banning, TKL (G:line and GZ:line)
+management, and a couple other more random features.
+
+The use of this system is at this time quite finicky, and is not
+recommended unless you have read through the SecurityBot code or talked
+to the coders. It was written for use on SurrealChat.net, and may not
+meet the 'ease of use' standard of the rest of SurrealServices.
+
+- TOR is more or less easy to use, just enable it in the config, and it
+should work.
+
+- DroneBL support requires permission from dronebl.org to
+download a copy of their blacklist.
+
+Enabling this option and not running the scripts/setting up the
+table will cause runtime errors. So don't do that. This is no
+different from the country system.
+
+- TKL handling is very similar to /stats G on Unreal, with some slight
+changes. The full documentation is available via
+
+/msg SecurityBot help TKL
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Agent;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw(
+ is_agent is_agent_in_chan
+ agent_connect agent_quit agent_quit_all
+ agent_join agent_part set_agent_umode
+ agent_sync is_invalid_agentname
+); }
+
+use SrSv::Process::InParent qw(
+ is_agent is_agent_in_chan
+ agent_connect agent_quit agent_quit_all
+ agent_join agent_part agent_sync
+ whois_callback kill_callback
+);
+
+use SrSv::Conf2Consts qw(main);
+
+use SrSv::Debug;
+use SrSv::Unreal::Tokens;
+use SrSv::Unreal::Base64 qw(itob64);
+use SrSv::IRCd::State qw(synced $ircd_ready %IRCd_capabilities);
+use SrSv::IRCd::IO qw(ircsend ircsendimm);
+use SrSv::IRCd::Event qw(addhandler);
+use SrSv::Unreal::Validate qw(valid_nick);
+use SrSv::RunLevel 'main_shutdown';
+
+# FIXME
+BEGIN { *SJB64 = \&ircd::SJB64 }
+
+our %agents;
+our @defer_join;
+
+addhandler('WHOIS', undef(), undef(), 'whois_callback', 1);
+addhandler('KILL', undef(), undef(), 'kill_callback', 1);
+
+sub is_agent($) {
+ my ($nick) = @_;
+ return (defined($agents{lc $nick}));
+}
+
+sub is_agent_in_chan($$) {
+ my ($agent, $chan) = @_;
+ $agent = lc $agent; $chan = lc $chan;
+
+ if($agents{$agent} and $agents{$agent}{CHANS} and $agents{$agent}{CHANS}{$chan}) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+sub agent_connect($$$$$) {
+ my ($nick, $ident, $host, $modes, $gecos) = @_;
+ my $time = time();
+
+ my @chans;
+ if(defined($agents{lc $nick}) and ref($agents{lc $nick}{CHANS})) {
+ @chans = keys(%{$agents{lc $nick}{CHANS}});
+ }
+
+ $agents{lc $nick}{PARMS} = [ @_ ];
+
+ $host = main_conf_local unless $host;
+ ircsend($tkn{NICK}[$tkn]." $nick 1 $time $ident $host ".
+ (SJB64 ? itob64(main_conf_numeric) : main_conf_local).
+ " 1 $modes * :$gecos");
+
+ foreach my $chan (@chans) {
+ ircsend(":$nick ".$tkn{JOIN}[$tkn]." $chan");
+ # If we tracked chanmodes for agents, that would go here as well.
+ }
+}
+
+sub agent_quit($$) {
+ my ($nick, $msg) = @_;
+
+ delete($agents{lc $nick}{CHANS});
+ delete($agents{lc $nick});
+
+ ircsendimm(":$nick ".$tkn{QUIT}[$tkn]." :$msg");
+}
+
+sub agent_quit_all($) {
+ my ($msg) = @_;
+
+ my @agents;
+ @agents = keys(%agents);
+
+ foreach my $a (@agents) {
+ agent_quit($a, $msg);
+ }
+}
+
+sub is_invalid_agentname($$$) {
+ my ($botnick, $botident, $bothost) = @_;
+
+ unless(valid_nick($botnick)) {
+ return "Invalid nickname.";
+ }
+ unless($botident =~ /^[[:alnum:]_]+$/) {
+ return "Invalid ident.";
+ }
+ unless($bothost =~ /^[[:alnum:].-]+$/) {
+ return "Invalid vhost.";
+ }
+ unless($bothost =~ /\./) {
+ return "A vhost must contain at least one dot.";
+ }
+ return undef;
+}
+
+sub agent_join($$) {
+ my ($agent, $chan) = @_;
+
+ if($agents{lc $agent}) {
+ $agents{lc $agent}{CHANS}{lc $chan} = 1;
+ ircsend(":$agent ".$tkn{JOIN}[$tkn]." $chan");
+ } else {
+ if($ircd_ready) {
+ print "Tried to make nonexistent agent ($agent) join channel ($chan)" if DEBUG;
+ } else {
+ print "Deferred join: $agent $chan\n" if DEBUG;
+ push @defer_join, "$agent $chan";
+ }
+ }
+}
+
+sub agent_part($$$) {
+ my ($agent, $chan, $reason) = @_;
+
+ delete($agents{lc $agent}{CHANS}{lc $chan});
+ ircsend(":$agent $tkn{PART}[$tkn] $chan :$reason");
+}
+
+sub set_agent_umode($$) {
+ my ($src, $modes) = @_;
+
+ ircsend(":$src $tkn{UMODE2}[$tkn] $modes");
+}
+
+sub agent_sync() {
+ foreach my $j (@defer_join) {
+ print "Processing join: $j\n" if DEBUG;
+ my ($agent, $chan) = split(/ /, $j);
+ agent_join($agent, $chan);
+ }
+ undef(@defer_join);
+}
+
+sub whois_callback {
+#:wyvern.surrealchat.net 311 blah2 tabris northman SCnet-E5870F84.dsl.klmzmi.ameritech.net * :Sponsored by Skuld
+#:wyvern.surrealchat.net 307 blah2 tabris :is a registered nick
+#:wyvern.surrealchat.net 312 blah2 tabris wyvern.surrealchat.net :SurrealChat - aphrodite.wcshells.com - Chicago.IL
+#:wyvern.surrealchat.net 671 blah2 tabris :is using a Secure Connection
+#:wyvern.surrealchat.net 317 blah2 tabris 54 1118217330 :seconds idle, signon time
+#:wyvern.surrealchat.net 401 blah2 nikanoru :No such nick/channel
+#:wyvern.surrealchat.net 311 blah2 somebot bot SCnet-DA158DBF.hsd1.nh.comcast.net * :Some sort of bot
+#:wyvern.surrealchat.net 312 blah2 somebot nascent.surrealchat.net :SurrealChat - Hub
+#:wyvern.surrealchat.net 335 blah2 somebot :is a Bot on SurrealChat.net
+#:wyvern.surrealchat.net 318 blah2 tabris,nikanoru,somebot :End of /WHOIS list.
+
+# Also reference http://www.alien.net.au/irc/irc2numerics.html
+
+ my ($src, $nicklist) = @_;
+
+ my @nicks = split(/\,/, $nicklist);
+ my @reply;
+ foreach my $nick (@nicks) {
+ if (is_agent($nick)) {
+ my ($nick, $ident, $host, $modes, $gecos) = @{$agents{lc $nick}{PARMS}};
+ $host = main_conf_local unless $host;
+ push @reply, ':'.main_conf_local." 311 $src $nick $ident $host * :$gecos";
+ push @reply, ':'.main_conf_local." 312 $src $nick ".main_conf_local.' :'.main_conf_info;
+ foreach my $mode (split(//, $modes)) {
+ if ($mode eq 'z') {
+ push @reply, ':'.main_conf_local." 671 $src $nick :is using a Secure Connection";
+ }
+ elsif($mode eq 'S') {
+ #313 tab ChanServ :is a Network Service
+ push @reply, ':'.main_conf_local." 313 $src $nick :is a Network Service";
+ }
+ elsif($mode eq 'B') {
+ #335 blah2 TriviaBot :is a Bot on SurrealChat.net
+ push @reply, ':'.main_conf_local.
+ " 335 $src $nick :is a \002Bot\002 on ".$IRCd_capabilities{NETWORK};
+ }
+ }
+ }
+ else {
+ push @reply, ':'.main_conf_local." 401 $src $nick :No such service";
+ }
+
+ }
+ push @reply, ':'.main_conf_local." 318 $src $nicklist :End of /WHOIS list.";
+ ircsend(@reply);
+}
+
+sub kill_callback($$$$) {
+ my ($src, $dst, $path, $reason) = @_;
+ if (defined($agents{lc $dst})) {
+ if (defined ($agents{lc $dst}{KILLED}) and ($agents{lc $dst}{KILLED} == time())) {
+ if ($agents{lc $dst}{KILLCOUNT} > 3) {
+ ircd::debug("Caught in a kill loop for $dst, dying now.");
+ main_shutdown;
+ } else {
+ $agents{lc $dst}{KILLCOUNT}++;
+ }
+ } else {
+ $agents{lc $dst}{KILLED} = time();
+ $agents{lc $dst}{KILLCOUNT} = 1;
+ }
+
+ if($src =~ /\./) {
+ # let's NOT loopback this event
+ ircsendimm(':'.main_conf_local.' '.$tkn{KILL}[$tkn]." $dst :Nick Collision");
+ } elsif (defined($agents{lc $src})) {
+ # Do Nothing.
+ } else {
+ ircd::irckill($main::rsnick, $src, "Do not kill services agents.");
+ }
+
+ &agent_connect(@{$agents{lc $dst}{PARMS}}) if synced();
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::AgentUI;
+
+=head1 NAME
+
+SrSv::AgentUI - User interface for IRC agents
+
+=cut
+
+use strict;
+
+use Carp;
+
+use SrSv::User::Notice;
+use SrSv::Help qw(send_help);
+
+use SrSv::AgentUI::Simple;
+
+our %uis;
+
+our $flood_check = sub {};
+
+sub add_command {
+ my ($ui, $command, $call) = @_;
+
+ if(ref $command ne 'ARRAY') {
+ my $obj = $command;
+ $call = sub { $obj->call(@_) };
+ $command = $obj->{COMMAND};
+ }
+
+ foreach my $s (@$command) {
+ $s = uc $s;
+ exists($ui->{COMMAND_INDEX}{$s}) and croak qq{UI command "$s" is already in use};
+ $ui->{COMMAND_INDEX}{$s} = $call;
+ }
+
+ push @{$ui->{COMMANDS}}, [$command, $call];
+}
+
+sub get_add_command_sub($) {
+ my ($p) = @_;
+
+ return sub ($;$) {
+ add_command($p, @_);
+ }
+}
+
+sub get_dispatch_sub($) {
+ my ($p) = @_;
+
+ return sub ($$$) {
+ dispatch($p, @_);
+ }
+}
+
+sub dispatch {
+ my ($ui, $src, $dst, $msg) = @_;
+ my $user = { NICK => $src, AGENT => $dst };
+
+ return if $flood_check->($user);
+
+ my ($cmd, $args) = split(/\s+/, $msg, 2);
+
+ $cmd = uc $cmd;
+ my $command = $ui->{COMMAND_INDEX}{$cmd};
+
+ unless(defined $command) {
+ notice $user, qq{Sorry, "$cmd" is not a $dst command.}, "For help, type: \002$ui->{PREFIX} help";
+ return;
+ }
+
+ $command->($user, $args, { CMD => $cmd, WRAPPER => $ui->{WRAPPER} });
+}
+
+sub get_help_sub($) {
+ my ($name) = @_;
+
+ return sub ($$) {
+ send_help($_[0], "$name $_[1]");
+ }
+}
+
+sub import($%) {
+ my (undef, $p) = @_;
+
+ if($p->{FLOOD_CHECK_SUB}) {
+ $flood_check = $p->{FLOOD_CHECK_SUB};
+ return;
+ }
+
+ my $package = caller;
+
+ $p->{COMMANDS} = [];
+ $p->{COMMAND_INDEX} = {};
+
+ add_command($p, ['help'], get_help_sub($p->{NAME}));
+
+ {
+ no strict 'refs';
+ *{"$package\::$p->{DISPATCH_SUB}"} = get_dispatch_sub($p);
+ *{"$package\::$p->{ADD_COMMAND_SUB}"} = get_add_command_sub($p);
+ }
+
+ $uis{$p->{NAME}} = $p;
+}
+
+1;
+
+__END__
+
+=head1 SYNOPSIS
+
+ use SrSv::AgentUI {
+ NAME => $myagent_nick,
+ PREFIX => '/msg myagent',
+ ADD_COMMAND_SUB => 'myagent_command',
+ DISPATCH_SUB => 'myagent_dispatch',
+ };
+
+ use SrSv::IRCd::Event qw(addhandler);
+ addhandler('PRIVMSG', undef, $myagent_nick, 'myagent_dispatch');
+
+ myagent_command {
+ SYNTAX => 'frobnicate/frob/fr [nick] password',
+ OPTIONAL_DEFAULT_SRC => 1,
+ CALL => \&myagent_frobnicate,
+ };
+
+ sub frobnicate($$$) {
+ my ($user, $nick, $password) = @_;
+
+ ...
+ }
+
+=head1 DESCRIPTION
+
+This module creates DALnet-style user interfaces for IRC agents. It exports
+two subroutines to the caller's namespace; one adds commands to the interface,
+the other handles incoming messages from users.
+
+=head2 Adding a command
+
+The subroutine defined with ADD_COMMAND_SUB takes a hash reference containing
+the following keys:
+
+=over
+
+=item SYNTAX
+
+A string that defines the syntax for the command. It begins with the name
+of the command, optionally with additional synonyms separated by slashes.
+Next is a list of named parameters, separated by spaces. The names of the
+parameters are used only to generate help texts, they have no other effect.
+
+To make a parameter optional, place square brackets around it. Currently,
+only one optional parameter is allowed.
+
+To accept freeform text with spaces, prepend TEXT: to the parameter name.
+
+To accept a list of parameters, prepend LIST: to the parameter name. The
+list will be passed to the callback as an array reference.
+
+TEXT and LIST parameters are considered "unbounded" and must be the last
+parameter of the command. Their use is incompatible with optional
+parameters, although they may be optional themselves.
+
+=item OPTIONAL_DEFAULT_SRC
+
+If this is set to a true value, the optional argument will automatically
+be filled in to the nick of the user who sent the command.
+
+=item CALL
+
+A reference to the subroutine that will process the command.
+
+=back
+
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::AgentUI::Simple;
+
+use Carp;
+
+use SrSv::User::Notice;
+use SrSv::User qw(get_user_nick);
+
+use constant {
+ OPTIONAL_RE => qr/^\[(.*)\]$/,
+ TYPE_RE => qr/(\w+):(\w+)/,
+};
+
+sub new {
+ my ($class, $self) = @_;
+
+ my @args = split(/\s/, $self->{SYNTAX});
+
+ for(my $i = 0; $i < @args; $i++) {
+ my $a = $args[$i];
+
+ if($a =~ OPTIONAL_RE) {
+ defined($self->{OPTIONAL_INDEX}) and croak 'Only one optional argument is allowed in UI command';
+ $self->{OPTIONAL_INDEX} = $i;
+ }
+ }
+
+ if(@args) {
+ my $type = ($args[-1] =~ TYPE_RE)[0];
+
+ if($type eq 'LIST') {
+ $self->{LIST} = 1;
+ $self->{UNBOUNDED} = 1;
+ }
+
+ if($type eq 'TEXT') {
+ $self->{UNBOUNDED} = 1;
+ }
+ }
+
+ $self->{ARGUMENT_COUNT} = scalar @args;
+ $self->{SYNTAX_HINT} = "Syntax: $self->{COMMAND}[0] " . $self->{SYNTAX};
+
+ bless $self, $class;
+}
+
+sub call {
+ my ($self, $user, $arglist, $uiOpts) = @_;
+ #$uiOpts is a hashref.
+ #$arglist is the full commandline, not just the verb/keyword.
+
+ my @args = split(/\s/, $arglist, ($self->{UNBOUNDED} ? $self->{ARGUMENT_COUNT} : undef));
+
+ if(scalar(@args) <= ($self->{ARGUMENT_COUNT} - 1) and defined($self->{OPTIONAL_INDEX})) {
+ my $default;
+
+ if($self->{OPTIONAL_DEFAULT_SRC}) {
+ $default = get_user_nick($user);
+ }
+
+ splice(@args, $self->{OPTIONAL_INDEX}, 0, $default);
+ }
+
+ if($self->{LIST} && scalar(@args)) {
+ my $argNum = scalar(@args)-1;
+ $args[$argNum] = [split(/\s+/, $args[$argNum])];
+ }
+
+ if($uiOpts->{WRAPPER} && !$self->{NO_WRAPPER}) {
+ # We pass in a reference to the existing list
+ # to make one less copy.
+ $uiOpts->{WRAPPER}(\@args);
+ }
+ if($self->{CMD_TOO}) {
+ $self->{CALL}($user, $uiOpts->{CMD}, @args);
+ } else {
+ $self->{CALL}($user, @args);
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::ChanReg::Flags;
+
+=head1 NAME
+
+SrSv::ChanReg::Flags - Manage flags of registered channels.
+
+=cut
+
+use strict;
+
+use Exporter 'import';
+
+BEGIN {
+ my %constants = (
+ #current chanreg.flags definition limits us to 16 of these. or 32768 as last flag
+ CRF_OPGUARD => 1,
+ CRF_LEAVEOP => 2,
+ CRF_VERBOSE => 4,
+ CRF_HOLD => 8,
+ CRF_FREEZE => 16,
+ CRF_BOTSTAY => 32,
+ CRF_CLOSE => 64,
+ CRF_DRONE => 128,
+ CRF_SPLITOPS => 256,
+ CRF_LOG => 512,
+ CRF_AUTOVOICE => 1024,
+ CRF_WELCOMEINCHAN => 2048,
+ CRF_NEVEROP => 4096,
+ );
+
+ our @EXPORT = (qw(cr_chk_flag cr_set_flag), keys(%constants));
+
+ require constant; import constant (\%constants);
+}
+
+use SrSv::MySQL '$dbh';
+use SrSv::Process::Init;
+
+our ($set_flags, $get_flags, $set_flag, $unset_flag);
+
+proc_init {
+ $set_flags = $dbh->prepare("UPDATE chanreg SET flags=? WHERE chan=?");
+ $get_flags = $dbh->prepare("SELECT flags FROM chanreg WHERE chan=?");
+ $set_flag = $dbh->prepare("UPDATE chanreg SET flags=(flags | (?)) WHERE chan=?");
+ $unset_flag = $dbh->prepare("UPDATE chanreg SET flags=(flags & ~(?)) WHERE chan=?");
+
+};
+
+sub cr_set_flag($$$) {
+ my ($chan, $flag, $sign) = @_;
+ my $cn = $chan->{CHAN};
+
+ if($sign >= 1) {
+ $chan->{FLAGS} = ( ( defined $chan->{FLAGS} ? $chan->{FLAGS} : 0 ) | $flag );
+ $set_flag->execute($flag, $cn);
+ } else {
+ $chan->{FLAGS} = ( ( defined $chan->{FLAGS} ? $chan->{FLAGS} : 0 ) & ~($flag) );
+ $unset_flag->execute($flag, $cn);
+ }
+}
+
+sub cr_chk_flag($$;$) {
+ my ($chan, $flag, $sign) = @_;
+ my $cn = $chan->{CHAN};
+ $sign = 1 unless defined($sign);
+
+ my $flags;
+ unless (exists($chan->{FLAGS})) {
+ $get_flags->execute($cn);
+ ($chan->{FLAGS}) = $get_flags->fetchrow_array;
+ $get_flags->finish();
+ }
+ $flags = $chan->{FLAGS};
+
+ return ($sign ? ($flags & $flag) : !($flags & $flag));
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::ChanServ;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw($csnick $csnick_default cs_command) }
+
+our ($csnick_default, $csnick);
+BEGIN {
+ $csnick_default = 'ChanServ';
+ $csnick = $csnick_default;
+}
+
+sub chanservWrapper {
+ my ($argsRef) = @_;
+ if($argsRef->[0] =~ /^#/) {
+ $argsRef->[0] = { CHAN => $argsRef->[0] };
+ } else {
+ }
+}
+
+use SrSv::AgentUI {
+ NAME => $csnick,
+ PREFIX => '/cs',
+ ADD_COMMAND_SUB => 'cs_command',
+ DISPATCH_SUB => 'cs_dispatch',
+ WRAPPER => \&chanservWrapper,
+};
+import SrSv::AgentUI { FLOOD_CHECK_SUB => sub { return operserv::flood_check(@_); } };
+
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Conf;
+
+use strict;
+
+use SrSv::SimpleHash qw(read_hash);
+
+our %conffiles;
+
+=cut
+our $prefix;
+BEGIN {
+ if(main::PREFIX()) {
+ $prefix = main::PREFIX();
+ } else {
+ $prefix = '.';
+ }
+}
+=cut
+
+sub install_conf($$) {
+ no strict 'refs';
+ my ($pkg, $file) = @_;
+
+ *{"${pkg}::$file\_conf"} = $conffiles{$file};
+}
+
+sub import {
+ my ($pkg, @files) = @_;
+
+ foreach my $file (@files) {
+ unless(defined $conffiles{$file}) {
+ $conffiles{$file} = { read_hash(main::PREFIX()."/config/$file.conf") };
+ }
+
+ install_conf(caller(), $file);
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published
+# by the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Conf2Consts;
+
+use strict;
+
+use SrSv::SimpleHash qw(read_hash);
+#use SrSv::Util qw( PREFIX CWD );
+# This is in main
+BEGIN {
+ *CWD = \&main::CWD;
+ *PREFIX = \&main::PREFIX;
+}
+
+=head1 NAME
+
+Util::Conf2Consts
+
+=head1 DESCRIPTION
+
+Given a file full of key=value pairs, produce constant functions for the
+key that contains value.
+
+=head1 SYNOPSIS
+
+use Util::Conf2Consts ( main sql );
+
+which will load the files main.conf and sql.conf, and load them into
+your namespace.
+
+=cut
+
+our (%conffiles, %subs);
+
+sub checkKeys($) {
+ my ($file) = @_;
+ my %exampleConf = read_hash("@{[PREFIX]}/config-example/$file.conf");
+ my %conf = read_hash("@{[PREFIX]}/config/$file.conf");
+ foreach my $key (keys(%exampleConf)) {
+ die "missing configuration key '$key' in $file.conf" if !exists($conf{$key});
+ }
+}
+
+sub install_vars($$) {
+ no strict 'refs';
+ no warnings;
+ my ($pkg, $file) = @_;
+
+ foreach my $key (keys(%{$conffiles{$file}})) {
+ # We don't support such constructs in Conf2Consts. yet.
+ next if ref $conffiles{$file}{$key};
+ my $scalar = $conffiles{$file}{$key};
+ $subs{$file}{$key} = sub() { $scalar; }
+ unless exists $subs{$file} and $subs{$file}{$key};
+ my $orig_key = $key;
+ $key =~ tr/-/_/;
+ $key = lc $key;
+ *{"${pkg}\::${file}_conf_${key}"} = $subs{$file}{$orig_key};
+ }
+}
+
+sub import {
+ my ($pkg, @files) = @_;
+
+ foreach my $file (@files) {
+ unless(defined $conffiles{$file}) {
+ checkKeys($file);
+ $conffiles{$file} = { read_hash("@{[PREFIX]}/config/$file.conf") };
+ }
+ install_vars(caller, $file);
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Debug;
+
+use strict;
+
+our @subs;
+BEGIN {
+ @subs = (
+ sub () { 0 },
+ sub () { 1 }
+ );
+}
+
+our %debug_pkgs;
+our $enabled;
+
+sub enable {
+ $enabled = 1;
+}
+
+sub import {
+ no strict 'refs';
+ no warnings 'uninitialized';
+ my ($package) = caller;
+
+ if($debug_pkgs{ALL}) {
+ *{"$package\::DEBUG"} = $subs[1];
+ } else {
+ *{"$package\::DEBUG"} = $subs[$debug_pkgs{$package}];
+ }
+
+ *{"$package\::DEBUG_ANY"} = $subs[$enabled];
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package SrSv::Email;
+use strict;
+
+use SrSv::Conf2Consts qw(main);
+use SrSv::IRCd::State qw( %IRCd_capabilities );
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw( send_email validate_email ) }
+
+sub send_email($$$) {
+ my ($dst, $subj, $msg) = @_;
+ return if main_conf_nomail;
+
+ open ((my $EMAIL), '|-', '/usr/sbin/sendmail', '-t');
+ print $EMAIL 'From: '.main_conf_email."\n";
+ print $EMAIL 'To: '.$dst."\n";
+ print $EMAIL 'Reply-to: '.main_conf_replyto."\n" if main_conf_replyto;
+ print $EMAIL 'Subject: '.$subj."\n\n";
+ print $EMAIL "This is an automated mailing from the IRC services at " . $IRCd_capabilities{NETWORK} . ".\n\n";
+ print $EMAIL $msg;
+ print $EMAIL "\n\n" . main_conf_sig . "\n";
+ close $EMAIL;
+}
+
+sub validate_email($) {
+ my ($email) = @_;
+
+ $email =~ /.+\.(\w+)$/;
+ my $tld = $1;
+ if(
+# $email =~ /^(?:[0-9a-z]+[-._+&])*[0-9a-z]+@(?:[-0-9a-z]+[.])+[a-z]{2,6}$/i and
+ $email =~ /^[^@]+@(?:[-0-9a-z]+[.])+[a-z]{2,6}$/i and
+ $email !~ /^(?:abuse|postmaster|noc|security|spamtrap)\@/i and
+ defined($core::ccode{uc $tld})
+ ) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Errors;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw($err_deny $err_email $err_pass) }
+
+*err_deny = \'Permission denied.';
+*err_email = \'Your email address looks funny.';
+*err_pass = \'Invalid password.';
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Hash::Passwords;
+
+=head1 NAME
+
+SrSv::Hash::Passwords - Handle passwords, hashing, and verifying the hashes.
+
+=cut
+
+use strict;
+use SrSv::Hash::SaltedHash qw( makeHash verifyHash );
+use SrSv::Conf qw( main );
+
+use Exporter 'import';
+BEGIN {
+ our @EXPORT = qw( hash_pass validate_pass is_hashed );
+}
+
+=head2
+
+ hash_pass($pass)
+ If hashed-passwords is enabled in main.conf, returns a hashed password in a string.
+ Otherwise returns $pass unmodified.
+
+=cut
+
+sub hash_pass($) {
+ my ($pass) = @_;
+ if($main_conf{'hashed-passwords'}) {
+ return makeHash($pass);
+ }
+ else {
+ return $pass;
+ }
+}
+
+=head2
+
+ validate_pass($hashedPass, $pass)
+ Decodes the hashedPass.
+ - If $hashedPass is a valid SSHA256 hash-string, it and determines whether $pass matches $hashedPass
+ - If $hashedPass is not a valid SSHA256 hash-string, it returns ($hashedPass eq $pass)
+
+=cut
+sub validate_pass($$) {
+ my ($hashedPass, $pass) = @_;
+ if (my $hashType = is_hashed($hashedPass)) {
+ return verifyHash($hashedPass, $pass);
+ } else {
+ return $hashedPass eq $pass;
+ }
+}
+
+sub is_hashed($) {
+ my ($in) = @_;
+ if ($in =~ /^\{S(.*)\}/ or $in =~ m/^(?:SHA256):v\d+-\d+-r\d+:[A-Za-z0-9+\/=]+:/) {
+ return 1;
+ } else {
+ return undef;
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Hash::Random;
+
+=head1 NAME
+
+SrSv::Hash::Random - generates random strings for use as salt
+
+=cut
+
+use strict;
+#use SrSv::Conf qw( main );
+
+use Exporter 'import';
+BEGIN {
+ our @EXPORT = qw( randomByte randomBytes );
+}
+
+sub randomByte() {
+ return chr(int(rand(256)));
+}
+
+sub randomBytes($) {
+ my ($count) = @_;
+ my $string;
+ for(1..$count) {
+ $string .= randomByte();
+ }
+ return $string;
+}
+
+=cut
+sub randomBytes($) {
+ my ($count) = @_;
+ open((my $fh), '<', '/dev/urandom');
+ binmode $fh;
+ my $bytes = '';
+ sysread($fh, $bytes, $count);
+ close $fh;
+ return $bytes;
+}
+
+sub randomByte() {
+ return randomBytes(1);
+}
+=cut
+
+1;
+
--- /dev/null
+#########################################################################################
+## ##
+## Copyright(c) 2007 M2000, Inc. ##
+## ##
+## File: SaltedHash.pm ##
+## Author: Adam Schrotenboer ##
+## ##
+## ##
+## Description ##
+## =========== ##
+## Produces salted hashes for various uses. ##
+## This module is licensed under the Lesser GNU Public License version 2.1 ##
+## ##
+## Revision History ##
+## ================ ##
+## 11/13/07: Initial version. ##
+## ##
+## ##
+#########################################################################################
+## ##
+## For more details refer to the implementation specification document ##
+## DRCS-xxxxxx Section x.x ##
+## ##
+#########################################################################################
+package SrSv::Hash::SaltedHash;
+
+use strict;
+
+=head1 NAME
+
+SaltedHash
+
+=head1 SYNOPSIS
+
+use SaltedHash;
+
+=head1 DESCRIPTION
+
+Produces and verifies salted hashes.
+
+=head2 NOTE
+
+ This module currently only supports SHA256, and requires Digest::SHA.
+ If Digest::SHA is not available, it will however fallback to an included copy of Digest::SHA::PurePerl
+
+=cut
+
+
+BEGIN {
+ if(eval { require Digest::SHA; } ) {
+ import Digest::SHA qw( sha256_base64 sha256 sha1 );
+ print "SrSv::Hash::SaltedHash using Digest::SHA\n";
+ }
+ elsif(eval { require Digest::SHA::PurePerl; } ){
+ import Digest::SHA::PurePerl qw( sha256_base64 sha256 sha1 );
+ print "SrSv::Hash::SaltedHash using Digest::SHA::PurePerl\n";
+ } else {
+ die "Unable to find a suitable SHA implementation\n";
+ }
+}
+
+=item Hash Notes
+
+ SHA512 requires 64bit int operations, and thus will be SLOW on 32bit platforms.
+ Current hash string length with SHA256 and 16byte (128bit) salts is 85 characters
+ Be aware that SHA512 with 16byte salt would take approximately ~130 characters
+ So make sure that your password field can hold strings large enough.
+ It is generally considered pointless to make your salt
+ longer than your hash, so 32bytes is longest that is useful
+ for SHA256 and 64 is longest for SHA512.
+ SrSv has a limit of 127 characters for password strings, so don't use SHA512.
+
+=cut
+use Exporter 'import';
+BEGIN {
+ my %constants = (
+ HASH_ALGORITHM => 'SHA256',
+ HASH_SALT_LEN => 16,
+ HASH_ROUNDS => 1,
+ );
+ my $version = 'v1-'.$constants{HASH_SALT_LEN}.'-r'.$constants{HASH_ROUNDS};
+ $constants{HASH_VERSION} = $version;
+ our @EXPORT = qw( makeHash verifyHash );
+ our @EXPORT_OK = ( @EXPORT, keys(%constants), qw( extractMeta extractSalt padBase64 makeHash_v0 makeHash_v1 ));
+ our %EXPORT_TAGS = ( constants => [keys(%constants)] );
+ require constant; import constant (\%constants);
+}
+
+
+use MIME::Base64 qw( encode_base64 decode_base64 );
+use SrSv::Hash::Random qw( randomBytes randomByte );
+
+=item makeHash($;$$$)
+
+ makeHash($secret, $salt, $algorithm, $version)
+
+ Salt is assumed to be a BINARY STRING.
+
+ Algorithm currently can only be 'SHA256'
+
+=cut
+
+sub makeHash($;$$$) {
+ return makeHash_v1(@_);
+}
+
+=item makeHash_v1($;$$$)
+
+ makeHash_v1 ($secret, $salt, $algorithm, $version)
+
+ returns a string that can be processed thusly
+ my ($algorithm, $version, $salt, $hash) = split(':', $string);
+
+ my ($revision, $saltsize, $rounds) = split('-', $version);
+
+=cut
+
+sub makeHash_v1($;$$$) {
+ my ($secret, $salt, $algorithm, $version) = @_;
+ $algorithm = HASH_ALGORITHM unless $algorithm;
+ $salt = makeBinSalt(HASH_SALT_LEN) unless $salt;
+ $version = HASH_VERSION unless $version;
+ my $string = "$algorithm:$version:";
+ $string .= encode_base64($salt, '').':';
+ $string .= padBase64(__makeHash($secret . $salt, $algorithm));
+ return $string;
+}
+
+sub __makeHash($$) {
+ my ($plaintext, $algorithm) = @_;
+ $algorithm = 'sha256';
+ if($algorithm =~ /^sha256$/i) {
+ return sha256_base64($plaintext);
+ } else {
+ # Other hash algos haven't been implemented yet
+ die "Unknown hash algorithm \"$algorithm\" \"$plaintext\"\n";
+ }
+}
+
+sub makeHash_v0($;$$) {
+ my ($secret, $salt, $algorithm) = @_;
+ $algorithm = 'SHA256' unless $algorithm;
+ $salt = makeBinSalt(4) unless $salt;
+ my $string = "{S$algorithm}";
+ if($algorithm eq 'SHA256') {
+ $string .= encode_base64(sha256($secret . $salt) . $salt, '');
+ } elsif ($algorithm eq 'SHA') {
+ $string .= encode_base64(sha1($secret . $salt) . $salt, '');
+ }
+ return $string;
+}
+
+sub padBase64($) {
+ my ($b64_digest) = @_;
+ while (length($b64_digest) % 4) {
+ $b64_digest .= '=';
+ }
+ return $b64_digest;
+}
+
+=item makeHash
+
+ verifyHash($hash, $plain)
+
+ Verifies that a given $plain matches $hash
+
+=cut
+
+sub verifyHash($$) {
+ my ($hash, $plain) = @_;
+ my ($algorithm, $version, $salt) = extractMeta($hash);
+ my $hash2;
+ if($version eq 'v0') {
+ $hash2 = makeHash_v0($plain, $salt, $algorithm);
+ } else {
+ $hash2 = makeHash_v1($plain, $salt, $algorithm, $version);
+ }
+
+ return ($hash eq $hash2 ? 1 : 0);
+}
+
+sub makeBinSalt(;$) {
+ my ($len) = @_;
+ $len = HASH_SALT_LEN unless $len;
+ return randomBytes($len);
+}
+
+=item makeHash
+
+ extractMeta($hash)
+
+ return ($algorithm, $version, $salt) from $hash.
+
+=cut
+sub extractMeta($) {
+ my ($input) = @_;
+ if($input =~ /^\{S(\S+)\}(.*)$/) {
+ my $algorithm = $1;
+ my $saltedBinHash = decode_base64($2);
+ my $salt = substr($saltedBinHash, -4);
+ return ($algorithm, 'v0', $salt);
+ } else {
+ my ($algorithm, $version, $salt, $hash) = split(':', $input);
+ return ($algorithm, $version, decode_base64($salt));
+ }
+}
+
+=item makeHash
+
+ extractSalt($hash)
+
+ return $salt from $hash.
+
+=cut
+sub extractSalt($) {
+ my ($input) = @_;
+ my ($algorithm, $version, $salt) = extractMeta($input);
+ return $salt;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package SrSv::Help;
+use strict;
+
+use SrSv::User::Notice qw( notice );
+
+use Exporter 'import';
+BEGIN {
+ our @EXPORT = qw( sendhelp readhelp send_help read_help );
+ my %constants = ( HELP_PATH => main::PREFIX()."/help/" );
+ require constant; import constant \%constants;
+}
+
+sub readhelp($) {
+ my ($file_name) = @_;
+ my @array;
+
+ open ((my $file_handle), $file_name) or return undef();
+
+ while(my $x = <$file_handle>) {
+ next if $x =~ /^#/;
+ chomp $x;
+ $x =~ s/\%B/\002/g;
+ $x =~ s/\%U/\037/g; # chr(31)
+ $x =~ s/\%E(.*?)\%E/eval($1)/eg;
+
+ $x = ' ' if $x eq '';
+ push @array, $x;
+ }
+
+ close $file_handle;
+
+ return (' ', @array, ' --');
+}
+
+sub sendhelp($@) {
+ my ($user, @subject) = @_;
+
+ @subject = split(/ /, $subject[0]) if(@subject == 1);
+
+ # change any / or . to _
+ # this is to prevent ppl from using this to access
+ # files outside of the helpdir.
+ # also lowercase the @subject components
+ foreach my $s (@subject) {
+ $s = lc $s;
+ $s =~ s/[^a-z0-9\-]/_/g;
+ }
+
+ my $file = HELP_PATH . join('/', @subject) . '.txt';
+ my @array = readhelp($file);
+ unless($array[0]) {
+ notice($user, "No help for \002".join(' ',
+ @subject)."\002");
+ return;
+ }
+
+ notice($user, @array);
+}
+
+BEGIN {
+ *read_help = \&readhelp;
+ *send_help = \&sendhelp;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::HostMask;
+
+=head1 NAME
+
+SrSv::HostMask - Functions for manipulating hostmasks
+
+=head1 SYNOPSIS
+
+ use SrSv::HostMask qw(normalize_hostmask hostmask_to_regexp parse_mask parse_hostmask make_hostmask);
+
+=cut
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw( normalize_hostmask hostmask_to_regexp parse_mask parse_hostmask make_hostmask ) }
+
+=pod
+
+ normalize_hostmask($hostmask);
+
+ # Heuristically convert random stuff entered by the user to normal *!*@* form
+ $hostmask = normalize_hostmask($hostmask)
+
+
+=cut
+
+sub normalize_hostmask($) {
+ my ($in) = @_;
+ if($in !~ /[!@]/) { # we have to guess whether they mean nick or host
+ if($in =~ /\./) { # nicks can't contain dots, so assume host
+ #if($in =~ /\*/) {
+ return '*!*@' . $in;
+ #} else { # no wildcard, so add one
+ # return '*!*@*' . $in;
+ #}
+ } else { # no dots, so assume nick
+ return $in . '!*@*';
+ }
+ }
+
+ my @parts = ($in =~ /^(.*?)(?:!(.*?))(?:\@(.*?))?$/);
+ my $out;
+
+ for my $i (0..2) {
+ $parts[$i] = '*' unless length($parts[$i]);
+ $out .= $parts[$i] . @{['!', '@', '']}[$i];
+ };
+
+ return $out;
+}
+
+
+=pod
+
+ my $re = hostmask_to_regexp('*!*@*.aol.com');
+ if($hostmask =~ $re) {
+ # user is from AOL
+ # ...
+ }
+
+=cut
+
+sub hostmask_to_regexp($) {
+ my $mask = normalize_hostmask(shift);
+
+ $mask =~ s/([^a-zA-Z0-9?*])/\\$1/g;
+ $mask =~ s/\*/.*/g;
+ $mask =~ s/\?/./g;
+
+ return qr/^$mask$/i;
+}
+
+=pod
+
+ my ($nick, $ident, $host) = parse_mask($mask);
+
+ split a nick!ident@hostmask into components
+ also lets you just do @host, or nick!
+
+=cut
+
+sub parse_mask($) {
+ my ($mask) = @_;
+ my ($mnick, $mident, $mhost);
+
+ $mask =~ /^(.*?)(?:\!|\@|$)/;
+ $mnick = $1;
+
+ if($mask =~ /\!(.*?)(?:\@|$)/) {
+ $mident = $1;
+ } else {
+ $mident = '';
+ }
+
+ if($mask =~ /\@(.*?)$/) {
+ $mhost = $1;
+ } else {
+ $mhost = '';
+ }
+
+ return ($mnick, $mident, $mhost);
+}
+
+=pod
+
+ my ($ident, $host) = parse_hostmask($mask);
+
+ This is like parse_mask, but only will parse ident@host
+ TKL in particular will use this.
+ also could be used to parse email addresses
+
+=cut
+
+sub parse_hostmask($) {
+ my ($mask) = @_;
+ my ($mident, $mhost);
+
+ if($mask !~ /@/) {
+ return ('', $mask);
+ }
+ elsif($mask =~ /\!(.*?)(?:\@|$)/) {
+ $mident = $1;
+ } else {
+ $mident = '';
+ }
+
+ if($mask =~ /\@(.*?)$/) {
+ $mhost = $1;
+ } else {
+ $mhost = '';
+ }
+
+ return ($mident, $mhost);
+}
+
+=pod
+
+ make_hostmask($type, $nick, $ident, $host);
+
+ Some of this may be Unreal/cloak specific, but is mostly generic.
+ No IPv6 support yet.
+ $type is an integer, 0 - 10
+ 0 - *!user@host.domain
+ 1 - *!*user@host.domain
+ 2 - *!*@host.domain
+ 3 - *!*user@*.domain
+ 4 - *!*@*.domain
+ 5 - nick!user@host.domain
+ 6 - nick!*user@host.domain
+ 7 - nick!*@host.domain
+ 8 - nick!*user@*.domain
+ 9 - nick!*@*.domain
+ 10 - cross btwn 2 and 3, depending on if is a java-abcd1 ident or not
+
+ 10 is very SCnet specific (more accurately, it is specific to our java iframe)
+ our java iframe is _not_ open source [yet]. I do not know if it will be either.
+
+=cut
+
+sub make_hostmask($$$$) {
+ my ($type, $nick, $ident, $host) = @_;
+ no warnings 'prototype'; #we call ourselves
+
+ if($type == 10) {
+ if ($ident =~ /^java-/) {
+ return make_hostmask(3, $nick, $ident, $host);
+ }
+ else {
+ return make_hostmask(2, $nick, $ident, $host);
+ }
+ }
+
+ if($host =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) {
+ # IPv4 address, dotted quad.
+ my @octets = ($1, $2, $3, $4);
+ if($type =~ /^[3489]$/) {
+ $host = $octets[0].'.'.$octets[1].'.'.$octets[2].'.*';
+ }
+ }
+ elsif($host =~ /^[A-Z0-9]{7}\.[A-Z0-9]{8}\.[A-Z0-9]{7}\.IP$/) { # should probably be case-sensitive.
+ # 74BBBBF2.493EE1E3.CA7BA255.IP
+ if($type =~ /^[3489]$/) {
+ my @host = split(/\./, $host);
+ pop @host; #discard last token ('IP')
+ $host = '*.'.$host[2].'.IP'; # Unreal's cloak makes last group be the first two octets.
+ }
+ } else {
+ # we assume normal hostname
+ # We don't know what the cloak prefix will be, nor that it will be sane
+ # Or even that we'll have a normal cloaked host (it could be a vhost)
+ # So we can't restrict the character-class [much].
+ # This could be improved further by popping off the
+ # parts that are mostly numbers, if not a normal cloakhost.
+ if($type =~ /^[3489]$/) {
+ $host =~ /(.+?)\.(.+\.[a-z]{2,3})/i;
+ $host = "*.$2";
+ }
+ }
+
+ if($type =~ /^[1368]$/) {
+ $ident =~ s/^\~//;
+ $ident = "*$ident" unless (length($ident) > (ircd::IDENTLEN - 1));
+ } elsif($type =~ /^[2479]$/) {
+ $ident = '*';
+ }
+
+ if ($type < 5 and $type >= 0) {
+ $nick = '*';
+ }
+
+ return ($nick, $ident, $host);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::IRCd::Event;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(addhandler callfuncs) }
+
+use SrSv::Debug;
+
+use SrSv::IRCd::Queue qw(ircd_enqueue);
+use SrSv::IRCd::State qw($ircline $ircline_real synced initial_synced);
+
+use SrSv::Message qw(add_callback message);
+
+# FIXME
+use constant {
+ # Wait For
+ WF_NONE => 0,
+ WF_NICK => 1,
+ WF_CHAN => 2,
+ WF_ALL => 3,
+};
+
+sub addhandler($$$$;$) {
+ my ($type, $src, $dst, $cb, $po) = @_;
+
+ if($cb !~ /::/) {
+ $cb = caller() . "::$cb";
+ }
+
+ print "Adding callback: $cb\n" if DEBUG;
+
+ my @cond = ( CLASS => 'IRCD', TYPE => $type );
+ push @cond, ( SRC => $src ) if($src);
+ push @cond, ( DST => $dst ) if($dst);
+
+ add_callback({
+ NAME => $cb,
+ TRIGGER_COND => { @cond },
+ CALL => 'SrSv::IRCd::Event::_realcall',
+ REALCALL => $cb,
+ PARENTONLY => $po,
+ });
+}
+
+sub callfuncs {
+ my ($args, $sync, $wf, $message);
+
+ if(@_ == 4) {
+ $args = $_[3];
+ $sync = 1;
+ $wf = WF_NONE;
+ } else {
+ $args = $_[4];
+ $sync = 0;
+ $wf = $_[3];
+ }
+
+ $message = {
+ CLASS => 'IRCD',
+ TYPE => $_[0],
+ SYNC => $sync,
+ SRC => (defined($_[1]) ? $args->[$_[1]] : undef),
+ DST => (defined($_[2]) ? $args->[$_[2]] : undef),
+ WF => $wf,
+ IRCLINE => ($sync ? $ircline : $ircline_real),
+ ARGS => $args,
+ ON_FINISH => ($sync ? undef : 'SrSv::IRCd::Queue::finished'), # FIXME
+ SYNCED => [synced, initial_synced],
+ };
+
+ if($sync) {
+ message($message);
+ } else {
+ ircd_enqueue($message);
+ }
+}
+
+sub _realcall($$) {
+ no strict 'refs';
+
+ my ($message, $callback) = @_;
+
+ print "Calling ", $callback->{REALCALL}, " ", join(',', @{$message->{ARGS}}), "\n" if DEBUG();
+ $ircline = $message->{IRCLINE};
+
+ local $SrSv::IRCd::State::synced = $message->{SYNCED}[0]; # XXX This is questionable.
+ local $SrSv::IRCd::State::initial_synced = $message->{SYNCED}[1];
+
+ print "IRCLINE is $ircline synced is $SrSv::IRCd::State::synced initial_synced is $SrSv::IRCd::State::initial_synced\n" if DEBUG();
+
+ &{$callback->{REALCALL}}(@{$message->{ARGS}});
+ ircd::flushmodes() unless $message->{SYNC}; # FIXME
+ print "Finished with $ircline\n" if DEBUG();
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::IRCd::IO;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(ircd_connect ircd_disconnect ircsendimm ircsend ircd_flush_queue) }
+
+use constant {
+ NL => "\015\012",
+};
+
+use Errno ':POSIX';
+use Event;
+
+use SrSv::Process::InParent qw(irc_connect ircsend ircsendimm ircd_flush_queue);
+use SrSv::Process::Worker qw(ima_worker);
+use SrSv::Debug;
+use SrSv::IRCd::State qw($ircline $ircline_real $ircd_ready);
+use SrSv::IRCd::Event qw(callfuncs);
+use SrSv::Unreal::Tokens;
+use SrSv::Unreal::Parse qw(parse_line);
+use SrSv::RunLevel qw(emerg_shutdown);
+use SrSv::Log qw( write_log );
+
+our $irc_sock;
+our @queue;
+our $flood_queue;
+
+sub irc_error($) {
+ print "IRC connection failed", ($_[0] ? ": $_[0]\n" : ".\n");
+ emerg_shutdown;
+}
+
+{
+ my $partial;
+
+ sub ircrecv {
+ my ($in, $r);
+ while($r = $irc_sock->sysread(my $part, 4096) > 0) {
+ $in .= $part;
+ }
+
+ irc_error($!) if($r <= 0 and not $!{EAGAIN});
+
+ my @lines = split(/\015\012/, $in);
+
+ $lines[0] = $partial . $lines[0];
+ if($in =~ /\015\012$/s) {
+ $partial = '';
+ } else {
+ $partial = pop @lines;
+ }
+
+ foreach my $line (@lines) {
+ $ircline_real++ unless $line =~ /^(?:8|PING)/;
+ write_log('netdump', '', $line) if main::NETDUMP();
+ print ">> $ircline_real $line\n" if DEBUG_ANY;
+ foreach my $ev (parse_line($line)) {
+ next unless $ev;
+
+ callfuncs(@$ev);
+ }
+ }
+ }
+}
+
+{
+ my $watcher;
+
+ sub ircd_connect($$) {
+ my ($remote, $port) = @_;
+
+ print "Connecting..." if DEBUG;
+ $irc_sock = IO::Socket::INET->new(
+ PeerAddr => $remote,
+ PeerPort => $port,
+ Proto => 'tcp',
+ Blocking => 1,
+ ) or die("Could not connect to IRC server ($remote:$port): $!");
+ $irc_sock->blocking(0);
+ print " done\n" if DEBUG;
+
+ $irc_sock->autoflush(1);
+
+ $watcher = Event->io(
+ cb => \&ircrecv,
+ fd => $irc_sock,
+ nice => -1,
+ );
+ }
+
+ sub ircd_disconnect() {
+ ircd_flush_queue();
+ $watcher->cancel;
+ $irc_sock->close;
+ }
+}
+
+sub ircsendimm {
+ print "ircsendimm() ima_worker: ", ima_worker(), "\n" if DEBUG;
+
+ if(defined $flood_queue) {
+ print "FLOOD QUEUE ACTIVE\n" if DEBUG;
+ push @$flood_queue, @_;
+ return;
+ }
+
+ while(my $line = shift @_) {
+ my $r;
+ my $bytes = 0;
+ my $len = length($line) + 2;
+ write_log('netdump', '', split(NL, $line))
+ if main::NETDUMP();
+ while(1) {
+ $r = $irc_sock->syswrite($line . NL, undef, $bytes);
+ $bytes += $r if $r > 0;
+
+ if($r <= 0 or $r < $len) {
+ if($!{EAGAIN} or ($r > 0 and $r < $len)) {
+ # Hold off to avoid flooding off
+ print "FLOOD QUEUE ACTIVE\n" if DEBUG;
+
+ $flood_queue = [];
+
+ push @$flood_queue, substr($line, $bytes) unless $bytes == $len;
+ push @$flood_queue, @_;
+
+ Event->idle (
+ min => 1,
+ max => 10,
+ repeat => 0,
+ cb => \&flush_flood_queue
+ );
+
+ return;
+ } else {
+ irc_error($!);
+ return;
+ }
+ }
+
+ last if($bytes == $len);
+ }
+ print "<< $line\n" if DEBUG_ANY;
+ }
+}
+
+sub ircsend {
+ print "ircsend() ima_worker: ", ima_worker(), "\n" if DEBUG;
+ if(DEBUG) {
+ foreach my $x (@_) {
+ print "<< $ircline $x\n";
+ }
+ }
+
+ if($ircd_ready) {
+ ircsendimm(@_);
+ } else {
+ foreach my $x (@_) {
+ if($x =~ /^$tkn{NICK}[$tkn]/) {
+ unshift @queue, $x;
+ } else {
+ push @queue, $x;
+ }
+ }
+ }
+}
+
+sub ircd_flush_queue() {
+ ircsendimm(@queue);
+ undef @queue;
+}
+
+sub flush_flood_queue() {
+ my $q = $flood_queue;
+ undef $flood_queue;
+ ircsendimm(@$q);
+}
+
+1;
--- /dev/null
+../Unreal/Send.pm
\ No newline at end of file
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::IRCd::Queue;
+
+# The purpose of this module is to make sure lines get processed in an
+# order that makes sense, e.g., a JOIN should not be processed before
+# the corresponding NICKCONN has been.
+
+# FIXME: This may not be well optimized. It also can be fouled up by
+# conflicting messages with the same WF value, such as the same nick
+# disconnecting and connecting at once.
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(ircd_enqueue queue_size) }
+
+use SrSv::Debug;
+use SrSv::Message qw(message);
+
+our @queue = map [], 0..3; # 3 is the maximum WF value
+
+sub ircd_enqueue($) {
+ my ($message) = @_;
+ my ($ircline, $wf) = @$message{'IRCLINE', 'WF'};
+
+ if($wf == 0) {
+ message($message);
+ return;
+ }
+
+ push @{$queue[$wf]}, $message;
+
+ if(_is_runnable($message)) {
+ print "$message->{IRCLINE} is runnable immediately. (WF=$message->{WF})\n" if DEBUG;
+ message($message);
+ $message->{_Q_RUNNING} = 1;
+ }
+}
+
+sub queue_size() {
+ my $r;
+ foreach (@queue) { $r += @$_ }
+ return $r;
+}
+
+sub finished {
+ my ($message) = @_;
+ my ($ircline, $wf) = @$message{'IRCLINE', 'WF'};
+
+ print "Called finished() for $ircline\n" if DEBUG();
+
+ for(my $i; $i < @{$queue[$wf]}; $i++) {
+ if($queue[$wf][$i]{IRCLINE} == $ircline) {
+ splice(@{$queue[$wf]}, $i, 1);
+ last;
+ }
+ }
+
+ if($message->{TYPE} eq 'SEOS') {
+ $message->{TYPE} = 'POSTSEOS';
+ message($message);
+ }
+
+ _dequeue();
+}
+
+sub _is_runnable($) {
+ my ($message) = @_;
+ my ($ircline, $wf) = @$message{'IRCLINE', 'WF'};
+
+ for(1..($wf-1)) {
+ if(defined($queue[$_][0]) and $queue[$_][0]{IRCLINE} < $ircline) {
+ print "Line $ircline must wait for $queue[$_][0]{IRCLINE}\n" if DEBUG;
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+sub _dequeue {
+ foreach my $q (@queue) {
+ INNER: foreach my $message (@$q) {
+ next INNER if $message->{_Q_RUNNING};
+
+ if(_is_runnable($message)) {
+ print "$message->{IRCLINE} is now runnable\n" if DEBUG;
+
+ message($message);
+ $message->{_Q_RUNNING} = 1;
+ }
+ else {
+ last INNER;
+ }
+ }
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::IRCd::State;
+
+
+use strict;
+
+use Exporter 'import';
+our @EXPORT_OK = qw($ircline $ircline_real $remoteserv $ircd_ready synced initial_synced create_server get_server_children set_server_state set_server_juped get_server_state get_online_servers %IRCd_capabilities);
+
+# FIXME - synced() is called very often and should be cached locally
+use SrSv::Process::InParent qw(calc_synced create_server get_server_children set_server_state set_server_juped get_server_state get_online_servers);
+
+use SrSv::Conf 'main';
+
+use SrSv::Debug;
+
+use SrSv::Shared qw(%IRCd_capabilities);
+
+our $ircline = 0;
+our $ircline_real = 0;
+our $remoteserv;
+our $ircd_ready;
+
+our %servers;
+our %juped_servers;
+our $synced;
+our $initial_synced;
+
+sub synced {
+ return $synced;
+}
+
+sub initial_synced {
+ return $initial_synced;
+}
+
+sub calc_synced {
+ #return ($sync and $sync < $ircd::ircline);
+
+ SYNCED: {
+ foreach my $s (keys(%servers)) {
+ my $state = get_server_state($s);
+
+ print "Server: $s State: $state\n" if DEBUG();
+
+ if(!$state) {
+ $synced = 0;
+ last SYNCED;
+ }
+ }
+
+ $synced = 1;
+ }
+
+ {
+ my $state = get_server_state($remoteserv);
+ if(!$state) {
+ $initial_synced = 0;
+ } else {
+ $initial_synced = 1;
+ }
+ }
+}
+
+sub create_server($$) {
+ my ($child, $parent) = @_;
+
+ $servers{$child} = {
+ PARENT => $parent,
+ CHILDREN => [],
+ SYNCED => 0,
+ };
+
+ push @{$servers{$parent}{CHILDREN}}, $child if $parent;
+
+ calc_synced();
+}
+
+sub get_server_children($) {
+ my ($s) = @_;
+ return ($s, map get_server_children($_), @{$servers{$s}{CHILDREN}});
+}
+
+sub set_server_state {
+ my ($server, $state) = @_;
+
+ if(defined($state)) {
+ return if $juped_servers{$server};
+
+ $servers{$server}{SYNCED} = $state;
+ } else {
+ delete $juped_servers{$server};
+
+ if(my $parent = $servers{$server}{PARENT}) {
+ $servers{$parent}{CHILDREN} = [
+ grep {$_ ne $server} @{$servers{$parent}{CHILDREN}}
+ ];
+ }
+
+ foreach (get_server_children($server)) {
+ delete $servers{$_};
+ }
+ }
+
+ calc_synced();
+}
+
+sub set_server_juped($) {
+ my ($server) = @_;
+
+ set_server_state($server, undef);
+ $juped_servers{$server} = 1;
+}
+
+sub get_server_state {
+ my ($server) = @_;
+
+ my $badserver = $main_conf{'unsyncserver'};
+ return 1 if($badserver and lc $server eq lc $badserver); # I HATE NEOSTATS
+
+ return $servers{$server}{SYNCED};
+}
+
+sub get_online_servers {
+ my @online_servers;
+ foreach my $server (keys(%servers)) {
+ push @online_servers, $server if $servers{$server}{SYNCED};
+ }
+ return @online_servers;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package SrSv::Log;
+
+use strict;
+use IO::Handle;
+
+use SrSv::Debug;
+use SrSv::Timer qw(add_timer);
+use SrSv::Time;
+use SrSv::Process::InParent qw(write_log open_log close_log rotate_logs close_all_logs);
+
+use SrSv::Text::Codes qw( strip_codes );
+
+use SrSv::Conf2Consts qw(main);
+
+use Exporter 'import';
+BEGIN {
+ my %constants = (
+ LOG_DEBUG => 0,
+ LOG_INFO => 1,
+ LOG_WARNING => 2, # A bad thing might happen
+ LOG_ERROR => 3, # A bad thing happened
+ LOG_CRITICAL => 4, # One module is going down
+ LOG_FATAL => 5, # One thread is going down
+ LOG_PANIC => 6, # The entire server is going down
+
+ LOG_OPEN => 1,
+ LOG_CLOSE => 2,
+ LOG_WRITE => 3,
+ LOG_ROTATE => 4,
+ );
+
+ require constant; import constant (\%constants);
+ our @EXPORT = ( qw( wlog write_log open_log close_log ), keys(%constants) );
+ our @EXPORT_OK = ( qw ( rotate_logs close_all_logs ) );
+ our %EXPORT_TAGS = (
+ levels => [keys(%constants)],
+ all => [@EXPORT, @EXPORT_OK],
+ );
+}
+
+our $path = './logs';
+our @levels = ('DEBUG', 'INFO', 'WARNING', 'ERROR', 'CRITICAL', 'FATAL', 'PANIC');
+
+open_log('diag', 'services.log');
+open_log('netdump', 'netdump.log') if main::NETDUMP();
+
+sub wlog($$$) {
+ my ($service, $level, $text) = @_;
+
+ my $prefix;
+ $prefix = "\002\00304" if($level > LOG_INFO);
+ $prefix .= $levels[$level];
+ ircd::privmsg($main::rsnick, main_conf_diag, "$prefix\: ($service) $text");
+ write_log('diag', '<'.$main::rsnick.'>', "$prefix\: ($service) $text");
+}
+
+my %log_handles;
+my %file_handles;
+
+sub write_log($$@) {
+ my ($handle, $prefix, @payloads) = @_;
+ unless (defined($log_handles{lc $handle})) {
+ ircd::debug_nolog("undefined log-handle $handle, aborting write()") if main::DEBUG();
+ return undef;
+ }
+ foreach (@payloads) {
+ $_ = strip_codes($_);
+ }
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime();
+ my $time = sprintf("%02d:%02d:%02d", $hour, $min, $sec);
+ my $payload = $time.$prefix.' '.join("\n".$time.$prefix.' ', @payloads);
+ print {$log_handles{lc $handle}} "$payload\n";
+}
+
+sub open_log($$) {
+ my ($handle, $filename) = @_;
+ if (defined($log_handles{lc $handle})) {
+ ircd::debug_nolog("duplicate log-handle $handle, aborting open()");
+ return undef;
+ }
+ my ($year, $month, undef, $mday) = gmt_date();
+ my $filename2 = $filename.'-'.sprintf('%04d-%02d-%02d', $year, $month, $mday);
+
+ open $log_handles{lc $handle}, '>>', $path.'/'.$filename2;
+ $file_handles{lc $handle} = { BASENAME => $filename, FILENAME => $filename2 };
+ $log_handles{lc $handle}->autoflush(1);
+}
+
+sub close_log($) {
+ my ($handle) = @_;
+ unless (defined($log_handles{lc $handle})) {
+ ircd::debug_nolog("undefined log-handle $handle, aborting close()");
+ return undef;
+ }
+ close $log_handles{lc $handle};
+ delete($log_handles{lc $handle});
+}
+
+sub rotate_logs() {
+ foreach my $handle (keys(%file_handles)) {
+ close $log_handles{$handle};
+ my ($year, $month, undef, $mday) = gmt_date();
+ $file_handles{lc $handle}{FILENAME} = $file_handles{lc $handle}{BASENAME}.'-'.sprintf('%04d-%02d-%02d', $year, $month, $mday);
+ open $log_handles{$handle}, '>>', $path.'/'.$file_handles{lc $handle}{FILENAME};
+ }
+
+ add_timer('', get_nextday_time()-time(), __PACKAGE__, 'SrSv::Log::rotate_logs');
+}
+
+sub close_all_logs() {
+ foreach my $handle (keys(%file_handles)) {
+ close $log_handles{$handle};
+ $file_handles{lc $handle} = undef;
+ }
+}
+
+# set a timer to rotate logs on day-change
+add_timer('', get_nextday_time()-time(), __PACKAGE__, 'SrSv::Log::rotate_logs');
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Message;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(add_callback message call_callback unit_finished current_message) }
+
+use Carp;
+use Storable qw(fd_retrieve store_fd);
+
+use SrSv::Debug;
+BEGIN {
+ if(DEBUG) {
+ require Data::Dumper; import Data::Dumper ();
+ }
+}
+
+use SrSv::Process::Call qw(safe_call);
+use SrSv::Process::Worker qw(ima_worker get_socket multi call_in_parent call_all_child do_callback_in_child);
+
+our %callbacks_by_trigger_class;
+our %callbacks_by_after;
+our %callbacks_by_name;
+
+our $current_message;
+
+### Public functions
+
+sub add_callback($) {
+ my ($callback) = @_;
+
+ if(multi) {
+ croak "Callbacks cannot be added at runtime";
+ }
+
+ if(my $after = $callback->{AFTER}) {
+ push @{$callbacks_by_after{$after}}, $callback;
+ }
+
+ $callback->{NAME} = $callback->{CALL} unless $callback->{NAME};
+ if(my $name = $callback->{NAME}) {
+ push @{$callbacks_by_name{$name}}, $callback;
+ }
+
+ if(my $trigger = $callback->{TRIGGER_COND}{CLASS}) {
+ push @{$callbacks_by_trigger_class{$trigger}}, $callback;
+ }
+
+ if(DEBUG()) {
+ print "Added callback: $callback->{NAME}\n";
+ }
+}
+
+sub message($) {
+ my ($message) = @_;
+
+ if(ima_worker()) {
+ if($message->{SYNC}) {
+ print "Triggered a sync callback!\n" if DEBUG();
+ trigger_callbacks($message);
+ } else {
+ store_fd($message, get_socket());
+ fd_retrieve(get_socket());
+ }
+ return;
+ }
+
+ trigger_callbacks($message);
+}
+
+### Semi-private ###
+
+sub call_callback {
+ my ($callback, $message) = @_;
+
+ local $current_message = $message;
+
+ if(my $call = $callback->{CALL}) {
+ safe_call($call, [$message, $callback]);
+ }
+}
+
+sub unit_finished($$) {
+ my ($callback, $message) = @_;
+
+ if(DEBUG()) {
+ print "--- Finished unit\nCallback: $callback->{NAME}\nMessage: $message->{CLASS}\n";
+ }
+
+ safe_call($callback->{ON_FINISH}, [$callback, $message]) if $callback->{ON_FINISH};
+
+ $message->{_CB_COUNTDOWN}--;
+ print "_CB_COUNTDOWN is $message->{_CB_COUNTDOWN}\n---\n" if DEBUG;
+
+ $message->{_CB_DONE}{$callback->{NAME}} = 1;
+
+ if(!$message->{SYNC} and defined($message->{_CB_QUEUE}) and @{$message->{_CB_QUEUE}}) {
+ trigger_callbacks($message);
+ }
+
+ if($message->{_CB_COUNTDOWN} == 0) {
+ message_finished($message);
+ }
+}
+
+sub message_finished($) {
+ my ($message) = @_;
+
+ print "Message finished: $message->{CLASS}\n" if DEBUG;
+
+ for(qw(_CB_QUEUE _CB_COUNTDOWN _CB_DONE _CB_TODO)) {
+ undef $message->{$_};
+ }
+
+ safe_call($message->{ON_FINISH}, [$message]) if $message->{ON_FINISH};
+}
+
+### Private functions ###
+
+sub trigger_callbacks($) {
+ my ($message) = @_;
+
+ my $callbacks;
+
+ if(defined($message->{_CB_QUEUE})) {
+ $callbacks = $message->{_CB_QUEUE};
+ } else {
+ $callbacks = get_matching_callbacks($message);
+ }
+
+ if(@$callbacks) {
+ $message->{_CB_COUNTDOWN} = @$callbacks unless defined($message->{_CB_COUNTDOWN});
+
+ my $do_next = [];
+
+ foreach my $callback (@$callbacks) {
+ my $after = $callback->{AFTER};
+ if($after and $message->{_CB_TODO}{$after} and not $message->{_CB_DONE}{$after}) {
+ push @$do_next, $callback;
+ } else {
+ do_unit($callback, $message);
+ }
+ }
+
+ $message->{_CB_QUEUE} = $do_next;
+
+ goto &trigger_callbacks if($message->{SYNC} and @$do_next > 0);
+ }
+
+ else {
+ if(DEBUG) {
+ print "Message with no callbacks: ".Dumper($message);
+ }
+
+ message_finished($message);
+ }
+}
+
+sub do_unit($$) {
+ my ($callback, $message) = @_;
+
+ if(!multi or $callback->{PARENTONLY} or $message->{SYNC}) {
+ call_callback($callback, $message);
+ unit_finished($callback, $message);
+ } else {
+ do_callback_in_child($callback, $message);
+ }
+}
+
+sub get_matching_callbacks($) {
+ my ($message) = @_;
+ my $ret = [];
+
+ my $class = $message->{CLASS};
+
+ foreach my $callback (@{$callbacks_by_trigger_class{$class}}) {
+ if(callback_matches($message, $callback)) {
+ push @$ret, $callback;
+ $message->{_CB_TODO}{$callback->{NAME}} = 1;
+ }
+ }
+
+ return $ret;
+}
+
+sub callback_matches($$) {
+ my ($message, $callback) = @_;
+
+ foreach my $cond (keys(%{$callback->{TRIGGER_COND}})) {
+ if(ref($callback->{TRIGGER_COND}{$cond}) eq 'Regexp') {
+ return 0 if defined($message->{$cond}) && !($message->{$cond} =~ $callback->{TRIGGER_COND}{$cond});
+ } else {
+ return 0 if defined($message->{$cond}) && !(lc $message->{$cond} eq lc $callback->{TRIGGER_COND}{$cond});
+ }
+ }
+
+ return 1;
+}
+
+sub current_message() { return $current_message }
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::MySQL;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw($dbh) }
+
+use DBI;
+
+use SrSv::Process::Init;
+use SrSv::Conf 'sql';
+
+our $dbh;
+
+proc_init {
+ $dbh = DBI->connect(
+ "DBI:mysql:".$sql_conf{'mysql-db'}.($sql_conf{server_prepare} ? ":mysql_server_prepare=1" : ''),
+ $sql_conf{'mysql-user'},
+ $sql_conf{'mysql-pass'},
+ {
+ AutoCommit => 1,
+ RaiseError => 0,
+ mysql_auto_reconnect => 1,
+ }
+ );
+ # Prevent timeout
+ $dbh->do("SET wait_timeout=(86400*365)");
+};
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::MySQL::Glob;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw( glob2sql sql2glob ) }
+
+sub glob2sql(@) {
+ foreach (@_) {
+ s/([%_])/\\$1/g;
+ tr/*?/%_/;
+ }
+ return (wantarray ? @_ : $_[0]);
+}
+
+sub sql2glob(@) {
+ foreach (@_) {
+ s/(?<!\\)_/?/g;
+ s/(?<!\\)%/*/g;
+ s/\\([%_])/$1/g;
+ }
+ return (wantarray ? @_ : $_[0]);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::MySQL::KeyValStub;
+
+use strict;
+
+use Symbol 'delete_package';
+
+use SrSv::MySQL '$dbh';
+use SrSv::Process::Init;
+
+sub create_stub($$) {
+ my ($get_sql, $set_sql) = @_;
+
+ my ($get, $set);
+
+ proc_init {
+ $get = $dbh->prepare($get_sql);
+ $set = $dbh->prepare($set_sql);
+ };
+
+ return sub ($;$) {
+ my ($k, $v) = @_;
+
+ if(defined($v)) {
+ $set->execute($v, $k); $set->finish;
+ } else {
+ $get->execute($k);
+ $v = $get->fetchrow_array;
+ $get->finish;
+ }
+
+ return $v;
+ };
+}
+
+sub create_readonly_stub($) {
+ my ($get_sql) = @_;
+
+ my ($get);
+
+ proc_init {
+ $get = $dbh->prepare($get_sql);
+ };
+
+ return sub ($) {
+ my ($k) = @_;
+
+ $get->execute($k);
+ my $v = $get->fetchrow_array;
+ $get->finish;
+
+ return $v;
+ };
+}
+
+sub import {
+ my (undef, $stubs) = @_;
+
+ my $callpkg = caller();
+
+ while(my ($name, $sql) = each %$stubs) {
+ no strict 'refs';
+
+ my $stub;
+
+ if(@$sql == 2) {
+ $stub = create_stub($sql->[0], $sql->[1]);
+ }
+ elsif(@$sql == 1) {
+ $stub = create_readonly_stub($sql->[0]);
+ }
+ else {
+ my ($package, $filename, $line) = caller();
+ die "Invalid use of ".__PACKAGE__." at $filename line $line\n";
+ }
+
+ *{"$callpkg\::$name"} = $stub;
+ }
+}
+
+INIT {
+ delete_package(__PACKAGE__);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::MySQL::Stub;
+
+=head1 NAME
+
+SrSv::MySQL::Stub - Create functions for SQL queries
+
+=cut
+
+use strict;
+
+use Symbol 'delete_package';
+use Carp qw( confess );
+
+use SrSv::Debug;
+use SrSv::MySQL '$dbh';
+use SrSv::Process::Init;
+use DBI qw(:sql_types);
+
+our %types;
+
+sub create_null_stub($) {
+ my ($stub) = @_;
+
+ my $sth;
+
+ proc_init {
+ $sth = $dbh->prepare($stub->{SQL});
+ };
+
+ return sub {
+ my $ret;
+ eval { $ret = $sth->execute(@_) + 0; }; #force result to be a number
+ if($@) { confess($@) }
+ $sth->finish();
+ return $ret;
+ };
+}
+
+sub create_insert_stub($) {
+ my ($stub) = @_;
+
+ my $sth;
+
+ proc_init {
+ $sth = $dbh->prepare($stub->{SQL});
+ # This is potentially interesting here,
+ # given a INSERT SELECT
+ if($stub->{SQL} =~ /OFFSET \?$/) {
+ my @dummy = $stub->{SQL} =~ /\?/g;
+ $sth->bind_param(scalar(@dummy), 0, SQL_INTEGER);
+ }
+ };
+
+ return sub {
+ eval { $sth->execute(@_) };
+ if($@) { confess($@) }
+ $sth->finish();
+ return $dbh->last_insert_id(undef, undef, undef, undef);;
+ };
+}
+
+sub create_scalar_stub($) {
+ my ($stub) = @_;
+
+ my $sth;
+
+ proc_init {
+ $sth = $dbh->prepare($stub->{SQL});
+ if($stub->{SQL} =~ /OFFSET \?$/) {
+ my @dummy = $stub->{SQL} =~ /\?/g;
+ $sth->bind_param(scalar(@dummy), 0, SQL_INTEGER);
+ }
+ };
+
+ return sub {
+ eval{ $sth->execute(@_); };
+ if($@) { confess($@) }
+ my $scalar;
+ eval{ ($scalar) = $sth->fetchrow_array; };
+ if($@) { confess($@) }
+ $sth->finish();
+ return $scalar;
+ };
+}
+
+sub create_arrayref_stub($) {
+ my ($stub) = @_;
+
+ my $sth;
+
+ proc_init {
+ $sth = $dbh->prepare($stub->{SQL});
+ if($stub->{SQL} =~ /OFFSET \?$/) {
+ my @dummy = $stub->{SQL} =~ /\?/g;
+ $sth->bind_param(scalar(@dummy), 0, SQL_INTEGER);
+ }
+ };
+
+ return sub {
+ eval{ $sth->execute(@_); };
+ if($@) { confess($@) }
+ return $sth->fetchall_arrayref;
+ };
+}
+
+sub create_array_stub($) {
+ my ($stub) = @_;
+
+ my $sth;
+
+ proc_init {
+ $sth = $dbh->prepare($stub->{SQL});
+ if($stub->{SQL} =~ /OFFSET \?$/) {
+ my @dummy = $stub->{SQL} =~ /\?/g;
+ $sth->bind_param(scalar(@dummy), 0, SQL_INTEGER);
+ }
+ };
+
+ return sub {
+ eval{ $sth->execute(@_); };
+ if($@) { confess($@) }
+ my $arrayRef;
+ eval{ $arrayRef = $sth->fetchall_arrayref; };
+ if($@) { confess($@) }
+ $sth->finish();
+ return @$arrayRef;
+ };
+}
+
+sub create_column_stub($) {
+ my ($stub) = @_;
+
+ my $sth;
+
+ proc_init {
+ $sth = $dbh->prepare($stub->{SQL});
+=cut
+# This isn't useful here.
+ if($stub->{SQL} =~ /OFFSET \?$/) {
+ my @dummy = $stub->{SQL} =~ /\?/g;
+ $sth->bind_param(scalar(@dummy), 0, SQL_INTEGER);
+ }
+=cut
+ };
+
+ return sub {
+ eval{ $sth->execute(@_); };
+ if($@) { confess($@) }
+ my $arrayRef;
+ eval { $arrayRef = $sth->fetchall_arrayref; };
+ if($@) { confess($@) }
+ $sth->finish();
+ return map({ $_->[0] } @$arrayRef);
+ };
+}
+
+sub create_row_stub($) {
+ my ($stub) = @_;
+
+ my $sth;
+
+ proc_init {
+ $sth = $dbh->prepare($stub->{SQL});
+ if($stub->{SQL} =~ /OFFSET \?$/) {
+ my @dummy = $stub->{SQL} =~ /\?/g;
+ $sth->bind_param(scalar(@dummy), 0, SQL_INTEGER);
+ }
+ };
+
+ return sub {
+ $sth->execute(@_);
+ my @row = $sth->fetchrow_array;
+ $sth->finish();
+ return @row;
+ };
+}
+
+BEGIN {
+ %types = (
+ NULL => \&create_null_stub,
+ SCALAR => \&create_scalar_stub,
+ ARRAYREF => \&create_arrayref_stub,
+
+ ARRAY => \&create_array_stub,
+ ROW => \&create_row_stub,
+ COLUMN => \&create_column_stub,
+ INSERT => \&create_insert_stub,
+ );
+}
+
+sub export_stub($$$) {
+ my ($name, $proto, $code) = @_;
+
+ no strict 'refs';
+
+ *{$name} = eval "sub $proto { goto &\$code }";
+}
+
+sub import {
+ my (undef, $ins) = @_;
+
+ while(my ($name, $args) = each %$ins) {
+ my $stub = {
+ NAME => $name,
+ TYPE => $args->[0],
+ SQL => $args->[1],
+ };
+
+ my @params = $stub->{SQL} =~ /\?/g;
+
+ $stub->{PROTO} = '(' . ('$' x @params) . ')';
+ print "$stub->{NAME} $stub->{PROTO}\n" if DEBUG;
+
+ export_stub scalar(caller) . '::' . $stub->{NAME}, $stub->{PROTO}, $types{$stub->{TYPE}}->($stub);
+ }
+}
+
+1;
+
+=head1 SYNOPSIS
+
+ use SrSv::MySQL::Stub {
+ get_all_foo => ['ARRAYREF', "SELECT * FROM foo"],
+ is_foo_valid => ['SCALAR', "SELECT 1 FROM foo WHERE id=? AND valid=1"],
+ delete_foo => ['NULL', "DELETE FROM foo WHERE id=?"],
+
+ get_all_foo_array => ['ARRAY', "SELECT * FROM foo"],
+ get_column_foo => ['COLUMN', "SELECT col FROM foo"],
+ get_row_foo => ['ROW', "SELECT * FROM foo LIMIT 1"],
+ insert_foo > ['INSERT', "INSERT INTO foo (foo,bar) VALUES (?,?)"],
+ };
+
+=head1 DESCRIPTION
+
+This module is a convenient way to make lots of subroutines that execute
+SQL statements.
+
+=head1 USAGE
+
+ my @listOfListrefs = get_all_foo_array(...);
+ my $listrefOfListrefs = get_all_foo(...);
+ my $scalar = is_foo_valid(...);
+ my $success = delete_foo(...);
+
+type ARRAYREF is for legacy code only, I doubt anyone will want to use
+it for new code. ARRAY returns a list of listrefs, while ARRAYREF
+returns a listref of listrefs.
+
+NULL returns success or failure. Technically, number of columns
+affected. Thus sometimes it may not have FAILED, but as it had no
+effect, it will return zero.
+
+INSERT returns the last INSERT ID in the current execution context. This
+basically means that if your table has a PRIMARY KEY AUTO_INCREMENT, it
+will return the value of that primary key.
+
+COLUMN returns a list consisting of a single column (the first, if there
+are more than one in the SELECT).
+
+ROW is like column, but returns an array of only a single row.
+
+=cut
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::MySQL::Unlock;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw($unlock_tables) }
+
+use SrSv::Process::Init;
+use SrSv::MySQL '$dbh';
+
+our ($unlock_tables);
+
+proc_init {
+ $unlock_tables = $dbh->prepare("UNLOCK TABLES");
+};
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::NickControl::Enforcer;
+
+=head1 NAME
+
+SrSv::NickControl::Enforcer - Prevent users from using nicks without identifying.
+
+=head1 SYNOPSIS
+
+ use SrSv::NickControl::Enforcer qw(%enforcers);
+
+=head1 DESCRIPTION
+
+At the moment, this is just a place to put the %enforcers hash.
+
+=cut
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(%enforcers) }
+
+use SrSv::Shared qw(%enforcers);
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::NickReg::Flags;
+
+use strict;
+
+use Exporter 'import';
+
+BEGIN {
+ my %constants = (
+ # current nickreg.flags definition limits us to 16 of these. or 32768 as last flag
+ NRF_HIDEMAIL => 1,
+ NRF_NOMEMO => 2,
+ NRF_NOACC => 4,
+ NRF_NEVEROP => 8,
+ NRF_AUTH => 16,
+ NRF_HOLD => 32,
+ NRF_FREEZE => 64,
+ NRF_VACATION => 128,
+ NRF_EMAILREG => 256,
+ NRF_NOHIGHLIGHT => 512,
+ NRF_SENDPASS => 1024,
+ );
+
+ our @EXPORT = (qw(nr_set_flag nr_set_flags nr_chk_flag nr_chk_flag_user nr_get_flags), keys(%constants));
+
+ require constant; import constant (\%constants);
+}
+
+use SrSv::Process::Init;
+use SrSv::MySQL '$dbh';
+
+use SrSv::User qw(get_user_id);
+
+our ($get_flags, $set_flag, $unset_flag, $set_flags, $get_nickreg_flags_user);
+
+proc_init {
+ $get_flags = $dbh->prepare("SELECT nickreg.flags FROM nickreg, nickalias WHERE nickalias.nrid=nickreg.id AND nickalias.alias=?");
+ $set_flag = $dbh->prepare("UPDATE nickreg, nickalias SET nickreg.flags=(nickreg.flags | (?)) WHERE nickalias.nrid=nickreg.id AND nickalias.alias=?");
+ $set_flags = $dbh->prepare("UPDATE nickreg, nickalias SET nickreg.flags=? WHERE nickalias.nrid=nickreg.id AND nickalias.alias=?");
+ $unset_flag = $dbh->prepare("UPDATE nickreg, nickalias SET nickreg.flags=(nickreg.flags & ~(?)) WHERE nickalias.nrid=nickreg.id AND nickalias.alias=?");
+ $get_nickreg_flags_user = $dbh->prepare("SELECT BIT_OR(nickreg.flags) FROM user
+ JOIN nickid ON (user.id=nickid.id)
+ JOIN nickreg ON(nickid.nrid=nickreg.id)
+ WHERE user.id=? GROUP BY user.id");
+};
+
+sub nr_set_flag($$;$) {
+ my ($nick, $flag, $sign) = @_;
+ $sign = 1 unless defined($sign);
+
+ if($sign) {
+ $set_flag->execute($flag, $nick);
+ } else {
+ $unset_flag->execute($flag, $nick);
+ }
+}
+
+sub nr_set_flags($$) {
+ my ($nick, $flags) = @_;
+
+ $set_flags->execute($flags, $nick);
+}
+
+sub nr_chk_flag($$;$) {
+ my ($nick, $flag, $sign) = @_;
+ $sign = 1 unless defined($sign);
+
+ $get_flags->execute($nick);
+ my ($flags) = $get_flags->fetchrow_array;
+
+ return ($sign ? ($flags & $flag) : !($flags & $flag));
+}
+
+sub nr_chk_flag_user($$;$) {
+ my ($tuser, $flag, $sign) = @_;
+ $sign = 1 unless defined($sign);
+
+ my $flags = 0;
+ # This needs to have ns_identify, ns_logout and ns_set clear $user->{NICKFLAGS}
+ if(exists $tuser->{NICKFLAGS}) {
+ $flags = $tuser->{NICKFLAGS};
+ }
+ else {
+ $get_nickreg_flags_user->execute(get_user_id($tuser));
+ ($flags) = $get_nickreg_flags_user->fetchrow_array();
+ $get_nickreg_flags_user->finish();
+ $tuser->{NICKFLAGS} = $flags;
+ }
+
+ return ($sign ? ($flags & $flag) : !($flags & $flag));
+}
+
+sub nr_get_flags($) {
+ my ($nick) = @_;
+
+ $get_flags->execute($nick);
+ my ($flags) = $get_flags->fetchrow_array(); $get_flags->finish();
+ return $flags;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::NickReg::User;
+
+=head1 NAME
+
+SrSv::NickReg::User - Determine which users are identified to which nicks
+
+=cut
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(is_identified chk_identified get_id_nicks get_nick_user_nicks get_nick_users) }
+
+use SrSv::Process::Init;
+use SrSv::MySQL '$dbh';
+use SrSv::User qw(:flags get_user_nick get_user_id);
+use SrSv::User::Notice;
+use SrSv::NickReg::Flags;
+use SrSv::Errors;
+
+our ($is_identified, $get_id_nicks, $get_nick_users);
+
+proc_init {
+ $is_identified = $dbh->prepare("SELECT 1 FROM user, nickid, nickalias WHERE user.id=nickid.id AND user.nick=? AND nickid.nrid=nickalias.nrid AND nickalias.alias=?");
+ $get_id_nicks = $dbh->prepare("SELECT nickreg.nick FROM nickid, nickreg WHERE nickid.nrid=nickreg.id AND nickid.id=?");
+ $get_nick_users = $dbh->prepare("SELECT user.nick, user.id FROM user, nickid, nickalias WHERE user.id=nickid.id AND nickid.nrid=nickalias.nrid AND nickalias.alias=? AND user.online=1");
+};
+
+sub is_identified($$) {
+ my ($user, $rnick) = @_;
+ my $nick = get_user_nick($user);
+
+ $is_identified->execute($nick, $rnick);
+ return scalar $is_identified->fetchrow_array;
+}
+
+sub chk_identified($;$) {
+ my ($user, $nick) = @_;
+
+ $nick = get_user_nick($user) unless $nick;
+
+ nickserv::chk_registered($user, $nick) or return 0;
+
+ unless(is_identified($user, $nick)) {
+ notice($user, $err_deny);
+ return 0;
+ }
+
+ return 1;
+}
+
+sub get_id_nicks($) {
+ my ($user) = @_;
+ my $id = get_user_id($user);
+ my @nicks;
+
+ $get_id_nicks->execute($id);
+ my $ref = $get_id_nicks->fetchall_arrayref;
+
+ return map $_->[0], @$ref;
+}
+
+sub get_nick_user_nicks($) {
+ my ($nick) = @_;
+
+ $get_nick_users->execute($nick);
+ my $ref = $get_nick_users->fetchall_arrayref;
+
+ return map $_->[0], @$ref;
+}
+
+sub get_nick_users($) {
+ my ($nick) = @_;
+
+ $get_nick_users->execute($nick);
+ my $ref = $get_nick_users->fetchall_arrayref;
+
+ return map +{NICK => $_->[0], ID => $_->[1]}, @$ref;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::NickServ;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw($nsnick $nsnick_default ns_command) }
+
+our ($nsnick_default, $nsnick);
+BEGIN {
+ $nsnick_default = 'NickServ';
+ $nsnick = $nsnick_default;
+}
+
+use SrSv::AgentUI {
+ NAME => $nsnick,
+ PREFIX => '/ns',
+ ADD_COMMAND_SUB => 'ns_command',
+ DISPATCH_SUB => 'ns_dispatch',
+# FLOOD_CHECK_SUB => 'operserv::flood_check',
+};
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::OnIRC;
+
+use strict;
+
+BEGIN {
+ our @ISA = qw(Exporter);
+ our @EXPORT = qw(IRC_SERVER);
+}
+
+sub import {
+ my ($pkg, $is_server) = @_;
+
+ if($is_server) {
+ *IRC_SERVER = sub () { 1 };
+ }
+ elsif(not defined *IRC_SERVER{CODE}) {
+ *IRC_SERVER = sub () { 0 };
+ }
+
+ SrSv::OnIRC->export_to_level(1);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Process::Call;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(safe_call) }
+
+use Carp 'longmess';
+
+sub safe_call($$) {
+ my ($call, $parms) = @_;
+ my $wa = wantarray;
+ my $ret;
+
+ eval {
+ no strict 'refs';
+
+ local $SIG{__WARN__} = sub {
+ ircd::debug(" -- Warning: ".$_[0],
+ ($_[0] =~ /MySQL\/Stub/ ? split(/\n/, Carp::longmess($@)) : undef ) );
+ };
+
+ local $SIG{__DIE__} = sub {
+ ($_[0] =~ /^user/) or
+ ircd::debug(" --", "-- DIED: ".$_[0], split(/\n/, Carp::longmess($@)), " --");
+ };
+
+
+ if(not defined($wa)) {
+ &$call(@$parms);
+ }
+ elsif(not $wa) {
+ $$ret = &$call(@$parms);
+ }
+ else {
+ @$ret = &$call(@$parms);
+ }
+ };
+ return undef if $@;
+
+ if(not defined($wa)) {
+ return;
+ }
+ elsif(not $wa) {
+ return $$ret;
+ }
+ else {
+ return @$ret;
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Process::InParent;
+
+use strict;
+
+use Filter::Util::Call;
+
+use SrSv::Debug;
+use SrSv::Process::Worker qw($ima_worker);
+
+sub import {
+ my $class = shift;
+ my ($package) = caller;
+
+ my $expr = join('|', @_);
+ filter_add( sub {
+ my $status;
+
+ s/^sub ($expr)(\W|$)/sub $1\_INPARENT$2/ if ($status = filter_read()) > 0;
+ print "Filtered: $_" if DEBUG() and $1;
+
+ return $status;
+ });
+
+ my @subs = map { "$package\::$_" } @_;
+
+ foreach my $sub (@subs) {
+ no strict 'refs';
+ no warnings;
+
+ print "Installing stub for $sub\n" if DEBUG();
+ *{$sub} = _make_stub($sub);
+ }
+}
+
+sub _make_stub($) {
+ my ($fake_sub) = @_;
+ my $real_sub = \&{"$fake_sub\_INPARENT"};
+
+ return sub {
+ if($ima_worker) {
+ print "Called $fake_sub in child.\n" if DEBUG();
+ SrSv::Process::Worker::call_in_parent($fake_sub, @_);
+ } else {
+ print "Called $fake_sub in parent.\n" if DEBUG();
+ goto &$real_sub;
+ }
+ };
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Process::Init;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw(proc_init) }
+
+use SrSv::OnIRC;
+
+our @subs;
+
+sub proc_init(&) {
+ if(IRC_SERVER) {
+ push @subs, $_[0];
+ } else {
+ &{$_[0]}();
+ }
+}
+
+sub do_init {
+ foreach my $sub (@subs) {
+ &$sub;
+ }
+
+ @subs = ();
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Process::Worker;
+
+use strict;
+
+use Carp 'croak';
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(spawn ima_worker $ima_worker multi get_socket call_in_parent call_all_child do_callback_in_child shutdown_worker shutdown_all_workers kill_all_workers) }
+
+use Event;
+use IO::Socket;
+use Storable qw(fd_retrieve store_fd);
+
+use SrSv::Debug;
+BEGIN {
+ if(DEBUG) {
+ require Data::Dumper; import Data::Dumper ();
+ }
+}
+
+use SrSv::Message qw(message call_callback unit_finished);
+use SrSv::Process::Call qw(safe_call);
+use SrSv::RunLevel qw(:levels $runlevel);
+
+use SrSv::Process::InParent qw(shutdown_worker shutdown_all_workers kill_all_workers);
+
+use SrSv::Process::Init ();
+
+our $parent_sock;
+our $multi = 0;
+our @workers;
+our @free_workers;
+our @queue;
+
+our $ima_worker = 0;
+
+### Public interface ###
+
+sub spawn() {
+ $multi = 1;
+
+ my ($parent, $child) = IO::Socket->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC);
+
+ if(my $pid = fork()) {
+ my $worker = {
+ SOCKET => $child,
+ NUMBER => scalar(@workers),
+ PID => $pid,
+ };
+
+ my $nr = @workers;
+ push @workers, $worker;
+ $worker->{WATCHER} = Event->io (
+ cb => \&SrSv::Process::Worker::req_from_child,
+ fd => $child,
+ data => $nr,
+ );
+ } else {
+ loop($parent);
+ exit;
+ }
+}
+
+sub ima_worker {
+ return $ima_worker;
+}
+
+sub multi {
+ return $multi;
+}
+
+sub get_socket {
+ if(ima_worker) {
+ return $parent_sock;
+ }
+}
+
+sub call_in_parent(@) {
+ my ($f, @args) = @_;
+ if(!ima_worker) {
+ no strict 'refs';
+ return &$f(@args);
+ }
+
+ my %call = (
+ CLASS => 'CALL',
+ FUNCTION => $f,
+ ARGS => \@args
+ );
+
+ store_fd(\%call, $parent_sock);
+
+ if(wantarray) {
+ return @{ fd_retrieve($parent_sock) };
+ } else {
+ return @{ fd_retrieve($parent_sock) }[-1];
+ }
+}
+
+sub call_all_child(@) {
+ croak "call_all_child is not functional.\n";
+
+=for comment
+ my (@args) = @_;
+
+ foreach my $worker (@workers) {
+ store_fd(\@args, $worker->{SOCKET});
+ }
+=cut
+}
+
+{
+ my $callback;
+
+ sub shutdown_worker($) {
+ my $worker = shift;
+
+ print "Shutting down worker $worker->{NUMBER}\n" if DEBUG;
+ store_fd({ _SHUTDOWN => 1 }, $worker->{SOCKET});
+ $worker->{WATCHER}->cancel; undef $worker->{WATCHER};
+ $worker->{SOCKET}->close; undef $worker->{SOCKET};
+ undef($workers[$worker->{NUMBER}]);
+
+ unless(grep defined($_), @workers) {
+ print "All workers shut down.\n" if DEBUG;
+ $callback->() if $callback;
+ }
+ }
+
+ sub shutdown_all_workers($) {
+ $callback = shift;
+
+ while(my $worker = pop @free_workers) {
+ shutdown_worker($worker);
+ }
+ }
+}
+
+sub kill_all_workers() {
+ kill 9, map($_->{PID}, @workers);
+}
+
+### Semi-private Functions ###
+
+sub do_callback_in_child {
+ my ($callback, $message) = @_;
+
+ if(my $worker = pop @free_workers) {
+ print "Asking worker ".$worker->{NUMBER}." to call ".$callback->{CALL}."\n" if DEBUG;
+ #store_fd([$unit], $worker->{SOCKET});
+ $worker->{UNIT} = [$callback, $message];
+
+ store_fd($worker->{UNIT}, $worker->{SOCKET});
+ } else {
+ push @queue, [$callback, $message];
+ print "Added to queue, length is now" . @queue if DEBUG;
+ }
+}
+
+### Internal Functions ###
+
+sub req_from_child($) {
+ my $event = shift;
+ my $nr = $event->w->data;
+ my $worker = $workers[$nr];
+ my $fd = $worker->{SOCKET};
+
+ my $req = eval { fd_retrieve($fd) };
+ die "Couldn't read the request: $@" if $@;
+
+ print "Got a ".$req->{CLASS}." message from worker ".$worker->{NUMBER}."\n" if DEBUG;
+
+ if($req->{CLASS} eq 'CALL') {
+ my @reply = safe_call($req->{FUNCTION}, $req->{ARGS});
+ store_fd(\@reply, $fd);
+ }
+ elsif($req->{CLASS} eq 'FINISHED') {
+ my $unit = $worker->{UNIT};
+ $worker->{UNIT} = undef;
+
+ print "Worker ".$worker->{NUMBER}." is now finished.\n" if DEBUG;
+
+ if($runlevel == ST_SHUTDOWN) {
+ shutdown_worker($worker);
+ return;
+ }
+
+ push @free_workers, $worker;
+
+ if(@queue) {
+ print "About to dequeue, length is now " . @queue if DEBUG;
+ do_callback_in_child(@{ shift @queue });
+ }
+
+ unit_finished($unit->[0], $unit->[1]);
+ }
+ elsif($runlevel != ST_SHUTDOWN) {
+ store_fd({ACK => 1}, $fd);
+ message($req);
+ }
+}
+
+sub do_exit() {
+ print "Worker ".@workers." shutting down.\n" if DEBUG;
+ $parent_sock->close;
+ exit;
+}
+
+sub loop($) {
+ my ($parent) = @_;
+
+ $ima_worker = 1;
+ $parent_sock = $parent;
+
+ SrSv::Process::Init::do_init();
+ module::begin();
+
+ store_fd({ CLASS => 'FINISHED' }, $parent);
+
+ while(my $unit = fd_retrieve($parent)) {
+ if(ref $unit eq 'HASH' and $unit->{_SHUTDOWN}) {
+ do_exit;
+ }
+ print "Worker ".@workers." is now busy.\n" if DEBUG;
+ call_callback(@$unit);
+
+ print "Worker ".@workers." is now free.\n" if DEBUG;
+ store_fd({ CLASS => 'FINISHED' }, $parent);
+ }
+
+ die "Lost contact with the mothership";
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::RunLevel;
+
+=head1 NAME
+
+SrSv::RunLevel - Control system state.
+
+=cut
+
+use strict;
+
+use Exporter 'import';
+
+BEGIN {
+ my %constants = (
+ ST_NORMAL => 1,
+ ST_SHUTDOWN => 2,
+ );
+
+ our @EXPORT_OK = (qw($runlevel main_shutdown emerg_shutdown), keys(%constants));
+ our %EXPORT_TAGS = (levels => [keys(%constants)]);
+
+ require constant; import constant (\%constants);
+}
+
+# FIXME: Uncommenting this breaks $ircd_ready for some reason.
+#use SrSv::IRCd::IO qw(ircd_disconnect);
+use SrSv::Process::Worker qw(ima_worker shutdown_all_workers kill_all_workers call_in_parent);
+use SrSv::Timer 'stop_timer';
+
+our $runlevel = ST_NORMAL;
+
+sub main_shutdown() {
+ call_in_parent(__PACKAGE__.'::_main_shutdown');
+}
+
+sub emerg_shutdown() {
+ $runlevel = ST_SHUTDOWN;
+ stop_timer;
+ shutdown_all_workers sub { exit; };
+
+ Event->timer(after => 5, cb => sub {
+ kill_all_workers;
+
+ exit;
+ });
+}
+
+sub _main_shutdown() {
+ ircd::agent_quit_all("Shutting down.");
+
+ emerg_shutdown;
+}
+
+1;
+
+__END__
+
+=head1 SYNOPSIS
+
+ use SrSv::RunLevel;
+
+ main_shutdown;
+
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Shared;
+
+=head1 NAME
+
+SrSv::Shared - Share global variables among processes.
+
+=cut
+
+use strict;
+
+use SrSv::Debug;
+
+use SrSv::Process::Worker qw(ima_worker);
+use SrSv::Process::Init;
+
+use SrSv::Shared::Scalar;
+use SrSv::Shared::Array;
+use SrSv::Shared::Hash;
+
+our @shared_vars;
+
+sub import {
+ croak("Shared variables can only be created by the parent process")
+ if ima_worker;
+
+ my $class = shift;
+ my ($package) = caller;
+
+ for (@_) {
+ my $var = $_;
+ my $sigil = substr($var, 0, 1, '');
+ my $pkgvar = "$package\::$var";
+
+ push @shared_vars, [$sigil, $pkgvar];
+
+ # make the variable accessable in the parent.
+ no strict 'refs';
+ *$pkgvar = (
+ $sigil eq '$' ? \$$pkgvar :
+ $sigil eq '@' ? \@$pkgvar :
+ $sigil eq '%' ? \%$pkgvar :
+ croak("Only scalars, arrays, and hashes are supported")
+ );
+ }
+}
+
+proc_init {
+ return unless ima_worker;
+ no strict 'refs';
+
+ for (@shared_vars) {
+ my ($sigil, $var) = @$_;
+
+ if($sigil eq '$') {
+ tie ${$var}, 'SrSv::Shared::Scalar', $var;
+ }
+ elsif($sigil eq '@') {
+ tie @{$var}, 'SrSv::Shared::Array', $var;
+ }
+ elsif($sigil eq '%') {
+ tie %{$var}, 'SrSv::Shared::Hash', $var;
+ }
+
+ print "$sigil$var is now shared.\n" if DEBUG;
+ }
+};
+
+1;
+
+__END__
+
+=head1 SYNOPSIS
+
+ use SrSv::Shared qw($shared1 @shared2 %shared3);
+
+=head1 DESCRIPTION
+
+This module creates shared variables.
+
+=head1 CAVEATS
+
+Operations which iterate through an entire hash are not supported. This
+includes keys(), values(), each(), and assignment to list context. If you need
+to do these things, do them in the parent process. (See SrSv::Process::InParent)
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Shared::Array;
+
+=head1 NAME
+
+SrSv::Shared::Array - Used internally by SrSv::Shared.
+
+=cut
+
+use strict;
+no strict 'refs';
+
+use SrSv::Process::InParent qw(STORE FETCH FETCHSIZE STORESIZE CLEAR PUSH POP SHIFT UNSHIFT SPLICE);
+
+sub TIEARRAY {
+ my ($class, $name) = @_;
+
+ return bless \$name, $class;
+}
+
+sub STORE {
+ my ($self, $key, $value) = @_;
+
+ print "Store \@" . $$self . "\n" if SrSv::Shared::DEBUG;
+ return ${$$self}[$key] = $value;
+}
+
+sub FETCH {
+ my ($self, $key) = @_;
+
+ print "Fetch \@" . $$self . "\n" if SrSv::Shared::DEBUG;
+ return ${$$self}[$key];
+}
+
+sub FETCHSIZE {
+ my ($self) = @_;
+
+ return scalar @{$$self};
+}
+
+sub STORESIZE {
+ my ($self, $value) = @_;
+
+ return $#{$$self} = $value-1;
+}
+
+sub CLEAR {
+ my ($self) = @_;
+
+ return @{$$self} = ();
+}
+
+sub PUSH {
+ my $self = shift;
+ return push @{$$self}, @_;
+}
+
+sub POP {
+ my ($self) = @_;
+
+ return pop @{$$self};
+}
+
+sub SHIFT {
+ my ($self) = @_;
+
+ return shift @{$$self};
+}
+
+sub UNSHIFT {
+ my $self = shift;
+ return unshift(@{$$self}, @_);
+}
+
+sub SPLICE {
+ my $self = shift;
+ return splice(@{$$self}, @_);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Shared::Hash;
+
+=head1 NAME
+
+SrSv::Shared::Hash - Used internally by SrSv::Shared.
+
+=cut
+
+use strict;
+no strict 'refs';
+
+use Carp;
+
+use SrSv::Process::InParent qw(STORE FETCH DELETE CLEAR EXISTS SCALAR);
+
+sub TIEHASH {
+ my ($class, $name) = @_;
+
+ return bless \$name, $class;
+}
+
+sub STORE {
+ my ($self, $key, $value) = @_;
+
+ print "Store \%" . $$self . "\n" if SrSv::Shared::DEBUG;
+ return ${$$self}{$key} = $value;
+}
+
+sub FETCH {
+ my ($self, $key) = @_;
+
+ print "Fetch \%" . $$self . "\n" if SrSv::Shared::DEBUG;
+ return ${$$self}{$key};
+}
+
+sub DELETE {
+ my ($self, $key) = @_;
+
+ return delete(${$$self}{$key});
+}
+
+sub CLEAR {
+ my ($self) = @_;
+
+ return %{$$self} = ();
+}
+
+sub EXISTS {
+ my ($self, $key) = @_;
+
+ return exists(${$$self}{$key});
+}
+
+# TODO: Fix these.
+sub FIRSTKEY {
+ croak "key listing not implemented yet";
+}
+
+sub NEXTKEY {
+ croak "key listing not implemented yet";
+}
+
+sub SCALAR {
+ my ($self) = @_;
+
+ return scalar(%{$$self});
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Shared::Scalar;
+
+=head1 NAME
+
+SrSv::Shared::Scalar - Used internally by SrSv::Shared.
+
+=cut
+
+use strict;
+no strict 'refs';
+
+use SrSv::Process::InParent qw(STORE FETCH);
+
+sub TIESCALAR {
+ my ($class, $name) = @_;
+
+ return bless \$name, $class;
+}
+
+sub STORE {
+ my ($self, $value) = @_;
+
+ print "Store \$" . $$self . "\n" if SrSv::Shared::DEBUG;
+ return ${$$self} = $value;
+}
+
+sub FETCH {
+ my ($self) = @_;
+
+ print "Fetch \$" . $$self . "\n" if SrSv::Shared::DEBUG;
+ return ${$$self};
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::SimpleHash;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(read_hash readHash write_hash writeHash) }
+
+sub writeHash {
+ my $hash = $_[0];
+ my $file = $_[1];
+
+ my $fh;
+ open $fh, '>', $file;
+
+ my @keys = keys(%$hash); my @values = values(%$hash);
+
+ for(my $i=0; $i<@keys; $i++) {
+ if(ref($values[$i]) eq 'ARRAY') {
+ chomp $keys[$i];
+ print $fh $keys[$i], " =[ ";
+ foreach my $atom (@{$values[$i]}) {
+ print $fh $atom, ", ";
+ }
+ print $fh "\n";
+ } else {
+ chomp $keys[$i]; chomp $values[$i];
+ print $fh $keys[$i], " = ", $values[$i], "\n";
+ }
+ }
+
+ close $fh;
+}
+
+sub readHash {
+ my $file = $_[0];
+ my %hash;
+
+ my $fh;
+ open $fh, $file
+ or die "ERROR: Unable to open config file $file: $!\n";
+
+ while(my $line = <$fh>) {
+ if($line =~ /^#|^\s*$/) { }
+ elsif($line =~ /^\S+ ?=\[ /) {
+ my ($key, $value) = split(/ =\[ /, $line);
+ chomp $key; chomp $value;
+ $key =~ s/(^\s+|\s+$)//g;
+ $value =~ s/(^\s+|\s+$)//g;
+ $hash{$key} = [ split(/, /, $value) ];
+ }
+ elsif($line =~ /^\S+ ?= ?/) {
+ my ($key, $value) = split(/ = /, $line);
+ chomp $key; chomp $value;
+ if($value eq 'undef') {
+ $value = undef;
+ }
+ $key =~ s/(^\s+|\s+$)//g;
+ $value =~ s/(^\s+|\s+$)//g;
+ $hash{$key} = $value;
+ }
+ else {
+ die "Malformed config file: $file\n";
+ }
+ }
+ close $fh;
+
+ return (%hash);
+}
+
+BEGIN { # The same functions, now with less camelCase
+ *write_hash = \&writeHash;
+ *read_hash = \&readHash;
+}
+
+1;
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+=pod
+ Parses the TOR router list for exit-nodes, and optionally
+ for exit-nodes that can connect to our services.
+
+ Interface still in progress.
+=cut
+
+package SrSv::TOR;
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw( getTorRouters ); }
+
+sub openURI($) {
+ my ($URI) = @_;
+ my $fh;
+ if($URI =~ s/^file:\/\///i) {
+ open($fh, '<', $URI) or die;
+ } else {
+ # assume HTTP/FTP URI
+ open($fh, '-|', ('wget -q -O - ' . $URI)) or die;
+ }
+ return $fh;
+}
+
+sub parseTorRouterList($) {
+ my ($fh) = @_;
+ my (%currentRouter, @routerList);
+ while (my $l = <$fh>) {
+ #print "$l";
+ chomp $l;
+ if($l =~ /^r (\S)+ (?:[a-zA-Z0-9+\/]+) (?:[a-zA-Z0-9+\/]+) (?:\d{4}-\d{2}-\d{2} \d\d:\d\d:\d\d) (\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3}) (\d+) (\d+)/) {
+ #r atari i2i65Qm8DXfRpHVk6N0tcT0fxvs djULF2FbASFyIzuSpH1Zit9cYFc 2007-10-07 00:19:17 85.31.187.200 9001 9030
+ #print "( NAME => $1, IP => \"$2.$3.$4.$5\", IN_PORT => $6, DIR_PORT => $7 )\n";
+ %currentRouter = ( NAME => $1, IP => "$2.$3.$4.$5", IN_PORT => $6, DIR_PORT => $7 );
+ }
+ elsif($l =~ /^s (.*)/) {
+ #s Exit Fast Guard Stable Running V2Dir Valid
+ my $tokens = $1;
+ # uncomment the conditional if you trust the router status flags
+# if($tokens =~ /Exit/) {
+ push @routerList, $currentRouter{IP};
+# }
+ }
+ elsif($l =~ /router (\S+) (\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3}) (\d+) (\d+) (\d+)/) {
+ push @routerList, processTorRouter(%currentRouter) if scalar(%currentRouter);
+ %currentRouter = ( NAME => $1, IP => "$2.$3.$4.$5", IN_PORT => $6, DIR_PORT => $8 );
+ } elsif($l =~ /reject (\S+):(\S+)/) {
+ #print STDERR "$currentRouter{IP} reject $1:$2\n";
+ push @{$currentRouter{REJECT}}, "$1:$2";
+ } elsif($l =~ /accept (\S+):(\S+)/) {
+ #print STDERR "$currentRouter{IP} accept $1:$2\n";
+ push @{$currentRouter{ACCEPT}}, "$1:$2";
+ }
+ }
+ close $fh;
+ return @routerList;
+}
+
+sub processTorRouter(%) {
+# only used for v1, and possibly v3
+ my (%routerData) = @_;
+ my @rejectList = ( $routerData{REJECT} and scalar(@{$routerData{REJECT}}) ? @{$routerData{REJECT}} : () );
+ my @acceptList = ( $routerData{ACCEPT} and scalar(@{$routerData{ACCEPT}}) ? @{$routerData{ACCEPT}} : () );
+ return () if $routerData{IP} =~ /^(127|10|192\.168)\./;
+ if ( (scalar(@rejectList) == 1) and ($rejectList[0] eq '*:*') ) {
+ #print STDERR "$routerData{IP} is not an exit node.\n";
+ return ();
+ } else {
+ #print STDERR "$routerData{IP} is an exit node.\n";
+ return ($routerData{IP});
+ }
+}
+
+sub getTorRouters($) {
+ my ($URI) = @_;
+ return parseTorRouterList(openURI($URI));
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Text::Codes;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(strip_codes) }
+
+sub strip_codes(@) {
+ my (@in) = @_;
+ foreach my $string (@in) {
+ $string =~ s/\003[0-9]{1,2}(?:,[0-9]{1,2})?|[[:cntrl:]]//g;
+ }
+ return (wantarray ? @in : $in[0]);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Text::Format;
+
+use strict;
+
+use Encode 'encode';
+
+use constant {
+ MAX_WIDTH => 60,
+ COLORS => 1,
+ BULLET => encode('utf8', "\x{2022} "),
+};
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw( columnar enum wordwrap ) }
+
+use SrSv::Text::Codes 'strip_codes';
+
+BEGIN { if(COLORS) {
+ *line_post = sub ($$) {
+ my ($bg, $t) = @_;
+
+ $t =~ s/^(.{60}.*?)\s*$/$1 / if length $t > 60;
+ $t = "\0031,15" . $t if $bg;
+
+ return $t;
+ }
+} else {
+ *line_post = sub ($$) {
+ my ($bg, $t) = @_;
+
+ $t =~ s/ +$//;
+ $t = ' ' unless $t;
+
+ return $t;
+ }
+} }
+
+sub columnar(@) {
+ my $opts = shift if ref($_[0]) eq 'HASH';
+ my (@mlen, @out);
+
+ $opts->{DOUBLE} = 0 if $opts->{NOHIGHLIGHT};
+ my $double = $opts->{DOUBLE};
+ my $border = $opts->{BORDER};
+
+ foreach my $x (@_) {
+ next unless ref($x) eq 'ARRAY';
+
+ for(my $i; $i<@$x; $i++) {
+ my $nc = strip_codes($x->[$i]);
+ my $len = length($nc);
+ $mlen[$i] = $len if $len > $mlen[$i];
+ }
+ }
+
+ pop @mlen if $double;
+
+ my $width = 2; # 2 leading spaces
+ my $borderLine = '+';
+ foreach my $x (@mlen) {
+ my $cellWidth = ($x ? $x + 2 : 0);
+ $width += $cellWidth;
+ $borderLine .= '-'x($cellWidth+1).'+';
+ }
+ $border = $border && ($width < MAX_WIDTH);
+
+ if($double and @mlen) {
+ $mlen[-1] += MAX_WIDTH - $width;
+ $width = MAX_WIDTH;
+ }
+ else {
+ $width = MAX_WIDTH if $width > MAX_WIDTH;
+ }
+
+ my ($bg, $collapsed);
+ foreach my $x (@_) {
+ if(ref $x eq 'HASH') {
+ if(my $t = $x->{COLLAPSE}) {
+ next unless @$t;
+ push @out, $borderLine if $border;
+ push @out, ' ' unless $collapsed;
+ @$t = map BULLET . $_, @$t if($x->{BULLET});
+ push @out, @$t;
+ $collapsed = 1;
+ }
+ else { $collapsed = 0 }
+
+ if(my $t = $x->{FULLROW}) {
+ my $nc = strip_codes($t);
+ push @out, line_post $bg, ' ' . $t . ' ' x ($width - length($nc));
+ }
+
+ next;
+ }
+
+ my $str = ($border ? '| ' : ' ');
+ #my $border = '+'.'-'x($width+1).'+';
+ for(my $i; $i<@mlen; $i++) {
+ my $nc = strip_codes($x->[$i]);
+ $str .= $x->[$i] .' ' x (($mlen[$i] - length($nc) + ($mlen[$i] ? 2 : 0))). ($border ? '| ' : ' ');
+ }
+
+ push @out, $borderLine if $border;
+ push @out, line_post $bg, $str;
+
+ if($double and $x->[-1]) {
+ my $t = $x->[-1];
+ push @out, line_post $bg, " $t" . ' ' x ($width - 4 - length strip_codes $t);
+ }
+ }
+ continue {
+ $bg = !$bg unless $opts->{NOHIGHLIGHT};
+ }
+ push @out, $borderLine if $border && !$collapsed;
+
+ push @out, ' (empty list)' unless @out;
+ push @out, ' --';
+
+ if(my $t = $opts->{TITLE}) {
+ unshift @out, "\037$t" . (' ' x ($width - length strip_codes $t));
+ }
+
+ return @out;
+}
+
+# Formats a list like "foo, bar, and baz"
+sub enum($@) {
+ my ($conj, @list) = @_;
+
+ my $el;
+ $el = " $conj ".pop(@list) if(@list > 1);
+ if(@list > 1) {
+ $el = join(", ", @list) . ",$el";
+ } else {
+ $el = $list[0].$el;
+ }
+
+ return $el;
+}
+
+# Portions of wordwrap() taken from
+# Bjoern 'fuchs' Krombholz splitlong.pl
+# bjkro@gmx.de
+sub wordwrap ($$) {
+ my ($data, $maxlength) = @_;
+
+ return ($data)
+ if (length($data) <= $maxlength);
+
+ my $lstart = '...';
+ my $lend = '...';
+ my $maxlength2 = $maxlength - length($lend);
+
+ my @spltarr;
+ while (length($data) > ($maxlength2)) {
+ my $pos = rindex($data, " ", $maxlength2);
+ push @spltarr, substr($data, 0, ($pos < ($maxlength/10 + 4)) ? $maxlength2 : $pos) . $lend;
+ $data = $lstart . substr($data, ($pos < ($maxlength/10 + 4)) ? $maxlength2 : $pos + 1);
+ }
+ push @spltarr, $data;
+
+ return @spltarr;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Time;
+
+use strict;
+use integer;
+use Time::Local;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw( @months @days
+ gmtime2 tz_time gmt_date local_date
+ time_ago time_rel time_rel_long_all
+ parse_time split_time
+ get_nextday get_nextday_time get_monthdays
+ get_nexthour get_nexthour_time
+ )
+}
+
+our @months = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' );
+our @days = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' );
+
+sub _time_text($) {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(shift);
+ return $mday.'/'.$months[$mon].'/'. substr($year, -2, 2).' '.
+ sprintf("%02d:%02d", $hour, $min);
+}
+
+sub gmtime2(;$) {
+ my ($time) = @_;
+ $time = time() unless $time;
+ return _time_text($time) . ' GMT';
+}
+
+sub tz_time($;$) {
+ my ($tzoffset, $time) = @_;
+ return _time_text(($time ? $time : time()) + tz_to_offset($tzoffset));
+}
+
+sub tz_to_offset($) {
+ my ($offset) = @_;
+ # offset is a signed integer corresponding to 1/4 hr increments
+ # or 900 seconds (15 minutes)
+ return ($offset * 900);
+}
+
+sub _date_text($) {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(shift);
+ return (!wantarray ? ($year+1900).' '.$months[$mon].' '.$mday : ($year + 1900, $mon+1, $months[$mon], $mday));
+}
+
+sub gmt_date(;$) {
+ my ($time) = @_;
+ $time = time() unless $time;
+ return _date_text($time);
+}
+
+sub local_date($;$) {
+ my ($tzoffset, $time) = @_;
+ return _date_text(($time ? $time : time()) + tz_to_offset($tzoffset));
+}
+
+sub parse_time($) {
+ my ($str) = @_;
+ my $out;
+ $str =~ s/^\+//;
+ $str = lc($str);
+
+ my @vals = split(/(?<!\d)(?=\d+\w)/, $str);
+
+ foreach my $val (@vals) {
+ $val =~ /(\d+)(\w)/;
+ my ($num, $pos) = ($1, $2);
+
+ if($pos eq 'w') { $num *= (86400*7) }
+ elsif($pos eq 'd') { $num *= 86400 }
+ elsif($pos eq 'h') { $num *= 3600 }
+ elsif($pos eq 'm') { $num *= 60 }
+ elsif($pos ne 's') { return undef }
+
+ $out += $num;
+ }
+
+ return $out;
+}
+
+sub split_time($) {
+ no integer; # We might want to pass in a float value for $difference
+ my ($difference) = @_;
+ my ($weeks, $days, $hours, $minutes, $seconds);
+ $seconds = $difference % 60;
+ $difference = ($difference - $seconds) / 60;
+ $minutes = $difference % 60;
+ $difference = ($difference - $minutes) / 60;
+ $hours = $difference % 24;
+ $difference = ($difference - $hours) / 24;
+ $days = $difference % 7;
+ $weeks = ($difference - $days) / 7;
+
+ return ($weeks, $days, $hours, $minutes, $seconds);
+}
+
+sub time_ago($;$) {
+ return time_rel(time() - $_[0], $_[1]);
+}
+
+sub time_rel($;$) {
+ my ($time, $all) = @_;
+
+ if ($time >= 2419200) { # 86400 * 7 * 4
+ my ($years, $months, $weeks, $days) = __time_rel_long(time() - $time);
+ if($years or $months or $weeks or $days) {
+ my $text = '';
+ if($years) {
+ $text = "$years year".($years !=1 ? 's' : '');
+ }
+ if($months) {
+ $text .= (length($text) ? ' ' : '')."$months month".($months !=1 ? 's' : '');
+ if ($years && !$all) {
+ return $text;
+ }
+ }
+ if($weeks) {
+ $text .= (length($text) ? ' ' : '')."$weeks week".($weeks !=1 ? 's' : '');
+ if ($months && !$all) {
+ return $text;
+ }
+ }
+ if($days) {
+ $text .= (length($text) ? ' ' : '')."$days day".($days !=1 ? 's' : '');
+=cut
+ if ($weeks && !$all) {
+ return $text;
+ }
+=cut
+ }
+ return $text;
+=cut
+ return ( $years ? "$years year".($years !=1 ? 's' : '') : '' ).
+ ( $months ? ($years ? ', ' : '')."$months month".( $months!=1 ? 's' : '' ) : '').
+ ( $weeks ? (($years or $months) ? ', ' : '')."$weeks week".( $weeks!=1 ? 's' : '' ) : '').
+ ( $days ? (($months or $years or $weeks) ? ', ' : '')."$days day".($days!=1 ? 's' : '') : '' )
+ ;
+=cut
+ }
+ }
+
+ my ($weeks, $days, $hours, $minutes, $seconds) = split_time($time);
+
+ my $text;
+# if($time >= 604800) { # 86400 * 7 }
+ if($weeks) {
+ $text = "$weeks week".($weeks!=1 ? 's' : '');
+=cut
+ return "$weeks week".
+ ($weeks!=1 ? 's' : '').
+ ", $days day".
+ ($days!=1 ? 's' : '');
+=cut
+ }
+ if($days) {
+ $text .= (length($text) ? ' ' : '')."$days day".($days!=1 ? 's' : '');
+ return $text if $weeks && !$all;
+=cut
+ return "$days day".
+ ($days!=1 ? 's' : '').
+ ", $hours hour".
+ ($hours!=1 ? 's' : '');
+=cut
+ }
+ if($hours) {
+ $text .= (length($text) ? ' ' : '')."$hours hour".($hours!=1 ? 's' : '');
+ return $text if $days && !$all;
+=cut
+ return "$hours hour".
+ ($hours!=1 ? 's' : '').
+ ", $minutes minute".
+ ($minutes!=1 ? 's' : '');
+=cut
+ }
+ if($minutes) {
+ $text .= (length($text) ? ' ' : '')."$minutes minute".($minutes!=1 ? 's' : '');
+ return $text if $hours && !$all;
+=cut return "$minutes minute".
+ ($minutes!=1 ? 's' : '').
+ ", $seconds second".
+ ($seconds!=1 ? 's' : '');
+=cut
+ }
+ if($seconds) {
+ $text .= (length($text) ? ' ' : '')."$seconds second".($seconds!=1 ? 's' : '');
+=cut
+ return "$seconds second".
+ ($seconds!=1 ? 's' : '');
+=cut
+ }
+ return $text;
+}
+
+# This is for cases over 4 weeks, when we need years, months, weeks, and days
+sub __time_rel_long($;$) {
+ my ($lesser_time, $greater_time) = @_;
+ $greater_time = time() unless $greater_time;
+
+ my ($sec1, $min1, $hour1, $mday1, $month1, $year1, undef, undef, undef) = gmtime($lesser_time);
+ my ($sec2, $min2, $hour2, $mday2, $month2, $year2, undef, undef, undef) = gmtime($greater_time);
+
+ my ($result_years, $result_months, $result_weeks, $result_days,
+ $result_hours, $result_mins, $result_secs);
+ $result_secs = $sec2 - $sec1;
+ $result_mins = $min2 - $min1;
+ if($result_secs < 0) {
+ $result_secs += 60; $result_mins--;
+ }
+ $result_hours = $hour2 - $hour1;
+ if($result_mins < 0) {
+ $result_mins += 60; $result_hours--;
+ }
+ $result_days = $mday2 - $mday1;
+ if($result_hours < 0) {
+ $result_hours += 24; $result_days--;
+ }
+ $result_months = $month2 - $month1;
+ if($result_days < 0) {
+ $result_days += get_monthdays(
+ ($month2 == 0 ? 11 : $month2 - 1),
+ ($month2 == 0 ? $year2 - 1: $year2));
+ $result_months--;
+ }
+ # The following division relies on integer division, as 'use integer' is decl'd above.
+ $result_weeks = $result_days / 7;
+ $result_days = $result_days % 7;
+ $result_years = $year2 - $year1;
+ if($result_months < 0) {
+ $result_months += 12; $result_years--
+ }
+ return ($result_years, $result_months, $result_weeks, $result_days, $result_hours, $result_mins, $result_secs);
+}
+
+# Apologize about the unreadability, but the alternative is about 4 times as long
+# This is for use when we want as precise a time-difference as possible.
+sub time_rel_long_all($;$) {
+ my ($lesser_time, $greater_time) = @_;
+ $greater_time = time() unless $greater_time;
+ my ($years, $months, $weeks, $days, $hours, $minutes, $seconds) = __time_rel_long($lesser_time);
+ return ( $years ? "$years year".($years !=1 ? 's' : '') : '' ).
+ ( $months ? ($years ? ', ' : '')."$months month".( $months!=1 ? 's' : '' ) : '').
+ ( $weeks ? (($years or $months) ? ', ' : '')."$weeks week".( $weeks!=1 ? 's' : '' ) : '').
+ ( $days ? (($months or $years or $weeks) ? ', ' : '')."$days day".($days!=1 ? 's' : '') : '' ).
+ ( $hours ? (($days or $months or $years or $weeks) ? ', ' : '')."$hours hour".($hours!=1 ? 's' : '') : '' ).
+ ( $minutes ? (($hours or $days or $months or $years or $weeks) ? ', ' : '')."$minutes minute".($minutes!=1 ? 's' : '') : '' ).
+ ( $seconds ? (($minutes or $days or $months or $years or $weeks) ? ', ' : '')."$seconds second".($seconds!=1 ? 's' : '') : '' )
+ ;
+
+}
+
+sub get_nextday($$$) {
+ my ($mday, $mon, $year) = @_;
+ $year += 1900 if $year < 1582; #Gregorian calendar was somewhere around here...
+
+ my $monthdays = get_monthdays($mon, $year);
+ $mday++;
+ if($mday > $monthdays) {
+ $mday %= $monthdays;
+ $mon++;
+ }
+ if($mon >= 12) {
+ $mon %= 12;
+ $year++;
+ }
+ return ($mday, $mon, $year);
+}
+sub get_nextday_time(;$) {
+ my ($time) = @_;
+ $time = time() unless $time;
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($time);
+ return Time::Local::timegm(0,0,0,get_nextday($mday, $mon, $year));
+}
+
+sub get_nexthour($$$$) {
+ my ($hour, $mday, $mon, $year) = @_;
+# $minute++;
+# if($minute >= 60) {
+# $minute %= 60;
+# $hour++;
+# }
+ $hour++;
+ if($hour >= 24) {
+ $hour %= 24;
+ ($mday, $mon, $year) = get_nextday($mday, $mon, $year)
+ }
+ return ($hour, $mday, $mon, $year);
+}
+sub get_nexthour_time(;$) {
+ my ($time) = @_;
+ $time = time() unless $time;
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($time);
+ return Time::Local::timegm(0,0,get_nexthour($hour, $mday, $mon, $year));
+}
+
+# This function is only correct/valid for Gregorian dates.
+# Not IVLIAN dates.
+sub get_monthdays {
+# $month is 0-11 not 1-12
+ my ($month, $year) = @_;
+ sub m30($) { return 30; }
+ sub m31($) { return 31; }
+ sub mFeb($) {
+ my ($year) = @_;
+ if(($year % 100 and !($year % 4)) or !($year % 400)) {
+ return 29;
+ } else {
+ return 28;
+ }
+ }
+ # this is the common table, but note +1 below
+ # as gmtime() and friends return months from 0-11 not 1-12
+ my %months = (
+ 1 => \&m31,
+ 3 => \&m31,
+ 5 => \&m31,
+ 7 => \&m31,
+ 8 => \&m31,
+ 10 => \&m31,
+ 12 => \&m31,
+
+ 4 => \&m30,
+ 6 => \&m30,
+ 9 => \&m30,
+ 11 => \&m30,
+
+ 2 => \&mFeb,
+ );
+
+ $year += 1900 if $year < 1582; #Gregorian calendar was somewhere around here...
+ return $months{$month+1}($year);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Timer;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(add_timer begin_timer stop_timer) }
+
+use Event;
+
+use SrSv::Debug;
+use SrSv::Process::InParent qw(_add_timer stop_timer);
+use SrSv::Message qw(message add_callback);
+
+our @timers;
+our $timer_watcher;
+
+add_callback({
+ TRIGGER_COND => { CLASS => 'TIMER' },
+ CALL => 'SrSv::Timer::call',
+});
+
+if(DEBUG()) {
+ add_timer('hello', 2, __PACKAGE__, 'SrSv::Timer::test');
+ sub test { ircd::privmsg('ServServ', '#surrealchat', $_[0]) };
+}
+
+sub add_timer($$$$) {
+ my ($token, $delay, $owner, $callback) = @_;
+
+ if($callback !~ /::/) {
+ $callback = caller() . "::$callback";
+ }
+
+ _add_timer($token, $delay, $owner, $callback);
+}
+
+sub _add_timer {
+ my ($token, $delay, $owner, $callback) = @_;
+
+ push @{ $timers[$delay] }, [$token, $owner, $callback];
+}
+
+sub begin_timer {
+ $timer_watcher = Event->timer(interval => 1, cb => \&trigger);
+}
+
+sub stop_timer {
+ $timer_watcher->cancel if $timer_watcher;
+}
+
+sub trigger {
+ my $timers = shift @timers;
+
+ foreach my $timer (@$timers) {
+ message({
+ CLASS => 'TIMER',
+ TOKEN => $timer->[0],
+ OWNER => $timer->[1],
+ REALCALL => $timer->[2],
+ CALL => 'SrSv::Timer::call'
+ });
+ }
+}
+
+sub call {
+ no strict 'refs';
+ my ($message, $callback) = @_;
+
+ &{$message->{REALCALL}}($message->{TOKEN});
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Unreal::Base64;
+
+=head1 NAME
+
+SrSv::Unreal::Base64 - Implementation of the UnrealIRCd Base64 encoding
+
+=cut
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(b64toi itob64); }
+
+# ':' and '#' and '&' and '+' and '@' must never be in this table. */
+# these tables must NEVER CHANGE! >) */
+our @int6_to_base64_map = (
+ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D',
+ 'E', 'F',
+ 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',
+ 'U', 'V',
+ 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j',
+ 'k', 'l',
+ 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
+ '{', '}'
+);
+
+our @base64_to_int6_map = (
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, -1, -1, -1, -1, -1,
+ -1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1,
+ -1, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
+ 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, -1, 63, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1
+);
+
+*b64toi = \&base64_to_int;
+sub base64_to_int($) {
+ my ($base64) = @_;
+
+ my $val = 0;
+ foreach my $ch (split(//, $base64)) {
+ $val <<= 6;
+ $val += $base64_to_int6_map[ord($ch)];
+ }
+ return $val;
+}
+
+*itob64 = \&int_to_base64;
+sub int_to_base64($) {
+ my ($val) = @_;
+
+ my $base64 = '';
+ do {
+ $base64 .= $int6_to_base64_map[$val & 63];
+ } while ($val >>= 6);
+ return scalar reverse($base64);
+}
+
+1;
+
+__END__
+
+=head1 SYNOPSIS
+
+ use SrSv::Unreal::Base64;
+ $integer = b64toi($base64);
+ $base64 = itob64($integer);
+
+=head1 NOTES
+
+As far as I know, all usage of these functions will accept or return
+a 32-bit integer. The only exception is for IPv6, but NICKIP uses the
+standard table anyway.
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Unreal::Modes;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(@opmodes %opmodes $scm $ocm $acm sanitize_mlockable) }
+
+our @opmodes = ('v', 'h', 'o', 'a', 'q');
+our %opmodes = (
+ v => 1,
+ h => 2,
+ o => 4,
+ a => 8,
+ q => 16
+);
+
+# Channel modes with arguments:
+our $scm = qr/^[bevhoaqI]$/;
+
+# Channel modes with only one setting:
+our $ocm = qr/^[kfLlj]$/;
+
+# Allowed channel modes:
+our $acm = qr/^[cfijklmnprstzACGIMKLNOQRSTVu]$/;
+
+sub sanitize_mlockable($) {
+ my ($inModes, @inParms) = split(/ /, $_[0]);
+ my ($outModes, @outParms);
+
+ my $sign = '+';
+ foreach my $mode (split(//, $inModes)) {
+ if ($mode =~ /[+-]/) {
+ $sign = $mode;
+ $outModes .= $mode;
+ next;
+ }
+ my $parm = shift @inParms
+ if (($mode =~ $ocm or $mode =~ $scm) and $sign eq '+');
+
+ if ($mode =~ $scm) {
+ next;
+ } else {
+ $outModes .= $mode;
+ push @outParms, $parm if $parm;
+ }
+ }
+
+ return $outModes . ' ' . join(' ', @outParms);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Unreal::Parse;
+
+use strict;
+
+use Exporter 'import';
+# parse_sjoin shouldn't get used anywhere else, as we never produce SJOINs
+# parse_tkl however is used for loopbacks.
+BEGIN { our @EXPORT_OK = qw(parse_line parse_tkl) }
+
+# FIXME
+BEGIN { *SJB64 = \&ircd::SJB64; *CLK = \&ircd::CLK; *NICKIP = \&ircd::NICKIP; }
+
+use SrSv::Conf 'main';
+use SrSv::Conf2Consts qw( main );
+
+use SrSv::Debug;
+use SrSv::IRCd::State qw($ircline $remoteserv create_server get_server_children set_server_state get_server_state %IRCd_capabilities);
+use SrSv::IRCd::Queue qw(queue_size);
+use SrSv::IRCd::IO qw( ircsend );
+use SrSv::Unreal::Modes qw(%opmodes);
+
+# Unreal uses its own modified base64 for everything except NICKIP
+use SrSv::Unreal::Base64 qw(b64toi itob64);
+
+# Unreal uses unmodified base64 for NICKIP.
+# Consider private implementation,
+# tho MIME's is probably faster
+use MIME::Base64;
+
+use Socket;
+BEGIN {
+ if(main_conf_ipv6) {
+ require Socket6;
+ }
+}
+
+# FIXME
+use constant {
+ # Wait For
+ WF_NONE => 0,
+ WF_NICK => 1,
+ WF_CHAN => 2,
+ WF_ALL => 3,
+};
+
+use SrSv::Shared qw(@servernum);
+
+our %cmdhash;
+
+sub parse_line($) {
+ my ($in) = @_;
+ return unless $in;
+ my $cmd;
+
+ if($in =~ /^(?:@|:)(\S+) (\S+)/) {
+ $cmd = $2;
+ }
+ elsif ($in =~ /^(\S+)/) {
+ $cmd = $1;
+ }
+
+ my $sub = $cmdhash{$cmd};
+ unless (defined($sub)) {
+ print "Bailing out from $ircline:$cmd for lack of cmdhash\n" if DEBUG();
+ return undef();
+ }
+ my ($event, $src, $dst, $wf, @args) = &$sub($in);
+ unless (defined($event)) {
+ print "Bailing out from $ircline:$cmd for lack of event\n" if DEBUG;
+ return undef();
+ }
+ #return unless defined $event;
+
+ my (@recipients, @out);
+ if(defined($dst)) {
+ #$args[$dst] = lc $args[$dst];
+ @recipients = split(/\,/, $args[$dst]);
+ }
+ #if(defined($src)) { $args[$src] = lc $args[$src]; }
+
+ if(@recipients > 1) {
+ foreach my $rcpt (@recipients) {
+ $args[$dst] = $rcpt;
+ push @out, [$event, $src, $dst, $wf, [@args]];
+ }
+ } else {
+ @out = [$event, $src, $dst, $wf, [@args]];
+ }
+
+ return @out;
+}
+
+sub parse_sjoin($$$$) {
+ my ($server, $ts, $cn, $parms) = @_;
+ my (@users, @bans, @excepts, @invex, @blobs, $blobs, $chmodes, $chmodeparms);
+
+ $server = '' unless $server;
+
+ if($parms =~ /^:(.*)/) {
+ $blobs = $1;
+ } else {
+ ($chmodes, $blobs) = split(/ :/, $parms, 2);
+ ($chmodes, $chmodeparms) = split(/ /, $chmodes, 2);
+ }
+ @blobs = split(/ /, $blobs);
+
+ foreach my $x (@blobs) {
+ if($x =~ /^(\&|\"|\')(.*)$/) {
+ my $type;
+ push @bans, $2 if $1 eq '&';
+ push @excepts, $2 if $1 eq '"';
+ push @invex, $2 if $1 eq "\'";
+ } else {
+ $x =~ /^([*~@%+]*)(.*)$/;
+ my ($prefixes, $nick) = ($1, $2);
+ my @prefixes = split(//, $prefixes);
+ my $op = 0;
+ foreach my $prefix (@prefixes) {
+ $op |= $opmodes{q} if ($prefix eq '*');
+ $op |= $opmodes{a} if ($prefix eq '~');
+ $op |= $opmodes{o} if ($prefix eq '@');
+ $op |= $opmodes{h} if ($prefix eq '%');
+ $op |= $opmodes{v} if ($prefix eq '+');
+ }
+
+ push @users, { NICK => $nick, __OP => $op };
+ }
+ }
+
+ return ($server, $cn, $ts, $chmodes, $chmodeparms, \@users, \@bans, \@excepts, \@invex);
+}
+
+sub parse_tkl ($) {
+ my ($in) = @_;
+ # This function is intended to accept ALL tkl types,
+ # tho maybe not parse all of them in the first version.
+
+ # Discard first token, 'TKL'
+ my (undef, $sign, $type, $params) = split(/ /, $in, 4);
+
+ # Yes, TKL types are case sensitive!
+ # also be aware (and this applies to the net.pm generator functions too)
+ # This implementation may appear naiive, but Unreal assumes that, for a given
+ # TKL type, that all parameters are non-null.
+ # Thus, if any parameters ARE null, Unreal WILL segfault.
+ ## Update: this problem may have been fixed since Unreal 3.2.2 or so.
+ if ($type eq 'G' or $type eq 'Z' or $type eq 's' or $type eq 'Q') {
+ # format is
+ # TKL + type ident host setter expiretime settime :reason
+ # TKL - type ident host setter
+ # for Q, ident is always '*' or 'h' (Services HOLDs)
+ if ($sign eq '+') {
+ my ($ident, $host, $setter, $expire, $time, $reason) = split(/ /, $params, 6);
+
+ $reason =~ s/^\://;
+ return ($type, +1, $ident, $host, $setter, $expire, $time, $reason);
+ }
+ elsif($sign eq '-') {
+ my ($ident, $host, $setter) = split(/ /, $params, 3);
+ return ($type, -1, $ident, $host, $setter);
+ }
+ }
+ elsif($type eq 'F') {
+ # TKL + F cpnNPq b saturn!attitude@netadmin.SCnet.ops 0 1099959668 86400 Possible_mIRC_DNS_exploit :\/dns (\d+\.){3}\d
+ # TKL + F u g saturn!attitude@saturn.netadmin.SCnet.ops 0 1102273855 604800 sploogatheunbreakable:_Excessively_offensive_behavior,_ban_evasion. :.*!imleetnig@.*\.dsl\.mindspring\.com
+ # TKL - F u Z tabris!northman@tabris.netadmin.SCnet.ops 0 0 :do_not!use@mask
+ if ($sign eq '+') {
+ my ($target, $action, $setter, $expire, $time, $bantime, $reason, $mask) = split(/ /, $params, 8);
+ $mask =~ s/^\://;
+ return ($type, +1, $target, $action, $setter, $expire, $time, $bantime, $reason, $mask);
+ }
+ elsif($sign eq '-') {
+ my ($target, $action, $setter, $expire, $time, $mask) = split(/ /, $params, 6);
+ $mask =~ s/^\://;
+ return ($type, -1, $target, $action, $setter, $mask);
+ }
+ }
+}
+
+sub PING($) {
+ my ($event, $src, $dst, @args);
+ $_[0] =~ /^(?:8|PING) :(\S+)$/;
+ # ($event, $src, $dst, $args)
+ return ('PING', undef, undef, WF_NONE, $1);
+}
+
+sub EOS($) {
+ my $event;
+ $_[0] =~ /^(@|:)(\S+) (?:EOS|ES)/; # Sometimes there's extra crap on the end?
+ my $server;
+ if ($1 eq '@') {
+ $server = $servernum[b64toi($2)];
+ }
+ else {
+ $server = $2;
+ }
+ set_server_state($server, 1);
+ return undef() unless get_server_state($remoteserv);
+ if($server eq $remoteserv) { $event = 'SEOS' } else { $event = 'EOS' }
+ print "Ok. we had EOS\n";
+ return ($event, undef, undef, WF_ALL, $server);
+}
+
+sub SERVER($) {
+ #ircd::debug($_[0]) if $debug;
+ if($_[0] =~ /^(?:SERVER|\') (\S+) (\S+) :(U[0-9]+)-([A-Za-z0-9]+)-([0-9]+) (.*)$/) {
+ # SERVER test-tab.surrealchat.net 1 :U2307-FhinXeOoZEmM-200 SurrealChat
+ # cmd, servername, hopCount, U<protocol>-<buildflags>-<numeric> infoLine
+ $remoteserv = $1;
+ create_server($1);
+ $servernum[$5] = $1;
+
+ return ('SERVER', undef, undef, WF_ALL, undef, $1, $2, $6, $5, $3, $4);
+ # src, serverName, numHops, infoLine, serverNumeric, protocolVersion, buildFlags
+ }
+ elsif($_[0] =~ /^(:|@)(\S+) (?:SERVER|\') (\S+) (\d+) (\d+) :(.*)$/) {
+ # @38 SERVER test-hermes.surrealchat.net 2 100 :SurrealChat
+ # source, cmd, new server, hopCount, serverNumeric, infoLine
+ my ($numeric, $name);
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ create_server($3, $name);
+ $servernum[$5] = $3;
+
+ return ('SERVER', undef, undef, WF_ALL, $name, $3, $4, $6, $5);
+ # src, serverName, numHops, infoLine, serverNumeric
+ }
+ if($_[0] =~ /^(?:SERVER|\') (\S+) (\S+) :(.*)$/) {
+ $remoteserv = $1;
+ create_server($1);
+ return ('SERVER', undef, undef, WF_ALL, undef, $1, $2, $3);
+ # src, serverName, numHops, infoLine
+ }
+ elsif($_[0] =~ /^:(\S+) (?:SERVER|\') (\S+) (\d+) :(.*)$/) {
+ # source, new server, hop count, description
+ create_server($2, $1);
+ return ('SERVER', undef, undef, WF_ALL, $1, $2, $3, $4);
+ # src, serverName, numHops, infoLine
+ }
+}
+
+sub SQUIT($) {
+ if($_[0] =~ /^(?:SQUIT|-) (\S+) :(.*)$/) {
+ my $list = [get_server_children($1)];
+ set_server_state($1, undef());
+ return ('SQUIT', undef, undef, WF_ALL, undef, $list, $2);
+ }
+ elsif($_[0] =~ /^(:|@)(\S+) (?:SQUIT|-) (\S+) :(.*)$/) {
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ my $list = [get_server_children($3)];
+ set_server_state($3, undef());
+ return ('SQUIT', undef, undef, WF_ALL, $name, $list, $4);
+ }
+}
+
+sub NETINFO($) {
+ $_[0] =~ /^(?:NETINFO|AO) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) :(.*)$/;
+ return ('NETINFO', undef, undef, WF_NONE, $1, $2, $3, $4, $5, $6, $7, $8);
+}
+
+sub PROTOCTL($) {
+ $_[0] =~ /^PROTOCTL (.*)$/;
+ return ('PROTOCTL', undef, undef, WF_NONE, $1);
+}
+
+sub JOIN($) {
+ $_[0] =~ /^:(\S+) (?:C|JOIN) (\S+)$/;
+ return ('JOIN', undef, 1, WF_CHAN, $1, $2);
+}
+
+sub SJOIN($) {
+ if ($_[0] =~ /^(?:\~|SJOIN) (\S+) (\S+) (.*)$/) {
+ my ($ts, $cn, $payload) = ($1, $2, $3);
+ if ($ts =~ s/^!//) {
+ $ts = b64toi($ts);
+ }
+ return ('SJOIN', undef, undef, WF_CHAN, parse_sjoin($remoteserv, $ts, $cn, $payload));
+ }
+ elsif($_[0] =~ /^(@|:)(\S+) (?:\~|SJOIN) (\S+) (\S+) (.*)$/) {
+ my ($server, $ts, $cn, $payload) = ($2, $3, $4, $5);
+ if ($1 eq '@') {
+ $server = $servernum[b64toi($2)];
+ }
+ else {
+ $server = $2;
+ }
+ if ($ts =~ s/^!//) {
+ $ts = b64toi($ts);
+ }
+ return ('SJOIN', undef, undef, WF_CHAN, parse_sjoin($server, $ts, $cn, $payload));
+ }
+}
+
+sub PART($) {
+ if($_[0] =~ /^:(\S+) (?:D|PART) (\S+) :(.*)$/) {
+ return ('PART', undef, 0, WF_CHAN, $1, $2, $3);
+ }
+ elsif($_[0] =~ /^:(\S+) (?:D|PART) (\S+)$/) {
+ return ('PART', undef, 0, WF_CHAN, $1, $2, undef);
+ }
+}
+
+sub MODE($) {
+ if($_[0] =~ /^(@|:)(\S+) (?:G|MODE) (#\S+) (\S+) (.*)(?: \d+)?$/) {
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ return ('MODE', undef, 1, WF_ALL, $name, $3, $4, $5);
+ }
+ elsif($_[0] =~ /^:(\S+) (?:G|MODE) (\S+) :(\S+)$/) {
+ # We shouldn't ever get this, as UMODE2 is preferred
+ return ('UMODE', 0, 0, WF_ALL, $1, $3);
+ }
+
+}
+
+sub MESSAGE($) {
+ my ($event, @args);
+ if($_[0] =~ /^(@|:)(\S+) (?:\!|PRIVMSG) (\S+) :(.*)$/) {
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ $event = 'PRIVMSG'; @args = ($name, $3, $4);
+ }
+ elsif($_[0] =~ /^(@|:)(\S+) (?:B|NOTICE) (\S+) :(.*)$/) {
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ $event = 'NOTICE'; @args = ($name, $3, $4);
+ }
+ $args[1] =~ s/\@${main_conf{local}}.*//io;
+
+ if(queue_size > 50 and $event eq 'PRIVMSG' and $args[1] !~ /^#/ and $args[2] =~ /^\w/) {
+ ircd::notice($args[1], $args[0], "It looks like the system is busy. You don't need to do your command again, just hold on a minute...");
+ }
+
+ return ($event, 0, 1, WF_ALL, @args);
+}
+
+sub AWAY($) {
+ if($_[0] =~ /^:(\S+) (?:6|AWAY) :(.*)$/) {
+ return ('AWAY', undef, undef, WF_ALL, $1, $2);
+ }
+ elsif($_[0] =~ /^:(\S+) (?:6|AWAY) $/) {
+ return ('BACK', undef, undef, WF_ALL, $1);
+ }
+}
+
+sub NICK($) {
+ my ($event, @args);
+ if($_[0] =~ /^:(\S+) (?:NICK|\&) (\S+) :?(\S+)$/) {
+ return ('NICKCHANGE', undef, undef, WF_NICK, $1, $2, $3);
+ }
+ elsif(CLK && NICKIP && $_[0] =~ /^(?:NICK|\&) (\S+) (\d+) (\S+) (\S+) (\S+) (\S+) (\d+) (\S+) (\S+) (\S+) (\S+) :(.*)$/) {
+#NICK Guest57385 1 !14b7t0 northman tabriel.tabris.net 38 0 +iowghaAxNWzt netadmin.SCnet.ops SCnet-3B0714C4.tabris.net CgECgw== :Sponsored By Skuld
+#NICK outis 1 !14corv northman localhost 38 0 +iowghaAxNWzt tabris.netadmin.SCnet.ops SCnet-D8C01838 AAAAAAAAAAAAAAAAAAAAAQ== :Sponsored By Skuld
+ my ($nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $cloakhost, $IP, $gecos) =
+ ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12);
+ if ($ts =~ s/^!//) {
+ $ts = b64toi($ts);
+ }
+ if (SJB64 and length($server) <= 2 and $server !~ /\./) {
+ $server = $servernum[b64toi($server)];
+
+ }
+ $IP = MIME::Base64::decode($IP);
+ if(main_conf_ipv6 && length($IP) == 16) {
+ $IP = Socket6::inet_ntop(AF_INET6, $IP);
+ } elsif(length($IP) == 4) {
+ $IP = Socket::inet_ntoa($IP);
+ } else {
+ die "NICKIP is invalid or unable to be decoded: $_[0]\n";
+ }
+ return ('NICKCONN', undef, undef, WF_NICK, $nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $gecos,
+ $IP, $cloakhost
+ );
+ }
+ elsif(!CLK && NICKIP && $_[0] =~ /^(?:NICK|\&) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) :(.*)$/) {
+#NICK tab 1 1116196525 northman tabriel.tabris.net test-tab.surrealchat.net 0 +iowghaAxNWzt netadmin.SCnet.ops CgECgw== :Sponsored by Skuld
+#NICK outis 1 !14corv northman localhost 38 0 +iowghaAxNWzt tabris.netadmin.SCnet.ops AAAAAAAAAAAAAAAAAAAAAQ== :Sponsored By Skuld
+ my ($nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $IP, $gecos) =
+ ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11);
+ if ($ts =~ s/^!//) {
+ $ts = b64toi($ts);
+ }
+ if (SJB64 and length($server) <= 2 and $server !~ /\./) {
+ $server = $servernum[b64toi($server)];
+
+ }
+ return ('NICKCONN', undef, undef, WF_NICK, $nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $gecos,
+ join('.', unpack('C4', MIME::Base64::decode($IP)))
+ );
+ }
+ elsif(!CLK && !NICKIP && $_[0] =~ /^(?:NICK|\&) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) :(.*)$/) {
+#NICK tab 1 1116196525 northman tabriel.tabris.net test-tab.surrealchat.net 0 +iowghaAxNWzt netadmin.SCnet.ops :Sponsored by Skuld
+ my ($nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $gecos) =
+ ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10);
+ if ($ts =~ s/^!//) {
+ $ts = b64toi($ts);
+ }
+ if (SJB64 and length($server) <= 2 and $server !~ /\./) {
+ $server = $servernum[b64toi($server)];
+
+ }
+ return ('NICKCONN', undef, undef, WF_NICK, $nick, $hops, $ts, $ident, $host, $server, $stamp, $modes, $vhost, $gecos);
+ }
+}
+
+sub QUIT($) {
+ $_[0] =~ /^:(\S+) (?:QUIT|\,) :(.*)$/;
+ return ('QUIT', 0, undef, WF_NICK, $1, $2);
+}
+
+sub KILL($) {
+#:tabris KILL ProxyBotW :tabris.netadmin.SCnet.ops!tabris (test.)
+#:ProxyBotW!bopm@ircop.SCnet.ops QUIT :Killed (tabris (test.))
+ $_[0] =~ /^(@|:)(\S+) (?:KILL|\.) (\S+) :(\S+) \((.*)\)$/;
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ return ('KILL', 0, 1, WF_NICK, $name, $3, $4, $5);
+}
+
+sub KICK($) {
+#:tabris KICK #diagnostics SurrealBot :i know you don't like this. but it's for science!
+ $_[0] =~ /^(@|:)(\S+) (?:KICK|H) (\S+) (\S+) :(.*)$/;
+ # source, chan, target, reason
+ #$src = 0; #$dst = 2;
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ return ('KICK', 0, undef, WF_CHAN, $name, $3, $4, $5);
+}
+
+sub HOST($) {
+ if($_[0] =~ /^:(\S+) (?:CHGHOST|AL) (\S+) (\S+)$/) {
+ #:Agent CHGHOST tabris tabris.netadmin.SCnet.ops
+ return ('CHGHOST', 0, 1, WF_CHAN, $1, $2, $3);
+ #setter, target, vhost
+ }
+ elsif($_[0] =~ /^:(\S+) (?:SETHOST|AA) (\S+)$/) {
+ #:tabris SETHOST tabris.netadmin.SCnet.ops
+ return ('CHGHOST', 0, 1, WF_CHAN, $1, $1, $2);
+ }
+
+ elsif ($_[0] =~ /^:(?:\S* )?302 (\S+) :(\S+?)\*?=[+-].*?\@(.*)/) {
+ #:serebii.razorville.co.uk 302 leif :Jesture=+~Jesture00@buzz-3F604D09.sympatico.ca
+ return ('CHGHOST', 0, 1, WF_CHAN, $1, $2, $3);
+ }
+}
+
+
+sub USERIP($) {
+ $_[0] =~ /^:(?:\S* )?340 (\S+) :(\S+?)\*?=[+-].*?\@((?:\.|\d)*)/;
+ return ('USERIP', 0, 1, WF_CHAN, $1, $2, $3);
+}
+
+sub IDENT($) {
+ if($_[0] =~ /^:(\S+) (?:CHGIDENT|AL) (\S+) (\S+)$/) {
+ return ('CHGIDENT', 0, 1, WF_ALL, $1, $2, $3);
+ #setter, target, IDENT
+ }
+ elsif($_[0] =~ /^:(\S+) (?:SETIDENT|AD) (\S+)$/) {
+ return ('CHGIDENT', 0, 1, WF_ALL, $1, $1, $2);
+ #setter, target, ident
+ }
+}
+
+
+sub TOPIC($) {
+ if($_[0] =~ /^(@|:)(\S+) (?:TOPIC|\)) (\S+) (\S+) (\S+) :(.*)$/) {
+ #:tabris TOPIC #the_lounge tabris 1089336598 :Small Channel in search of Strong Founder for long term relationship, growth, and great conversation.
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ return ('TOPIC', 0, 1, WF_ALL, $name, $3, $4, $5, $6);
+ }
+ elsif($_[0] =~ /^(?:TOPIC|\)) (\S+) (\S+) (\S+) :(.*)$/) {
+ # src, channel, setter, timestamp, topic
+ return ('TOPIC', 0, 1, WF_ALL, undef, $1, $2, $3, $4);
+ }
+}
+
+sub UMODE($) {
+#:tabris | +oghaANWt
+ $_[0] =~ /^:(\S+) (?:UMODE2|\|) (\S+)$/;
+ # src, umodes
+ # a note, not all umodes are passed
+ # +s, +O, and +t are not passed. possibly others
+ # also not all umodes do we care about.
+ # umodes we need care about:
+ # oper modes: hoaACN,O oper-only modes: HSq
+ # regular modes: rxB,izV (V is only somewhat, as the ircd
+ # does the conversions from NOTICE to PRIVSMG for us).
+
+ # Yes, I'm changing the event type on this
+ # It's better called UMODE, and easily emulated
+ # on IRCds with only MODE.
+ return ('UMODE', 0, 0, WF_ALL, $1, $2);
+}
+
+sub SVSMODE($) {
+#:tabris | +oghaANWt
+ $_[0] =~ /^:(\S+) (?:SVS2?MODE|n|v) (\S+) (\S+)$/;
+ # src, umodes
+ # a note, not all umodes are passed
+ # +s, +O, and +t are not passed. possibly others
+ # also not all umodes do we care about.
+ # umodes we need care about:
+ # oper modes: hoaACN,O oper-only modes: HSq
+ # regular modes: rxB,izV (V is only somewhat, as the ircd
+ # does the conversions from NOTICE to PRIVSMG for us).
+
+ return ('UMODE', 0, 0, WF_ALL, $2, $3);
+}
+
+sub WHOIS($) {
+# :tab WHOIS ConnectServ :ConnectServ
+ if($_[0] =~ /^:(\S+) (?:WHOIS|\#) (\S+)$/) {
+ return ('WHOIS', 0, undef, WF_NONE, $1, $2);
+ }
+ elsif($_[0] =~ /^:(\S+) (?:WHOIS|\#) (\S+) :(\S+)$/) {
+ return ('WHOIS', 0, undef, WF_NONE, $1, $3);
+ }
+}
+
+sub TSCTL($) {
+ $_[0] =~ /^:(\S+) (?:TSCTL|AW) alltime$/;
+ ircsend(":$main_conf{local} NOTICE $1 *** Server=$main_conf{local} TSTime=".
+ time." time()=".time." TSOffset=0");
+ return;
+}
+
+sub VERSION($) {
+ $_[0] =~ /^:(\S+) (?:VERSION|\+).*$/;
+ return ('VERSION', 0, undef, WF_NONE, $1);
+}
+
+sub TKL($) {
+ if ($_[0] =~ /^(@|:)(\S+) (?:TKL|BD) (.*)$/) {
+ # We discard the source anyway.
+ #my $server;
+ #if ($1 eq '@') {
+ # $server = $servernum[b64toi($2)];
+ #}
+ #else {
+ # $server = $2;
+ #}
+ return ('TKL', undef, undef, WF_NONE, parse_tkl("TKL $3"));
+ }
+ elsif ($_[0] =~ /^(?:TKL|BD) (.*)$/) {
+ return ('TKL', undef, undef, WF_NONE, parse_tkl("TKL $1"));
+ }
+}
+
+sub SNOTICE($) {
+ $_[0] =~ /^(@|:)(\S+) (SENDSNO|Ss|SMO|AU) ([A-Za-z]) :(.*)$/;
+ #@servernumeric Ss snomask :message
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ my $event;
+ $event = 'SENDSNO' if(($3 eq 'SENDSNO' or $3 eq 'Ss'));
+ $event = 'SMO' if(($3 eq 'SMO' or $3 eq 'AU'));
+ return ($event, 0, undef, WF_NONE, $name, $4, $5);
+}
+
+sub GLOBOPS($) {
+ $_[0] =~ /^(@|:)(\S+) (?:GLOBOPS|\]) :(.*)$/;
+ #@servernumeric [ :message
+ my $name;
+ if ($1 eq '@') {
+ $name = $servernum[b64toi($2)];
+ }
+ else {
+ $name = $2;
+ }
+ return ('GLOBOPS', 0, undef, WF_NONE, $name, $3);
+}
+
+sub ISUPPORT($) {
+ $_[0] =~ /^:(\S+) (?:105|005) (\S+) (.+) :are supported by this server$/;
+ # :test-tab.surrealchat.net 105 services.SC.net CMDS=KNOCK,MAP,DCCALLOW,USERIP :are supported by this server
+ foreach my $token (split(/\s+/, $3)) {
+ my ($key, $value) = split('=', $token);
+ $IRCd_capabilities{$key} = ($value ? $value : 1);
+ }
+}
+
+sub STATS($) {
+ $_[0] =~ /^:(\S+) (?:STATS|2) (\S) :(.+)$/;
+ return ('STATS', undef, undef, WF_NONE, $1, $2, $3)
+}
+
+BEGIN {
+ %cmdhash = (
+ PING => \&PING,
+ '8' => \&PING,
+
+ EOS => \&EOS,
+ ES => \&EOS,
+
+ SERVER => \&SERVER,
+ "\'" => \&SERVER,
+
+ SQUIT => \&SQUIT,
+ '-' => \&SQUIT,
+
+ NETINFO => \&NETINFO,
+ AO => \&NETINFO,
+
+ PROTOCTL => \&PROTOCTL,
+
+ JOIN => \&JOIN,
+ C => \&JOIN,
+
+ PART => \&PART,
+ D => \&PART,
+
+ SJOIN => \&SJOIN,
+ '~' => \&SJOIN,
+
+ MODE => \&MODE,
+ G => \&MODE,
+
+ PRIVMSG => \&MESSAGE,
+ '!' => \&MESSAGE,
+ NOTICE => \&MESSAGE,
+ B => \&MESSAGE,
+
+ AWAY => \&AWAY,
+ '6' => \&AWAY,
+
+ NICK => \&NICK,
+ '&' => \&NICK,
+
+ QUIT => \&QUIT,
+ ',' => \&QUIT,
+
+ KILL => \&KILL,
+ '.' => \&KILL,
+
+ KICK => \&KICK,
+ H => \&KICK,
+
+ CHGHOST => \&HOST,
+ AL => \&HOST,
+ SETHOST => \&HOST,
+ AA => \&HOST,
+ '302' => \&HOST,
+
+ '340' => \&USERIP,
+
+ CHGIDENT => \&IDENT,
+ AZ => \&IDENT,
+ SETIDENT => \&IDENT,
+ AD => \&IDENT,
+
+ TOPIC => \&TOPIC,
+ ')' => \&TOPIC,
+
+ UMODE2 => \&UMODE,
+ '|' => \&UMODE,
+
+ TSCTL => \&TSCTL,
+ AW => \&TSCTL,
+
+ VERSION => \&VERSION,
+ '+' => \&VERSION,
+
+ TKL => \&TKL,
+ BD => \&TKL,
+
+ WHOIS => \&WHOIS,
+ '#' => \&WHOIS,
+
+ SENDSNO => \&SNOTICE,
+ Ss => \&SNOTICE,
+
+ SMO => \&SNOTICE,
+ AU => \&SNOTICE,
+
+ GLOBOPS => \&GLOBOPS,
+ ']' => \&GLOBOPS,
+
+ '105' => \&ISUPPORT,
+ '005' => \&ISUPPORT,
+
+ SVSMODE => \&SVSMODE,
+ 'n' => \&SVSMODE,
+ SVS2MODE => \&SVSMODE,
+ 'v' => \&SVSMODE,
+
+ STATS => \&STATS,
+ '2' => \&STATS,
+ );
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package ircd;
+
+use strict;
+
+use IO::Socket::INET;
+use Event;
+use Carp;
+use MIME::Base64;
+
+use SrSv::Conf 'main';
+
+use SrSv::Debug;
+use SrSv::Log;
+
+# FIXME
+use constant {
+ MAXBUFLEN => 510,
+
+# These appear to match the implementations I've seen, but are unspecified in the RFCs.
+# They may vary by implementation.
+ NICKLEN => 30, # some ircds are different. hyperion is 16.
+ IDENTLEN => 10, # Sometimes 8 or 9.
+ # hyperion may break this due to it's ident format: [ni]=identhere, like this n=northman
+ HOSTLEN => 63, # I think I've seen 64 here before.
+ MASKLEN => 30 + 10 + 63 + 2, # 105, or maybe 106. the 2 constant is for !@
+
+ CHANNELLEN => 32, # From 005 reply. hyperion is 30.
+
+ SJ3 => 1,
+ NOQUIT => 1,
+ NICKIP => 1,
+ SJB64 => 1,
+ CLK => 1,
+
+ PREFIXAQ_DISABLE => 0,
+};
+die "NICKIP must be enabled if CLK is\n" if CLK && !NICKIP;
+
+use SrSv::IRCd::IO qw(ircd_connect ircsend ircsendimm ircd_flush_queue);
+use SrSv::IRCd::Event qw(addhandler callfuncs);
+use SrSv::IRCd::State qw($ircline $remoteserv $ircd_ready synced initial_synced set_server_state set_server_juped get_server_state get_online_servers);
+
+use SrSv::Unreal::Modes qw(@opmodes %opmodes $scm $ocm $acm);
+use SrSv::Unreal::Tokens;
+use SrSv::Unreal::Parse qw(parse_tkl);
+use SrSv::Unreal::Base64 qw(itob64 b64toi);
+
+use SrSv::Text::Format qw( wordwrap );
+
+use SrSv::Agent;
+
+use SrSv::Process::InParent qw(update_userkill);
+
+our %defer_mode;
+our %preconnect_defer_mode;
+our @userkill;
+our $unreal_protocol_version;
+
+addhandler('SEOS', undef(), undef(), 'ircd::eos', 1);
+addhandler('NETINFO', undef(), undef(), 'ircd::netinfo', 1);
+addhandler('VERSION', undef(), undef(), 'ircd::version', 1);
+addhandler('SERVER', undef(), undef(), 'ircd::handle_server', 1);
+
+sub serv_connect() {
+ my $remote = $main_conf{remote};
+ my $port = $main_conf{port};
+
+ ircd_connect($remote, $port);
+
+ ircsendimm('PROTOCTL '.($tkn ? 'TOKEN ' : '').'NICKv2 UMODE2 TKLEXT'.
+ (CLK ? ' CLK' : ' VHP'). # CLK obsoletes VHP. Plus if you leave VHP on, CLK doesn't work.
+ (NOQUIT ? ' NOQUIT' : '').(SJ3 ? ' SJOIN SJOIN2 SJ3' : '').
+ (NICKIP ? ' NICKIP' : '').
+ (SJB64 ? ' SJB64 NS VL' : ''),
+ 'PASS :'.$main_conf{pass},
+ 'SERVER '.$main_conf{local}.' 1 '.$main_conf{numeric}.(SJB64 ? ( ':U*-*-'.$main_conf{numeric}.' ') : ' :').$main_conf{info});
+
+ %preconnect_defer_mode = %defer_mode;
+ %defer_mode = ();
+}
+
+# Helper Functions
+
+sub handle_server($$$$;$$$) {
+# This is mostly a stub function, but we may need the $unreal_protocol_version
+# at a later date. Plus we may want to maintain a server tree in another module.
+ my ($src_server, $server_name, $num_hops, $info_line, $server_numeric, $protocol_version, $build_flags) = @_;
+ $unreal_protocol_version = $protocol_version if defined $protocol_version;
+}
+
+# Handler functions
+
+sub pong($$$) {
+ my ($src, $cookie, $dst) = @_;
+ # This will only make sense if you remember that
+ # $src is where it came from, $dst is where it went (us)
+ # we're basically bouncing it back, but changing from PING to PONG.
+ if (defined($dst) and defined($cookie)) {
+ # $dst is always $main_conf{local} anyway...
+ # this is only valid b/c we never have messages routed THROUGH us
+ # we are always an end point.
+ ircsendimm(":$dst $tkn{PONG}[$tkn] $src :$cookie");
+ }
+ else {
+ ircsendimm("$tkn{PONG}[$tkn] :$src");
+ }
+}
+
+sub eos {
+ print "GOT EOS\n\n" if DEBUG;
+
+ #foreach my $k (keys %servers) {
+ # print "Server: $k ircline: ",$servers{$k}[0], " state: ", $servers{$k}[1], "\n";
+ #}
+ #print "Synced: ", synced(), "\n\n";
+ #exit;
+
+ ircsendimm(':'.$main_conf{local}.' '.$tkn{EOS}[$tkn], 'VERSION');
+
+ agent_sync();
+ flushmodes(\%preconnect_defer_mode);
+ ircd_flush_queue();
+
+ $ircd_ready = 1;
+}
+
+sub netinfo($$$$$$$$) {
+ ircsendimm($tkn{NETINFO}[$tkn].' 0 '.time." $_[2] $_[3] 0 0 0 :$_[7]");
+ $main_conf{network} = $_[7];
+}
+
+sub tssync {
+ ircsendimm((SJB64 ? '@'.itob64($main_conf{numeric}) : ':'.$main_conf{local})." $tkn{TSCTL}[$tkn] SVSTIME ".time);
+}
+
+sub parse_sjoin($$$$) {
+ my ($server, $ts, $cn, $parms) = @_;
+ my (@users, @bans, @excepts, @invex, @blobs, $blobs, $chmodes, $chmodeparms);
+
+ $server = '' unless $server;
+
+ if($parms =~ /^:(.*)/) {
+ $blobs = $1;
+ } else {
+ ($chmodes, $blobs) = split(/ :/, $parms, 2);
+ ($chmodes, $chmodeparms) = split(/ /, $chmodes, 2);
+ }
+ @blobs = split(/ /, $blobs);
+
+ foreach my $x (@blobs) {
+ if($x =~ /^(\&|\"|\')(.*)$/) {
+ my $type;
+ push @bans, $2 if $1 eq '&';
+ push @excepts, $2 if $1 eq '"';
+ push @invex, $2 if $1 eq "\'";
+ } else {
+ $x =~ /^([*~@%+]*)(.*)$/;
+ my ($prefixes, $nick) = ($1, $2);
+ my @prefixes = split(//, $prefixes);
+ my $op;
+ foreach my $prefix (@prefixes) {
+ $op |= $opmodes{q} if ($prefix eq '*');
+ $op |= $opmodes{a} if ($prefix eq '~');
+ $op |= $opmodes{o} if ($prefix eq '@');
+ $op |= $opmodes{h} if ($prefix eq '%');
+ $op |= $opmodes{v} if ($prefix eq '+');
+ }
+
+ push @users, { NICK => $nick, __OP => $op };
+ }
+ }
+
+ return ($server, $cn, $ts, $chmodes, $chmodeparms, \@users, \@bans, \@excepts, \@invex);
+}
+
+# Send Functions
+
+sub kick($$$$) {
+ my ($src, $chan, $target, $reason) = @_;
+ $src = $main_conf{local} unless initial_synced();
+ ircsend(":$src $tkn{KICK}[$tkn] $chan $target :$reason");
+# thread::ircrecv(":$src $tkn{KICK}[$tkn] $chan $target :$reason");
+ callfuncs('KICK', 0, 2, [$src, $chan, $target, $reason]);
+}
+
+sub invite($$$) {
+ my ($src, $chan, $target) = @_;
+ #:SecurityBot INVITE tabris #channel
+ ircsend(":$src $tkn{INVITE}[$tkn] $target $chan");
+}
+
+sub ping {
+# if(@_ == 1) {
+ ircsend(':'.$main_conf{local}.' '.$tkn{PING}[$tkn].' :'.$main_conf{local});
+# } else {
+# ircsend(':'.$_[2].' '.$tkn{PONG}[$tkn].' '.$_[0].' :'.$_[1]);
+# }
+}
+
+sub privmsg($$@) {
+ my ($src, $dst, @msgs) = @_;
+
+ my @bufs;
+ foreach my $buf (@msgs) {
+ # 3 spaces, two colons, PRIVMSG=7
+ # Length restrictions are for CLIENT Protocol
+ # hence the (MASKLEN - (NICKLEN + 1))
+ # Technically optimizable if we use $agent{lc $src}'s ident and host
+ my $buflen = length($src) + length($dst) + 12 + (MASKLEN - (NICKLEN + 1));
+ push @bufs, wordwrap($buf, (MAXBUFLEN - $buflen));
+ }
+
+ # submit a list of messages as a single packet to the server
+ ircsend(":$src $tkn{PRIVMSG}[$tkn] $dst :".join("\r\n".":$src $tkn{PRIVMSG}[$tkn] $dst :", @bufs));
+ callfuncs('LOOP_PRIVMSG', 0, 1, [$src, $dst, \@bufs]);
+}
+
+sub debug(@) {
+ my (@msgs) = @_;
+ debug_privmsg($main_conf{local}, $main_conf{diag}, @msgs);
+ write_log('diag', '<'.$main_conf{local}.'>', @msgs);
+}
+
+sub debug_nolog(@) {
+ my (@msgs) = @_;
+ debug_privmsg($main_conf{local}, $main_conf{diag}, @msgs);
+}
+
+sub debug_privmsg($$@) {
+ my ($src, $dst, @msgs) = @_;
+
+ my @bufs;
+ foreach my $buf (@msgs) {
+ # 3 spaces, two colons, PRIVMSG=7
+ # Length restrictions are for CLIENT Protocol
+ # hence the (MASKLEN - (NICKLEN + 1))
+ my $buflen = length($src) + length($dst) + 12 + (MASKLEN - (NICKLEN + 1));
+ push @bufs, wordwrap($buf, (MAXBUFLEN - $buflen));
+ }
+
+ # submit a list of messages as a single packet to the server
+ ircsendimm(":$src $tkn{PRIVMSG}[$tkn] $dst :".join("\r\n".":$src $tkn{PRIVMSG}[$tkn] $dst :", @bufs));
+ callfuncs('LOOP_PRIVMSG', 0, 1, [$src, $dst, \@bufs]);
+}
+
+sub notice($$@) {
+ my ($src, $dst, @msgs) = @_;
+
+ my @bufs;
+ foreach my $buf (@msgs) {
+ # 3 spaces, two colons, NOTICE=6
+ # Length restrictions are for CLIENT Protocol
+ # hence the (MASKLEN - (NICKLEN + 1))
+ my $buflen = length($src) + length($dst) + 12 + (MASKLEN - (NICKLEN + 1));
+ push @bufs, wordwrap($buf, (MAXBUFLEN - $buflen));
+ }
+
+ # submit a list of notices as a single packet to the server
+ ircsend(":$src $tkn{NOTICE}[$tkn] $dst :".join("\r\n".":$src $tkn{NOTICE}[$tkn] $dst :", @bufs));
+ callfuncs('LOOP_NOTICE', 0, 1, [$src, $dst, \@bufs]);
+}
+
+sub ctcp($$@) {
+ my ($src, $dst, $cmd, @toks) = @_;
+
+ privmsg($src, $dst, "\x01".join(' ', ($cmd, @toks))."\x01");
+}
+
+sub ctcp_reply($$@) {
+ my ($src, $dst, $cmd, @toks) = @_;
+
+ notice($src, $dst, "\x01".join(' ', ($cmd, @toks))."\x01");
+}
+
+sub setumode($$$) {
+ my ($src, $dst, $modes) = @_;
+
+ ircsend(":$src $tkn{SVS2MODE}[$tkn] $dst $modes");
+ callfuncs('UMODE', 0, undef, [$dst, $modes]);
+}
+
+sub setsvsstamp($$$) {
+ my ($src, $dst, $stamp) = @_;
+
+ ircsend(":$src $tkn{SVS2MODE}[$tkn] $dst +d $stamp");
+ # This function basically set the svsstamp to
+ # be the same as the userid. Not all ircd will
+ # support this function.
+ # We obviously already know the userid, so don't
+ # use a callback here.
+ #callfuncs('UMODE', 0, undef, [$dst, $modes]);
+}
+
+sub setagent_umode($$) {
+ my ($src, $modes) = @_;
+
+ ircsend(":$src $tkn{UMODE2}[$tkn] $modes");
+}
+
+sub setmode2($$@) {
+ my ($src, $dst, @modelist) = @_;
+ #debug(" --", "-- ircd::setmode2: ".$_[0], split(/\n/, Carp::longmess($@)), " --");
+ foreach my $modetuple (@modelist) {
+ setmode($src, $dst, $modetuple->[0], $modetuple->[1]);
+ }
+}
+sub ban_list($$$$@) {
+# Convenience function for lots of bans or excepts.
+ my ($src, $cn, $sign, $mode, @parms) = @_;
+ my @masklist;
+ foreach my $mask (@parms) {
+ push @masklist, [( ($sign >= 1) ? '+' : '-').$mode, $mask];
+ }
+ ircd::setmode2($src, $cn, @masklist);
+}
+
+sub setmode($$$;$) {
+ my ($src, $dst, $modes, $parms) = @_;
+ $src = $main_conf{local} unless initial_synced();
+
+ callfuncs('MODE', undef, 1, [$src, $dst, $modes, $parms]);
+
+ print "$ircline -- setmode($src, $dst, $modes, $parms)\n" if DEBUG;
+ my $prev = $defer_mode{"$src $dst"}[-1];
+
+ if(defined($prev)) {
+ my ($oldmodes, $oldparms) = split(/ /, $prev, 2);
+
+ # 12 modes per line
+ if((length($oldmodes.$modes) - @{[($oldmodes.$modes) =~ /[+-]/g]}) <= 12 and length($src.$dst.$parms.$oldparms) < 400) {
+ $defer_mode{"$src $dst"}[-1] = modes::merge(
+ $prev, "$modes $parms", ($dst =~ /^#/ ? 1 : 0));
+ print $defer_mode{"$src $dst"}[-1], " *** \n" if DEBUG;
+
+ return;
+ }
+ }
+
+ push @{$defer_mode{"$src $dst"}}, "$modes $parms";
+}
+
+sub flushmodes(;$) {
+ my $dm = (shift or \%defer_mode);
+ my @k = keys(%$dm); my @v = values(%$dm);
+
+ for(my $i; $i<@k; $i++) {
+ my ($src, $dst) = split(/ /, $k[$i]);
+ my @m = @{$v[$i]};
+ foreach my $m (@m) {
+ my ($modes, $parms) = split(/ /, $m, 2);
+
+ setmode_real($src, $dst, $modes, $parms);
+ }
+ }
+
+ %$dm = ();
+}
+
+sub setmode_real($$$;$) {
+ my ($src, $dst, $modes, $parms) = @_;
+
+ print "$ircline -- setmode_real($src, $dst, $modes, $parms)\n" if DEBUG;
+ # for server sources, there must be a timestamp. but you can put 0 for unspecified.
+ $parms =~ s/\s+$//; #trim any trailing whitespace, as it might break the simple parser in the ircd.
+ ircsend(":$src ".$tkn{MODE}[$tkn]." $dst $modes".($parms?" $parms":'').($src =~ /\./ ? ' 0' : ''));
+}
+
+sub settopic($$$$$) {
+ my ($src, $chan, $setter, $time, $topic) = @_;
+ $src = $main_conf{local} unless initial_synced();
+
+ ircsend(":$src ".$tkn{TOPIC}[$tkn]." $chan $setter $time :$topic");
+ callfuncs('TOPIC', undef, undef, [$src, $chan, $setter, $time, $topic]);
+}
+
+sub wallops ($$) {
+ my ($src, $message) = @_;
+ ircsend(":$src $tkn{WALLOPS}[$tkn] :$message");
+}
+
+sub globops ($$) {
+ my ($src, $message) = @_;
+ ircsend(":$src $tkn{GLOBOPS}[$tkn] :$message");
+}
+
+sub kline ($$$$$) {
+ my ($setter, $ident, $host, $expiry, $reason) = @_;
+ $setter=$main_conf{local} unless defined($setter);
+ $ident = '*' unless defined($ident);
+
+
+ #foreach my $ex (@except) { return 1 if $mask =~ /\Q$ex\E/i; }
+
+ #my $line = "GLINE $mask $time :$reason";
+ # you need to use TKL for this. GLINE is a user command
+ # TKL is a server command.
+ # format is
+ # TKL +/- type ident host setter expiretime settime :reason
+#:nascent.surrealchat.net TKL + G * *.testing.only tabris!northman@netadmin.SCnet.ops 1089168439 1089168434 :This is just a test.
+ my $line = "TKL + G $ident $host $setter ".($expiry + time()).' '.time()." :$reason";
+
+ ircsend($line);
+ callfuncs('TKL', undef, undef, [parse_tkl($line)]);
+}
+
+sub unkline ($$$) {
+ my ($setter, $ident, $host) = @_;
+ # TKL - G ident host setter
+# TKL - G ident *.test.dom tabris!northman@netadmin.SCnet.ops
+ my $line = "TKL - G $ident $host $setter";
+ ircsend($line);
+ callfuncs('TKL', undef, undef, [parse_tkl($line)]);
+}
+
+sub zline ($$$$) {
+ my ($setter, $host, $expiry, $reason) = @_;
+ $setter=$main_conf{local} unless defined($setter);
+
+ #foreach my $ex (@except) { return 1 if $mask =~ /\Q$ex\E/i; }
+
+ # format is
+ # TKL +/- type ident host setter expiretime settime :reason
+ my $line = "TKL + Z * $host $setter ".($expiry + time).' '.time." :$reason";
+ ircsend($line);
+ callfuncs('TKL', undef, undef, [parse_tkl($line)]);
+}
+
+sub unzline ($$) {
+ my ($setter, $host) = @_;
+ # TKL - G ident host setter
+# TKL - G ident *.test.dom tabris!northman@netadmin.SCnet.ops
+ my $line = "TKL - Z * $host $setter";
+ ircsend($line);
+ callfuncs('TKL', undef, undef, [parse_tkl($line)]);
+}
+
+sub spamfilter($$$$$$$) {
+# Note the hardcoded zero (0).
+# Looks like theoretically one can have expirable spamfilters.
+# This is untested however.
+ my ($sign, $tkl_target, $tkl_action, $setter, $bantime, $reason, $regex) = @_;
+ my $tkl = "TKL ".($sign ? '+' : '-' )." F $tkl_target $tkl_action $setter 0 ".time()." $bantime $reason :$regex";
+ ircsend($tkl);
+ callfuncs('TKL', undef, undef, [parse_tkl($tkl)]);
+}
+
+sub update_userkill($) {
+ my ($target) = @_;
+
+ # This is a simple way to do it, that _could_ be defeated
+ # with enough users getting killed at once.
+ # The alternative would require a timer to expire the old entries.
+ return undef if (time() == $userkill[1] and $target eq $userkill[0]);
+ @userkill = ($target, time());
+
+ return 1;
+}
+
+sub irckill($$$) {
+ my ($src, $targetlist, $reason) = @_;
+ $src = $main_conf{local} unless initial_synced();
+
+ foreach my $target (split(',', $targetlist)) {
+ next unless update_userkill($target);
+
+ ircsendimm(":$src ".$tkn{KILL}[$tkn]." $target :$src ($reason)");
+
+ callfuncs('KILL', 0, 1, [$src, $target, $src, $reason]);
+ }
+}
+
+sub svssno($$$) {
+ my ($src, $target, $snomasks) = @_;
+ $src=$main_conf{local} unless defined($src);
+ # TODO:
+ # None, this doesn't affect us.
+
+ # SVSSNO is not in tokens.txt nor msg.h
+ ircsend(":$src ".'SVS2SNO'." $target $snomasks ".time);
+}
+
+sub svsnick($$$) {
+ my ($src, $oldnick, $newnick) = @_;
+ $src=$main_conf{local} unless defined($src);
+ # note: we will get a NICK cmd back after a
+ # successful nick change.
+ # warning, if misused, this can KILL the user
+ # with a collision
+
+# ircsend(":$src ".$tkn{SVSNICK}[$tkn]." $oldnick $newnick ".time);
+ ircsend($tkn{SVSNICK}[$tkn]." $oldnick $newnick :".time);
+}
+
+sub svsnoop($$$) {
+ my ($targetserver, $bool, $src) = @_;
+ $src = $main_conf{local} unless defined($src);
+ if ($bool > 0) { $bool = '+'; } else { $bool = '-'; }
+#this is SVS NO-OP not SVS SNOOP
+ ircsend(":$main_conf{local} $tkn{SVSNOOP}[$tkn] $targetserver $bool");
+}
+
+sub svswatch ($$@) {
+# Changes the WATCH list of a user.
+# Syntax: SVSWATCH <nick> :<watch parameters>
+# Example: SVSWATCH Blah :+Blih!*@* -Bluh!*@* +Bleh!*@*.com
+# *** We do not track this info nor care.
+ my ($src, $target, @watchlist) = @_;
+ my $base_str = ":$src ".$tkn{SVSWATCH}[$tkn]." $target :";
+ my $send_str = $base_str;
+ while (@watchlist) {
+ my $watch = shift @watchlist;
+ if (length("$send_str $watch") > MAXBUFLEN) {
+ ircsend($send_str);
+ $send_str = $base_str;
+ }
+ $send_str = "$send_str $watch";
+ }
+ ircsend($send_str);
+}
+
+sub svssilence ($$@) {
+# Changes the SILENCE list of a user.
+# Syntax: SVSSILENCE <nick> :<silence parameters>
+# Example: SVSSILENCE Blah :+Blih!*@* -Bluh!*@* +Bleh!*@*.com
+# *** We do not track this info nor care.
+ my ($src, $target, @silencelist) = @_;
+ my $base_str = ":$src ".$tkn{SVSSILENCE}[$tkn]." $target :";
+ my $send_str = $base_str;
+ while (@silencelist) {
+ my $silence = shift @silencelist;
+ if (length("$send_str $silence") > MAXBUFLEN) {
+ ircsend($send_str);
+ $send_str = $base_str;
+ }
+ $send_str = "$send_str $silence";
+ }
+ ircsend($send_str);
+}
+
+sub svso($$$) {
+# Gives nick Operflags like the ones in O:lines.
+# SVSO <nick> <+operflags> (Adds the Operflags)
+# SVSO <nick> - (Removes all O:Line flags)
+# Example: SVSO SomeNick +bBkK
+# *** We do not track this info nor care.
+# *** We will see any umode changes later.
+# *** this cmd does not change any umodes!
+
+ my ($src, $target, $oflags) = @_;
+ $src = $main_conf{local} unless defined($src);
+ ircsend(":$src $tkn{SVSO}[$tkn] $target $oflags");
+
+}
+
+sub swhois($$$) {
+# *** We do not track this info nor care.
+ my ($src, $target, $swhois) = @_;
+ $src = $main_conf{local} unless defined($src);
+ ircsend(":$src $tkn{SWHOIS}[$tkn] $target :$swhois");
+}
+
+sub svsjoin($$@) {
+ my ($src, $target, @chans) = @_;
+ while(my @chanList = splice(@chans, 0, 10)) {
+ # split into no more than 10 at a time.
+ __svsjoin($src, $target, @chanList);
+ }
+}
+
+sub __svsjoin($$@) {
+ my ($src, $target, @chans) = @_;
+ # a note. a JOIN is returned back to us on success
+ # so no need to process this command.
+ # similar for svspart.
+ ircsend(($src?":$src":'')." $tkn{SVSJOIN}[$tkn] $target ".join(',', @chans));
+}
+
+sub svspart($$$@) {
+ my ($src, $target, $reason, @chans) = @_;
+ ircsend(($src ? ":$src" : '')." $tkn{SVSPART}[$tkn] $target ".join(',', @chans).
+ ($reason ? " :$reason" : ''));
+}
+
+sub sqline ($;$) {
+# we need to sqline most/all of our agents.
+# tho whether we want to put it in agent_connect
+# or leave it to the module to call it...
+ my ($nickmask, $reason) = @_;
+ #ircsend("$tkn{S1QLINE}[$tkn] $nickmask".($reason?" :$reason":''));
+ qline($nickmask, 0, $reason);
+}
+
+sub svshold($$$) {
+# Not all IRCd will support this command, as such the calling module must check the IRCd capabilities first.
+ my ($nickmask, $expiry, $reason) = @_;
+# TKL version - Allows timed qlines.
+# TKL + Q * test services.SC.net 0 1092179497 :test
+ my $line = 'TKL + Q H '.$nickmask.' '.$main_conf{local}.' '.($expiry ? $expiry+time() : 0).' '.time().' :'.$reason;
+ ircsend($line);
+
+ # at startup we send these too early,
+ # before the handlers are initialized
+ # so they may be lost.
+ callfuncs('TKL', undef, undef, [parse_tkl($line)]);
+}
+
+sub svsunhold($) {
+ my ($nickmask) = @_;
+# TKL version
+# TKL - Q * test services.SC.net
+ my $line = 'TKL - Q H '.$nickmask.' '.$main_conf{local};
+ ircsend($line);
+ callfuncs('TKL', undef, undef, [parse_tkl($line)]);
+}
+
+sub qline($$$) {
+ my ($nickmask, $expiry, $reason) = @_;
+# TKL version - Allows timed qlines.
+# TKL + Q * test services.SC.net 0 1092179497 :test
+ my $line = 'TKL + Q * '.$nickmask.' '.$main_conf{local}.' '.($expiry ? $expiry+time() : 0).' '.time().' :'.$reason;
+ ircsend($line);
+
+ # at startup we send these too early,
+ # before the handlers are initialized
+ # so they may be lost.
+ callfuncs('TKL', undef, undef, [parse_tkl($line)]);
+}
+
+sub unsqline ($) {
+# we need to sqline most/all of our agents.
+# tho whether we want to put it in agent_connect
+# or leave it to the module to call it...
+ my ($nickmask) = @_;
+ unqline($nickmask);
+}
+
+sub unqline($) {
+ my ($nickmask) = @_;
+# TKL version
+# TKL - Q * test services.SC.net
+ my $line = 'TKL - Q * '.$nickmask.' '.$main_conf{local};
+ ircsend($line);
+ callfuncs('TKL', undef, undef, [parse_tkl($line)]);
+}
+
+sub svskill($$$) {
+ my ($src, $target, $reason) = @_;
+ # SVSKILL requires a src, it will NOT work w/o one.
+ # not sure if it'll accept a servername or not.
+ # consider defaulting to ServServ
+ die('svskill called w/o $src') unless $src;
+ ircsend(':'.$src.' '.$tkn{SVSKILL}[$tkn].' '.$target.' :'.$reason);
+ callfuncs('QUIT', 0, undef, [$target, $reason]);
+}
+
+sub version($) {
+ my ($src) = @_;
+ ircsend(":$main_conf{local} 351 $src $main::progname ver $main::version $main_conf{local} ".
+ $main::extraversion);
+}
+
+sub userhost($) {
+ my ($target) = @_;
+ ircsend($tkn{USERHOST}[$tkn]." $target");
+}
+
+sub userip($) {
+ my ($target) = @_;
+ die "We're not supposed to use USERIP anymore!" if DEBUG and NICKIP;
+ ircsend(":$main::rsnick USERIP $target");
+}
+
+sub chghost($$$) {
+ my ($src, $target, $vhost) = @_;
+ ircsend(($src?":$src ":'').$tkn{CHGHOST}[$tkn]." $target $vhost");
+ callfuncs('CHGHOST', 0, 1, [$src, $target, $vhost]);
+}
+
+sub chgident($$$) {
+ my ($src, $target, $ident) = @_;
+ ircsend(($src?":$src ":'').$tkn{CHGIDENT}[$tkn]." $target $ident");
+ callfuncs('CHGIDENT', 0, 1, [$src, $target, $ident]);
+}
+
+sub jupe_server($$) {
+ my ($server, $reason) = @_;
+
+ # :nascent.surrealchat.net SERVER wyvern.surrealchat.net 2 :SurrealChat
+ die "You can't jupe $server"
+ if ((lc($server) eq lc($remoteserv)) or (lc($server) eq lc($main_conf{local})));
+ ircsend(':'.$main_conf{local}.' '.$tkn{SQUIT}[$tkn]." $server :");
+ ircsend(':'.$main_conf{local}.' '.$tkn{SERVER}[$tkn]." $server 2 :$reason");
+
+ set_server_juped($server);
+}
+
+sub rehash_all_servers(;$) {
+ my ($type) = @_;
+
+ # Validate the type before passing it along.
+ # Very IRCd specific! May be version specific.
+ $type = undef() if(defined($type) && !($type =~ /^\-(motd|botmotd|opermotd|garbage)$/i));
+
+ foreach my $server (get_online_servers()) {
+ ircsend(':'.$main::rsnick.' '.$tkn{REHASH}[$tkn].' '.$server.(defined($type) ? ' '.$type : '') );
+ }
+}
+
+sub unban_nick($$@) {
+# This is an Unreal-specific server-protocol HACK.
+# It is not expected to be portable to other ircds.
+# Similar concepts may exist in other ircd implementations
+ my ($src, $cn, @nicks) = @_;
+
+ my $i = 0; my @nicklist = ();
+ while(my $nick = shift @nicks) {
+ push @nicklist, $nick;
+ if(++$i >= 10) {
+ ircsend(($src ? ":$src " : '' ).$tkn{SVSMODE}[$tkn]." $cn -".'b'x($i).' '.join(' ', @nicklist));
+ $i = 0; @nicklist = ();
+ }
+ }
+
+ ircsend(($src ? ":$src " : '' ).$tkn{SVSMODE}[$tkn]." $cn -".'b'x($i).' '.join(' ', @nicklist));
+ # We don't loopback this, as we'll receive back the list
+ # of removed bans.
+}
+
+sub clear_bans($$) {
+# This is an Unreal-specific server-protocol HACK.
+# It is not expected to be portable to other ircds.
+# Similar concepts may exist in other ircd implementations
+ my ($src, $cn) = @_;
+
+ ircsend(($src ? ":$src " : '' ).$tkn{SVSMODE}[$tkn]." $cn -b");
+ # We don't loopback this, as we'll receive back the list
+ # of removed bans.
+}
+
+# HostServ OFF would want this.
+# resets the vhost to be the cloakhost.
+sub reset_cloakhost($$) {
+ my ($src, $target) = @_;
+ setumode($src, $target, '-x+x'); # only works in 3.2.6.
+}
+
+# removes the cloakhost, so that vhost matches realhost
+sub disable_cloakhost($$) {
+ my ($src, $target) = @_;
+ setumode($src, $target, '-x'); # only works in 3.2.6.
+}
+
+# enables the cloakhost, so that vhost becomes the cloakhost
+sub enable_cloakhost($$) {
+ my ($src, $target) = @_;
+ setumode($src, $target, '+x'); # only works in 3.2.6.
+}
+
+sub nolag($$@) {
+ my ($src, $sign, @targets) = @_;
+ $src = $main_conf{local} unless $src;
+ foreach my $target (@targets) {
+ ircsend(':'.$src .' '.$tkn{SVS2NOLAG}[$tkn].' '.$sign.' '.$target);
+ }
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Unreal::Tokens;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw($tkn %tkn) }
+
+our $tkn = 0;
+
+# TODO: Turn these into constants.
+our %tkn = (
+ PRIVMSG => ['PRIVMSG', '!'],
+ WHOIS => ['WHOIS', '#'],
+ WHOWAS => ['WHOWAS', '$'],
+ USER => ['USER', '%'],
+ NICK => ['NICK', '&'],
+ SERVER => ['SERVER', "\'"],
+ LIST => ['LIST', '('],
+ TOPIC => ['TOPIC', ')'],
+ INVITE => ['INVITE', '*'],
+ VERSION => ['VERSION', '+'],
+ QUIT => ['QUIT', ','],
+ SQUIT => ['SQUIT', '-'],
+ KILL => ['KILL', '.'],
+ INFO => ['INFO', '/'],
+ LINKS => ['LINKS', '0'],
+ STATS => ['STATS', '2'],
+ USERS => ['USERS', '3'],
+ ERROR => ['ERROR', '5'],
+ AWAY => ['AWAY', '6'],
+ CONNECT => ['CONNECT', '7'],
+ PING => ['PING', '8'],
+ PONG => ['PONG', '9'],
+ OPER => ['OPER', ';'],
+ PASS => ['PASS', '<'],
+ WALLOPS => ['WALLOPS', '='],
+ GLOBOPS => ['GLOBOPS', ']'],
+ TIME => ['TIME', '>'],
+ NAMES => ['NAMES', '?'],
+ SJOIN => ['SJOIN', '~'],
+ NOTICE => ['NOTICE', 'B'],
+ JOIN => ['JOIN', 'C'],
+ PART => ['PART', 'D'],
+ MODE => ['MODE', 'G'],
+ KICK => ['KICK', 'H'],
+ USERHOST => ['USERHOST', 'J'],
+ SQLINE => ['SQLINE', 'c'],
+ UNSQLINE => ['UNSQLINE', 'd'],
+ SVSNICK => ['SVSNICK', 'e'],
+ SVSNOOP => ['SVSNOOP', 'f'],
+ SVSKILL => ['SVSKILL', 'h'],
+ SVSMODE => ['SVSMODE', 'n'],
+ SVS2MODE => ['SVS2MODE', 'v'],
+ CHGHOST => ['CHGHOST', 'AL'],
+ CHGIDENT => ['CHGIDENT', 'AZ'],
+ NETINFO => ['NETINFO', 'AO'],
+ TSCTL => ['TSCTL', 'AW'],
+ SWHOIS => ['SWHOIS', 'BA'],
+ SVSO => ['SVSO', 'BB'],
+ # One may note... that although there is a TKL Token
+ # it does not appear to always be used.
+ # Maybe b/c 2 vs 3 chars, nobody cares.
+ TKL => ['TKL', 'BD'],
+ SHUN => ['SHUN', 'BL'],
+ SVSJOIN => ['SVSJOIN', 'BX'],
+ SVSPART => ['SVSPART', 'BT'],
+ SVSSILENCE => ['SVSSILENCE','Bs'],
+ SVSWATCH => ['SVSWATCH', 'Bw'],
+ SVSSNO => ['SVSSNO', 'BV'],
+ SENDSNO => ['SENDSNO', 'Ss'],
+
+ EOS => ['EOS', 'ES'],
+ UMODE2 => ['UMODE2', "\|"],
+
+ REHASH => ['REHASH', 'O'],
+
+ SVSNOLAG => ['SVSNOLAG', 'sl'],
+ SVS2NOLAG => ['SVS2NOLAG', 'SL'],
+);
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Unreal::Validate;
+
+use SrSv::HostMask qw( normalize_hostmask );
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT_OK = qw(valid_server valid_nick validate_chmodej validate_chmodef validate_chmodes validate_ban); }
+
+our $valid_nick_re = qr/^[][a-zA-Z`\\\|{}_^][][a-zA-Z0-9`\\\|{}_^-]*$/;
+
+our $s_chars = qr/[a-zA-Z0-9_.-]/;
+our $valid_server_re = qr/^[a-zA-Z]$s_chars*\.$s_chars*$/;
+
+sub valid_server($) {
+ return $_[0] =~ $valid_server_re;
+}
+
+sub valid_nick($) {
+ return $_[0] =~ $valid_nick_re;
+}
+
+sub validate_chmodej($) {
+ my ($joins, $seconds) = split(/:/, @_);
+ return 1 unless (defined $joins and ($joins <= 255 and $joins >=1));
+ return 1 unless (defined $seconds and ($seconds <= 999 and $seconds >=1));
+ return 0;
+}
+
+my %chmodef_types = (
+ c => [{'m' => 1, 'M' => 1}, 0, 60],
+ j => [{'R' => 1}, 0, 60],
+ k => [{'K' => 1}, 0, 60],
+ m => [{'M' => 1}, 0, 60],
+ n => [{'N' => 1}, 0, 60],
+ t => [{'b' => 1}, -1],
+);
+
+sub validate_chmodef($) {
+ my ($block, $seconds) = split(/:/, $_[0]);
+ # [4j#i5,3k#K7,15m#M10,5n#N5,6t#b]:5
+
+ return 0 unless (defined($seconds) and ($seconds <= 999 and $seconds > 0));
+
+ $block =~ s/(\[|\])//g;
+
+ foreach my $tuple (split(',', $block)) {
+ my ($limit, $action) = split('#', $tuple);
+ my ($type, $time);
+ {
+ $limit =~ /([0-9]{1,3})([a-z])$/;
+ ($time, $type) = ($1, $2);
+ }
+ return 0 unless defined($chmodef_types{$type});
+
+ my $restrictions = $chmodef_types{$type};
+ if($restrictions == -1) {
+ return 0 if defined($action);
+ } else {
+ my ($alt, $time) = split(//, $action, 2);
+ return 0 if (defined($action) and $restrictions->[0]->{$a});
+ }
+ }
+ return 1;
+}
+
+sub validate_chmodes($@) {
+ my ($modes_in, @parms_in) = @_;
+ my ($modes_out, @parms_out);
+ my $sign = '+';
+ foreach my $mode (split(//, $modes_in)) {
+ my $parm;
+ if ($mode =~ /^[+-]$/) {
+ $sign = $mode;
+ }
+ elsif ($mode =~ /^[qaohv]$/) {
+ $parm = shift @parms_in;
+ unless(valid_nick($parm)) {
+ next;
+ }
+ }
+ else {
+ $parm = shift @parms_in if $mode =~ /^[beIkflLj]$/;
+ ($mode, $parm) = validate_chmode($mode, $sign, $parm);
+ }
+ push @parms_out, $parm if $parm;
+ $modes_out .= $mode;
+ }
+ return ($modes_out, @parms_out);
+}
+
+sub validate_extban($) {
+# Unreal 3.3 will have chained extbans.
+ my ($parm) = @_;
+ my ($type, $payload) = split(':', $parm, 2);
+ $type =~ s/^\~//;
+ if(lc $type eq 'q' or lc $type eq 'n') {
+ return 1 if($payload =~ /^(.+)!(.+)@(.+)$/);
+ } elsif(lc $type eq 'c') {
+ return 1 if($payload =~ /^[~&@%+]?#.{0,29}$/);
+ } elsif(lc $type eq 'r') {
+ return 1; # how can this be invalid anyway?
+ } elsif(uc $type eq 'T') {
+ my ($action, $mask) = split(':', $payload);
+ return 1 if ($action =~ /^(block|censor)$/i);
+ }
+}
+
+sub validate_ban($) {
+ my ($parm) = @_;
+ if($parm =~ /^(.+)!(.+)@(.+)$/) {
+ # nothing obviously wrong
+ return $parm;
+ }
+ elsif($parm =~ /^\~[qncrT]:/i) {
+ # nothing obviously wrong
+ # or at least, we know nothing about it.
+ return $parm if validate_extban($parm);
+ } else {
+ # hopefully this will sufficiently sanitize it for the ircd.
+ # if this is wrong, it may cause desyncs in the ban list.
+ # thankfully most of those should be invalid bans and won't match on anything.
+ return normalize_hostmask($parm);
+ }
+ return undef;
+}
+
+sub validate_chmode($$;$) {
+ my ($mode, $sign, $parm) = @_;
+ use Switch;
+ switch($mode) {
+ #CHANMODES=beI,kfL,lj,psmntirRcOAQKVCuzNSMTG
+ case /^[beI]$/ {
+ $parm = validate_ban($parm);
+ return ($mode, $parm) if $parm;
+ }
+ case 'f' {
+ return ($mode, $parm) if $sign eq '-' or validate_chmodef($parm);
+ }
+ case 'k' {
+ $parm = '*' if $sign eq '-' and !defined($parm);
+ return ($mode, $parm)
+ }
+ case 'l' {
+ $parm = '1' if $sign eq '-' and !defined($parm);
+ return ($mode, $parm) if $parm =~ /^\d+$/;
+ }
+ case 'L' {
+ $parm = '*' if $sign eq '-' and !defined($parm);
+ return ($mode, $parm) if $parm =~ /^#/;
+ }
+ case 'j' {
+ return ($mode, $parm) if validate_chmodej($parm);
+ }
+ case /^[psmntirRcOAQKVCuzNSMTG]$/ { return ($mode, undef); }
+ else { return undef; }
+ }
+}
+
+1;
--- /dev/null
+package SrSv::Upgrade::HashPass;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw(hash_all_passwords) }
+
+use SrSv::Hash::SaltedHash;
+use SrSv::Hash::Passwords qw( hash_pass validate_pass is_hashed );
+use SrSv::MySQL '$dbh';
+use SrSv::Process::Init;
+use SrSv::Conf 'main';
+
+my ($get_nicks, $replace_pass);
+
+proc_init {
+ $get_nicks = $dbh->prepare("SELECT nick, id, pass FROM nickreg ORDER BY id");
+ $replace_pass = $dbh->prepare("UPDATE nickreg SET pass=? WHERE id=?");
+};
+
+sub hash_all_passwords() {
+ return unless $main_conf{'hashed-passwords'};
+
+ print "Updating passwords...\n";
+
+ $dbh->do("LOCK TABLES nickreg WRITE");
+
+ $get_nicks->execute();
+ while (my ($nick, $nrid, $pass) = $get_nicks->fetchrow_array() ) {
+ next if is_hashed($pass);
+
+ my $hashedPass = hash_pass($pass);
+
+ #print STDOUT "$nick, $nrid, $pass, $hashedPass\n";
+ #print STDOUT (validate_pass($hashedPass, $pass) ? "hash is valid" : "hash is not valid" )."\n";
+ #print STDOUT " ----------------- \n";
+ validate_pass($hashedPass, $pass) or die "Internal error while converting password ($pass, $hashedPass)";
+
+ $replace_pass->execute($hashedPass, $nrid);
+ }
+
+ $dbh->do("UNLOCK TABLES");
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::User;
+
+=head1 NAME
+
+SrSv::User - Track users
+
+=head1 SYNOPSIS
+
+ use SrSv::User qw(get_user_id get_user_nick get_user_agent is_online chk_online get_user_flags set_user_flag chk_user_flag);
+
+=cut
+
+use strict;
+
+use Exporter 'import';
+BEGIN {
+ my %constants = (
+ UF_FINISHED => 1,
+ UF_ONLINE => 2, # not used yet
+ );
+
+ our @EXPORT_OK = (qw(get_user_id get_user_nick get_user_agent is_online chk_online
+ $get_user_id $get_user_nick
+ get_user_ip
+ get_user_flags set_user_flag chk_user_flag set_user_flag_all
+ get_host get_vhost get_cloakhost get_user_info
+ ),
+ keys(%constants));
+
+ our %EXPORT_TAGS = (flags => [keys(%constants)]);
+
+ require constant; import constant (\%constants);
+}
+
+use SrSv::MySQL::Stub {
+ __getIPV4 => ['SCALAR', "SELECT INET_NTOA(ip) FROM user WHERE id=?"],
+};
+
+
+
+use SrSv::Process::Init;
+use SrSv::MySQL '$dbh';
+use SrSv::NickControl::Enforcer qw(%enforcers);
+use SrSv::IRCd::State qw(synced);
+use SrSv::Agent qw(is_agent);
+use SrSv::User::Notice;
+
+use SrSv::Log;
+
+our (
+ $get_user_id, $get_user_nick, $get_nickchg, $is_online,
+
+ $get_user_flags, $set_user_flag, $unset_user_flag, $set_user_flag_all,
+
+ $get_host, $get_vhost, $get_cloakhost, $get_ip, $get_user_info,
+);
+
+proc_init {
+ $get_user_id = $dbh->prepare("SELECT id FROM user WHERE nick=?");
+ $get_user_nick = $dbh->prepare("SELECT nick FROM user WHERE id=?");
+ $get_nickchg = $dbh->prepare("SELECT nickchg.nickid, user.nick FROM nickchg, user WHERE user.id=nickchg.nickid AND nickchg.nick=?");
+ $is_online = $dbh->prepare("SELECT 1 FROM user WHERE nick=? AND online=1");
+
+ $get_user_flags = $dbh->prepare("SELECT flags FROM user WHERE id=?");
+ $set_user_flag = $dbh->prepare("UPDATE user SET flags=(flags | (?)) WHERE id=?");
+ $unset_user_flag = $dbh->prepare("UPDATE user SET flags=(flags & ~(?)) WHERE id=?");
+ $set_user_flag_all = $dbh->prepare("UPDATE user SET flags=flags | ?");
+
+ $get_host = $dbh->prepare("SELECT ident, host FROM user WHERE id=?");
+ $get_vhost = $dbh->prepare("SELECT ident, vhost FROM user WHERE id=?");
+ $get_cloakhost = $dbh->prepare("SELECT 1, cloakhost FROM user WHERE id=?");
+ $get_user_info = $dbh->prepare("SELECT ident, host, vhost, gecos, server FROM user WHERE id=?");
+};
+
+sub get_user_id($) {
+ my ($user) = @_;
+ my ($id, $n);
+
+ return undef if(is_agent($user->{NICK}) and not $enforcers{lc $user->{NICK}});
+
+ unless(ref($user) eq 'HASH') {
+ die("invalid get_user_nick call");
+ }
+
+ if(exists($user->{ID})) { return $user->{ID}; }
+
+ my $nick = $user->{NICK};
+
+ # a cheat for isServer()
+ if($user->{NICK} =~ /\./) {
+ return $user->{ID} = undef;
+ }
+
+ if($nick eq '') {
+ die("get_user_id called on empty string");
+ }
+
+ my $nick2;
+ while($n < 10 and !defined($id)) {
+ $n++;
+ $get_user_id->execute($nick);
+ ($id) = $get_user_id->fetchrow_array;
+ unless($id) {
+ $get_nickchg->execute($nick);
+ ($id, $nick2) = $get_nickchg->fetchrow_array;
+ }
+ }
+
+ #unless($id) { log::wlog(__PACKAGE__, log::DEBUG(), "get_user_id($nick) failed."); }
+
+ if(defined($nick2) and lc $nick2 ne lc $user->{NICK}) {
+ $user->{OLDNICK} = $user->{NICK};
+ $user->{NICK} = $nick2;
+ }
+
+ return $user->{ID} = $id;
+}
+
+sub get_user_nick($) {
+ my ($user) = @_;
+
+ unless(ref($user) eq 'HASH') {
+ die("invalid get_user_nick call");
+ }
+
+ if(exists($user->{NICK}) and is_online($user->{NICK})) { return $user->{NICK} }
+
+ # Possible bug? This next bit only works to chase the nick-change
+ # if the caller already did a get_user_id to find out
+ # if the user exists in the user table, and thus get $user->{ID}
+ # I don't know if calling get_user_id here is safe or not.
+ my $nick;
+ if($user->{ID}) {
+ $get_user_nick->execute($user->{ID});
+ ($nick) = $get_user_nick->fetchrow_array;
+ }
+
+ # avoid returning an undef/NULL here. That's only legal for get_user_id
+ # If the user does not exist, we must avoid modifying the input
+ # so that it may be used for the error paths.
+ return (defined $nick ? $user->{NICK} = $nick : $user->{NICK});
+}
+
+sub get_user_agent($) {
+ my ($user) = @_;
+
+=cut
+ eval { $user->{AGENT} };
+ if($@) {
+ die("invalid get_user_agent call");
+ }
+=cut
+ die "invalid get_user_agent call" unless ref($user) eq 'HASH';
+
+ if(exists($user->{AGENT})) {
+ return $user->{AGENT}
+ }
+ else {
+ return undef;
+ }
+}
+
+sub is_online($) {
+ my ($user) = @_;
+ my $nick;
+
+ if(ref($user)) {
+ if(exists($user->{ONLINE})) { return $user->{ONLINE}; }
+ $nick = get_user_nick($user);
+ } else {
+ $nick = $user;
+ }
+
+ $is_online->execute($nick);
+ my ($status) = $is_online->fetchrow_array;
+ $is_online->finish();
+ if(ref($user)) {
+ $user->{ONLINE} = ($status ? 1 : 0);
+ }
+
+ return $status;
+}
+
+sub chk_online($$) {
+ my ($user, $target) = @_;
+
+ unless(is_online($target)) {
+ if(ref($target)) {
+ $target = get_user_nick($target);
+ }
+
+ notice($user, "\002$target\002: No such user.");
+ return 0;
+ }
+
+ return 1;
+}
+
+sub set_user_flag($$;$) {
+ my ($user, $flag, $sign) = @_;
+ my $uid = get_user_id($user);
+ $sign = 1 unless defined($sign);
+
+ if($sign) {
+ $user->{FLAGS} = ( ( defined $user->{FLAGS} ? $user->{FLAGS} : 0 ) | $flag );
+ $set_user_flag->execute($flag, $uid);
+ } else {
+ $user->{FLAGS} = ( ( defined $user->{FLAGS} ? $user->{FLAGS} : 0 ) & ~($flag) );
+ $unset_user_flag->execute($flag, $uid);
+ }
+}
+
+sub chk_user_flag($$;$) {
+ my ($user, $flag, $sign) = @_;
+ my $flags = get_user_flags($user);
+ $sign = 1 unless defined($sign);
+
+ return ($sign ? ($flags & $flag) : !($flags & $flag));
+}
+
+sub get_user_flags($) {
+ my ($user) = @_;
+ my $uid = get_user_id($user);
+
+ my $flags;
+ unless (exists($user->{FLAGS})) {
+ $get_user_flags->execute($uid);
+ ($flags) = $get_user_flags->fetchrow_array;
+ $get_user_flags->finish();
+ } else {
+ $flags = $user->{FLAGS};
+ }
+
+ return $user->{FLAGS} = $flags;
+}
+
+sub set_user_flag_all($) {
+ my ($flags) = @_;
+
+ $set_user_flag_all->execute($flags);
+ $set_user_flag_all->finish();
+}
+
+sub get_host($) {
+ my ($user) = @_;
+
+ my $id;
+ if(ref($user)) {
+ $id = get_user_id($user);
+ } else {
+ $id = get_user_id({ NICK => $user });
+ }
+ return undef unless $id;
+
+ $get_host->execute($id);
+ my ($ident, $host) = $get_host->fetchrow_array;
+
+ return ($ident, $host);
+}
+
+sub get_cloakhost($) {
+ my ($user) = @_;
+
+ my $id;
+ if(ref($user)) {
+ $id = get_user_id($user);
+ } else {
+ $id = get_user_id({ NICK => $user });
+ }
+ return undef unless $id;
+
+ $get_cloakhost->execute($id);
+ my ($valid, $cloakhost) = $get_cloakhost->fetchrow_array;
+ $get_cloakhost->finish;
+
+ # Beware, $cloakhost may be NULL while the user entry exists
+ # if $cloakhost == undef, check $valid before assuming no such user.
+ return ($valid, $cloakhost);
+}
+
+sub get_vhost($) {
+ my ($user) = @_;
+
+ my $id;
+ if(ref($user)) {
+ $id = get_user_id($user);
+ } else {
+ $id = get_user_id({ NICK => $user });
+ }
+ return undef unless $id;
+
+ $get_vhost->execute($id);
+ my ($ident, $vhost) = $get_vhost->fetchrow_array;
+
+ return ($ident, $vhost);
+}
+
+sub get_user_info($) {
+ my ($user) = @_;
+
+ my $uid = get_user_id($user);
+ return undef() unless $uid;
+
+ $get_user_info->execute($uid);
+ my ($ident, $host, $vhost, $gecos, $server) = $get_user_info->fetchrow_array();
+ $get_user_info->finish;
+
+ return ($ident, $host, $vhost, $gecos, $server);
+}
+
+sub get_user_ipv4($) {
+ my ($user) = @_;
+
+ my $id;
+ if(ref($user)) {
+ if(exists $user->{IP}) {
+ return $user->{IP};
+ }
+ $id = get_user_id($user);
+ } else {
+ $id = get_user_id({ NICK => $user });
+ }
+ return undef unless $id;
+
+ my $ip = getIPV4($id);
+ if(ref($user)) {
+ return $user->{IP} = $ip;
+ } else {
+ return $ip;
+ }
+}
+
+sub get_user_ip($) {
+ return get_user_ipv4(@_);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::User::Notice;
+
+use strict;
+
+use Exporter 'import';
+BEGIN { our @EXPORT = qw(notice user_die) }
+
+use SrSv::User qw(get_user_nick);
+
+sub notice($@) {
+ my $user = shift;
+
+ # FIXME: ref to 'NickServ' should call for the agent-nick in nickserv.pm,
+ # but that's not available at this layer, so we'd be making
+ # a blind reference to something that _might_ be undef
+ ircd::notice($user->{AGENT} || 'NickServ', get_user_nick($user), @_);
+}
+
+sub user_die($@) {
+ ¬ice;
+
+ die 'user';
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::User;
+
+=head1 NAME
+
+SrSv::User - Track users
+
+=head1 SYNOPSIS
+
+ use SrSv::User qw(get_user_id get_user_nick get_user_agent is_online chk_online get_user_flags set_user_flag chk_user_flag);
+
+=cut
+
+use strict;
+
+use Exporter 'import';
+BEGIN {
+ my %constants = (
+ UF_FINISHED => 1,
+ UF_ONLINE => 2, # not used yet
+ );
+
+ our @EXPORT_OK = (qw(get_user_id get_user_nick get_user_agent is_online chk_online
+ $get_user_id $get_user_nick
+ get_user_ip
+ get_user_flags set_user_flag chk_user_flag set_user_flag_all
+ get_host get_vhost get_cloakhost get_user_info
+ ),
+ keys(%constants));
+
+ our %EXPORT_TAGS = (flags => [keys(%constants)]);
+
+ require constant; import constant (\%constants);
+}
+
+use SrSv::MySQL::Stub {
+ __getIPV4 => ['SCALAR', "SELECT INET_NTOA(ip) FROM user WHERE id=?"],
+};
+
+use SrSv::Process::Init;
+use SrSv::MySQL '$dbh';
+use SrSv::NickControl::Enforcer qw(%enforcers);
+use SrSv::IRCd::State qw(synced);
+use SrSv::Agent qw(is_agent);
+use SrSv::User::Notice;
+
+use SrSv::Log;
+
+our (
+ $get_user_id, $get_user_nick, $get_nickchg, $is_online,
+
+ $get_user_flags, $set_user_flag, $unset_user_flag, $set_user_flag_all,
+
+ $get_host, $get_vhost, $get_cloakhost, $get_ip, $get_user_info,
+);
+
+proc_init {
+ $get_user_id = $dbh->prepare("SELECT id FROM user WHERE nick=?");
+ $get_user_nick = $dbh->prepare("SELECT nick FROM user WHERE id=?");
+ $get_nickchg = $dbh->prepare("SELECT nickchg.nickid, user.nick FROM nickchg, user WHERE user.id=nickchg.nickid AND nickchg.nick=?");
+ $is_online = $dbh->prepare("SELECT 1 FROM user WHERE nick=? AND online=1");
+
+ $get_user_flags = $dbh->prepare("SELECT flags FROM user WHERE id=?");
+ $set_user_flag = $dbh->prepare("UPDATE user SET flags=(flags | (?)) WHERE id=?");
+ $unset_user_flag = $dbh->prepare("UPDATE user SET flags=(flags & ~(?)) WHERE id=?");
+ $set_user_flag_all = $dbh->prepare("UPDATE user SET flags=flags | ?");
+
+ $get_host = $dbh->prepare("SELECT ident, host FROM user WHERE id=?");
+ $get_vhost = $dbh->prepare("SELECT ident, vhost FROM user WHERE id=?");
+ $get_cloakhost = $dbh->prepare("SELECT 1, cloakhost FROM user WHERE id=?");
+ $get_user_info = $dbh->prepare("SELECT ident, host, vhost, gecos, server FROM user WHERE id=?");
+};
+
+my (%userID, %userNick, %userOnline, %userAgent);
+
+sub new {
+ my (undef, @args) = @_;
+ my $self = {};
+ for (my $i = 0; $i < scalar(@args); $i += 2) {
+ my ($key, $val) = @args[$i..$i+1];
+ if($key =~ /^nick$/i) {
+ $userNick{$self} = $val;
+ }
+ if($key =~ /^(user)?ID$/i) {
+ $userID{$self} = $val;
+ }
+ if($key =~ /^Agent$/i) {
+ $userAgent{$self} = $val;
+ }
+ }
+ bless $self;
+ return $self;
+}
+
+sub id {
+ return uid(@_);
+}
+sub ID {
+ return uid(@_);
+}
+
+sub uid {
+ my ($self) = @_;
+ my ($id, $n);
+ my $nick = $userNick{$self};
+
+ return undef if(is_agent($nick) and not $enforcers{lc $nick});
+
+ if(exists($userID{$self})) { return $userID{$self}; }
+
+ # a cheat for isServer()
+ if($nick =~ /\./) {
+ return $userID{$self} = undef;
+ }
+
+ my $nick2;
+ while($n < 10 and !defined($id)) {
+ $n++;
+ $get_user_id->execute($nick);
+ ($id) = $get_user_id->fetchrow_array;
+ unless($id) {
+ $get_nickchg->execute($nick);
+ ($id, $nick2) = $get_nickchg->fetchrow_array;
+ }
+ }
+
+ #unless($id) { log::wlog(__PACKAGE__, log::DEBUG(), "get_user_id($nick) failed."); }
+
+ if(defined($nick2) and lc $nick2 ne lc $user->{NICK}) {
+ $user->{OLDNICK} = $user->{NICK};
+ $user->{NICK} = $nick2;
+ }
+
+ return $userID{$self} = $id;
+}
+
+sub nick {
+ my ($self) = @_;
+
+ if(exists($userNick{$self}) and is_online($userNick->{$self})) { return $userNick{$self} }
+
+ # Possible bug? This next bit only works to chase the nick-change
+ # if the caller already did a get_user_id to find out
+ # if the user exists in the user table, and thus get $user->{ID}
+ # I don't know if calling get_user_id here is safe or not.
+ my $nick;
+ if($userID{$self}) {
+ $get_user_nick->execute($userID{$self});
+ ($nick) = $get_user_nick->fetchrow_array;
+ }
+
+ # avoid returning an undef/NULL here. That's only legal for get_user_id
+ # If the user does not exist, we must avoid modifying the input
+ # so that it may be used for the error paths.
+ return (defined $nick ? $userNick{$self} = $nick : $userNick{$self});
+}
+
+sub agent {
+ my ($self) = @_;
+
+ if(exists($userAgent{$self})) {
+ return $userAgent{$self}
+ }
+ else {
+ return undef;
+ }
+}
+
+sub is_online($) {
+ my ($user) = @_;
+ my $nick;
+
+=cut
+ if(ref($user)) {
+ if(exists($user->{ONLINE})) { return $user->{ONLINE}; }
+ $nick = get_user_nick($user);
+ } else {
+ $nick = $user;
+ }
+=cut
+ my $nick = $user->nick;
+
+ $is_online->execute($nick);
+ my ($status) = $is_online->fetchrow_array;
+ $is_online->finish();
+ if(ref($user)) {
+ $user->{ONLINE} = ($status ? 1 : 0);
+ }
+
+ return $status;
+}
+
+sub chk_online($$) {
+ my ($user, $target) = @_;
+
+ unless(is_online($target)) {
+ if(ref($target)) {
+ $target = get_user_nick($target);
+ }
+
+ notice($user, "\002$target\002: No such user.");
+ return 0;
+ }
+
+ return 1;
+}
+
+sub set_user_flag($$;$) {
+ my ($user, $flag, $sign) = @_;
+ my $uid = $user->uid;
+ $sign = 1 unless defined($sign);
+
+ if($sign) {
+ $user->{FLAGS} = ( ( defined $user->{FLAGS} ? $user->{FLAGS} : 0 ) | $flag );
+ $set_user_flag->execute($flag, $uid);
+ } else {
+ $user->{FLAGS} = ( ( defined $user->{FLAGS} ? $user->{FLAGS} : 0 ) & ~($flag) );
+ $unset_user_flag->execute($flag, $uid);
+ }
+}
+
+sub chk_flag($$;$) {
+ my ($user, $flag, $sign) = @_;
+ my $flags = $user->flags;
+ $sign = 1 unless defined($sign);
+
+ return ($sign ? ($flags & $flag) : !($flags & $flag));
+}
+
+sub flags_reset {
+ my ($self) = @_;
+ delete $userFlags{$self};
+}
+
+sub flags($) {
+ my ($user) = @_;
+ my $uid = $user->uid;
+
+ my $flags;
+ unless (exists($user->{FLAGS})) {
+ $get_user_flags->execute($uid);
+ ($flags) = $get_user_flags->fetchrow_array;
+ $get_user_flags->finish();
+ } else {
+ $flags = $user->{FLAGS};
+ }
+
+ return $userFlags{$self} = $flags;
+}
+
+sub set_user_flag_all($) {
+ my ($flags) = @_;
+
+ $set_user_flag_all->execute($flags);
+ $set_user_flag_all->finish();
+}
+
+sub get_host($) {
+ my ($user) = @_;
+
+ my $id;
+ if(ref($user)) {
+ $id = $user->uid;
+ } else {
+ $id = {new(NICK => $nick)}->uid
+ }
+ return undef unless $id;
+
+ $get_host->execute($id);
+ my ($ident, $host) = $get_host->fetchrow_array;
+
+ return ($ident, $host);
+}
+
+sub get_cloakhost($) {
+ my ($user) = @_;
+
+ my $id;
+ if(ref($user)) {
+ $id = $user->uid;
+ } else {
+ $id = {new(NICK => $nick)}->uid;
+ }
+ return undef unless $id;
+
+ $get_cloakhost->execute($id);
+ my ($valid, $cloakhost) = $get_cloakhost->fetchrow_array;
+ $get_cloakhost->finish;
+
+ # Beware, $cloakhost may be NULL while the user entry exists
+ # if $cloakhost == undef, check $valid before assuming no such user.
+ return ($valid, $cloakhost);
+}
+
+sub get_vhost($) {
+ my ($user) = @_;
+
+ my $id;
+ if(ref($user)) {
+ $id = $user->uid;
+ } else {
+ $id = {new(NICK => $nick)}->uid;
+ }
+ return undef unless $id;
+
+ $get_vhost->execute($id);
+ my ($ident, $vhost) = $get_vhost->fetchrow_array;
+
+ return ($ident, $vhost);
+}
+
+sub get_user_info($) {
+ my ($user) = @_;
+
+ my $uid = $user->uid;
+ return undef() unless $uid;
+
+ $get_user_info->execute($uid);
+ my ($ident, $host, $vhost, $gecos, $server) = $get_user_info->fetchrow_array();
+ $get_user_info->finish;
+
+ return ($ident, $host, $vhost, $gecos, $server);
+}
+
+sub get_user_ipv4($) {
+ my ($user) = @_;
+
+ my $id;
+ if(ref($user)) {
+ if(exists $user->{IP}) {
+ return $user->{IP};
+ }
+ $id = $user->uid;
+ } else {
+ $id = {new(NICK => $nick)}->uid;
+ }
+ return undef unless $id;
+
+ my $ip = getIPV4($id);
+ if(ref($user)) {
+ return $user->{IP} = $ip;
+ } else {
+ return $ip;
+ }
+}
+
+sub get_user_ip($) {
+ return get_user_ipv4(@_);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+package SrSv::Util;
+
+use strict;
+
+use Exporter 'import';
+BEGIN {
+ our @EXPORT = qw(min max makeSeqList);
+ our @EXPORT_OK = qw(
+ say say2 say3 sayFH sayERR
+ slurpFile dumpFile
+ interpretSuffixes humanizeBigNums
+ );
+ our %EXPORT_TAGS = (
+ say => [qw( say say2 say3 sayFH sayERR )],
+ );
+
+}
+
+sub min($$) {
+ return ($_[0] < $_[1] ? $_[0] : $_[1]);
+}
+sub max($$) {
+ return ($_[0] > $_[1] ? $_[0] : $_[1]);
+}
+
+sub makeSeqList(@) {
+ my @nums;
+ foreach my $arg (@_) {
+ foreach my $parm (split(',', $arg)) {
+ if ($parm =~ /^(\d+)(?:-|\.\.)(\d+)$/) {
+ push @nums, min($1, $2)..max($1, $2);
+ } elsif(misc::isint($parm)) {
+ push @nums, $parm;
+ } else {
+ # just ignore it. we could try throwing an error.
+ }
+ }
+ }
+ # map is a uniqify in case of duplicates
+ # the sort is modified to sort numerically rather than by string.
+ return sort( {$a <=> $b} keys %{{ map { $_ => 1 } @nums }} );
+}
+
+sub __say($@) {
+ my ($chr, @list) = @_;
+ return join( '', map( {"$_$chr"} @list) );
+}
+sub _say(@) {
+ return __say ("\n", @_);
+}
+sub say(@) {
+ print _say(@_);
+}
+sub sayFH($@) {
+ my ($fh, @list) = @_;
+ print $fh _say(@list);
+}
+sub sayERR(@) {
+ sayFH STDERR, @_;
+}
+sub say2(@) {
+ say( __say( ' ', @_) );
+}
+sub say3(@) {
+ say( __say( ',', map({"\"$_\"" } @_) ) );
+}
+
+sub slurpFile($) {
+ my ($filename) = @_;
+ open((my $fh), '<', $filename) or return;
+ binmode $fh;
+ local $/;
+ my $data = <$fh>;
+ close $fh;
+ return $data;
+}
+
+sub dumpFile($@) {
+ my ($filename, @data) = @_;
+ open((my $fh), '>', $filename);
+ binmode $fh;
+ print $fh join("\n", map({ chomp $_; $_ } @data));
+ close $fh;
+}
+
+my %suffixes = ( 'k' => 1024, 'm' => 1048576, 'g' => 1024**3, 't' => 1024**4 );
+sub interpretSuffixes($) {
+ my ($mem) = @_;
+ $mem =~ /^(\d+)\s*([kmgt])?(?:i?B)?$/i;
+ my ($num, $suffix) = ($1, $2);
+ if($suffix) {
+ return $num * $suffixes{lc $suffix};
+ } else {
+ return $num;
+ }
+}
+
+sub humanizeBigNums($;$) {
+ my ($val, $precision) = @_;
+ $precision = 2 unless $precision;
+ #return $val;
+ #return sprintf("%.2gMiB", $val / (1 << 20));
+ if($val > (1 << 40)) {
+ return sprintf("%.${precision}fTiB", $val / (1 << 40));
+ }
+ elsif($val > (1 << 30)) {
+ return sprintf("%.${precision}fGiB", $val / (1 << 30));
+ }
+ elsif($val > (1 << 20)) {
+ return sprintf("%.${precision}fMiB", $val / (1 << 20));
+ }
+ elsif($val > (1 << 10)) {
+ return sprintf("%.${precision}fKiB", $val / (1 << 10));
+ }
+}
+
+1;
--- /dev/null
+-----------------------------------------------------------------------
+VERSION-SPECIFIC CHANGES
+
+0.4.1:
+You must move all mysql settings from services.conf to sql.conf
+
+0.4.2: Adds support for password-hashing, and makes a lot of changes to
+the database schema. running db-setup.pl is required.
+
+0.4.3: Do not mv config-example config, but rather
+cp -r config-example config.
+We actually use config-example to verify that all config keywords in the
+config-example also exist in config, and thus that the config is
+complete.
+
+-----------------------------------------------------------------------
+
+The db-setup.pl script should perform any database changes or
+conversions.
+
+If you have any problems, contact the coders on SurrealChat.net in
+#dev.lounge. We'll help out as best we can.
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use DBI;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => dirname(abs_path($0)),
+ );
+ require constant; import constant(\%constants);
+ chdir $constants{PREFIX};
+}
+use lib PREFIX;
+
+use SrSv::Conf 'sql';
+
+$dbh = DBI->connect('DBI:mysql:'.$sql_conf{'mysql-db'}, $sql_conf{'mysql-user'}, $sql_conf{'mysql-pass'},
+ { AutoCommit => 1, RaiseError => 1 });
+
+$get_root_nick = $dbh->prepare("SELECT nickreg.nick FROM nickalias,nickreg WHERE nickalias.nrid=nickreg.id AND alias=?");
+$create_svsop = $dbh->prepare("INSERT IGNORE INTO svsop SELECT nickreg.id, 0, '' FROM nickreg WHERE nickreg.nick=?");
+$set_svs_level = $dbh->prepare("UPDATE svsop, nickreg SET svsop.level=4, svsop.adder=''
+ WHERE svsop.nrid=nickreg.id AND nickreg.nick=?");
+
+$get_root_nick->execute($ARGV[0]);
+my ($root) = $get_root_nick->fetchrow_array;
+$get_root_nick->finish;
+
+unless($root) {
+ print "That nick does not exist.\n";
+ exit;
+}
+
+$create_svsop->execute($root);
+$create_svsop->finish;
+
+$set_svs_level->execute($root);
+$set_svs_level->finish;
+
+print "$root has been added as a Services Root.\n";
--- /dev/null
+ This is a utility for converting Anope databases to SrSv. For
+this to work, you'll need a current copy of ircservices for their
+convert-epona tool. This tool converts an epona/anope database to XML,
+and the parsexml script loads that XML file into your database.
+
+A) It does not handle channel access, as there is no reliable conversion
+between anope's LEVELS system and SrSv's xOP system.
+
+B) It currently does not handle memos, although it probably could.
+
+C) As SrSv has no concept of forbidden nicks or channels (nicks are
+usually handled by just registering, and holding, and channels can be
+just closed) this is not handled either.
+
+D) Channel passwords are simply discarded, as SrSv does not use channel
+passwords.
+
+E) This program has not been tested with a recent anope database,
+although we believe it was done with an early 1.7.x version.
+
+F) It is likely that the conversion can be done w/o the ircservices
+tools by converting Anope's MySQL database directly, however it has not
+been done yet.
+
+G) This database converter is BETA SOFTWARE. It is not guaranteed to not
+eat your data for lunch with a little barbecue sauce, and then burp
+happily.
+
+H) At present, merging two databases is NOT SUPPORTED, although it
+should be entirely possible. It merely has not been tested. Further,
+there is NO resolution method for collisions between the two databases
+for either channels or nicks.
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use XML::Twig;
+use DBI;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => abs_path(dirname(abs_path($0)).'/..'),
+ );
+ require constant; import constant(\%constants);
+}
+chdir PREFIX;
+use lib PREFIX;
+
+use SrSv::Conf 'sql';
+
+my $db = 1;
+
+my ($dbh);
+my (
+ $is_chan_reg, $regchan, $add_topic, $create_acc,
+
+ $is_nick_reg, $regnick, $create_alias
+);
+my ($time);
+
+if($db) {
+ eval {
+ $dbh = DBI->connect("DBI:mysql:".$sql_conf{'mysql-db'}, $sql_conf{'mysql-user'}, $sql_conf{'mysql-pass'},
+ { AutoCommit => 1, RaiseError => 1 });
+ };
+ if($@) {
+ print "FATAL: Can't connect to database:\n$@\n";
+ print "You must edit config/sql.conf and create a corresponding\nMySQL user and database!\n\n";
+ exit;
+ }
+
+ $is_chan_reg = $dbh->prepare("SELECT 1 FROM chanreg WHERE chan=?");
+ $regchan = $dbh->prepare("INSERT IGNORE INTO chanreg (chan, descrip, founderid, regd, last, topicer, topicd)
+ SELECT ?, ?, nickreg.id, ?, ?, ?, ? FROM nickalias
+ JOIN nickreg ON (nickalias.nrid=nickreg.id)
+ WHERE nickalias.alias=?");
+
+ $add_topic = $dbh->prepare("INSERT INTO chantext SET chan=?, type=1, data=?");
+ $create_acc = $dbh->prepare("INSERT INTO chanacc (chan,nrid,level)
+ SELECT ?, nickreg.id, ? FROM nickalias
+ JOIN nickreg ON (nickreg.id=nickalias.nrid)
+ WHERE alias=?");
+
+ $is_nick_reg = $dbh->prepare("SELECT 1 FROM nickalias WHERE alias=?");
+ $regnick = $dbh->prepare("INSERT INTO nickreg
+ SET nick=?, pass=?, email=?, regd=?, last=?, flags=1, ident='unknown', vhost='unknown', gecos=''");
+ $create_alias = $dbh->prepare("INSERT INTO nickalias (nrid, alias, protect, last)
+ SELECT id, ?, 1, 0 FROM nickreg WHERE nick=?");
+
+ $time = time();
+}
+
+my %nickids;
+my %ignorenicks;
+
+open ((my $FBN), '>', "nicks.forbid");
+open ((my $FBC), '>', "chans.forbid");
+
+my $crap;
+{
+ local $/;
+ $crap = <>;
+}
+
+$crap =~ s/\%/%%/g;
+$crap =~ s/&#/%/g;
+
+my $twig=XML::Twig->new(
+ twig_handlers =>
+ { nickgroupinfo => \&insert_nick,
+ channelinfo => \&insert_chan
+ },
+ keep_encoding => 1
+);
+$twig->parse($crap);
+$twig->purge;
+
+sub insert_nick {
+ my ($t, $section) = @_;
+
+ my $id = $section->first_child_text('id');
+ print "ID: $id\n";
+
+ my $root;
+ my $nickst = $section->first_child('nicks');
+ my @nickts = $nickst->children('array-element');
+ my @aliases;
+ foreach my $nt (@nickts) {
+ my $nick = $nt->text;
+ print "Alias: $nick\n";
+
+ if($db) {
+ $is_nick_reg->execute($nick);
+ if($is_nick_reg->fetchrow_array) {
+ print "Already registered!\n\n";
+ $ignorenicks{$id} = 1;
+ return;
+ }
+ }
+
+ push @aliases, $nick;
+ }
+ my $root = @aliases[0];
+
+ $nickids{$id} = $root;
+
+ my $pass = $section->first_child_text('pass');
+
+ if($pass eq '') {
+ print "Forbidden!\n\n";
+ print $FBN "$root\n";
+ return;
+ }
+
+ print "Pass: $pass\n";
+
+ my $email = $section->first_child_text('email');
+ print "Email: $email\n";
+
+ if($db) {
+ $regnick->execute($root, $pass, $email, $time, $time);
+
+ foreach my $alias (@aliases) {
+ $create_alias->execute($alias, $root);
+ }
+ }
+
+ print "\n";
+
+ $t->purge;
+}
+
+sub insert_chan {
+ my ($t, $section) = @_;
+
+ my $chan = $section->first_child_text('name');
+ print "Chan: $chan\n";
+
+ if($db) {
+ $is_chan_reg->execute($chan);
+ if($is_chan_reg->fetchrow_array) {
+ print "Already registered!\n\n";
+ return;
+ }
+ }
+
+ my $founderid = $section->first_child_text('founder');
+
+ if($founderid == 0) {
+ print "Forbidden!\n\n";
+ print $FBC "$chan\n";
+ return;
+ }
+
+ if($ignorenicks{$founderid}) {
+ print "Founder nick was already registered!\n\n";
+ return;
+ }
+
+ my $founder = $nickids{$founderid};
+ print "Founder: $founder\n";
+ die("No founder!") unless $founder;
+
+ my $topic = $section->first_child_text('last_topic');
+ $topic =~ s/%(\d+);/chr($1)/eg;
+ $topic =~ s/%%/%/g;
+ my $topictime = $section->first_child_text('last_topic_time');
+ my $topicset = $section->first_child_text('last_topic_setter');
+ my $desc = $section->first_child_text('desc');
+ my $pass = $section->first_child_text('founderpass');
+ my $last = $section->first_child_text('last_used');
+ my $regd = $section->first_child_text('time_registered');
+
+ if($db) {
+ $regchan->execute($chan, $desc, $regd, $last, $topicset, $topictime, $founder);
+ $add_topic->execute($chan, $topic);
+ $create_acc->execute($chan, 7, $founder);
+ }
+
+ print "\n";
+
+ $t->purge;
+}
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use DBI;
+
+%acc = (
+ 3 => 2,
+ 4 => 3,
+ 5 => 4,
+ 10 => 5,
+ 13 => 6
+);
+
+$dbh = DBI->connect("DBI:mysql:services", "services", "yQ0AaCLdMhfEBTpxwc0OWw", { AutoCommit => 1, RaiseError => 1 });
+
+$register = $dbh->prepare("INSERT IGNORE INTO chanreg SET chan=?, descrip=?, founder=?, pass=?, regd=?, last=?, topic=?, topicer='unknown', topicd=?, successor=?, bot=?");
+$create_acc = $dbh->prepare("INSERT IGNORE INTO chanacc SET chan=?, nick=?, level=?, adder=?");
+
+$time = time();
+
+open FILE, $ARGV[0];
+
+# 0name;1founder;2pass;3time_registered;4url;email;5mlock_key;6welcome;7hold;8mark;9freeze;10forbid;11successor;12mlock_link;13mlock_flood;14bot;15markreason;16freezereason;17holdreason;18lastgetpass;19access-level:nick:adder;20last_topic\ndesc
+
+while(@in = split(/;/, <FILE>)) {
+ die("Too many fields in $in[0]") if @in > 21;
+ $topic = <FILE>; chomp $topic;
+ $desc = <FILE>; chomp $desc;
+ @data = ($in[0], $desc, $in[1], $in[2], $in[3], $time, $topic, $time, $in[12], $in[15]);
+ print join(', ', @data), "\n";
+ $register->execute(@data);
+ $create_acc->execute($in[0], $in[1], 7, '');
+
+ foreach $acc (split(/,/, $in[20])) {
+ @d = split(/:/, $acc);
+ next unless @d == 3;
+ $d[0] = $acc{$d[0]};
+
+ print "acc: ", join(', ', @d), "\n";
+ $create_acc->execute($in[0], $d[1], $d[0], $d[2]);
+ }
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use DBI;
+
+$dbh = DBI->connect("DBI:mysql:services", "services", "yQ0AaCLdMhfEBTpxwc0OWw", { AutoCommit => 1, RaiseError => 1 });
+
+$register = $dbh->prepare("INSERT IGNORE INTO nickreg SET nick=?, pass=?, email=?, regd=?, last=?, flags=1, ident=?, vhost=?, gecos=?, quit=?");
+$create_alias = $dbh->prepare("INSERT IGNORE INTO nickalias SET root=?, alias=?");
+
+$time = time();
+
+open FILE, $ARGV[0];
+
+while(@in = split(/;/, <FILE>)) {
+ next unless($in[2] eq 'slave:no');
+
+ my ($ident, $host) = split('@', $in[3]) or ('', '');
+ next unless $ident;
+
+ @data = ($in[0], $in[1], $in[6], $in[4], $time, $ident, $host, $in[17], $in[16]);
+ print join(', ', @data), "\n";
+ $register->execute(@data);
+ $create_alias->execute($in[0], $in[0]);
+}
+
+open FILE, $ARGV[0];
+
+while(@in = split(/;/, <FILE>)) {
+ next unless($in[2] eq 'slave:yes');
+
+ @data = ($in[3], $in[0]);
+ print join(', ', @data), "\n";
+ $create_alias->execute(@data);
+}
--- /dev/null
+# This is the servername for services (it shows up in /map and /list).
+# It MUST contain at least one dot per RFC1459.
+local = services.example.com
+
+# This is the name or IP of the IRC-server/Hub that services
+# will connect to.
+remote = hub.example.com
+
+# This is the port to connect to. This port must accept server
+# connections (cannot be 'clientonly'). Nor can it be an SSL
+# port. SrSv does not support ziplinks either.
+port = 6667
+
+# This is UnrealIRCd's server numeric. You must set this to
+# a unique value.
+numeric = 123
+
+# You can set this to anything you want, it shows up in
+# /whois and /links
+info = SurrealServices
+
+# Server link password. Must match the appropriate link{} block
+# in the ircd config.
+pass = mypass
+
+# Number of worker processes. Note that increasing this above 4
+# will most likely only slow things down -- see README file.
+procs = 4
+
+# Diagnostic channel where you can monitor what services is doing.
+diag = #Diagnostics
+
+# List of modules to load. See README.
+load = core, services
+
+# The name of your network.
+# Not really used for anything anymore, we just take 005's NETWORK
+netname = ExampleNet
+
+# The email address that services will use for nearexpire,
+# sendpass, etc.
+email = Example IRC Services <services@example.com>
+
+# This is the Reply-To: field. This should be set to an address
+# of your network staff. Or set it to "noreply" if you hate
+# your users.
+replyto = staff@example.com
+
+# This line will be at the end of each email sent by services.
+sig = Thank you for chatting with us.
+
+# If you use NeoStats, set this to the name of your NeoStats
+# server. Otherwise, leave it commented out.
+#unsyncserver = neostats.example.com
+
+# Uncomment this if you don't want any emails to be sent.
+#nomail = 1
+
+# This is the address for maillogs.
+#logmail = staff@example.com
+
+# This determines whether passwords in services (and possibly some other modules)
+# are hashed or stored plain-text. hashing passwords mostly makes password-theft
+# harder, if the database is accessed by someone who should not have it.
+# default is off, but recommended to be turned on:
+# a) if your network is under threat of hacking
+# b) if your network is large
+# c) to alleviate some fears from users.
+#
+# If you set this to 1, and run db-setup, all of the nickreg passes will be
+# hashed for you. This process is irreversible, short of reverting to
+# a backup copy of your database. Keeping the backup for any period of time
+# violates the point of hashing your passwords.
+hashed-passwords = 0
+
+# IPv6 code is currently experimental, but is being explored.
+# For now, just disable this code and you should be fine.
+ipv6 = 0
--- /dev/null
+FloodGraceBackoff = 1
+DroneKlineReason = Botnet/Drone Channel
+FloodKlineTime = 3600
+MaxCloneTime = 0
+CloneKlineReason = Too Many Connections or Connecting Too Fast (Automatic Temporary K:Line)
+DroneKlineTime = 21600
+Debug = 0
+FloodGraceTime = 120
+MaxClones = 1024
+EnableConnTrack = 1
+CloneKillReason = Cloning Detected
+CloneKlineTime = 120
+Debugger = #diagnostics
+EnableFloodTrack = 1
+FloodKlineReason = Repeated Flooding (Automatic Ban)
+AuthWarnFail = 1
+EnableAutoFP = 0
+FloodGrace = 100
+CTCPonConnect = VERSION LAG
+ss_Username = username
+ss_Pass = pass
+ss_SkipFilters = DCCSEND IRCSpam HTTPSpam HTTPSpamChan
+EnableOPM = 0
+OPMZlineReason = Open proxy - see http://opm.blitzed.org/$
+ProxyZlineTime = 21600
+TorZlineReason = You are not permitted to connect to this network using anonymous proxies.
+TorServer = http://moria.seul.org:9031/tor/status/all
+EnableTor = 1
+CountryZlineReason = Due to persistent abuse, access to this network from $ is denied.
--- /dev/null
+# If this is set to 1, channels and nicknames will not expire.
+# This is useful after a long-term downtime where you want to
+# give a chance for people to come back and renew their nicks.
+noexpire = 0
+
+# The number of days a nick lasts before expiring.
+nickexpire = 21
+
+# The number of days a nick can be in vacation mode.
+vacationexpire = 90
+
+# Number of days before expiration where services will send
+# a reminder to the owner of the nick. Set to 0 to turn
+# this feature off.
+nearexpire = 7
+
+# Number of days a channel lasts before expiring.
+chanexpire = 21
+
+# If this is set to 1, users must validate their email
+# address in order to register a nick.
+validate-email = 0
+
+# Number of days a non-validated nick will last.
+validate-expire = 1
+
+# Maximum connections from the same IP.
+clone-limit = 3
+
+# Automatic gline time in seconds
+chankilltime = 86400
+
+# Default protection level for new nicknames.
+default-protect = normal
+
+#Whether to log override use. Not all overrides are logged yet!
+log-overrides = 0
+
+# Default channel bot for all registrations
+#default-chanbot=ChanBot
+default-chanbot = undef
+
+# Allows you to add secondary names for the agents
+botserv = undef
+nickserv = undef
+chanserv = undef
+memoserv = undef
+adminserv = undef
+operserv = undef
+hostserv = undef
+
+#Example:
+#botserv = Botty
+#nickserv = NomServ
+#chanserv = RoomService
+#memoserv = Question
+#adminserv = Secretary
+#operserv = Bouncer
+#hostserv = Butler
--- /dev/null
+# The username, password, and database for MySQL.
+mysql-user = services
+mysql-pass = mypass
+mysql-db = services
+
+# This is an optimization for MySQL 4.x,
+# but breaks HORRIBLY on MySQL 5.0 and newer DBI/DBDs
+server_prepare = 0
--- /dev/null
+500 Portland-Auburn, ME
+501 New York, NY
+502 Binghamton, NY
+503 Macon, GA
+504 Philadelphia, PA
+505 Detroit, MI
+506 Boston, MA
+507 Savannah, GA
+508 Pittsburgh, PA
+509 Ft Wayne, IN
+510 Cleveland, OH
+511 Washington, DC
+512 Baltimore, MD
+513 Flint, MI
+514 Buffalo, NY
+515 Cincinnati, OH
+516 Erie, PA
+517 Charlotte, NC
+518 Greensboro, NC
+519 Charleston, SC
+520 Augusta, GA
+521 Providence, RI
+522 Columbus, GA
+523 Burlington, VT
+524 Atlanta, GA
+525 Albany, GA
+526 Utica-Rome, NY
+527 Indianapolis, IN
+528 Miami, FL
+529 Louisville, KY
+530 Tallahassee, FL
+531 Tri-Cities, TN
+532 Albany-Schenectady-Troy, NY
+533 Hartford, CT
+534 Orlando, FL
+535 Columbus, OH
+536 Youngstown-Warren, OH
+537 Bangor, ME
+538 Rochester, NY
+539 Tampa, FL
+540 Traverse City-Cadillac, MI
+541 Lexington, KY
+542 Dayton, OH
+543 Springfield-Holyoke, MA
+544 Norfolk-Portsmouth, VA
+545 Greenville-New Bern-Washington, NC
+546 Columbia, SC
+547 Toledo, OH
+548 West Palm Beach, FL
+549 Watertown, NY
+550 Wilmington, NC
+551 Lansing, MI
+552 Presque Isle, ME
+553 Marquette, MI
+554 Wheeling, WV
+555 Syracuse, NY
+556 Richmond-Petersburg, VA
+557 Knoxville, TN
+558 Lima, OH
+559 Bluefield-Beckley-Oak Hill, WV
+560 Raleigh-Durham, NC
+561 Jacksonville, FL
+563 Grand Rapids, MI
+564 Charleston-Huntington, WV
+565 Elmira, NY
+566 Harrisburg-Lancaster-Lebanon-York, PA
+567 Greenville-Spartenburg, SC
+569 Harrisonburg, VA
+570 Florence-Myrtle Beach, SC
+571 Ft Myers, FL
+573 Roanoke-Lynchburg, VA
+574 Johnstown-Altoona, PA
+575 Chattanooga, TN
+576 Salisbury, MD
+577 Wilkes Barre-Scranton, PA
+581 Terre Haute, IN
+582 Lafayette, IN
+583 Alpena, MI
+584 Charlottesville, VA
+588 South Bend, IN
+592 Gainesville, FL
+596 Zanesville, OH
+597 Parkersburg, WV
+598 Clarksburg-Weston, WV
+600 Corpus Christi, TX
+602 Chicago, IL
+603 Joplin-Pittsburg, MO
+604 Columbia-Jefferson City, MO
+605 Topeka, KS
+606 Dothan, AL
+609 St Louis, MO
+610 Rockford, IL
+611 Rochester-Mason City-Austin, MN
+612 Shreveport, LA
+613 Minneapolis-St Paul, MN
+616 Kansas City, MO
+617 Milwaukee, WI
+618 Houston, TX
+619 Springfield, MO
+620 Tuscaloosa, AL
+622 New Orleans, LA
+623 Dallas-Fort Worth, TX
+624 Sioux City, IA
+625 Waco-Temple-Bryan, TX
+626 Victoria, TX
+627 Wichita Falls, TX
+628 Monroe, LA
+630 Birmingham, AL
+631 Ottumwa-Kirksville, IA
+632 Paducah, KY
+633 Odessa-Midland, TX
+634 Amarillo, TX
+635 Austin, TX
+636 Harlingen, TX
+637 Cedar Rapids-Waterloo, IA
+638 St Joseph, MO
+639 Jackson, TN
+640 Memphis, TN
+641 San Antonio, TX
+642 Lafayette, LA
+643 Lake Charles, LA
+644 Alexandria, LA
+646 Anniston, AL
+647 Greenwood-Greenville, MS
+648 Champaign-Springfield-Decatur, IL
+649 Evansville, IN
+650 Oklahoma City, OK
+651 Lubbock, TX
+652 Omaha, NE
+656 Panama City, FL
+657 Sherman, TX
+658 Green Bay-Appleton, WI
+659 Nashville, TN
+661 San Angelo, TX
+662 Abilene-Sweetwater, TX
+669 Madison, WI
+670 Ft Smith-Fay-Springfield, AR
+671 Tulsa, OK
+673 Columbus-Tupelo-West Point, MS
+675 Peoria-Bloomington, IL
+676 Duluth, MN
+678 Wichita, KS
+679 Des Moines, IA
+682 Davenport-Rock Island-Moline, IL
+686 Mobile, AL
+687 Minot-Bismarck-Dickinson, ND
+691 Huntsville, AL
+692 Beaumont-Port Author, TX
+693 Little Rock-Pine Bluff, AR
+698 Montgomery, AL
+702 La Crosse-Eau Claire, WI
+705 Wausau-Rhinelander, WI
+709 Tyler-Longview, TX
+710 Hattiesburg-Laurel, MS
+711 Meridian, MS
+716 Baton Rouge, LA
+717 Quincy, IL
+718 Jackson, MS
+722 Lincoln-Hastings, NE
+724 Fargo-Valley City, ND
+725 Sioux Falls, SD
+734 Jonesboro, AR
+736 Bowling Green, KY
+737 Mankato, MN
+740 North Platte, NE
+743 Anchorage, AK
+744 Honolulu, HI
+745 Fairbanks, AK
+746 Biloxi-Gulfport, MS
+747 Juneau, AK
+749 Laredo, TX
+751 Denver, CO
+752 Colorado Springs, CO
+753 Phoenix, AZ
+754 Butte-Bozeman, MT
+755 Great Falls, MT
+756 Billings, MT
+757 Boise, ID
+758 Idaho Falls-Pocatello, ID
+759 Cheyenne, WY
+760 Twin Falls, ID
+762 Missoula, MT
+764 Rapid City, SD
+765 El Paso, TX
+766 Helena, MT
+767 Casper-Riverton, WY
+770 Salt Lake City, UT
+771 Yuma, AZ
+773 Grand Junction, CO
+789 Tucson, AZ
+790 Albuquerque, NM
+798 Glendive, MT
+800 Bakersfield, CA
+801 Eugene, OR
+802 Eureka, CA
+803 Los Angeles, CA
+804 Palm Springs, CA
+807 San Francisco, CA
+810 Yakima-Pasco, WA
+811 Reno, NV
+813 Medford-Klamath Falls, OR
+819 Seattle-Tacoma, WA
+820 Portland, OR
+821 Bend, OR
+825 San Diego, CA
+828 Monterey-Salinas, CA
+839 Las Vegas, NV
+855 Santa Barbara, CA
+862 Sacramento, CA
+866 Fresno, CA
+868 Chico-Redding, CA
+881 Spokane, WA
--- /dev/null
+- Unknown
+AD Andorra
+AE United Arab Emirates
+AF Afghanistan
+AG Antigua and Barbuda
+AI Anguilla
+AL Albania
+AM Armenia
+AN Netherlands Antilles
+AO Angola
+AQ Antarctica
+AR Argentina
+AS American Samoa
+AT Austria
+AU Australia
+AW Aruba
+AX Aland Islands
+AZ Azerbaijan
+BA Bosnia and Herzegovina
+BB Barbados
+BD Bangladesh
+BE Belgium
+BF Burkina Faso
+BG Bulgaria
+BH Bahrain
+BI Burundi
+BJ Benin
+BM Bermuda
+BN Brunei Darussalam
+BO Bolivia
+BR Brazil
+BS Bahamas
+BT Bhutan
+BV Bouvet Island
+BW Botswana
+BY Belarus
+BZ Belize
+CA Canada
+CC Cocos (Keeling) Islands
+CD Democratic Republic of the Congo
+CF Central African Republic
+CG Congo
+CH Switzerland
+CI Cote D'Ivoire (Ivory Coast)
+CK Cook Islands
+CL Chile
+CM Cameroon
+CN China
+CO Colombia
+CR Costa Rica
+CS Serbia and Montenegro
+CU Cuba
+CV Cape Verde
+CX Christmas Island
+CY Cyprus
+CZ Czech Republic
+DE Germany
+DJ Djibouti
+DK Denmark
+DM Dominica
+DO Dominican Republic
+DZ Algeria
+EC Ecuador
+EE Estonia
+EG Egypt
+EH Western Sahara
+ER Eritrea
+ES Spain
+ET Ethiopia
+FI Finland
+FJ Fiji
+FK Falkland Islands (Malvinas)
+FM Federated States of Micronesia
+FO Faroe Islands
+FR France
+FX France, Metropolitan
+GA Gabon
+GB Great Britain (UK)
+GD Grenada
+GE Georgia
+GF French Guiana
+GH Ghana
+GI Gibraltar
+GL Greenland
+GM Gambia
+GN Guinea
+GP Guadeloupe
+GQ Equatorial Guinea
+GR Greece
+GS S. Georgia and S. Sandwich Islands
+GT Guatemala
+GU Guam
+GW Guinea-Bissau
+GY Guyana
+HK Hong Kong
+HM Heard Island and McDonald Islands
+HN Honduras
+HR Croatia (Hrvatska)
+HT Haiti
+HU Hungary
+ID Indonesia
+IE Ireland
+IL Israel
+IN India
+IO British Indian Ocean Territory
+IQ Iraq
+IR Iran
+IS Iceland
+IT Italy
+JM Jamaica
+JO Jordan
+JP Japan
+KE Kenya
+KG Kyrgyzstan
+KH Cambodia
+KI Kiribati
+KM Comoros
+KN Saint Kitts and Nevis
+KP Korea (North)
+KR Korea (South)
+KW Kuwait
+KY Cayman Islands
+KZ Kazakhstan
+LA Laos
+LB Lebanon
+LC Saint Lucia
+LI Liechtenstein
+LK Sri Lanka
+LR Liberia
+LS Lesotho
+LT Lithuania
+LU Luxembourg
+LV Latvia
+LY Libya
+MA Morocco
+MC Monaco
+MD Moldova
+MG Madagascar
+MH Marshall Islands
+MK Macedonia
+ML Mali
+MM Myanmar
+MN Mongolia
+MO Macao
+MP Northern Mariana Islands
+MQ Martinique
+MR Mauritania
+MS Montserrat
+MT Malta
+MU Mauritius
+MV Maldives
+MW Malawi
+MX Mexico
+MY Malaysia
+MZ Mozambique
+NA Namibia
+NC New Caledonia
+NE Niger
+NF Norfolk Island
+NG Nigeria
+NI Nicaragua
+NL Netherlands
+NO Norway
+NP Nepal
+NR Nauru
+NU Niue
+NZ New Zealand (Aotearoa)
+OM Oman
+PA Panama
+PE Peru
+PF French Polynesia
+PG Papua New Guinea
+PH Philippines
+PK Pakistan
+PL Poland
+PM Saint Pierre and Miquelon
+PN Pitcairn
+PR Puerto Rico
+PS Palestinian Territory
+PT Portugal
+PW Palau
+PY Paraguay
+QA Qatar
+RE Reunion
+RO Romania
+RU Russian Federation
+RW Rwanda
+SA Saudi Arabia
+SB Solomon Islands
+SC Seychelles
+SD Sudan
+SE Sweden
+SG Singapore
+SH Saint Helena
+SI Slovenia
+SJ Svalbard and Jan Mayen
+SK Slovakia
+SL Sierra Leone
+SM San Marino
+SN Senegal
+SO Somalia
+SR Suriname
+ST Sao Tome and Principe
+SU USSR (former)
+SV El Salvador
+SY Syria
+SZ Swaziland
+TC Turks and Caicos Islands
+TD Chad
+TF French Southern Territories
+TG Togo
+TH Thailand
+TJ Tajikistan
+TK Tokelau
+TL Timor-Leste
+TM Turkmenistan
+TN Tunisia
+TO Tonga
+TP East Timor
+TR Turkey
+TT Trinidad and Tobago
+TV Tuvalu
+TW Taiwan
+TZ Tanzania
+UA Ukraine
+UG Uganda
+UK United Kingdom
+UM United States Minor Outlying Islands
+US United States
+UY Uruguay
+UZ Uzbekistan
+VA Vatican City State (Holy See)
+VC Saint Vincent and the Grenadines
+VE Venezuela
+VG Virgin Islands (British)
+VI Virgin Islands (U.S.)
+VN Viet Nam
+VU Vanuatu
+WF Wallis and Futuna
+WS Samoa
+YE Yemen
+YT Mayotte
+YU Yugoslavia (former)
+ZA South Africa
+ZM Zambia
+ZR Zaire (former)
+ZW Zimbabwe
+BIZ Business
+COM Commercial
+EDU US Educational
+GOV US Government
+INT International
+MIL US Military
+NET Network
+ORG Nonprofit Organization
+PRO Professional Services
+AERO Aeronautic
+ARPA Arpanet Technical Infrastructure
+COOP Cooperative
+INFO Info Domain
+NAME Personal Name
+NATO North Atlantic Treaty Organization
+MUSEUM Museum Domain Management Association (MuseDoma)
+XXX Pornography
+EU European Union
--- /dev/null
+"iso 3166 country","fips 10-4 region code","name"
+AD,02,"Canillo"
+AD,03,"Encamp"
+AD,04,"La Massana"
+AD,05,"Ordino"
+AD,06,"Sant Julia de Loria"
+AD,07,"Andorra la Vella"
+AD,08,"Escaldes-Engordany"
+AE,01,"Abu Dhabi"
+AE,02,"Ajman"
+AE,03,"Dubai"
+AE,04,"Fujairah"
+AE,05,"Ras Al Khaimah"
+AE,06,"Sharjah"
+AE,07,"Umm Al Quwain"
+AF,01,"Badakhshan"
+AF,02,"Badghis"
+AF,03,"Baghlan"
+AF,05,"Bamian"
+AF,06,"Farah"
+AF,07,"Faryab"
+AF,08,"Ghazni"
+AF,09,"Ghowr"
+AF,10,"Helmand"
+AF,11,"Herat"
+AF,13,"Kabol"
+AF,14,"Kapisa"
+AF,15,"Konar"
+AF,16,"Laghman"
+AF,17,"Lowgar"
+AF,18,"Nangarhar"
+AF,19,"Nimruz"
+AF,21,"Paktia"
+AF,22,"Parvan"
+AF,23,"Kandahar"
+AF,24,"Kondoz"
+AF,26,"Takhar"
+AF,27,"Vardak"
+AF,28,"Zabol"
+AF,29,"Paktika"
+AF,30,"Balkh"
+AF,31,"Jowzjan"
+AF,32,"Samangan"
+AF,33,"Sar-e Pol"
+AF,34,"Konar"
+AF,35,"Laghman"
+AF,36,"Paktia"
+AF,37,"Khowst"
+AF,38,"Nurestan"
+AF,39,"Oruzgan"
+AF,40,"Parvan"
+AF,41,"Daykondi"
+AF,42,"Panjshir"
+AG,01,"Barbuda"
+AG,03,"Saint George"
+AG,04,"Saint John"
+AG,05,"Saint Mary"
+AG,06,"Saint Paul"
+AG,07,"Saint Peter"
+AG,08,"Saint Philip"
+AL,40,"Berat"
+AL,41,"Diber"
+AL,42,"Durres"
+AL,43,"Elbasan"
+AL,44,"Fier"
+AL,45,"Gjirokaster"
+AL,46,"Korce"
+AL,47,"Kukes"
+AL,48,"Lezhe"
+AL,49,"Shkoder"
+AL,50,"Tirane"
+AL,51,"Vlore"
+AM,01,"Aragatsotn"
+AM,02,"Ararat"
+AM,03,"Armavir"
+AM,04,"Geghark'unik'"
+AM,05,"Kotayk'"
+AM,06,"Lorri"
+AM,07,"Shirak"
+AM,08,"Syunik'"
+AM,09,"Tavush"
+AM,10,"Vayots' Dzor"
+AM,11,"Yerevan"
+AO,01,"Benguela"
+AO,02,"Bie"
+AO,03,"Cabinda"
+AO,04,"Cuando Cubango"
+AO,05,"Cuanza Norte"
+AO,06,"Cuanza Sul"
+AO,07,"Cunene"
+AO,08,"Huambo"
+AO,09,"Huila"
+AO,10,"Luanda"
+AO,12,"Malanje"
+AO,14,"Moxico"
+AO,15,"Uige"
+AO,16,"Zaire"
+AO,17,"Lunda Norte"
+AO,18,"Lunda Sul"
+AO,19,"Bengo"
+AO,20,"Luanda"
+AR,01,"Buenos Aires"
+AR,02,"Catamarca"
+AR,03,"Chaco"
+AR,04,"Chubut"
+AR,05,"Cordoba"
+AR,06,"Corrientes"
+AR,07,"Distrito Federal"
+AR,08,"Entre Rios"
+AR,09,"Formosa"
+AR,10,"Jujuy"
+AR,11,"La Pampa"
+AR,12,"La Rioja"
+AR,13,"Mendoza"
+AR,14,"Misiones"
+AR,15,"Neuquen"
+AR,16,"Rio Negro"
+AR,17,"Salta"
+AR,18,"San Juan"
+AR,19,"San Luis"
+AR,20,"Santa Cruz"
+AR,21,"Santa Fe"
+AR,22,"Santiago del Estero"
+AR,23,"Tierra del Fuego"
+AR,24,"Tucuman"
+AT,01,"Burgenland"
+AT,02,"Karnten"
+AT,03,"Niederosterreich"
+AT,04,"Oberosterreich"
+AT,05,"Salzburg"
+AT,06,"Steiermark"
+AT,07,"Tirol"
+AT,08,"Vorarlberg"
+AT,09,"Wien"
+AU,01,"Australian Capital Territory"
+AU,02,"New South Wales"
+AU,03,"Northern Territory"
+AU,04,"Queensland"
+AU,05,"South Australia"
+AU,06,"Tasmania"
+AU,07,"Victoria"
+AU,08,"Western Australia"
+AZ,01,"Abseron"
+AZ,02,"Agcabadi"
+AZ,03,"Agdam"
+AZ,04,"Agdas"
+AZ,05,"Agstafa"
+AZ,06,"Agsu"
+AZ,07,"Ali Bayramli"
+AZ,08,"Astara"
+AZ,09,"Baki"
+AZ,10,"Balakan"
+AZ,11,"Barda"
+AZ,12,"Beylaqan"
+AZ,13,"Bilasuvar"
+AZ,14,"Cabrayil"
+AZ,15,"Calilabad"
+AZ,16,"Daskasan"
+AZ,17,"Davaci"
+AZ,18,"Fuzuli"
+AZ,19,"Gadabay"
+AZ,20,"Ganca"
+AZ,21,"Goranboy"
+AZ,22,"Goycay"
+AZ,23,"Haciqabul"
+AZ,24,"Imisli"
+AZ,25,"Ismayilli"
+AZ,26,"Kalbacar"
+AZ,27,"Kurdamir"
+AZ,28,"Lacin"
+AZ,29,"Lankaran"
+AZ,30,"Lankaran"
+AZ,31,"Lerik"
+AZ,32,"Masalli"
+AZ,33,"Mingacevir"
+AZ,34,"Naftalan"
+AZ,35,"Naxcivan"
+AZ,36,"Neftcala"
+AZ,37,"Oguz"
+AZ,38,"Qabala"
+AZ,39,"Qax"
+AZ,40,"Qazax"
+AZ,41,"Qobustan"
+AZ,42,"Quba"
+AZ,43,"Qubadli"
+AZ,44,"Qusar"
+AZ,45,"Saatli"
+AZ,46,"Sabirabad"
+AZ,47,"Saki"
+AZ,48,"Saki"
+AZ,49,"Salyan"
+AZ,50,"Samaxi"
+AZ,51,"Samkir"
+AZ,52,"Samux"
+AZ,53,"Siyazan"
+AZ,54,"Sumqayit"
+AZ,55,"Susa"
+AZ,56,"Susa"
+AZ,57,"Tartar"
+AZ,58,"Tovuz"
+AZ,59,"Ucar"
+AZ,60,"Xacmaz"
+AZ,61,"Xankandi"
+AZ,62,"Xanlar"
+AZ,63,"Xizi"
+AZ,64,"Xocali"
+AZ,65,"Xocavand"
+AZ,66,"Yardimli"
+AZ,67,"Yevlax"
+AZ,68,"Yevlax"
+AZ,69,"Zangilan"
+AZ,70,"Zaqatala"
+AZ,71,"Zardab"
+BA,01,"Federation of Bosnia and Herzegovina"
+BA,02,"Republika Srpska"
+BB,01,"Christ Church"
+BB,02,"Saint Andrew"
+BB,03,"Saint George"
+BB,04,"Saint James"
+BB,05,"Saint John"
+BB,06,"Saint Joseph"
+BB,07,"Saint Lucy"
+BB,08,"Saint Michael"
+BB,09,"Saint Peter"
+BB,10,"Saint Philip"
+BB,11,"Saint Thomas"
+BD,01,"Barisal"
+BD,04,"Bandarban"
+BD,05,"Comilla"
+BD,12,"Mymensingh"
+BD,13,"Noakhali"
+BD,15,"Patuakhali"
+BD,22,"Bagerhat"
+BD,23,"Bhola"
+BD,24,"Bogra"
+BD,25,"Barguna"
+BD,26,"Brahmanbaria"
+BD,27,"Chandpur"
+BD,28,"Chapai Nawabganj"
+BD,29,"Chattagram"
+BD,30,"Chuadanga"
+BD,31,"Cox's Bazar"
+BD,32,"Dhaka"
+BD,33,"Dinajpur"
+BD,34,"Faridpur"
+BD,35,"Feni"
+BD,36,"Gaibandha"
+BD,37,"Gazipur"
+BD,38,"Gopalganj"
+BD,39,"Habiganj"
+BD,40,"Jaipurhat"
+BD,41,"Jamalpur"
+BD,42,"Jessore"
+BD,43,"Jhalakati"
+BD,44,"Jhenaidah"
+BD,45,"Khagrachari"
+BD,46,"Khulna"
+BD,47,"Kishorganj"
+BD,48,"Kurigram"
+BD,49,"Kushtia"
+BD,50,"Laksmipur"
+BD,51,"Lalmonirhat"
+BD,52,"Madaripur"
+BD,53,"Magura"
+BD,54,"Manikganj"
+BD,55,"Meherpur"
+BD,56,"Moulavibazar"
+BD,57,"Munshiganj"
+BD,58,"Naogaon"
+BD,59,"Narail"
+BD,60,"Narayanganj"
+BD,61,"Narsingdi"
+BD,62,"Nator"
+BD,63,"Netrakona"
+BD,64,"Nilphamari"
+BD,65,"Pabna"
+BD,66,"Panchagar"
+BD,67,"Parbattya Chattagram"
+BD,68,"Pirojpur"
+BD,69,"Rajbari"
+BD,70,"Rajshahi"
+BD,71,"Rangpur"
+BD,72,"Satkhira"
+BD,73,"Shariyatpur"
+BD,74,"Sherpur"
+BD,75,"Sirajganj"
+BD,76,"Sunamganj"
+BD,77,"Sylhet"
+BD,78,"Tangail"
+BD,79,"Thakurgaon"
+BD,81,"Dhaka"
+BD,82,"Khulna"
+BD,83,"Rajshahi"
+BD,84,"Chittagong"
+BD,85,"Barisal"
+BD,86,"Sylhet"
+BE,01,"Antwerpen"
+BE,02,"Brabant"
+BE,03,"Hainaut"
+BE,04,"Liege"
+BE,05,"Limburg"
+BE,06,"Luxembourg"
+BE,07,"Namur"
+BE,08,"Oost-Vlaanderen"
+BE,09,"West-Vlaanderen"
+BE,10,"Brabant Wallon"
+BE,11,"Brussels Hoofdstedelijk Gewest"
+BE,12,"Vlaams-Brabant"
+BF,15,"Bam"
+BF,19,"Boulkiemde"
+BF,20,"Ganzourgou"
+BF,21,"Gnagna"
+BF,28,"Kouritenga"
+BF,33,"Oudalan"
+BF,34,"Passore"
+BF,36,"Sanguie"
+BF,40,"Soum"
+BF,42,"Tapoa"
+BF,44,"Zoundweogo"
+BF,45,"Bale"
+BF,46,"Banwa"
+BF,47,"Bazega"
+BF,48,"Bougouriba"
+BF,49,"Boulgou"
+BF,50,"Gourma"
+BF,51,"Houet"
+BF,52,"Ioba"
+BF,53,"Kadiogo"
+BF,54,"Kenedougou"
+BF,55,"Komoe"
+BF,56,"Komondjari"
+BF,57,"Kompienga"
+BF,58,"Kossi"
+BF,59,"Koulpelogo"
+BF,60,"Kourweogo"
+BF,61,"Leraba"
+BF,62,"Loroum"
+BF,63,"Mouhoun"
+BF,64,"Namentenga"
+BF,65,"Naouri"
+BF,66,"Nayala"
+BF,67,"Noumbiel"
+BF,68,"Oubritenga"
+BF,69,"Poni"
+BF,70,"Sanmatenga"
+BF,71,"Seno"
+BF,72,"Sissili"
+BF,73,"Sourou"
+BF,74,"Tuy"
+BF,75,"Yagha"
+BF,76,"Yatenga"
+BF,77,"Ziro"
+BF,78,"Zondoma"
+BG,33,"Mikhaylovgrad"
+BG,38,"Blagoevgrad"
+BG,39,"Burgas"
+BG,40,"Dobrich"
+BG,41,"Gabrovo"
+BG,42,"Grad Sofiya"
+BG,43,"Khaskovo"
+BG,44,"Kurdzhali"
+BG,45,"Kyustendil"
+BG,46,"Lovech"
+BG,47,"Montana"
+BG,48,"Pazardzhik"
+BG,49,"Pernik"
+BG,50,"Pleven"
+BG,51,"Plovdiv"
+BG,52,"Razgrad"
+BG,53,"Ruse"
+BG,54,"Shumen"
+BG,55,"Silistra"
+BG,56,"Sliven"
+BG,57,"Smolyan"
+BG,58,"Sofiya"
+BG,59,"Stara Zagora"
+BG,60,"Turgovishte"
+BG,61,"Varna"
+BG,62,"Veliko Turnovo"
+BG,63,"Vidin"
+BG,64,"Vratsa"
+BG,65,"Yambol"
+BH,01,"Al Hadd"
+BH,02,"Al Manamah"
+BH,03,"Al Muharraq"
+BH,05,"Jidd Hafs"
+BH,06,"Sitrah"
+BH,08,"Al Mintaqah al Gharbiyah"
+BH,09,"Mintaqat Juzur Hawar"
+BH,10,"Al Mintaqah ash Shamaliyah"
+BH,11,"Al Mintaqah al Wusta"
+BH,12,"Madinat"
+BH,13,"Ar Rifa"
+BH,14,"Madinat Hamad"
+BH,15,"Al Muharraq"
+BH,16,"Al Asimah"
+BH,17,"Al Janubiyah"
+BH,18,"Ash Shamaliyah"
+BH,19,"Al Wusta"
+BI,02,"Bujumbura"
+BI,09,"Bubanza"
+BI,10,"Bururi"
+BI,11,"Cankuzo"
+BI,12,"Cibitoke"
+BI,13,"Gitega"
+BI,14,"Karuzi"
+BI,15,"Kayanza"
+BI,16,"Kirundo"
+BI,17,"Makamba"
+BI,18,"Muyinga"
+BI,19,"Ngozi"
+BI,20,"Rutana"
+BI,21,"Ruyigi"
+BI,22,"Muramvya"
+BI,23,"Mwaro"
+BJ,01,"Atakora"
+BJ,02,"Atlantique"
+BJ,03,"Borgou"
+BJ,04,"Mono"
+BJ,05,"Oueme"
+BJ,06,"Zou"
+BJ,14,"Littoral"
+BM,01,"Devonshire"
+BM,02,"Hamilton"
+BM,03,"Hamilton"
+BM,04,"Paget"
+BM,05,"Pembroke"
+BM,06,"Saint George"
+BM,07,"Saint George's"
+BM,08,"Sandys"
+BM,09,"Smiths"
+BM,10,"Southampton"
+BM,11,"Warwick"
+BN,07,"Alibori"
+BN,08,"Belait"
+BN,09,"Brunei and Muara"
+BN,10,"Temburong"
+BN,11,"Collines"
+BN,12,"Kouffo"
+BN,13,"Donga"
+BN,14,"Littoral"
+BN,15,"Tutong"
+BN,16,"Oueme"
+BN,17,"Plateau"
+BN,18,"Zou"
+BO,01,"Chuquisaca"
+BO,02,"Cochabamba"
+BO,03,"El Beni"
+BO,04,"La Paz"
+BO,05,"Oruro"
+BO,06,"Pando"
+BO,07,"Potosi"
+BO,08,"Santa Cruz"
+BO,09,"Tarija"
+BR,01,"Acre"
+BR,02,"Alagoas"
+BR,03,"Amapa"
+BR,04,"Amazonas"
+BR,05,"Bahia"
+BR,06,"Ceara"
+BR,07,"Distrito Federal"
+BR,08,"Espirito Santo"
+BR,11,"Mato Grosso do Sul"
+BR,13,"Maranhao"
+BR,14,"Mato Grosso"
+BR,15,"Minas Gerais"
+BR,16,"Para"
+BR,17,"Paraiba"
+BR,18,"Parana"
+BR,20,"Piaui"
+BR,21,"Rio de Janeiro"
+BR,22,"Rio Grande do Norte"
+BR,23,"Rio Grande do Sul"
+BR,24,"Rondonia"
+BR,25,"Roraima"
+BR,26,"Santa Catarina"
+BR,27,"Sao Paulo"
+BR,28,"Sergipe"
+BR,29,"Goias"
+BR,30,"Pernambuco"
+BR,31,"Tocantins"
+BS,05,"Bimini"
+BS,06,"Cat Island"
+BS,10,"Exuma"
+BS,13,"Inagua"
+BS,15,"Long Island"
+BS,16,"Mayaguana"
+BS,18,"Ragged Island"
+BS,22,"Harbour Island"
+BS,23,"New Providence"
+BS,24,"Acklins and Crooked Islands"
+BS,25,"Freeport"
+BS,26,"Fresh Creek"
+BS,27,"Governor's Harbour"
+BS,28,"Green Turtle Cay"
+BS,29,"High Rock"
+BS,30,"Kemps Bay"
+BS,31,"Marsh Harbour"
+BS,32,"Nichollstown and Berry Islands"
+BS,33,"Rock Sound"
+BS,34,"Sandy Point"
+BS,35,"San Salvador and Rum Cay"
+BT,05,"Bumthang"
+BT,06,"Chhukha"
+BT,07,"Chirang"
+BT,08,"Daga"
+BT,09,"Geylegphug"
+BT,10,"Ha"
+BT,11,"Lhuntshi"
+BT,12,"Mongar"
+BT,13,"Paro"
+BT,14,"Pemagatsel"
+BT,15,"Punakha"
+BT,16,"Samchi"
+BT,17,"Samdrup"
+BT,18,"Shemgang"
+BT,19,"Tashigang"
+BT,20,"Thimphu"
+BT,21,"Tongsa"
+BT,22,"Wangdi Phodrang"
+BW,01,"Central"
+BW,03,"Ghanzi"
+BW,04,"Kgalagadi"
+BW,05,"Kgatleng"
+BW,06,"Kweneng"
+BW,08,"North-East"
+BW,09,"South-East"
+BW,10,"Southern"
+BW,11,"North-West"
+BY,01,"Brestskaya Voblasts'"
+BY,02,"Homyel'skaya Voblasts'"
+BY,03,"Hrodzyenskaya Voblasts'"
+BY,04,"Minsk"
+BY,05,"Minskaya Voblasts'"
+BY,06,"Mahilyowskaya Voblasts'"
+BY,07,"Vitsyebskaya Voblasts'"
+BZ,01,"Belize"
+BZ,02,"Cayo"
+BZ,03,"Corozal"
+BZ,04,"Orange Walk"
+BZ,05,"Stann Creek"
+BZ,06,"Toledo"
+CA,01,"Alberta"
+CA,02,"British Columbia"
+CA,03,"Manitoba"
+CA,04,"New Brunswick"
+CA,05,"Newfoundland and Labrador"
+CA,07,"Nova Scotia"
+CA,08,"Ontario"
+CA,09,"Prince Edward Island"
+CA,10,"Quebec"
+CA,11,"Saskatchewan"
+CA,12,"Yukon Territory"
+CA,13,"Northwest Territories"
+CA,14,"Nunavut"
+CD,01,"Bandundu"
+CD,02,"Equateur"
+CD,04,"Kasai-Oriental"
+CD,05,"Katanga"
+CD,06,"Kinshasa"
+CD,07,"Kivu"
+CD,08,"Bas-Congo"
+CD,09,"Orientale"
+CD,10,"Maniema"
+CD,11,"Nord-Kivu"
+CD,12,"Sud-Kivu"
+CD,13,"Cuvette"
+CF,01,"Bamingui-Bangoran"
+CF,02,"Basse-Kotto"
+CF,03,"Haute-Kotto"
+CF,04,"Mambere-Kadei"
+CF,05,"Haut-Mbomou"
+CF,06,"Kemo"
+CF,07,"Lobaye"
+CF,08,"Mbomou"
+CF,09,"Nana-Mambere"
+CF,11,"Ouaka"
+CF,12,"Ouham"
+CF,13,"Ouham-Pende"
+CF,14,"Cuvette-Ouest"
+CF,15,"Nana-Grebizi"
+CF,16,"Sangha-Mbaere"
+CF,17,"Ombella-Mpoko"
+CF,18,"Bangui"
+CG,01,"Bouenza"
+CG,03,"Cuvette"
+CG,04,"Kouilou"
+CG,05,"Lekoumou"
+CG,06,"Likouala"
+CG,07,"Niari"
+CG,08,"Plateaux"
+CG,10,"Sangha"
+CG,11,"Pool"
+CG,12,"Brazzaville"
+CH,01,"Aargau"
+CH,02,"Ausser-Rhoden"
+CH,03,"Basel-Landschaft"
+CH,04,"Basel-Stadt"
+CH,05,"Bern"
+CH,06,"Fribourg"
+CH,07,"Geneve"
+CH,08,"Glarus"
+CH,09,"Graubunden"
+CH,10,"Inner-Rhoden"
+CH,11,"Luzern"
+CH,12,"Neuchatel"
+CH,13,"Nidwalden"
+CH,14,"Obwalden"
+CH,15,"Sankt Gallen"
+CH,16,"Schaffhausen"
+CH,17,"Schwyz"
+CH,18,"Solothurn"
+CH,19,"Thurgau"
+CH,20,"Ticino"
+CH,21,"Uri"
+CH,22,"Valais"
+CH,23,"Vaud"
+CH,24,"Zug"
+CH,25,"Zurich"
+CH,26,"Jura"
+CI,51,"Sassandra"
+CI,61,"Abidjan"
+CI,74,"Agneby"
+CI,75,"Bafing"
+CI,76,"Bas-Sassandra"
+CI,77,"Denguele"
+CI,78,"Dix-Huit Montagnes"
+CI,79,"Fromager"
+CI,80,"Haut-Sassandra"
+CI,81,"Lacs"
+CI,82,"Lagunes"
+CI,83,"Marahoue"
+CI,84,"Moyen-Cavally"
+CI,85,"Moyen-Comoe"
+CI,86,"N'zi-Comoe"
+CI,87,"Savanes"
+CI,88,"Sud-Bandama"
+CI,89,"Sud-Comoe"
+CI,90,"Vallee du Bandama"
+CI,91,"Worodougou"
+CI,92,"Zanzan"
+CL,01,"Valparaiso"
+CL,02,"Aisen del General Carlos Ibanez del Campo"
+CL,03,"Antofagasta"
+CL,04,"Araucania"
+CL,05,"Atacama"
+CL,06,"Bio-Bio"
+CL,07,"Coquimbo"
+CL,08,"Libertador General Bernardo O'Higgins"
+CL,09,"Los Lagos"
+CL,10,"Magallanes y de la Antartica Chilena"
+CL,11,"Maule"
+CL,12,"Region Metropolitana"
+CL,13,"Tarapaca"
+CM,04,"Est"
+CM,05,"Littoral"
+CM,07,"Nord-Ouest"
+CM,08,"Ouest"
+CM,09,"Sud-Ouest"
+CM,10,"Adamaoua"
+CM,11,"Centre"
+CM,12,"Extreme-Nord"
+CM,13,"Nord"
+CM,14,"Sud"
+CN,01,"Anhui"
+CN,02,"Zhejiang"
+CN,03,"Jiangxi"
+CN,04,"Jiangsu"
+CN,05,"Jilin"
+CN,06,"Qinghai"
+CN,07,"Fujian"
+CN,08,"Heilongjiang"
+CN,09,"Henan"
+CN,10,"Hebei"
+CN,11,"Hunan"
+CN,12,"Hubei"
+CN,13,"Xinjiang"
+CN,14,"Xizang"
+CN,15,"Gansu"
+CN,16,"Guangxi"
+CN,18,"Guizhou"
+CN,19,"Liaoning"
+CN,20,"Nei Mongol"
+CN,21,"Ningxia"
+CN,22,"Beijing"
+CN,23,"Shanghai"
+CN,24,"Shanxi"
+CN,25,"Shandong"
+CN,26,"Shaanxi"
+CN,28,"Tianjin"
+CN,29,"Yunnan"
+CN,30,"Guangdong"
+CN,31,"Hainan"
+CN,32,"Sichuan"
+CN,33,"Chongqing"
+CO,01,"Amazonas"
+CO,02,"Antioquia"
+CO,03,"Arauca"
+CO,04,"Atlantico"
+CO,05,"Bolívar Department"
+CO,06,"Boyacá Department"
+CO,07,"Caldas Department"
+CO,08,"Caqueta"
+CO,09,"Cauca"
+CO,10,"Cesar"
+CO,11,"Choco"
+CO,12,"Cordoba"
+CO,14,"Guaviare"
+CO,15,"Guainia"
+CO,16,"Huila"
+CO,17,"La Guajira"
+CO,18,"Magdalena Department"
+CO,19,"Meta"
+CO,20,"Narino"
+CO,21,"Norte de Santander"
+CO,22,"Putumayo"
+CO,23,"Quindio"
+CO,24,"Risaralda"
+CO,25,"San Andres y Providencia"
+CO,26,"Santander"
+CO,27,"Sucre"
+CO,28,"Tolima"
+CO,29,"Valle del Cauca"
+CO,30,"Vaupes"
+CO,31,"Vichada"
+CO,32,"Casanare"
+CO,33,"Cundinamarca"
+CO,34,"Distrito Especial"
+CO,35,"Bolivar"
+CO,36,"Boyaca"
+CO,37,"Caldas"
+CO,38,"Magdalena"
+CR,01,"Alajuela"
+CR,02,"Cartago"
+CR,03,"Guanacaste"
+CR,04,"Heredia"
+CR,06,"Limon"
+CR,07,"Puntarenas"
+CR,08,"San Jose"
+CU,01,"Pinar del Rio"
+CU,02,"Ciudad de la Habana"
+CU,03,"Matanzas"
+CU,04,"Isla de la Juventud"
+CU,05,"Camaguey"
+CU,07,"Ciego de Avila"
+CU,08,"Cienfuegos"
+CU,09,"Granma"
+CU,10,"Guantanamo"
+CU,11,"La Habana"
+CU,12,"Holguin"
+CU,13,"Las Tunas"
+CU,14,"Sancti Spiritus"
+CU,15,"Santiago de Cuba"
+CU,16,"Villa Clara"
+CV,01,"Boa Vista"
+CV,02,"Brava"
+CV,04,"Maio"
+CV,05,"Paul"
+CV,07,"Ribeira Grande"
+CV,08,"Sal"
+CV,10,"Sao Nicolau"
+CV,11,"Sao Vicente"
+CV,13,"Mosteiros"
+CV,14,"Praia"
+CV,15,"Santa Catarina"
+CV,16,"Santa Cruz"
+CV,17,"Sao Domingos"
+CV,18,"Sao Filipe"
+CV,19,"Sao Miguel"
+CV,20,"Tarrafal"
+CY,01,"Famagusta"
+CY,02,"Kyrenia"
+CY,03,"Larnaca"
+CY,04,"Nicosia"
+CY,05,"Limassol"
+CY,06,"Paphos"
+CZ,03,"Blansko"
+CZ,04,"Breclav"
+CZ,20,"Hradec Kralove"
+CZ,21,"Jablonec nad Nisou"
+CZ,23,"Jicin"
+CZ,24,"Jihlava"
+CZ,30,"Kolin"
+CZ,33,"Liberec"
+CZ,36,"Melnik"
+CZ,37,"Mlada Boleslav"
+CZ,39,"Nachod"
+CZ,41,"Nymburk"
+CZ,45,"Pardubice"
+CZ,52,"Hlavni mesto Praha"
+CZ,61,"Semily"
+CZ,70,"Trutnov"
+CZ,78,"Jihomoravsky kraj"
+CZ,79,"Jihocesky kraj"
+CZ,80,"Vysocina"
+CZ,81,"Karlovarsky kraj"
+CZ,82,"Kralovehradecky kraj"
+CZ,83,"Liberecky kraj"
+CZ,84,"Olomoucky kraj"
+CZ,85,"Moravskoslezsky kraj"
+CZ,86,"Pardubicky kraj"
+CZ,87,"Plzensky kraj"
+CZ,88,"Stredocesky kraj"
+CZ,89,"Ustecky kraj"
+CZ,90,"Zlinsky kraj"
+DE,01,"Baden-Wurttemberg"
+DE,02,"Bayern"
+DE,03,"Bremen"
+DE,04,"Hamburg"
+DE,05,"Hessen"
+DE,06,"Niedersachsen"
+DE,07,"Nordrhein-Westfalen"
+DE,08,"Rheinland-Pfalz"
+DE,09,"Saarland"
+DE,10,"Schleswig-Holstein"
+DE,11,"Brandenburg"
+DE,12,"Mecklenburg-Vorpommern"
+DE,13,"Sachsen"
+DE,14,"Sachsen-Anhalt"
+DE,15,"Thuringen"
+DE,16,"Berlin"
+DJ,01,"Ali Sabieh"
+DJ,04,"Obock"
+DJ,05,"Tadjoura"
+DJ,06,"Dikhil"
+DJ,07,"Djibouti"
+DJ,08,"Arta"
+DK,01,"Arhus"
+DK,02,"Bornholm"
+DK,03,"Frederiksborg"
+DK,04,"Fyn"
+DK,05,"Kobenhavn"
+DK,06,"Staden Kobenhavn"
+DK,07,"Nordjylland"
+DK,08,"Ribe"
+DK,09,"Ringkobing"
+DK,10,"Roskilde"
+DK,11,"Sonderjylland"
+DK,12,"Storstrom"
+DK,13,"Vejle"
+DK,14,"Vestsjalland"
+DK,15,"Viborg"
+DK,17,"Hovedstaden"
+DK,18,"Midtjyllen"
+DK,19,"Nordjylland"
+DK,20,"Sjelland"
+DK,21,"Syddanmark"
+DM,02,"Saint Andrew"
+DM,03,"Saint David"
+DM,04,"Saint George"
+DM,05,"Saint John"
+DM,06,"Saint Joseph"
+DM,07,"Saint Luke"
+DM,08,"Saint Mark"
+DM,09,"Saint Patrick"
+DM,10,"Saint Paul"
+DM,11,"Saint Peter"
+DO,01,"Azua"
+DO,02,"Baoruco"
+DO,03,"Barahona"
+DO,04,"Dajabon"
+DO,05,"Distrito Nacional"
+DO,06,"Duarte"
+DO,08,"Espaillat"
+DO,09,"Independencia"
+DO,10,"La Altagracia"
+DO,11,"Elias Pina"
+DO,12,"La Romana"
+DO,14,"Maria Trinidad Sanchez"
+DO,15,"Monte Cristi"
+DO,16,"Pedernales"
+DO,17,"Peravia"
+DO,18,"Puerto Plata"
+DO,19,"Salcedo"
+DO,20,"Samana"
+DO,21,"Sanchez Ramirez"
+DO,23,"San Juan"
+DO,24,"San Pedro De Macoris"
+DO,25,"Santiago"
+DO,26,"Santiago Rodriguez"
+DO,27,"Valverde"
+DO,28,"El Seibo"
+DO,29,"Hato Mayor"
+DO,30,"La Vega"
+DO,31,"Monsenor Nouel"
+DO,32,"Monte Plata"
+DO,33,"San Cristobal"
+DO,34,"Distrito Nacional"
+DO,35,"Peravia"
+DO,36,"San Jose de Ocoa"
+DO,37,"Santo Domingo"
+DZ,01,"Alger"
+DZ,03,"Batna"
+DZ,04,"Constantine"
+DZ,06,"Medea"
+DZ,07,"Mostaganem"
+DZ,09,"Oran"
+DZ,10,"Saida"
+DZ,12,"Setif"
+DZ,13,"Tiaret"
+DZ,14,"Tizi Ouzou"
+DZ,15,"Tlemcen"
+DZ,18,"Bejaia"
+DZ,19,"Biskra"
+DZ,20,"Blida"
+DZ,21,"Bouira"
+DZ,22,"Djelfa"
+DZ,23,"Guelma"
+DZ,24,"Jijel"
+DZ,25,"Laghouat"
+DZ,26,"Mascara"
+DZ,27,"M'sila"
+DZ,29,"Oum el Bouaghi"
+DZ,30,"Sidi Bel Abbes"
+DZ,31,"Skikda"
+DZ,33,"Tebessa"
+DZ,34,"Adrar"
+DZ,35,"Ain Defla"
+DZ,36,"Ain Temouchent"
+DZ,37,"Annaba"
+DZ,38,"Bechar"
+DZ,39,"Bordj Bou Arreridj"
+DZ,40,"Boumerdes"
+DZ,41,"Chlef"
+DZ,42,"El Bayadh"
+DZ,43,"El Oued"
+DZ,44,"El Tarf"
+DZ,45,"Ghardaia"
+DZ,46,"Illizi"
+DZ,47,"Khenchela"
+DZ,48,"Mila"
+DZ,49,"Naama"
+DZ,50,"Ouargla"
+DZ,51,"Relizane"
+DZ,52,"Souk Ahras"
+DZ,53,"Tamanghasset"
+DZ,54,"Tindouf"
+DZ,55,"Tipaza"
+DZ,56,"Tissemsilt"
+EC,01,"Galapagos"
+EC,02,"Azuay"
+EC,03,"Bolivar"
+EC,04,"Canar"
+EC,05,"Carchi"
+EC,06,"Chimborazo"
+EC,07,"Cotopaxi"
+EC,08,"El Oro"
+EC,09,"Esmeraldas"
+EC,10,"Guayas"
+EC,11,"Imbabura"
+EC,12,"Loja"
+EC,13,"Los Rios"
+EC,14,"Manabi"
+EC,15,"Morona-Santiago"
+EC,17,"Pastaza"
+EC,18,"Pichincha"
+EC,19,"Tungurahua"
+EC,20,"Zamora-Chinchipe"
+EC,22,"Sucumbios"
+EC,23,"Napo"
+EC,24,"Orellana"
+EE,01,"Harjumaa"
+EE,02,"Hiiumaa"
+EE,03,"Ida-Virumaa"
+EE,04,"Jarvamaa"
+EE,05,"Jogevamaa"
+EE,06,"Kohtla-Jarve"
+EE,07,"Laanemaa"
+EE,08,"Laane-Virumaa"
+EE,09,"Narva"
+EE,10,"Parnu"
+EE,11,"Parnumaa"
+EE,12,"Polvamaa"
+EE,13,"Raplamaa"
+EE,14,"Saaremaa"
+EE,15,"Sillamae"
+EE,16,"Tallinn"
+EE,17,"Tartu"
+EE,18,"Tartumaa"
+EE,19,"Valgamaa"
+EE,20,"Viljandimaa"
+EE,21,"Vorumaa"
+EG,01,"Ad Daqahliyah"
+EG,02,"Al Bahr al Ahmar"
+EG,03,"Al Buhayrah"
+EG,04,"Al Fayyum"
+EG,05,"Al Gharbiyah"
+EG,06,"Al Iskandariyah"
+EG,07,"Al Isma'iliyah"
+EG,08,"Al Jizah"
+EG,09,"Al Minufiyah"
+EG,10,"Al Minya"
+EG,11,"Al Qahirah"
+EG,12,"Al Qalyubiyah"
+EG,13,"Al Wadi al Jadid"
+EG,14,"Ash Sharqiyah"
+EG,15,"As Suways"
+EG,16,"Aswan"
+EG,17,"Asyut"
+EG,18,"Bani Suwayf"
+EG,19,"Bur Sa'id"
+EG,20,"Dumyat"
+EG,21,"Kafr ash Shaykh"
+EG,22,"Matruh"
+EG,23,"Qina"
+EG,24,"Suhaj"
+EG,26,"Janub Sina'"
+EG,27,"Shamal Sina'"
+ER,01,"Anseba"
+ER,02,"Debub"
+ER,03,"Debubawi K'eyih Bahri"
+ER,04,"Gash Barka"
+ER,05,"Ma'akel"
+ER,06,"Semenawi K'eyih Bahri"
+ES,07,"Islas Baleares"
+ES,27,"La Rioja"
+ES,29,"Madrid"
+ES,31,"Murcia"
+ES,32,"Navarra"
+ES,34,"Asturias"
+ES,39,"Cantabria"
+ES,51,"Andalucia"
+ES,52,"Aragon"
+ES,53,"Canarias"
+ES,54,"Castilla-La Mancha"
+ES,55,"Castilla y Leon"
+ES,56,"Catalonia"
+ES,57,"Extremadura"
+ES,58,"Galicia"
+ES,59,"Pais Vasco"
+ES,60,"Comunidad Valenciana"
+ET,02,"Amhara"
+ET,07,"Somali"
+ET,08,"Gambella"
+ET,10,"Addis Abeba"
+ET,11,"Southern"
+ET,12,"Tigray"
+ET,13,"Benishangul"
+ET,14,"Afar"
+ET,44,"Adis Abeba"
+ET,45,"Afar"
+ET,46,"Amara"
+ET,47,"Binshangul Gumuz"
+ET,48,"Dire Dawa"
+ET,49,"Gambela Hizboch"
+ET,50,"Hareri Hizb"
+ET,51,"Oromiya"
+ET,52,"Sumale"
+ET,53,"Tigray"
+ET,54,"YeDebub Biheroch Bihereseboch na Hizboch"
+FI,01,"Aland"
+FI,06,"Lapland"
+FI,08,"Oulu"
+FI,13,"Southern Finland"
+FI,14,"Eastern Finland"
+FI,15,"Western Finland"
+FJ,01,"Central"
+FJ,02,"Eastern"
+FJ,03,"Northern"
+FJ,04,"Rotuma"
+FJ,05,"Western"
+FM,01,"Kosrae"
+FM,02,"Pohnpei"
+FM,03,"Chuuk"
+FM,04,"Yap"
+FR,97,"Aquitaine"
+FR,98,"Auvergne"
+FR,99,"Basse-Normandie"
+FR,A1,"Bourgogne"
+FR,A2,"Bretagne"
+FR,A3,"Centre"
+FR,A4,"Champagne-Ardenne"
+FR,A5,"Corse"
+FR,A6,"Franche-Comte"
+FR,A7,"Haute-Normandie"
+FR,A8,"Ile-de-France"
+FR,A9,"Languedoc-Roussillon"
+FR,B1,"Limousin"
+FR,B2,"Lorraine"
+FR,B3,"Midi-Pyrenees"
+FR,B4,"Nord-Pas-de-Calais"
+FR,B5,"Pays de la Loire"
+FR,B6,"Picardie"
+FR,B7,"Poitou-Charentes"
+FR,B8,"Provence-Alpes-Cote d'Azur"
+FR,B9,"Rhone-Alpes"
+FR,C1,"Alsace"
+GA,01,"Estuaire"
+GA,02,"Haut-Ogooue"
+GA,03,"Moyen-Ogooue"
+GA,04,"Ngounie"
+GA,05,"Nyanga"
+GA,06,"Ogooue-Ivindo"
+GA,07,"Ogooue-Lolo"
+GA,08,"Ogooue-Maritime"
+GA,09,"Woleu-Ntem"
+GB,01,"Avon"
+GB,03,"Berkshire"
+GB,07,"Cleveland"
+GB,17,"Greater London"
+GB,18,"Greater Manchester"
+GB,20,"Hereford and Worcester"
+GB,22,"Humberside"
+GB,28,"Merseyside"
+GB,37,"South Yorkshire"
+GB,41,"Tyne and Wear"
+GB,43,"West Midlands"
+GB,45,"West Yorkshire"
+GB,79,"Central"
+GB,82,"Grampian"
+GB,84,"Lothian"
+GB,87,"Strathclyde"
+GB,88,"Tayside"
+GB,90,"Clwyd"
+GB,91,"Dyfed"
+GB,92,"Gwent"
+GB,94,"Mid Glamorgan"
+GB,96,"South Glamorgan"
+GB,97,"West Glamorgan"
+GB,A1,"Barking and Dagenham"
+GB,A2,"Barnet"
+GB,A3,"Barnsley"
+GB,A4,"Bath and North East Somerset"
+GB,A5,"Bedfordshire"
+GB,A6,"Bexley"
+GB,A7,"Birmingham"
+GB,A8,"Blackburn with Darwen"
+GB,A9,"Blackpool"
+GB,B1,"Bolton"
+GB,B2,"Bournemouth"
+GB,B3,"Bracknell Forest"
+GB,B4,"Bradford"
+GB,B5,"Brent"
+GB,B6,"Brighton and Hove"
+GB,B7,"Bristol, City of"
+GB,B8,"Bromley"
+GB,B9,"Buckinghamshire"
+GB,C1,"Bury"
+GB,C2,"Calderdale"
+GB,C3,"Cambridgeshire"
+GB,C4,"Camden"
+GB,C5,"Cheshire"
+GB,C6,"Cornwall"
+GB,C7,"Coventry"
+GB,C8,"Croydon"
+GB,C9,"Cumbria"
+GB,D1,"Darlington"
+GB,D2,"Derby"
+GB,D3,"Derbyshire"
+GB,D4,"Devon"
+GB,D5,"Doncaster"
+GB,D6,"Dorset"
+GB,D7,"Dudley"
+GB,D8,"Durham"
+GB,D9,"Ealing"
+GB,E1,"East Riding of Yorkshire"
+GB,E2,"East Sussex"
+GB,E3,"Enfield"
+GB,E4,"Essex"
+GB,E5,"Gateshead"
+GB,E6,"Gloucestershire"
+GB,E7,"Greenwich"
+GB,E8,"Hackney"
+GB,E9,"Halton"
+GB,F1,"Hammersmith and Fulham"
+GB,F2,"Hampshire"
+GB,F3,"Haringey"
+GB,F4,"Harrow"
+GB,F5,"Hartlepool"
+GB,F6,"Havering"
+GB,F7,"Herefordshire"
+GB,F8,"Hertford"
+GB,F9,"Hillingdon"
+GB,G1,"Hounslow"
+GB,G2,"Isle of Wight"
+GB,G3,"Islington"
+GB,G4,"Kensington and Chelsea"
+GB,G5,"Kent"
+GB,G6,"Kingston upon Hull, City of"
+GB,G7,"Kingston upon Thames"
+GB,G8,"Kirklees"
+GB,G9,"Knowsley"
+GB,H1,"Lambeth"
+GB,H2,"Lancashire"
+GB,H3,"Leeds"
+GB,H4,"Leicester"
+GB,H5,"Leicestershire"
+GB,H6,"Lewisham"
+GB,H7,"Lincolnshire"
+GB,H8,"Liverpool"
+GB,H9,"London, City of"
+GB,I1,"Luton"
+GB,I2,"Manchester"
+GB,I3,"Medway"
+GB,I4,"Merton"
+GB,I5,"Middlesbrough"
+GB,I6,"Milton Keynes"
+GB,I7,"Newcastle upon Tyne"
+GB,I8,"Newham"
+GB,I9,"Norfolk"
+GB,J1,"Northamptonshire"
+GB,J2,"North East Lincolnshire"
+GB,J3,"North Lincolnshire"
+GB,J4,"North Somerset"
+GB,J5,"North Tyneside"
+GB,J6,"Northumberland"
+GB,J7,"North Yorkshire"
+GB,J8,"Nottingham"
+GB,J9,"Nottinghamshire"
+GB,K1,"Oldham"
+GB,K2,"Oxfordshire"
+GB,K3,"Peterborough"
+GB,K4,"Plymouth"
+GB,K5,"Poole"
+GB,K6,"Portsmouth"
+GB,K7,"Reading"
+GB,K8,"Redbridge"
+GB,K9,"Redcar and Cleveland"
+GB,L1,"Richmond upon Thames"
+GB,L2,"Rochdale"
+GB,L3,"Rotherham"
+GB,L4,"Rutland"
+GB,L5,"Salford"
+GB,L6,"Shropshire"
+GB,L7,"Sandwell"
+GB,L8,"Sefton"
+GB,L9,"Sheffield"
+GB,M1,"Slough"
+GB,M2,"Solihull"
+GB,M3,"Somerset"
+GB,M4,"Southampton"
+GB,M5,"Southend-on-Sea"
+GB,M6,"South Gloucestershire"
+GB,M7,"South Tyneside"
+GB,M8,"Southwark"
+GB,M9,"Staffordshire"
+GB,N1,"St. Helens"
+GB,N2,"Stockport"
+GB,N3,"Stockton-on-Tees"
+GB,N4,"Stoke-on-Trent"
+GB,N5,"Suffolk"
+GB,N6,"Sunderland"
+GB,N7,"Surrey"
+GB,N8,"Sutton"
+GB,N9,"Swindon"
+GB,O1,"Tameside"
+GB,O2,"Telford and Wrekin"
+GB,O3,"Thurrock"
+GB,O4,"Torbay"
+GB,O5,"Tower Hamlets"
+GB,O6,"Trafford"
+GB,O7,"Wakefield"
+GB,O8,"Walsall"
+GB,O9,"Waltham Forest"
+GB,P1,"Wandsworth"
+GB,P2,"Warrington"
+GB,P3,"Warwickshire"
+GB,P4,"West Berkshire"
+GB,P5,"Westminster"
+GB,P6,"West Sussex"
+GB,P7,"Wigan"
+GB,P8,"Wiltshire"
+GB,P9,"Windsor and Maidenhead"
+GB,Q1,"Wirral"
+GB,Q2,"Wokingham"
+GB,Q3,"Wolverhampton"
+GB,Q4,"Worcestershire"
+GB,Q5,"York"
+GB,Q6,"Antrim"
+GB,Q7,"Ards"
+GB,Q8,"Armagh"
+GB,Q9,"Ballymena"
+GB,R1,"Ballymoney"
+GB,R2,"Banbridge"
+GB,R3,"Belfast"
+GB,R4,"Carrickfergus"
+GB,R5,"Castlereagh"
+GB,R6,"Coleraine"
+GB,R7,"Cookstown"
+GB,R8,"Craigavon"
+GB,R9,"Down"
+GB,S1,"Dungannon"
+GB,S2,"Fermanagh"
+GB,S3,"Larne"
+GB,S4,"Limavady"
+GB,S5,"Lisburn"
+GB,S6,"Derry"
+GB,S7,"Magherafelt"
+GB,S8,"Moyle"
+GB,S9,"Newry and Mourne"
+GB,T1,"Newtownabbey"
+GB,T2,"North Down"
+GB,T3,"Omagh"
+GB,T4,"Strabane"
+GB,T5,"Aberdeen City"
+GB,T6,"Aberdeenshire"
+GB,T7,"Angus"
+GB,T8,"Argyll and Bute"
+GB,T9,"Scottish Borders, The"
+GB,U1,"Clackmannanshire"
+GB,U2,"Dumfries and Galloway"
+GB,U3,"Dundee City"
+GB,U4,"East Ayrshire"
+GB,U5,"East Dunbartonshire"
+GB,U6,"East Lothian"
+GB,U7,"East Renfrewshire"
+GB,U8,"Edinburgh, City of"
+GB,U9,"Falkirk"
+GB,V1,"Fife"
+GB,V2,"Glasgow City"
+GB,V3,"Highland"
+GB,V4,"Inverclyde"
+GB,V5,"Midlothian"
+GB,V6,"Moray"
+GB,V7,"North Ayrshire"
+GB,V8,"North Lanarkshire"
+GB,V9,"Orkney"
+GB,W1,"Perth and Kinross"
+GB,W2,"Renfrewshire"
+GB,W3,"Shetland Islands"
+GB,W4,"South Ayrshire"
+GB,W5,"South Lanarkshire"
+GB,W6,"Stirling"
+GB,W7,"West Dunbartonshire"
+GB,W8,"Eilean Siar"
+GB,W9,"West Lothian"
+GB,X1,"Isle of Anglesey"
+GB,X2,"Blaenau Gwent"
+GB,X3,"Bridgend"
+GB,X4,"Caerphilly"
+GB,X5,"Cardiff"
+GB,X6,"Ceredigion"
+GB,X7,"Carmarthenshire"
+GB,X8,"Conwy"
+GB,X9,"Denbighshire"
+GB,Y1,"Flintshire"
+GB,Y2,"Gwynedd"
+GB,Y3,"Merthyr Tydfil"
+GB,Y4,"Monmouthshire"
+GB,Y5,"Neath Port Talbot"
+GB,Y6,"Newport"
+GB,Y7,"Pembrokeshire"
+GB,Y8,"Powys"
+GB,Y9,"Rhondda Cynon Taff"
+GB,Z1,"Swansea"
+GB,Z2,"Torfaen"
+GB,Z3,"Vale of Glamorgan, The"
+GB,Z4,"Wrexham"
+GD,01,"Saint Andrew"
+GD,02,"Saint David"
+GD,03,"Saint George"
+GD,04,"Saint John"
+GD,05,"Saint Mark"
+GD,06,"Saint Patrick"
+GE,01,"Abashis Raioni"
+GE,02,"Abkhazia"
+GE,03,"Adigenis Raioni"
+GE,04,"Ajaria"
+GE,05,"Akhalgoris Raioni"
+GE,06,"Akhalk'alak'is Raioni"
+GE,07,"Akhalts'ikhis Raioni"
+GE,08,"Akhmetis Raioni"
+GE,09,"Ambrolauris Raioni"
+GE,10,"Aspindzis Raioni"
+GE,11,"Baghdat'is Raioni"
+GE,12,"Bolnisis Raioni"
+GE,13,"Borjomis Raioni"
+GE,14,"Chiat'ura"
+GE,15,"Ch'khorotsqus Raioni"
+GE,16,"Ch'okhatauris Raioni"
+GE,17,"Dedop'listsqaros Raioni"
+GE,18,"Dmanisis Raioni"
+GE,19,"Dushet'is Raioni"
+GE,20,"Gardabanis Raioni"
+GE,21,"Gori"
+GE,22,"Goris Raioni"
+GE,23,"Gurjaanis Raioni"
+GE,24,"Javis Raioni"
+GE,25,"K'arelis Raioni"
+GE,26,"Kaspis Raioni"
+GE,27,"Kharagaulis Raioni"
+GE,28,"Khashuris Raioni"
+GE,29,"Khobis Raioni"
+GE,30,"Khonis Raioni"
+GE,31,"K'ut'aisi"
+GE,32,"Lagodekhis Raioni"
+GE,33,"Lanch'khut'is Raioni"
+GE,34,"Lentekhis Raioni"
+GE,35,"Marneulis Raioni"
+GE,36,"Martvilis Raioni"
+GE,37,"Mestiis Raioni"
+GE,38,"Mts'khet'is Raioni"
+GE,39,"Ninotsmindis Raioni"
+GE,40,"Onis Raioni"
+GE,41,"Ozurget'is Raioni"
+GE,42,"P'ot'i"
+GE,43,"Qazbegis Raioni"
+GE,44,"Qvarlis Raioni"
+GE,45,"Rust'avi"
+GE,46,"Sach'kheris Raioni"
+GE,47,"Sagarejos Raioni"
+GE,48,"Samtrediis Raioni"
+GE,49,"Senakis Raioni"
+GE,50,"Sighnaghis Raioni"
+GE,51,"T'bilisi"
+GE,52,"T'elavis Raioni"
+GE,53,"T'erjolis Raioni"
+GE,54,"T'et'ritsqaros Raioni"
+GE,55,"T'ianet'is Raioni"
+GE,56,"Tqibuli"
+GE,57,"Ts'ageris Raioni"
+GE,58,"Tsalenjikhis Raioni"
+GE,59,"Tsalkis Raioni"
+GE,60,"Tsqaltubo"
+GE,61,"Vanis Raioni"
+GE,62,"Zestap'onis Raioni"
+GE,63,"Zugdidi"
+GE,64,"Zugdidis Raioni"
+GH,01,"Greater Accra"
+GH,02,"Ashanti"
+GH,03,"Brong-Ahafo"
+GH,04,"Central"
+GH,05,"Eastern"
+GH,06,"Northern"
+GH,08,"Volta"
+GH,09,"Western"
+GH,10,"Upper East"
+GH,11,"Upper West"
+GL,01,"Nordgronland"
+GL,02,"Ostgronland"
+GL,03,"Vestgronland"
+GM,01,"Banjul"
+GM,02,"Lower River"
+GM,03,"Central River"
+GM,04,"Upper River"
+GM,05,"Western"
+GM,07,"North Bank"
+GN,01,"Beyla"
+GN,02,"Boffa"
+GN,03,"Boke"
+GN,04,"Conakry"
+GN,05,"Dabola"
+GN,06,"Dalaba"
+GN,07,"Dinguiraye"
+GN,09,"Faranah"
+GN,10,"Forecariah"
+GN,11,"Fria"
+GN,12,"Gaoual"
+GN,13,"Gueckedou"
+GN,15,"Kerouane"
+GN,16,"Kindia"
+GN,17,"Kissidougou"
+GN,18,"Koundara"
+GN,19,"Kouroussa"
+GN,21,"Macenta"
+GN,22,"Mali"
+GN,23,"Mamou"
+GN,25,"Pita"
+GN,27,"Telimele"
+GN,28,"Tougue"
+GN,29,"Yomou"
+GN,30,"Coyah"
+GN,31,"Dubreka"
+GN,32,"Kankan"
+GN,33,"Koubia"
+GN,34,"Labe"
+GN,35,"Lelouma"
+GN,36,"Lola"
+GN,37,"Mandiana"
+GN,38,"Nzerekore"
+GN,39,"Siguiri"
+GQ,03,"Annobon"
+GQ,04,"Bioko Norte"
+GQ,05,"Bioko Sur"
+GQ,06,"Centro Sur"
+GQ,07,"Kie-Ntem"
+GQ,08,"Litoral"
+GQ,09,"Wele-Nzas"
+GR,01,"Evros"
+GR,02,"Rodhopi"
+GR,03,"Xanthi"
+GR,04,"Drama"
+GR,05,"Serrai"
+GR,06,"Kilkis"
+GR,07,"Pella"
+GR,08,"Florina"
+GR,09,"Kastoria"
+GR,10,"Grevena"
+GR,11,"Kozani"
+GR,12,"Imathia"
+GR,13,"Thessaloniki"
+GR,14,"Kavala"
+GR,15,"Khalkidhiki"
+GR,16,"Pieria"
+GR,17,"Ioannina"
+GR,18,"Thesprotia"
+GR,19,"Preveza"
+GR,20,"Arta"
+GR,21,"Larisa"
+GR,22,"Trikala"
+GR,23,"Kardhitsa"
+GR,24,"Magnisia"
+GR,25,"Kerkira"
+GR,26,"Levkas"
+GR,27,"Kefallinia"
+GR,28,"Zakinthos"
+GR,29,"Fthiotis"
+GR,30,"Evritania"
+GR,31,"Aitolia kai Akarnania"
+GR,32,"Fokis"
+GR,33,"Voiotia"
+GR,34,"Evvoia"
+GR,35,"Attiki"
+GR,36,"Argolis"
+GR,37,"Korinthia"
+GR,38,"Akhaia"
+GR,39,"Ilia"
+GR,40,"Messinia"
+GR,41,"Arkadhia"
+GR,42,"Lakonia"
+GR,43,"Khania"
+GR,44,"Rethimni"
+GR,45,"Iraklion"
+GR,46,"Lasithi"
+GR,47,"Dhodhekanisos"
+GR,48,"Samos"
+GR,49,"Kikladhes"
+GR,50,"Khios"
+GR,51,"Lesvos"
+GT,01,"Alta Verapaz"
+GT,02,"Baja Verapaz"
+GT,03,"Chimaltenango"
+GT,04,"Chiquimula"
+GT,05,"El Progreso"
+GT,06,"Escuintla"
+GT,07,"Guatemala"
+GT,08,"Huehuetenango"
+GT,09,"Izabal"
+GT,10,"Jalapa"
+GT,11,"Jutiapa"
+GT,12,"Peten"
+GT,13,"Quetzaltenango"
+GT,14,"Quiche"
+GT,15,"Retalhuleu"
+GT,16,"Sacatepequez"
+GT,17,"San Marcos"
+GT,18,"Santa Rosa"
+GT,19,"Solola"
+GT,20,"Suchitepequez"
+GT,21,"Totonicapan"
+GT,22,"Zacapa"
+GW,01,"Bafata"
+GW,02,"Quinara"
+GW,04,"Oio"
+GW,05,"Bolama"
+GW,06,"Cacheu"
+GW,07,"Tombali"
+GW,10,"Gabu"
+GW,11,"Bissau"
+GW,12,"Biombo"
+GY,10,"Barima-Waini"
+GY,11,"Cuyuni-Mazaruni"
+GY,12,"Demerara-Mahaica"
+GY,13,"East Berbice-Corentyne"
+GY,14,"Essequibo Islands-West Demerara"
+GY,15,"Mahaica-Berbice"
+GY,16,"Pomeroon-Supenaam"
+GY,17,"Potaro-Siparuni"
+GY,18,"Upper Demerara-Berbice"
+GY,19,"Upper Takutu-Upper Essequibo"
+HN,01,"Atlantida"
+HN,02,"Choluteca"
+HN,03,"Colon"
+HN,04,"Comayagua"
+HN,05,"Copan"
+HN,06,"Cortes"
+HN,07,"El Paraiso"
+HN,08,"Francisco Morazan"
+HN,09,"Gracias a Dios"
+HN,10,"Intibuca"
+HN,11,"Islas de la Bahia"
+HN,12,"La Paz"
+HN,13,"Lempira"
+HN,14,"Ocotepeque"
+HN,15,"Olancho"
+HN,16,"Santa Barbara"
+HN,17,"Valle"
+HN,18,"Yoro"
+HR,01,"Bjelovarsko-Bilogorska"
+HR,02,"Brodsko-Posavska"
+HR,03,"Dubrovacko-Neretvanska"
+HR,04,"Istarska"
+HR,05,"Karlovacka"
+HR,06,"Koprivnicko-Krizevacka"
+HR,07,"Krapinsko-Zagorska"
+HR,08,"Licko-Senjska"
+HR,09,"Medimurska"
+HR,10,"Osjecko-Baranjska"
+HR,11,"Pozesko-Slavonska"
+HR,12,"Primorsko-Goranska"
+HR,13,"Sibensko-Kninska"
+HR,14,"Sisacko-Moslavacka"
+HR,15,"Splitsko-Dalmatinska"
+HR,16,"Varazdinska"
+HR,17,"Viroviticko-Podravska"
+HR,18,"Vukovarsko-Srijemska"
+HR,19,"Zadarska"
+HR,20,"Zagrebacka"
+HR,21,"Grad Zagreb"
+HT,03,"Nord-Ouest"
+HT,06,"Artibonite"
+HT,07,"Centre"
+HT,09,"Nord"
+HT,10,"Nord-Est"
+HT,11,"Ouest"
+HT,12,"Sud"
+HT,13,"Sud-Est"
+HT,14,"Grand' Anse"
+HT,15,"Nippes"
+HU,01,"Bacs-Kiskun"
+HU,02,"Baranya"
+HU,03,"Bekes"
+HU,04,"Borsod-Abauj-Zemplen"
+HU,05,"Budapest"
+HU,06,"Csongrad"
+HU,07,"Debrecen"
+HU,08,"Fejer"
+HU,09,"Gyor-Moson-Sopron"
+HU,10,"Hajdu-Bihar"
+HU,11,"Heves"
+HU,12,"Komarom-Esztergom"
+HU,13,"Miskolc"
+HU,14,"Nograd"
+HU,15,"Pecs"
+HU,16,"Pest"
+HU,17,"Somogy"
+HU,18,"Szabolcs-Szatmar-Bereg"
+HU,19,"Szeged"
+HU,20,"Jasz-Nagykun-Szolnok"
+HU,21,"Tolna"
+HU,22,"Vas"
+HU,23,"Veszprem"
+HU,24,"Zala"
+HU,25,"Gyor"
+HU,26,"Bekescsaba"
+HU,27,"Dunaujvaros"
+HU,28,"Eger"
+HU,29,"Hodmezovasarhely"
+HU,30,"Kaposvar"
+HU,31,"Kecskemet"
+HU,32,"Nagykanizsa"
+HU,33,"Nyiregyhaza"
+HU,34,"Sopron"
+HU,35,"Szekesfehervar"
+HU,36,"Szolnok"
+HU,37,"Szombathely"
+HU,38,"Tatabanya"
+HU,39,"Veszprem"
+HU,40,"Zalaegerszeg"
+HU,41,"Salgotarjan"
+HU,42,"Szekszard"
+ID,01,"Aceh"
+ID,02,"Bali"
+ID,03,"Bengkulu"
+ID,04,"Jakarta Raya"
+ID,05,"Jambi"
+ID,06,"Jawa Barat"
+ID,07,"Jawa Tengah"
+ID,08,"Jawa Timur"
+ID,09,"Papua"
+ID,10,"Yogyakarta"
+ID,11,"Kalimantan Barat"
+ID,12,"Kalimantan Selatan"
+ID,13,"Kalimantan Tengah"
+ID,14,"Kalimantan Timur"
+ID,15,"Lampung"
+ID,16,"Maluku"
+ID,17,"Nusa Tenggara Barat"
+ID,18,"Nusa Tenggara Timur"
+ID,19,"Riau"
+ID,20,"Sulawesi Selatan"
+ID,21,"Sulawesi Tengah"
+ID,22,"Sulawesi Tenggara"
+ID,23,"Sulawesi Utara"
+ID,24,"Sumatera Barat"
+ID,25,"Sumatera Selatan"
+ID,26,"Sumatera Utara"
+ID,28,"Maluku"
+ID,29,"Maluku Utara"
+ID,30,"Jawa Barat"
+ID,31,"Sulawesi Utara"
+ID,32,"Sumatera Selatan"
+ID,33,"Banten"
+ID,34,"Gorontalo"
+ID,35,"Kepulauan Bangka Belitung"
+ID,36,"Papua"
+ID,37,"Riau"
+ID,38,"Sulawesi Selatan"
+ID,39,"Irian Jaya Barat"
+ID,40,"Kepulauan Riau"
+ID,41,"Sulawesi Barat"
+IE,01,"Carlow"
+IE,02,"Cavan"
+IE,03,"Clare"
+IE,04,"Cork"
+IE,06,"Donegal"
+IE,07,"Dublin"
+IE,10,"Galway"
+IE,11,"Kerry"
+IE,12,"Kildare"
+IE,13,"Kilkenny"
+IE,14,"Leitrim"
+IE,15,"Laois"
+IE,16,"Limerick"
+IE,18,"Longford"
+IE,19,"Louth"
+IE,20,"Mayo"
+IE,21,"Meath"
+IE,22,"Monaghan"
+IE,23,"Offaly"
+IE,24,"Roscommon"
+IE,25,"Sligo"
+IE,26,"Tipperary"
+IE,27,"Waterford"
+IE,29,"Westmeath"
+IE,30,"Wexford"
+IE,31,"Wicklow"
+IL,01,"HaDarom"
+IL,02,"HaMerkaz"
+IL,03,"HaZafon"
+IL,04,"Hefa"
+IL,05,"Tel Aviv"
+IL,06,"Yerushalayim"
+IN,01,"Andaman and Nicobar Islands"
+IN,02,"Andhra Pradesh"
+IN,03,"Assam"
+IN,05,"Chandigarh"
+IN,06,"Dadra and Nagar Haveli"
+IN,07,"Delhi"
+IN,09,"Gujarat"
+IN,10,"Haryana"
+IN,11,"Himachal Pradesh"
+IN,12,"Jammu and Kashmir"
+IN,13,"Kerala"
+IN,14,"Lakshadweep"
+IN,16,"Maharashtra"
+IN,17,"Manipur"
+IN,18,"Meghalaya"
+IN,19,"Karnataka"
+IN,20,"Nagaland"
+IN,21,"Orissa"
+IN,22,"Puducherry"
+IN,23,"Punjab"
+IN,24,"Rajasthan"
+IN,25,"Tamil Nadu"
+IN,26,"Tripura"
+IN,28,"West Bengal"
+IN,29,"Sikkim"
+IN,30,"Arunachal Pradesh"
+IN,31,"Mizoram"
+IN,32,"Daman and Diu"
+IN,33,"Goa"
+IN,34,"Bihar"
+IN,35,"Madhya Pradesh"
+IN,36,"Uttar Pradesh"
+IN,37,"Chhattisgarh"
+IN,38,"Jharkhand"
+IN,39,"Uttarakhand"
+IQ,01,"Al Anbar"
+IQ,02,"Al Basrah"
+IQ,03,"Al Muthanna"
+IQ,04,"Al Qadisiyah"
+IQ,05,"As Sulaymaniyah"
+IQ,06,"Babil"
+IQ,07,"Baghdad"
+IQ,08,"Dahuk"
+IQ,09,"Dhi Qar"
+IQ,10,"Diyala"
+IQ,11,"Arbil"
+IQ,12,"Karbala'"
+IQ,13,"At Ta'mim"
+IQ,14,"Maysan"
+IQ,15,"Ninawa"
+IQ,16,"Wasit"
+IQ,17,"An Najaf"
+IQ,18,"Salah ad Din"
+IR,01,"Azarbayjan-e Bakhtari"
+IR,02,"Azarbayjan-e Khavari"
+IR,03,"Chahar Mahall va Bakhtiari"
+IR,04,"Sistan va Baluchestan"
+IR,05,"Kohkiluyeh va Buyer Ahmadi"
+IR,07,"Fars"
+IR,08,"Gilan"
+IR,09,"Hamadan"
+IR,10,"Ilam"
+IR,11,"Hormozgan"
+IR,12,"Kerman"
+IR,13,"Bakhtaran"
+IR,15,"Khuzestan"
+IR,16,"Kordestan"
+IR,17,"Mazandaran"
+IR,18,"Semnān Province"
+IR,19,"Markazi"
+IR,21,"Zanjan"
+IR,22,"Bushehr"
+IR,23,"Lorestan"
+IR,24,"Markazi"
+IR,25,"Semnan"
+IR,26,"Tehran"
+IR,27,"Zanjan"
+IR,28,"Esfahan"
+IR,29,"Kerman"
+IR,30,"Khorasan"
+IR,31,"Yazd"
+IR,32,"Ardabil"
+IR,33,"East Azarbaijan"
+IR,34,"Markazi"
+IR,35,"Mazandaran"
+IR,36,"Zanjan"
+IR,37,"Golestan"
+IR,38,"Qazvin"
+IR,39,"Qom"
+IR,40,"Yazd"
+IR,41,"Khorasan-e Janubi"
+IR,42,"Khorasan-e Razavi"
+IR,43,"Khorasan-e Shemali"
+IS,03,"Arnessysla"
+IS,05,"Austur-Hunavatnssysla"
+IS,06,"Austur-Skaftafellssysla"
+IS,07,"Borgarfjardarsysla"
+IS,09,"Eyjafjardarsysla"
+IS,10,"Gullbringusysla"
+IS,15,"Kjosarsysla"
+IS,17,"Myrasysla"
+IS,20,"Nordur-Mulasysla"
+IS,21,"Nordur-Tingeyjarsysla"
+IS,23,"Rangarvallasysla"
+IS,28,"Skagafjardarsysla"
+IS,29,"Snafellsnes- og Hnappadalssysla"
+IS,31,"Sudur-Mulasysla"
+IS,32,"Sudur-Tingeyjarsysla"
+IS,34,"Vestur-Bardastrandarsysla"
+IS,35,"Vestur-Hunavatnssysla"
+IS,36,"Vestur-Isafjardarsysla"
+IS,37,"Vestur-Skaftafellssysla"
+IS,40,"Norourland Eystra"
+IS,41,"Norourland Vestra"
+IS,42,"Suourland"
+IS,43,"Suournes"
+IS,44,"Vestfiroir"
+IS,45,"Vesturland"
+IT,01,"Abruzzi"
+IT,02,"Basilicata"
+IT,03,"Calabria"
+IT,04,"Campania"
+IT,05,"Emilia-Romagna"
+IT,06,"Friuli-Venezia Giulia"
+IT,07,"Lazio"
+IT,08,"Liguria"
+IT,09,"Lombardia"
+IT,10,"Marche"
+IT,11,"Molise"
+IT,12,"Piemonte"
+IT,13,"Puglia"
+IT,14,"Sardegna"
+IT,15,"Sicilia"
+IT,16,"Toscana"
+IT,17,"Trentino-Alto Adige"
+IT,18,"Umbria"
+IT,19,"Valle d'Aosta"
+IT,20,"Veneto"
+JM,01,"Clarendon"
+JM,02,"Hanover"
+JM,04,"Manchester"
+JM,07,"Portland"
+JM,08,"Saint Andrew"
+JM,09,"Saint Ann"
+JM,10,"Saint Catherine"
+JM,11,"Saint Elizabeth"
+JM,12,"Saint James"
+JM,13,"Saint Mary"
+JM,14,"Saint Thomas"
+JM,15,"Trelawny"
+JM,16,"Westmoreland"
+JM,17,"Kingston"
+JO,02,"Al Balqa'"
+JO,07,"Ma"
+JO,09,"Al Karak"
+JO,10,"Al Mafraq"
+JO,11,"Amman Governorate"
+JO,12,"At Tafilah"
+JO,13,"Az Zarqa"
+JO,14,"Irbid"
+JO,16,"Amman"
+JP,01,"Aichi"
+JP,02,"Akita"
+JP,03,"Aomori"
+JP,04,"Chiba"
+JP,05,"Ehime"
+JP,06,"Fukui"
+JP,07,"Fukuoka"
+JP,08,"Fukushima"
+JP,09,"Gifu"
+JP,10,"Gumma"
+JP,11,"Hiroshima"
+JP,12,"Hokkaido"
+JP,13,"Hyogo"
+JP,14,"Ibaraki"
+JP,15,"Ishikawa"
+JP,16,"Iwate"
+JP,17,"Kagawa"
+JP,18,"Kagoshima"
+JP,19,"Kanagawa"
+JP,20,"Kochi"
+JP,21,"Kumamoto"
+JP,22,"Kyoto"
+JP,23,"Mie"
+JP,24,"Miyagi"
+JP,25,"Miyazaki"
+JP,26,"Nagano"
+JP,27,"Nagasaki"
+JP,28,"Nara"
+JP,29,"Niigata"
+JP,30,"Oita"
+JP,31,"Okayama"
+JP,32,"Osaka"
+JP,33,"Saga"
+JP,34,"Saitama"
+JP,35,"Shiga"
+JP,36,"Shimane"
+JP,37,"Shizuoka"
+JP,38,"Tochigi"
+JP,39,"Tokushima"
+JP,40,"Tokyo"
+JP,41,"Tottori"
+JP,42,"Toyama"
+JP,43,"Wakayama"
+JP,44,"Yamagata"
+JP,45,"Yamaguchi"
+JP,46,"Yamanashi"
+JP,47,"Okinawa"
+KE,01,"Central"
+KE,02,"Coast"
+KE,03,"Eastern"
+KE,05,"Nairobi Area"
+KE,06,"North-Eastern"
+KE,07,"Nyanza"
+KE,08,"Rift Valley"
+KE,09,"Western"
+KG,01,"Bishkek"
+KG,02,"Chuy"
+KG,03,"Jalal-Abad"
+KG,04,"Naryn"
+KG,05,"Osh"
+KG,06,"Talas"
+KG,07,"Ysyk-Kol"
+KG,08,"Osh"
+KG,09,"Batken"
+KH,02,"Kampong Cham"
+KH,03,"Kampong Chhnang"
+KH,04,"Kampong Spoe"
+KH,05,"Kampong Thum"
+KH,06,"Kampot"
+KH,07,"Kandal"
+KH,08,"Kaoh Kong"
+KH,09,"Kracheh"
+KH,10,"Mondol Kiri"
+KH,11,"Phnum Penh"
+KH,12,"Pouthisat"
+KH,13,"Preah Vihear"
+KH,14,"Prey Veng"
+KH,15,"Rotanokiri"
+KH,16,"Siemreab-Otdar Meanchey"
+KH,17,"Stoeng Treng"
+KH,18,"Svay Rieng"
+KH,19,"Takev"
+KH,29,"Batdambang"
+KH,30,"Pailin"
+KI,01,"Gilbert Islands"
+KI,02,"Line Islands"
+KI,03,"Phoenix Islands"
+KM,01,"Anjouan"
+KM,02,"Grande Comore"
+KM,03,"Moheli"
+KN,01,"Christ Church Nichola Town"
+KN,02,"Saint Anne Sandy Point"
+KN,03,"Saint George Basseterre"
+KN,04,"Saint George Gingerland"
+KN,05,"Saint James Windward"
+KN,06,"Saint John Capisterre"
+KN,07,"Saint John Figtree"
+KN,08,"Saint Mary Cayon"
+KN,09,"Saint Paul Capisterre"
+KN,10,"Saint Paul Charlestown"
+KN,11,"Saint Peter Basseterre"
+KN,12,"Saint Thomas Lowland"
+KN,13,"Saint Thomas Middle Island"
+KN,15,"Trinity Palmetto Point"
+KP,01,"Chagang-do"
+KP,03,"Hamgyong-namdo"
+KP,06,"Hwanghae-namdo"
+KP,07,"Hwanghae-bukto"
+KP,08,"Kaesong-si"
+KP,09,"Kangwon-do"
+KP,11,"P'yongan-bukto"
+KP,12,"P'yongyang-si"
+KP,13,"Yanggang-do"
+KP,14,"Namp'o-si"
+KP,15,"P'yongan-namdo"
+KP,17,"Hamgyong-bukto"
+KP,18,"Najin Sonbong-si"
+KR,01,"Cheju-do"
+KR,03,"Cholla-bukto"
+KR,05,"Ch'ungch'ong-bukto"
+KR,06,"Kangwon-do"
+KR,10,"Pusan-jikhalsi"
+KR,11,"Seoul-t'ukpyolsi"
+KR,12,"Inch'on-jikhalsi"
+KR,13,"Kyonggi-do"
+KR,14,"Kyongsang-bukto"
+KR,15,"Taegu-jikhalsi"
+KR,16,"Cholla-namdo"
+KR,17,"Ch'ungch'ong-namdo"
+KR,18,"Kwangju-jikhalsi"
+KR,19,"Taejon-jikhalsi"
+KR,20,"Kyongsang-namdo"
+KR,21,"Ulsan-gwangyoksi"
+KW,01,"Al Ahmadi"
+KW,02,"Al Kuwayt"
+KW,05,"Al Jahra"
+KW,07,"Al Farwaniyah"
+KW,08,"Hawalli"
+KW,09,"Mubarak al Kabir"
+KY,01,"Creek"
+KY,02,"Eastern"
+KY,03,"Midland"
+KY,04,"South Town"
+KY,05,"Spot Bay"
+KY,06,"Stake Bay"
+KY,07,"West End"
+KY,08,"Western"
+KZ,01,"Almaty"
+KZ,02,"Almaty City"
+KZ,03,"Aqmola"
+KZ,04,"Aqtobe"
+KZ,05,"Astana"
+KZ,06,"Atyrau"
+KZ,07,"West Kazakhstan"
+KZ,08,"Bayqonyr"
+KZ,09,"Mangghystau"
+KZ,10,"South Kazakhstan"
+KZ,11,"Pavlodar"
+KZ,12,"Qaraghandy"
+KZ,13,"Qostanay"
+KZ,14,"Qyzylorda"
+KZ,15,"East Kazakhstan"
+KZ,16,"North Kazakhstan"
+KZ,17,"Zhambyl"
+LA,01,"Attapu"
+LA,02,"Champasak"
+LA,03,"Houaphan"
+LA,04,"Khammouan"
+LA,05,"Louang Namtha"
+LA,07,"Oudomxai"
+LA,08,"Phongsali"
+LA,09,"Saravan"
+LA,10,"Savannakhet"
+LA,11,"Vientiane"
+LA,13,"Xaignabouri"
+LA,14,"Xiangkhoang"
+LA,17,"Louangphrabang"
+LB,01,"Beqaa"
+LB,03,"Liban-Nord"
+LB,04,"Beyrouth"
+LB,05,"Mont-Liban"
+LB,06,"Liban-Sud"
+LB,07,"Nabatiye"
+LB,08,"Beqaa"
+LB,09,"Liban-Nord"
+LB,10,"Aakk,r"
+LB,11,"Baalbek-Hermel"
+LC,01,"Anse-la-Raye"
+LC,02,"Dauphin"
+LC,03,"Castries"
+LC,04,"Choiseul"
+LC,05,"Dennery"
+LC,06,"Gros-Islet"
+LC,07,"Laborie"
+LC,08,"Micoud"
+LC,09,"Soufriere"
+LC,10,"Vieux-Fort"
+LC,11,"Praslin"
+LI,01,"Balzers"
+LI,02,"Eschen"
+LI,03,"Gamprin"
+LI,04,"Mauren"
+LI,05,"Planken"
+LI,06,"Ruggell"
+LI,07,"Schaan"
+LI,08,"Schellenberg"
+LI,09,"Triesen"
+LI,10,"Triesenberg"
+LI,11,"Vaduz"
+LI,21,"Gbarpolu"
+LI,22,"River Gee"
+LK,01,"Amparai"
+LK,02,"Anuradhapura"
+LK,03,"Badulla"
+LK,04,"Batticaloa"
+LK,06,"Galle"
+LK,07,"Hambantota"
+LK,09,"Kalutara"
+LK,10,"Kandy"
+LK,11,"Kegalla"
+LK,12,"Kurunegala"
+LK,14,"Matale"
+LK,15,"Matara"
+LK,16,"Moneragala"
+LK,17,"Nuwara Eliya"
+LK,18,"Polonnaruwa"
+LK,19,"Puttalam"
+LK,20,"Ratnapura"
+LK,21,"Trincomalee"
+LK,23,"Colombo"
+LK,24,"Gampaha"
+LK,25,"Jaffna"
+LK,26,"Mannar"
+LK,27,"Mullaittivu"
+LK,28,"Vavuniya"
+LK,29,"Central"
+LK,30,"North Central"
+LK,31,"Northern"
+LK,32,"North Western"
+LK,33,"Sabaragamuwa"
+LK,34,"Southern"
+LK,35,"Uva"
+LK,36,"Western"
+LR,01,"Bong"
+LR,04,"Grand Cape Mount"
+LR,06,"Maryland"
+LR,07,"Monrovia"
+LR,09,"Nimba"
+LR,10,"Sino"
+LR,11,"Grand Bassa"
+LR,14,"Montserrado"
+LR,19,"Grand Gedeh"
+LR,20,"Lofa"
+LS,10,"Berea"
+LS,11,"Butha-Buthe"
+LS,12,"Leribe"
+LS,13,"Mafeteng"
+LS,14,"Maseru"
+LS,15,"Mohales Hoek"
+LS,16,"Mokhotlong"
+LS,17,"Qachas Nek"
+LS,18,"Quthing"
+LS,19,"Thaba-Tseka"
+LT,56,"Alytaus Apskritis"
+LT,57,"Kauno Apskritis"
+LT,58,"Klaipedos Apskritis"
+LT,59,"Marijampoles Apskritis"
+LT,60,"Panevezio Apskritis"
+LT,61,"Siauliu Apskritis"
+LT,62,"Taurages Apskritis"
+LT,63,"Telsiu Apskritis"
+LT,64,"Utenos Apskritis"
+LT,65,"Vilniaus Apskritis"
+LU,01,"Diekirch"
+LU,02,"Grevenmacher"
+LU,03,"Luxembourg"
+LV,01,"Aizkraukles"
+LV,02,"Aluksnes"
+LV,03,"Balvu"
+LV,04,"Bauskas"
+LV,05,"Cesu"
+LV,06,"Daugavpils"
+LV,07,"Daugavpils"
+LV,08,"Dobeles"
+LV,09,"Gulbenes"
+LV,10,"Jekabpils"
+LV,11,"Jelgava"
+LV,12,"Jelgavas"
+LV,13,"Jurmala"
+LV,14,"Kraslavas"
+LV,15,"Kuldigas"
+LV,16,"Liepaja"
+LV,17,"Liepajas"
+LV,18,"Limbazu"
+LV,19,"Ludzas"
+LV,20,"Madonas"
+LV,21,"Ogres"
+LV,22,"Preilu"
+LV,23,"Rezekne"
+LV,24,"Rezeknes"
+LV,25,"Riga"
+LV,26,"Rigas"
+LV,27,"Saldus"
+LV,28,"Talsu"
+LV,29,"Tukuma"
+LV,30,"Valkas"
+LV,31,"Valmieras"
+LV,32,"Ventspils"
+LV,33,"Ventspils"
+LY,03,"Al Aziziyah"
+LY,05,"Al Jufrah"
+LY,08,"Al Kufrah"
+LY,13,"Ash Shati'"
+LY,30,"Murzuq"
+LY,34,"Sabha"
+LY,41,"Tarhunah"
+LY,42,"Tubruq"
+LY,45,"Zlitan"
+LY,47,"Ajdabiya"
+LY,48,"Al Fatih"
+LY,49,"Al Jabal al Akhdar"
+LY,50,"Al Khums"
+LY,51,"An Nuqat al Khams"
+LY,52,"Awbari"
+LY,53,"Az Zawiyah"
+LY,54,"Banghazi"
+LY,55,"Darnah"
+LY,56,"Ghadamis"
+LY,57,"Gharyan"
+LY,58,"Misratah"
+LY,59,"Sawfajjin"
+LY,60,"Surt"
+LY,61,"Tarabulus"
+LY,62,"Yafran"
+MA,01,"Agadir"
+MA,02,"Al Hoceima"
+MA,03,"Azilal"
+MA,04,"Ben Slimane"
+MA,05,"Beni Mellal"
+MA,06,"Boulemane"
+MA,07,"Casablanca"
+MA,08,"Chaouen"
+MA,09,"El Jadida"
+MA,10,"El Kelaa des Srarhna"
+MA,11,"Er Rachidia"
+MA,12,"Essaouira"
+MA,13,"Fes"
+MA,14,"Figuig"
+MA,15,"Kenitra"
+MA,16,"Khemisset"
+MA,17,"Khenifra"
+MA,18,"Khouribga"
+MA,19,"Marrakech"
+MA,20,"Meknes"
+MA,21,"Nador"
+MA,22,"Ouarzazate"
+MA,23,"Oujda"
+MA,24,"Rabat-Sale"
+MA,25,"Safi"
+MA,26,"Settat"
+MA,27,"Tanger"
+MA,29,"Tata"
+MA,30,"Taza"
+MA,32,"Tiznit"
+MA,33,"Guelmim"
+MA,34,"Ifrane"
+MA,35,"Laayoune"
+MA,36,"Tan-Tan"
+MA,37,"Taounate"
+MA,38,"Sidi Kacem"
+MA,39,"Taroudannt"
+MA,40,"Tetouan"
+MA,41,"Larache"
+MA,45,"Grand Casablanca"
+MA,46,"Fes-Boulemane"
+MA,47,"Marrakech-Tensift-Al Haouz"
+MA,48,"Meknes-Tafilalet"
+MA,49,"Rabat-Sale-Zemmour-Zaer"
+MA,50,"Chaouia-Ouardigha"
+MA,51,"Doukkala-Abda"
+MA,52,"Gharb-Chrarda-Beni Hssen"
+MA,53,"Guelmim-Es Smara"
+MA,54,"Oriental"
+MA,55,"Souss-Massa-Dr,a"
+MA,56,"Tadla-Azilal"
+MA,57,"Tanger-Tetouan"
+MA,58,"Taza-Al Hoceima-Taounate"
+MA,59,"La,youne-Boujdour-Sakia El Hamra"
+MC,01,"La Condamine"
+MC,02,"Monaco"
+MC,03,"Monte-Carlo"
+MD,46,"Balti"
+MD,47,"Cahul"
+MD,48,"Chisinau"
+MD,49,"Stinga Nistrului"
+MD,50,"Edinet"
+MD,51,"Gagauzia"
+MD,52,"Lapusna"
+MD,53,"Orhei"
+MD,54,"Soroca"
+MD,55,"Tighina"
+MD,56,"Ungheni"
+MD,58,"Stinga Nistrului"
+MD,59,"Anenii Noi"
+MD,60,"Balti"
+MD,61,"Basarabeasca"
+MD,62,"Bender"
+MD,63,"Briceni"
+MD,64,"Cahul"
+MD,65,"Cantemir"
+MD,66,"Calarasi"
+MD,67,"Causeni"
+MD,68,"Cimislia"
+MD,69,"Criuleni"
+MD,70,"Donduseni"
+MD,71,"Drochia"
+MD,72,"Dubasari"
+MD,73,"Edinet"
+MD,74,"Falesti"
+MD,75,"Floresti"
+MD,76,"Glodeni"
+MD,77,"Hincesti"
+MD,78,"Ialoveni"
+MD,79,"Leova"
+MD,80,"Nisporeni"
+MD,81,"Ocnita"
+MD,83,"Rezina"
+MD,84,"Riscani"
+MD,85,"Singerei"
+MD,86,"Soldanesti"
+MD,87,"Soroca"
+MD,88,"Stefan-Voda"
+MD,89,"Straseni"
+MD,90,"Taraclia"
+MD,91,"Telenesti"
+MD,92,"Ungheni"
+MG,01,"Antsiranana"
+MG,02,"Fianarantsoa"
+MG,03,"Mahajanga"
+MG,04,"Toamasina"
+MG,05,"Antananarivo"
+MG,06,"Toliara"
+MK,01,"Aracinovo"
+MK,02,"Bac"
+MK,03,"Belcista"
+MK,04,"Berovo"
+MK,05,"Bistrica"
+MK,06,"Bitola"
+MK,07,"Blatec"
+MK,08,"Bogdanci"
+MK,09,"Bogomila"
+MK,10,"Bogovinje"
+MK,11,"Bosilovo"
+MK,12,"Brvenica"
+MK,13,"Cair"
+MK,14,"Capari"
+MK,15,"Caska"
+MK,16,"Cegrane"
+MK,17,"Centar"
+MK,18,"Centar Zupa"
+MK,19,"Cesinovo"
+MK,20,"Cucer-Sandevo"
+MK,21,"Debar"
+MK,22,"Delcevo"
+MK,23,"Delogozdi"
+MK,24,"Demir Hisar"
+MK,25,"Demir Kapija"
+MK,26,"Dobrusevo"
+MK,27,"Dolna Banjica"
+MK,28,"Dolneni"
+MK,29,"Dorce Petrov"
+MK,30,"Drugovo"
+MK,31,"Dzepciste"
+MK,32,"Gazi Baba"
+MK,33,"Gevgelija"
+MK,34,"Gostivar"
+MK,35,"Gradsko"
+MK,36,"Ilinden"
+MK,37,"Izvor"
+MK,38,"Jegunovce"
+MK,39,"Kamenjane"
+MK,40,"Karbinci"
+MK,41,"Karpos"
+MK,42,"Kavadarci"
+MK,43,"Kicevo"
+MK,44,"Kisela Voda"
+MK,45,"Klecevce"
+MK,46,"Kocani"
+MK,47,"Konce"
+MK,48,"Kondovo"
+MK,49,"Konopiste"
+MK,50,"Kosel"
+MK,51,"Kratovo"
+MK,52,"Kriva Palanka"
+MK,53,"Krivogastani"
+MK,54,"Krusevo"
+MK,55,"Kuklis"
+MK,56,"Kukurecani"
+MK,57,"Kumanovo"
+MK,58,"Labunista"
+MK,59,"Lipkovo"
+MK,60,"Lozovo"
+MK,61,"Lukovo"
+MK,62,"Makedonska Kamenica"
+MK,63,"Makedonski Brod"
+MK,64,"Mavrovi Anovi"
+MK,65,"Meseista"
+MK,66,"Miravci"
+MK,67,"Mogila"
+MK,68,"Murtino"
+MK,69,"Negotino"
+MK,70,"Negotino-Polosko"
+MK,71,"Novaci"
+MK,72,"Novo Selo"
+MK,73,"Oblesevo"
+MK,74,"Ohrid"
+MK,75,"Orasac"
+MK,76,"Orizari"
+MK,77,"Oslomej"
+MK,78,"Pehcevo"
+MK,79,"Petrovec"
+MK,80,"Plasnica"
+MK,81,"Podares"
+MK,82,"Prilep"
+MK,83,"Probistip"
+MK,84,"Radovis"
+MK,85,"Rankovce"
+MK,86,"Resen"
+MK,87,"Rosoman"
+MK,88,"Rostusa"
+MK,89,"Samokov"
+MK,90,"Saraj"
+MK,91,"Sipkovica"
+MK,92,"Sopiste"
+MK,93,"Sopotnica"
+MK,94,"Srbinovo"
+MK,95,"Staravina"
+MK,96,"Star Dojran"
+MK,97,"Staro Nagoricane"
+MK,98,"Stip"
+MK,99,"Struga"
+MK,A1,"Strumica"
+MK,A2,"Studenicani"
+MK,A3,"Suto Orizari"
+MK,A4,"Sveti Nikole"
+MK,A5,"Tearce"
+MK,A6,"Tetovo"
+MK,A7,"Topolcani"
+MK,A8,"Valandovo"
+MK,A9,"Vasilevo"
+MK,B1,"Veles"
+MK,B2,"Velesta"
+MK,B3,"Vevcani"
+MK,B4,"Vinica"
+MK,B5,"Vitoliste"
+MK,B6,"Vranestica"
+MK,B7,"Vrapciste"
+MK,B8,"Vratnica"
+MK,B9,"Vrutok"
+MK,C1,"Zajas"
+MK,C2,"Zelenikovo"
+MK,C3,"Zelino"
+MK,C4,"Zitose"
+MK,C5,"Zletovo"
+MK,C6,"Zrnovci"
+ML,01,"Bamako"
+ML,03,"Kayes"
+ML,04,"Mopti"
+ML,05,"Segou"
+ML,06,"Sikasso"
+ML,07,"Koulikoro"
+ML,08,"Tombouctou"
+ML,09,"Gao"
+ML,10,"Kidal"
+MM,01,"Rakhine State"
+MM,02,"Chin State"
+MM,03,"Irrawaddy"
+MM,04,"Kachin State"
+MM,05,"Karan State"
+MM,06,"Kayah State"
+MM,07,"Magwe"
+MM,08,"Mandalay"
+MM,09,"Pegu"
+MM,10,"Sagaing"
+MM,11,"Shan State"
+MM,12,"Tenasserim"
+MM,13,"Mon State"
+MM,14,"Rangoon"
+MM,17,"Yangon"
+MN,01,"Arhangay"
+MN,02,"Bayanhongor"
+MN,03,"Bayan-Olgiy"
+MN,05,"Darhan"
+MN,06,"Dornod"
+MN,07,"Dornogovi"
+MN,08,"Dundgovi"
+MN,09,"Dzavhan"
+MN,10,"Govi-Altay"
+MN,11,"Hentiy"
+MN,12,"Hovd"
+MN,13,"Hovsgol"
+MN,14,"Omnogovi"
+MN,15,"Ovorhangay"
+MN,16,"Selenge"
+MN,17,"Suhbaatar"
+MN,18,"Tov"
+MN,19,"Uvs"
+MN,20,"Ulaanbaatar"
+MN,21,"Bulgan"
+MN,22,"Erdenet"
+MN,23,"Darhan-Uul"
+MN,24,"Govisumber"
+MN,25,"Orhon"
+MO,01,"Ilhas"
+MO,02,"Macau"
+MR,01,"Hodh Ech Chargui"
+MR,02,"Hodh El Gharbi"
+MR,03,"Assaba"
+MR,04,"Gorgol"
+MR,05,"Brakna"
+MR,06,"Trarza"
+MR,07,"Adrar"
+MR,08,"Dakhlet Nouadhibou"
+MR,09,"Tagant"
+MR,10,"Guidimaka"
+MR,11,"Tiris Zemmour"
+MR,12,"Inchiri"
+MS,01,"Saint Anthony"
+MS,02,"Saint Georges"
+MS,03,"Saint Peter"
+MU,12,"Black River"
+MU,13,"Flacq"
+MU,14,"Grand Port"
+MU,15,"Moka"
+MU,16,"Pamplemousses"
+MU,17,"Plaines Wilhems"
+MU,18,"Port Louis"
+MU,19,"Riviere du Rempart"
+MU,20,"Savanne"
+MU,21,"Agalega Islands"
+MU,22,"Cargados Carajos"
+MU,23,"Rodrigues"
+MV,01,"Seenu"
+MV,02,"Aliff"
+MV,03,"Laviyani"
+MV,04,"Waavu"
+MV,05,"Laamu"
+MV,07,"Haa Aliff"
+MV,08,"Thaa"
+MV,12,"Meemu"
+MV,13,"Raa"
+MV,14,"Faafu"
+MV,17,"Daalu"
+MV,20,"Baa"
+MV,23,"Haa Daalu"
+MV,24,"Shaviyani"
+MV,25,"Noonu"
+MV,26,"Kaafu"
+MV,27,"Gaafu Aliff"
+MV,28,"Gaafu Daalu"
+MV,29,"Naviyani"
+MV,40,"Male"
+MW,02,"Chikwawa"
+MW,03,"Chiradzulu"
+MW,04,"Chitipa"
+MW,05,"Thyolo"
+MW,06,"Dedza"
+MW,07,"Dowa"
+MW,08,"Karonga"
+MW,09,"Kasungu"
+MW,11,"Lilongwe"
+MW,12,"Mangochi"
+MW,13,"Mchinji"
+MW,15,"Mzimba"
+MW,16,"Ntcheu"
+MW,17,"Nkhata Bay"
+MW,18,"Nkhotakota"
+MW,19,"Nsanje"
+MW,20,"Ntchisi"
+MW,21,"Rumphi"
+MW,22,"Salima"
+MW,23,"Zomba"
+MW,24,"Blantyre"
+MW,25,"Mwanza"
+MW,26,"Balaka"
+MW,27,"Likoma"
+MW,28,"Machinga"
+MW,29,"Mulanje"
+MW,30,"Phalombe"
+MX,01,"Aguascalientes"
+MX,02,"Baja California"
+MX,03,"Baja California Sur"
+MX,04,"Campeche"
+MX,05,"Chiapas"
+MX,06,"Chihuahua"
+MX,07,"Coahuila de Zaragoza"
+MX,08,"Colima"
+MX,09,"Distrito Federal"
+MX,10,"Durango"
+MX,11,"Guanajuato"
+MX,12,"Guerrero"
+MX,13,"Hidalgo"
+MX,14,"Jalisco"
+MX,15,"Mexico"
+MX,16,"Michoacan de Ocampo"
+MX,17,"Morelos"
+MX,18,"Nayarit"
+MX,19,"Nuevo Leon"
+MX,20,"Oaxaca"
+MX,21,"Puebla"
+MX,22,"Queretaro de Arteaga"
+MX,23,"Quintana Roo"
+MX,24,"San Luis Potosi"
+MX,25,"Sinaloa"
+MX,26,"Sonora"
+MX,27,"Tabasco"
+MX,28,"Tamaulipas"
+MX,29,"Tlaxcala"
+MX,30,"Veracruz-Llave"
+MX,31,"Yucatan"
+MX,32,"Zacatecas"
+MY,01,"Johor"
+MY,02,"Kedah"
+MY,03,"Kelantan"
+MY,04,"Melaka"
+MY,05,"Negeri Sembilan"
+MY,06,"Pahang"
+MY,07,"Perak"
+MY,08,"Perlis"
+MY,09,"Pulau Pinang"
+MY,11,"Sarawak"
+MY,12,"Selangor"
+MY,13,"Terengganu"
+MY,14,"Kuala Lumpur"
+MY,15,"Labuan"
+MY,16,"Sabah"
+MY,17,"Putrajaya"
+MZ,01,"Cabo Delgado"
+MZ,02,"Gaza"
+MZ,03,"Inhambane"
+MZ,04,"Maputo"
+MZ,05,"Sofala"
+MZ,06,"Nampula"
+MZ,07,"Niassa"
+MZ,08,"Tete"
+MZ,09,"Zambezia"
+MZ,10,"Manica"
+MZ,11,"Maputo"
+NA,01,"Bethanien"
+NA,02,"Caprivi Oos"
+NA,03,"Boesmanland"
+NA,04,"Gobabis"
+NA,05,"Grootfontein"
+NA,06,"Kaokoland"
+NA,07,"Karibib"
+NA,08,"Keetmanshoop"
+NA,09,"Luderitz"
+NA,10,"Maltahohe"
+NA,11,"Okahandja"
+NA,12,"Omaruru"
+NA,13,"Otjiwarongo"
+NA,14,"Outjo"
+NA,15,"Owambo"
+NA,16,"Rehoboth"
+NA,17,"Swakopmund"
+NA,18,"Tsumeb"
+NA,20,"Karasburg"
+NA,21,"Windhoek"
+NA,22,"Damaraland"
+NA,23,"Hereroland Oos"
+NA,24,"Hereroland Wes"
+NA,25,"Kavango"
+NA,26,"Mariental"
+NA,27,"Namaland"
+NA,28,"Caprivi"
+NA,29,"Erongo"
+NA,30,"Hardap"
+NA,31,"Karas"
+NA,32,"Kunene"
+NA,33,"Ohangwena"
+NA,34,"Okavango"
+NA,35,"Omaheke"
+NA,36,"Omusati"
+NA,37,"Oshana"
+NA,38,"Oshikoto"
+NA,39,"Otjozondjupa"
+NE,01,"Agadez"
+NE,02,"Diffa"
+NE,03,"Dosso"
+NE,04,"Maradi"
+NE,05,"Niamey"
+NE,06,"Tahoua"
+NE,07,"Zinder"
+NE,08,"Niamey"
+NG,05,"Lagos"
+NG,10,"Rivers"
+NG,11,"Federal Capital Territory"
+NG,16,"Ogun"
+NG,17,"Ondo"
+NG,21,"Akwa Ibom"
+NG,22,"Cross River"
+NG,23,"Kaduna"
+NG,24,"Katsina"
+NG,25,"Anambra"
+NG,26,"Benue"
+NG,27,"Borno"
+NG,28,"Imo"
+NG,29,"Kano"
+NG,30,"Kwara"
+NG,31,"Niger"
+NG,32,"Oyo"
+NG,35,"Adamawa"
+NG,36,"Delta"
+NG,37,"Edo"
+NG,39,"Jigawa"
+NG,40,"Kebbi"
+NG,41,"Kogi"
+NG,42,"Osun"
+NG,43,"Taraba"
+NG,44,"Yobe"
+NG,45,"Abia"
+NG,46,"Bauchi"
+NG,47,"Enugu"
+NG,48,"Ondo"
+NG,49,"Plateau"
+NG,50,"Rivers"
+NG,51,"Sokoto"
+NG,52,"Bayelsa"
+NG,53,"Ebonyi"
+NG,54,"Ekiti"
+NG,55,"Gombe"
+NG,56,"Nassarawa"
+NG,57,"Zamfara"
+NI,01,"Boaco"
+NI,02,"Carazo"
+NI,03,"Chinandega"
+NI,04,"Chontales"
+NI,05,"Esteli"
+NI,06,"Granada"
+NI,07,"Jinotega"
+NI,08,"Leon"
+NI,09,"Madriz"
+NI,10,"Managua"
+NI,11,"Masaya"
+NI,12,"Matagalpa"
+NI,13,"Nueva Segovia"
+NI,14,"Rio San Juan"
+NI,15,"Rivas"
+NI,16,"Zelaya"
+NL,01,"Drenthe"
+NL,02,"Friesland"
+NL,03,"Gelderland"
+NL,04,"Groningen"
+NL,05,"Limburg"
+NL,06,"Noord-Brabant"
+NL,07,"Noord-Holland"
+NL,08,"Overijssel"
+NL,09,"Utrecht"
+NL,10,"Zeeland"
+NL,11,"Zuid-Holland"
+NL,12,"Dronten"
+NL,13,"Zuidelijke IJsselmeerpolders"
+NL,14,"Lelystad"
+NL,15,"Overijssel"
+NL,16,"Flevoland"
+NO,01,"Akershus"
+NO,02,"Aust-Agder"
+NO,04,"Buskerud"
+NO,05,"Finnmark"
+NO,06,"Hedmark"
+NO,07,"Hordaland"
+NO,08,"More og Romsdal"
+NO,09,"Nordland"
+NO,10,"Nord-Trondelag"
+NO,11,"Oppland"
+NO,12,"Oslo"
+NO,13,"Ostfold"
+NO,14,"Rogaland"
+NO,15,"Sogn og Fjordane"
+NO,16,"Sor-Trondelag"
+NO,17,"Telemark"
+NO,18,"Troms"
+NO,19,"Vest-Agder"
+NO,20,"Vestfold"
+NP,01,"Bagmati"
+NP,02,"Bheri"
+NP,03,"Dhawalagiri"
+NP,04,"Gandaki"
+NP,05,"Janakpur"
+NP,06,"Karnali"
+NP,07,"Kosi"
+NP,08,"Lumbini"
+NP,09,"Mahakali"
+NP,10,"Mechi"
+NP,11,"Narayani"
+NP,12,"Rapti"
+NP,13,"Sagarmatha"
+NP,14,"Seti"
+NR,01,"Aiwo"
+NR,02,"Anabar"
+NR,03,"Anetan"
+NR,04,"Anibare"
+NR,05,"Baiti"
+NR,06,"Boe"
+NR,07,"Buada"
+NR,08,"Denigomodu"
+NR,09,"Ewa"
+NR,10,"Ijuw"
+NR,11,"Meneng"
+NR,12,"Nibok"
+NR,13,"Uaboe"
+NR,14,"Yaren"
+NZ,10,"Chatham Islands"
+NZ,E7,"Auckland"
+NZ,E8,"Bay of Plenty"
+NZ,E9,"Canterbury"
+NZ,F1,"Gisborne"
+NZ,F2,"Hawke's Bay"
+NZ,F3,"Manawatu-Wanganui"
+NZ,F4,"Marlborough"
+NZ,F5,"Nelson"
+NZ,F6,"Northland"
+NZ,F7,"Otago"
+NZ,F8,"Southland"
+NZ,F9,"Taranaki"
+NZ,G1,"Waikato"
+NZ,G2,"Wellington"
+NZ,G3,"West Coast"
+OM,01,"Ad Dakhiliyah"
+OM,02,"Al Batinah"
+OM,03,"Al Wusta"
+OM,04,"Ash Sharqiyah"
+OM,05,"Az Zahirah"
+OM,06,"Masqat"
+OM,07,"Musandam"
+OM,08,"Zufar"
+PA,01,"Bocas del Toro"
+PA,02,"Chiriqui"
+PA,03,"Cocle"
+PA,04,"Colon"
+PA,05,"Darien"
+PA,06,"Herrera"
+PA,07,"Los Santos"
+PA,08,"Panama"
+PA,09,"San Blas"
+PA,10,"Veraguas"
+PE,01,"Amazonas"
+PE,02,"Ancash"
+PE,03,"Apurimac"
+PE,04,"Arequipa"
+PE,05,"Ayacucho"
+PE,06,"Cajamarca"
+PE,07,"Callao"
+PE,08,"Cusco"
+PE,09,"Huancavelica"
+PE,10,"Huanuco"
+PE,11,"Ica"
+PE,12,"Junin"
+PE,13,"La Libertad"
+PE,14,"Lambayeque"
+PE,15,"Lima"
+PE,16,"Loreto"
+PE,17,"Madre de Dios"
+PE,18,"Moquegua"
+PE,19,"Pasco"
+PE,20,"Piura"
+PE,21,"Puno"
+PE,22,"San Martin"
+PE,23,"Tacna"
+PE,24,"Tumbes"
+PE,25,"Ucayali"
+PG,01,"Central"
+PG,02,"Gulf"
+PG,03,"Milne Bay"
+PG,04,"Northern"
+PG,05,"Southern Highlands"
+PG,06,"Western"
+PG,07,"North Solomons"
+PG,08,"Chimbu"
+PG,09,"Eastern Highlands"
+PG,10,"East New Britain"
+PG,11,"East Sepik"
+PG,12,"Madang"
+PG,13,"Manus"
+PG,14,"Morobe"
+PG,15,"New Ireland"
+PG,16,"Western Highlands"
+PG,17,"West New Britain"
+PG,18,"Sandaun"
+PG,19,"Enga"
+PG,20,"National Capital"
+PH,01,"Abra"
+PH,02,"Agusan del Norte"
+PH,03,"Agusan del Sur"
+PH,04,"Aklan"
+PH,05,"Albay"
+PH,06,"Antique"
+PH,07,"Bataan"
+PH,08,"Batanes"
+PH,09,"Batangas"
+PH,10,"Benguet"
+PH,11,"Bohol"
+PH,12,"Bukidnon"
+PH,13,"Bulacan"
+PH,14,"Cagayan"
+PH,15,"Camarines Norte"
+PH,16,"Camarines Sur"
+PH,17,"Camiguin"
+PH,18,"Capiz"
+PH,19,"Catanduanes"
+PH,20,"Cavite"
+PH,21,"Cebu"
+PH,22,"Basilan"
+PH,23,"Eastern Samar"
+PH,24,"Davao"
+PH,25,"Davao del Sur"
+PH,26,"Davao Oriental"
+PH,27,"Ifugao"
+PH,28,"Ilocos Norte"
+PH,29,"Ilocos Sur"
+PH,30,"Iloilo"
+PH,31,"Isabela"
+PH,32,"Kalinga-Apayao"
+PH,33,"Laguna"
+PH,34,"Lanao del Norte"
+PH,35,"Lanao del Sur"
+PH,36,"La Union"
+PH,37,"Leyte"
+PH,38,"Marinduque"
+PH,39,"Masbate"
+PH,40,"Mindoro Occidental"
+PH,41,"Mindoro Oriental"
+PH,42,"Misamis Occidental"
+PH,43,"Misamis Oriental"
+PH,44,"Mountain"
+PH,46,"Negros Oriental"
+PH,47,"Nueva Ecija"
+PH,48,"Nueva Vizcaya"
+PH,49,"Palawan"
+PH,50,"Pampanga"
+PH,51,"Pangasinan"
+PH,53,"Rizal"
+PH,54,"Romblon"
+PH,55,"Samar"
+PH,56,"Maguindanao"
+PH,57,"North Cotabato"
+PH,58,"Sorsogon"
+PH,59,"Southern Leyte"
+PH,60,"Sulu"
+PH,61,"Surigao del Norte"
+PH,62,"Surigao del Sur"
+PH,63,"Tarlac"
+PH,64,"Zambales"
+PH,65,"Zamboanga del Norte"
+PH,66,"Zamboanga del Sur"
+PH,67,"Northern Samar"
+PH,68,"Quirino"
+PH,69,"Siquijor"
+PH,70,"South Cotabato"
+PH,71,"Sultan Kudarat"
+PH,72,"Tawitawi"
+PH,A1,"Angeles"
+PH,A2,"Bacolod"
+PH,A3,"Bago"
+PH,A4,"Baguio"
+PH,A5,"Bais"
+PH,A6,"Basilan City"
+PH,A7,"Batangas City"
+PH,A8,"Butuan"
+PH,A9,"Cabanatuan"
+PH,B1,"Cadiz"
+PH,B2,"Cagayan de Oro"
+PH,B3,"Calbayog"
+PH,B4,"Caloocan"
+PH,B5,"Canlaon"
+PH,B6,"Cavite City"
+PH,B7,"Cebu City"
+PH,B8,"Cotabato"
+PH,B9,"Dagupan"
+PH,C1,"Danao"
+PH,C2,"Dapitan"
+PH,C3,"Davao City"
+PH,C4,"Dipolog"
+PH,C5,"Dumaguete"
+PH,C6,"General Santos"
+PH,C7,"Gingoog"
+PH,C8,"Iligan"
+PH,C9,"Iloilo City"
+PH,D1,"Iriga"
+PH,D2,"La Carlota"
+PH,D3,"Laoag"
+PH,D4,"Lapu-Lapu"
+PH,D5,"Legaspi"
+PH,D6,"Lipa"
+PH,D7,"Lucena"
+PH,D8,"Mandaue"
+PH,D9,"Manila"
+PH,E1,"Marawi"
+PH,E2,"Naga"
+PH,E3,"Olongapo"
+PH,E4,"Ormoc"
+PH,E5,"Oroquieta"
+PH,E6,"Ozamis"
+PH,E7,"Pagadian"
+PH,E8,"Palayan"
+PH,E9,"Pasay"
+PH,F1,"Puerto Princesa"
+PH,F2,"Quezon City"
+PH,F3,"Roxas"
+PH,F4,"San Carlos"
+PH,F5,"San Carlos"
+PH,F6,"San Jose"
+PH,F7,"San Pablo"
+PH,F8,"Silay"
+PH,F9,"Surigao"
+PH,G1,"Tacloban"
+PH,G2,"Tagaytay"
+PH,G3,"Tagbilaran"
+PH,G4,"Tangub"
+PH,G5,"Toledo"
+PH,G6,"Trece Martires"
+PH,G7,"Zamboanga"
+PH,G8,"Aurora"
+PH,H2,"Quezon"
+PH,H3,"Negros Occidental"
+PK,01,"Federally Administered Tribal Areas"
+PK,02,"Balochistan"
+PK,03,"North-West Frontier"
+PK,04,"Punjab"
+PK,05,"Sindh"
+PK,06,"Azad Kashmir"
+PK,07,"Northern Areas"
+PK,08,"Islamabad"
+PL,23,"Biala Podlaska"
+PL,24,"Bialystok"
+PL,25,"Bielsko"
+PL,26,"Bydgoszcz"
+PL,27,"Chelm"
+PL,28,"Ciechanow"
+PL,29,"Czestochowa"
+PL,30,"Elblag"
+PL,31,"Gdansk"
+PL,32,"Gorzow"
+PL,33,"Jelenia Gora"
+PL,34,"Kalisz"
+PL,35,"Katowice"
+PL,36,"Kielce"
+PL,37,"Konin"
+PL,38,"Koszalin"
+PL,39,"Krakow"
+PL,40,"Krosno"
+PL,41,"Legnica"
+PL,42,"Leszno"
+PL,43,"Lodz"
+PL,44,"Lomza"
+PL,45,"Lublin"
+PL,46,"Nowy Sacz"
+PL,47,"Olsztyn"
+PL,48,"Opole"
+PL,49,"Ostroleka"
+PL,50,"Pila"
+PL,51,"Piotrkow"
+PL,52,"Plock"
+PL,53,"Poznan"
+PL,54,"Przemysl"
+PL,55,"Radom"
+PL,56,"Rzeszow"
+PL,57,"Siedlce"
+PL,58,"Sieradz"
+PL,59,"Skierniewice"
+PL,60,"Slupsk"
+PL,61,"Suwalki"
+PL,62,"Szczecin"
+PL,63,"Tarnobrzeg"
+PL,64,"Tarnow"
+PL,65,"Torun"
+PL,66,"Walbrzych"
+PL,67,"Warszawa"
+PL,68,"Wloclawek"
+PL,69,"Wroclaw"
+PL,70,"Zamosc"
+PL,71,"Zielona Gora"
+PL,72,"Dolnoslaskie"
+PL,73,"Kujawsko-Pomorskie"
+PL,74,"Lodzkie"
+PL,75,"Lubelskie"
+PL,76,"Lubuskie"
+PL,77,"Malopolskie"
+PL,78,"Mazowieckie"
+PL,79,"Opolskie"
+PL,80,"Podkarpackie"
+PL,81,"Podlaskie"
+PL,82,"Pomorskie"
+PL,83,"Slaskie"
+PL,84,"Swietokrzyskie"
+PL,85,"Warminsko-Mazurskie"
+PL,86,"Wielkopolskie"
+PL,87,"Zachodniopomorskie"
+PS,GZ,"Gaza"
+PS,WE,"West Bank"
+PT,02,"Aveiro"
+PT,03,"Beja"
+PT,04,"Braga"
+PT,05,"Braganca"
+PT,06,"Castelo Branco"
+PT,07,"Coimbra"
+PT,08,"Evora"
+PT,09,"Faro"
+PT,10,"Madeira"
+PT,11,"Guarda"
+PT,13,"Leiria"
+PT,14,"Lisboa"
+PT,16,"Portalegre"
+PT,17,"Porto"
+PT,18,"Santarem"
+PT,19,"Setubal"
+PT,20,"Viana do Castelo"
+PT,21,"Vila Real"
+PT,22,"Viseu"
+PT,23,"Azores"
+PY,01,"Alto Parana"
+PY,02,"Amambay"
+PY,03,"Boqueron"
+PY,04,"Caaguazu"
+PY,05,"Caazapa"
+PY,06,"Central"
+PY,07,"Concepcion"
+PY,08,"Cordillera"
+PY,10,"Guaira"
+PY,11,"Itapua"
+PY,12,"Misiones"
+PY,13,"Neembucu"
+PY,15,"Paraguari"
+PY,16,"Presidente Hayes"
+PY,17,"San Pedro"
+PY,19,"Canindeyu"
+PY,20,"Chaco"
+PY,21,"Nueva Asuncion"
+PY,23,"Alto Paraguay"
+QA,01,"Ad Dawhah"
+QA,02,"Al Ghuwariyah"
+QA,03,"Al Jumaliyah"
+QA,04,"Al Khawr"
+QA,05,"Al Wakrah Municipality"
+QA,06,"Ar Rayyan"
+QA,08,"Madinat ach Shamal"
+QA,09,"Umm Salal"
+QA,10,"Al Wakrah"
+QA,11,"Jariyan al Batnah"
+QA,12,"Umm Sa'id"
+RO,01,"Alba"
+RO,02,"Arad"
+RO,03,"Arges"
+RO,04,"Bacau"
+RO,05,"Bihor"
+RO,06,"Bistrita-Nasaud"
+RO,07,"Botosani"
+RO,08,"Braila"
+RO,09,"Brasov"
+RO,10,"Bucuresti"
+RO,11,"Buzau"
+RO,12,"Caras-Severin"
+RO,13,"Cluj"
+RO,14,"Constanta"
+RO,15,"Covasna"
+RO,16,"Dambovita"
+RO,17,"Dolj"
+RO,18,"Galati"
+RO,19,"Gorj"
+RO,20,"Harghita"
+RO,21,"Hunedoara"
+RO,22,"Ialomita"
+RO,23,"Iasi"
+RO,25,"Maramures"
+RO,26,"Mehedinti"
+RO,27,"Mures"
+RO,28,"Neamt"
+RO,29,"Olt"
+RO,30,"Prahova"
+RO,31,"Salaj"
+RO,32,"Satu Mare"
+RO,33,"Sibiu"
+RO,34,"Suceava"
+RO,35,"Teleorman"
+RO,36,"Timis"
+RO,37,"Tulcea"
+RO,38,"Vaslui"
+RO,39,"Valcea"
+RO,40,"Vrancea"
+RO,41,"Calarasi"
+RO,42,"Giurgiu"
+RO,43,"Ilfov"
+RS,00,"Serbia proper"
+RS,01,"Kosovo"
+RS,02,"Vojvodina"
+RU,01,"Adygeya, Republic of"
+RU,02,"Aginsky Buryatsky AO"
+RU,03,"Gorno-Altay"
+RU,04,"Altaisky krai"
+RU,05,"Amur"
+RU,06,"Arkhangel'sk"
+RU,07,"Astrakhan'"
+RU,08,"Bashkortostan"
+RU,09,"Belgorod"
+RU,10,"Bryansk"
+RU,11,"Buryat"
+RU,12,"Chechnya"
+RU,13,"Chelyabinsk"
+RU,14,"Chita"
+RU,15,"Chukot"
+RU,16,"Chuvashia"
+RU,17,"Dagestan"
+RU,18,"Evenk"
+RU,19,"Ingush"
+RU,20,"Irkutsk"
+RU,21,"Ivanovo"
+RU,22,"Kabardin-Balkar"
+RU,23,"Kaliningrad"
+RU,24,"Kalmyk"
+RU,25,"Kaluga"
+RU,26,"Kamchatka"
+RU,27,"Karachay-Cherkess"
+RU,28,"Karelia"
+RU,29,"Kemerovo"
+RU,30,"Khabarovsk"
+RU,31,"Khakass"
+RU,32,"Khanty-Mansiy"
+RU,33,"Kirov"
+RU,34,"Komi"
+RU,35,"Komi-Permyak"
+RU,36,"Koryak"
+RU,37,"Kostroma"
+RU,38,"Krasnodar"
+RU,39,"Krasnoyarsk"
+RU,40,"Kurgan"
+RU,41,"Kursk"
+RU,42,"Leningrad"
+RU,43,"Lipetsk"
+RU,44,"Magadan"
+RU,45,"Mariy-El"
+RU,46,"Mordovia"
+RU,47,"Moskva"
+RU,48,"Moscow City"
+RU,49,"Murmansk"
+RU,50,"Nenets"
+RU,51,"Nizhegorod"
+RU,52,"Novgorod"
+RU,53,"Novosibirsk"
+RU,54,"Omsk"
+RU,55,"Orenburg"
+RU,56,"Orel"
+RU,57,"Penza"
+RU,58,"Perm'"
+RU,59,"Primor'ye"
+RU,60,"Pskov"
+RU,61,"Rostov"
+RU,62,"Ryazan'"
+RU,63,"Sakha"
+RU,64,"Sakhalin"
+RU,65,"Samara"
+RU,66,"Saint Petersburg City"
+RU,67,"Saratov"
+RU,68,"North Ossetia"
+RU,69,"Smolensk"
+RU,70,"Stavropol'"
+RU,71,"Sverdlovsk"
+RU,72,"Tambovskaya oblast"
+RU,73,"Tatarstan"
+RU,74,"Taymyr"
+RU,75,"Tomsk"
+RU,76,"Tula"
+RU,77,"Tver'"
+RU,78,"Tyumen'"
+RU,79,"Tuva"
+RU,80,"Udmurt"
+RU,81,"Ul'yanovsk"
+RU,82,"Ust-Orda Buryat"
+RU,83,"Vladimir"
+RU,84,"Volgograd"
+RU,85,"Vologda"
+RU,86,"Voronezh"
+RU,87,"Yamal-Nenets"
+RU,88,"Yaroslavl'"
+RU,89,"Yevrey"
+RU,90,"Permskiy Kray"
+RU,91,"Krasnoyarskiy Kray"
+RW,01,"Butare"
+RW,06,"Gitarama"
+RW,09,"Kigali"
+RW,11,"Est"
+RW,12,"Kigali"
+RW,13,"Nord"
+RW,14,"Ouest"
+RW,15,"Sud"
+SA,02,"Al Bahah"
+SA,03,"Al Jawf"
+SA,05,"Al Madinah"
+SA,06,"Ash Sharqiyah"
+SA,08,"Al Qasim"
+SA,09,"Al Qurayyat"
+SA,10,"Ar Riyad"
+SA,13,"Ha'il"
+SA,14,"Makkah"
+SA,15,"Al Hudud ash Shamaliyah"
+SA,16,"Najran"
+SA,17,"Jizan"
+SA,19,"Tabuk"
+SA,20,"Al Jawf"
+SB,03,"Malaita"
+SB,06,"Guadalcanal"
+SB,07,"Isabel"
+SB,08,"Makira"
+SB,09,"Temotu"
+SB,10,"Central"
+SB,11,"Western"
+SB,12,"Choiseul"
+SB,13,"Rennell and Bellona"
+SC,01,"Anse aux Pins"
+SC,02,"Anse Boileau"
+SC,03,"Anse Etoile"
+SC,04,"Anse Louis"
+SC,05,"Anse Royale"
+SC,06,"Baie Lazare"
+SC,07,"Baie Sainte Anne"
+SC,08,"Beau Vallon"
+SC,09,"Bel Air"
+SC,10,"Bel Ombre"
+SC,11,"Cascade"
+SC,12,"Glacis"
+SC,13,"Grand' Anse"
+SC,14,"Grand' Anse"
+SC,15,"La Digue"
+SC,16,"La Riviere Anglaise"
+SC,17,"Mont Buxton"
+SC,18,"Mont Fleuri"
+SC,19,"Plaisance"
+SC,20,"Pointe La Rue"
+SC,21,"Port Glaud"
+SC,22,"Saint Louis"
+SC,23,"Takamaka"
+SD,27,"Al Wusta"
+SD,28,"Al Istiwa'iyah"
+SD,29,"Al Khartum"
+SD,30,"Ash Shamaliyah"
+SD,31,"Ash Sharqiyah"
+SD,32,"Bahr al Ghazal"
+SD,33,"Darfur"
+SD,34,"Kurdufan"
+SD,35,"Upper Nile"
+SE,01,"Alvsborgs Lan"
+SE,02,"Blekinge Lan"
+SE,03,"Gavleborgs Lan"
+SE,04,"Goteborgs och Bohus Lan"
+SE,05,"Gotlands Lan"
+SE,06,"Hallands Lan"
+SE,07,"Jamtlands Lan"
+SE,08,"Jonkopings Lan"
+SE,09,"Kalmar Lan"
+SE,10,"Dalarnas Lan"
+SE,11,"Kristianstads Lan"
+SE,12,"Kronobergs Lan"
+SE,13,"Malmohus Lan"
+SE,14,"Norrbottens Lan"
+SE,15,"Orebro Lan"
+SE,16,"Ostergotlands Lan"
+SE,17,"Skaraborgs Lan"
+SE,18,"Sodermanlands Lan"
+SE,21,"Uppsala Lan"
+SE,22,"Varmlands Lan"
+SE,23,"Vasterbottens Lan"
+SE,24,"Vasternorrlands Lan"
+SE,25,"Vastmanlands Lan"
+SE,26,"Stockholms Lan"
+SE,27,"Skane Lan"
+SE,28,"Vastra Gotaland"
+SH,01,"Ascension"
+SH,02,"Saint Helena"
+SH,03,"Tristan da Cunha"
+SI,01,"Ajdovscina"
+SI,02,"Beltinci"
+SI,03,"Bled"
+SI,04,"Bohinj"
+SI,05,"Borovnica"
+SI,06,"Bovec"
+SI,07,"Brda"
+SI,08,"Brezice"
+SI,09,"Brezovica"
+SI,11,"Celje"
+SI,12,"Cerklje na Gorenjskem"
+SI,13,"Cerknica"
+SI,14,"Cerkno"
+SI,15,"Crensovci"
+SI,16,"Crna na Koroskem"
+SI,17,"Crnomelj"
+SI,19,"Divaca"
+SI,20,"Dobrepolje"
+SI,22,"Dol pri Ljubljani"
+SI,24,"Dornava"
+SI,25,"Dravograd"
+SI,26,"Duplek"
+SI,27,"Gorenja Vas-Poljane"
+SI,28,"Gorisnica"
+SI,29,"Gornja Radgona"
+SI,30,"Gornji Grad"
+SI,31,"Gornji Petrovci"
+SI,32,"Grosuplje"
+SI,34,"Hrastnik"
+SI,35,"Hrpelje-Kozina"
+SI,36,"Idrija"
+SI,37,"Ig"
+SI,38,"Ilirska Bistrica"
+SI,39,"Ivancna Gorica"
+SI,40,"Izola-Isola"
+SI,42,"Jursinci"
+SI,44,"Kanal"
+SI,45,"Kidricevo"
+SI,46,"Kobarid"
+SI,47,"Kobilje"
+SI,49,"Komen"
+SI,50,"Koper-Capodistria"
+SI,51,"Kozje"
+SI,52,"Kranj"
+SI,53,"Kranjska Gora"
+SI,54,"Krsko"
+SI,55,"Kungota"
+SI,57,"Lasko"
+SI,61,"Ljubljana"
+SI,62,"Ljubno"
+SI,64,"Logatec"
+SI,66,"Loski Potok"
+SI,68,"Lukovica"
+SI,71,"Medvode"
+SI,72,"Menges"
+SI,73,"Metlika"
+SI,74,"Mezica"
+SI,76,"Mislinja"
+SI,77,"Moravce"
+SI,78,"Moravske Toplice"
+SI,79,"Mozirje"
+SI,80,"Murska Sobota"
+SI,81,"Muta"
+SI,82,"Naklo"
+SI,83,"Nazarje"
+SI,84,"Nova Gorica"
+SI,86,"Odranci"
+SI,87,"Ormoz"
+SI,88,"Osilnica"
+SI,89,"Pesnica"
+SI,91,"Pivka"
+SI,92,"Podcetrtek"
+SI,94,"Postojna"
+SI,97,"Puconci"
+SI,98,"Racam"
+SI,99,"Radece"
+SI,A1,"Radenci"
+SI,A2,"Radlje ob Dravi"
+SI,A3,"Radovljica"
+SI,A6,"Rogasovci"
+SI,A7,"Rogaska Slatina"
+SI,A8,"Rogatec"
+SI,B1,"Semic"
+SI,B2,"Sencur"
+SI,B3,"Sentilj"
+SI,B4,"Sentjernej"
+SI,B6,"Sevnica"
+SI,B7,"Sezana"
+SI,B8,"Skocjan"
+SI,B9,"Skofja Loka"
+SI,C1,"Skofljica"
+SI,C2,"Slovenj Gradec"
+SI,C4,"Slovenske Konjice"
+SI,C5,"Smarje pri Jelsah"
+SI,C6,"Smartno ob Paki"
+SI,C7,"Sostanj"
+SI,C8,"Starse"
+SI,C9,"Store"
+SI,D1,"Sveti Jurij"
+SI,D2,"Tolmin"
+SI,D3,"Trbovlje"
+SI,D4,"Trebnje"
+SI,D5,"Trzic"
+SI,D6,"Turnisce"
+SI,D7,"Velenje"
+SI,D8,"Velike Lasce"
+SI,E1,"Vipava"
+SI,E2,"Vitanje"
+SI,E3,"Vodice"
+SI,E5,"Vrhnika"
+SI,E6,"Vuzenica"
+SI,E7,"Zagorje ob Savi"
+SI,E9,"Zavrc"
+SI,F1,"Zelezniki"
+SI,F2,"Ziri"
+SI,F3,"Zrece"
+SI,G4,"Dobrova-Horjul-Polhov Gradec"
+SI,G7,"Domzale"
+SI,H4,"Jesenice"
+SI,H6,"Kamnik"
+SI,H7,"Kocevje"
+SI,I2,"Kuzma"
+SI,I3,"Lenart"
+SI,I5,"Litija"
+SI,I6,"Ljutomer"
+SI,I7,"Loska Dolina"
+SI,I9,"Luce"
+SI,J1,"Majsperk"
+SI,J2,"Maribor"
+SI,J5,"Miren-Kostanjevica"
+SI,J7,"Novo Mesto"
+SI,J9,"Piran"
+SI,K5,"Preddvor"
+SI,K7,"Ptuj"
+SI,L1,"Ribnica"
+SI,L3,"Ruse"
+SI,L7,"Sentjur pri Celju"
+SI,L8,"Slovenska Bistrica"
+SI,N2,"Videm"
+SI,N3,"Vojnik"
+SI,N5,"Zalec"
+SK,01,"Banska Bystrica"
+SK,02,"Bratislava"
+SK,03,"Kosice"
+SK,04,"Nitra"
+SK,05,"Presov"
+SK,06,"Trencin"
+SK,07,"Trnava"
+SK,08,"Zilina"
+SL,01,"Eastern"
+SL,02,"Northern"
+SL,03,"Southern"
+SL,04,"Western Area"
+SM,01,"Acquaviva"
+SM,02,"Chiesanuova"
+SM,03,"Domagnano"
+SM,04,"Faetano"
+SM,05,"Fiorentino"
+SM,06,"Borgo Maggiore"
+SM,07,"San Marino"
+SM,08,"Monte Giardino"
+SM,09,"Serravalle"
+SN,01,"Dakar"
+SN,03,"Diourbel"
+SN,04,"Saint-Louis"
+SN,05,"Tambacounda"
+SN,07,"Thies"
+SN,09,"Fatick"
+SN,10,"Kaolack"
+SN,11,"Kolda"
+SN,12,"Ziguinchor"
+SN,13,"Louga"
+SN,14,"Saint-Louis"
+SN,15,"Matam"
+SO,01,"Bakool"
+SO,02,"Banaadir"
+SO,03,"Bari"
+SO,04,"Bay"
+SO,05,"Galguduud"
+SO,06,"Gedo"
+SO,07,"Hiiraan"
+SO,08,"Jubbada Dhexe"
+SO,09,"Jubbada Hoose"
+SO,10,"Mudug"
+SO,11,"Nugaal"
+SO,12,"Sanaag"
+SO,13,"Shabeellaha Dhexe"
+SO,14,"Shabeellaha Hoose"
+SO,16,"Woqooyi Galbeed"
+SO,18,"Nugaal"
+SO,19,"Togdheer"
+SO,20,"Woqooyi Galbeed"
+SO,21,"Awdal"
+SO,22,"Sool"
+SR,10,"Brokopondo"
+SR,11,"Commewijne"
+SR,12,"Coronie"
+SR,13,"Marowijne"
+SR,14,"Nickerie"
+SR,15,"Para"
+SR,16,"Paramaribo"
+SR,17,"Saramacca"
+SR,18,"Sipaliwini"
+SR,19,"Wanica"
+ST,01,"Principe"
+ST,02,"Sao Tome"
+SV,01,"Ahuachapan"
+SV,02,"Cabanas"
+SV,03,"Chalatenango"
+SV,04,"Cuscatlan"
+SV,05,"La Libertad"
+SV,06,"La Paz"
+SV,07,"La Union"
+SV,08,"Morazan"
+SV,09,"San Miguel"
+SV,10,"San Salvador"
+SV,11,"Santa Ana"
+SV,12,"San Vicente"
+SV,13,"Sonsonate"
+SV,14,"Usulutan"
+SY,01,"Al Hasakah"
+SY,02,"Al Ladhiqiyah"
+SY,03,"Al Qunaytirah"
+SY,04,"Ar Raqqah"
+SY,05,"As Suwayda'"
+SY,06,"Dar"
+SY,07,"Dayr az Zawr"
+SY,08,"Rif Dimashq"
+SY,09,"Halab"
+SY,10,"Hamah"
+SY,11,"Hims"
+SY,12,"Idlib"
+SY,13,"Dimashq"
+SY,14,"Tartus"
+SZ,01,"Hhohho"
+SZ,02,"Lubombo"
+SZ,03,"Manzini"
+SZ,04,"Shiselweni"
+SZ,05,"Praslin"
+TD,01,"Batha"
+TD,02,"Biltine"
+TD,03,"Borkou-Ennedi-Tibesti"
+TD,04,"Chari-Baguirmi"
+TD,05,"Guera"
+TD,06,"Kanem"
+TD,07,"Lac"
+TD,08,"Logone Occidental"
+TD,09,"Logone Oriental"
+TD,10,"Mayo-Kebbi"
+TD,11,"Moyen-Chari"
+TD,12,"Ouaddai"
+TD,13,"Salamat"
+TD,14,"Tandjile"
+TG,09,"Lama-Kara"
+TG,18,"Tsevie"
+TG,22,"Centrale"
+TG,23,"Kara"
+TG,24,"Maritime"
+TG,25,"Plateaux"
+TG,26,"Savanes"
+TH,01,"Mae Hong Son"
+TH,02,"Chiang Mai"
+TH,03,"Chiang Rai"
+TH,04,"Nan"
+TH,05,"Lamphun"
+TH,06,"Lampang"
+TH,07,"Phrae"
+TH,08,"Tak"
+TH,09,"Sukhothai"
+TH,10,"Uttaradit"
+TH,11,"Kamphaeng Phet"
+TH,12,"Phitsanulok"
+TH,13,"Phichit"
+TH,14,"Phetchabun"
+TH,15,"Uthai Thani"
+TH,16,"Nakhon Sawan"
+TH,17,"Nong Khai"
+TH,18,"Loei"
+TH,20,"Sakon Nakhon"
+TH,21,"Nakhon Phanom"
+TH,22,"Khon Kaen"
+TH,23,"Kalasin"
+TH,24,"Maha Sarakham"
+TH,25,"Roi Et"
+TH,26,"Chaiyaphum"
+TH,27,"Nakhon Ratchasima"
+TH,28,"Buriram"
+TH,29,"Surin"
+TH,30,"Sisaket"
+TH,31,"Narathiwat"
+TH,32,"Chai Nat"
+TH,33,"Sing Buri"
+TH,34,"Lop Buri"
+TH,35,"Ang Thong"
+TH,36,"Phra Nakhon Si Ayutthaya"
+TH,37,"Saraburi"
+TH,38,"Nonthaburi"
+TH,39,"Pathum Thani"
+TH,40,"Krung Thep"
+TH,41,"Phayao"
+TH,42,"Samut Prakan"
+TH,43,"Nakhon Nayok"
+TH,44,"Chachoengsao"
+TH,45,"Prachin Buri"
+TH,46,"Chon Buri"
+TH,47,"Rayong"
+TH,48,"Chanthaburi"
+TH,49,"Trat"
+TH,50,"Kanchanaburi"
+TH,51,"Suphan Buri"
+TH,52,"Ratchaburi"
+TH,53,"Nakhon Pathom"
+TH,54,"Samut Songkhram"
+TH,55,"Samut Sakhon"
+TH,56,"Phetchaburi"
+TH,57,"Prachuap Khiri Khan"
+TH,58,"Chumphon"
+TH,59,"Ranong"
+TH,60,"Surat Thani"
+TH,61,"Phangnga"
+TH,62,"Phuket"
+TH,63,"Krabi"
+TH,64,"Nakhon Si Thammarat"
+TH,65,"Trang"
+TH,66,"Phatthalung"
+TH,67,"Satun"
+TH,68,"Songkhla"
+TH,69,"Pattani"
+TH,70,"Yala"
+TH,71,"Ubon Ratchathani"
+TH,72,"Yasothon"
+TH,75,"Ubon Ratchathani"
+TH,76,"Udon Thani"
+TH,78,"Mukdahan"
+TJ,01,"Kuhistoni Badakhshon"
+TJ,02,"Khatlon"
+TJ,03,"Sughd"
+TM,01,"Ahal"
+TM,02,"Balkan"
+TM,03,"Dashoguz"
+TM,04,"Lebap"
+TM,05,"Mary"
+TN,02,"Al Qasrayn"
+TN,03,"Al Qayrawan"
+TN,06,"Jundubah"
+TN,10,"Qafsah"
+TN,14,"Kef"
+TN,15,"Al Mahdiyah"
+TN,16,"Al Munastir"
+TN,17,"Bajah"
+TN,18,"Banzart"
+TN,19,"Nabul"
+TN,22,"Silyanah"
+TN,23,"Susah"
+TN,27,"Bin"
+TN,28,"Madanin"
+TN,29,"Qabis"
+TN,30,"Qafşah"
+TN,31,"Qibili"
+TN,32,"Safaqis"
+TN,33,"Sidi Bu Zayd"
+TN,34,"Tatawin"
+TN,35,"Tawzar"
+TN,36,"Tunis"
+TN,37,"Zaghwan"
+TN,38,"Ariana"
+TN,39,"Manouba"
+TO,01,"Ha"
+TO,02,"Tongatapu"
+TO,03,"Vava"
+TR,02,"Adiyaman"
+TR,03,"Afyonkarahisar"
+TR,04,"Agri"
+TR,05,"Amasya"
+TR,07,"Antalya"
+TR,08,"Artvin"
+TR,09,"Aydin"
+TR,10,"Balikesir"
+TR,11,"Bilecik"
+TR,12,"Bingol"
+TR,13,"Bitlis"
+TR,14,"Bolu"
+TR,15,"Burdur"
+TR,16,"Bursa"
+TR,17,"Canakkale"
+TR,19,"Corum"
+TR,20,"Denizli"
+TR,21,"Diyarbakir"
+TR,22,"Edirne"
+TR,23,"Elazig"
+TR,24,"Erzincan"
+TR,25,"Erzurum"
+TR,26,"Eskisehir"
+TR,28,"Giresun"
+TR,31,"Hatay"
+TR,32,"Icel"
+TR,33,"Isparta"
+TR,34,"Istanbul"
+TR,35,"Izmir"
+TR,37,"Kastamonu"
+TR,38,"Kayseri"
+TR,39,"Kirklareli"
+TR,40,"Kirsehir"
+TR,41,"Kocaeli"
+TR,43,"Kutahya"
+TR,44,"Malatya"
+TR,45,"Manisa"
+TR,46,"Kahramanmaras"
+TR,48,"Mugla"
+TR,49,"Mus"
+TR,50,"Nevsehir"
+TR,52,"Ordu"
+TR,53,"Rize"
+TR,54,"Sakarya"
+TR,55,"Samsun"
+TR,57,"Sinop"
+TR,58,"Sivas"
+TR,59,"Tekirdag"
+TR,60,"Tokat"
+TR,61,"Trabzon"
+TR,62,"Tunceli"
+TR,63,"Sanliurfa"
+TR,64,"Usak"
+TR,65,"Van"
+TR,66,"Yozgat"
+TR,68,"Ankara"
+TR,69,"Gumushane"
+TR,70,"Hakkari"
+TR,71,"Konya"
+TR,72,"Mardin"
+TR,73,"Nigde"
+TR,74,"Siirt"
+TR,75,"Aksaray"
+TR,76,"Batman"
+TR,77,"Bayburt"
+TR,78,"Karaman"
+TR,79,"Kirikkale"
+TR,80,"Sirnak"
+TR,81,"Adana"
+TR,82,"Cankiri"
+TR,83,"Gaziantep"
+TR,84,"Kars"
+TR,85,"Zonguldak"
+TR,86,"Ardahan"
+TR,87,"Bartin"
+TR,88,"Igdir"
+TR,89,"Karabuk"
+TR,90,"Kilis"
+TR,91,"Osmaniye"
+TR,92,"Yalova"
+TR,93,"Duzce"
+TT,01,"Arima"
+TT,02,"Caroni"
+TT,03,"Mayaro"
+TT,04,"Nariva"
+TT,05,"Port-of-Spain"
+TT,06,"Saint Andrew"
+TT,07,"Saint David"
+TT,08,"Saint George"
+TT,09,"Saint Patrick"
+TT,10,"San Fernando"
+TT,11,"Tobago"
+TT,12,"Victoria"
+TW,01,"Fu-chien"
+TW,02,"Kao-hsiung"
+TW,03,"T'ai-pei"
+TW,04,"T'ai-wan"
+TZ,02,"Pwani"
+TZ,03,"Dodoma"
+TZ,04,"Iringa"
+TZ,05,"Kigoma"
+TZ,06,"Kilimanjaro"
+TZ,07,"Lindi"
+TZ,08,"Mara"
+TZ,09,"Mbeya"
+TZ,10,"Morogoro"
+TZ,11,"Mtwara"
+TZ,12,"Mwanza"
+TZ,13,"Pemba North"
+TZ,14,"Ruvuma"
+TZ,15,"Shinyanga"
+TZ,16,"Singida"
+TZ,17,"Tabora"
+TZ,18,"Tanga"
+TZ,19,"Kagera"
+TZ,20,"Pemba South"
+TZ,21,"Zanzibar Central"
+TZ,22,"Zanzibar North"
+TZ,23,"Dar es Salaam"
+TZ,24,"Rukwa"
+TZ,25,"Zanzibar Urban"
+TZ,26,"Arusha"
+TZ,27,"Manyara"
+UA,01,"Cherkas'ka Oblast'"
+UA,02,"Chernihivs'ka Oblast'"
+UA,03,"Chernivets'ka Oblast'"
+UA,04,"Dnipropetrovs'ka Oblast'"
+UA,05,"Donets'ka Oblast'"
+UA,06,"Ivano-Frankivs'ka Oblast'"
+UA,07,"Kharkivs'ka Oblast'"
+UA,08,"Khersons'ka Oblast'"
+UA,09,"Khmel'nyts'ka Oblast'"
+UA,10,"Kirovohrads'ka Oblast'"
+UA,11,"Krym"
+UA,12,"Kyyiv"
+UA,13,"Kyyivs'ka Oblast'"
+UA,14,"Luhans'ka Oblast'"
+UA,15,"L'vivs'ka Oblast'"
+UA,16,"Mykolayivs'ka Oblast'"
+UA,17,"Odes'ka Oblast'"
+UA,18,"Poltavs'ka Oblast'"
+UA,19,"Rivnens'ka Oblast'"
+UA,20,"Sevastopol'"
+UA,21,"Sums'ka Oblast'"
+UA,22,"Ternopil's'ka Oblast'"
+UA,23,"Vinnyts'ka Oblast'"
+UA,24,"Volyns'ka Oblast'"
+UA,25,"Zakarpats'ka Oblast'"
+UA,26,"Zaporiz'ka Oblast'"
+UA,27,"Zhytomyrs'ka Oblast'"
+UG,05,"Busoga"
+UG,08,"Karamoja"
+UG,12,"South Buganda"
+UG,18,"Central"
+UG,20,"Eastern"
+UG,21,"Nile"
+UG,22,"North Buganda"
+UG,23,"Northern"
+UG,24,"Southern"
+UG,25,"Western"
+UG,37,"Kampala"
+UG,56,"Mubende"
+UG,65,"Adjumani"
+UG,66,"Bugiri"
+UG,67,"Busia"
+UG,69,"Katakwi"
+UG,73,"Nakasongola"
+UG,74,"Sembabule"
+UG,77,"Arua"
+UG,78,"Iganga"
+UG,79,"Kabarole"
+UG,80,"Kaberamaido"
+UG,81,"Kamwenge"
+UG,82,"Kanungu"
+UG,83,"Kayunga"
+UG,84,"Kitgum"
+UG,85,"Kyenjojo"
+UG,86,"Mayuge"
+UG,87,"Mbale"
+UG,88,"Moroto"
+UG,89,"Mpigi"
+UG,90,"Mukono"
+UG,91,"Nakapiripirit"
+UG,92,"Pader"
+UG,93,"Rukungiri"
+UG,94,"Sironko"
+UG,95,"Soroti"
+UG,96,"Wakiso"
+UG,97,"Yumbe"
+US,01,"Alabama"
+US,02,"Alaska"
+US,04,"Arizona"
+US,05,"Arkansas"
+US,06,"California"
+US,08,"Colorado"
+US,09,"Connecticut"
+US,10,"Delaware"
+US,11,"District of Columbia"
+US,12,"Florida"
+US,13,"Georgia"
+US,15,"Hawaii"
+US,16,"Idaho"
+US,17,"Illinois"
+US,18,"Indiana"
+US,19,"Iowa"
+US,20,"Kansas"
+US,21,"Kentucky"
+US,22,"Louisiana"
+US,23,"Maine"
+US,24,"Maryland"
+US,25,"Massachusetts"
+US,26,"Michigan"
+US,27,"Minnesota"
+US,28,"Mississippi"
+US,29,"Missouri"
+US,30,"Montana"
+US,31,"Nebraska"
+US,32,"Nevada"
+US,33,"New Hampshire"
+US,34,"New Jersey"
+US,35,"New Mexico"
+US,36,"New York"
+US,37,"North Carolina"
+US,38,"North Dakota"
+US,39,"Ohio"
+US,40,"Oklahoma"
+US,41,"Oregon"
+US,42,"Pennsylvania"
+US,44,"Rhode Island"
+US,45,"South Carolina"
+US,46,"South Dakota"
+US,47,"Tennessee"
+US,48,"Texas"
+US,49,"Utah"
+US,50,"Vermont"
+US,51,"Virginia"
+US,53,"Washington"
+US,54,"West Virginia"
+US,55,"Wisconsin"
+US,56,"Wyoming"
+UY,01,"Artigas"
+UY,02,"Canelones"
+UY,03,"Cerro Largo"
+UY,04,"Colonia"
+UY,05,"Durazno"
+UY,06,"Flores"
+UY,07,"Florida"
+UY,08,"Lavalleja"
+UY,09,"Maldonado"
+UY,10,"Montevideo"
+UY,11,"Paysandu"
+UY,12,"Rio Negro"
+UY,13,"Rivera"
+UY,14,"Rocha"
+UY,15,"Salto"
+UY,16,"San Jose"
+UY,17,"Soriano"
+UY,18,"Tacuarembo"
+UY,19,"Treinta y Tres"
+UZ,01,"Andijon"
+UZ,02,"Bukhoro"
+UZ,03,"Farghona"
+UZ,04,"Jizzakh"
+UZ,05,"Khorazm"
+UZ,06,"Namangan"
+UZ,07,"Nawoiy"
+UZ,08,"Qashqadaryo"
+UZ,09,"Qoraqalpoghiston"
+UZ,10,"Samarqand"
+UZ,11,"Sirdaryo"
+UZ,12,"Surkhondaryo"
+UZ,13,"Toshkent"
+UZ,14,"Toshkent"
+VC,01,"Charlotte"
+VC,02,"Saint Andrew"
+VC,03,"Saint David"
+VC,04,"Saint George"
+VC,05,"Saint Patrick"
+VC,06,"Grenadines"
+VE,01,"Amazonas"
+VE,02,"Anzoategui"
+VE,03,"Apure"
+VE,04,"Aragua"
+VE,05,"Barinas"
+VE,06,"Bolivar"
+VE,07,"Carabobo"
+VE,08,"Cojedes"
+VE,09,"Delta Amacuro"
+VE,11,"Falcon"
+VE,12,"Guarico"
+VE,13,"Lara"
+VE,14,"Merida"
+VE,15,"Miranda"
+VE,16,"Monagas"
+VE,17,"Nueva Esparta"
+VE,18,"Portuguesa"
+VE,19,"Sucre"
+VE,20,"Tachira"
+VE,21,"Trujillo"
+VE,22,"Yaracuy"
+VE,23,"Zulia"
+VE,24,"Dependencias Federales"
+VE,25,"Distrito Federal"
+VE,26,"Vargas"
+VN,01,"An Giang"
+VN,02,"Bac Thai"
+VN,03,"Ben Tre"
+VN,04,"Binh Tri Thien"
+VN,05,"Cao Bang"
+VN,07,"Dac Lac"
+VN,09,"Dong Thap"
+VN,11,"Ha Bac"
+VN,12,"Hai Hung"
+VN,13,"Hai Phong"
+VN,14,"Ha Nam Ninh"
+VN,16,"Ha Son Binh"
+VN,17,"Ha Tuyen"
+VN,19,"Hoang Lien Son"
+VN,20,"Ho Chi Minh"
+VN,21,"Kien Giang"
+VN,22,"Lai Chau"
+VN,23,"Lam Dong"
+VN,24,"Long An"
+VN,25,"Minh Hai"
+VN,26,"Nghe Tinh"
+VN,27,"Nghia Binh"
+VN,28,"Phu Khanh"
+VN,29,"Quang Nam-Da Nang"
+VN,30,"Quang Ninh"
+VN,31,"Song Be"
+VN,32,"Son La"
+VN,33,"Tay Ninh"
+VN,34,"Thanh Hoa"
+VN,35,"Thai Binh"
+VN,36,"Thuan Hai"
+VN,37,"Tien Giang"
+VN,38,"Vinh Phu"
+VN,39,"Lang Son"
+VN,40,"Dong Nai"
+VN,43,"An Giang"
+VN,44,"Dac Lac"
+VN,45,"Dong Nai"
+VN,46,"Dong Thap"
+VN,47,"Kien Giang"
+VN,48,"Minh Hai"
+VN,49,"Song Be"
+VN,50,"Vinh Phu"
+VN,51,"Ha Noi"
+VN,52,"Ho Chi Minh"
+VN,53,"Ba Ria-Vung Tau"
+VN,54,"Binh Dinh"
+VN,55,"Binh Thuan"
+VN,56,"Can Tho"
+VN,57,"Gia Lai"
+VN,58,"Ha Giang"
+VN,59,"Ha Tay"
+VN,60,"Ha Tinh"
+VN,61,"Hoa Binh"
+VN,62,"Khanh Hoa"
+VN,63,"Kon Tum"
+VN,64,"Quang Tri"
+VN,65,"Nam Ha"
+VN,66,"Nghe An"
+VN,67,"Ninh Binh"
+VN,68,"Ninh Thuan"
+VN,69,"Phu Yen"
+VN,70,"Quang Binh"
+VN,71,"Quang Ngai"
+VN,72,"Quang Tri"
+VN,73,"Soc Trang"
+VN,74,"Thua Thien"
+VN,75,"Tra Vinh"
+VN,76,"Tuyen Quang"
+VN,77,"Vinh Long"
+VN,78,"Da Nang"
+VN,79,"Hai Duong"
+VN,80,"Ha Nam"
+VN,81,"Hung Yen"
+VN,82,"Nam Dinh"
+VN,83,"Phu Tho"
+VN,84,"Quang Nam"
+VN,85,"Thai Nguyen"
+VN,87,"Can Tho"
+VN,88,"Dak Lak"
+VN,89,"Lai Chau"
+VN,90,"Lao Cai"
+VN,91,"Dak Nong"
+VN,92,"Dien Bien"
+VN,93,"Hau Giang"
+VU,05,"Ambrym"
+VU,06,"Aoba"
+VU,07,"Torba"
+VU,08,"Efate"
+VU,09,"Epi"
+VU,10,"Malakula"
+VU,11,"Paama"
+VU,12,"Pentecote"
+VU,13,"Sanma"
+VU,14,"Shepherd"
+VU,15,"Tafea"
+VU,16,"Malampa"
+VU,17,"Penama"
+VU,18,"Shefa"
+WS,02,"Aiga-i-le-Tai"
+WS,03,"Atua"
+WS,04,"Fa"
+WS,05,"Gaga"
+WS,06,"Va"
+WS,07,"Gagaifomauga"
+WS,08,"Palauli"
+WS,09,"Satupa"
+WS,10,"Tuamasaga"
+WS,11,"Vaisigano"
+YE,01,"Abyan"
+YE,02,"Adan"
+YE,03,"Al Mahrah"
+YE,04,"Hadramawt"
+YE,05,"Shabwah"
+YE,08,"Al Hudaydah"
+YE,10,"Al Mahwit"
+YE,11,"Dhamar"
+YE,14,"Ma'rib"
+YE,15,"Sa"
+YE,16,"San"
+YE,20,"Al Bayda'"
+YE,21,"Al Jawf"
+YE,22,"Hajjah"
+YE,23,"Ibb"
+YE,24,"Lahij"
+YE,25,"Ta"
+ZA,02,"KwaZulu-Natal"
+ZA,03,"Free State"
+ZA,05,"Eastern Cape"
+ZA,06,"Gauteng"
+ZA,07,"Mpumalanga"
+ZA,08,"Northern Cape"
+ZA,09,"Limpopo"
+ZA,10,"North-West"
+ZA,11,"Western Cape"
+ZM,01,"Western"
+ZM,02,"Central"
+ZM,03,"Eastern"
+ZM,04,"Luapula"
+ZM,05,"Northern"
+ZM,06,"North-Western"
+ZM,07,"Southern"
+ZM,08,"Copperbelt"
+ZM,09,"Lusaka"
+ZW,01,"Manicaland"
+ZW,02,"Midlands"
+ZW,03,"Mashonaland Central"
+ZW,04,"Mashonaland East"
+ZW,05,"Mashonaland West"
+ZW,06,"Matabeleland North"
+ZW,07,"Matabeleland South"
+ZW,08,"Masvingo"
+ZW,09,"Bulawayo"
+ZW,10,"Harare"
--- /dev/null
+A1,"Anonymous Proxy"
+A2,"Satellite Provider"
+AD,"Andorra"
+AE,"United Arab Emirates"
+AF,"Afghanistan"
+AG,"Antigua and Barbuda"
+AI,"Anguilla"
+AL,"Albania"
+AM,"Armenia"
+AN,"Netherlands Antilles"
+AO,"Angola"
+AP,"Asia/Pacific Region"
+AQ,"Antarctica"
+AR,"Argentina"
+AS,"American Samoa"
+AT,"Austria"
+AU,"Australia"
+AW,"Aruba"
+AX,"Aland Islands"
+AZ,"Azerbaijan"
+BA,"Bosnia and Herzegovina"
+BB,"Barbados"
+BD,"Bangladesh"
+BE,"Belgium"
+BF,"Burkina Faso"
+BG,"Bulgaria"
+BH,"Bahrain"
+BI,"Burundi"
+BJ,"Benin"
+BM,"Bermuda"
+BN,"Brunei Darussalam"
+BO,"Bolivia"
+BR,"Brazil"
+BS,"Bahamas"
+BT,"Bhutan"
+BV,"Bouvet Island"
+BW,"Botswana"
+BY,"Belarus"
+BZ,"Belize"
+CA,"Canada"
+CC,"Cocos (Keeling) Islands"
+CD,"Congo, The Democratic Republic of the"
+CF,"Central African Republic"
+CG,"Congo"
+CH,"Switzerland"
+CI,"Cote d'Ivoire"
+CK,"Cook Islands"
+CL,"Chile"
+CM,"Cameroon"
+CN,"China"
+CO,"Colombia"
+CR,"Costa Rica"
+CU,"Cuba"
+CV,"Cape Verde"
+CX,"Christmas Island"
+CY,"Cyprus"
+CZ,"Czech Republic"
+DE,"Germany"
+DJ,"Djibouti"
+DK,"Denmark"
+DM,"Dominica"
+DO,"Dominican Republic"
+DZ,"Algeria"
+EC,"Ecuador"
+EE,"Estonia"
+EG,"Egypt"
+EH,"Western Sahara"
+ER,"Eritrea"
+ES,"Spain"
+ET,"Ethiopia"
+EU,"Europe"
+FI,"Finland"
+FJ,"Fiji"
+FK,"Falkland Islands (Malvinas)"
+FM,"Micronesia, Federated States of"
+FO,"Faroe Islands"
+FR,"France"
+GA,"Gabon"
+GB,"United Kingdom"
+GD,"Grenada"
+GE,"Georgia"
+GF,"French Guiana"
+GG,"Guernsey"
+GH,"Ghana"
+GI,"Gibraltar"
+GL,"Greenland"
+GM,"Gambia"
+GN,"Guinea"
+GP,"Guadeloupe"
+GQ,"Equatorial Guinea"
+GR,"Greece"
+GS,"South Georgia and the South Sandwich Islands"
+GT,"Guatemala"
+GU,"Guam"
+GW,"Guinea-Bissau"
+GY,"Guyana"
+HK,"Hong Kong"
+HM,"Heard Island and McDonald Islands"
+HN,"Honduras"
+HR,"Croatia"
+HT,"Haiti"
+HU,"Hungary"
+ID,"Indonesia"
+IE,"Ireland"
+IL,"Israel"
+IM,"Isle of Man"
+IN,"India"
+IO,"British Indian Ocean Territory"
+IQ,"Iraq"
+IR,"Iran, Islamic Republic of"
+IS,"Iceland"
+IT,"Italy"
+JE,"Jersey"
+JM,"Jamaica"
+JO,"Jordan"
+JP,"Japan"
+KE,"Kenya"
+KG,"Kyrgyzstan"
+KH,"Cambodia"
+KI,"Kiribati"
+KM,"Comoros"
+KN,"Saint Kitts and Nevis"
+KP,"Korea, Democratic People's Republic of"
+KR,"Korea, Republic of"
+KW,"Kuwait"
+KY,"Cayman Islands"
+KZ,"Kazakhstan"
+LA,"Lao People's Democratic Republic"
+LB,"Lebanon"
+LC,"Saint Lucia"
+LI,"Liechtenstein"
+LK,"Sri Lanka"
+LR,"Liberia"
+LS,"Lesotho"
+LT,"Lithuania"
+LU,"Luxembourg"
+LV,"Latvia"
+LY,"Libyan Arab Jamahiriya"
+MA,"Morocco"
+MC,"Monaco"
+MD,"Moldova, Republic of"
+ME,"Montenegro"
+MG,"Madagascar"
+MH,"Marshall Islands"
+MK,"Macedonia"
+ML,"Mali"
+MM,"Myanmar"
+MN,"Mongolia"
+MO,"Macao"
+MP,"Northern Mariana Islands"
+MQ,"Martinique"
+MR,"Mauritania"
+MS,"Montserrat"
+MT,"Malta"
+MU,"Mauritius"
+MV,"Maldives"
+MW,"Malawi"
+MX,"Mexico"
+MY,"Malaysia"
+MZ,"Mozambique"
+NA,"Namibia"
+NC,"New Caledonia"
+NE,"Niger"
+NF,"Norfolk Island"
+NG,"Nigeria"
+NI,"Nicaragua"
+NL,"Netherlands"
+NO,"Norway"
+NP,"Nepal"
+NR,"Nauru"
+NU,"Niue"
+NZ,"New Zealand"
+OM,"Oman"
+PA,"Panama"
+PE,"Peru"
+PF,"French Polynesia"
+PG,"Papua New Guinea"
+PH,"Philippines"
+PK,"Pakistan"
+PL,"Poland"
+PM,"Saint Pierre and Miquelon"
+PN,"Pitcairn"
+PR,"Puerto Rico"
+PS,"Palestinian Territory"
+PT,"Portugal"
+PW,"Palau"
+PY,"Paraguay"
+QA,"Qatar"
+RE,"Reunion"
+RO,"Romania"
+RS,"Serbia"
+RU,"Russian Federation"
+RW,"Rwanda"
+SA,"Saudi Arabia"
+SB,"Solomon Islands"
+SC,"Seychelles"
+SD,"Sudan"
+SE,"Sweden"
+SG,"Singapore"
+SH,"Saint Helena"
+SI,"Slovenia"
+SJ,"Svalbard and Jan Mayen"
+SK,"Slovakia"
+SL,"Sierra Leone"
+SM,"San Marino"
+SN,"Senegal"
+SO,"Somalia"
+SR,"Suriname"
+ST,"Sao Tome and Principe"
+SV,"El Salvador"
+SY,"Syrian Arab Republic"
+SZ,"Swaziland"
+TC,"Turks and Caicos Islands"
+TD,"Chad"
+TF,"French Southern Territories"
+TG,"Togo"
+TH,"Thailand"
+TJ,"Tajikistan"
+TK,"Tokelau"
+TL,"Timor-Leste"
+TM,"Turkmenistan"
+TN,"Tunisia"
+TO,"Tonga"
+TR,"Turkey"
+TT,"Trinidad and Tobago"
+TV,"Tuvalu"
+TW,"Taiwan"
+TZ,"Tanzania, United Republic of"
+UA,"Ukraine"
+UG,"Uganda"
+UM,"United States Minor Outlying Islands"
+US,"United States"
+UY,"Uruguay"
+UZ,"Uzbekistan"
+VA,"Holy See (Vatican City State)"
+VC,"Saint Vincent and the Grenadines"
+VE,"Venezuela"
+VG,"Virgin Islands, British"
+VI,"Virgin Islands, U.S."
+VN,"Vietnam"
+VU,"Vanuatu"
+WF,"Wallis and Futuna"
+WS,"Samoa"
+YE,"Yemen"
+YT,"Mayotte"
+ZA,"South Africa"
+ZM,"Zambia"
+ZW,"Zimbabwe"
--- /dev/null
+iso 3166 country,iso 3166-2 region,name
+CA,AB,"Alberta"
+CA,BC,"British Columbia"
+CA,MB,"Manitoba"
+CA,NB,"New Brunswick"
+CA,NL,"Newfoundland"
+CA,NS,"Nova Scotia"
+CA,NU,"Nunavut"
+CA,ON,"Ontario"
+CA,PE,"Prince Edward Island"
+CA,QC,"Quebec"
+CA,SK,"Saskatchewan"
+CA,NT,"Northwest Territories"
+CA,YT,"Yukon Territory"
+US,AA,"Armed Forces Americas"
+US,AE,"Armed Forces Europe, Middle East, & Canada"
+US,AK,"Alaska"
+US,AL,"Alabama"
+US,AP,"Armed Forces Pacific"
+US,AR,"Arkansas"
+US,AS,"American Samoa"
+US,AZ,"Arizona"
+US,CA,"California"
+US,CO,"Colorado"
+US,CT,"Connecticut"
+US,DC,"District of Columbia"
+US,DE,"Delaware"
+US,FL,"Florida"
+US,FM,"Federated States of Micronesia"
+US,GA,"Georgia"
+US,GU,"Guam"
+US,HI,"Hawaii"
+US,IA,"Iowa"
+US,ID,"Idaho"
+US,IL,"Illinois"
+US,IN,"Indiana"
+US,KS,"Kansas"
+US,KY,"Kentucky"
+US,LA,"Louisiana"
+US,MA,"Massachusetts"
+US,MD,"Maryland"
+US,ME,"Maine"
+US,MH,"Marshall Islands"
+US,MI,"Michigan"
+US,MN,"Minnesota"
+US,MO,"Missouri"
+US,MP,"Northern Mariana Islands"
+US,MS,"Mississippi"
+US,MT,"Montana"
+US,NC,"North Carolina"
+US,ND,"North Dakota"
+US,NE,"Nebraska"
+US,NH,"New Hampshire"
+US,NJ,"New Jersey"
+US,NM,"New Mexico"
+US,NV,"Nevada"
+US,NY,"New York"
+US,OH,"Ohio"
+US,OK,"Oklahoma"
+US,OR,"Oregon"
+US,PA,"Pennsylvania"
+US,PR,"Puerto Rico"
+US,PW,"Palau"
+US,RI,"Rhode Island"
+US,SC,"South Carolina"
+US,SD,"South Dakota"
+US,TN,"Tennessee"
+US,TX,"Texas"
+US,UT,"Utah"
+US,VA,"Virginia"
+US,VI,"Virgin Islands"
+US,VT,"Vermont"
+US,WA,"Washington"
+US,WV,"West Virginia"
+US,WI,"Wisconsin"
+US,WY,"Wyoming"
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+use strict;
+
+use Getopt::Long;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => dirname(abs_path($0)),
+ );
+ require constant; import constant(\%constants);
+}
+chdir PREFIX;
+use lib PREFIX;
+
+our ($delete_db, $skip_backup, $auto_backup, $restore, $help);
+BEGIN {
+ GetOptions (
+ "delete" => \$delete_db,
+ "skip-backup" => \$skip_backup,
+ "backup" => \$auto_backup,
+ "restore" => \$restore,
+ "help" => \$help,
+ );
+
+ if($help) {
+ print <<EOF;
+Options:
+ --delete Delete entire database
+ --skip-backup Don't nag about making a backup
+ --backup Make backup without upgrading
+ --restore FILE Restore the database from a backup
+ --help Show this message
+EOF
+
+ exit 1;
+ }
+}
+
+use SrSv::Conf qw(main sql);
+
+BEGIN {
+ if($restore) {
+ my $f = shift @ARGV;
+ $f or die "You must specify a backup file to restore.\n";
+ print "Restoring from backup...\n";
+ system("mysql $sql_conf{'mysql-db'} -u $sql_conf{'mysql-user'} --password=$sql_conf{'mysql-pass'} <$f");
+ print "Finished.\n";
+ exit;
+ }
+}
+
+use SrSv::MySQL '$dbh';
+
+use SrSv::Upgrade::HashPass;
+
+my $backup_file;
+
+sub ask($) {
+ print shift;
+
+ while(my $c = getc) {
+ next unless $c =~ /\S/;
+ return (lc $c eq 'y');
+ }
+}
+
+sub do_sql_file($) {
+ my $file = shift;
+ open ((my $SQL), $file) or die "$file: $!\n";
+ my $sql;
+ while(my $x = <$SQL>) { $sql .= $x unless $x =~ /^#/ or $x eq '\n'}
+ foreach my $line (split(/;/s, $sql)) {
+ $dbh->do($line);
+ }
+}
+
+unless($skip_backup) {
+ if($auto_backup or ask "Would you like to make a backup of your database: $sql_conf{'mysql-db'}? (Y/n) ") {
+ my @lt = localtime();
+ $backup_file = "./db-backup-" . sprintf( "%04d%02d%02d", ($lt[5]+1900) , ($lt[4]+1) , ($lt[3]) ) . "-$$.sql";
+ print "Creating backup in $backup_file\n";
+ system("./utils/db-dump.pl > $backup_file");
+ goto END if $auto_backup;
+ }
+}
+
+if($delete_db) {
+ exit unless ask "Really delete all data in database: $sql_conf{'mysql-db'}? (y/N) ";
+
+ print "Deleting old tables...\n";
+
+ my $table_list = $dbh->prepare("SHOW TABLES");
+ $table_list->execute;
+ while(my $t = $table_list->fetchrow_array) {
+ $dbh->do("DROP TABLE $t");
+ }
+}
+
+print "Creating tables...\n";
+
+$dbh->{RaiseError} = 0;
+$dbh->{PrintError} = 0;
+
+do_sql_file("sql/services.sql");
+
+print "Updating chanperm...\n";
+
+my $add_perm = $dbh->prepare("INSERT IGNORE INTO chanperm SET name=?, level=?, max=?");
+my $del_perm = $dbh->prepare("DELETE FROM chanperm WHERE name=?");
+
+my @perms = (
+ ['Join', 0, 1],
+ ['AccList', 1, 0],
+ ['AccChange', 5, 0],
+ ['AKICK', 5, 0],
+ ['AKickList', 3, 0],
+ ['AKickEnforce', 5, 0],
+ ['SET', 6, 0],
+ ['BAN', 4, 0],
+ ['CLEAR', 6, 0],
+ ['GETKEY', 4, 0],
+ ['INFO', 0, 0],
+ ['KICK', 4, 0],
+ ['LEVELS', 6, 7],
+ ['LevelsList', 3, 7],
+ ['INVITE', 4, 0],
+ ['InviteSelf', 1, 0],
+ ['TOPIC', 5, 0],
+ ['UnbanSelf', 4, 0],
+ ['UNBAN', 5, 0],
+ ['VOICE', 2, 0],
+ ['HALFOP', 3, 0],
+ ['OP', 4, 0],
+ ['ADMIN', 5, 0],
+ ['OWNER', 6, 0],
+ ['Memo', 5, 0],
+ ['BadWords', 5, 0],
+ ['Greet', 1, 0],
+ ['NoKick', 4, 0],
+ ['BotSay', 5, 0],
+ ['BotAssign', 6, 0],
+ ['SetTopic', 0, 0],
+ ['WELCOME', 6, 0],
+ ['DICE', 1, 0],
+ ['UPDOWN', 1, 0],
+ ['MemoAccChange', 8, 0],
+ ['MODE', 6, 0],
+ ['COPY', 7, 0],
+);
+
+my @noperms = ();
+
+foreach my $p (@perms) {
+ $add_perm->execute($p->[0], $p->[1], $p->[2]);
+}
+
+foreach my $p (@noperms) {
+ $del_perm->execute($p);
+}
+
+hash_all_passwords();
+
+print "Database setup complete!\n";
+
+END:
+$backup_file and print "\nNOTE: To restore your backup, use this command:\n ./db-setup.pl --restore $backup_file\n";
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use DBI;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => dirname(abs_path($0)),
+ );
+ require constant; import constant(\%constants);
+}
+chdir PREFIX;
+use lib PREFIX;
+
+use SrSv::Conf 'sql';
+
+$dbh = DBI->connect('DBI:mysql:'.$sql_conf{'mysql-db'}, $sql_conf{'mysql-user'}, $sql_conf{'mysql-pass'},
+ { AutoCommit => 1, RaiseError => 1 });
+
+$get_root_nick = $dbh->prepare("SELECT nickreg.nick FROM nickalias,nickreg WHERE nickalias.nrid=nickreg.id AND alias=?");
+$del_svsop = $dbh->prepare("DELETE FROM svsop USING svsop, nickreg WHERE svsop.nrid=nickreg.id AND nickreg.nick=?");
+
+$get_root_nick->execute($ARGV[0]);
+my ($root) = $get_root_nick->fetchrow_array;
+$get_root_nick->finish;
+
+unless($root) {
+ print "That nick does not exist.\n";
+ exit;
+}
+
+$del_svsop->execute($root);
+$del_svsop->finish;
+
+print "$root has been stripped of all rank.\n";
--- /dev/null
+AdminServ Commands
+
+SVSOP - Modify Services Operator
+WHOIS - Check rank of an individual
+STAFF - List all Services Ops
--- /dev/null
+%BAdminServ STAFF%B lists all services staff-members, in rank
+order.
\ No newline at end of file
--- /dev/null
+Modify Services Operator
+
+Syntax: SVSOP <ADD|DEL|LIST> <nick> <H|O|A|R>
+
+Services Access:
+
+H HelpOp
+O [Services] Operator
+A [Services] Admin
+R Services Root
--- /dev/null
+Commands:
+ JOIN Force bot to join a channel.
+ PART Force bot to leave a channel.
+ SAY Make bot say a message.
+ ACT Make bot do an action.
--- /dev/null
+%BBotServ%B allows you to control services bots.
+
+Commands:
+ ASSIGN Assign bot to channel
+ UNASSIGN Remove bot from channel
+ LIST List available bots
+ ADD Create a new bot
+ DEL Delete a bot
+ SAY Make bot say a message
+ ACT Make bot do an action
+ SET Set flags on a bot
+
+For more help on a specific command, type: %B/bs help%B %Ucommand%U
--- /dev/null
+%BBotServ ACT%B allows you to make a bot perform an action in a channel.
+
+Syntax: %BACT%B %U#channel%U %Uaction%U
--- /dev/null
+%BBotServ ADD%B allows you to create a new services bot.
+
+Syntax: %BADD%B %Unick%U %Uident%U %Uvhost%U %Urealname%U
--- /dev/null
+%BBotServ ASSIGN%B allows you to assign a bot to a channel. Once assigned,
+the bot will join the channel and accept commands.
+
+Syntax: %BASSIGN%B %U#channel%U %Ubot%U
--- /dev/null
+%BBotServ DEL%B allows you to delete a services bot.
+
+Syntax: %BDEL%B %Ubot%U
--- /dev/null
+%BBotServ LIST%B allows you to view a list of all available services bots.
+
+Syntax: %BLIST%B
--- /dev/null
+%BBotServ SAY%B allows you to make a bot send a message to a channel.
+
+Syntax: %BSAY%B %U#channel%U %Umessage%U
--- /dev/null
+%BBotServ SET%B sets flags on bots.
+
+ PRIVATE - defaults to on. Set it off to make a bot public.
+ DEAF - Sets a bot to have umode +d, thus will not receive
+ channel messages. Mostly useful to reduce load.
+ Deaf bots will not be able to be used for
+ any kind of badword kicking.
+
+Syntax: %BSET%B %Ubot%U %Uflag%U %UOn/Off%U
--- /dev/null
+%BBotServ UNASSIGN%B allows you to remove a previously assigned bot
+from a channel.
+
+Syntax: %BUNASSIGN%B %U#channel%U
--- /dev/null
+Commands:
+ !up Gives you the highest channel status you are allowed.
+ !down Removes all channel status.
+ !invite Invites a user to the channel.
+ !ban Bans a user or mask from the channel.
+ !kick Kicks a user from the channel.
+ !kickban Kicks and bans a user from the channel.
+ !kickmask Kicks users matching a mask from the channel.
+ !kickbanmask Kicks and bans users matching a mask from the channel.
+ !unban Unbans a user from the channel.
+ !calc Performs a mathematical calculation.
+ !seen Shows how long it has been since a user identified to a nick.
+ !dice Rolls dice, !d 2d4 rolls 2 4 sided dice.
+ !mode Sets modes in a channel.
+ !resync Gives everyone the precise chan-ops they're supposed to have.
+
+Commands to set channel status:
+ !voice !halfop !op !admin
+ !devoice !dehalfop !deop !deadmin
--- /dev/null
+%BChanServ%B allows you to register and control various aspects of
+channels. ChanServ can prevent malicious users from "taking
+over" channels by limiting who is allowed channel operator
+priviliges.
+
+Commands:
+ REGISTER Register a channel
+ SET Change various channel configuration settings
+ AKICK Maintain the channel AutoKick list
+ LEVELS Alter the required access level for commands
+ INFO Information about a channel
+ DROP Drop a registered channel
+ MODE Change channel modes.
+
+Commands to manipulate access lists:
+ CF SOP AOP HOP VOP UOP AUTH
+
+Commands to change or check channel status:
+ VOICE OP HALFOP PROTECT UP
+ DEVOICE DEOP DEHALFOP DEPROTECT DOWN
+ WHY COUNT ALIST RESYNC
+
+Other available commands:
+ DICE INVITE GETKEY CLOSE COPY
+ CLEAR WELCOME DRONE KICKMASK
+ KICK KICKBAN MLOCK KICKBANMASK
+
+Note that channels will be dropped after 21 days of inactivity.
+
+For more help on a specific command, type: %B/cs help%B %Ucommand%U
--- /dev/null
+%BChanServ ADMIN%B allows you to set channel-admin mode on
+either yourself or on other people in a channel.
+
+Syntax:
+ ADMIN <channel> [nick [nick ...]]
+ ADMIN <channel> [channel [channel]]
--- /dev/null
+%BChanServ AKICK%B maintains the AutoKick list for a channel.
+If a user on the AutoKick list attempts to join the channel,
+ChanServ will ban that user from the channel, then kick the user.
+
+Syntax: %BAKICK%B %U#channel%U %BADD%B %Unick/mask%U %Ureason%U
+ %BAKICK%B %U#channel%U %BDEL%B %Unick/mask/list%U
+ %BAKICK%B %U#channel%U %BLIST%B
+
+The %BAKICK ADD%B command adds the given nick or hostmask to
+the AutoKick list.
+#If a %Ureason%U is given with the
+#command, that reason will be used when the user is kicked;
+#if not, the default reason is "You have been banned from the
+#channel".
+
+The %BAKICK DEL%B command removes the given nick, mask or
+sequence of numbered-entries from the AutoKick list. It does
+not, however, remove any bans placed by an AutoKick; those must
+be removed manually.
+
+The %BAKICK LIST%B command displays the AutoKick list.
+#or
+#optionally only those AutoKick entries which match the given
+#mask.
--- /dev/null
+%BChanServ ALIST%B displays a full listing of all users,
+optionally filtered, that have access to a channel.
+
+Syntax: %BALIST%B %U#channel%U [%Umask%U]
--- /dev/null
+%BChanServ AOP%B maintains the auto-op list for a channel.
+Users on this list are given op status upon joining
+the channel.
+
+Syntax: %BAOP%B %U#channel%U %BADD%B %Unick%U
+ %BAOP%B %U#channel%U %BDEL%B %Unick%U
+ %BAOP%B %U#channel%U %BLIST%B [%Umask%U]
+ %BAOP%B %U#channel%U %BWIPE%B
+
+The %BAOP ADD%B command adds the given nickname to the list.
+If the target has SET AUTH on, a demotions is handled by
+deleting the target's access, so they may accept the demotion,
+or no access at all.
+
+The %BAOP DEL%B command removes the given nick from the list.
+
+The %BAOP LIST%B command displays the list.
+if a mask is given, only those entries matching the mask are
+displayed.
+
+The %BAOP WIPE%B command removes all entries from the list.
--- /dev/null
+%BChanServ AUTH%B allows channel SOps to delete old/stale
+entries from the pending access list.
+
+Syntax: %BAUTH %U<#channel>%U <LIST|DELETE> %U[number|name]%U%B
+
+Examples:
+/msg ChanServ AUTH #SurrealChat LIST
+/msg ChanServ AUTH #SurrealChat DELETE Alucard
+/msg ChanServ AUTH #SurrealChat DELETE 3
--- /dev/null
+%BChanServ BAN%B Tells ChanServ to set a ban on a person or
+mask. It can also remove bans, if you prefix the ban with a -
+
+Syntax: %BBAN %U#channel%U <nick|mask>%B
+
+By default limited to %BHOP%B
--- /dev/null
+%BChanServ CF%B maintains the cofounder list for a channel.
+Users on this list are allowed to do anything the founder can do.
+
+Syntax: %BCF%B %U#channel%U %BADD%B %Unick%U
+ %BCF%B %U#channel%U %BDEL%B %Unick%U
+ %BCF%B %U#channel%U %BLIST%B [%Umask%U]
+ %BCF%B %U#channel%U %BWIPE%B
+
+The %BCF ADD%B command adds the given nickname to the list.
+If the target has SET AUTH on, a demotions is handled by
+deleting the target's access, so they may accept the demotion,
+or no access at all.
+
+The %BCF DEL%B command removes the given nick from the list.
+
+The %BCF LIST%B command displays the list.
+if a mask is given, only those entries matching the mask are
+displayed.
+
+The %BCF WIPE%B command removes all entries from the list.
--- /dev/null
+%BChanServ CLEAR%B allows you to un-set all channel modes,
+remove all channel status, kick all users, or
+clear the ban list from a channel.
+
+Syntax: %BCLEAR%B %U#channel%U %BMODES%B [%Ureason%U]
+ %BCLEAR%B %U#channel%U %BOPS%B [%Ureason%U]
+ %BCLEAR%B %U#channel%U %BUSERS%B [%Ureason%U]
+ %BCLEAR%B %U#channel%U %BBANS%B [%Ureason%U]
+
+The %BCLEAR MODES%B command removes all channel modes.
+
+The %BCLEAR OPS%B command removes all status from all users
+in a channel.
+
+The %BCLEAR USERS%B command kicks all users from a channel.
+
+The %BCLEAR BANS%B command clears the ban list in a channel.
--- /dev/null
+%BChanServ CLOSE%B clears all users, bans *!*@*, and
+closes the channel down permanently. This process is not
+currently reversible, the channel must be dropped to be
+re-opened.
+
+The founder is unchanged, and the oper who closes the
+channel becomes successor, in case the founder nick is
+dropped.
+
+Syntax: %BCLOSE %U#channel%U Reason%B
+
+Requires SERVOP.
--- /dev/null
+%BChanServ COPY%B copies channel properties from one channel
+to another.
+
+* If #channel2 is not registered, you must be op in
+ #channel2.
+* You must have permission (LEVELS %BCOPY%B) in #channel1 in
+ order to copy to #channel2.
+* If #channel2 is already registered, you must also have
+ permission to copy to it.
+* If no type is specified, type is assumed to be All
+
+Available properties are:
+* All
+ Creates a new #channel2 from #channel1. #channel2 cannot
+ be registered. You must be opped on #channel2.
+* AKick
+* Access
+ May only copy one particular xOp/rank list.
+* LEVELS
+
+Syntax:
+ %BCOPY #chan1 [%Utype [rank]%U] #chan2%B
+
+Examples:
+ COPY #chan1 #chan2
+ COPY #chan1 akick #chan2
+ COPY #chan1 access #chan2
+ COPY #chan1 access aop #chan2
--- /dev/null
+%BChanServ COUNT%B displays the number of users in each
+channel access list.
+
+Syntax: %BCOUNT%B %U#channel%U
--- /dev/null
+%BChanServ DOWN%B has two syntaxes.
+
+First form gives you the highest channel op you are allowed
+in the channels you specify. If you specify no channels, all
+channels will be affected.
+
+Second form removes all channel ops from the nick[s] in the
+channel you specify, if you have sufficient rank.
+
+Syntax: %BDOWN%B [%Uchannel%U [%Uchannel%U ...]]
+Syntax: %BDOWN%B %Uchannel%U %Unick%U [[%Unick%U] ...]
--- /dev/null
+%BChanServ DRONE%B is like ChanServ CLOSE but instead of
+using kick it uses G:line or GZ:line.
+
+For more information, see ChanServ CLOSE.
+
+Syntax: %BDRONE %U#channel%U Reason%B
+
+Requires SERVOP.
--- /dev/null
+%BChanServ DROP%B unregisters the named channel. Can only
+be used by the channel founder.
+
+Syntax: %BDROP%B %U#channel%U
--- /dev/null
+%BChanServ GETKEY%B displays a channel's key (+k). If a channel has
+a key, you must provide the key when joining the channel.
+
+Syntax: %BGETKEY%B %U#channel%U
--- /dev/null
+%BChanServ HALFOP%B allows you to set halfop mode on either
+yourself or on other people in a channel.
+
+Syntax:
+ HALFOP <channel> [nick [nick ...]]
+ HALFOP <channel> [channel [channel]]
--- /dev/null
+%BChanServ HOP%B maintains the auto-hop list for a channel.
+Users on this list are given half-op status upon joining
+the channel.
+
+Syntax: %BHOP%B %U#channel%U %BADD%B %Unick%U
+ %BHOP%B %U#channel%U %BDEL%B %Unick%U
+ %BHOP%B %U#channel%U %BLIST%B [%Umask%U]
+ %BHOP%B %U#channel%U %BWIPE%B
+
+The %BHOP ADD%B command adds the given nickname to the list.
+If the target has SET AUTH on, a demotions is handled by
+deleting the target's access, so they may accept the demotion,
+or no access at all.
+
+The %BHOP DEL%B command removes the given nick from the list.
+
+The %BHOP LIST%B command displays the list.
+if a mask is given, only those entries matching the mask are
+displayed.
+
+The %BHOP WIPE%B command removes all entries from the list.
--- /dev/null
+%BChanServ INFO%B lists information about the named registered channel,
+including its founder, time of registration, last time used,
+description, and mode lock, if any.
+
+Syntax: %BINFO%B %U#channel%U
--- /dev/null
+%BChanServ INVITE%B allows you to invite a user into a channel.
+
+Syntax: %BINVITE%B %U#channel%U [%Unick%U]
+
+If you do not specify a nick, you will be invited.
--- /dev/null
+%BChanServ KICK%B allows you to kick a user from a channel.
+
+Syntax: %BKICK%B %U#channel%U %Unick%U [%Ureason%U]
--- /dev/null
+%BChanServ KICKBAN%B allows you to kick and ban a user from
+a channel.
+
+Syntax: %BKICKBAN%B %U#channel%U %Unick%U [%Ureason%U]
--- /dev/null
+%BChanServ KICKBANMASK%B allows you to kickban users matching a
+hostmask from the channel. It does not affect users with
+channel access.
+
+Syntax: %BKICKBANMASK%B %U#channel%U %Umask%U [%Ureason%U]
--- /dev/null
+%BChanServ KICKMASK%B allows you to kick users matching a
+hostmask from the channel. It does not affect users with
+channel access.
+
+Syntax: %BKICKMASK%B %U#channel%U %Umask%U [%Ureason%U]
--- /dev/null
+%BChanServ LEVELS%B allows you to adjust the minimum access levels
+required to do certain commands.
+
+Syntax: %BLEVELS%B %U#channel%U %BSET%B %Ucommand%U %Ulevel%U
+ %BLEVELS%B %U#channel%U %BRESET%B %Ucommand%U
+ %BLEVELS%B %U#channel%U %BLIST%B
+ %BLEVELS%B %U#channel%U %BCLEAR%B
+
+The %BLEVELS SET%B command sets the required level for a command.
+
+The %BLEVELS RESET%B command sets the level of a command back to
+the default setting.
+
+The %BLEVELS LIST%B command displays a list of possible commands
+and their current level settings.
+
+The %BLEVELS CLEAR%B command sets all levels back to the default
+settings.
+
+For a list of the different LEVELS settings and what they allow, type:
+%B/cs help levels set%B
--- /dev/null
+%U LEVEL: Allows you to:
+ AccChange Modify channel access lists.
+ AccList View channel access lists.
+ AKICK Modify the AKICK list.
+ AKickEnforce Re-check and enforce the akick list.
+ AKickList View the AKICK list.
+ BadWords *
+ BAN Use ChanServ/BotServ to ban users.
+ BotAssign Assign the BotServ bot.
+ BotSay Use BotServ SAY and BotServ ACT.
+ CLEAR Use ChanServ CLEAR commands.
+ DICE Allowed to use the !dice trigger.
+ GETKEY Use ChanServ GETKEY.
+ Greet Will receive a Greeting upon join
+ HALFOP Use ChanServ/BotServ to half-op (+h) users.
+ INFO Use ChanServ INFO.
+ INVITE Use ChanServ/BotServ to invite users.
+ InviteSelf Use ChanServ/BotServ to invite oneself.
+ Join May join the channel.
+ KICK Use ChanServ/BotServ to kick users.
+ LEVELS Modify the LEVELS list.
+ LevelsList View the LEVELS list.
+ Memo Send channel memos.
+ MemoAccChange Will receive memos about Access List Changes
+ NoKick *
+ OP Use ChanServ/BotServ to op (+o) users.
+ PROTECT Use ChanServ/BotServ to protect (+a) users.
+ SET Modify ChanServ settings.
+ SetTopic Use the /topic command to change the topic.
+ TOPIC *
+ UNBAN Unban others
+ UPDOWN Can use UP or DOWN on other people.
+ UnbanSelf Unban self
+ VOICE Use ChanServ/BotServ to voice (+v) users.
+ WELCOME Modify the ChanServ WELCOME list.
+
+* Not yet implemented.
--- /dev/null
+%BChanServ LIST%B Lists all registered channels matching the given mask.
+(Channels with the PRIVATE option set are not listed, of
+course.)
+
+Syntax: %BLIST %Umask%U%B
--- /dev/null
+%BChanServ MLOCK%B allows you to lock channel modes either
+on or off.
+
+Syntax: %BMLOCK%B %U#channel%U %B<SET|ADD|DEL>%B %Umodes%U
+
+The %Umodes%U parameter is constructed exactly the same way as
+a %B/MODE%B command; that is, modes preceded by a %B+%B are locked
+on, and modes preceded by a %B-%B are locked off.
+
+%BWarning:%B If you set a mode-locked key, as in the example
+below, you should also restrict who can join the channel.
+(see %B/cs HELP LEVELS SET%B) Otherwise, anyone entering the channel
+when it is empty will be able to see the key!
+
+Examples:
+
+ %BMLOCK%B %U#channel%U %BADD%B %U+QS-M%U
+ Adds +Q, +S and -M to your mlock.
+
+ %BMLOCK%B %U#channel%U %BDEL%B %UQ%U
+ Removes Q from your mlock, it may be +Q or -Q.
+
+ %BMLOCK%B %U#channel%U %BSET%B %U+nt-iklps%U
+ Forces modes n and t on, and modes i, k, l, p, and
+ s off. Mode m (and others) are left free to be either
+ on or off.
+
+ %BMLOCK%B %U#channel%U %BSET%B %U+knst-ilmp%U %Umy-key%U
+ Forces modes k, n, s, and t on, and modes i, l, m,
+ and p off. Also forces the channel key to be
+ "my-key".
+
+ %BMLOCK%B %U#channel%U %BSET%B %U+%U
+ Removes the mode lock; all channel modes are free
+ to be either on or off.
--- /dev/null
+%BChanServ MODE%B does everything that the regular IRCd MODE
+command does, but allows you to do so if you're not currently
+opped in the channel.
+
+Syntax: %BMODE%B %U#channel%U %U+modes-modes%U %U%B[%Bparams%B]%B%U
+
+Example: MODE #Support +tn
+ MODE #Support +ootn hAtbLaDe XYZ
--- /dev/null
+%BChanServ OP%B allows you to set channel op mode on either
+yourself or on other people in a channel.
+
+Syntax:
+ OP <channel> [nick [nick ...]]
+ OP <channel> [channel [channel]]
--- /dev/null
+%BChanServ REGISTER%B registers a channel in the ChanServ
+database. In order to use this command, you must first be a
+channel operator on the channel you're trying to register.
+
+Syntax: %BREGISTER%B %U#channel%U [%Upassword%U %Udescription%U]
+
+When you register a channel, you are recorded as the
+"Founder" of the channel. The channel founder is allowed to
+change all of the channel settings for the channel; ChanServ
+will also automatically give the founder channel-operator
+privileges when s/he enters the channel.
+
+NOTES:
+
+Channel passwords are no longer used, however, the command
+will still accept a password as a safety feature. The password
+you specify will be discarded. If you want to add a description,
+you must also specify a password.
+
+In order to register a channel, you must have first registered
+your nickname. If you haven't, %B/msg NickServ HELP%B for
+information on how to do so.
--- /dev/null
+%BChanServ RESYNC%B Synchronizes users in the channel with the
+userlist. This means that if the user can normally get ops,
+ChanServ makes sure the user has ops. Otherwise, if the user
+normally gets voice, ChanServ makes sure the user has voice but
+not ops. Otherwise, ChanServ makes sure the user has neither
+voice nor ops.
+
+This is actually implemented via CS CLEAR <#chan> OPS, and a
+CS UP #chan <all users>
+
+Syntax: %BRESYNC%B %U#channel [#channel [#channel]]%U
--- /dev/null
+%BChanServ SET%B allows the channel founder to set various
+channel options and other information
+
+Settings:
+ FOUNDER Set the founder for a channel
+ SUCCESSOR Set the successor for a channel
+ UNSUCCESSOR Remove the successor for a channel
+ PASSWORD Set the channel password
+ DESC Set the channel description
+ OPGUARD Stricter control of chanop status
+ SPLITOPS Let anyone keep ops from a netsplit
+ VERBOSE Notify chanops on command usage
+ NEVEROP Make a channel opless
+ WELCOMEINCHAN Puts WELCOME messages into the channel.
+ This flag doesn't do what you think it does.
+ Don't use it.
+ AUTOVOICE Voices everyone who joins the channel.
+ BANTYPE Selects the ban-type to be used for KICKBAN and AKICKs
+
+Oper only flags:
+ HOLD Prevent channel from expiring
+ FREEZE Suspend access in this channel
+ BOTSTAY Make the bot stay in the channel when empty.
+ LOG Tells LogServ to join and log the channel.
+
+For more help about a specific setting, type:
+%B/cs help set%B %Usetting%U
--- /dev/null
+%BChanServ SET BANTYPE%B determines the kind of ban that
+ChanServ will use for kickbans and akicks.
+Default is 2.
+
+ 0 - *!user@host.domain
+ 1 - *!*user@host.domain
+ 2 - *!*@host.domain
+ 3 - *!*user@*.domain
+ 4 - *!*@*.domain
+ 5 - nick!user@host.domain
+ 6 - nick!*user@host.domain
+ 7 - nick!*@host.domain
+ 8 - nick!*user@*.domain
+ 9 - nick!*@*.domain
--- /dev/null
+%BChanServ SET DESC%B sets the description for the channel,
+which can be seen with the %BChanServ INFO%B command.
+
+Syntax: %BSET%B %U#channel%U %BDESC%B %Udescription%U
--- /dev/null
+%BChanServ SET FOUNDER%B changes the founder of a channel.
+You must be the current founder of the channel, and the new
+founder must have a registered nick.
+
+Syntax: %BSET%B %U#channel%U %BFOUNDER%B %Unick%U
+
+Once you have used this command, you will be automatically
+moved to the channel's co-founder list; you may then remove
+yourself or demote yourself to any lower rank.
--- /dev/null
+%BChanServ SET HOLD%B Sets whether the given channel will
+expire. Setting this to ON prevents the channel from
+expiring.
+
+Syntax: ChanServ SET #channel HOLD <ON/OFF>
--- /dev/null
+%BChanServ SET NEVEROP%B Prevents services from opping users
+in the channel. Users may still use the UP command to gain
+chanop.
+
+Syntax: %BSET #chan NEVEROP %U{ON|OFF}%U%B
--- /dev/null
+%BChanServ SET OPGUARD%B makes ChanServ strictly
+control channel status.
+
+Syntax: %BSET%B %U#channel%U %BOPGUARD%B %UON/OFF%U
+
+When OpGuard is set to ON, only people with the
+appropriate permission will be allowed to grant
+channel status to other users.
+
+Note: This setting will have no effect unless you
+also change the %BLEVELS%B settings for VOICE, HOP,
+OP, and/or PROTECT. See %B/cs help levels%B
--- /dev/null
+%BChanServ SET PASSWORD%B changes the password of a channel.
+
+Syntax: %BSET%B %U#channel%U %BPASSWORD%B %Upassword%U
+
+Note: Channel passwords cannot be used; this command
+exists only for completeness.
--- /dev/null
+%BChanServ SET SPLITOPS%B allows users that gain ops from
+initial join or a netsplit to keep their ops. This can
+avoid mass-deops in a channel where not everyone is
+identified to NickServ, but may make channel takeovers
+easier.
+
+Syntax: SET <channel> SPLITOPS {ON|OFF}
--- /dev/null
+%BChanServ SET SUCCESSOR%B changes the successor of a channel.
+The new successor must have a registered nick.
+
+Syntax: %BSET%B %U#channel%U %BSUCCESSOR%B %Unick%U
+
+The channel successor will be made founder in case the original
+founder's nick is expired or dropped. A channel with no
+successor will expire along with the founder's nick.
--- /dev/null
+%BChanServ SET UNSUCCESSOR%B Removes the successor of a
+channel.
+
+Syntax: %BSET%B %U#channel%U %BUNSUCCESSOR%B
+
+For more information about successors, type:
+%B/cs help set successor%B
--- /dev/null
+%BChanServ SET VERBOSE%B enables various channel notices for
+ChanServ and BotServ commands.
+
+ VOICE/HOP/OP/PROTECT - Set and Unset
+ AKick - Add/Delete/Move/Wipe
+ VOp/HOp/AOp/SOp/CoFounder - Add/Delete/Move/Wipe
+ BotSay - Usage
--- /dev/null
+%BChanServ SET WelcomeInChan%B instructs services to send
+WELCOME messages to the channel when a user joins, rather
+than to the user as a private NOTICE.
+
+This flag probably doesn't do what you think it does.
+Don't use it.
+
+Syntax: %BSET #chan WelcomeInChan %U{ON|OFF}%U%B
--- /dev/null
+%BChanServ SOP%B maintains the super-op list for a channel.
+
+Syntax: %BSOP%B %U#channel%U %BADD%B %Unick%U
+ %BSOP%B %U#channel%U %BDEL%B %Unick%U
+ %BSOP%B %U#channel%U %BLIST%B [%Umask%U]
+ %BSOP%B %U#channel%U %BWIPE%B
+
+The %BSOP ADD%B command adds the given nickname to the list.
+If the target has SET AUTH on, a demotions is handled by
+deleting the target's access, so they may accept the demotion,
+or no access at all.
+
+The %BSOP DEL%B command removes the given nick from the list.
+
+The %BSOP LIST%B command displays the list.
+if a mask is given, only those entries matching the mask are
+displayed.
+
+The %BSOP WIPE%B command removes all entries from the list.
--- /dev/null
+%BChanServ UNBAN%B Tells ChanServ to remove all bans
+preventing you or another person from entering the given
+channel, or remove particular ban-masks.
+
+Syntax: %BUNBAN %U#channel%U [nick|mask]%B
+
+By default limited to %BAOP%B
+
+To unban all, use /cs clear #channel bans
--- /dev/null
+%BChanServ UOP%B maintains the user list for a channel.
+
+Syntax: %BUOP%B %U#channel%U %BADD%B %Unick%U
+ %BUOP%B %U#channel%U %BDEL%B %Unick%U
+ %BUOP%B %U#channel%U %BLIST%B [%Umask%U]
+ %BUOP%B %U#channel%U %BWIPE%B
+
+The %BUOP ADD%B command adds the given nickname to the list.
+If the target has SET AUTH on, a demotions is handled by
+deleting the target's access, so they may accept the demotion,
+or no access at all.
+
+The %BUOP DEL%B command removes the given nick from the list.
+
+The %BUOP LIST%B command displays the list.
+if a mask is given, only those entries matching the mask are
+displayed.
+
+The %BUOP WIPE%B command removes all entries from the list.
--- /dev/null
+%BChanServ UP%B has two syntaxes.
+
+First form gives you the highest channel ops you are allowed
+in the channels you specify. If you specify no channels, all
+channels will be affected.
+
+Second form gives the highest channel ops allowed to the
+nick[s] in the channel you specify.
+
+Syntax: %BUP%B [%Uchannel%U [%Uchannel%U ...]]
+Syntax: %BUP%B %Uchannel%U %Unick%U [[%Unick%U] ...]
--- /dev/null
+%BChanServ VOICE%B allows you to set channel-voice mode on either
+yourself or on other people in a channel.
+
+Syntax:
+ VOICE <channel> [nick [nick ...]]
+ VOICE <channel> [channel [channel]]
--- /dev/null
+%BChanServ VOP%B maintains the auto-voice list for a channel.
+Users on this list are given voice status upon joining
+the channel.
+
+Syntax: %BVOP%B %U#channel%U %BADD%B %Unick%U
+ %BVOP%B %U#channel%U %BDEL%B %Unick%U
+ %BVOP%B %U#channel%U %BLIST%B [%Umask%U]
+ %BVOP%B %U#channel%U %BWIPE%B
+
+The %BVOP ADD%B command adds the given nickname to the list.
+If the target has SET AUTH on, a demotions is handled by
+deleting the target's access, so they may accept the demotion,
+or no access at all.
+
+The %BVOP DEL%B command removes the given nick from the list.
+
+The %BVOP LIST%B command displays the list.
+if a mask is given, only those entries matching the mask are
+displayed.
+
+The %BVOP WIPE%B command removes all entries from the list.
--- /dev/null
+%BChanServ WELCOME%B allows you to maintain the channel welcome
+list. The contents of this list will be sent to every user who
+joins your channel.
+
+Syntax: %BWELCOME%B %U#channel%U %BADD%B %Umessage%U
+ %BWELCOME%B %U#channel%U %BDEL%B %Unumber%U
+ %BWELCOME%B %U#channel%U %BLIST%B
+
+The %BWELCOME ADD%B command adds a message to the welcome list.
+
+The %BWELCOME DEL%B command removes a message from the list.
+
+The %BWELCOME LIST%B command displays the contents of the list.
--- /dev/null
+%BChanServ WHY%B tells what status a user has in a channel.
+
+Syntax: %BWHY%B %U#channel%U %Unick%U
--- /dev/null
+Commands:
+ RAW Send a command in the raw. Must be Server Protocol Format.
+ Requires Services Rank: Services Root or IRCd Rank: NetAdmin.
+ LSMOD Lists all modules loaded.
+ SHUTDOWN Shuts down the services system.
+ Requires Services Rank: Services Admin or IRCd Rank: Server Admin.
--- /dev/null
+%BHostServ%B allows IRC Operators to change vhosts and add auto
+hosting for a registered nick
+
+%BCommands:
+ SETHOST Add or change vHost for a registered nick.
+ DEL Delete vHost from a nick
+ LIST Show nick list of vHosts
+ ON Activate your vHost
+ OFF Unset umode xt to disable your vHost.
--- /dev/null
+%BHostServ DEL%B deletes a vHost from a registered nick.
+
+Syntax: %BDEL%B %Unick%U
--- /dev/null
+%BHostServ LIST%B displays a list of vHosts matching a mask.
+
+Syntax: %BLIST%B %Umask%U
--- /dev/null
+%BHostServ OFF%B resets your vHost to your cloakhost.
+
+Syntax: %BOFF
--- /dev/null
+%BHostServ ON%B activates the vHost currently assigned to the
+nick in use. When you use this command any user who performs a
+whois on you will see the vHost instead of your real host.
+
+Syntax: %BON
--- /dev/null
+%BHostServ SETHOST%B sets the vHost for the given nick to that
+of the given hostmask. If your IRCD supports vIdents, then
+using SET <nick> <ident>@<hostmask> set idents for users as well
+as vhosts.
+
+Syntax: %BSET%B %Unick%U %Uvhost%U
--- /dev/null
+%BMemoServ%B is a utility allowing IRC users to send short
+messages to other IRC users, whether they are online at
+the time or not. Both sender and recipient must have
+their nicknames registered with %BNickServ%B in order to
+send a memo.
+
+Commands:
+ SEND Send a memo to a nick/channel
+ CSEND Send a channel memo to higher access levels
+ LIST List all of your memos
+ READ Read a memo
+ DEL Delete a memo
+ IGNORE Block memos coming from a specific person
+
+For more help on a specific command, type: %B/ms help%B %Ucommand%U
--- /dev/null
+Syntax: \ 2CSEND #<chan> [\1fAOP\1f|\1fSOP\1f|\1fCF\1f] <message>\ 2
+
+This command will send a channel memo to only the
+higher channel access users.
+Selections: AOP = Will send to all AOP/SOP/CF
+ SOP = Will only send to SOP and Co-Founders
+ CF = Will only send to Channel Founders
+* Note: The Founder receives memos from any selection.
+ Also, selecting ALL or AVOICE will just send
+ a general channel memo.
+
+EX: /MSG MemoServ CSEND #mychan SOP hello all
+
+The Above example will send "hello all" to the
+channel's Super-Ops, Co-Founders and Founder.
--- /dev/null
+%BMemoServ CSEND%B allows you to send a channel memo
+to users of a certain rank or higher.
+
+Syntax: %BCSEND%B %U#channel%U %Urank%U %Umessage%U
+
+Valid ranks include: UOP, VOP, HOP, AOP, SOP, CF, FOUNDER
--- /dev/null
+%BMemoServ DEL%B deletes a memo, a series of memos, or all memos.
+
+Syntax: %BDEL%B %Unumber%U
+ %BDEL%B %Unumber1-number2%U
+ %BDEL%B %Unumber1..number2%U
+ %BDEL ALL%B
--- /dev/null
+%BMemoServ IGNORE%B gives you the ability to manage a
+permanent MemoServ ignore list with this command. All
+nicknames added to your ignore list must be registered. If a
+nickname on your ignore list tries to send you a memo, the
+ignored person will be notified that they are on your ignore
+list and you do not wish to receive any memos from them.
+
+%BSyntax: IGNORE [ADD|DEL|LIST] [<nick>]%B
+
+This is a good way to avoid memos from people who spam you.
+They can get around an ignore by registering a different
+nickname, but if people do so just to continue spamming, you
+can report them to networks staff.
+
+MemoServ abuse is uncommon since it requires that the person
+register a nick to do it, and thus leaves a record of who
+was causing problems.
+
+Examples:
+/msg memoserv ignore add benny
+/msg memoserv ignore del Dainera
+/msg memoserv ignore list
--- /dev/null
+\ 2MemoServ\ 2 is a utility allowing IRC users to send short
+messages to other IRC users, whether they are online at
+the time or not. Both sender and recipient must have
+their nicknames registered with \ 2NickServ\ 2 in order to
+send a memo.
+
+MemoServ's commands include:
+
+Core Commands:
+
+SEND - Send a memo to a nick/channel
+CSEND - Send a channel memo to higher access levels
+LIST - List all of your memos
+READ - Read a memo
+DEL - Set Delete flag for a memo (or all memos)
+UNDEL - Remove the delete flag for a memo (or all memos)
+UNSEND - Retrieve a memo sent to a user
+PURGE - Erase all marked memos as deleted
+FORWARD - Have memos forwarded to another registered nick
+MARK - MARK a memo that you do not want to expire
+UNMARK - UNMARK a memo that you do not want to expire
+NEWS - Recent news and information about network
+SET - Set options related to memos
+
+Type \ 2/msg MemoServ HELP \1fcommand\1f\ 2 for help on any of the
+above commands.
--- /dev/null
+%BMemoServ LIST%B lists the memos you currently have. Unread memos
+are displayed in bold.
+
+Syntax: %BLIST%B
--- /dev/null
+Syntax: %BREAD {%Bnum%B|%BLAST%B}%B
+
+Sends you the text of memo number %Bnum%B, or of the last
+(i.e. most recently received) memo if LAST is given
+instead of a number.
--- /dev/null
+%BMemoServ SEND%B allows you to send a memo to a nick or channel.
+
+Syntax: %BSEND%B %Unick/#chan%U %Umessage%U
--- /dev/null
+Syntax: \ 2UNSEND \1fnick\1f\ 2
+
+Retrieves the latest memo you sent to
+the person, and deletes it. This feature
+currently only works for nicks, not channels.
--- /dev/null
+%BNickServ%B allows you to register a nickname and prevent others
+from using it.
+
+Commands:
+ REGISTER Register a nickname
+ SET Change settings
+ IDENTIFY Authorize yourself using a password
+ SIDENTIFY Identify and change to that nickname.
+ GIDENTIFY Identify, GHOST, and change to that nickname.
+ GHOST Kill a user who is using your nick
+ RECOVER Recovers/jupes a nick to stop another user from using it.
+ RELEASE Releases your nick from services custody
+ INFO Get information about a nick
+ DROPGROUP Delete a registered nickname and all aliases
+
+ LINK Make an alias of your nick
+ UNLINK Remove an alias
+ DROP Same as UNLINK
+ CHGROOT Change your root nick
+
+Additional Commands:
+ GLIST ALIST WATCH SILENCE ACC SEEN
+ LOGOUT LIST AUTH AUTHCODE SENDPASS PROFILE
+
+%BNOTICE:%B This service is intended to provide a way for IRC users to
+ensure their identity is not compromised. It is NOT intended to
+facilitate "stealing" of nicknames or other malicious actions. Abuse
+of NickServ will result in, at minimum, loss of the abused nicknames.
+
+For more help on a specific command, type: %B/ns help%B %Ucommand%U
--- /dev/null
+%BNickServ ACC%B allows you to view the current status of a nickname. It
+is intended to be used by scripts.
+
+Syntax: %BACC%B %Unick%U
+
+The codes have the following meanings:
+ 0 The nick is not registered.
+ 1 The nick is registered but not in use.
+ 2 The nick is in use but the user has not identified.
+ 3 The nick is in use and the user has identified.
--- /dev/null
+%BNickServ ACC%B Returns whether the user using the given
+nickname is recognized as the owner of the nickname. The
+response has this format:
+
+ %Bnickname%B %Bacc-code%B
+
+%Bacc-code%B is one of the following:
+
+ 0 - Nickname Unregistered
+ 1 - Registered, Offline
+ 2 - UnIdentified
+ 3 - Identified via password authentication
+ 4 - Identified via access list
+ 5 - Forbidden Nickname
+
+Syntax: %BACC%B <%Bnickname%B>
+
--- /dev/null
+%BNickServ ALIST%B allows you to view a list of channels where a nick
+has access.
+
+Syntax: %BALIST%B [%Unick%U [%Unick%U ...]]
+
+If you do not specify a nick, your current nick will be used.
--- /dev/null
+%BNickServ AUTH%B is used for reviewing and approving/rejecting
+channel access grants.
+
+ACCEPT - Approve the authorization request and memo the person confirmation.
+APPROVE - Same as accept.
+DECLINE - Decline the authorization request and memo the person
+ that you will not be added to that channel list.
+REJECT - Same as decline
+LIST - List auth requests.
+
+Syntax: AUTH [nick] <LIST|ACCEPT|DECLINE> [num|chan]
+
+If you do not want to be added to that channel list, use decline or reject.
+Demotions are handled by deleting the target's access, so they may accept
+the demotion, or no access at all.
+
+Other related commands:
+/msg nickserv help set auth
--- /dev/null
+%BNickServ AUTHCODE%B is used for nick registrations when email
+verification is enabled, or for sendpass when password-hashing
+is enabled.
+
+More information on its use should be in the email you receive.
+
+Syntax: %BAUTHCODE%B %Unickname%U %Ucode%U [%Unewpassword%U]
--- /dev/null
+%BNickServ CHGROOT%B sets the "root" nickname for your
+nickname group. The root nick is the one that will appear
+in various displays as your main nick.
+
+Syntax: %BCHGROOT%B [%Uoldroot%U] %Unewroot%U
--- /dev/null
+%BNickServ DROP%B allows you to relinquish a previously registered
+nickname.
+
+Syntax: %BDROP%B %Unick%U %Upassword%U
--- /dev/null
+%BNickServ DROPGROUP%B allows you to delete a whole group of
+nicks/aliases
+
+Syntax: %BDROPGROUP%B %Unick%U %Upassword%U
--- /dev/null
+%BNickServ EMAILREG%B is used for nick registrations when email
+verification is enabled.
+
+More information on its use should be in the email you receive.
+
+Syntax: %BEMAILREG%B %Unickname%U %Ucode%U
--- /dev/null
+%BNickServ GHOST%B terminates a "ghost" IRC session using
+your nick. A "ghost" session is one which is not actually
+connected, but which the IRC server believes is still online.
+Typically, this happens when your Internet connection goes down
+while you're on IRC.
+
+Syntax: %BGHOST%B %Unickname%U [%Upassword%U]
+#
+#In order to use the GHOST command for a nick, your current
+#address as shown in /WHOIS must be on that nick's access
+#list, or you must supply the correct password for the
+#nickname.
+#
+#This command also identifies you to your nick if you are not
+#already.
--- /dev/null
+%BNickServ GIDENTIFY%B is similar to the IDENTIFY command. The
+difference is GIDENITFY changes your nickname while
+identifying, and will use GHOST if the target nick is
+currently online.
+
+Syntax: GIDENTIFY <nick> <password>
+
+Examples:
+ IDENTIFY n00b
+ IDENTIFY Soulja soulseeker
+ ID bob thebuilder
--- /dev/null
+%BNickServ GLIST%B allows you to view a list of linked nicks.
+
+Syntax: %BGLIST%B [%Unick%U [%Unick%U ...]]
+
+If you do not specify a nick, your current nick will be used.
+
+%BLINKS%B is an alias for %BGLIST%B.
--- /dev/null
+link.txt
\ No newline at end of file
--- /dev/null
+%BNickServ IDENTIFY%B tells NickServ that you are really
+the owner of this nick. Many commands require you to
+authenticate yourself with this command before you use them.
+The password should be the same one you sent with the
+%BREGISTER%B command.
+
+Syntax: %BIDENTIFY%B [%Unick%U] %Upassword%U
+
+Examples:
+ IDENTIFY n00b
+ IDENTIFY Soulja soulseeker
+ ID bob thebuilder
+
+You MUST specifiy the nick if identifying to a nick you're
+not using right now, or for nicks with %BHIGH%B or %BKILL%B
+protection.
--- /dev/null
+%BNickServ INFO%B displays information about the given
+nicknames, such as the nick's owner, last seen address and
+time, and nick options.
+
+Syntax: %BINFO%B %Unickname%U [%Unickname%U ...]
--- /dev/null
+%BNickServ LINK%B links your current nickname to another
+nickname. Linked nicknames share everything from access
+lists and settings to memos.
+
+Syntax: %BLINK%B %Unick%U %Upassword%U
+
+This command does NOT support linking two groups together.
+
+%BGROUP%B is an alias for %BLINK%B.
--- /dev/null
+glist.txt
\ No newline at end of file
--- /dev/null
+%BNickServ LIST%B is used by opers to find registered nicks that
+match wildcard patterns.
+
+Syntax: %BLIST%B %Umask%U
+
+Masks are quite flexible, and can be as simple as nick*! or
+ident@*host
--- /dev/null
+%BNickServ LOGOUT%B logs you out of all nicks that you are
+identified. THE USE OF THIS COMMAND IS LOGGED.
+
+Syntax: %BLOGOUT%B
--- /dev/null
+%BNickServ PROFILE%B stores information about you for others
+to read.
+
+Syntax: %BPROFILE READ%B %Unickname%U [%Unickname%U ...]%B
+ %BPROFILE%B [%Unick%U] %BSET%B %Uitem%U %Udata%U
+ %BPROFILE%B [%Unick%U] %BDEL%B %Uitem%U
+ %BPROFILE%B [%Unick%U] %BWIPE%B
+
+The %BPROFILE READ%B command displays PROFILE data for you
+or for a list of registered nicks.
+
+The %BPROFILE SET%B command adds an entry to your profile.
+
+%BExamples:%B
+ /ns profile set aim blahblah123
+ /ns profile set myspace http://www.myspace.com/you
+ /ns profile set birthday June 9, 1969
+ /ns profile set mood sassy
+
+%BWARNING%B: Don't put private information in your profile.
+There are no restrictions on who can read it.
+
+The %BPROFILE DEL%B command removes an entry from your profile.
+
+The %BPROFILE WIPE%B command deletes your entire profile.
--- /dev/null
+%BNickServ RECOVER%B allows you to get back your nick if
+someone else is using it. It's slightly nicer than GHOST.
+
+NickServ will change the target's nick to a guestnick, and
+jupes the nick for one minute. To use it yourself, use
+%BNS RELEASE%B, then change your nick, OR use %BNS SIDENTIFY%B
+
+Syntax: %BRECOVER%B %Unickname%U [%Upassword%U]
+
+This command also identifies you to your nick if you are not
+already. If you are already identified, the password is
+optional.
--- /dev/null
+%BNickServ REGISTER%B allows you to reserve a particular nickname for
+your own use and prove your identity using a password.
+
+Syntax: %BREGISTER <password> <e-mail>%B
+
+%BNOTICE:%B The email address is %BNOT%B optional and you are strongly
+discouraged from using a fake address, as this will make it impossible
+to prove your ownership of a nick should you forget your password.
--- /dev/null
+%BNickServ RELEASE%B removes any hold on your nickname. NickServ
+will hold a nickname that is used without authorization for one
+minute; this command releases it sooner.
+
+Syntax: %BRELEASE%B %Unickname%U [%Upassword%U]
--- /dev/null
+%BNickServ SEEN%B displays how long it has been since a user identified
+to a nick.
+
+Syntax: %BSEEN%B %Unick%U
--- /dev/null
+%BNickServ SENDPASS%B sends the password (or an authentication
+code) to the email-address that the target nick is registered
+with.
+
+As currently implemented, this command is only available to
+Network Staff.
+
+Syntax: %BSENDPASS%B %Utarget%U
--- /dev/null
+%BNickServ SET%B allows you to change the various settings associated
+with your nickname. The following settings are available:
+
+ PROTECT Protect your nick from unauthorized use.
+ PASSWORD Change your password.
+ EMAIL Change your email address.
+ HIDEMAIL Hide your email address from other users.
+ NOMEMO Block memos sent to this nick.
+ NOACC Prevent this nick from being added to channel access lists.
+ NEVEROP Prevent ChanServ from automatically granting you channel
+ operator status.
+ AUTH Prevent others from adding you to channel access lists
+ without authorization from you.
+ VACATION Extend the time your nick will last before expiring.
+ ROOT Change the root nick for your nickgroup.
+
+Oper only flags:
+ HOLD Prevent channel from expiring
+ FREEZE Suspend access in this channel
+ EMAILREG If enabled, forces user to revalidate their email address.
+ If disabled, force validates their email address.
+
+For more information on a specific option, type:
+%B/msg nickserv help set <option>%B
--- /dev/null
+NickServ SET AUTH enables selective Channel Rank acceptance.
+See HELP NickServ AUTH for more information.
+
+Syntax: %BSET [nick] AUTH %U{ON|OFF}%U%B
--- /dev/null
+root.txt
\ No newline at end of file
--- /dev/null
+%BNickServ SET EMAIL%B Associates the given E-mail address with
+the nick. This address will be displayed whenever someone
+requests information on the nick with the INFO command.
+
+Syntax: %BSET [nick] EMAIL %Uaddress%U%B
+
+The %BHIDEMAIL%B command will hide your email from INFO
+requests.
+
+If %BHIDEMAIL%B is given, your email will no longer be hidden
+and will be visible to all in INFO requests.
\ No newline at end of file
--- /dev/null
+%BNickServ SET GREET%B sets the message that will be
+displayed when joining a channel that you have sufficient
+access to and has GREET enabled.
+
+Syntax: SET GREET <NONE|message>
+
+NONE will remove/unset your greet.
--- /dev/null
+%BNickServ SET HIDEMAIL%B hides your email address from users.
+
+Syntax: %BSET [nick] HIDEMAIL%B %UON/OFF%U
+
+If %BHIDEMAIL%B is disabled, your email will no longer be
+hidden and will be visible in your NickServ INFO listing.
--- /dev/null
+%BNickServ SET HOLD%B Sets whether the given nick will
+expire. Setting this to ON prevents the nick from
+expiring.
+
+Syntax: NickServ SET [nick] HOLD <ON/OFF>
--- /dev/null
+%BNickServ SET NEVEROP%B Prevents services from giving you
+channel status upon channels. You may still use the UP command
+to gain your status.
+
+Syntax: %BSET [nick] NEVEROP %U{ON|OFF}%U%B
--- /dev/null
+%BNickServ SET NOACC%B Prevents other people from adding
+you to channel access lists.
+
+Syntax: %BSET [nick] NOACC %U{ON|OFF}%U%B
--- /dev/null
+%BNickServ SET NOMEMO%B blocks incoming memos for your current
+nick. This does not prevent you from sending memos, it will
+only block receieving memos to you from others.
+
+Syntax: %BSET [nick] NOMEMO %U{ON|OFF}%U%B
--- /dev/null
+%BNickServ SET PASSWD%B Changes the password used to
+identify you as the nick's owner
+
+Syntax: %BSET [nick] PASSWD%B %Upassword%U
--- /dev/null
+%BNickServ SET PROTECT%B allows you to control the extent to which
+your nick will be protected from unauthorized use.
+
+Syntax: %BSET [nick] PROTECT (OFF|ON|HIGH|KILL)%B
+
+With PROTECT OFF, anyone may use your nick without authorization.
+
+With PROTECT ON, users of your nick must identify within
+one minute or their nick will be changed. This is the default.
+
+With PROTECT HIGH, users must identify before using your nick
+or their nick will be changed immediately.
+
+With PROTECT KILL, users must identify before using your nick
+or they will be disconnected from IRC.
--- /dev/null
+%BNickServ SET ROOT%B is an alias for NS CHGROOT.
+
+See NS HELP CHGROOT for more information.
+
--- /dev/null
+%BNickServ SET UMODE%B sets the umodes that NickServ will set
+on you when you identify.
+
+Syntax: %BSET [nick] UMODE %U<+modes-modes|none>%U%B
--- /dev/null
+%BNickServ SET VACATION%B extends the time limit on nick
+expiration from %E$services::conf{'nickexpire'}%E days to %E$services::conf{'vacationexpire'}%E days. Your nick must
+be at least %Eint($services::conf{'vacationexpire'}/3)%E days old for this to be available.
+
+The flag is cleared on your next identify, and you will not be
+able to use it again until %Eint($services::conf{'vacationexpire'}/3)%E days have passed.
+
+Syntax: %BSET%B [%Unick%U] %BVACATION%B %Uon%U/%Uoff%U
--- /dev/null
+%BNickServ SIDENTIFY%B is similar to the IDENTIFY command. The
+difference is SIDENITFY changes your nickname while
+identifying.
+It will automatically release an enforced nick, but it will
+not ghost or recover your nick if another user is using it.
+
+Syntax: SIDENTIFY <nick> <password>
+
+Examples:
+ SIDENTIFY n00b
+ SIDENTIFY Soulja soulseeker
+ SID bob thebuilder
+
+Example:
+/msg nickserv sidentify yournick yourpass
+This command is mostly useful if you use HIGH protection on your nickname.
--- /dev/null
+%BNickServ SILENCE%B allows you to view and modify your NickServ silence
+list. Users on your silence list will not be able to send you private
+messages.
+
+Syntax: %BSILENCE ADD%B %Unick!ident@host%U [%U+expiry%U] [%Ucomment%U]
+ %BSILENCE ADD%B %Unick%U [%U+expiry%U] [%Ucomment%U]
+ %BSILENCE DEL%B %Unick!ident@host%U
+ %BSILENCE LIST%B
+
+The %BSILENCE ADD%B command adds a nick or hostmask to your silence list.
+Expiry and comment are both optional.
+
+The %BSILENCE DEL%B command removes a hostmask from your silence list.
+
+The %BSILENCE LIST%B command displays your silence list.
+
+%BCAVEATS:%B You cannot have more than 32 silence entries.
--- /dev/null
+%BNickServ UNLINK%B allows you to delete a linked nickname.
+
+Syntax: %BUNLINK%B %Unick%U %Upassword%U
--- /dev/null
+%BNickServ WATCH%B allows you to view and modify your NickServ watch list.
+You will be notified when a user on your watch list connects to IRC.
+
+Syntax: %BWATCH ADD%B %Unick/mask%U
+ %BWATCH DEL%B %Unick/mask%U
+ %BWATCH LIST%B
+
+The %BWATCH ADD%B command adds the specified nick or hostmask to your
+watch list.
+
+The %BWATCH DEL%B command removes the specified nick or hostmask from
+your watch list.
+
+The %BWATCH LIST%B command displays your watch list.
+
+%BCAVEATS:%B You cannot use wildcards in nicks, and you cannot have more
+than 128 watch entries.
--- /dev/null
+%BOperServ%B provides various functions that may be used by
+IRC Operators.
+
+Commands:
+ FJOIN Force a user to join a channel.
+ FPART Force a user to part a channel.
+ UNIDENTIFY Log out a user from all nick identifies.
+ QLINE Maintain services QLINE list.
+ JUPE Introduce a fake server to network.
+ UINFO Get information about a user.
+ NINFO Get information about all users identified to
+ a nick.
+ SVSNICK Change a user's nick.
+ GNICK Change a user's nick to guest with random number.
+ STAFF List services operators.
+ LOGONNEWS Maintain logon news list.
+ EXCEPT Maintain clone exception list.
+ SESSION List the number of clones per host.
+ CHANKILL G:line all users in a channel.
+ REHASH Rehash all servers.
+ LONERS Get users that are in zero channels.
+ KILL KILLs a user normally.
+ SVSKILL KILLs a user with a specified quit message.
+ GLINE Adds and removes G:lines.
+ GZLINE Adds and removes Z:lines.
+ CLONES Lists and/or manipulates clones.
+ Similar to LONERS.
+ MASSKILL Alias for CLONES KILL.
--- /dev/null
+%BOperServ CHANKILL%B adds a G:line for every user in a channel,
+IRCOps excepted.
+
+Syntax: %BCHANKILL%B %U#channel%U %Ureason%U
--- /dev/null
+%BOperServ CLONES%B gets the list of clone-users that match a
+specific host, IP, or nickname and optionally:
+
+* retrieves %BUINFO%B,
+* sends a %BMSG%B to the users,
+* %BFJOIN%Bs the users,
+* %BKILL%Bs the users,
+* %BKLINE%Bs the users.
+
+Syntax: OS CLONES [LIST|UINFO|MSG|FJOIN|KILL|KLINE] [msg/reason]
+
+ LIST - Lists all users that match.
+ UINFO - Retrieves UINFO for all users that match. %BWARNING%B May flood you off.
+ MSG - Sends a NOTICE from OperServ to the users. Message is not optional. (DUH)
+ FJOIN - Force-Join to a channel.
+ KILL - Kill the users. Reason is optional, but recommended.
+ KLINE - G:Line the users. Reason is optional, but recommended.
--- /dev/null
+%BOperServ EXCEPT%B is used to add clone-limit exceptions.
+
+There are 3 different kinds of exceptions
+SERVER - All users on this server[mask]
+HOSTNAME - All users with this hostmask
+IP - All users in this IP Netblock
+
+The overall syntax isn't hard, just not well documented. Until
+now.
+
+OS EXCEPT SERVER ADD <name> <limit>
+OS EXCEPT SERVER DEL <name>
+OS EXCEPT HOSTNAME ADD <name> <limit>
+OS EXCEPT HOSTNAME DEL <name>
+
+and the only really different one, IP
+OS EXCEPT IP ADD <IP[/mask]> <limit>
+OS EXCEPT IP DEL <IP[/mask]>
+
+Mask is in bits, like CIDR notation.
+127.0.0.1/32 means 127.0.0.1-127.0.0.1
+or say AOL
+172.192.0.0/12 -> 172.192.0.0 - 172.207.255.255
+172.208.0.0/14 -> 172.208.0.0 - 172.211.255.255
+
+Sorry, it doesn't do the alternate CIDR format
+172.192.0.0/255.240.0.0
\ No newline at end of file
--- /dev/null
+%BOperServ FJOIN%B forces a user to join a channel.
+
+Syntax: %BFJOIN%B %Unick%U %U#channel%U
--- /dev/null
+%BOperServ FPART%B forces a user to part a channel.
+
+Syntax: %BFPART%B %Unick%U %U#channel%U
--- /dev/null
+%BOperServ GNICK%B forces a user to have their nick changed to a
+Guest. Commonly used when qlining, or when a user is otherwise
+using a nick they should not.
+
+Syntax: %BGNICK%B %Unick%U
--- /dev/null
+%BOperServ JUPE%B allows you to jupiter a server -- that is, to
+create a fake "server" connected to Services which prevents the
+real server of that name from connecting. The jupe may be
+removed using a standard SQUIT. To be used only in a situation
+where a server is disrupting the network and must be juped.
+
+Syntax: %BJUPE%B %Userver%U %Ureason%U
--- /dev/null
+%BOperServ KILL%B KILLs a user off the network.
+One possible use is to allow helpers to KILL.
+
+Syntax: %BKILL%B %Utarget%U %Ureason here%U
+
+Example: KILL erry not kool.
--- /dev/null
+%BOperServ LOGONNEWS%B handles the logonnews system.
+
+There are two lists. one for Users, and one for Opers (not
+finished yet). A news item may be permanent (does not expire) or
+may have a limited life (expires).
+
+Syntax: %BLOGONNEWS ADD%B %UU/O%U [%U+expiry%U] %Umessage%U
+ %BLOGONNEWS LIST%B %UU/O%U
+ %BLOGONNEWS DEL%B %UU/O%U %Unum%U
--- /dev/null
+%BOperServ LONERS%B gets the list of users in zero channels and
+optionally retrieves %BUINFO%B, sends a %BMSG%B, %BFJOIN%B,
+%BKILL%B, or %BKLINE%B. if you specify %BNOID%B it will only act on
+users that have not identified to any nicks.
+
+Syntax: OS LONERS [LIST|UINFO|MSG|FJOIN|KILL|KLINE] [NOTID] [msg/reason]
+
+If no command is specified, defauls to LIST.
+
+ LIST - Lists all users in zero channels
+ UINFO - Retrieves UINFO for all users in zero channels. %BWARNING%B May flood you off.
+ MSG - Sends a NOTICE from OperServ to the users. Message is not optional. (DUH)
+ FJOIN - Force-Join to a channel. Will obviously make them no longer be in zero channels.
+ KILL - Kill the users. Reason is optional, but recommended.
+ KLINE - G:Line the users. Reason is optional, but recommended.
+
+ NOTID - Only matches if the users are not identified to nicks.
+ May be used with any of the above.
+ Also aliased to NOIDENTIFY and NOID.
--- /dev/null
+%BOperServ NINFO%B calls OS UINFO for all clients identified
+to a nick.
+
+Syntax: %BNINFO%B %Unick%U
--- /dev/null
+%BOperServ QLINE%B prevents a nick or nickmask from being used,
+except by opers and services agents.
+
+Syntax: %BQLINE ADD%B [%U+expiry%U] %Umask%U %Ureason%U
+ %BQLINE DEL%B %Umask%U
+ %BQLINE LIST%B
--- /dev/null
+%BOperServ REHASH%B signals all servers to re-read their configuration
+files.
+
+Syntax: %BREHASH%B [%Utype%U]
--- /dev/null
+%BOperServ SESSION%B displays a list of hosts with more than a
+certain number of clones.
+
+Syntax: %BSESSION%B %Unumber%U
--- /dev/null
+%BOperServ STAFF%B lists all Services Operators.
+
+Syntax: %BSTAFF%B
--- /dev/null
+%BOperServ SVSKILL%B KILLs a user off the network with a custom
+QUIT message.
+
+This command is limited to %BServices Roots%B, as it is
+%Uhighly%U abuseable.
+
+Syntax: %BSVSKILL%B %Utarget%U %Ureason here%U
+
+Example: SVSKILL Alucard Quit: I am the very model of a modern major general.
--- /dev/null
+%BOperServ SVSNICK%B forcibly changes a user's nick.
+
+Syntax: %BSVSNICK%B %Uoldnick%U %Unewnick%U
--- /dev/null
+%BOperServ UINFO%B Allows IRC Operators to view additional
+status about a client. IE: Nicks identified, or channels joined
+regardless of modes (+s)
+
+Syntax: %BUINFO%B %Unick%U
--- /dev/null
+%BOperServ UNIDENTIFY%B logs a user out of any nicks they are
+identified to.
+
+Syntax: %BUNIDENTIFY%B %Unick%U
--- /dev/null
+- This is SecurityBot.
+
+- Available Commands:
+- NOTICE nick message: Say something.
+- MSG nick message: Say it again.
+- RAW message: Say it from the heart.
+
+- TOR-UPDATE: Update Tor server list
+
+- KILL nick reason: Commit murder.
+
+- CONF: View configuration.
+- SET name value: Edit configuration.
+- AUTH hostmask: Allow someone to control me.
+- REHASH: Revert configuration.
+- SAVE: Save configuration.
+
+- TSSYNC: Sync all the ircds clocks to services
+- TKL: Manipulate the TKL (G:line & Z:line) list
--- /dev/null
+%BSecurityBot TKL%B is a series of functions to make TKL
+handling easier. Specifically it will help in handling
+G:lines and GZ:lines.
+
+Syntax is as follows:
+
+TKL LIST [(+/- filters) [params]]
+TKL DEL <(+/- filters) <params>>
+
+Filters are case-sensitive.
+
+Filter-parameters may be delimited by // (for regexps) or
+"" (for regexps or strings). Otherwise space delimiters are
+assumed. if there is a mismatch in the filter vs param count,
+the command WILL fail.
+
+Filters may be any of:
+ Globbing filters
+ r %BReason%B
+ m %BMask%B (ident@host only)
+ s %BSetter%B
+ Regular Expression filters
+ R %BReason%B
+ M %BMask%B (ident@host only)
+ S %BSetter%B
+ Miscellaneous Filters
+ O/o %BOrder by%B (Sort by) - case insensitive.
+ negative is Descending, positive is Ascending.
+ You can specify multiple of these, but the
+ resulting sort order is not always intuitive.
+ Default is type,time,host Ascending.
+ Legal, but not necessarily meaningful for delete.
+ Available sort fields: %Btype%B, %Bident%B, %Bhost%B, %Bsetter%B,
+ %Bexpire%B, %Btime%B, %Breason%B.
+
+Example:
+
+TKL LIST -r+s *warez* *netadmin*
+would list all bans that do not include the word 'warez'
+and set by an oper with 'netadmin' in their vhost.
+
--- /dev/null
+#!/bin/bash
+
+for X in `pgrep services.pl`; do
+ if [[ `vdir /proc/$X/cwd |sed 's/.*-> //'` == `pwd` ]]; then
+ kill $X
+ fi
+done
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package event;
+use strict;
+
+use Event;
+use IO::Socket;
+
+# FIXME
+use SrSv::Timer;
+BEGIN { *addtimer = \&SrSv::Timer::add_timer }
+
+sub loop() {
+ Event::loop();
+}
+
+sub add_io_watcher(@) {
+ my $watcher = Event->io(@_);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package misc;
+use strict;
+
+sub isint($) {
+ my($x) = shift;
+ return (int($x) eq $x);
+}
+
+sub parse_quoted($) {
+ my ($in) = @_;
+ my @out;
+
+ my @qs = (
+ [qr/^\s*\"(.*?)(?<!\\)\"(.*)/,
+ sub { $_[0] =~ s/\\"/\"/g; return $_[0] }],
+ [qr/^\s*\/(.*?)(?<!\\)\/(.*)/,
+ sub { $_[0] =~ s#\\/#/#g; return $_[0] }],
+ [qr/(\S+)\s*(.*|$)/, undef]
+ );
+
+ do {
+ foreach my $q (@qs) {
+ my $str;
+ my ($re, $trans) = @$q;
+
+ if(my @x = ($in =~ $re)) {
+ ($str, $in) = @x;
+ $str = &$trans($str) if $trans;
+ push @out, $str;
+ #print "str: $str\nin: $in\n";
+ }
+ }
+ } while($in =~ /\S/);
+
+ return @out;
+}
+
+use constant { ORD_A => ord('A') };
+
+sub gen_uuid($$) {
+ my ($groups, $length) = @_;
+ my $emailreg_code = '';
+ for(my $i = 1; $i <= $groups; $i++) {
+ for (my $j = 1; $j <= $length; $j++) {
+ my $ch;
+ $emailreg_code .= (($ch = int(rand(36))) > 9 ? chr((ORD_A - 10) + $ch) : $ch);
+ }
+ $emailreg_code .= '-' unless $i >= $groups;
+ }
+ return $emailreg_code;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package modes;
+
+use strict;
+no strict 'refs';
+use constant {
+ DEBUG => 0,
+
+ DIFF => 1,
+ ADD => 2,
+ MERGE => 3
+};
+
+# This gives what we need to do to bring a current modeset into compliance
+# with a specified modeset (used for modelock)
+sub diff($$$) {
+ return calc($_[0], $_[1], $_[2], DIFF);
+}
+
+# This gives the result of applying the mode changes in the second parameter
+# to the existing modes in the first parameter.
+sub add($$$) {
+ return calc($_[0], $_[1], $_[2], ADD);
+}
+
+# This gives back the modes in the first parameter, with any modes in the
+# second overriding the first. (used to validate modelock setting)
+sub merge($$$) {
+ return calc($_[0], $_[1], $_[2], MERGE);
+}
+
+sub invert($) {
+ my @modes = split(/ /, $_[0]);
+
+ $modes[0] =~ tr/+-/-+/;
+
+ return join(' ', @modes);
+}
+
+# This removes the channel key, for info displays
+sub sanitize($) {
+ my ($modes, @parms) = split(/ /, $_[0]);
+ my @modes = split(//, $modes);
+ my ($c, $sign);
+
+ foreach my $m (@modes) {
+ if($m eq '+') { $sign = 1; next; }
+ if($m eq '-') { $sign = 0; next; }
+
+ if($sign) {
+ if($m =~ $ircd::ocm) {
+ $parms[$c] = '*' if $m eq 'k';
+ $c++;
+ }
+ }
+ }
+
+ return join(' ', $modes, @parms);
+}
+
+sub get_key($) {
+ my ($modes, @parms) = split(/ /, $_[0]);
+ my @modes = split(//, $modes);
+ my ($c, $sign);
+
+ foreach my $m (@modes) {
+ if($m eq '+') { $sign = 1; next; }
+ if($m eq '-') { $sign = 0; next; }
+
+ if($sign) {
+ if($m =~ $ircd::ocm) {
+ return $parms[$c] if ($m eq 'k');
+ $c++;
+ }
+ }
+ }
+
+ return undef;
+}
+
+# This is far from the best way to do it.
+#
+# 'bekfLlvhoaq' 'kfLlj'
+######
+# This really needs to be made more generic
+# learn more about $ircd::ocm $ircd::scm $ircd::acm
+######
+sub calc($$$$) {
+ my ($src, $dst, $chan, $type) = @_;
+
+ my ($smodes, @sargs) = split(/ /, $src);
+ my ($dmodes, @dargs) = split(/ /, $dst);
+
+ #$smodes =~ s/[bevhoaq]//g if $chan;
+
+ my @smodes = split(//, $smodes);
+ my @dmodes = split(//, $dmodes);
+
+ my $sign = 2;
+ my (@tmodes, @targs, @omodes, @oargs, $rmodes, @rargs, %status);
+
+ foreach my $x (@smodes) {
+ if($x eq '+') { $sign=2; next; }
+ if($x eq '-') { $sign=1; next; }
+ if($chan and $x =~ $ircd::scm) {
+ #shift @sargs if($sign == 2);
+ my $t = shift @sargs;
+ if($type == MERGE) {
+ $status{$x}{lc $t} = $sign;
+ }
+ next;
+ }
+ if($chan and $x !~ $ircd::acm) {
+ next;
+ }
+
+ if($type == DIFF or $type == ADD) {
+ $tmodes[ord($x)] = $sign if $type == DIFF;
+ $omodes[ord($x)] = $sign if $type == ADD;
+
+ if($chan and $sign == 2 and $x =~ $ircd::ocm) {
+ $targs[ord($x)] = shift @sargs if $type == DIFF;
+ $oargs[ord($x)] = shift @sargs if $type == ADD;
+ }
+ }
+
+ elsif($type == MERGE) {
+ if($chan and $sign == 2 and $x =~ $ircd::ocm) {
+ if(
+ ($x eq 'l' and $sargs[0] =~ /^\d+$/) or
+ ($x eq 'L' and $sargs[0] =~ /^#/) or
+ $x eq 'f' or $x eq 'k' or
+ ($x eq 'j' and $sargs[0] =~ /^\d+\:\d+$/)
+ ) {
+ $omodes[ord($x)] = $sign;
+ $oargs[ord($x)] = shift @sargs;
+ }
+ } else {
+ $omodes[ord($x)] = $sign;
+ }
+ }
+ }
+
+ foreach my $x (@dmodes) {
+ if($x eq '+') { $sign=2; next; }
+ if($x eq '-') { $sign=1; next; }
+ if($chan and $x =~ $ircd::scm) {
+ #shift @dargs if($sign == 2);
+ my $t = shift @dargs;
+ if($type == MERGE) {
+ $status{$x}{lc $t} = $sign;
+ }
+ next;
+ }
+ if($chan and $x !~ $ircd::acm) {
+ next;
+ }
+
+ if($chan and $sign == 2 and $x =~ $ircd::ocm) {
+ $oargs[ord($x)] = shift @dargs;
+ }
+
+ if(
+ $type == ADD or
+ $type == MERGE or
+ $type == DIFF and (
+ ($sign==2 or $tmodes[ord($x)]) and (
+ $sign != $tmodes[ord($x)] or
+ $targs[ord($x)] ne $oargs[ord($x)]
+ )
+ )
+ ) {
+ $omodes[ord($x)] = $sign;
+ }
+
+ # -k won't work without its parameter!
+ if($chan and $type == DIFF and $sign == 1 and $x eq 'k') {
+ $oargs[ord($x)] = $targs[ord($x)];
+ }
+ }
+
+ $sign = 0;
+ for(my $i = 0; $i < scalar @omodes; $i++) {
+ if($omodes[$i] == 2) {
+ if($sign != 2) { $sign = 2; $rmodes .= '+'; }
+ $rmodes .= chr($i);
+ push @rargs, $oargs[$i] if $oargs[$i];
+
+ }
+ }
+
+ if($type == MERGE) {
+ foreach my $m (keys(%status)) {
+ foreach my $v (keys(%{$status{$m}})) {
+ if($status{$m}{$v} == 2) {
+ if($sign != 2) { $sign = 2; $rmodes .= '+'; }
+ $rmodes .= $m;
+ push @rargs, $v;
+ }
+ }
+ }
+ }
+
+ if($type == DIFF or $type == MERGE) {
+ for(my $i = 0; $i < scalar @omodes; $i++) {
+ if($omodes[$i] == 1) {
+ if($sign != 1) { $sign = 1; $rmodes .= '-'; }
+ $rmodes .= chr($i);
+ push @rargs, $oargs[$i] if $oargs[$i];
+ }
+ }
+ }
+
+ if($type == MERGE) {
+ foreach my $m (keys(%status)) {
+ foreach my $v (keys(%{$status{$m}})) {
+ if($status{$m}{$v} == 1) {
+ if($sign != 1) { $sign = 1; $rmodes .= '-'; }
+ $rmodes .= $m;
+ push @rargs, $v;
+ }
+ }
+ }
+ }
+
+ #return undef if($rmodes eq '+');
+ print "modes::calc($src, $dst, $chan, $type)\n" if DEBUG();
+ print "--- MODE CALCULATED: ", join(' ', $rmodes, @rargs), "\n" if DEBUG();
+ return join(' ', $rmodes, @rargs);
+}
+
+# Splits modes into a hash
+# Skips modes in $ircd::scm (opmodes and banmodes)
+sub splitmodes($) {
+ my ($modes) = @_;
+ my (%modelist, @parms);
+ ($modes, @parms) = split(/ /, $modes);
+ my $sign = '+';
+ foreach my $mode (split(//, $modes)) {
+ if ($mode eq '+' or $mode eq '-') {
+ $sign = $mode;
+ }
+ elsif($mode =~ $ircd::scm) {
+ shift @parms;
+ }
+ elsif($mode =~ $ircd::ocm) {
+ push @{$modelist{$mode}}, $sign, shift @parms;
+ }
+ elsif($mode =~ $ircd::acm) {
+ push @{$modelist{$mode}}, $sign;
+ }
+ }
+ return %modelist;
+}
+
+sub splitumodes($) {
+ my ($modes) = @_;
+ my %modelist;
+ my $sign = '+';
+ foreach my $mode (split(//, $modes)) {
+ if ($mode eq '+' or $mode eq '-') {
+ $sign = $mode;
+ }
+ else {
+ $modelist{$mode} = $sign;
+ }
+ }
+ return %modelist;
+}
+
+# umodes that should not be settable by services
+# Most are OperModes [thus most are legal to be set for /os oper]
+our %unsafeumodes = (
+ o => 1, # Global Oper
+ O => 1, # Local Oper [wouldn't ever show up to remote servers]
+ A => 1, # Server Admin
+ C => 1, # Server CoAdmin (little diff in ability vs Admin)
+ a => 1, # Services Admin
+ N => 1, # Network Admin
+ W => 1, # See WHOIS events
+ g => 1, # see GLOBOPS
+ s => 1, # SNOMASKs. variable. has parameters, only settable via svssno
+ S => 1, # For Network Service Agents only. Protects from various
+ h => 1, # Can see /helpop msgs /.\ good for a helpop/helper
+ v => 1, # can see rejected/blocked DCC messages /.\ good for a helpop/helper
+ q => 1, # Can wok through walls. Kidding, avoid/block non-server/services kicks
+
+ z => 1, # Strictly speaking not unsafe, but shouldn't be allowed
+ t => 1, # Not unsafe either, but pointless as it won't have the desired effect
+ x => 1, # Ditto
+ r => 1 # This should be taken care of by identifying, if you're on a reg'd nick.
+);
+
+sub allowed_umodes($) {
+ my ($modes) = @_;
+ my %modelist = splitumodes($modes);
+ foreach my $mode (keys(%modelist)) {
+ $modelist{$mode} = undef if defined ($unsafeumodes{$mode});
+ }
+ return unsplit_umodes(%modelist);
+}
+
+# split + unsplit equals a modes::merge for umodes
+sub unsplit_umodes(%) {
+ my (%modelist) = @_;
+ my ($upmodes, $downmodes) = ('', '');
+ foreach my $mode (keys(%modelist)) {
+ if ($modelist{$mode} eq '+') {
+ $upmodes .= $mode;
+ }
+ elsif ($modelist{$mode} eq '-') {
+ $downmodes .= $mode;
+ }
+ }
+ return ($upmodes ne '' ? "+$upmodes" : '').($downmodes ne '' ? "-$downmodes" : '');
+}
+
+sub merge_umodes($;$) {
+# second param is optional as we may want to merge a string of mixed modes '+rh-x+i'
+ my ($umodes1, $umodes2) = @_;
+ return modes::unsplit_umodes(modes::splitumodes($umodes1 . ($umodes2 ? $umodes2 : '' ) ) );
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package module;
+use strict;
+no strict 'refs';
+
+use Symbol qw(delete_package);
+
+use SrSv::Conf2Consts qw(main);
+
+use constant {
+ ST_UNLOADED => 0,
+ ST_LOADED => 1,
+ ST_READY => 2,
+};
+
+our %modules;
+our %packages;
+our @modules;
+
+our @unload;
+our @load;
+
+sub load(@) {
+ my @m = @_;
+ @m = @modules = split(/\s*,\s*/, main_conf_load) unless @m;
+
+ foreach my $module (@m) {
+ next if ($modules{$module} and $modules{$module}[0] and !($modules{$module}[0] == ST_UNLOADED));
+
+ my $m = "./modules/$module.pm";
+ print "Loading module $module..."; # if $main::status==main::ST_PRECONNECT();
+ eval { require $m };
+ if($@) {
+ #if($main::status==main::ST_PRECONNECT()) {
+ print qq{ FAILED.\n\nModule "$module" failed to load.\n};
+
+ my $error = $@;
+ $error =~ s/\n(?:BEGIN failed--|Compilation failed in require).*(?:\n|$)//sg unless main::DEBUG();
+ print "Please read INSTALL and README.\nOr if you just upgraded, see UPGRADING.\n" unless main::DEBUG();
+ print "\n$error\n";
+ exit;
+ #} else {
+ # return $@;
+ #}
+ }
+
+ foreach my $p (@{"$module\::packages"}) {
+ $packages{$p}{$module} = 1;
+ }
+
+ print " done.\n"; #if $main::status==main::ST_PRECONNECT();
+
+ $modules{$module}[0] = ST_LOADED;
+ }
+
+ foreach my $module (@m) {
+ my $m = "$module\::init";
+ eval { &$m(); };
+
+ if($@) {
+ print qq{ FAILED.\n\nModule "$module" failed to load.\n};
+ print "\n$@\n";
+ exit;
+ }
+ }
+
+ return undef;
+}
+
+sub unload(@) {
+ my @m = @_;
+ @m = @modules unless @m;
+
+ unload_lazy(@m);
+
+ foreach my $module (@m) {
+ next unless $modules{$module}[0] == ST_UNLOADED;
+
+ delete_package $module;
+
+ foreach my $p (keys(%packages)) {
+ delete $packages{$p}{$module};
+
+ unless(keys(%{$packages{$p}})) {
+ delete_package $p;
+ }
+ }
+ }
+}
+
+sub unload_lazy(@) {
+ my @m = @_;
+ @m = @modules unless @m;
+
+ foreach my $module (@m) {
+ next unless $modules{$module}[0] == ST_LOADED;
+
+ my $m = "$module\::unload";
+ eval { &$m };
+ print $@ if $@;
+
+ $modules{$module}[0] = ST_UNLOADED;
+ }
+}
+
+sub begin(@) {
+ my @m = @_;
+ @m = @modules unless @m;
+
+ foreach my $module (@m) {
+ next unless $modules{$module}[0] == ST_LOADED;
+
+ my $m = "$module\::begin";
+ eval { &$m };
+ print $@ if $@;
+
+ $modules{$module}[0] = ST_READY;
+ }
+}
+
+sub end(@) {
+ my @m = @_;
+ @m = @modules unless @m;
+
+ foreach my $module (@m) {
+ next unless $modules{$module}[0] == ST_READY;
+
+ my $m = "$module\::end";
+ eval { &$m };
+ print $@ if $@;
+
+ $modules{$module}[0] = ST_LOADED;
+ }
+}
+
+sub is_loaded(@) {
+ foreach my $module (@_) {
+ return 0 if($modules{$module}[0] == ST_UNLOADED);
+ }
+
+ return 1;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package connectserv;
+
+use strict;
+no strict 'refs';
+
+use SrSv::IRCd::State 'initial_synced';
+use SrSv::IRCd::Event 'addhandler';
+
+use SrSv::Conf2Consts qw(main);
+
+use SrSv::Log;
+
+use SrSv::Process::InParent qw(
+ ev_nickconn ev_nickchange ev_quit ev_kill ev_umode ev_connect message
+);
+
+my %userlist;
+
+use SrSv::Agent;
+
+my $csnick = 'ConnectServ';
+
+agent_connect($csnick, 'services', undef, '+pqzBHS', 'Connection Monitor');
+agent_join($csnick, main_conf_diag);
+ircd::setmode($csnick, main_conf_diag, '+o', $csnick);
+
+addhandler('NICKCONN', undef, undef, 'connectserv::ev_nickconn', 1);
+sub ev_nickconn {
+ my ($nick, $ident, $host, $server, $gecos) = @_[0,3,4,5,9];
+
+ $userlist{lc $nick} = [$ident, $host, $gecos, $server];
+
+ return unless initial_synced();
+ message("\00304\002SIGNED ON\002 user: \002$nick\002 ($ident\@$host - $gecos\017\00304) at $server");
+}
+
+addhandler('NICKCHANGE', undef, undef, 'connectserv::ev_nickchange', 1);
+sub ev_nickchange {
+ my ($old, $new) = @_;
+ my ($ident, $host);
+ unless(lc($new) eq lc($old)) {
+ $userlist{lc $new} = $userlist{lc $old};
+ delete($userlist{lc $old});
+ }
+ ($ident, $host) = @{$userlist{lc $new}} if (defined($userlist{lc $new}));
+ message("\00307\002NICK CHANGE\002 user: \002$old\002 ($ident\@$host) changed their nick to \002$new\002");
+}
+
+addhandler('CHGIDENT', undef, undef, 'connectserv::ev_identchange', 1);
+sub ev_identchange {
+ my (undef, $nick, $ident) = @_;
+
+ my ($oldident, $host, $gecos, $server) = @{$userlist{lc $nick}} if (defined($userlist{lc $nick}));
+ $userlist{lc $nick} = [$ident, $host, $gecos, $server];
+
+ message("\00310\002IDENT CHANGE\002 user: \002$nick\002 ($oldident\@$host) changed their virtual ident to \002$ident\002");
+}
+
+addhandler('QUIT', undef, undef, 'connectserv::ev_quit', 1);
+sub ev_quit {
+ my ($nick, $reason) = @_;
+ my ($ident, $host, $gecos, $server);
+ if(defined($userlist{lc $nick})) {
+ ($ident, $host, $gecos, $server) = @{$userlist{lc $nick}};
+ delete($userlist{lc $nick});
+ }
+ return unless initial_synced();
+ message("\00303\002SIGNED OFF\002 user: \002$nick\002 ($ident\@$host - $gecos\017\00303) at $server - $reason");
+}
+
+addhandler('KILL', undef, undef, 'connectserv::ev_kill', 1);
+sub ev_kill {
+ my ($src, $target, $reason) = @_[0,1,3];
+ my ($ident, $host, $gecos, $server);
+ if(defined($userlist{lc $target})) {
+ ($ident, $host, $gecos, $server) = @{$userlist{lc $target}};
+ delete($userlist{lc $target});
+ }
+ message("\00302\002GLOBAL KILL\002 user: \002$target\002 ($ident\@$host) killed by \002$src\002 - $reason");
+}
+
+addhandler('UMODE', undef, undef, 'connectserv::ev_umode', 1);
+sub ev_umode {
+ my ($nick, $modes) = @_;
+ my @modes = split(//, $modes);
+ my $sign;
+ foreach my $m (@modes) {
+ $sign = 1 if $m eq '+';
+ $sign = 0 if $m eq '-';
+
+ my $label;
+ $label = 'Global Operator' if $m eq 'o';
+ $label = 'Services Administrator' if $m eq 'a';
+ $label = 'Server Administrator' if $m eq 'A';
+ $label = 'Network Administrator' if $m eq 'N';
+ $label = 'Co Administrator' if $m eq 'C';
+ $label = 'Bot' if $m eq 'B';
+
+ if($label) {
+ message("\00306\002$nick\002 is ".($sign ? 'now' : 'no longer')." a \002$label\002 (".($sign ? '+' : '-')."$m)");
+ }
+ }
+}
+
+sub message(@) {
+ ircd::privmsg($csnick, main_conf_diag, @_);
+ write_log('diag', '<'.$csnick.'>', @_);
+}
+
+sub init { }
+sub begin { }
+sub end { }
+sub unload { }
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package core;
+
+use strict;
+
+use SrSv::Conf2Consts qw(main);
+use SrSv::RunLevel 'main_shutdown';
+use SrSv::IRCd::Event 'addhandler';
+use SrSv::IRCd::IO 'ircsend';
+use SrSv::Timer 'add_timer';
+use SrSv::Time 'time_rel_long_all';
+use SrSv::Agent;
+use SrSv::Process::Init; #FIXME - only needed for ccode
+use SrSv::User::Notice;
+use SrSv::Help;
+
+my $startTime = time();
+
+our %ccode; #FIXME - Split out
+proc_init {
+ open ((my $COUNTRY), main::PREFIX()."/data/country-codes.txt");
+ while(my $x = <$COUNTRY>) {
+ chomp $x;
+ my($code, $country) = split(/ /, $x);
+ $ccode{uc $code} = $country;
+ }
+ close $COUNTRY;
+};
+
+our $rsnick = 'ServServ';
+
+addhandler('STATS', undef, undef, 'core::stats');
+sub stats($$) {
+ my ($src, $token) = @_;
+ if($token eq 'u') {
+ ircsend('242 '.$src.' :Server up '.time_rel_long_all($startTime),
+ '219 '.$src.' u :End of /STATS report')
+ }
+}
+
+addhandler('PING', undef, undef, 'ircd::pong', 1);
+
+sub pingtimer($) {
+ ircd::ping();
+ add_timer('perlserv__pingtimer', 60, __PACKAGE__,
+ "core::pingtimer");
+}
+
+agent_connect($rsnick, 'service', undef, '+ABHSNaopqz', 'Services Control Agent');
+
+addhandler('SEOS', undef, undef, 'core::ev_connect', 1);
+
+sub ev_connect {
+ agent_join($rsnick, main_conf_diag);
+ ircd::setmode($rsnick, main_conf_diag, '+o', $rsnick);
+ add_timer('perlserv__pingtimer', 60, __PACKAGE__,
+ "core::pingtimer");
+}
+
+addhandler('PRIVMSG', undef, 'servserv', 'core::dispatch', 1);
+
+sub dispatch {
+ my ($src, $dst, $msg) = @_;
+ my $user = { NICK => $src, AGENT => $rsnick };
+ if(!adminserv::is_ircop($user)) {
+ notice($user, 'Access Denied');
+ ircd::globops($rsnick, "\002$src\002 failed access to $rsnick $msg");
+ return;
+ }
+ if($msg =~ /^lsmod/i) {
+ notice($user, main_conf_load);
+ }
+
+ if($msg =~ /^shutdown/i) {
+ if(!adminserv::is_svsop($user, adminserv::S_ADMIN() )) {
+ notice($user, 'You do not have sufficient rank for this command');
+ return;
+ }
+
+ main_shutdown;
+ }
+ if($msg =~ /^raw/i) {
+ if(!adminserv::is_svsop($user, adminserv::S_ROOT() )) {
+ notice($user, 'You do not have sufficient rank for this command');
+ return;
+ }
+ my $cmd = $msg;
+ $cmd =~ s/raw\s+//i;
+ ircsend($cmd);
+ }
+ if($msg =~ /^help$/) {
+ sendhelp($user, lc 'core');
+ return;
+ }
+ if(main::DEBUG and $msg =~ /^eval\s+(.*)/) {
+ my $out = eval($1);
+ notice($user, split(/\n/, $out.$@));
+ }
+}
+
+sub init { }
+sub begin { }
+sub end { }
+sub unload { }
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# Copyright tabris@surrealchat.net (C) 2005
+package country;
+
+use strict;
+
+use SrSv::MySQL '$dbh';
+use SrSv::Process::Init;
+use SrSv::IRCd::Event 'addhandler';
+use SrSv::IRCd::State 'initial_synced';
+
+use SrSv::Log;
+
+use SrSv::Shared qw(%unwhois);
+
+use SrSv::User qw(get_user_id);
+
+addhandler('USERIP', undef, undef, 'userip');
+addhandler('NICKCONN', undef, undef, 'nickconn');
+
+our ($get_ip_country, $get_ip_country_aton, $get_user_country);
+
+proc_init {
+ $get_ip_country = $dbh->prepare_cached("SELECT country FROM country WHERE
+ ? BETWEEN low AND high");
+ $get_ip_country_aton = $dbh->prepare_cached("SELECT country FROM country WHERE
+ INET_ATON(?) BETWEEN low AND high");
+ $get_user_country = $dbh->prepare_cached("SELECT country FROM country, user WHERE
+ user.ip BETWEEN low AND high and user.id=?");
+};
+
+sub get_ip_country($) {
+ my ($ip) = @_;
+
+ $get_ip_country->execute($ip);
+ my ($country) = $get_ip_country->fetchrow_array();
+ $get_ip_country->finish();
+
+ return $country;
+}
+
+sub get_ip_country_aton($) {
+# IP is expected to be a dotted quad string!
+ my ($ip) = @_;
+
+ $get_ip_country_aton->execute($ip);
+ my ($country) = $get_ip_country_aton->fetchrow_array();
+ $get_ip_country_aton->finish();
+ #my ($country)= $dbh->selectrow_array(
+ # "SELECT `country` FROM `country` WHERE `low` < INET_ATON('$ip') AND `high` > INET_ATON('$ip')");
+ #$dbh->finish();
+
+ return $country;
+}
+
+sub get_user_country($) {
+# Preferred to use this if you have a $user hash and you've set the IP.
+# it should return undef in the case of user.ip == 0
+# do check this case in the caller before assuming the return value is valid.
+ my ($user) = @_;
+
+ $get_user_country->execute(get_user_id($user));
+ my ($country) = $get_user_country->fetchrow_array();
+ $get_user_country->finish();
+
+ return $country;
+}
+
+sub get_country_long($) {
+# I'd prefer that this be used by the callers of get_user_country()
+# If they need the long country name,
+# they can use country::get_country_long(country::get_user_country($user))
+# that way the get_{user,ip}_country functions get back an easily parsed value.
+ my ($country) = @_;
+ $country = uc $country;
+
+ my $cname = $core::ccode{$country};
+ $country .= " ($cname)" if $cname;
+
+ return $country if $cname;
+ return 'Unknown';
+}
+
+sub get_user_country_long($) {
+ my ($user) = @_;
+ return get_country_long(get_user_country($user));
+}
+
+sub nickconn {
+ my ($rnick, $time, $ident, $host, $vhost, $server, $modes, $gecos, $ip, $svsstamp) = @_[0,2..4,8,5,7,9,10,6];
+ if(initial_synced() && !$svsstamp) {
+ if ($ip) {
+ wlog($main::rsnick, LOG_INFO(), "\002$rnick\002 is connecting from ".
+ get_country_long(get_ip_country_aton($ip)));
+ }
+ else {
+ $unwhois{lc $rnick} = 1;
+ }
+ }
+ # we already depend on services being up for our SQL,
+ # thus we know a USERIP will be sent.
+ # However this IS avoidable if we make our own SQL connection
+ # but would then require an additional %config and configfile
+ return;
+}
+
+sub userip($$$) {
+ my($src, $nick, $ip) = @_;
+
+ return unless($unwhois{lc $nick});
+ return unless($ip =~ /^\d{1,3}(\.\d{1,3}){3}$/);
+
+ wlog($main::rsnick, LOG_INFO(), "\002$nick\002 is connecting from ".
+ get_country_long(get_ip_country_aton($ip)));
+ delete $unwhois{lc $nick};
+}
+
+sub init() { }
+sub begin() { }
+sub end() { %unwhois = undef(); }
+sub unload() { }
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package echoserv;
+
+use SrSv::IRCd::Event qw( addhandler );
+use SrSv::Agent;
+
+my $esnick = 'EchoServ';
+
+addhandler('PRIVMSG', undef, lc $esnick, 'echoserv::ev_privmsg');
+sub ev_privmsg { ircd::privmsg($_[1], $_[0], $_[2]) }
+
+addhandler('NOTICE', undef, lc $esnick, 'echoserv::ev_notice');
+sub ev_notice { ircd::notice($_[1], $_[0], $_[2]) }
+
+agent_connect($esnick, 'services', 'services.SC.net', '+pqzBGHS', 'Echo Server');
+agent_join($esnick, main_conf_diag);
+ircd::setmode($esnick, main_conf_diag, '+o', $esnick);
+
+sub init { }
+sub begin { }
+sub end { }
+sub unload { }
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# Copyright tabris@surrealchat.net (C) 2005, 2008
+package geoip;
+
+use strict;
+
+use SrSv::MySQL '$dbh';
+use SrSv::Process::Init;
+use SrSv::IRCd::Event 'addhandler';
+use SrSv::IRCd::State 'initial_synced';
+
+use SrSv::Log;
+
+#use SrSv::Shared qw(%unwhois);
+our %unwhois;
+use SrSv::Process::InParent qw( userip nickconn );
+
+use SrSv::User qw(get_user_id);
+
+addhandler('USERIP', undef, undef, 'userip');
+addhandler('NICKCONN', undef, undef, 'nickconn');
+
+my ($get_ip_location, $get_ip_location_aton, $get_user_location);
+
+proc_init {
+ my $baseSQL = "SELECT geolocation.country, geolocation.region,
+ geocountry.country, georegion.name, geolocation.city, geolocation.postalcode,metrocode.metro
+ FROM geolocation
+ JOIN geoip ON (geolocation.id=geoip.location)
+ LEFT JOIN geocountry ON (geolocation.country=geocountry.code)
+ LEFT JOIN georegion ON (geolocation.country=georegion.country AND geolocation.region=georegion.region)
+ LEFT JOIN metrocode ON (metrocode.id=geolocation.metrocode) ";
+ #"WHERE MBRCONTAINS(ip_poly, POINTFROMWKB(POINT(INET_ATON( ? ), 0)))";
+ $get_ip_location = $dbh->prepare_cached("$baseSQL
+ WHERE MBRCONTAINS(ip_poly, POINTFROMWKB(POINT( ?, 0)))");
+ $get_ip_location_aton = $dbh->prepare_cached("$baseSQL
+ WHERE MBRCONTAINS(ip_poly, POINTFROMWKB(POINT(INET_ATON( ? ), 0)))");
+ $get_user_location = $dbh->prepare_cached("$baseSQL
+ JOIN user
+ WHERE MBRCONTAINS(ip_poly, POINTFROMWKB(POINT(user.ip, 0)))
+ AND user.id=?");
+};
+
+sub get_ip_location($) {
+ my ($ip) = @_;
+
+ $get_ip_location->execute($ip);
+ my ($countryCode, $regionCode, $countryName, $regionName, $city, $postalCode, $metro) =
+ $get_ip_location->fetchrow_array();
+ $get_ip_location->finish();
+ if(!defined($countryCode)) {
+ $countryCode = '-';
+ $countryName = 'Unknown';
+ }
+
+ if(wantarray) {
+ return ($countryCode, $regionCode, $countryName, $regionName, $city, $postalCode, $metro);
+ } else {
+ return $countryCode;
+ }
+}
+
+sub get_ip_location_aton($) {
+# IP is expected to be a dotted quad string!
+ my ($ip) = @_;
+
+ $get_ip_location_aton->execute($ip);
+ my ($countryCode, $regionCode, $countryName, $regionName, $city, $postalCode, $metro) =
+ $get_ip_location_aton->fetchrow_array();
+ $get_ip_location_aton->finish();
+ if(!defined($countryCode)) {
+ $countryCode = '-';
+ $countryName = 'Unknown';
+ }
+
+ if(wantarray) {
+ return ($countryCode, $regionCode, $countryName, $regionName, $city, $postalCode, $metro);
+ } else {
+ return $countryCode;
+ }
+}
+
+sub get_user_location($) {
+# Preferred to use this if you have a $user hash and you've set the IP.
+# it should return undef in the case of user.ip == 0
+# do check this case in the caller before assuming the return value is valid.
+ my ($user) = @_;
+
+ $get_user_location->execute(get_user_id($user));
+ my ($countryCode, $regionCode, $countryName, $regionName, $city, $postalCode, $metro) =
+ $get_user_location->fetchrow_array();
+ $get_user_location->finish();
+ if(!defined($countryCode)) {
+ $countryCode = '-';
+ $countryName = 'Unknown';
+ }
+
+ if(wantarray) {
+ return ($countryCode, $regionCode, $countryName, $regionName, $city, $postalCode, $metro);
+ } else {
+ return $countryCode;
+ }
+}
+
+sub stringify_location(@) {
+ my ($countryCode, $regionCode, $countryName, $regionName, $city, $postalCode, $metro) = @_;
+ my $location;
+ if(!defined($countryCode) || $countryCode eq '-') {
+ $location = "Unknown";
+ } else {
+ $location = "$countryName";
+ if(defined($city) && length($city)) {
+ $location .= " ($city";
+ }
+ if(defined($regionName)) {
+ if($regionName =~ /, /) {
+ #normalize stuff like "London, City of"
+ $regionName = join(' ', reverse(split(', ', $regionName)));
+ }
+ $location .= (defined($city) && length($city)) ? ' ' : '(';
+ $location .= "$regionName)";
+ } else {
+ $location .= ')';
+ }
+ if(defined($metro)) {
+ $location .= " [$metro]";
+ }
+ }
+ return $location;
+}
+
+sub nickconn {
+ my ($rnick, $time, $ident, $host, $vhost, $server, $modes, $gecos, $ip, $svsstamp) = @_[0,2..4,8,5,7,9,10,6];
+ if(initial_synced() && !$svsstamp) {
+ if ($ip) {
+ wlog($main::rsnick, LOG_INFO(), "\002$rnick\002 is connecting from ".
+ stringify_location(get_ip_location_aton($ip)));
+ }
+ else {
+ $unwhois{lc $rnick} = 1;
+ }
+ }
+ # we already depend on services being up for our SQL,
+ # thus we know a USERIP will be sent.
+ # However this IS avoidable if we make our own SQL connection
+ # but would then require an additional %config and configfile
+ return;
+}
+
+sub userip($$$) {
+ my($src, $nick, $ip) = @_;
+
+ return unless($unwhois{lc $nick});
+ return unless($ip =~ /^\d{1,3}(\.\d{1,3}){3}$/);
+
+ wlog($main::rsnick, LOG_INFO(), "\002$nick\002 is connecting from ".
+ stringify_location(get_ip_location_aton($ip)));
+ delete $unwhois{lc $nick};
+}
+
+sub init() { }
+sub begin() { }
+sub end() { %unwhois = undef(); }
+sub unload() { }
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package logserv;
+
+use strict;
+no strict 'refs';
+use Storable;
+
+use SrSv::Process::InParent qw(chanlog addchan delchan ev_sjoin ev_join ev_part
+ev_kick ev_mode ev_nickconn ev_nickchange ev_quit ev_message ev_notice
+ev_chghost ev_kill ev_topic ev_connect saveconf loadconf join_chans);
+
+use SrSv::Conf2Consts qw(main);
+use SrSv::IRCd::Event 'addhandler';
+use SrSv::IRCd::State 'initial_synced';
+use SrSv::Agent;
+use SrSv::User::Notice;
+use SrSv::Log qw( :all );
+
+my %userlist;
+my %chanlist;
+
+our $lsnick = 'LogServ';
+my $chanopmode = '+v';
+
+loadconf();
+agent_connect($lsnick, 'services', undef, '+pqzBHSD', 'Log Service');
+agent_join($lsnick, main_conf_diag);
+ircd::setmode($lsnick, main_conf_diag, '+o', $lsnick);
+join_chans();
+
+sub chanlog($@) {
+ my ($cn, @payload) = @_;
+ write_log("logserv:$cn", '', @payload)
+ # This if allows us to be lazy
+ if defined($chanlist{lc $cn});
+}
+
+sub addchan($$) {
+ my ($user, $cn) = @_;
+ unless(defined($chanlist{lc $cn})) {
+ open_log("logserv:$cn", lc($cn).'.log');
+ $chanlist{lc $cn} = 1;
+ agent_join($lsnick, $cn);
+ ircd::setmode($lsnick, $cn, $chanopmode, $lsnick);
+ notice($user, "Channel $cn will now be logged");
+ saveconf();
+ return 1;
+ } else {
+ notice($user, "Channel $cn is already being logged");
+ return 0;
+ }
+}
+
+sub delchan($$) {
+ my ($user, $cn) = @_;
+ if(defined($chanlist{lc $cn})) {
+ close_log("logserv:$cn");
+ delete($chanlist{lc $cn});
+ agent_part($lsnick, $cn, "Channel has been deleted by ".$user->{NICK});
+ notice($user, "Channel $cn will not be logged");
+ saveconf();
+ return 1;
+ } else {
+ notice($user, "Channel $cn is not being logged");
+ return 0;
+ }
+}
+
+# Handler Functions
+
+addhandler('SJOIN', undef, undef, 'logserv::ev_sjoin');
+sub ev_sjoin {
+ # ($server, $cn, $ts, $chmodes, $chmodeparms, \@users, \@bans, \@excepts, \@invex);
+ my (undef, $cn, undef, undef, undef, $users, undef, undef, undef) = @_;
+ foreach my $user (@$users) {
+ ev_join($user->{NICK}, $cn);
+ }
+}
+
+addhandler('JOIN', undef, undef, 'logserv::ev_join');
+sub ev_join {
+ my ($nick, $cn) = @_;
+ return if is_agent($nick); # Ignore agent joins.
+ return unless defined($userlist{lc $nick}); # Sometimes we get JOINs after a KILL or QUIT
+ {
+ $userlist{lc $nick}{CHANS}{$cn} = 1;
+ }
+ if(initial_synced()) {
+ if($cn eq '0') {
+ foreach my $cn (keys(%{$userlist{lc $nick}{CHANS}})) {
+ ev_part($nick, $cn, 'Left all channels');
+ }
+ } else {
+ my ($ident, $vhost) = @{$userlist{lc $nick}{INFO}};
+ chanlog($cn, "-!- $nick [$ident\@$vhost] has joined $cn");
+ }
+ }
+}
+
+addhandler('PART', undef, undef, 'logserv::ev_part');
+sub ev_part {
+ my ($nick, $cn, $reason) = @_;
+ return if is_agent($nick); # Ignore agent parts.
+ return unless defined($userlist{lc $nick}); # Sometimes we get JOINs after a KILL or QUIT
+ {
+ delete($userlist{lc $nick}{CHANS}{$cn});
+ }
+ my ($ident, $vhost) = @{$userlist{lc $nick}{INFO}};
+ chanlog("$cn", "-!- $nick [$ident\@$vhost] has left $cn [$reason]");
+}
+
+addhandler('KICK', undef, undef, 'logserv::ev_kick');
+sub ev_kick {
+ my ($src, $cn, $target, $reason) = @_;
+ return unless defined($userlist{lc $target}); # Sometimes we get JOINs after a KILL or QUIT
+ if(lc $target eq lc $lsnick) {
+ agent_join($lsnick, $cn);
+ ircd::setmode($lsnick, $cn, '+o', $lsnick);
+ return;
+ }
+ {
+ delete($userlist{lc $target}{CHANS}{$cn});
+ }
+ chanlog("$cn", "-!- $target was kicked by $src [$reason]");
+}
+
+addhandler('MODE', undef, undef, 'logserv::ev_mode');
+sub ev_mode {
+ my ($src, $cn, $modes, $parms) = @_;
+ return unless initial_synced();
+ chanlog("$cn", "-!- mode/$cn [$modes".($parms ? " $parms" : '')."] by $src");
+}
+
+addhandler('NICKCONN', undef, undef, 'logserv::ev_nickconn');
+sub ev_nickconn {
+ my ($nick, $ident, $host, $modes, $vhost, $cloakhost) = @_[0,3,4,7,8,11];
+ if ($vhost eq '*') {
+ if ({modes::splitumodes($modes)}->{x} eq '+') {
+ if(defined($cloakhost)) {
+ $vhost = $cloakhost;
+ }
+ else {
+ # Since we have no desire to do ircd::userhost checks
+ # This makes us dependent on VHP or CLK.
+ # Do we care? Not at the moment.
+ # This should NEVER happen with VHP or CLK.
+ $vhost = $host;
+ }
+ } else {
+ $vhost = $host;
+ }
+ }
+ $userlist{lc $nick} = {
+ INFO => [$ident, $vhost],
+ CHANS => {},
+ };
+}
+
+addhandler('NICKCHANGE', undef, undef, 'logserv::ev_nickchange');
+sub ev_nickchange {
+ my ($old, $new) = @_;
+ return unless defined($userlist{lc $old}); # Sometimes we get JOINs after a KILL or QUIT
+ unless (lc($old) eq lc($new)) {
+ $userlist{lc $new} = $userlist{lc $old};
+ delete($userlist{lc $old});
+ }
+ foreach my $cn (keys(%{$userlist{lc $new}{CHANS}})) {
+ chanlog($cn, "-!- $old is now known as $new");
+ }
+}
+
+addhandler('QUIT', undef, undef, 'logserv::ev_quit');
+sub ev_quit {
+ my ($nick, $reason) = @_;
+ my ($ident, $vhost) = @{$userlist{lc $nick}{INFO}};
+ if (initial_synced()) {
+ foreach my $cn (keys(%{$userlist{lc $nick}{CHANS}})) {
+ chanlog($cn, "$nick [$ident\@$vhost] has quit [$reason]");
+ }
+ }
+ delete($userlist{lc $nick});
+}
+
+addhandler('LOOP_PRIVMSG', undef, qr/^#/, 'logserv::ev_loop_message');
+sub ev_loop_message {
+ my ($nick, $cn, $messages) = @_;
+ my $channel = $cn;
+ $channel =~ s/^[+%@&~]+//;
+ return unless defined($chanlist{lc $channel});
+ foreach my $message (@$messages) {
+ if ($message =~ /^\001(\w+)(?: (.*))\001$/i) {
+ my ($ctcp, $payload) = ($1, $2);
+ if($ctcp eq 'ACTION') {
+ $message = "* $nick $payload";
+ }
+ else {
+ $message = "$nick requested CTCP $1 from $cn: $2";
+ }
+ } else {
+ $message = "<$nick> $message";
+ }
+ }
+ chanlog($channel, @$messages);
+}
+addhandler('LOOP_NOTICE', undef, qr/^#/, 'logserv::ev_loop_notice');
+sub ev_loop_notice {
+ my ($nick, $cn, $messages) = @_;
+ my $channel = $cn;
+ $channel =~ s/^[+%@&~]+//;
+ return unless defined($chanlist{lc $channel});
+ foreach my $message (@$messages) {
+ $message = "-$nick:$cn- $message";
+ }
+ chanlog($channel, @$messages);
+}
+
+addhandler('PRIVMSG', undef, qr/^#/, 'logserv::ev_message');
+sub ev_message {
+ my ($nick, $cn, $message) = @_;
+ my $channel = $cn;
+ $channel =~ s/^[+%@&~]+//;
+ return unless defined($chanlist{lc $channel});
+ if ($message =~ /^\001(\w+)(?: (.*))\001$/i) {
+ my ($ctcp, $payload) = ($1, $2);
+ if($ctcp eq 'ACTION') {
+ chanlog($channel, "* $nick $payload");
+ }
+ else {
+ chanlog($channel, "$nick requested CTCP $1 from $cn: $2");
+ }
+ } else {
+ chanlog($channel, "<$nick> $message");
+ }
+
+}
+addhandler('NOTICE', undef, qr/^#/, 'logserv::ev_notice');
+sub ev_notice {
+ my ($nick, $cn, $message) = @_;
+ my $channel = $cn;
+ $channel =~ s/^[+%@&~]+//;
+ return unless defined($chanlist{lc $channel});
+ chanlog($channel, "-$nick:$cn- $message");
+}
+
+addhandler('CHGHOST', undef, undef, 'logserv::ev_chghost');
+sub ev_chghost {
+ my (undef, $nick, $vhost) = @_;
+ return unless defined($userlist{lc $nick}); # Sometimes we get JOINs after a KILL or QUIT
+ {
+ my ($ident, undef) = @{$userlist{lc $nick}{INFO}};
+ $userlist{lc $nick}{INFO} = [$ident, $vhost];
+ }
+
+}
+
+addhandler('KILL', undef, undef, 'logserv::ev_kill');
+sub ev_kill {
+ my ($src, $target, $reason) = @_;
+ return if is_agent($target) or !defined($userlist{lc $target}); # Ignore agent kills.
+ my ($ident, $vhost) = @{$userlist{lc $target}{INFO}};
+ if (initial_synced()) {
+ foreach my $cn (keys(%{$userlist{lc $target}{CHANS}})) {
+ chanlog($cn, "$target [$ident\@$vhost] has quit [Killed ($src ($reason))]");
+ }
+ }
+ delete($userlist{lc $target});
+}
+
+addhandler('TOPIC', undef, undef, 'logserv::ev_topic');
+sub ev_topic {
+ my ($src, $cn, $setter, undef, $topic) = @_;
+ # We don't care about the timestamp
+ return unless initial_synced();
+ chanlog($cn, "$src changed the topic of $cn to: $topic".($setter ne $src ? " ($setter)" : ''));
+}
+
+# Internal Only functions.
+
+sub saveconf() {
+ my @channels = keys(%chanlist);
+ Storable::nstore(\@channels, "config/logserv/chans.conf");
+}
+
+sub loadconf() {
+ (-d "config/logserv") or mkdir "config/logserv";
+ return unless(-f "config/logserv/chans.conf");
+ my @channels = @{Storable::retrieve("config/logserv/chans.conf")};
+ foreach my $cn (@channels) {
+ $chanlist{lc $cn} = 1;
+ }
+}
+
+sub join_chans() {
+ foreach my $cn (keys(%chanlist)) {
+ open_log("logserv:$cn", lc($cn).'.log');
+ agent_join($lsnick, $cn);
+ ircd::setmode($lsnick, $cn, $chanopmode, $lsnick);
+ }
+}
+
+sub init { }
+sub begin { }
+sub end { }
+sub unload { saveconf(); }
+
+1;
--- /dev/null
+#!/usr/bin/perl
+#
+# Copyright saturn@surrealchat.net
+# multiple feature-adds and code changes tabris@tabris.net
+#
+# Licensed under the GNU Public License
+# http://www.gnu.org/licenses/gpl.txt
+#
+
+package securitybot;
+
+use strict;
+no strict "refs";
+use Time::HiRes qw(gettimeofday);
+
+use SrSv::Process::Init;
+use SrSv::IRCd::Event 'addhandler';
+use SrSv::IRCd::State 'initial_synced';
+use SrSv::Timer qw(add_timer);
+use SrSv::Time;
+use SrSv::Agent;
+use SrSv::HostMask qw( parse_hostmask );
+#use SrSv::Conf qw(main sql);
+use SrSv::Conf2Consts qw(main sql);
+use SrSv::SimpleHash qw(readHash writeHash);
+
+use SrSv::Log;
+
+use SrSv::User qw( get_user_nick );
+use SrSv::User::Notice;
+use SrSv::Help qw( sendhelp );
+
+use SrSv::MySQL '$dbh';
+use SrSv::MySQL::Glob;
+
+use SrSv::Shared qw(%conf %torip %unwhois);
+
+use SrSv::Process::InParent qw(list_conf loadconf saveconf);
+
+use SrSv::TOR;
+
+#use modules::ss2tkl; # package securitybot::ss2tkl, but has exports
+
+#this stuff needs to be put into files
+our $sbnick = "SecurityBot";
+our $ident = 'Security';
+our $gecos = 'Security Monitor (you are being monitored)';
+our $umodes = '+BHSdopqz';
+our $vhost = 'services.SC.bot';
+
+our (
+ $add_spamfilter, $del_spamfilter, $add_tklban, $del_tklban,
+ $del_expired_tklban, $get_expired_tklban,
+
+ $get_tklban, $get_spamfilter,
+ $get_all_tklban, $get_all_spamfilter,
+
+ $check_opm,
+);
+
+loadconf(0);
+our $enabletor = $conf{'EnableTor'};
+register();
+
+addhandler('SEOS', undef, undef, "securitybot::start_timers");
+addhandler('TKL', undef, undef, "securitybot::handle_tkl");
+
+addhandler('PRIVMSG', undef, $sbnick, "securitybot::msghandle");
+addhandler('NOTICE', undef, $sbnick, "securitybot::noticehandle");
+addhandler('SENDSNO', undef, undef, "securitybot::snotice");
+addhandler('GLOBOPS', undef, undef, "securitybot::globops");
+addhandler('SMO', undef, undef, "securitybot::snotice");
+
+if($conf{'EnableTor'} or $conf{'CTCPonConnect'} or $conf{'EnableOPM'}) {
+ addhandler('NICKCONN', undef, undef, 'securitybot::nickconn');
+ addhandler('USERIP', undef, undef, 'securitybot::userip');
+}
+
+proc_init {
+ $add_tklban = $dbh->prepare_cached("REPLACE INTO tklban
+ SET type=?, ident=?, host=?, setter=?, expire=?, time=?, reason=?");
+ $del_tklban = $dbh->prepare_cached("DELETE FROM tklban WHERE type=? AND ident=? AND host=?");
+ $add_spamfilter = $dbh->prepare_cached("REPLACE INTO spamfilter
+ SET target=?, action=?, setter=?, expire=?, time=?, bantime=?, reason=?, mask=?");
+ $del_spamfilter = $dbh->prepare_cached("DELETE FROM spamfilter WHERE target=? AND action=? AND mask=?");
+
+ $del_expired_tklban = $dbh->prepare_cached("DELETE FROM tklban WHERE expire <= UNIX_TIMESTAMP() AND expire!=0");
+ $get_expired_tklban = $dbh->prepare_cached("SELECT type, ident, host, setter, expire, time, reason
+ FROM tklban WHERE expire <= UNIX_TIMESTAMP() AND expire!=0");
+
+ $get_tklban = $dbh->prepare_cached("SELECT setter, expire, time, reason FROM tklban WHERE
+ type=? AND ident=? AND host=?");
+ $get_spamfilter = $dbh->prepare_cached("SELECT time, reason FROM spamfilter WHERE target=? AND action=? AND mask=?");
+
+ $get_all_tklban = $dbh->prepare_cached("SELECT type, ident, host, setter, expire, time, reason
+ FROM tklban ORDER BY type, time, host");
+ $get_all_spamfilter = $dbh->prepare_cached("SELECT target, action, setter, expire, time, bantime, reason, mask, managed
+ FROM spamfilter ORDER BY time, mask");
+
+ $check_opm = $dbh->prepare_cached("SELECT 1 FROM opm WHERE ipaddr=?");
+};
+
+sub init {
+ my $tmpdbh = DBI->connect(
+ "DBI:mysql:".sql_conf_mysql_db,
+ sql_conf_mysql_user,
+ sql_conf_mysql_pass,
+ {
+ AutoCommit => 1,
+ RaiseError => 1
+ }
+ );
+ $tmpdbh->do("TRUNCATE TABLE tklban");
+ $tmpdbh->do("TRUNCATE TABLE spamfilter");
+ $tmpdbh->disconnect();
+}
+
+=cut
+my %snomasks = (
+ e => 'Eyes Notice',
+ v => 'VHost Notice',
+ # They're prefixed already.
+ #S => 'Spamfilter',
+ o => 'Oper-up Notice',
+);
+=cut
+
+sub snotice($$$) {
+ my ($server, $type, $msg) = @_;
+# $type = $snomasks{$type};
+# diagmsg( ($type ? "[$type] " : '').$msg);
+ diagmsg( $msg);
+}
+
+sub globops($$) {
+ my ($src, $msg) = @_;
+ diagmsg("Global -- from $src: $msg");
+}
+
+sub register {
+ agent_connect($sbnick, $ident, $vhost, $umodes, $gecos);
+ ircd::sqline($sbnick, 'Reserved for Services');
+
+ agent_join($sbnick, main_conf_diag);
+ ircd::setmode($sbnick, main_conf_diag, '+o', $sbnick);
+}
+
+sub start_timers {
+ add_timer('', 5, __PACKAGE__, 'securitybot::start_timers2');
+ expire_tkl_timed();
+}
+
+sub start_timers2 {
+ update_tor_list_timed(3540) if $conf{'EnableTor'};
+ #securitybot::ss2tkl::update_ss_timed(3300) if $conf{'EnableSS'};
+};
+
+sub nickconn {
+ my ($rnick, $time, $ident, $host, $vhost, $server, $modes, $gecos, $ip, $svsstamp) = @_[0,2..4,8,5,7,9,10,6];
+
+ goto OUT if ($svsstamp or $unwhois{lc $rnick});
+
+ if((initial_synced and $enabletor) or $conf{'EnableOPM'} or $conf{'BanCountry'} ) {
+ if ($ip) {
+ check_blacklists($rnick, $ip) or return;
+ }
+ else {
+ ircd::userip($rnick) unless module::is_loaded('services');
+ }
+ }
+
+ if($conf{'CTCPonConnect'}) {
+ my @ctcplist = split(/ /, $conf{'CTCPonConnect'});
+ foreach my $ctcp_msg (@ctcplist) {
+ if(uc($ctcp_msg) eq 'PING') {
+ my ($sec, $usec) = gettimeofday();
+ ircd::ctcp($sbnick, $rnick, 'PING', $sec, $usec);
+ } else {
+ ircd::ctcp($sbnick, $rnick, uc($ctcp_msg));
+ }
+ }
+ }
+ OUT:
+ $unwhois{lc $rnick} = 1 unless ($svsstamp or $ip);
+}
+
+sub userip {
+ my($src, $rnick, $ip) = @_;
+
+ return unless($unwhois{lc $rnick});
+ return unless($ip =~ /^\d{1,3}(\.\d{1,3}){3}$/);
+
+ check_blacklists($rnick, $ip) or return;
+
+ delete $unwhois{lc $rnick};
+}
+
+sub check_opm($) {
+ my ($ip) = @_;
+ $check_opm->execute($ip);
+ my ($ret) = $check_opm->fetchrow_array();
+ $check_opm->finish();
+ return $ret;
+}
+
+sub check_country($) {
+ my ($ip) = @_;
+ my $ccode;
+ if(module::is_loaded('geoip')) {
+ $ccode = geoip::get_ip_location($ip);
+ } elsif(module::is_loaded('country')) {
+ $ccode = country::get_ip_country_aton($ip);
+ }
+ foreach my $country (split(/[, ]+/, $conf{'BanCountry'})) {
+ if (lc $ccode eq lc $country) {
+ return country::get_country_long($country);
+ }
+ }
+ return undef;
+}
+
+sub mk_banreason($$) {
+ my ($reason, $ip) = @_;
+ $reason =~ s/\$/$ip/g;
+ return $reason;
+}
+
+sub check_blacklists($$) {
+ my ($rnick, $ip) = @_;
+
+ if(initial_synced and $enabletor && $torip{$ip}) {
+ if (lc $enabletor eq lc 'vhost') {
+ ircd::chghost($sbnick, $rnick, misc::gen_uuid(1, 20).'.session.tor');
+ } else {
+ ircd::zline($sbnick, $ip, $conf{'ProxyZlineTime'}, $conf{'TorZlineReason'});
+ }
+ return 0;
+ }
+
+ if($conf{'EnableOPM'} && check_opm($ip)) {
+ ircd::zline($sbnick, $ip, $conf{'ProxyZlineTime'}, mk_banreason($conf{'OPMZlineReason'}, $ip));
+ return 0;
+ }
+
+ if($conf{'BanCountry'} && module::is_loaded('country') && (my $country = check_country($ip))) {
+ ircd::zline($sbnick, $ip, $conf{'ProxyZlineTime'}, mk_banreason($conf{'CountryZlineReason'}, $country));
+ return 0;
+ }
+
+ return 1;
+}
+
+sub update_tor_list_timed($) {
+ my $time = shift;
+ $time = 3600 unless $time;
+
+ add_timer('', $time, __PACKAGE__, 'securitybot::update_tor_list_timed');
+
+ update_tor_list();
+}
+
+sub update_tor_list() {
+ diagmsg( " -- Loading Tor server list.");
+
+ # path may be a local one if you run a tor-client.
+ # most configs are /var/lib/tor/cached-directory
+ my %newtorip;
+ foreach my $torIP (getTorRouters($conf{'TorServer'})) {
+ $newtorip{$torIP} = 1;
+ }
+
+ my $torcount = scalar(keys(%newtorip));
+
+ if($torcount > 0) {
+ %torip = %newtorip;
+ diagmsg( " -- Finished loading Tor server list - $torcount servers found.");
+ } else {
+ diagmsg( " -- Failed to load Tor server list, CHECK YOUR TorServer SETTING.");
+ }
+}
+
+sub msghandle {
+ my ($rnick, $dst, $msg) = @_;
+ print join("\n", @_);
+ my $user = { NICK => $rnick, AGENT => $sbnick };
+ unless (adminserv::is_ircop($user)) {
+ notice($user, 'Permission Denied');
+ return;
+ }
+
+ if($msg =~ /^help/i) {
+ my (undef, @args) = split(/ /, $msg); #discards first token 'help'
+ sendhelp($user, 'securitybot', @args);
+ }
+
+ elsif($msg =~ /^notice (\S*) (.*)/i) {
+ ircd::notice($sbnick, $1, $2);
+ }
+
+ elsif($msg =~ /^msg (\S*) (.*)/i) {
+ ircd::privmsg($sbnick, $1, $2);
+ }
+
+ elsif($msg =~ /^raw (.*)/i) {
+ if(!adminserv::is_svsop($user, adminserv::S_ROOT() )) {
+ notice($user, 'You do not have sufficient rank for this command');
+ return;
+ }
+ ircd::ircsend($1);
+ }
+
+ elsif($msg =~ /^kill (\S*) (.*)/i) {
+ ircd::irckill($sbnick, $1, $2);
+ }
+
+ elsif($msg =~ /^conf/i) {
+ notice($user, "Configuration:", list_conf);
+ }
+
+ elsif($msg =~ /^set (\S+) (.*)/i) {
+ if(!adminserv::is_svsop($user, adminserv::S_ROOT() )) {
+ notice($user, 'You do not have sufficient rank for this command');
+ return;
+ }
+
+ my @p = ($1, $2);
+ chomp $p[1];
+
+ if(update_conf($p[0], $p[1])) {
+ notice($user, "Configuration: ".$p[0]." = ".$p[1]);
+ } else {
+ notice($user, "That value is read-only.");
+ }
+ }
+
+ elsif($msg =~ /^save/i) {
+ notice($user, "Saving configuration.");
+
+ saveconf();
+ }
+
+ elsif($msg =~ /^rehash/i) {
+ notice($user, "Loading configuration.");
+
+ loadconf(1);
+ }
+
+ elsif($msg =~ /^tssync/i) {
+ ircd::tssync();
+ }
+
+ elsif($msg =~ /^svsnick (\S+) (\S+)/i) {
+ if(!adminserv::is_svsop($user, adminserv::S_ROOT() )) {
+ notice($user, 'You do not have sufficient rank for this command');
+ return;
+ }
+ ircd::svsnick($sbnick, $1, $2);
+ }
+
+ elsif($msg =~ /^tor-update/i) {
+ notice($user, "Updating Tor server list.");
+ update_tor_list();
+ }
+=cut
+ elsif($msg =~ /^ss-update/i) {
+ notice($user, "Updating SS definitions.");
+ securitybot::ss2tkl::update_ss();
+ }
+=cut
+ elsif($msg =~ /^tkl/i) {
+ sb_tkl($user, $msg);
+ }
+}
+
+sub list_conf() {
+ my @k = keys(%conf);
+ my @v = values(%conf);
+ my @reply;
+
+ for(my $i=0; $i<@k; $i++) {
+ push @reply, $k[$i]." = ".$v[$i];
+ }
+ return @reply;
+}
+
+sub noticehandle {
+ my ($rnick, $dst, $msg) = @_;
+
+ if($msg =~ /^\x01(\S+)\s?(.*?)\x01?$/) {
+ diagmsg( "Got $1 reply from $rnick: $2");
+ }
+}
+
+sub sb_tkl($$) {
+# This function is a hack to fit better our normal services coding style.
+# Better fix is to rewrite msghandle in another cleanup patch.
+ my ($user, $msg) = @_;
+ # We discard first token 'tkl'
+ my $cmd;
+ (undef, $cmd, $msg) = split(/ /, $msg, 3);
+ if(lc($cmd) eq 'list') {
+ if($msg) {
+ sb_tkl_glob($user, $msg);
+ }
+ else {
+ sb_tkl_list($user);
+ }
+ }
+ elsif(lc($cmd) eq 'del') {
+ unless($msg) {
+ notice($user, "You have to specify at least one parameter");
+ }
+ sb_tkl_glob_delete($user, $msg);
+ }
+}
+
+sub sb_tkl_list($) {
+ my ($user) = @_;
+ my @reply;
+ $get_all_tklban->execute();
+ while(my ($type, $ident, $host, $setter, $expire, $time, $reason) = $get_all_tklban->fetchrow_array()) {
+ if($type eq 'Q') {
+ #push @reply, "$type $host $setter";
+ next;
+ }
+ else {
+ push @reply, "$type $ident\@$host $setter";
+ }
+ $time = gmtime2($time); $expire = time_rel($expire - time()) if $expire;
+ push @reply, " set: $time; ".($expire ? "expires in: $expire" : "Will not expire");
+ push @reply, " reason: $reason";
+ }
+ $get_all_tklban->finish();
+ push @reply, "No results" unless @reply;
+
+ notice($user, @reply);
+}
+
+sub sb_tkl_glob($$) {
+ my ($user, $cmdline) = @_;
+
+ my $sql_expr = "SELECT type, ident, host, setter, expire, time, reason FROM tklban ";
+
+ my ($filters, $parms) = split(/ /, $cmdline, 2);
+ my @filters = split(//, $filters);
+ unless($filters[0] eq '+' or $filters[0] eq '-') {
+ notice($user, "Invalid Syntax: First parameter must be a set of filters preceded by a + or -");
+ return;
+ }
+ my @args = misc::parse_quoted($parms);
+
+ my ($success, $expr) = make_tkl_query(\@filters, \@args);
+ unless ($success) {
+ notice($user, "Error: $expr");
+ return;
+ }
+ $sql_expr .= $expr;
+
+ my @reply;
+ my $get_glob_tklban = $dbh->prepare($sql_expr);
+ $get_glob_tklban->execute();
+ while(my ($type, $ident, $host, $setter, $expire, $time, $reason) = $get_glob_tklban->fetchrow_array()) {
+ if($type eq 'Q') {
+ #push @reply, "$type $host $setter";
+ next;
+ }
+ else {
+ push @reply, "$type $ident\@$host $setter";
+ }
+ $time = gmtime2($time); $expire = time_rel($expire - time()) if $expire;
+ push @reply, " set: $time; ".($expire ? "expires in: $expire" : "Will not expire");
+ push @reply, " reason: $reason";
+ }
+ $get_glob_tklban->finish();
+
+ push @reply, "No results" unless @reply;
+ notice($user, @reply);
+}
+
+sub sb_tkl_glob_delete($$) {
+ my ($user, $cmdline) = @_;
+
+ my $sql_expr = "SELECT type, ident, host FROM tklban ";
+
+ my ($filters, $parms) = split(/ /, $cmdline, 2);
+ my @filters = split(//, $filters);
+ unless($filters[0] eq '+' or $filters[0] eq '-') {
+ notice($user, "Invalid Syntax: First parameter must be a set of filters preceded by a + or -");
+ return;
+ }
+ my @args = misc::parse_quoted($parms);
+
+ my ($success, $expr) = make_tkl_query(\@filters, \@args);
+ unless ($success) {
+ notice($user, "Error: $expr");
+ return;
+ }
+
+ $sql_expr .= $expr;
+
+ my $src = get_user_nick($user);
+ my $get_glob_tklban = $dbh->prepare($sql_expr);
+ $get_glob_tklban->execute();
+ while(my ($type, $ident, $host) = $get_glob_tklban->fetchrow_array()) {
+ if($type eq 'G') {
+ ircd::unkline($src, $ident, $host);
+ }
+ elsif($type eq 'Z') {
+ ircd::unzline($src, $host);
+ }
+ }
+ $get_glob_tklban->finish();
+
+}
+
+sub make_tkl_query($$) {
+ my ($parm1, $parm2) = @_;
+ my @filters = @$parm1; my @args = @$parm2;
+
+ my ($sign, $sql_expr, $sortby, $where, $and);
+ while(my $filter = shift @filters) {
+ my $condition;
+ if ($filter eq '+') {
+ $sign = +1;
+ next;
+ }
+ elsif($filter eq '-') {
+ $sign = 0;
+ next;
+ }
+
+ my $parm = shift @args;
+ unless (defined($parm)) {
+ return (0, "Not enough arguments for filters.");
+ }
+ if($filter eq 'm') {
+ my ($mident, $mhost) = parse_hostmask($parm);
+ $mident = glob2sql($dbh->quote($mident)) if $mident;
+ $mhost = glob2sql($dbh->quote($mhost)) if $mhost;
+
+ $condition = ($mident ? ($sign ? '' : '!').
+ "(ident LIKE $mident) " : '').
+ ($mhost ? ($sign ? '' : '!').
+ "(host LIKE $mhost) " : '');
+ }
+ elsif($filter eq 'r') {
+ my $reason = $dbh->quote($parm);
+ $reason = glob2sql($reason);
+ $condition = ($sign ? '' : '!')."(reason LIKE $reason) ";
+
+ }
+ elsif($filter eq 's') {
+ my $setter = $dbh->quote($parm);
+ $setter = glob2sql($setter);
+ $condition = ($sign ? '' : '!')."(setter LIKE $setter) ";
+
+ }
+ if($filter eq 'M') {
+ my ($mident, $mhost) = parse_hostmask($parm);
+ $mident = $dbh->quote($mident) if $mident;
+ $mhost = $dbh->quote($mhost) if $mhost;
+ $condition = ($mident ? ($sign ? '' : '!').
+ "(ident REGEXP $mident) " : '').
+ ($mhost ? ($sign ? '' : '!').
+ "(host REGEXP $mhost) " : '');
+ }
+ elsif($filter eq 'R') {
+ my $reason = $dbh->quote($parm);
+ $condition = ($sign ? '' : '!')."(reason REGEXP $reason) ";
+
+ }
+ elsif($filter eq 'S') {
+ my $setter = $dbh->quote($parm);
+ $condition = ($sign ? '' : '!')."(setter REGEXP $setter) ";
+
+ }
+ elsif(lc $filter eq 'o') {
+ $parm = lc $parm;
+ next unless ($parm =~ /(type|ident|host|setter|expire|reason|time)/);
+ if ($sortby) {
+ $sortby .= ', ';
+ } else {
+ $sortby = 'ORDER BY ';
+ }
+ $sortby .= $parm.($sign ? ' ASC' : ' DESC');
+ next;
+ }
+ if (!$where) {
+ $sql_expr .= 'WHERE ';
+ $where = 1;
+ }
+ if ($and) {
+ $sql_expr .= 'AND ';
+ } else {
+ $and = 1;
+ }
+ $sql_expr .= $condition if $condition;
+ }
+ if (scalar(@args)) {
+ return (0, "Too many arguments for filters.");
+ }
+ return (1, $sql_expr.((defined $sortby and $sortby ne '') ? $sortby : 'ORDER BY type, time, host'));
+}
+
+sub get_tkl_type_name($) {
+ my %tkltype = (
+ G => 'G:line',
+ Z => 'GZ:line',
+ s => 'Shun',
+ Q => 'Q:line',
+ );
+ return $tkltype{$_[0]};
+};
+
+sub get_filter_action_name($) {
+ my %filteraction = (
+ Z => 'GZ:line',
+ S => 'tempshun',
+ s => 'shun',
+ g => 'G:line',
+ z => 'Z:line',
+ k => 'K:line',
+ K => 'Kill',
+ b => 'Block',
+ d => 'DCC Block',
+ v => 'Virus Chan',
+ w => 'Warn',
+ #t => 'Test', # Should never show up, and not implemented in 3.2.4 yet.
+ );
+ return $filteraction{$_[0]};
+};
+
+sub handle_tkl($$@) {
+ my ($type, $sign, @parms) = @_;
+ return unless defined ($dbh);
+ if ($type eq 'G' or $type eq 'Z' or $type eq 's' or $type eq 'Q') {
+ if ($sign == +1) {
+ my ($ident, $host, $setter, $expire, $time, $reason) = @parms;
+ $add_tklban->execute($type, $ident, $host, $setter, $expire, $time, $reason);
+ $add_tklban->finish();
+ diagmsg( get_tkl_type_name($type)." added for $ident\@$host ".
+ "from ($setter on ".gmtime2($time).
+ ($expire ? ' to expire at '.gmtime2($expire) : ' does not expire').": $reason)")
+ if initial_synced() and $type ne 'Q';
+ }
+ elsif($sign == -1) {
+ my ($ident, $host, $setter) = @parms;
+
+ if ($type ne 'Q' and initial_synced()) {
+ $get_tklban->execute($type, $ident, $host);
+ my (undef, $expire, $time, $reason) = $get_tklban->fetchrow_array;
+ $get_tklban->finish();
+
+ diagmsg( "$setter removed ".get_tkl_type_name($type)." $ident\@$host ".
+ "set at ".gmtime2($time)." - reason: $reason");
+ }
+
+ $del_tklban->execute($type, $ident, $host);
+ $del_tklban->finish();
+ }
+ }
+ elsif($type eq 'F') {
+ if($sign == +1) {
+ my ($target, $action, $setter, $expire, $time, $bantime, $reason, $mask) = @parms;
+ $add_spamfilter->execute($target, $action, $setter, $expire, $time, $bantime, $reason, $mask);
+ $add_spamfilter->finish();
+ diagmsg( "Spamfilter added: '$mask' [target: $target] [action: ".
+ get_filter_action_name($action)."] [reason: $reason] on ".gmtime2($time)."from ($setter)")
+ if initial_synced();
+ }
+ elsif($sign == -1) {
+ # TKL - F u Z tabris!northman@tabris.netadmin.SCnet.ops 0 0 :do_not!use@mask
+ my ($target, $action, $setter, $mask) = @parms;
+ if(initial_synced()) {
+ $get_spamfilter->execute($target, $action, $mask);
+ my ($time, $reason) = $get_spamfilter->fetchrow_array;
+ $get_spamfilter->finish();
+ $reason =~ tr/_/ /;
+ diagmsg( "$setter removed Spamfilter (action: ".get_filter_action_name($action).
+ ", targets: $target) (reason: $reason) '$mask' set at: ".gmtime2($time));
+ }
+ $del_spamfilter->execute($target, $action, $mask);
+ $del_spamfilter->finish();
+ }
+ }
+}
+
+sub saveconf() {
+ writeHash(\%conf, "config/securitybot/sb.conf");
+}
+
+sub loadconf($) {
+ my ($update) = @_;
+
+ %conf = readHash("config/securitybot/sb.conf");
+}
+
+sub update_conf($$) {
+ my ($k, $v) = @_;
+
+ return 0 if($k eq 'EnableTor');
+
+ $conf{$k} = $v;
+ return 1;
+}
+
+sub expire_tkl() {
+ $get_expired_tklban->execute();
+ while (my ($type, $ident, $host, $setter, $expire, $time, $reason) = $get_expired_tklban->fetchrow_array()) {
+ if ($type eq 'G' or $type eq 'Z' or $type eq 's') {
+ diagmsg( "Expiring ".get_tkl_type_name($type)." $ident\@$host ".
+ "set by $setter at ".gmtime2($time)." - reason: $reason");
+ #$del_tklban->execute($type, $ident, $host);
+ #$del_tklban->finish();
+ }
+ }
+ $get_expired_tklban->finish();
+
+ $del_expired_tklban->execute();
+ $del_expired_tklban->finish();
+}
+
+sub expire_tkl_timed {
+ my ($time) = @_;
+ $time = 10 unless $time;
+
+ add_timer('10', $time, __PACKAGE__, "securitybot::expire_tkl_timed");
+
+ expire_tkl();
+}
+
+sub diagmsg(@) {
+ ircd::privmsg($sbnick, main_conf_diag, @_);
+ write_log('diag', '<'.main_conf_local.'>', @_);
+}
+
+sub end { }
+sub unload { saveconf(); }
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package services;
+use strict;
+
+use DBI;
+use SrSv::MySQL qw($dbh);
+use SrSv::Conf qw(main services sql);
+use SrSv::Conf2Consts qw(main services sql);
+use SrSv::Timer qw(add_timer);
+use SrSv::Agent;
+use SrSv::IRCd::Event qw(addhandler);
+use SrSv::Log;
+
+use SrSv::NickServ;
+use SrSv::ChanServ;
+
+use modules::serviceslibs::adminserv;
+use modules::serviceslibs::nickserv;
+use modules::serviceslibs::chanserv;
+use modules::serviceslibs::operserv;
+use modules::serviceslibs::botserv;
+use modules::serviceslibs::memoserv;
+use modules::serviceslibs::hostserv;
+
+*conf = \%services_conf; # only used in some help docs
+
+our @agents = (
+ [$nsnick_default, '+opqzBHS', 'Nick Registration Agent'],
+ [$csnick_default, '+pqzBS', 'Channel Registration Agent'],
+ [$operserv::osnick_default, '+opqzBHS', 'Operator Services Agent'],
+ [$memoserv::msnick_default, '+pqzBS', 'Memo Exchange Agent'],
+ [$botserv::bsnick_default, '+pqzBS', 'Channel Bot Control Agent'],
+ [$adminserv::asnick_default, '+pqzBS', 'Services\' Administration Agent'],
+ [$hostserv::hsnick_default, '+pqzBS', 'vHost Agent']
+);
+if(services_conf_nickserv) {
+ push @agents, [services_conf_nickserv, '+opqzBHS', 'Nick Registration Agent'];
+ $nsnick = services_conf_nickserv;
+}
+if(services_conf_chanserv) {
+ push @agents, [services_conf_chanserv, '+pqzBS', 'Channel Registration Agent'];
+ $csnick = services_conf_chanserv;
+}
+if(services_conf_operserv) {
+ push @agents, [services_conf_operserv, '+opqzBHS', 'Operator Services Agent'];
+ $operserv::osnick = services_conf_operserv;
+}
+if(services_conf_memoserv) {
+ push @agents, [services_conf_memoserv, '+pqzBS', 'Memo Exchange Agent'];
+ $memoserv::msnick = services_conf_memoserv;
+}
+if(services_conf_botserv) {
+ push @agents, [services_conf_botserv, '+pqzBS', 'Channel Bot Control Agent'];
+ $botserv::bsnick = services_conf_botserv;
+}
+if(services_conf_adminserv) {
+ push @agents, [services_conf_adminserv, '+pqzBS', 'Services\' Administration Agent'];
+ $adminserv::asnick = services_conf_adminserv;
+}
+if(services_conf_hostserv) {
+ push @agents, [services_conf_hostserv, '+pqzBS', 'vHost Agent'];
+ $hostserv::hsnick = services_conf_hostserv;
+}
+
+our $qlreason = 'Reserved for Services';
+
+foreach my $a (@agents) {
+ agent_connect($a->[0], 'services', undef, $a->[1], $a->[2]);
+ ircd::sqline($a->[0], $qlreason);
+ agent_join($a->[0], main_conf_diag);
+ ircd::setmode($main::rsnick, main_conf_diag, '+o', $a->[0]);
+}
+
+addhandler('SEOS', undef, undef, 'services::ev_connect');
+sub ev_connect {
+ botserv::eos();
+ nickserv::cleanup_users();
+ nickserv::fix_vhosts();
+ chanserv::eos();
+ operserv::expire();
+}
+
+addhandler('EOS', undef, undef, 'services::eos');
+sub eos {
+ chanserv::eos($_[0]);
+}
+
+addhandler('KILL', undef, undef, 'nickserv::killhandle');
+
+addhandler('NICKCONN', undef, undef, 'services::ev_nickconn');
+sub ev_nickconn {
+ nickserv::nick_create(@_[0,2..4,8,5..7,9,10,11]);
+}
+
+# NickServ
+addhandler('NICKCHANGE', undef, undef, 'nickserv::nick_change');
+addhandler('QUIT', undef, undef, 'nickserv::nick_delete');
+addhandler('UMODE', undef, undef, 'nickserv::umode');
+addhandler('CHGHOST', undef, undef, 'nickserv::chghost');
+addhandler('CHGIDENT', undef, undef, 'nickserv::chgident');
+addhandler('USERIP', undef, undef, 'nickserv::userip');
+addhandler('SQUIT', undef, undef, 'nickserv::squit') if ircd::NOQUIT();
+
+addhandler('PRIVMSG', undef, 'nickserv', 'SrSv::NickServ::ns_dispatch');
+addhandler('PRIVMSG', undef, lc services_conf_nickserv, 'SrSv::NickServ::ns_dispatch') if services_conf_nickserv;
+
+addhandler('BACK', undef, undef, 'nickserv::notify_auths');
+
+# ChanServ
+addhandler('JOIN', undef, undef, 'chanserv::user_join');
+addhandler('SJOIN', undef, undef, 'chanserv::handle_sjoin');
+addhandler('PART', undef, undef, 'chanserv::user_part');
+addhandler('KICK', undef, undef, 'chanserv::process_kick');
+addhandler('MODE', undef, qr/^#/, 'chanserv::chan_mode');
+addhandler('TOPIC', undef, undef, 'chanserv::chan_topic');
+
+#addhandler('PRIVMSG', undef, 'chanserv', 'chanserv::dispatch');
+#addhandler('PRIVMSG', undef, lc services_conf_chanserv, 'chanserv::dispatch') if services_conf_chanserv;
+addhandler('PRIVMSG', undef, 'chanserv', 'SrSv::ChanServ::cs_dispatch');
+addhandler('PRIVMSG', undef, lc services_conf_chanserv, 'SrSv::ChanServ::cs_dispatch') if services_conf_chanserv;
+
+# OperServ
+addhandler('PRIVMSG', undef, 'operserv', 'operserv::dispatch');
+addhandler('PRIVMSG', undef, lc services_conf_operserv, 'operserv::dispatch') if services_conf_operserv;
+
+add_timer('flood_expire', 10, __PACKAGE__, 'operserv::flood_expire');
+
+# MemoServ
+addhandler('PRIVMSG', undef, 'memoserv', 'memoserv::dispatch');
+addhandler('PRIVMSG', undef, lc services_conf_memoserv, 'memoserv::dispatch') if services_conf_memoserv;
+addhandler('BACK', undef, undef, 'memoserv::notify');
+
+# BotServ
+addhandler('PRIVMSG', undef, undef, 'botserv::dispatch');
+# botserv takes all PRIVMSG and NOTICEs, so no special dispatch is needed.
+addhandler('NOTICE', undef, qr/^#/, 'botserv::chan_msg');
+
+# AdminServ
+addhandler('PRIVMSG', undef, 'adminserv', 'adminserv::dispatch');
+addhandler('PRIVMSG', undef, lc services_conf_adminserv, 'adminserv::dispatch') if services_conf_adminserv;
+
+add_timer('', 30, __PACKAGE__, 'services::maint');
+#add_timer('', 20, __PACKAGE__, 'nickserv::cleanup_users');
+add_timer('', 60, __PACKAGE__, 'nickserv::expire_silence_timed');
+
+# HostServ
+addhandler('PRIVMSG', undef, 'hostserv', 'hostserv::dispatch');
+addhandler('PRIVMSG', undef, lc services_conf_hostserv, 'hostserv::dispatch') if services_conf_hostserv;
+
+# $nick should be a registered root nick, if applicable
+# $src is the nick or nickid that sent the command
+sub ulog($$$$;$$) {
+ my ($service, $level, $text) = splice(@_, 0, 3);
+
+ my $hostmask = nickserv::get_hostmask($_[0]);
+
+ # TODO - Record this in the database
+
+ wlog($service, $level, "$hostmask - $text");
+}
+
+sub maint {
+ wlog($main::rsnick, LOG_INFO(), " -- Running maintenance routines.");
+ add_timer('', 3600, __PACKAGE__, 'services::maint');
+
+ nickserv::expire();
+ chanserv::expire();
+
+ wlog($main::rsnick, LOG_INFO(), " -- Maintenance routines complete.");
+}
+
+sub init {
+ my $tmpdbh = DBI->connect("DBI:mysql:".sql_conf_mysql_db, sql_conf_mysql_user, sql_conf_mysql_pass, { AutoCommit => 1, RaiseError => 1 });
+
+ $tmpdbh->do("TRUNCATE TABLE chanuser");
+ $tmpdbh->do("TRUNCATE TABLE nickchg");
+ $tmpdbh->do("TRUNCATE TABLE chan");
+ $tmpdbh->do("TRUNCATE TABLE chanban");
+ $tmpdbh->do("UPDATE user SET online=0, quittime=".time());
+
+ $tmpdbh->disconnect;
+}
+
+sub begin {
+ nickserv::init();
+ chanserv::init();
+ operserv::init();
+ botserv::init();
+ adminserv::init();
+ memoserv::init();
+ hostserv::init();
+}
+
+sub end {
+ $dbh->disconnect;
+}
+
+sub unload { }
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package adminserv;
+
+use strict;
+
+use SrSv::Agent;
+
+use SrSv::Text::Format qw(columnar);
+use SrSv::Errors;
+
+use SrSv::User qw(get_user_nick get_user_id);
+use SrSv::User::Notice;
+use SrSv::Help qw( sendhelp );
+
+use SrSv::Log;
+
+use SrSv::NickReg::Flags qw(NRF_NOHIGHLIGHT nr_chk_flag_user);
+
+use SrSv::MySQL '$dbh';
+
+use constant {
+ S_HELP => 1,
+ S_OPER => 2,
+ S_ADMIN => 3,
+ S_ROOT => 4,
+};
+
+# BE CAREFUL CHANGING THESE
+my @flags = (
+ 'SERVOP',
+ 'FJOIN',
+ 'SUPER',
+ 'HOLD',
+ 'FREEZE',
+ 'BOT',
+ 'QLINE',
+ 'KILL',
+ 'HELP',
+);
+my $allflags = (2**@flags) - 1;
+my %flags;
+for(my $i=0; $i<@flags; $i++) {
+ $flags{$flags[$i]} = 2**$i;
+}
+
+our $asnick_default = 'AdminServ';
+our $asnick = $asnick_default;
+
+our @levels = ('Normal User', 'HelpOp', 'Operator', 'Administrator', 'Root');
+my @defflags = (
+ 0, # Unused
+ $flags{HELP}, # HelpOp
+ $flags{HELP}|$flags{FJOIN}|$flags{QLINE}|$flags{SUPER}|$flags{FREEZE}|$flags{KILL}, # Operator
+ $flags{HELP}|$flags{FJOIN}|$flags{QLINE}|$flags{SUPER}|$flags{FREEZE}|$flags{HOLD}|$flags{BOT}|$flags{SERVOP}|$flags{KILL}, # Admin
+ $allflags # Root
+);
+
+our (
+ $create_svsop, $delete_svsop, $rename_svsop,
+
+ $get_svs_list, $get_all_svsops,
+
+ $get_svs_level, $set_svs_level, $get_best_svs_level,
+
+ $chk_pass, $get_pass, $set_pass
+);
+
+sub init() {
+ $create_svsop = $dbh->prepare("INSERT IGNORE INTO svsop SELECT id, NULL, NULL FROM nickreg WHERE nick=?");
+ $delete_svsop = $dbh->prepare("DELETE FROM svsop USING svsop, nickreg WHERE nickreg.nick=? AND svsop.nrid=nickreg.id");
+
+ $get_svs_list = $dbh->prepare("SELECT nickreg.nick, svsop.adder FROM svsop, nickreg WHERE svsop.level=? AND svsop.nrid=nickreg.id ORDER BY nickreg.nick");
+ $get_all_svsops = $dbh->prepare("SELECT nickreg.nick, svsop.level, svsop.adder FROM svsop, nickreg WHERE svsop.nrid=nickreg.id ORDER BY svsop.level, nickreg.nick");
+
+ $get_svs_level = $dbh->prepare("SELECT svsop.level FROM svsop, nickalias WHERE nickalias.alias=? AND svsop.nrid=nickalias.nrid");
+ $set_svs_level = $dbh->prepare("UPDATE svsop, nickreg SET svsop.level=?, svsop.adder=? WHERE nickreg.nick=? AND svsop.nrid=nickreg.id");
+ $get_best_svs_level = $dbh->prepare("SELECT svsop.level, nickreg.nick FROM nickid, nickreg, svsop WHERE nickid.nrid=nickreg.id AND svsop.nrid=nickreg.id AND nickid.id=? ORDER BY level DESC LIMIT 1");
+
+ $chk_pass = $dbh->prepare("SELECT 1 FROM ircop WHERE nick=? AND pass=?");
+ $get_pass = $dbh->prepare("SELECT pass FROM ircop WHERE nick=?");
+ $set_pass = $dbh->prepare("UPDATE ircop SET pass=? WHERE nick=?");
+}
+
+### ADMINSERV COMMANDS ###
+
+sub dispatch($$$) {
+ my ($src, $dst, $msg) = @_;
+ $msg =~ s/^\s+//;
+ my @args = split(/\s+/, $msg);
+ my $cmd = shift @args;
+
+ my $user = { NICK => $src, AGENT => $dst };
+
+ services::ulog($asnick, LOG_INFO(), "cmd: [$msg]", $user);
+
+ unless(is_svsop($user) or is_ircop($user)) {
+ notice($user, $err_deny);
+ ircd::globops($asnick, "\002$src\002 failed access to $asnick $msg");
+ return;
+ }
+
+ if($cmd =~ /^svsop$/i) {
+ my $cmd2 = shift @args;
+
+ if($cmd2 =~ /^add$/i) {
+ if(@args == 2 and $args[1] =~ /^[aoh]$/i) {
+ as_svs_add($user, $args[0], num_level($args[1]));
+ } else {
+ notice($user, 'Syntax: SVSOP ADD <nick> <A|O|H>');
+ }
+ }
+ elsif($cmd2 =~ /^del$/i) {
+ if(@args == 1) {
+ as_svs_del($user, $args[0]);
+ } else {
+ notice($user, 'Syntax: SVSOP DEL <nick>');
+ }
+ }
+ elsif($cmd2 =~ /^list$/i) {
+ if(@args == 1 and $args[0] =~ /^[raoh]$/i) {
+ as_svs_list($user, num_level($args[0]));
+ } else {
+ notice($user, 'Syntax: SVSOP LIST <R|A|O|H>');
+ }
+ }
+ else {
+ notice($user, 'Syntax: SVSOP <ADD|DEL|LIST> [...]');
+ }
+ }
+ elsif($cmd =~ /^whois$/i) {
+ if(@args == 1) {
+ as_whois($user, $args[0]);
+ } else {
+ notice($user, 'Syntax: WHOIS <nick>');
+ }
+ }
+ elsif($cmd =~ /^help$/i) {
+ sendhelp($user, 'adminserv', @args)
+ }
+ elsif($cmd =~ /^staff$/i) {
+ if(@args == 0) {
+ as_staff($user);
+ }
+ else {
+ notice($user, 'Syntax: STAFF');
+ }
+ }
+ else {
+ notice($user, "Unrecognized command. For help, type: \002/msg adminserv help\002");
+ }
+}
+
+sub as_svs_add($$$) {
+ my ($user, $nick, $level) = @_;
+ my $src = get_user_nick($user);
+
+ my ($root, $oper) = validate_chg($user, $nick);
+ return unless $oper;
+
+ if(get_svs_level($root) >= S_ROOT) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ $create_svsop->execute($root);
+ $set_svs_level->execute($level, $oper, $root);
+
+ notice($user, "\002$nick\002 is now a \002Services $levels[$level]\002.");
+ wlog($asnick, LOG_INFO(), "$src added $root as a Services $levels[$level].");
+}
+
+sub as_svs_del($$) {
+ my ($user, $nick) = @_;
+ my $src = get_user_nick($user);
+
+ my ($root, $oper) = validate_chg($user, $nick);
+ return unless $oper;
+
+ if(get_svs_level($root) >= S_ROOT) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ $delete_svsop->execute($root);
+ notice($user, "\002$nick\002 has been stripped of services rank.");
+ wlog($asnick, LOG_INFO(), "$src stripped $root of services rank.")
+}
+
+sub as_svs_list($$) {
+ my ($user, $level) = @_;
+ my (@data, @reply);
+
+ $get_svs_list->execute($level);
+
+ while(my ($nick, $adder) = $get_svs_list->fetchrow_array) {
+ push @data, [$nick, "($adder)"];
+ }
+
+ notice($user, columnar({TITLE => "Services $levels[$level] list:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data));
+}
+
+sub as_whois($$) {
+ my ($user, $nick) = @_;
+
+ my ($level, $root) = get_best_svs_level({ NICK => $nick });
+ notice($user, "\002$nick\002 is a Services $levels[$level]".($level ? ' due to identification to the nick '."\002$root\002." : ''));
+}
+
+sub as_staff($) {
+ my ($user) = @_;
+ my (@data);
+
+ $get_all_svsops->execute();
+
+ while(my ($nick, $level, $adder) = $get_all_svsops->fetchrow_array) {
+ push @data, [$nick, $levels[$level], "($adder)"];
+ }
+
+ notice($user, columnar({TITLE => 'Staff list:',
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data));
+}
+
+
+### DATABASE UTILITY FUNCTIONS ###
+
+sub validate_chg($$) {
+ my ($user, $nick) = @_;
+ my ($oper);
+
+ unless($oper = is_svsop($user, S_ROOT)) {
+ notice($user, $err_deny);
+ return undef;
+ }
+
+ my $root = nickserv::get_root_nick($nick);
+ unless($root) {
+ notice($user, "The nick \002$nick\002 is not registered.");
+ return undef;
+ }
+
+ return ($root, $oper);
+}
+
+sub can_do($$) {
+ my ($user, $flag) = @_;
+ my $nflag = $flags{$flag};
+
+ my ($level, $nick) = get_best_svs_level($user);
+
+ if($defflags[$level] & $nflag) {
+ return $nick if (($nflag == $flags{'HELP'}) or is_ircop($user));
+ }
+
+ return undef;
+}
+
+sub is_svsop($;$) {
+ my ($user, $rlev) = @_;
+
+ my ($level, $nick) = get_best_svs_level($user);
+ return $nick if(defined($level) and !defined($rlev));
+
+ if($level >= $rlev) {
+ return $nick if (($rlev == S_HELP) or is_ircop($user));
+ }
+
+ return undef;
+}
+
+sub is_ircop($) {
+ my ($user) = @_;
+
+ return undef if is_agent($user->{NICK});
+
+ return $user->{IRCOP} if(exists($user->{IRCOP}));
+
+ my %umodes = modes::splitumodes(nickserv::get_user_modes($user));
+
+ no warnings 'deprecated';
+ if(($umodes{'o'} eq '+') or ($umodes{'S'} eq '+')) {
+ $user->{IRCOP} = 1;
+ }
+ else {
+ $user->{IRCOP} = 0;
+ }
+
+ return $user->{IRCOP};
+}
+
+sub is_service($) {
+# detect if a user belongs to another service like NeoStats. only works if they set umode +S
+# is_ircop() includes is_service(), so no reason to call both.
+ my ($user) = @_;
+
+ return undef if is_agent($user->{NICK});
+
+ return $user->{SERVICE} if(exists($user->{SERVICE}));
+
+ my %umodes = modes::splitumodes(nickserv::get_user_modes($user));
+
+ if($umodes{'S'} eq '+') {
+ $user->{SERVICE} = 1;
+ $user->{IRCOP} = 1;
+ }
+ else {
+ $user->{SERVICE} = 0;
+ }
+
+ return $user->{SERVICE};
+}
+
+sub get_svs_level($) {
+ my ($nick) = @_;
+
+ return undef if is_agent($nick);
+
+ $get_svs_level->execute($nick);
+ my ($level) = $get_svs_level->fetchrow_array;
+
+ return $level or 0;
+}
+
+sub get_best_svs_level($) {
+ my ($user) = @_;
+
+ return undef if is_agent($user->{NICK});
+
+ if(exists($user->{SVSOP_LEVEL}) && exists($user->{SVSOP_NICK})) {
+ if(wantarray) {
+ return ($user->{SVSOP_LEVEL}, $user->{SVSOP_NICK});
+ } else {
+ return $user->{SVSOP_LEVEL};
+ }
+ }
+
+ my $uid = get_user_id($user);
+ $get_best_svs_level->execute($uid);
+ my ($level, $nick) = $get_best_svs_level->fetchrow_array;
+
+ $user->{SVSOP_LEVEL} = $level; $user->{SVSOP_NICK} = $nick;
+
+ if(wantarray) {
+ return ($level, $nick);
+ } else {
+ return $level;
+ }
+}
+
+### MISCELLANEA ###
+
+sub num_level($) {
+ my ($x) = @_;
+ $x =~ tr/hoarHOAR/12341234/;
+ return $x;
+}
+
+### IRC EVENTS ###
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package botserv;
+
+use strict;
+no strict 'refs';
+
+use Safe;
+
+use SrSv::Agent;
+use SrSv::Process::Worker 'ima_worker'; #FIXME
+
+use SrSv::Text::Format qw(columnar);
+use SrSv::Errors;
+
+use SrSv::Conf2Consts qw( main services );
+
+use SrSv::User qw(get_user_nick get_user_id);
+use SrSv::User::Notice;
+use SrSv::Help qw( sendhelp );
+
+use SrSv::ChanReg::Flags;
+use SrSv::NickReg::Flags qw(NRF_NOHIGHLIGHT nr_chk_flag_user);
+
+use SrSv::MySQL '$dbh';
+
+use constant {
+ F_PRIVATE => 1,
+ F_DEAF => 2
+};
+
+our $bsnick_default = 'BotServ';
+our $bsnick = $bsnick_default;
+our $botchmode;
+if(!ircd::PREFIXAQ_DISABLE()) {
+ $botchmode = '+q';
+} else {
+ $botchmode = '+qo';
+}
+
+*agent = \&chanserv::agent;
+
+our $calc_safe = new Safe;
+
+our (
+ $get_all_bots, $get_botchans, $get_botstay_chans, $get_chan_bot, $get_bots_chans, $get_bot_info,
+
+ $create_bot, $delete_bot, $delete_bot_allchans, $assign_bot, $unassign_bot,
+ $change_bot, $update_chanreg_bot,
+
+ $is_bot, $has_bot,
+
+ $set_flag, $unset_flag, $get_flags
+);
+
+sub init() {
+ $get_all_bots = $dbh->prepare("SELECT nick, ident, vhost, gecos, flags FROM bot");
+ $get_botchans = $dbh->prepare("SELECT chan, COALESCE(bot, '$chanserv::csnick') FROM chanreg WHERE bot != '' OR (flags & ". CRF_BOTSTAY() . ")");
+ $get_botstay_chans = $dbh->prepare("SELECT chan, COALESCE(bot, '$chanserv::csnick') FROM chanreg WHERE (flags & ".
+ CRF_BOTSTAY() . ")");
+ $get_chan_bot = $dbh->prepare("SELECT bot FROM chanreg WHERE chan=?");
+ $get_bots_chans = $dbh->prepare("SELECT chan FROM chanreg WHERE bot=?");
+ $get_bot_info = $dbh->prepare("SELECT nick, ident, vhost, gecos, flags FROM bot WHERE nick=?");
+
+ $create_bot = $dbh->prepare("INSERT INTO bot SET nick=?, ident=?, vhost=?, gecos=?");
+ $delete_bot = $dbh->prepare("DELETE FROM bot WHERE nick=?");
+ $delete_bot_allchans = $dbh->prepare("UPDATE chanreg SET bot='' WHERE bot=?");
+ $change_bot = $dbh->prepare("UPDATE bot SET nick=?, ident=?, vhost=?, gecos=? WHERE nick=?");
+ $update_chanreg_bot = $dbh->prepare("UPDATE chanreg SET bot=? WHERE bot=?");
+
+ $assign_bot = $dbh->prepare("UPDATE chanreg, bot SET chanreg.bot=bot.nick WHERE bot.nick=? AND chan=?");
+ $unassign_bot = $dbh->prepare("UPDATE chanreg SET chanreg.bot='' WHERE chan=?");
+
+ $is_bot = $dbh->prepare("SELECT 1 FROM bot WHERE nick=?");
+ $has_bot = $dbh->prepare("SELECT 1 FROM chanreg WHERE chan=? AND bot != ''");
+
+ $set_flag = $dbh->prepare("UPDATE bot SET flags=(flags | (?)) WHERE nick=?");
+ $unset_flag = $dbh->prepare("UPDATE bot SET flags=(flags & ~(?)) WHERE nick=?");
+ $get_flags = $dbh->prepare("SELECT flags FROM bot WHERE bot.nick=?");
+
+ register() unless ima_worker; #FIXME
+};
+
+sub dispatch($$$) {
+ my ($src, $dst, $msg) = @_;
+
+ if(lc $dst eq lc $bsnick or lc $dst eq lc $bsnick_default ) {
+ bs_dispatch($src, $dst, $msg);
+ }
+ elsif($dst =~ /^#/) {
+ if($msg =~ /^\!/) {
+ $has_bot->execute($dst);
+ return unless($has_bot->fetchrow_array);
+ chan_dispatch($src, $dst, $msg);
+ } else {
+ chan_msg($src, $dst, $msg);
+ }
+ }
+ else {
+ $is_bot->execute($dst);
+ if($is_bot->fetchrow_array) {
+ bot_dispatch($src, $dst, $msg);
+ }
+ }
+}
+
+### BOTSERV COMMANDS ###
+
+sub bs_dispatch($$$) {
+ my ($src, $dst, $msg) = @_;
+ $msg =~ s/^\s+//;
+ my @args = split(/\s+/, $msg);
+ my $cmd = shift @args;
+
+ my $user = { NICK => $src, AGENT => $bsnick };
+
+ return if operserv::flood_check($user);
+
+ if($cmd =~ /^assign$/i) {
+ if (@args == 2) {
+ bs_assign($user, {CHAN => $args[0]}, $args[1]);
+ } else {
+ notice($user, 'Syntax: ASSIGN <#channel> <bot>');
+ }
+ }
+ elsif ($cmd =~ /^unassign$/i) {
+ if (@args == 1) {
+ bs_assign($user, {CHAN => $args[0]}, '');
+ } else {
+ notice($user, 'Syntax: UNASSIGN <#channel>');
+ }
+ }
+ elsif ($cmd =~ /^list$/i) {
+ if(@args == 0) {
+ bs_list($user);
+ } else {
+ notice($user, 'Syntax: LIST');
+ }
+ }
+ elsif ($cmd =~ /^add$/i) {
+ if (@args >= 4) {
+ @args = split(/\s+/, $msg, 5);
+ bs_add($user, $args[1], $args[2], $args[3], $args[4]);
+ } else {
+ notice($user, 'Syntax: ADD <nick> <ident> <vhost> <realname>');
+ }
+ }
+ elsif ($cmd =~ /^change$/i) {
+ if (@args >= 4) {
+ @args = split(/\s+/, $msg, 6);
+ bs_change($user, $args[1], $args[2], $args[3], $args[4], $args[5]);
+ } else {
+ notice($user, 'Syntax: ADD <oldnick> <nick> <ident> <vhost> <realname>');
+ }
+ }
+ elsif ($cmd =~ /^del(ete)?$/i) {
+ if (@args == 1) {
+ bs_del($user, $args[0]);
+ } else {
+ notice($user, 'Syntax: DEL <botnick>');
+ }
+ }
+ elsif($cmd =~ /^set$/i) {
+ if(@args == 3) {
+ bs_set($user, $args[0], $args[1], $args[2]);
+ } else {
+ notice($user, 'Syntax: SET <botnick> <option> <value>');
+ }
+ }
+ elsif($cmd =~ /^seen$/i) {
+ if(@args >= 1) {
+ nickserv::ns_seen($user, @args);
+ } else {
+ notice($user, 'Syntax: SEEN <nick> [nick ...]');
+ }
+ }
+
+ elsif($cmd =~ /^(say|act)$/i) {
+ if(@args > 1) {
+ my @args = split(/\s+/, $msg, 3);
+ my $botmsg = $args[2];
+ $botmsg = "\001ACTION $botmsg\001" if(lc $cmd eq 'act');
+ bot_say($user, {CHAN => $args[1]}, $botmsg);
+ } else {
+ notice($user, 'Syntax: '.uc($cmd).' <#chan> <message>');
+ }
+ }
+ elsif($cmd =~ /^info$/i) {
+ if(@args == 1) {
+ bs_info($user, $args[0]);
+ } else {
+ notice($user, 'Syntax: INFO <botnick>');
+ }
+ }
+ elsif($cmd =~ /^help$/i) {
+ sendhelp($user, 'botserv', @args);
+ }
+ elsif($cmd =~ /^d(ice)?$/i) {
+ notice($user, get_dice($args[0]));
+ }
+ else {
+ notice($user, "Unrecognized command. For help, type: \002/bs help\002");
+ }
+}
+
+# For unassign, set $bot to ''
+#
+sub bs_assign($$$) {
+ my ($user, $chan, $bot) = @_;
+
+ chanserv::chk_registered($user, $chan) or return;
+
+ unless (chanserv::can_do($chan, 'BotAssign', $user)) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if ($bot) {
+ $is_bot->execute($bot);
+ unless($is_bot->fetchrow_array) {
+ notice($user, "\002$bot\002 is not a bot.");
+ return;
+ }
+ }
+
+ $get_flags->execute($bot);
+ my ($botflags) = $get_flags->fetchrow_array;
+ if (($botflags & F_PRIVATE) && !adminserv::can_do($user, 'BOT')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+
+ my $cn = $chan->{CHAN};
+ my $src = get_user_nick($user);
+ my $oldbot;
+ if ($oldbot = get_chan_bot($chan)) {
+ agent_part($oldbot, $cn, "Unassigned by \002$src\002.");
+ }
+
+
+
+ if($bot) {
+ $assign_bot->execute($bot, $cn);
+ bot_join($chan, $bot);
+ notice($user, "\002$bot\002 now assigned to \002$cn\002.");
+ } else {
+ $unassign_bot->execute($cn);
+ notice($user, "\002$oldbot\002 removed from \002$cn\002.");
+ }
+}
+
+sub bs_list($) {
+ my ($user) = @_;
+ my @data;
+ my $is_oper = adminserv::is_svsop($user, adminserv::S_HELP());
+
+ $get_all_bots->execute();
+ while (my ($botnick, $botident, $bothost, $botgecos, $flags) = $get_all_bots->fetchrow_array) {
+ if($is_oper) {
+ push @data, [$botnick, "($botident\@$bothost)", $botgecos,
+ (($flags & F_PRIVATE) ? "Private":"Public")];
+ } else {
+ next if($flags & F_PRIVATE);
+ push @data, [$botnick, "($botident\@$bothost)", $botgecos];
+ }
+ }
+
+ notice($user, columnar({TITLE => "The following bots are available:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data));
+}
+
+sub bs_add($$$$$) {
+ my ($user, $botnick, $botident, $bothost, $botgecos) = @_;
+
+ unless (adminserv::can_do($user, 'BOT')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if (my $ret = is_invalid_agentname($botnick, $botident, $bothost)) {
+ notice($user, $ret);
+ return;
+ }
+
+ if(nickserv::is_registered($botnick)) {
+ notice($user, "The nick \002$botnick\002 is already registered.");
+ return;
+ }
+
+ if(nickserv::is_online($botnick)) {
+ notice($user, "The nick \002$botnick\002 is currently in use.");
+ return;
+ }
+
+ $is_bot->execute($botnick);
+ if($is_bot->fetchrow_array) {
+ notice($user, "\002$botnick\002 already exists.");
+ return;
+ }
+
+ $create_bot->execute($botnick, $botident, $bothost, $botgecos);
+ ircd::sqline($botnick, $services::qlreason);
+ agent_connect($botnick, $botident, $bothost, '+pqBSrz', $botgecos);
+ agent_join($botnick, main_conf_diag);
+ ircd::setmode($main::rsnick, main_conf_diag, '+h', $botnick);
+
+ notice($user, "Bot $botnick connected.");
+}
+
+sub bs_del($$) {
+ my ($user, $botnick) = @_;
+
+ unless (adminserv::can_do($user, 'BOT')) {
+ notice($user, $err_deny);
+ return;
+ }
+ $is_bot->execute($botnick);
+ if (!$is_bot->fetchrow_array) {
+ notice($user, "\002$botnick\002 is not a bot.");
+ return;
+ }
+
+ my $src = get_user_nick($user);
+ $delete_bot->execute($botnick);
+ agent_quit($botnick, "Deleted by \002$src\002.");
+ ircd::unsqline($botnick);
+
+ $delete_bot_allchans->execute($botnick);
+ notice($user, "Bot \002$botnick\002 disconnected.");
+}
+
+sub bs_set($$$$) {
+ my ($user, $botnick, $set, $parm) = @_;
+
+ unless (adminserv::can_do($user, 'BOT')) {
+ notice($user, $err_deny);
+ return;
+ }
+ if($set =~ /^private$/i) {
+ if ($parm =~ /^(on|true)$/i) {
+ set_flag($botnick, F_PRIVATE());
+ notice($user, "\002$botnick\002 is now private.");
+ }
+ elsif ($parm =~ /^(off|false)$/i) {
+ unset_flag($botnick, F_PRIVATE());
+ notice($user, "\002$botnick\002 is now public.");
+ }
+ else {
+ notice($user, 'Syntax: SET <botnick> PRIVATE <ON|OFF>');
+ }
+ }
+ if($set =~ /^deaf$/i) {
+ if ($parm =~ /^(on|true)$/i) {
+ set_flag($botnick, F_DEAF());
+ setagent_umode($botnick, '+d');
+ notice($user, "\002$botnick\002 is now deaf.");
+ }
+ elsif ($parm =~ /^(off|false)$/i) {
+ unset_flag($botnick, F_DEAF());
+ setagent_umode($botnick, '-d');
+ notice($user, "\002$botnick\002 is now undeaf.");
+ }
+ else {
+ notice($user, 'Syntax: SET <botnick> DEAF <ON|OFF>');
+ }
+ }
+}
+
+sub bs_info($$) {
+ my ($user, $botnick) = @_;
+
+ unless (adminserv::can_do($user, 'HELP')) {
+ notice($user, $err_deny);
+ return;
+ }
+ $is_bot->execute($botnick);
+ unless($is_bot->fetchrow_array) {
+ notice($user, "\002$botnick\002 is not a bot.");
+ return;
+ }
+
+ $get_bot_info->execute($botnick);
+ my ($nick, $ident, $vhost, $gecos, $flags) = $get_bot_info->fetchrow_array;
+ $get_bot_info->finish();
+ $get_bots_chans->execute($botnick);
+ my @chans = ();
+ while (my $chan = $get_bots_chans->fetchrow_array) {
+ push @chans, $chan;
+ }
+ $get_bots_chans->finish();
+
+ notice($user, columnar({TITLE => "Information for bot \002$nick\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)},
+ ['Mask:', "$ident\@$vhost"], ['Realname:', $gecos],
+ ['Flags:', (($flags & F_PRIVATE())?'Private ':'').(($flags & F_DEAF())?'Deaf ':'')],
+ {COLLAPSE => [
+ 'Assigned to '. @chans.' channel(s):',
+ ' ' . join(' ', @chans)
+ ]}
+ ));
+}
+
+sub bs_change($$$$$$) {
+ my ($user, $oldnick, $botnick, $botident, $bothost, $botgecos) = @_;
+
+ if (lc $oldnick eq lc $botnick) {
+ notice($user, "Error: $oldnick is the same (case-insensitive) as $botnick",
+ "At this time, you cannot change only the ident, host, gecos, or nick-case of a bot.");
+ return;
+ }
+
+ unless (adminserv::can_do($user, 'BOT')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if (my $ret = is_invalid_agentname($botnick, $botident, $bothost)) {
+ notice($user, $ret);
+ return;
+ }
+
+ if(nickserv::is_registered($botnick)) {
+ notice($user, "The nick \002$botnick\002 is already registered.");
+ return;
+ }
+
+ if(nickserv::is_online($botnick)) {
+ notice($user, "The nick \002$botnick\002 is currently in use.");
+ return;
+ }
+
+ $is_bot->execute($botnick);
+ if($is_bot->fetchrow_array) {
+ notice($user, "\002$botnick\002 already exists.");
+ return;
+ }
+
+ #Create bot first, join it to its chans
+ # then finally delete the old bot
+ # This is to prevent races.
+ $create_bot->execute($botnick, $botident, $bothost, $botgecos);
+ ircd::sqline($botnick, $services::qlreason);
+ agent_connect($botnick, $botident, $bothost, '+pqBSrz', $botgecos);
+ agent_join($botnick, main_conf_diag);
+ ircd::setmode($main::rsnick, main_conf_diag, '+h', $botnick);
+
+ notice($user, "Bot $botnick connected.");
+
+ $get_bots_chans->execute($oldnick);
+ while(my ($cn) = $get_bots_chans->fetchrow_array()) {
+ my $chan = { CHAN => $cn };
+ bot_join($chan, $botnick)
+ if chanserv::get_user_count($chan) or cr_chk_flag($chan, CRF_BOTSTAY(), 1);
+ }
+ $get_bots_chans->finish();
+
+ $update_chanreg_bot->execute($botnick, $oldnick); $update_chanreg_bot->finish();
+
+ my $src = get_user_nick($user);
+ $delete_bot->execute($oldnick);
+ agent_quit($oldnick, "Deleted by \002$src\002.");
+ ircd::unsqline($oldnick);
+ notice($user, "Bot \002$oldnick\002 disconnected.");
+}
+
+### CHANNEL COMMANDS ###
+
+sub chan_dispatch($$$) {
+ my ($src, $cn, $msg) = @_;
+
+ my @args = split(/\s+/, $msg);
+ my $cmd = lc(shift @args);
+ $cmd =~ s/^\!//;
+
+ my $chan = { CHAN => $cn };
+ my $user = { NICK => $src, AGENT => agent($chan) };
+
+ my %cmdhash = (
+ 'voice' => \&give_ops,
+ 'devoice' => \&give_ops,
+ 'hop' => \&give_ops,
+ 'halfop' => \&give_ops,
+ 'dehop' => \&give_ops,
+ 'dehalfop' => \&give_ops,
+ 'op' => \&give_ops,
+ 'deop' => \&give_ops,
+ 'protect' => \&give_ops,
+ 'admin' => \&give_ops,
+ 'deprotect' => \&give_ops,
+ 'deadmin' => \&give_ops,
+
+ 'up' => \&up,
+
+ 'down' => \&down,
+ 'molest' => \&down,
+
+ 'invite' => \&invite,
+
+ 'kick' => \&kick,
+ 'k' => \&kick,
+
+ 'kb' => \&kickban,
+ 'kickb' => \&kickban,
+ 'kban' => \&kickban,
+ 'kickban' => \&kickban,
+ 'bk' => \&kickban,
+ 'bkick' => \&kickban,
+ 'bank' => \&kickban,
+ 'bankick' => \&kickban,
+
+ 'kickmask' => \&kickmask,
+ 'km' => \&kickmask,
+ 'kmask' => \&kickmask,
+
+ 'kickbanmask' => \&kickbanmask,
+ 'kickbmask' => \&kickbanmask,
+ 'kickbm' => \&kickbanmask,
+ 'kbm' => \&kickbanmask,
+ 'kbanm' => \&kickbanmask,
+ 'kbanmask' => \&kickbanmask,
+ 'kbmask' => \&kickbanmask,
+
+ 'calc' => \&calc,
+
+ 'seen' => \&seen,
+
+ #We really need something that is mostly obvious
+ # and won't be used by any other bots.
+ #TriviaBot I added !trivhelp
+ # I guess anope uses !commands
+ 'help' => \&help,
+ 'commands' => \&help,
+ 'botcmds' => \&help,
+
+ 'users' => \&alist,
+ 'alist' => \&alist,
+
+ 'unban' => \&unban,
+
+ 'banlist' => \&banlist,
+ 'blist' => \&banlist,
+
+ 'ban' => \&ban,
+ 'b' => \&ban,
+ 'qban' => \&ban,
+ 'nban' => \&ban,
+
+ 'd' => \&dice,
+ 'dice' => \&dice,
+
+ 'mode' => \&mode,
+ 'm' => \&mode,
+
+ 'resync' => \&resync,
+ );
+
+ sub give_ops {
+ my ($user, $cmd, $chan, @args) = @_;
+ chanserv::cs_setmodes($user, $cmd, $chan->{CHAN}, [@args]);
+ }
+ sub up {
+ my ($user, $cmd, $chan, @args) = @_;
+ chanserv::cs_updown($user, $cmd, [$chan->{CHAN}, @args]);
+ }
+ sub down {
+ my ($user, $cmd, $chan, @args) = @_;
+ if(lc $cmd eq 'molest') {
+ chanserv::unset_modes($user, [$chan->{CHAN}]);
+ } else {
+ chanserv::cs_updown($user, $cmd, [$chan->{CHAN}, @args]);
+ }
+ }
+
+ sub invite {
+ my ($user, $cmd, $chan, @args) = @_;
+ chanserv::cs_invite($user, $chan, [@args]) unless @args == 0;
+ }
+
+ sub kick {
+ my ($user, $cmd, $chan, @args) = @_;
+ my $target = shift @args;
+ chanserv::cs_kick($user, $chan, $target, 0, join(' ', @args));
+ }
+ sub kickban {
+ my ($user, $cmd, $chan, @args) = @_;
+ my $target = shift @args;
+ chanserv::cs_kick($user, $chan, $target, 1, join(' ', @args));
+ }
+
+ sub kickmask {
+ my ($user, $cmd, $chan, @args) = @_;
+ my $target = shift @args;
+ chanserv::cs_kickmask($user, $chan, $target, 0, join(' ', @args));
+ }
+ sub kickbanmask {
+ my ($user, $cmd, $chan, @args) = @_;
+ my $target = shift @args;
+ chanserv::cs_kickmask($user, $chan, $target, 1, join(' ', @args));
+ }
+
+ sub calc {
+ my ($user, $cmd, $chan, @args) = @_;
+ my $msg = join(' ', @args);
+ for ($msg) {
+ s/,/./g;
+ s/[^*.+0-9&|)(x\/^-]//g;
+ s/([*+\\.\/x-])\1*/$1/g;
+ s/\^/**/g;
+ s/(?<!0)x//g;
+ }
+
+ my $answer = $calc_safe->reval("($msg) || 0");
+ $answer = 'ERROR' unless defined $answer;
+
+ notice($user, ($@ ? "$msg = ERROR (${\ (split / at/, $@, 2)[0]})" : "$msg = $answer"));
+ }
+
+ sub seen {
+ my ($user, $cmd, $chan, @args) = @_;
+
+ if(@args >= 1) {
+ nickserv::ns_seen($user, [@args]);
+ } else {
+ notice($user, 'Syntax: SEEN <nick> [nick ...]');
+ }
+ }
+
+ sub help {
+ my ($user, $cmd, $chan, @args) = @_;
+ sendhelp($user, 'chanbot');
+ }
+
+ sub alist {
+ my ($user, $cmd, $chan, @args) = @_;
+ chanserv::cs_alist($user, $chan);
+ }
+
+ sub unban {
+ my ($user, $cmd, $chan, @args) = @_;
+ if(@args == 0) {
+ chanserv::cs_unban($user, $chan, [get_user_nick($user)]);
+ }
+ elsif(@args >= 1) {
+ chanserv::cs_unban($user, $chan, [@args]);
+ }
+ }
+
+ sub ban {
+ my ($user, $cmd, $chan, @args) = @_;
+ $cmd =~ /^(q|n)?ban$/; my $type = $1;
+ if(@args >= 1) {
+ chanserv::cs_ban($user, $chan, $type, @args);
+ }
+ }
+
+ sub banlist {
+ my ($user, $cmd, $chan, @args) = @_;
+ chanserv::cs_banlist($user, $chan);
+ }
+
+ sub dice {
+ # FIXME: If dice is disabled, don't count towards flooding.
+ my ($user, $cmd, $chan, @args) = @_;
+
+ if(chanserv::can_do($chan, 'DICE', $user)) {
+ ircd::privmsg(agent($chan), $chan->{CHAN},
+ get_dice($args[0]));
+ }
+ }
+
+ sub mode {
+ my ($user, $cmd, $chan, @args) = @_;
+ if(@args >= 1) {
+ chanserv::cs_mode($user, $chan, shift @args, @args);
+ }
+ }
+
+ sub resync {
+ my ($user, $cmd, $chan) = @_;
+ chanserv::cs_resync($user, $chan->{CHAN});
+ }
+
+ if(defined($cmdhash{$cmd})) {
+ return if operserv::flood_check($user);
+
+ &{$cmdhash{$cmd}}($user, $cmd, $chan, @args);
+ }
+}
+
+sub bot_say($$$) {
+ my ($user, $chan, $botmsg) = @_;
+ my $cn = $chan->{CHAN};
+
+ if(chanserv::can_do($chan, 'BotSay', $user)) {
+ ircd::notice(agent($chan), '%'.$cn, get_user_nick($user).' used BotSay')
+ if cr_chk_flag($chan, CRF_VERBOSE());
+ ircd::privmsg(agent($chan), $cn, $botmsg);
+ } else {
+ notice($user, $err_deny);
+ }
+}
+
+### BOT COMMANDS ###
+
+sub bot_dispatch($$$) {
+ my ($src, $bot, $msg) = @_;
+
+ my ($cmd, $cn, $botmsg) = split(/ /, $msg, 3);
+
+ my $user = { NICK => $src, AGENT => $bot };
+ my $chan = { CHAN => $cn };
+
+ return if operserv::flood_check($user);
+
+ if ($cmd =~ /^join$/i) {
+ if (adminserv::can_do($user, 'BOT')) {
+ agent_join($bot, $cn);
+ } else {
+ notice($user, $err_deny);
+ }
+ }
+ elsif ($cmd =~ /^part$/i) {
+ if (adminserv::can_do($user, 'BOT')) {
+ agent_part($bot, $cn, "$src requested part");
+ } else {
+ notice($user, $err_deny);
+ }
+ }
+ elsif ($cmd =~ /^say$/i) {
+ bot_say($user, $chan, $botmsg);
+ }
+ elsif ($cmd =~ /^act$/i) {
+ bot_say($user, $chan, "\001ACTION $botmsg\001");
+ }
+ elsif ($cmd =~ /^help$/i) {
+ #my @help; @help = ($cn) if $cn; push @help, split(/\s+/, $botmsg);
+ sendhelp($user, 'botpriv');
+ }
+}
+
+sub get_dice($) {
+ my ($count, $sides) = map int($_), ($_[0] ? split('d', $_[0]) : (1, 6));
+
+ if ($sides < 1 or $sides > 1000 or $count < 0 or $count > 100) {
+ return "Sorry, you can't have more than 100 dice, or 1000 sides, or less than 1 of either.";
+ }
+ $count = 1 if $count == 0;
+
+ my $sum = 0;
+
+ if($count == 1 or $count > 25) {
+ for(my $i = 1; $i <= $count; $i++) {
+ $sum += int(rand($sides)+1);
+ }
+
+ return "${count}d$sides: $sum";
+ }
+ else {
+ my @dice;
+
+ for(my $i = 1; $i <= $count; $i++) {
+ my $n = int(rand($sides)+1);
+ $sum += $n;
+ push @dice, $n;
+ }
+
+ return "${count}d$sides: $sum [" . join(' ', sort {$a <=> $b} @dice) . "]";
+ }
+}
+
+### IRC EVENTS ###
+
+sub chan_msg($$$) {
+ #We don't do chanmsg processing yet, like badwords.
+}
+
+sub register() {
+ $get_all_bots->execute();
+ while(my ($nick, $ident, $vhost, $gecos, $flags) = $get_all_bots->fetchrow_array) {
+ agent_connect($nick, $ident, $vhost, '+pqBSrz'.(($flags & F_DEAF())?'d':''), $gecos);
+ ircd::sqline($nick, $services::qlreason);
+ agent_join($nick, main_conf_diag);
+ ircd::setmode($main::rsnick, main_conf_diag, '+h', $nick);
+ }
+}
+
+sub eos() {
+ $get_botchans->execute();
+ while(my ($cn, $nick) = $get_botchans->fetchrow_array) {
+ my $chan = { CHAN => $cn };
+ if(chanserv::get_user_count($chan)) {
+ bot_join($chan, $nick);
+ }
+ elsif(cr_chk_flag($chan, CRF_BOTSTAY(), 1)) {
+ bot_join($chan, $nick);
+ my $modelock = chanserv::get_modelock($chan);
+ ircd::setmode(main_conf_local, $cn, $modelock) if $modelock;
+ }
+ }
+}
+
+### Database Functions ###
+
+sub set_flag($$) {
+ my ($bot, $flag) = @_;
+
+ $set_flag->execute($flag, $bot);
+}
+
+sub unset_flag($$) {
+ my ($bot, $flag) = @_;
+
+ $unset_flag->execute($flag, $bot);
+}
+
+sub bot_join($;$) {
+ my ($chan, $nick) = @_;
+
+ my $cn = $chan->{CHAN};
+
+ $nick = agent($chan) unless $nick;
+
+ unless(is_agent_in_chan($nick, $cn)) {
+ agent_join($nick, $cn);
+ ircd::setmode($nick, $cn, $botchmode, $nick.(ircd::PREFIXAQ_DISABLE() ? ' '.$nick : '') );
+ }
+}
+
+sub bot_part_if_needed($$$;$) {
+ my ($nick, $chan, $reason, $empty) = @_;
+ my $cn = $chan->{CHAN};
+ my $bot = get_chan_bot($chan);
+ $nick = agent($chan) unless $nick;
+
+ return if (lc $chanserv::enforcers{lc $cn} eq lc $nick);
+
+ if(is_agent_in_chan($nick, $cn)) {
+ if(lc $bot eq lc $nick) {
+ if(cr_chk_flag($chan, CRF_BOTSTAY(), 1) or ($empty != 1 or chanserv::get_user_count($chan))) {
+ return;
+ }
+ }
+
+ agent_part($nick, $cn, $reason);
+ }
+}
+
+sub get_chan_bot($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+ $botserv::get_chan_bot->execute($cn);
+
+ my ($bot) = $botserv::get_chan_bot->fetchrow_array();
+ $botserv::get_chan_bot->finish();
+
+ return $bot;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package chanserv;
+
+use strict;
+use DBI qw(:sql_types);
+
+use SrSv::Timer qw(add_timer);
+
+use SrSv::Message qw(current_message);
+use SrSv::IRCd::State qw($ircline synced initial_synced %IRCd_capabilities);
+use SrSv::Message qw(message current_message);
+use SrSv::HostMask qw(normalize_hostmask make_hostmask parse_mask);
+
+use SrSv::Unreal::Modes qw(@opmodes %opmodes $scm $ocm $acm sanitize_mlockable);
+use SrSv::Unreal::Validate qw( valid_nick validate_chmodes validate_ban );
+use SrSv::Agent;
+
+use SrSv::Shared qw(%enforcers $chanuser_table);
+
+#use SrSv::Conf qw(services);
+use SrSv::Conf2Consts qw(services sql );
+
+use SrSv::Time;
+use SrSv::Text::Format qw( columnar enum );
+use SrSv::Errors;
+
+use SrSv::Log;
+
+use SrSv::User qw(get_user_nick get_user_id is_online chk_user_flag set_user_flag_all get_host get_vhost UF_FINISHED);
+use SrSv::User::Notice;
+use SrSv::Help qw( sendhelp );
+
+use SrSv::ChanReg::Flags;
+
+use SrSv::NickReg::Flags;
+use SrSv::NickReg::User qw(is_identified get_nick_users get_nick_user_nicks);
+
+use SrSv::MySQL '$dbh';
+use SrSv::MySQL::Glob;
+
+use SrSv::Util qw( makeSeqList );
+
+use SrSv::ChanServ;
+
+use constant {
+ UOP => 1,
+ VOP => 2,
+ HOP => 3,
+ AOP => 4,
+ SOP => 5,
+ COFOUNDER => 6,
+ FOUNDER => 7,
+
+ # Maybe this should be a config option
+ DEFAULT_BANTYPE => 10,
+
+ CRT_TOPIC => 1,
+ CRT_AKICK => 2,
+};
+
+*get_root_nick = \&nickserv::get_root_nick;
+
+our @levels = ("no", "UOp", "VOp", "HOp", "AOp", "SOp", "co-founder", "founder");
+our @ops;
+if(!ircd::PREFIXAQ_DISABLE()) {
+ @ops = (0, 0, 1, 2, 4, 8, 16, 16); # PREFIX_AQ
+} else { # lame IRC scripts and admins who don't enable PREFIX_AQ
+ @ops = (0, 0, 1, 2, 4, 12, 20, 20); # normal
+}
+our @plevels = ('AKICK', 'anyone', 'UOp', 'VOp', 'HOp', 'AOp', 'SOp', 'co-founder', 'founder', 'disabled');
+our $plzero = 1;
+
+our @override = (
+ ['SERVOP',
+ {
+ ACCCHANGE => 1,
+ SET => 1,
+ MEMO => 1,
+ SETTOPIC => 1,
+ AKICK => 1,
+ LEVELS => 1,
+ COPY => 1,
+ }
+ ],
+ ['SUPER',
+ {
+ BAN => 1,
+ KICK => 1,
+ VOICE => 1,
+ HALFOP => 1,
+ OP => 1,
+ ADMIN => 1,
+ OWNER => 1,
+ SETTOPIC => 1,
+ INVITE => 1,
+ INVITESELF => 1,
+ JOIN => 1,
+ CLEAR => 1,
+ AKICKENFORCE => 1,
+ UPDOWN => 1,
+ MODE => 1,
+ }
+ ],
+ ['HELP',
+ {
+ ACCLIST => 1,
+ LEVELSLIST => 1,
+ AKICKLIST => 1,
+ INFO => 1,
+ GETKEY => 1
+ }
+ ],
+ ['BOT',
+ {
+ BOTSAY => 1,
+ BOTASSIGN => 1
+ }
+ ]
+);
+
+$chanuser_table = 0;
+
+our ($cur_lock, $cnt_lock);
+
+our (
+ $get_joinpart_lock, $get_modelock_lock, $get_update_modes_lock,
+
+ $chanjoin, $chanpart, $chop, $chdeop, $get_op, $get_user_chans, $get_user_chans_recent,
+ $get_all_closed_chans, $get_user_count,
+
+ #$lock_chanuser, $get_all_chan_users,
+ $unlock_tables,
+ $get_chan_users, $get_chan_users_noacc, $get_chan_users_mask, $get_chan_users_mask_noacc,
+
+ $get_users_nochans, $get_users_nochans_noid,
+
+ $get_using_nick_chans,
+
+ $get_lock, $release_lock, $is_free_lock,
+
+ $chan_create, $chan_delete, $get_chanmodes, $set_chanmodes,
+
+ $get_modelock, $set_modelock, $set_descrip,
+
+ $get_topic, $set_topic1, $set_topic2,
+
+ $get_acc, $set_acc1, $set_acc2, $del_acc, $get_acc_list, $get_acc_list2, $get_acc_list_mask, $get_acc_list2_mask,
+ $wipe_acc_list,
+ $get_best_acc, $get_all_acc, $get_highrank, $get_acc_count,
+ $copy_acc, $copy_acc_rank,
+
+ $get_eos_lock, $get_status_all, $get_status_all_server, $get_modelock_all,
+
+ $get_akick, $get_akick_allchan, $get_akick_alluser, $get_akick_all, $add_akick, $del_akick,
+ $get_akick_list, $get_akick_by_num,
+
+ $add_nick_akick, $del_nick_akick, $get_nick_akick, $drop_nick_akick,
+ $copy_akick,
+
+ $is_level, $get_level, $get_levels, $add_level, $set_level, $reset_level, $clear_levels, $get_level_max,
+ $copy_levels,
+
+ $get_founder, $get_successor,
+ $set_founder, $set_successor, $del_successor,
+
+ $get_nick_own_chans, $delete_successors,
+
+ $get_info,
+
+ $register, $drop_acc, $drop_lvl, $drop_akick, $drop,
+ $copy_chanreg,
+
+ $get_expired,
+
+ $get_close, $set_close, $del_close,
+
+ $add_welcome, $del_welcome, $list_welcome, $get_welcomes, $drop_welcome,
+ $count_welcome, $consolidate_welcome,
+
+ $add_ban, $delete_bans, $delete_ban,
+ $get_all_bans, $get_ban_num,
+ $find_bans, $list_bans, $wipe_bans,
+ $find_bans_chan_user, $delete_bans_chan_user,
+
+ $add_auth, $list_auth_chan, $get_auth_nick, $get_auth_num, $find_auth,
+
+ $set_bantype, $get_bantype,
+
+ $drop_chantext, $drop_nicktext,
+
+ $get_recent_private_chans,
+);
+
+sub init() {
+ #$chan_create = $dbh->prepare("INSERT IGNORE INTO chan SET id=(RAND()*294967293)+1, chan=?");
+ $get_joinpart_lock = $dbh->prepare("LOCK TABLES chan WRITE, chanuser WRITE");
+ $get_modelock_lock = $dbh->prepare("LOCK TABLES chanreg READ LOCAL, chan WRITE");
+ $get_update_modes_lock = $dbh->prepare("LOCK TABLES chan WRITE");
+
+ $chanjoin = $dbh->prepare("REPLACE INTO chanuser (seq,nickid,chan,op,joined) VALUES (?, ?, ?, ?, 1)");
+ $chanpart = $dbh->prepare("UPDATE chanuser SET joined=0, seq=?
+ WHERE nickid=? AND chan=? AND (seq <= ? OR seq > ?)");
+ #$chop = $dbh->prepare("UPDATE chanuser SET op=op+? WHERE nickid=? AND chan=?");
+ $chop = $dbh->prepare("UPDATE chanuser SET op=IF(op & ?, op, op ^ ?) WHERE nickid=? AND chan=?");
+ $chdeop = $dbh->prepare("UPDATE chanuser SET op=IF(op & ?, op ^ ?, op) WHERE nickid=? AND chan=?");
+ $get_op = $dbh->prepare("SELECT op FROM chanuser WHERE nickid=? AND chan=?");
+ $get_user_chans = $dbh->prepare("SELECT chan, op FROM chanuser WHERE nickid=? AND joined=1 AND (seq <= ? OR seq > ?)");
+ $get_user_chans_recent = $dbh->prepare("SELECT chan, joined, op FROM chanuser WHERE nickid=?");
+
+ $get_all_closed_chans = $dbh->prepare("SELECT chanclose.chan, chanclose.type, chanclose.reason, chanclose.nick, chanclose.time FROM chanreg, chanuser, chanclose WHERE chanreg.chan=chanuser.chan AND chanreg.chan=chanclose.chan AND chanreg.flags & ? GROUP BY chanclose.chan ORDER BY NULL");
+ $get_user_count = $dbh->prepare("SELECT COUNT(*) FROM chanuser WHERE chan=? AND joined=1");
+
+
+ #$lock_chanuser = $dbh->prepare("LOCK TABLES chanuser READ, user READ");
+ #$get_all_chan_users = $dbh->prepare("SELECT user.nick, chanuser.nickid, chanuser.chan FROM chanuser, user WHERE user.id=chanuser.nickid AND chanuser.joined=1");
+ $unlock_tables = $dbh->prepare("UNLOCK TABLES");
+
+ $get_chan_users = $dbh->prepare("SELECT user.nick, user.id FROM chanuser, user
+ WHERE chanuser.chan=? AND user.id=chanuser.nickid AND chanuser.joined=1");
+ my $chan_users_noacc_tables = 'user '.
+ 'JOIN chanuser ON (chanuser.nickid=user.id AND chanuser.joined=1 AND user.online=1) '.
+ 'LEFT JOIN nickid ON (chanuser.nickid=nickid.id) '.
+ 'LEFT JOIN chanacc ON (nickid.nrid=chanacc.nrid AND chanuser.chan=chanacc.chan)';
+ $get_chan_users_noacc = $dbh->prepare("SELECT user.nick, user.id FROM $chan_users_noacc_tables
+ WHERE chanuser.chan=?
+ GROUP BY user.id HAVING MAX(IF(chanacc.level IS NULL, 0, chanacc.level)) <= 0
+ ORDER BY NULL");
+ my $check_mask = "((user.nick LIKE ?) AND (user.ident LIKE ?)
+ AND ((user.vhost LIKE ?) OR (user.host LIKE ?) OR (user.cloakhost LIKE ?)))";
+ $get_chan_users_mask = $dbh->prepare("SELECT user.nick, user.id FROM chanuser, user
+ WHERE chanuser.chan=? AND user.id=chanuser.nickid AND chanuser.joined=1 AND $check_mask");
+ $get_chan_users_mask_noacc = $dbh->prepare("SELECT user.nick, user.id FROM $chan_users_noacc_tables
+ WHERE chanuser.chan=? AND $check_mask
+ GROUP BY user.id HAVING MAX(IF(chanacc.level IS NULL, 0, chanacc.level)) <= 0
+ ORDER BY NULL");
+
+ $get_users_nochans = $dbh->prepare("SELECT user.nick, user.id
+ FROM user LEFT JOIN chanuser ON (chanuser.nickid=user.id AND chanuser.joined=1)
+ WHERE chanuser.chan IS NULL AND user.online=1");
+ $get_users_nochans_noid = $dbh->prepare("SELECT user.nick, user.id
+ FROM user LEFT JOIN chanuser ON (chanuser.nickid=user.id AND chanuser.joined=1)
+ LEFT JOIN nickid ON (nickid.id=user.id)
+ WHERE chanuser.chan IS NULL AND nickid.id IS NULL
+ AND user.online=1");
+
+ $get_using_nick_chans = $dbh->prepare("SELECT user.nick FROM user, nickid, nickreg, chanuser
+ WHERE user.id=nickid.id AND user.id=chanuser.nickid AND nickid.nrid=nickreg.id AND chanuser.joined=1
+ AND nickreg.nick=? AND chanuser.chan=?");
+
+ $get_lock = $dbh->prepare("SELECT GET_LOCK(?, 3)");
+ $release_lock = $dbh->prepare("DO RELEASE_LOCK(?)");
+ $is_free_lock = $dbh->prepare("SELECT IS_FREE_LOCK(?)");
+
+ $chan_create = $dbh->prepare("INSERT IGNORE INTO chan SET seq=?, chan=?");
+ $chan_delete = $dbh->prepare("DELETE FROM chan WHERE chan=?");
+ $get_chanmodes = $dbh->prepare("SELECT modes FROM chan WHERE chan=?");
+ $set_chanmodes = $dbh->prepare("REPLACE INTO chan SET modes=?, chan=?");
+
+ $get_modelock = $dbh->prepare("SELECT modelock FROM chanreg WHERE chan=?");
+ $set_modelock = $dbh->prepare("UPDATE chanreg SET modelock=? WHERE chan=?");
+
+ $set_descrip = $dbh->prepare("UPDATE chanreg SET descrip=? WHERE chan=?");
+
+ $get_topic = $dbh->prepare("SELECT chantext.data, topicer, topicd FROM chanreg, chantext
+ WHERE chanreg.chan=chantext.chan AND chantext.chan=?");
+ $set_topic1 = $dbh->prepare("UPDATE chanreg SET chanreg.topicer=?, chanreg.topicd=?
+ WHERE chanreg.chan=?");
+ $set_topic2 = $dbh->prepare("REPLACE INTO chantext SET chan=?, type=".CRT_TOPIC().", data=?");
+
+ $get_acc = $dbh->prepare("SELECT chanacc.level FROM chanacc, nickalias
+ WHERE chanacc.chan=? AND chanacc.nrid=nickalias.nrid AND nickalias.alias=?");
+ $set_acc1 = $dbh->prepare("INSERT IGNORE INTO chanacc SELECT ?, nrid, ?, NULL, UNIX_TIMESTAMP(), 0
+ FROM nickalias WHERE alias=?");
+ $set_acc2 = $dbh->prepare("UPDATE chanacc, nickalias
+ SET chanacc.level=?, chanacc.adder=?, chanacc.time=UNIX_TIMESTAMP()
+ WHERE chanacc.chan=? AND chanacc.nrid=nickalias.nrid AND nickalias.alias=?");
+ $del_acc = $dbh->prepare("DELETE FROM chanacc USING chanacc, nickalias
+ WHERE chanacc.chan=? AND chanacc.nrid=nickalias.nrid AND nickalias.alias=?");
+ $wipe_acc_list = $dbh->prepare("DELETE FROM chanacc WHERE chan=? AND level=?");
+ $get_acc_list = $dbh->prepare("SELECT nickreg.nick, chanacc.adder, chanacc.time,
+ chanacc.last, nickreg.ident, nickreg.vhost
+ FROM chanacc, nickreg
+ WHERE chanacc.chan=? AND chanacc.level=? AND chanacc.nrid=nickreg.id AND chanacc.level > 0 ORDER BY nickreg.nick");
+ $get_acc_list2 = $dbh->prepare("SELECT nickreg.nick, chanacc.adder, chanacc.level, chanacc.time,
+ chanacc.last, nickreg.ident, nickreg.vhost
+ FROM chanacc, nickreg
+ WHERE chanacc.chan=? AND chanacc.nrid=nickreg.id AND chanacc.level > 0 ORDER BY nickreg.nick");
+ $get_acc_list_mask = $dbh->prepare("SELECT IF (nickreg.nick LIKE ?, nickreg.nick, nickalias.alias), chanacc.adder, chanacc.time,
+ chanacc.last, nickreg.ident, nickreg.vhost, COUNT(nickreg.id) as c
+ FROM chanacc, nickalias, nickreg
+ WHERE chanacc.chan=? AND chanacc.level=? AND chanacc.nrid=nickalias.nrid AND nickreg.id=nickalias.nrid
+ AND chanacc.level > 0
+ AND nickalias.alias LIKE ? AND nickreg.ident LIKE ? AND nickreg.vhost LIKE ?
+ GROUP BY nickreg.id
+ ORDER BY nickalias.alias");
+ $get_acc_list2_mask = $dbh->prepare("SELECT IF (nickreg.nick LIKE ?, nickreg.nick, nickalias.alias),
+ chanacc.adder, chanacc.level, chanacc.time,
+ chanacc.last, nickreg.ident, nickreg.vhost, COUNT(nickreg.id) as c
+ FROM chanacc, nickalias, nickreg
+ WHERE chanacc.chan=? AND chanacc.nrid=nickalias.nrid AND nickreg.id=nickalias.nrid
+ AND chanacc.level > 0
+ AND nickalias.alias LIKE ? AND nickreg.ident LIKE ? AND nickreg.vhost LIKE ?
+ GROUP BY nickreg.id
+ ORDER BY nickalias.alias");
+
+ $get_best_acc = $dbh->prepare("SELECT nickreg.nick, chanacc.level
+ FROM nickid, nickalias, nickreg, chanacc
+ WHERE nickid.nrid=nickreg.id AND nickalias.nrid=nickreg.id AND nickid.id=?
+ AND chanacc.nrid=nickreg.id AND chanacc.chan=? ORDER BY chanacc.level DESC LIMIT 1");
+ $get_all_acc = $dbh->prepare("SELECT nickreg.nick, chanacc.level
+ FROM nickid, nickreg, chanacc
+ WHERE nickid.nrid=nickreg.id AND nickid.id=? AND chanacc.nrid=nickreg.id
+ AND chanacc.chan=? ORDER BY chanacc.level");
+ $get_highrank = $dbh->prepare("SELECT user.nick, chanacc.level FROM chanuser, nickid, chanacc, user WHERE chanuser.chan=? AND chanuser.joined=1 AND chanuser.chan=chanacc.chan AND chanuser.nickid=nickid.id AND user.id=nickid.id AND nickid.nrid=chanacc.nrid ORDER BY chanacc.level DESC LIMIT 1");
+ $get_acc_count = $dbh->prepare("SELECT COUNT(*) FROM chanacc WHERE chan=? AND level=?");
+ $copy_acc = $dbh->prepare("REPLACE INTO chanacc
+ ( chan, nrid, level, adder, time)
+ SELECT ?, nrid, level, adder, time FROM chanacc JOIN nickreg ON (chanacc.nrid=nickreg.id)
+ WHERE chan=? AND nickreg.nick!=? AND chanacc.level!=7");
+ $copy_acc_rank = $dbh->prepare("REPLACE INTO chanacc
+ ( chan, nrid, level, adder, time)
+ SELECT ?, nrid, level, adder, time FROM chanacc
+ WHERE chan=? AND chanacc.level=?");
+
+ $get_eos_lock = $dbh->prepare("LOCK TABLES akick READ LOCAL, welcome READ LOCAL, chanuser WRITE, user WRITE,
+ user AS u1 READ, user AS u2 READ, chan WRITE, chanreg WRITE, nickid READ LOCAL, nickreg READ LOCAL,
+ nickalias READ LOCAL, chanacc READ LOCAL, chanban WRITE, svsop READ");
+ my $get_status_all_1 = "SELECT chanuser.chan, chanreg.flags, chanreg.bot, user.nick, user.id, user.flags, MAX(chanacc.level), chanuser.op, MAX(nickreg.flags & ".NRF_NEVEROP().")
+ FROM user, chanreg, chanuser
+ LEFT JOIN nickid ON(nickid.id=chanuser.nickid)
+ LEFT JOIN nickreg ON(nickid.nrid=nickreg.id)
+ LEFT JOIN chanacc ON(chanacc.chan=chanuser.chan AND chanacc.nrid=nickid.nrid AND (nickreg.flags & ".NRF_NEVEROP().")=0)
+ WHERE";
+ my $get_status_all_2 = "(user.flags & ".UF_FINISHED().")=0 AND chanuser.joined=1 AND (chanreg.flags & ".(CRF_CLOSE|CRF_DRONE).") = 0 AND chanreg.chan=chanuser.chan AND user.id=chanuser.nickid AND (nickid.nrid IS NULL OR nickreg.id IS NOT NULL)
+ GROUP BY chanuser.chan, chanuser.nickid ORDER BY NULL";
+ $get_status_all = $dbh->prepare("$get_status_all_1 $get_status_all_2");
+ $get_status_all_server = $dbh->prepare("$get_status_all_1 user.server=? AND $get_status_all_2");
+
+ $get_modelock_all = $dbh->prepare("SELECT chanuser.chan, chan.modes, chanreg.modelock FROM chanreg, chan, chanuser WHERE chanuser.joined=1 AND chanreg.chan=chan.chan AND chanreg.chan=chanuser.chan GROUP BY chanreg.chan ORDER BY NULL");
+
+ my $akick_rows = "user.nick, akick.nick, akick.ident, akick.host, akick.reason";
+ my $akick_no_zerolen = "(akick.ident != '' AND akick.host != '')";
+ my $akick_single_cond = "$akick_no_zerolen AND user.nick LIKE akick.nick AND user.ident LIKE akick.ident ".
+ "AND ( (user.host LIKE akick.host) OR (user.vhost LIKE akick.host) OR ".
+ "(IF((user.ip IS NOT NULL) AND (user.ip != 0), INET_NTOA(user.ip) LIKE akick.host, 0)) OR ".
+ "(IF(user.cloakhost IS NOT NULL, user.cloakhost LIKE akick.host, 0)) )";
+ my $akick_multi_cond = "chanuser.chan=akick.chan AND $akick_single_cond";
+
+ $get_akick = $dbh->prepare("SELECT $akick_rows FROM akick, user ".
+ "WHERE user.id=? AND akick.chan=? AND $akick_single_cond LIMIT 1");
+ $get_akick_allchan = $dbh->prepare("SELECT $akick_rows FROM $chan_users_noacc_tables
+ JOIN akick ON($akick_multi_cond)
+ WHERE akick.chan=?
+ GROUP BY user.id HAVING MAX(IF(chanacc.level IS NULL, 0, chanacc.level)) <= 0
+ ORDER BY NULL");
+ $get_akick_alluser = $dbh->prepare("SELECT akick.chan, $akick_rows FROM $chan_users_noacc_tables
+ JOIN akick ON($akick_multi_cond)
+ WHERE chanuser.nickid=?
+ GROUP BY user.id HAVING MAX(IF(chanacc.level IS NULL, 0, chanacc.level)) <= 0
+ ORDER BY NULL");
+ $get_akick_all = $dbh->prepare("SELECT akick.chan, $akick_rows FROM $chan_users_noacc_tables
+ JOIN akick ON($akick_multi_cond)
+ GROUP BY akick.chan, user.id HAVING MAX(IF(chanacc.level IS NULL, 0, chanacc.level)) <= 0
+ ORDER BY NULL");
+
+ $add_akick = $dbh->prepare("INSERT INTO akick SET chan=?, nick=?, ident=?, host=?, adder=?, reason=?, time=UNIX_TIMESTAMP()");
+ $add_akick->{PrintError} = 0;
+ $del_akick = $dbh->prepare("DELETE FROM akick WHERE chan=? AND nick=? AND ident=? AND host=?");
+ $get_akick_list = $dbh->prepare("SELECT nick, ident, host, adder, reason, time FROM akick WHERE chan=? ORDER BY time");
+
+ $add_nick_akick = $dbh->prepare("INSERT INTO akick SELECT ?, nickalias.nrid, '', '', ?, ?, UNIX_TIMESTAMP()
+ FROM nickalias WHERE alias=?");
+ $del_nick_akick = $dbh->prepare("DELETE FROM akick USING akick, nickalias
+ WHERE akick.chan=? AND akick.nick=nickalias.nrid AND akick.ident='' AND akick.host='' AND nickalias.alias=?");
+ $get_nick_akick = $dbh->prepare("SELECT reason FROM akick, nickalias
+ WHERE akick.chan=? AND akick.nick=nickalias.nrid AND akick.ident='' AND akick.host='' AND nickalias.alias=?");
+ $drop_nick_akick = $dbh->prepare("DELETE FROM akick USING akick, nickreg
+ WHERE akick.nick=nickreg.id AND akick.ident='' AND akick.host='' AND nickreg.nick=?");
+ $copy_akick = $dbh->prepare("REPLACE INTO akick
+ ( chan, nick, ident, host, adder, reason, time)
+ SELECT ?, nick, ident, host, adder, reason, time FROM akick WHERE chan=?");
+ $get_akick_by_num = $dbh->prepare("SELECT akick.nick, akick.ident, akick.host FROM akick WHERE chan=?
+ ORDER BY time LIMIT 1 OFFSET ?");
+ $get_akick_by_num->bind_param(2, 0, SQL_INTEGER);
+
+ $is_level = $dbh->prepare("SELECT 1 FROM chanperm WHERE chanperm.name=?");
+ $get_level = $dbh->prepare("SELECT IF(chanlvl.level IS NULL, chanperm.level, chanlvl.level), chanlvl.level
+ FROM chanperm LEFT JOIN chanlvl ON chanlvl.perm=chanperm.id AND chanlvl.chan=?
+ WHERE chanperm.name=?");
+ $get_levels = $dbh->prepare("SELECT chanperm.name, chanperm.level, chanlvl.level FROM chanperm LEFT JOIN chanlvl ON chanlvl.perm=chanperm.id AND chanlvl.chan=? ORDER BY chanperm.name");
+ $add_level = $dbh->prepare("INSERT IGNORE INTO chanlvl SELECT ?, chanperm.id, chanperm.level FROM chanperm WHERE chanperm.name=?");
+ $set_level = $dbh->prepare("UPDATE chanlvl, chanperm SET chanlvl.level=? WHERE chanlvl.chan=? AND chanperm.id=chanlvl.perm AND chanperm.name=?");
+ $reset_level = $dbh->prepare("DELETE FROM chanlvl USING chanlvl, chanperm WHERE chanperm.name=? AND chanlvl.perm=chanperm.id AND chanlvl.chan=?");
+ $clear_levels = $dbh->prepare("DELETE FROM chanlvl WHERE chan=?");
+ $get_level_max = $dbh->prepare("SELECT max FROM chanperm WHERE name=?");
+ $copy_levels = $dbh->prepare("REPLACE INTO chanlvl
+ ( chan, perm, level)
+ SELECT ?, perm, level FROM chanlvl WHERE chan=?");
+
+ $get_founder = $dbh->prepare("SELECT nickreg.nick FROM chanreg, nickreg WHERE chanreg.chan=? AND chanreg.founderid=nickreg.id");
+ $get_successor = $dbh->prepare("SELECT nickreg.nick FROM chanreg, nickreg WHERE chanreg.chan=? AND chanreg.successorid=nickreg.id");
+ $set_founder = $dbh->prepare("UPDATE chanreg, nickreg SET chanreg.founderid=nickreg.id WHERE nickreg.nick=? AND chanreg.chan=?");
+ $set_successor = $dbh->prepare("UPDATE chanreg, nickreg SET chanreg.successorid=nickreg.id WHERE nickreg.nick=? AND chanreg.chan=?");
+ $del_successor = $dbh->prepare("UPDATE chanreg SET chanreg.successorid=NULL WHERE chanreg.chan=?");
+
+ $get_nick_own_chans = $dbh->prepare("SELECT chanreg.chan FROM chanreg, nickreg WHERE nickreg.nick=? AND chanreg.founderid=nickreg.id");
+ $delete_successors = $dbh->prepare("UPDATE chanreg, nickreg SET chanreg.successorid=NULL WHERE nickreg.nick=? AND chanreg.successorid=nickreg.id");
+
+ $get_info = $dbh->prepare("SELECT chanreg.descrip, chanreg.regd, chanreg.last, chantext.data,
+ chanreg.topicer, chanreg.modelock, foundernick.nick, successornick.nick, chanreg.bot, chanreg.bantype
+ FROM nickreg AS foundernick, chanreg
+ LEFT JOIN nickreg AS successornick ON(successornick.id=chanreg.successorid)
+ LEFT JOIN chantext ON (chanreg.chan=chantext.chan AND chantext.type=".CRT_TOPIC().")
+ WHERE chanreg.chan=? AND foundernick.id=chanreg.founderid");
+
+ $register = $dbh->prepare("INSERT INTO chanreg
+ SELECT ?, ?, UNIX_TIMESTAMP(), UNIX_TIMESTAMP(), NULL, NULL,
+ NULL, id, NULL, NULL, NULL, ".DEFAULT_BANTYPE()." FROM nickreg WHERE nick=?");
+ $register->{PrintError} = 0;
+ $copy_chanreg = $dbh->prepare("INSERT INTO chanreg
+ ( chan, descrip, regd, last, modelock, founderid, successorid, bot, flags, bantype)
+ SELECT ?, descrip, UNIX_TIMESTAMP(), UNIX_TIMESTAMP(), modelock, founderid, successorid, bot, flags, bantype
+ FROM chanreg WHERE chan=?");
+
+ $drop_acc = $dbh->prepare("DELETE FROM chanacc WHERE chan=?");
+ $drop_lvl = $dbh->prepare("DELETE FROM chanlvl WHERE chan=?");
+ $drop_akick = $dbh->prepare("DELETE FROM akick WHERE chan=?");
+ $drop = $dbh->prepare("DELETE FROM chanreg WHERE chan=?");
+
+ $get_expired = $dbh->prepare("SELECT chanreg.chan, nickreg.nick FROM nickreg, chanreg
+ LEFT JOIN chanuser ON(chanreg.chan=chanuser.chan AND chanuser.op!=0)
+ WHERE chanreg.founderid=nickreg.id AND chanuser.chan IS NULL AND chanreg.last<? AND
+ !(chanreg.flags & " . CRF_HOLD . ")");
+
+ $get_close = $dbh->prepare("SELECT reason, nick, time FROM chanclose WHERE chan=?");
+ $set_close = $dbh->prepare("REPLACE INTO chanclose SET chan=?, reason=?, nick=?, time=UNIX_TIMESTAMP(), type=?");
+ $del_close = $dbh->prepare("DELETE FROM chanclose WHERE chan=?");
+
+ $add_welcome = $dbh->prepare("REPLACE INTO welcome SET chan=?, id=?, adder=?, time=UNIX_TIMESTAMP(), msg=?");
+ $del_welcome = $dbh->prepare("DELETE FROM welcome WHERE chan=? AND id=?");
+ $list_welcome = $dbh->prepare("SELECT id, time, adder, msg FROM welcome WHERE chan=? ORDER BY id");
+ $get_welcomes = $dbh->prepare("SELECT msg FROM welcome WHERE chan=? ORDER BY id");
+ $drop_welcome = $dbh->prepare("DELETE FROM welcome WHERE chan=?");
+ $count_welcome = $dbh->prepare("SELECT COUNT(*) FROM welcome WHERE chan=?");
+ $consolidate_welcome = $dbh->prepare("UPDATE welcome SET id=id-1 WHERE chan=? AND id>?");
+
+ $add_ban = $dbh->prepare("REPLACE INTO chanban SET chan=?, mask=?, setter=?, type=?, time=UNIX_TIMESTAMP()");
+ $delete_bans = $dbh->prepare("DELETE FROM chanban WHERE chan=? AND ? LIKE mask AND type=?");
+ # likely need a better name for this or for the above.
+ $delete_ban = $dbh->prepare("DELETE FROM chanban WHERE chan=? AND mask=? AND type=?");
+ $find_bans = $dbh->prepare("SELECT mask FROM chanban WHERE chan=? AND ? LIKE mask AND type=?");
+ $get_all_bans = $dbh->prepare("SELECT mask FROM chanban WHERE chan=? AND type=?");
+ $get_ban_num = $dbh->prepare("SELECT mask FROM chanban WHERE chan=? ORDER BY time, mask LIMIT 1 OFFSET ?");
+ $get_ban_num->bind_param(2, 0, SQL_INTEGER);
+ $list_bans = $dbh->prepare("SELECT mask, setter, time FROM chanban WHERE chan=? AND type=? ORDER BY time, mask");
+ $wipe_bans = $dbh->prepare("DELETE FROM chanban WHERE chan=?");
+
+ my $chanban_mask = "((CONCAT(user.nick, '!', user.ident, '\@', user.host) LIKE chanban.mask) ".
+ "OR (CONCAT(user.nick , '!' , user.ident , '\@' , user.vhost) LIKE chanban.mask) ".
+ "OR IF(user.cloakhost IS NOT NULL, ".
+ "(CONCAT(user.nick , '!' , user.ident , '\@' , user.cloakhost) LIKE chanban.mask), 0))";
+ $find_bans_chan_user = $dbh->prepare("SELECT mask FROM chanban,user
+ WHERE chan=? AND user.id=? AND type=? AND $chanban_mask");
+ $delete_bans_chan_user = $dbh->prepare("DELETE FROM chanban USING chanban,user
+ WHERE chan=? AND user.id=? AND type=? AND $chanban_mask");
+
+ $add_auth = $dbh->prepare("REPLACE INTO nicktext
+ SELECT nickalias.nrid, (".nickserv::NTF_AUTH()."), 1, ?, ? FROM nickalias WHERE nickalias.alias=?");
+ $list_auth_chan = $dbh->prepare("SELECT nickreg.nick, nicktext.data FROM nickreg, nicktext
+ WHERE nickreg.id=nicktext.nrid AND nicktext.type=(".nickserv::NTF_AUTH().") AND nicktext.chan=?");
+ $get_auth_nick = $dbh->prepare("SELECT nicktext.data FROM nickreg, nickalias, nicktext
+ WHERE nickreg.id=nicktext.nrid AND nickreg.id=nickalias.nrid AND nicktext.type=(".nickserv::NTF_AUTH().")
+ AND nicktext.chan=? AND nickalias.alias=?");
+ $get_auth_num = $dbh->prepare("SELECT nickreg.nick, nicktext.data FROM nickreg, nickalias, nicktext
+ WHERE nickreg.id=nicktext.nrid AND nickreg.id=nickalias.nrid AND nicktext.type=(".nickserv::NTF_AUTH().")
+ AND nicktext.chan=? LIMIT 1 OFFSET ?");
+ $get_auth_num->bind_param(2, 0, SQL_INTEGER);
+ $find_auth = $dbh->prepare("SELECT 1 FROM nickalias, nicktext
+ WHERE nickalias.nrid=nicktext.nrid AND nicktext.type=(".nickserv::NTF_AUTH().")
+ AND nicktext.chan=? AND nickalias.alias=?");
+
+ $set_bantype = $dbh->prepare("UPDATE chanreg SET bantype=? WHERE chan=?");
+ $get_bantype = $dbh->prepare("SELECT bantype FROM chanreg WHERE chan=?");
+
+ $drop_chantext = $dbh->prepare("DELETE FROM chantext WHERE chan=?");
+ $drop_nicktext = $dbh->prepare("DELETE nicktext.* FROM nicktext WHERE nicktext.chan=?");
+
+ $get_recent_private_chans = $dbh->prepare("SELECT chanuser.chan FROM chanperm, chanlvl, chanuser, nickid, chanacc WHERE chanperm.name='Join' AND chanlvl.perm=chanperm.id AND chanlvl.level > 0 AND nickid.id=? AND chanacc.nrid=nickid.nrid AND chanuser.nickid=nickid.id AND chanuser.joined=0 AND chanuser.chan=chanacc.chan AND chanlvl.level <= chanacc.level");
+}
+
+import SrSv::MySQL::Stub {
+ # This one isn't very well constructed. 'nickid' is really 'user.id'
+ # chanuser.nickid=user.id (and thus chanuser.nickid should be called chanuser.userid)
+ __is_in_chan => ['SCALAR', "SELECT 1 FROM chanuser WHERE nickid=? AND chan=? AND joined=1"],
+
+ __is_registered => ['SCALAR', "SELECT 1 FROM chanreg WHERE chan=?"],
+
+ set_lastused => ['NULL', "UPDATE chanacc, nickid SET chanacc.last=UNIX_TIMESTAMP() WHERE
+ chanacc.chan=? AND nickid.id=? AND chanacc.nrid=nickid.nrid AND chanacc.level > 0"],
+ set_lastop => ['NULL', "UPDATE chanreg SET last=UNIX_TIMESTAMP() WHERE chan=?"],
+};
+
+### CHANSERV COMMANDS ###
+
+=cut
+sub dispatch($$$) {
+ my ($src, $dst, $msg) = @_;
+
+ $msg =~ s/^\s+//;
+ my @args = split(/\s+/, $msg);
+ my $cmd = shift @args;
+
+ my $user = { NICK => $src, AGENT => $dst };
+
+ return if operserv::flood_check($user);
+
+ if($cmd =~ /^register$/i) {
+ if(@args >= 1) {
+ my @args = split(/\s+/, $msg, 4);
+ cs_register($user, { CHAN => $args[1] }, $args[2], $args[3]);
+ } else {
+ notice($user, 'Syntax: REGISTER <#channel> [password] [description]');
+ }
+ }
+ elsif($cmd =~ /^(?:[uvhas]op|co?f(ounder)?)$/i) {
+ my ($cn, $cmd2) = splice(@args, 0, 2);
+ my $chan = { CHAN => $cn };
+
+ if($cmd2 =~ /^add$/i) {
+ if(@args == 1) {
+ cs_xop_add($user, $chan, $cmd, $args[0]);
+ } else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> ADD <nick>');
+ }
+ }
+ elsif($cmd2 =~ /^del(ete)?$/i) {
+ if(@args == 1) {
+ cs_xop_del($user, $chan, $cmd, $args[0]);
+ } else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> DEL <nick>');
+ }
+ }
+ elsif($cmd2 =~ /^list$/i) {
+ if(@args >= 0) {
+ cs_xop_list($user, $chan, $cmd, $args[0]);
+ } else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> LIST [mask]');
+ }
+ }
+ elsif($cmd2 =~ /^(wipe|clear)$/i) {
+ if(@args == 0) {
+ cs_xop_wipe($user, $chan, $cmd);
+ } else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> WIPE');
+ }
+ }
+ else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> <ADD|DEL|LIST|WIPE>');
+ }
+ }
+ elsif($cmd =~ /^levels$/i) {
+ if(@args < 2) {
+ notice($user, 'Syntax: LEVELS <#channel> <SET|RESET|LIST|CLEAR>');
+ return;
+ }
+
+ my $cmd2 = lc(splice(@args, 1, 1));
+
+ if($cmd2 eq 'set') {
+ if(@args == 3) {
+ cs_levels_set($user, { CHAN => $args[0] }, $args[1], $args[2]);
+ } else {
+ notice($user, 'Syntax: LEVELS <#channel> SET <permission> <level>');
+ }
+ }
+ elsif($cmd2 eq 'reset') {
+ if(@args == 2) {
+ cs_levels_set($user, { CHAN => $args[0] }, $args[1]);
+ } else {
+ notice($user, 'Syntax: LEVELS <#channel> RESET <permission>');
+ }
+ }
+ elsif($cmd2 eq 'list') {
+ if(@args == 1) {
+ cs_levels_list($user, { CHAN => $args[0] });
+ } else {
+ notice($user, 'Syntax: LEVELS <#channel> LIST');
+ }
+ }
+ elsif($cmd2 eq 'clear') {
+ if(@args == 1) {
+ cs_levels_clear($user, { CHAN => $args[0] });
+ } else {
+ notice($user, 'Syntax: LEVELS <#channel> CLEAR');
+ }
+ }
+ else {
+ notice($user, 'Syntax: LEVELS <#channel> <SET|RESET|LIST|CLEAR>');
+ }
+ }
+ elsif($cmd =~ /^akick$/i) {
+ }
+ elsif($cmd =~ /^info$/i) {
+ if(@args == 1) {
+ cs_info($user, { CHAN => $args[0] });
+ } else {
+ notice($user, 'Syntax: INFO <channel>');
+ }
+ }
+ elsif($cmd =~ /^set$/i) {
+ if(@args == 2 and lc($args[1]) eq 'unsuccessor') {
+ cs_set($user, { CHAN => $args[0] }, $args[1]);
+ }
+ elsif(@args >= 3 and (
+ $args[1] =~ /m(?:ode)?lock/i or
+ lc($args[1]) eq 'desc'
+ )) {
+ my @args = split(/\s+/, $msg, 4);
+ cs_set($user, { CHAN => $args[1] }, $args[2], $args[3]);
+ }
+ elsif(@args == 3) {
+ cs_set($user, { CHAN => $args[0] }, $args[1], $args[2]);
+ }
+ else {
+ notice($user, 'Syntax: SET <channel> <option> <value>');
+ }
+ }
+ elsif($cmd =~ /^why$/i) {
+ if(@args == 1) {
+ cs_why($user, { CHAN => shift @args }, $src);
+ }
+ elsif(@args >= 2) {
+ cs_why($user, { CHAN => shift @args }, @args);
+ } else {
+ notice($user, 'Syntax: WHY <channel> <nick> [nick [nick ...]]');
+ return;
+ }
+ }
+ elsif($cmd =~ /^(de)?(voice|h(alf)?op|op|protect|admin|owner)$/i) {
+ if(@args >= 1) {
+ cs_setmodes($user, $cmd, { CHAN => shift(@args) }, @args);
+ } else {
+ notice($user, 'Syntax: '.uc($cmd).' <channel> [nick [nick ...]]');
+ }
+ }
+ elsif($cmd =~ /^(up|down)$/i) {
+ cs_updown($user, $cmd, @args);
+ }
+ elsif($cmd =~ /^drop$/i) {
+ if(@args == 1) {
+ cs_drop($user, { CHAN => $args[0] });
+ } else {
+ notice($user, 'Syntax: DROP <channel>');
+ }
+ }
+ elsif($cmd =~ /^help$/i) {
+ sendhelp($user, 'chanserv', @args)
+ }
+ elsif($cmd =~ /^count$/i) {
+ if(@args == 1) {
+ cs_count($user, { CHAN => $args[0] });
+ } else {
+ notice($user, 'Syntax: COUNT <channel>');
+ }
+ }
+ elsif($cmd =~ /^kick$/i) {
+ my @args = split(/\s+/, $msg, 4); shift @args;
+ if(@args >= 2) {
+ cs_kick($user, { CHAN => $args[0] }, $args[1], 0, $args[2])
+ }
+ else {
+ notice($user, 'Syntax: KICK <channel> <nick> [reason]');
+ }
+ }
+ elsif($cmd =~ /^(k(ick)?b(an)?|b(an)?k(ick)?)$/i) {
+ my @args = split(/\s+/, $msg, 4); shift @args;
+ if(@args >= 2) {
+ cs_kick($user, { CHAN => $args[0] }, $args[1], 1, $args[2]);
+ } else {
+ notice($user, 'Syntax: KICKBAN <channel> <nick> [reason]');
+ }
+ }
+ elsif($cmd =~ /^k(ick)?m(ask)?$/i) {
+ my @args = split(/\s+/, $msg, 4); shift @args;
+ if(@args >= 2) {
+ cs_kickmask($user, { CHAN => $args[0] }, $args[1], 0, $args[2])
+ }
+ else {
+ notice($user, 'Syntax: KICKMASK <channel> <mask> [reason]');
+ }
+ }
+ elsif($cmd =~ /^(k(ick)?b(an)?|b(an)?k(ick)?)m(ask)?$/i) {
+ my @args = split(/\s+/, $msg, 4); shift @args;
+ if(@args >= 2) {
+ cs_kickmask($user, { CHAN => $args[0] }, $args[1], 1, $args[2]);
+ } else {
+ notice($user, 'Syntax: KICKBANMASK <channel> <mask> [reason]');
+ }
+ }
+ elsif($cmd =~ /^invite$/i) {
+ my $chan = shift @args;
+ if(@args == 0) {
+ cs_invite($user, { CHAN => $chan }, $src)
+ }
+ elsif(@args >= 1) {
+ cs_invite($user, { CHAN => $chan }, @args)
+ }
+ else {
+ notice($user, 'Syntax: INVITE <channel> <nick>');
+ }
+ }
+ elsif($cmd =~ /^(close|forbid)$/i) {
+ if(@args > 1) {
+ my @args = split(/\s+/, $msg, 3);
+ cs_close($user, { CHAN => $args[1] }, $args[2], CRF_CLOSE);
+ }
+ else {
+ notice($user, 'Syntax: CLOSE <chan> <reason>');
+ }
+ }
+ elsif($cmd =~ /^drone$/i) {
+ if(@args > 1) {
+ my @args = split(/\s+/, $msg, 3);
+ cs_close($user, { CHAN => $args[1] }, $args[2], CRF_DRONE);
+ }
+ else {
+ notice($user, 'Syntax: DRONE <chan> <reason>');
+ }
+ }
+ elsif($cmd =~ /^clear$/i) {
+ my ($cmd, $chan, $clearcmd, $reason) = split(/\s+/, $msg, 4);
+ unless ($chan and $clearcmd) {
+ notice($user, 'Syntax: CLEAR <channel> <MODES|OPS|USERS|BANS> [reason]');
+ return;
+ }
+ if($clearcmd =~ /^modes$/i) {
+ cs_clear_modes($user, { CHAN => $chan }, $reason);
+ }
+ elsif($clearcmd =~ /^ops$/i) {
+ cs_clear_ops($user, { CHAN => $chan }, $reason);
+ }
+ elsif($clearcmd =~ /^users$/i) {
+ cs_clear_users($user, { CHAN => $chan }, $reason);
+ }
+ elsif($clearcmd =~ /^bans?$/i) {
+ cs_clear_bans($user, { CHAN => $chan }, 0, $reason);
+ }
+ elsif($clearcmd =~ /^excepts?$/i) {
+ cs_clear_bans($user, { CHAN => $chan }, 128, $reason);
+ }
+ else {
+ notice($user, "Unknown CLEAR command \002$clearcmd\002",
+ 'Syntax: CLEAR <channel> <MODES|OPS|USERS|BANS> [reason]');
+ }
+ }
+ elsif($cmd =~ /^mkick$/i) {
+ my ($cmd, $chan, $reason) = split(/\s+/, $msg, 3);
+ if($chan) {
+ cs_clear_users($user, { CHAN => $chan }, $reason);
+ }
+ else {
+ notice($user, 'Syntax: MKICK <chan> [reason]');
+ }
+ }
+ elsif($cmd =~ /^mdeop$/i) {
+ my ($cmd, $chan, $reason) = split(/\s+/, $msg, 3);
+ if($chan) {
+ cs_clear_ops($user, { CHAN => $chan }, $reason);
+ }
+ else {
+ notice($user, 'Syntax: MDEOP <chan> [reason]');
+ }
+ }
+ elsif($cmd =~ /^welcome$/i) {
+ my $wcmd = splice(@args, 1, 1);
+ if(lc($wcmd) eq 'add') {
+ my ($chan, $wmsg) = (splice(@args, 0, 1), join(' ', @args));
+ unless ($chan and $wmsg) {
+ notice($user, 'Syntax: WELCOME <channel> ADD <message>');
+ return;
+ }
+ cs_welcome_add($user, { CHAN => $chan }, $wmsg);
+ }
+ elsif(lc($wcmd) eq 'del') {
+ if (@args != 2 or !misc::isint($args[1])) {
+ notice($user, 'Syntax: WELCOME <channnel> DEL <number>');
+ return;
+ }
+ cs_welcome_del($user, { CHAN => $args[0] }, $args[1]);
+ }
+ elsif(lc($wcmd) eq 'list') {
+ if (@args != 1) {
+ notice($user, 'Syntax: WELCOME <channel> LIST');
+ return;
+ }
+ cs_welcome_list($user, { CHAN => $args[0] });
+ }
+ else {
+ notice($user, 'Syntax: WELCOME <channel> <ADD|DEL|LIST>');
+ }
+ }
+ elsif($cmd =~ /^alist$/i) {
+ if(@args >= 1) {
+ cs_alist($user, { CHAN => shift @args }, shift @args);
+ } else {
+ notice($user, 'Syntax: ALIST <channel> [mask]');
+ }
+ }
+ elsif($cmd =~ /^unban$/i) {
+ if(@args == 1) {
+ cs_unban($user, { CHAN => shift @args }, $src);
+ }
+ elsif(@args >= 2) {
+ cs_unban($user, { CHAN => shift @args }, @args);
+ } else {
+ notice($user, 'Syntax: UNBAN <channel> [nick]');
+ }
+ }
+ elsif($cmd =~ /^getkey$/i) {
+ if(@args == 1) {
+ cs_getkey($user, { CHAN => $args[0] });
+ } else {
+ notice($user, 'Syntax: GETKEY <channel>');
+ }
+ }
+ elsif($cmd =~ /^auth$/i) {
+ if (@args == 0) {
+ notice($user, 'Syntax: AUTH <channel> <LIST|DELETE> [param]');
+ } else {
+ cs_auth($user, { CHAN => shift @args }, shift @args, @args);
+ }
+ }
+ elsif($cmd =~ /^dice$/i) {
+ notice($user, botserv::get_dice($args[0]));
+ }
+ elsif($cmd =~ /^(q|n)?ban$/i) {
+ my $type = $1;
+ my $chan = shift @args;
+ if(@args >= 1) {
+ cs_ban($user, { CHAN => $chan }, $type, @args)
+ }
+ else {
+ notice($user, 'Syntax: BAN <channel> <nick|mask>');
+ }
+ }
+ elsif($cmd =~ /^banlist$/i) {
+ my $chan = shift @args;
+ if(@args == 0) {
+ cs_banlist($user, { CHAN => $chan });
+ }
+ else {
+ notice($user, 'Syntax: BANLIST <channel>');
+ }
+ }
+ elsif($cmd =~ /^assign$/i) {
+ my $chan = shift @args;
+ notice($user, "$csnick ASSIGN is deprecated. Please use $botserv::bsnick ASSIGN");
+ if(@args == 2) {
+ botserv::bs_assign($user, { CHAN => shift @args }, shift @args);
+ }
+ else {
+ notice($user, 'Syntax: ASSIGN <#channel> <bot>');
+ }
+ }
+ elsif($cmd =~ /^mode$/i) {
+ my $chan = shift @args;
+ if(@args >= 1) {
+ cs_mode($user, { CHAN => $chan }, @args)
+ }
+ else {
+ notice($user, 'Syntax: MODE <channel> <modes> [parms]');
+ }
+ }
+ elsif($cmd =~ /^copy$/i) {
+ my $chan = shift @args;
+ if(@args >= 1) {
+ cs_copy($user, { CHAN => $chan }, @args)
+ }
+ else {
+ notice($user, 'Syntax: COPY #chan1 [type] #chan2');
+ }
+ }
+ elsif($cmd =~ /^m(?:ode)?lock$/i) {
+ my $chan = shift @args;
+ if(@args >= 1) {
+ cs_mlock($user, { CHAN => $chan }, @args)
+ }
+ else {
+ notice($user, 'Syntax: MLOCK <channel> <ADD|DEL> <modes> [parms]');
+ }
+ }
+ elsif($cmd =~ /^resync$/i) {
+ if (@args == 0) {
+ notice($user, 'Syntax: RESYNC <chan1> [chan2 [chan3 [..]]]');
+ } else {
+ cs_resync($user, @args);
+ }
+ }
+ else {
+ notice($user, "Unrecognized command \002$cmd\002.", "For help, type: \002/msg chanserv help\002");
+ wlog($csnick, LOG_DEBUG(), "$src tried to use $csnick $msg");
+ }
+}
+=cut
+
+cs_command [qw(register)], \&cs_register;
+
+sub cs_register {
+ my ($user, $arglist) = @_;
+ my ($cn, $pass, $desc) = split(/\s+/, $arglist, 3);
+ # $pass is still passed in, but summarily ignored.
+ my $src = get_user_nick($user);
+ my $chan = { CHAN => $cn };
+
+ unless(is_identified($user, $src)) {
+ notice($user, 'You must register your nickname first.',
+ "Type \002/msg NickServ HELP\002 for information on registering nicknames.");
+ return;
+ }
+
+ unless(is_in_chan($user, $chan)) {
+ notice($user, "You are not in \002$cn\002.");
+ return;
+ }
+
+ unless(get_op($user, $chan) & ($opmodes{o} | $opmodes{a} | $opmodes{q})) {
+ # This would be preferred to be a 'opmode_mask' or something
+ # However that might be misleading due to hop not being enough to register
+ notice($user, "You must have channel operator status to register \002$cn\002.");
+ return;
+ }
+
+ my $root = get_root_nick($src);
+
+ if($desc) {
+ my $dlength = length($desc);
+ if($dlength >= 350) {
+ notice($user, 'Channel description is too long by '. $dlength-350 .' character(s). Maximum length is 350 characters.');
+ return;
+ }
+ }
+
+ if($register->execute($cn, $desc, $root)) {
+ notice($user, "\002Your channel is now registered. Thank you.\002");
+ notice($user, ' ', "\002NOTICE:\002 Channel passwords are not used, as a security precaution.")
+ if $pass;
+ set_acc($root, $user, $chan, FOUNDER);
+ $set_modelock->execute('+rnt', $cn);
+ do_modelock($chan);
+ services::ulog($csnick, LOG_INFO(), "registered $cn", $user, $chan);
+ botserv::bs_assign($user, $chan, services_conf_default_chanbot) if services_conf_default_chanbot;
+ } else {
+ notice($user, 'That channel has already been registered.');
+ }
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(uop vop hop aop sop cf cofounder cof cfounder)],
+ SYNTAX => '#chan add/del/list/wipe/clear [nick/mask]',
+ CALL => \&cs_xop_dispatch,
+ CMD_TOO => 1,
+};
+sub cs_xop_dispatch($$$@) {
+ my ($user, $cmd, $chan, $cmd2, @args) = @_;
+ $cmd = uc $cmd;
+
+ if($cmd2 =~ /^add$/i) {
+ if(@args == 1) {
+ cs_xop_add($user, $chan, $cmd, $args[0]);
+ } else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> ADD <nick>');
+ }
+ }
+ elsif($cmd2 =~ /^del(ete)?$/i) {
+ if(@args == 1) {
+ cs_xop_del($user, $chan, $cmd, $args[0]);
+ } else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> DEL <nick>');
+ }
+ }
+ elsif($cmd2 =~ /^list$/i) {
+ if(@args >= 0) {
+ cs_xop_list($user, $chan, $cmd, $args[0]);
+ } else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> LIST [mask]');
+ }
+ }
+ elsif($cmd2 =~ /^(wipe|clear)$/i) {
+ if(@args == 0) {
+ cs_xop_wipe($user, $chan, $cmd);
+ } else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> WIPE');
+ }
+ }
+ else {
+ notice($user, 'Syntax: '.uc $cmd.' <#channel> <ADD|DEL|LIST|WIPE>');
+ }
+}
+
+sub cs_xop_ad_pre($$$$$) {
+ my ($user, $chan, $nick, $level, $del) = @_;
+
+ my $old = get_acc($nick, $chan); $old = 0 unless $old;
+ my $slevel = get_best_acc($user, $chan);
+
+ unless(($del and is_identified($user, $nick)) or adminserv::can_do($user, 'SERVOP')) {
+ unless($level < $slevel and $old < $slevel) {
+ notice($user, $err_deny);
+ return undef;
+ }
+ my $cn = $chan->{CHAN};
+ my $overrideMsg = "$levels[$level] $cn ".($del ? 'DEL' : 'ADD')." $nick";
+ can_do($chan, 'ACCCHANGE', $user, { OVERRIDE_MSG => $overrideMsg }) or return undef;
+ }
+
+ nickserv::chk_registered($user, $nick) or return undef;
+ if (nr_chk_flag($nick, NRF_NOACC()) and !adminserv::can_do($user, 'SERVOP') and !$del) {
+ notice($user, "\002$nick\002 is not able to be added to access lists.");
+ return undef;
+ }
+
+ return $old;
+}
+
+sub cs_xop_list($$$;$) {
+ my ($user, $chan, $cmd, $mask) = @_;
+ chk_registered($user, $chan) or return;
+ my $cn = $chan->{CHAN};
+ my $level = xop_byname($cmd);
+
+ my $overrideMsg = "$cmd $cn LIST";
+ can_do($chan, 'ACCLIST', $user, { OVERRIDE_MSG => $overrideMsg }) or return;
+
+ my @reply;
+ if($mask) {
+ my ($mnick, $mident, $mhost) = glob2sql(parse_mask($mask));
+ $mnick = '%' if($mnick eq '');
+ $mident = '%' if($mident eq '');
+ $mhost = '%' if($mhost eq '');
+
+ $get_acc_list_mask->execute($mnick, $cn, $level, $mnick, $mident, $mhost);
+ while(my ($n, $a, $t, $lu, $id, $vh) = $get_acc_list_mask->fetchrow_array) {
+ push @reply, "*) $n ($id\@$vh)" . ($a ? ' Added by: '.$a : '');
+ push @reply, ' '.($t ? 'Date/time added: '. gmtime2($t).' ' : '').
+ ($lu ? 'Last used '.time_ago($lu).' ago' : '') if ($t or $lu);
+ }
+ $get_acc_list_mask->finish();
+ } else {
+ $get_acc_list->execute($cn, $level);
+ while(my ($n, $a, $t, $lu, $id, $vh) = $get_acc_list->fetchrow_array) {
+ push @reply, "*) $n ($id\@$vh)" . ($a ? ' Added by: '.$a : '');
+ push @reply, ' '.($t ? 'Date/time added: '. gmtime2($t).' ' : '').
+ ($lu ? 'Last used '.time_ago($lu).' ago' : '') if ($t or $lu);
+ }
+ $get_acc_list->finish();
+ }
+
+ notice($user, "$levels[$level] list for \002$cn\002:", @reply);
+
+ return;
+}
+
+sub cs_xop_wipe($$$) {
+ my ($user, $chan, $cmd, $nick) = @_;
+ chk_registered($user, $chan) or return;
+
+ my $slevel = get_best_acc($user, $chan);
+ my $level = xop_byname($cmd);
+
+ unless($level < $slevel) {
+ notice($user, $err_deny);
+ return;
+ }
+ my $cn = $chan->{CHAN};
+ my $overrideMsg = "$cmd $cn WIPE";
+ my $srcnick = can_do($chan, 'ACCCHANGE', $user, { ACC => $slevel, OVERRIDE_MSG => $overrideMsg }) or return;
+
+ $wipe_acc_list->execute($cn, $level);
+
+ my $log_str = "wiped the $cmd list of \002$cn\002.";
+ my $src = get_user_nick($user);
+ notice($user, "You have $log_str");
+ ircd::notice(agent($chan), '%'.$cn, "\002$src\002 has $log_str")
+ if cr_chk_flag($chan, CRF_VERBOSE);
+ services::ulog($csnick, LOG_INFO(), $log_str, $user, $chan);
+
+ memolog($chan, "\002$srcnick\002 $log_str");
+}
+
+sub cs_xop_add($$$$) {
+ my ($user, $chan, $cmd, $nick) = @_;
+
+ chk_registered($user, $chan) or return;
+ my $level = xop_byname($cmd);
+ my $old = cs_xop_ad_pre($user, $chan, $nick, $level, 0);
+ return unless defined($old);
+
+ my $cn = $chan->{CHAN};
+
+ if($old == $level) {
+ notice($user, "\002$nick\002 already has $levels[$level] access to \002$cn\002.");
+ return;
+ }
+
+ if($old == FOUNDER) {
+ notice($user, "\002$nick\002 is the founder of \002$cn\002 and cannot be added to access lists.",
+ "For more information, type: \002/msg chanserv help set founder\002");
+ return;
+ }
+
+ my $root = get_root_nick($nick);
+ my $auth = nr_chk_flag($root, NRF_AUTH());
+ my $src = get_user_nick($user);
+
+ if($auth) {
+ $add_auth->execute($cn, "$src:".($old ? $old : 0 ).":$level:".time(), $root);
+ del_acc($root, $chan) if $level < $old;
+ }
+ else {
+ set_acc($root, $user, $chan, $level);
+ }
+
+ if($old < 0) {
+ $del_nick_akick->execute($cn, $root);
+ my $log_str = "moved $root from the AKICK list to the ${levels[$level]} list of \002$cn\002".
+ ($auth ? ' (requires authorization)' : '');
+
+ my $src = get_user_nick($user);
+ notice_all_nicks($user, $root, "\002$src\002 $log_str");
+ ircd::notice(agent($chan), '%'.$cn, "\002$src\002 $log_str")
+ if cr_chk_flag($chan, CRF_VERBOSE);
+ services::ulog($csnick, LOG_INFO(), $log_str, $user, $chan);
+ my $srcnick = can_do($chan, 'ACCLIST', $user);
+ memolog($chan, "\002$srcnick\002 $log_str");
+ } else {
+ my $log_str = ($old?'moved':'added')." \002$root\002"
+ . ($old ? " from the ${levels[$old]}" : '') .
+ " to the ${levels[$level]} list of \002$cn\002" .
+ ($auth ? ' (requires authorization)' : '');
+ my $src = get_user_nick($user);
+ notice_all_nicks($user, $root, "\002$src\002 $log_str");
+ ircd::notice(agent($chan), '%'.$cn, "\002$src\002 $log_str")
+ if cr_chk_flag($chan, CRF_VERBOSE);
+ services::ulog($csnick, LOG_INFO(), $log_str, $user, $chan);
+ my $srcnick = can_do($chan, 'ACCLIST', $user);
+ memolog($chan, "\002$srcnick\002 $log_str");
+ }
+}
+
+sub cs_xop_del($$$) {
+ my ($user, $chan, $cmd, $nick) = @_;
+
+ chk_registered($user, $chan) or return;
+ my $level = xop_byname($cmd);
+ my $old = cs_xop_ad_pre($user, $chan, $nick, $level, 1);
+ return unless defined($old);
+
+ my $cn = $chan->{CHAN};
+
+ unless($old == $level) {
+ notice($user, "\002$nick\002 is not on the ${levels[$level]} list of \002$cn\002.");
+ return;
+ }
+
+ my $root = get_root_nick($nick);
+
+ del_acc($root, $chan);
+
+ my $src = get_user_nick($user);
+ my $log_str = "removed \002$root\002 ($nick) from the ${levels[$level]} list of \002$cn\002";
+ notice_all_nicks($user, $root, "\002$src\002 $log_str");
+ ircd::notice(agent($chan), '%'.$cn, "\002$src\002 $log_str")
+ if cr_chk_flag($chan, CRF_VERBOSE);
+ services::ulog($csnick, LOG_INFO(), $log_str, $user, $chan);
+ my $srcnick = can_do($chan, 'ACCLIST', $user);
+ memolog($chan, "\002$srcnick\002 $log_str");
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(count)],
+ SYNTAX => '#chan ',
+ CALL => \&cs_count,
+};
+sub cs_count($$) {
+ my ($user, $chan) = @_;
+
+ chk_registered($user, $chan) or return;
+
+ my $cn = $chan->{CHAN};
+ my $overrideMsg = "COUNT $cn";
+ can_do($chan, 'ACCLIST', $user, { OVERRIDE_MSG => $overrideMsg }) or return;
+
+
+ my $reply = '';
+ for (my $level = $plzero + 1; $level < COFOUNDER + 2; $level++) {
+ $get_acc_count->execute($cn, $level - 1);
+ my ($num_recs) = $get_acc_count->fetchrow_array;
+ $reply = $reply." $plevels[$level]: ".$num_recs;
+ }
+ notice($user, "\002$cn Count:\002 ".$reply);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(levels)],
+ SYNTAX => '#chan set/reset/list/clear',
+ CALL => \&cs_levels_dispatch,
+};
+
+sub cs_levels_dispatch($$$@) {
+ my ($user, $chan, $cmd2, @args) = @_;
+ if(!defined($cmd2)) {
+ notice($user, 'Syntax: LEVELS <#channel> <SET|RESET|LIST|CLEAR>');
+ return;
+ }
+
+ if($cmd2 eq 'set') {
+ if(@args == 2) {
+ cs_levels_set($user, $chan, $args[0], $args[1]);
+ } else {
+ notice($user, 'Syntax: LEVELS <#channel> SET <permission> <level>');
+ }
+ }
+ elsif($cmd2 eq 'reset') {
+ if(@args == 1) {
+ cs_levels_set($user, $chan, $args[0]);
+ } else {
+ notice($user, 'Syntax: LEVELS <#channel> RESET <permission>');
+ }
+ }
+ elsif($cmd2 eq 'list') {
+ if(@args == 0) {
+ cs_levels_list($user, $chan);
+ } else {
+ notice($user, 'Syntax: LEVELS <#channel> LIST');
+ }
+ }
+ elsif($cmd2 eq 'clear') {
+ if(@args == 0) {
+ cs_levels_clear($user, $chan);
+ } else {
+ notice($user, 'Syntax: LEVELS <#channel> CLEAR');
+ }
+ }
+ else {
+ notice($user, 'Syntax: LEVELS <#channel> <SET|RESET|LIST|CLEAR>');
+ }
+}
+
+sub cs_levels_pre($$$;$) {
+ my($user, $chan, $cmd, $listonly) = @_;
+
+ chk_registered($user, $chan) or return 0;
+ my $cn = $chan->{CHAN};
+ my $overrideMsg = "LEVELS $cn $cmd";
+ return can_do($chan, ($listonly ? 'LEVELSLIST' : 'LEVELS'), $user, { OVERRIDE_MSG => $overrideMsg });
+}
+
+sub cs_levels_set($$$;$) {
+ my ($user, $chan, $perm, $level) = @_;
+
+ cs_levels_pre($user, $chan, "$perm $level") or return;
+ my $cn = $chan->{CHAN};
+
+ unless(is_level($perm)) {
+ notice($user, "$perm is not a valid permission.");
+ return;
+ }
+
+ if(defined($level)) {
+ $level = xop_byname($level);
+ unless(defined($level) and $level >= 0) {
+ notice($user, 'You must specify one of the following levels: '.
+ 'any, uop, vop, hop, aop, sop, cofounder, founder, nobody');
+ return;
+ }
+
+ $get_level_max->execute($perm);
+ my ($max) = $get_level_max->fetchrow_array;
+ $get_level_max->finish();
+
+ if($max and $level > $max) {
+ notice($user, "\002$perm\002 cannot be set to " . $plevels[$level+$plzero] . '.');
+ return;
+ }
+
+ $add_level->execute($cn, $perm);
+ $set_level->execute($level, $cn, $perm);
+
+ if($level == 8) {
+ notice($user, "\002$perm\002 is now disabled in \002$cn\002.");
+ } else {
+ notice($user, "\002$perm\002 now requires " . $levels[$level] . " access in \002$cn\002.");
+ }
+ } else {
+ $reset_level->execute($perm, $cn);
+
+ notice($user, "\002$perm\002 has been reset to default.");
+ }
+}
+
+sub cs_levels_list($$) {
+ my ($user, $chan) = @_;
+
+ cs_levels_pre($user, $chan, 'LIST', 1) or return;
+ my $cn = $chan->{CHAN};
+
+ $get_levels->execute($cn);
+ my @data;
+ while(my ($name, $def, $lvl) = $get_levels->fetchrow_array) {
+ push @data, [$name,
+ (defined($lvl) ? $plevels[$lvl+$plzero] : $plevels[$def+$plzero]),
+ (defined($lvl) ? '' : '(default)')];
+ }
+
+ notice($user, columnar { TITLE => "Permission levels for \002$cn\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT) }, @data);
+}
+
+sub cs_levels_clear($$) {
+ my ($user, $chan) = @_;
+
+ cs_levels_pre($user, $chan, 'CLEAR') or return;
+ my $cn = $chan->{CHAN};
+
+ $clear_levels->execute($cn);
+
+ notice($user, "All permissions have been reset to default.");
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(akick)],
+ SYNTAX => '#chan add/del/list/clear',
+ CALL => \&cs_akick_dispatch,
+};
+
+sub cs_akick_dispatch {
+ my ($user, $chan, $cmd2, @args) = @_;
+ if(!$cmd2) {
+ notice($user, 'Syntax: AKICK <#channel> <ADD|DEL|LIST|WIPE|CLEAR>');
+ return;
+ }
+
+ if($cmd2 eq 'add') {
+ if(@args >= 2) {
+ cs_akick_add($user, $chan, shift @args, join(' ', @args));
+ } else {
+ notice($user, 'Syntax: AKICK <#channel> ADD <nick|mask> <reason>');
+ }
+ }
+ elsif($cmd2 eq 'del') {
+ if(@args == 1) {
+ cs_akick_del($user, $chan, $args[0]);
+ } else {
+ notice($user, 'Syntax: AKICK <#channel> DEL <nick|mask|num|seq>');
+ }
+ }
+ elsif($cmd2 eq 'list') {
+ if(@args == 0) {
+ cs_akick_list($user, $chan);
+ } else {
+ notice($user, 'Syntax: AKICK <#channel> LIST');
+ }
+ }
+ elsif($cmd2 =~ /^(wipe|clear)$/i) {
+ if(@args == 0) {
+ cs_akick_wipe($user, $chan);
+ } else {
+ notice($user, 'Syntax: AKICK <#channel> WIPE');
+ }
+ }
+ elsif($cmd2 =~ /^enforce$/i) {
+ if(@args == 0) {
+ cs_akick_enforce($user, $chan);
+ } else {
+ notice($user, 'Syntax: AKICK <#channel> ENFORCE');
+ }
+ }
+ else {
+ notice($user, 'Syntax: AKICK <#channel> <ADD|DEL|LIST|WIPE|CLEAR>');
+ }
+}
+sub cs_akick_pre($$$;$) {
+ my ($user, $chan, $overrideMsg, $list) = @_;
+
+ chk_registered($user, $chan) or return 0;
+
+ return can_do($chan, ($list ? 'AKICKLIST' : 'AKICK'), $user, { OVERRIDE_MSG => $overrideMsg });
+}
+
+sub cs_akick_add($$$$) {
+ my ($user, $chan, $mask, $reason) = @_;
+ my $cn = $chan->{CHAN};
+
+ my $adder = cs_akick_pre($user, $chan, "ADD $mask $reason") or return;
+
+ my ($nick, $ident, $host) = parse_mask($mask);
+
+ if(($ident eq '' or $host eq '') and not ($ident eq '' and $host eq '')) {
+ notice($user, 'Invalid hostmask.');
+ return;
+ }
+
+ if($ident eq '') {
+ $nick = $mask;
+
+ unless(valid_nick($nick)) {
+ $mask = normalize_hostmask($mask);
+ ($nick, $ident, $host) = parse_mask($mask);
+ }
+ }
+
+ if ($ident eq '' and $host eq '' and !nickserv::is_registered($nick)) {
+ notice($user, "\002$nick\002 is not registered");
+ return;
+ }
+
+ my $rlength = length($reason);
+ if($rlength >= 350) {
+ notice($user, 'AKick reason is too long by '. $rlength-350 .' character(s). Maximum length is 350 characters.');
+ return;
+ }
+
+ my $log_str;
+ my $src = get_user_nick($user);
+ if($ident eq '' and $host eq '' and my $old = get_acc($nick, $chan)) {
+ if ($old == -1) {
+ notice($user, "\002$nick\002 is already on the AKick list in \002$cn\002");
+ return;
+ }
+ if($old < get_best_acc($user, $chan) or adminserv::can_do($user, 'SERVOP')) {
+ if ($old == FOUNDER()) {
+ # This is a fallthrough for the override case.
+ # It shouldn't happen otherwise.
+ # I didn't make it part of the previous conditional
+ # b/c just $err_deny is a bit undescriptive in the override case.
+ notice($user, "You can't akick the founder!", $err_deny);
+ return;
+ }
+
+ my $root = get_root_nick($nick);
+ $add_nick_akick->execute($cn, $src, $reason, $nick); $add_nick_akick->finish();
+ set_acc($nick, $user, $chan, -1);
+ $log_str = "moved \002$nick\002 (root: \002$root\002) from the $levels[$old] list".
+ " to the AKick list of \002$cn\002";
+ notice_all_nicks($user, $root, "\002$src\002 $log_str");
+ } else {
+ notice($user, $err_deny);
+ return;
+ }
+ } else {
+ if($ident eq '' and $host eq '') {
+ $add_nick_akick->execute($cn, $src, $reason, $nick); $add_nick_akick->finish();
+ if (find_auth($cn, $nick)) {
+ # Don't allow a pending AUTH entry to potentially override an AKick entry
+ # Believe it or not, it almost happened with #animechat on SCnet.
+ # This would also end up leaving an orphan entry in the akick table.
+ $nickserv::del_auth->execute($nick, $cn);
+ $nickserv::del_auth->finish();
+ }
+ set_acc($nick, $user, $chan, -1);
+ my $root = get_root_nick($nick);
+ $log_str = "added \002$nick\002 (root: \002$root\002) to the AKick list of \002$cn\002.";
+ } else {
+ ($nick, $ident, $host) = glob2sql($nick, $ident, $host);
+ unless($add_akick->execute($cn, $nick, $ident, $host, $adder, $reason)) {
+ notice($user, "\002$mask\002 is already on the AKick list of \002$cn\002.");
+ return;
+ }
+ $log_str = "added \002$mask\002 to the AKick list of \002$cn\002.";
+ }
+
+ }
+ notice($user, "You have $log_str");
+ ircd::notice(agent($chan), '%'.$cn, "\002$src\002 $log_str")
+ if cr_chk_flag($chan, CRF_VERBOSE);
+ services::ulog($csnick, LOG_INFO(), $log_str, $user, $chan);
+ memolog($chan, "\002$adder\002 $log_str");
+
+ akick_allchan($chan);
+}
+
+sub get_akick_by_num($$) {
+ my ($chan, $num) = @_;
+ my $cn = $chan->{CHAN};
+
+ $get_akick_by_num->execute($cn, $num);
+ my ($nick, $ident, $host) = $get_akick_by_num->fetchrow_array();
+ ($nick, $ident, $host) = sql2glob($nick, $ident, $host);
+ $get_akick_by_num->finish();
+ if(!$nick) {
+ return undef;
+ } elsif($ident eq '' and $host eq '') {
+ # nick based akicks don't use nicks but nickreg.id
+ # so we have to get the nickreg.nick back
+ $nick = nickserv::get_id_nick($nick);
+ }
+ return ($nick, $ident, $host);
+}
+
+sub cs_akick_del($$$) {
+ my ($user, $chan, $mask) = @_;
+ my $cn = $chan->{CHAN};
+
+ my $adder = cs_akick_pre($user, $chan, "DEL $mask") or return;
+
+ my @masks;
+ if ($mask =~ /^[0-9\.,-]+$/) {
+ foreach my $num (makeSeqList($mask)) {
+ my ($nick, $ident, $host) = get_akick_by_num($chan, $num - 1) or next;
+ if($ident eq '' and $host eq '') {
+ push @masks, $nick;
+ } else {
+ push @masks, "$nick!$ident\@$host";
+ }
+ }
+ } else {
+ @masks = ($mask);
+ }
+ foreach my $mask (@masks) {
+ my ($nick, $ident, $host) = parse_mask($mask);
+
+ if(($ident eq '' or $host eq '') and not ($ident eq '' and $host eq '')) {
+ notice($user, 'Invalid hostmask.');
+ return;
+ }
+
+ if($ident eq '') {
+ $nick = $mask;
+
+ unless(valid_nick($nick)) {
+ $mask = normalize_hostmask($mask);
+ ($nick, $ident, $host) = parse_mask($mask);
+ }
+ }
+
+ if ($ident eq '' and $host eq '' and !nickserv::is_registered($nick)) {
+ notice($user, "\002$nick\002 is not registered");
+ return;
+ }
+
+ my ($success, $log_str) = do_akick_del($chan, $mask, $nick, $ident, $host);
+ my $src = get_user_nick($user);
+ if($success) {
+ notice($user, "\002$src\002 $log_str");
+ services::ulog($csnick, LOG_INFO(), $log_str, $user, $chan);
+ ircd::notice(agent($chan), '%'.$cn, "\002$src\002 $log_str") if cr_chk_flag($chan, CRF_VERBOSE);
+ memolog($chan, "\002$adder\002 $log_str");
+ } else {
+ notice($user, $log_str);
+ }
+ }
+}
+
+sub do_akick_del($$$$$) {
+ my ($chan, $mask, $nick, $ident, $host) = @_;
+ my $cn = $chan->{CHAN};
+
+ my $log_str;
+ if($ident eq '' and $host eq '') {
+ if(get_acc($nick, $chan) == -1) {
+ del_acc($nick, $chan);
+ $del_nick_akick->execute($cn, $nick); $del_nick_akick->finish();
+ my $root = get_root_nick($nick);
+ return (1, "deleted \002$nick\002 (root: \002$root\002) from the AKick list of \002$cn\002.")
+ } else {
+ return (undef, "\002$mask\002 was not on the AKick list of \002$cn\002.");
+ }
+ } else {
+ ($nick, $ident, $host) = glob2sql($nick, $ident, $host);
+ if($del_akick->execute($cn, $nick, $ident, $host) != 0) {
+ return (1, "deleted \002$mask\002 from the AKick list of \002$cn\002.");
+ } else {
+ return (undef, "\002$mask\002 was not on the AKick list of \002$cn\002.");
+ }
+ }
+}
+
+sub cs_akick_list($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ cs_akick_pre($user, $chan, 'LIST', 1) or return;
+
+ my @data;
+
+ $get_akick_list->execute($cn);
+ my $i = 0;
+ while(my ($nick, $ident, $host, $adder, $reason, $time) = $get_akick_list->fetchrow_array) {
+ if($ident ne '') {
+ ($nick, $ident, $host) = sql2glob($nick, $ident, $host);
+ }
+
+ if($ident eq '' and $host eq '') {
+ $nick = nickserv::get_id_nick($nick);
+ } else {
+ $nick = "$nick!$ident\@$host";
+ }
+
+ push @data, ["\002".++$i."\002", $nick, $adder, ($time ? gmtime2($time) : ''), $reason];
+ }
+
+ notice($user, columnar {TITLE => "AKICK list of \002$cn\002:", DOUBLE=>1,
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data);
+}
+
+sub cs_akick_wipe($$$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ my $adder = cs_akick_pre($user, $chan, 'WIPE') or return;
+
+ $drop_akick->execute($cn);
+ $wipe_acc_list->execute($cn, -1);
+ my $log_str = "wiped the AKICK list of \002$cn\002.";
+ my $src = get_user_nick($user);
+ notice($user, "You have $log_str");
+ ircd::notice(agent($chan), '%'.$cn, "\002$src\002 $log_str") if cr_chk_flag($chan, CRF_VERBOSE);
+ services::ulog($csnick, LOG_INFO(), $log_str, $user, $chan);
+ memolog($chan, "\002$adder\002 $log_str");
+}
+
+sub cs_akick_enforce($$$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ chk_registered($user, $chan) or return;
+
+ can_do($chan, 'AKickEnforce', $user, { OVERRIDE_MSG => "AKICK $cn ENFORCE" }) or return;
+
+ akick_allchan($chan);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(info)],
+ SYNTAX => 'LIST:#chan',
+ CALL => \&cs_info,
+ NO_WRAPPER => 1,
+};
+sub cs_info($@) {
+ my ($user, @chanList) = @_;
+
+ my @reply;
+ foreach my $cn (@chanList) {
+ if($cn =~ /,/) {
+ push @chanList, split(',', $cn);
+ next;
+ }
+ my $chan = { CHAN => $cn };
+ unless(__can_do($chan, 'INFO', undef, 0)) {
+ can_do($chan, 'INFO', $user, { OVERRIDE_MSG => "INFO $cn" })
+ or next;
+ }
+
+ $get_info->execute($cn);
+ my @result = $get_info->fetchrow_array;
+ unless(@result) {
+ push @reply, "The channel \002$cn\002 is not registered.";
+ next;
+ }
+
+ my ($descrip, $regd, $last, $topic, $topicer, $modelock, $founder, $successor, $bot, $bantype) = @result;
+
+ $modelock = modes::sanitize($modelock) unless can_do($chan, 'GETKEY', $user, { NOREPLY => 1 });
+
+ my @opts;
+
+ my $topiclock = get_level($chan, 'SETTOPIC');
+ push @opts, "Topic Lock ($levels[$topiclock])" if $topiclock;
+
+ if(cr_chk_flag($chan, (CRF_CLOSE | CRF_DRONE))) {
+ push @reply, "\002$cn\002 is closed and cannot be used: ". get_close($chan);
+ next;
+ }
+
+ my @extra;
+ push @extra, 'Will not expire' if cr_chk_flag($chan, CRF_HOLD);
+ push @extra, 'Channel is frozen and access suspended' if cr_chk_flag($chan, CRF_FREEZE);
+
+ push @opts, 'OpGuard' if cr_chk_flag($chan, CRF_OPGUARD);
+ push @opts, 'BotStay' if cr_chk_flag($chan, CRF_BOTSTAY);
+ push @opts, 'SplitOps' if cr_chk_flag($chan, CRF_SPLITOPS);
+ push @opts, 'Verbose' if cr_chk_flag($chan, CRF_VERBOSE);
+ push @opts, 'NeverOp' if cr_chk_flag($chan, CRF_NEVEROP);
+ push @opts, 'Ban type '.$bantype if $bantype;
+ my $opts = join(', ', @opts);
+
+ my @data;
+
+ push @data, ['Founder:', $founder];
+ push @data, ['Successor:', $successor] if $successor;
+ push @data, ['Description:', $descrip] if $descrip;
+ push @data, ['Mode lock:', $modelock];
+ push @data, ['Settings:', $opts] if $opts;
+ push @data, ['ChanBot:', $bot] if $bot and $bot ne '';
+ #FIXME: memo level
+ push @data, ['Registered:', gmtime2($regd)],
+ ['Last opping:', gmtime2($last)],
+ ['Time now:', gmtime2(time)];
+
+ push @reply, columnar {TITLE => "ChanServ info for \002$cn\002:", NOHIGHLIGHT => 1}, @data,
+ {COLLAPSE => \@extra, BULLET => 1};
+ }
+ notice($user, @reply);
+}
+
+sub cs_set_pre($$$$) {
+ my ($user, $chan, $set, $parm) = @_;
+ my $cn = $chan->{CHAN};
+ my $override = 0;
+
+ my %valid_set = (
+ 'founder' => 1, 'successor' => 1, 'unsuccessor' => 1,
+ #'mlock' => 1, 'modelock' => 1,
+ 'desc' => 1,
+ 'topiclock' => 1, 'greet' => 1, 'opguard' => 1,
+ 'freeze' => 1, 'botstay' => 1, 'verbose' => 1,
+ 'splitops' => 1, 'bantype' => 1, 'dice' => 1,
+ 'welcomeinchan' => 1, 'log' => 1,
+
+ 'hold' => 1, 'noexpire' => 1, 'no-expire' => 1,
+
+ 'autovoice' => 1, 'avoice' => 1,
+ 'neverop' => 1, 'noop' => 1,
+ );
+ my %override_set = (
+ 'hold' => 'SERVOP', 'noexpire' => 'SERVOP', 'no-expire' => 'SERVOP',
+ 'freeze' => 'FREEZE', 'botstay' => 'BOT',
+ );
+
+ chk_registered($user, $chan) or return 0;
+ if($set =~ /m(?:ode)?lock/) {
+ notice($user, "CS SET MLOCK is deprecated and replaced with CS MLOCK",
+ "For more information, please /CS HELP MLOCK");
+ return 0;
+ }
+ unless($valid_set{lc $set}) {
+ notice($user, "$set is not a valid ChanServ setting.");
+ return 0;
+ }
+
+ if($override_set{lc($set)}) {
+ if(adminserv::can_do($user, $override_set{lc($set)}) ) {
+ if(services_conf_log_overrides) {
+ my $src = get_user_nick($user);
+ wlog($csnick, LOG_INFO(), "\002$src\002 used override CS SET $cn $set $parm");
+ }
+ $override = 1;
+ } else {
+ notice($user, $err_deny);
+ return 0;
+ }
+ }
+ else {
+ can_do($chan, 'SET', $user) or return 0;
+ }
+
+ return 1;
+}
+
+cs_command ['set'], \&cs_set;
+sub cs_set($$) {
+ my ($user, $arglist) = @_;
+ my ($cn, $set, $parm) = split(/\s+/, $arglist, 3);
+ my $chan = { CHAN => $cn };
+ $set = lc $set;
+
+ cs_set_pre($user, $chan, $set, $parm) or return;
+
+ if($set =~ /^founder$/i) {
+ my $override;
+ unless(get_best_acc($user, $chan) == FOUNDER) {
+ if(adminserv::can_do($user, 'SERVOP')) {
+ $override = 1;
+ } else {
+ notice($user, $err_deny);
+ return;
+ }
+ }
+
+ my $root;
+ unless($root = get_root_nick($parm)) {
+ notice($user, "The nick \002$parm\002 is not registered.");
+ return;
+ }
+
+ $get_founder->execute($cn);
+ my ($prev) = $get_founder->fetchrow_array;
+ $get_founder->finish();
+
+ if(lc($root) eq lc($prev)) {
+ notice($user, "\002$parm\002 is already the founder of \002$cn\002.");
+ return;
+ }
+
+ set_acc($prev, $user, $chan, COFOUNDER);
+
+ $set_founder->execute($root, $cn); $set_founder->finish();
+ set_acc($root, $user, $chan, FOUNDER);
+
+ notice($user, ($override ? "The previous founder, \002$prev\002, has" : "You have") . " been moved to the co-founder list of \002$cn\002.");
+ notice_all_nicks($user, $root, "\002$root\002 has been set as the founder of \002$cn\002.");
+ services::ulog($csnick, LOG_INFO(), "set founder of \002$cn\002 to \002$root\002", $user, $chan);
+
+ $get_successor->execute($cn);
+ my $suc = $get_successor->fetchrow_array; $get_successor->finish();
+ if(lc($suc) eq lc($root)) {
+ $del_successor->execute($cn); $del_successor->finish();
+ notice($user, "Successor has been removed from \002$cn\002.");
+ }
+
+ return;
+ }
+
+ if($set eq 'successor') {
+ unless(get_best_acc($user, $chan) == FOUNDER or adminserv::can_do($user, 'SERVOP')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if(get_acc($parm, $chan) == 7) {
+ notice($user, "The channel founder may not be the successor.");
+ return;
+ }
+
+ my $root;
+ unless($root = get_root_nick($parm)) {
+ notice($user, "The nick \002$parm\002 is not registered.");
+ return;
+ }
+
+ $set_successor->execute($root, $cn); $set_successor->finish();
+
+ notice($user, "\002$parm\002 is now the successor of \002$cn\002");
+ services::ulog($csnick, LOG_INFO(), "set successor of \002$cn\002 to \002$root\002", $user, $chan);
+ return;
+ }
+
+ if($set eq 'unsuccessor') {
+ unless(get_best_acc($user, $chan) == FOUNDER or adminserv::can_do($user, 'SERVOP')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ $del_successor->execute($cn); $del_successor->finish();
+
+ notice($user, "Successor has been removed from \002$cn\002.");
+ services::ulog($csnick, LOG_INFO(), "removed successor from \002$cn\002", $user, $chan);
+ return;
+ }
+
+ if($set =~ /m(?:ode)?lock/) {
+ my $modes = modes::merge($parm, '+r', 1);
+ $modes = sanitize_mlockable($modes);
+ $set_modelock->execute($modes, $cn);
+
+ notice($user, "Mode lock for \002$cn\002 has been set to: \002$modes\002");
+ do_modelock($chan);
+ return;
+ }
+
+ if($set eq 'desc') {
+ $set_descrip->execute($parm, $cn);
+
+ notice($user, "Description of \002$cn\002 has been changed.");
+ return;
+ }
+
+ if($set eq 'topiclock') {
+ my $perm = xop_byname($parm);
+ if($parm =~ /^(?:no|off|false|0)$/i) {
+ cs_levels_set($user, $chan, 'SETTOPIC');
+ cs_levels_set($user, $chan, 'TOPIC');
+ } elsif($perm >= 0 and defined($perm)) {
+ cs_levels_set($user, $chan, 'SETTOPIC', $parm);
+ cs_levels_set($user, $chan, 'TOPIC', $parm);
+ } else {
+ notice($user, 'Syntax: SET <#chan> TOPICLOCK <off|any|uop|vop|hop|aop|sop|cf|founder>');
+ }
+ return;
+ }
+
+ if($set =~ /^bantype$/i) {
+ unless (misc::isint($parm) and ($parm >= 0 and $parm <= 10)) {
+ notice($user, 'Invalid bantype');
+ return;
+ }
+
+ $set_bantype->execute($parm, $cn);
+
+ notice($user, "Ban-Type for \002$cn\002 now set to \002$parm\002.");
+
+ return;
+ }
+
+ my $val;
+ if($parm =~ /^(?:no|off|false|0)$/i) { $val = 0; }
+ elsif($parm =~ /^(?:yes|on|true|1)$/i) { $val = 1; }
+ else {
+ notice($user, "Please say \002on\002 or \002off\002.");
+ return;
+ }
+
+ if($set =~ /^(?:opguard|secureops)$/i) {
+ cr_set_flag($chan, CRF_OPGUARD, $val);
+
+ if($val) {
+ notice($user,
+ "OpGuard is now \002ON\002.",
+ "Channel status may not be granted by unauthorized users in \002$cn\002."#,
+ #"Note that you must change the $csnick LEVELS settings for VOICE, HALFOP, OP, and/or ADMIN for this setting to have any effect."
+ );
+ } else {
+ notice($user,
+ "OpGuard is now \002OFF\002.",
+ "Channel status may be given freely in \002$cn\002."
+ );
+ }
+
+ return;
+ }
+
+ if($set =~ /^(?:splitops)$/i) {
+ cr_set_flag($chan, CRF_SPLITOPS, $val);
+
+ if($val) {
+ notice($user, "SplitOps is now \002ON\002.");
+ } else {
+ notice($user, "SplitOps is now \002OFF\002.");
+ }
+
+ return;
+ }
+
+ if($set =~ /^(hold|no-?expire)$/i) {
+ cr_set_flag($chan, CRF_HOLD, $val);
+
+ if($val) {
+ notice($user, "\002$cn\002 will not expire");
+ services::ulog($csnick, LOG_INFO(), "has held \002$cn\002", $user, $chan);
+ } else {
+ notice($user, "\002$cn\002 is no longer held from expiration");
+ services::ulog($csnick, LOG_INFO(), "has removed \002$cn\002 from hold", $user, $chan);
+ }
+
+ return;
+ }
+
+ if($set =~ /^freeze$/i) {
+ cr_set_flag($chan, CRF_FREEZE, $val);
+
+ if($val) {
+ notice($user, "\002$cn\002 is now frozen and access suspended");
+ services::ulog($csnick, LOG_INFO(), "has frozen \002$cn\002", $user, $chan);
+ } else {
+ notice($user, "\002$cn\002 is now unfrozen and access restored");
+ services::ulog($csnick, LOG_INFO(), "has unfrozen \002$cn\002", $user, $chan);
+ }
+
+ return;
+ }
+
+ if($set =~ /^botstay$/i) {
+ cr_set_flag($chan, CRF_BOTSTAY, $val);
+
+ if($val) {
+ notice($user, "Bot will now always stay in \002$cn");
+ botserv::bot_join($chan, undef);
+ } else {
+ notice($user, "Bot will now part if less than one user is in \002$cn");
+ botserv::bot_part_if_needed(undef, $chan, "Botstay turned off");
+ }
+
+ return;
+ }
+ if($set =~ /^verbose$/i) {
+ cr_set_flag($chan, CRF_VERBOSE, $val);
+
+ if($val) {
+ notice($user, "Verbose mode enabled on \002$cn");
+ }
+ else {
+ notice($user, "Verbose mode disabled on \002$cn");
+ }
+ return;
+ }
+
+ if($set =~ /^greet$/i) {
+ if($val) {
+ notice($user, "$csnick SET $cn GREET ON is deprecated.",
+ "Please use $csnick LEVELS $cn SET GREET <rank>");
+ } else {
+ cs_levels_set($user, $chan, 'GREET', 'nobody');
+ }
+
+ return;
+ }
+
+ if($set =~ /^dice$/i) {
+ if($val) {
+ notice($user, "$csnick SET $cn DICE ON is deprecated.",
+ "Please use $csnick LEVELS $cn SET DICE <rank>");
+ } else {
+ cs_levels_set($user, $chan, 'DICE', 'nobody');
+ }
+
+ return;
+ }
+
+ if($set =~ /^welcomeinchan$/i) {
+ cr_set_flag($chan, CRF_WELCOMEINCHAN(), $val);
+
+ if($val) {
+ notice($user, "WELCOME messages will be put in the channel.");
+ } else {
+ notice($user, "WELCOME messages will be sent privately.");
+ }
+
+ return;
+ }
+
+ if($set =~ /^log$/i) {
+ unless(module::is_loaded('logserv')) {
+ notice($user, "module logserv is not loaded, logging is not available.");
+ return;
+ }
+
+ if($val) {
+ logserv::addchan($user, $cn) and cr_set_flag($chan, CRF_LOG, $val);
+ }
+ else {
+ logserv::delchan($user, $cn) and cr_set_flag($chan, CRF_LOG, $val);
+ }
+ return;
+ }
+
+ if($set =~ /^a(?:uto)?voice$/i) {
+ cr_set_flag($chan, CRF_AUTOVOICE(), $val);
+
+ if($val) {
+ notice($user, "All users w/o access will be autovoiced on join.");
+ } else {
+ notice($user, "AUTOVOICE disabled.");
+ }
+
+ return;
+ }
+
+ if($set =~ /^(?:never|no)op$/i) {
+ cr_set_flag($chan, CRF_NEVEROP(), $val);
+
+ if($val) {
+ notice($user, "Users will not be automatically opped on join.");
+ } else {
+ notice($user, "Users with access will now be automatically opped on join.");
+ }
+
+ return;
+ }
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(why)],
+ SYNTAX => '#chan LIST:nick',
+ CALL => \&cs_why,
+};
+
+sub cs_why($$$) {
+ my ($user, $chan, $tnicks) = @_;
+
+ chk_registered($user, $chan) or return;
+
+ my ($candoNick, $override) = can_do($chan, 'ACCLIST', undef, $user, undef);
+ return unless $candoNick;
+
+ my $cn = $chan->{CHAN};
+ my @reply;
+ foreach my $tnick (@$tnicks) {
+ my $tuser = { NICK => $tnick };
+ unless(get_user_id($tuser)) {
+ notice($user, "\002$tnick\002: No such user.");
+ return;
+ }
+
+ my $has;
+ if(is_online($tnick)) {
+ $has = 'has';
+ } else {
+ $has = 'had';
+ }
+
+ my $n;
+ $get_all_acc->execute(get_user_id($tuser), $cn);
+ while(my ($rnick, $acc) = $get_all_acc->fetchrow_array) {
+ $n++;
+ push @reply, "\002$tnick\002 $has $plevels[$acc+$plzero] access to \002$cn\002 due to identification to the nick \002$rnick\002.";
+ }
+ $get_all_acc->finish();
+
+ unless($n) {
+ push @reply, "\002$tnick\002 has no access to \002$cn\002.";
+ }
+ if(services_conf_log_overrides && $override) {
+ my $src = get_user_nick($user);
+ wlog($csnick, LOG_INFO(), "\002$src\002 used override CS WHY $cn $tnick");
+ }
+ }
+ notice($user, @reply);
+}
+
+=cut
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(voice halfop op admin owner
+ devoice dehalfop deop deadmin deowner
+ unowner unadmin unop unhalfop unvoice)
+ ],
+ SYNTAX => '#chan LIST:nick',
+ CALL => \&cs_setmodes,
+ CMD_TOO => 1,
+ NO_WRAPPER => 1,
+};
+=cut
+cs_command [qw(voice halfop op admin owner
+ devoice dehalfop deop deadmin deowner
+ unowner unadmin unop unhalfop unvoice)
+ ],
+ \&cs_op_wrapper;
+sub cs_op_wrapper($$$) {
+ my ($user, $arglist, $uiOpts) = @_;
+ cs_setmodes($user, $uiOpts->{CMD}, split(/\s+/, $arglist));
+}
+sub cs_setmodes($$$@) {
+ my ($user, $cmd, $cn, @args) = @_;
+ #no warnings 'void';
+ my $agent = $user->{AGENT} or $csnick;
+ my $src = get_user_nick($user);
+ my $self = 0;
+
+ if(scalar(@args) == 0) {
+ @args = ($src);
+ $self = 1;
+ } elsif($args[0] =~ /^#/) {
+ foreach my $chn ($cn, @args) {
+ next unless $chn =~ /^#/;
+ no warnings 'prototype'; # we call ourselves
+ if (cr_chk_flag($chn, CRF_FREEZE())) {
+ notice($user, "\002$chn\002 is frozen and access suspended.");
+ next;
+ }
+ cs_setmodes($user, $cmd, { CHAN => $chn });
+ }
+ return;
+ } elsif((scalar(@args) == 1) and (lc($args[0]) eq lc($src))) {
+ $self = 1;
+ }
+
+ # PROTECT is deprecated. remove it in a couple versions.
+ # It should be called ADMIN under PREFIX_AQ
+ my @mperms = ('VOICE', 'HALFOP', 'OP', 'ADMIN', 'OWNER');
+ my @l = ('v', 'h', 'o', 'a', 'q');
+ my ($level, @modes, $count);
+
+ if($cmd =~ /voice$/i) { $level = 0 }
+ elsif($cmd =~ /h(alf)?op$/i) { $level = 1 }
+ elsif($cmd =~ /op$/i) { $level = 2 }
+ elsif($cmd =~ /(protect|admin)$/i) { $level = 3 }
+ elsif($cmd =~ /owner$/i) { $level = 4 }
+ my $de = 1 if($cmd =~ s/^(un|de)//i);
+ #$cmd =~ s/^de//i;
+
+ my $chan = { CHAN => $cn };
+ my $acc = get_best_acc($user, $chan);
+
+ # XXX I'm not sure this is the best way to do it.
+ unless(
+ ($de and $self) or ($self and ($level + 2) <= $acc) or
+ can_do($chan, $mperms[$level], $user, { ACC => $acc, NOREPLY => 1, OVERRIDE_MSG => "$cmd $cn @args" }) )
+ {
+ notice($user, "$cn: $err_deny");
+ return;
+ }
+
+ my ($override, $check_override);
+
+ foreach my $target (@args) {
+ my ($tuser);
+
+ $tuser = ($self ? $user : { NICK => $target } );
+
+ unless(is_in_chan($tuser, $chan)) {
+ notice($user, "\002$target\002 is not in \002$cn\002.");
+ next;
+ }
+
+ my $top = get_op($tuser, $chan);
+
+ if($de) {
+ unless($top & (2**$level)) {
+ notice($user, "\002$target\002 has no $cmd in \002$cn\002.");
+ next;
+ }
+
+ if(!$override and get_best_acc($tuser, $chan) > $acc) {
+ unless($check_override) {
+ $override = adminserv::can_do($user, 'SUPER');
+ $check_override = 1;
+ }
+ if($check_override and !$override) {
+ notice($user, "\002$target\002 outranks you in \002$cn\002.");
+ next;
+ }
+ }
+ } else {
+ if($top & (2**$level)) {
+ if($self) {
+ notice($user, "You already have $cmd in \002$cn\002.");
+ } else {
+ notice($user, "\002$target\002 already has $cmd in \002$cn\002.");
+ }
+ next;
+ }
+ if (cr_chk_flag($chan, CRF_OPGUARD()) and
+ !can_keep_op($user, $chan, $tuser, $l[$level]))
+ {
+ notice($user, "$target may not hold ops in $cn because OpGuard is enabled. ".
+ "Please respect the founders wishes.");
+ next;
+ }
+ }
+
+ push @modes, [($de ? '-' : '+').$l[$level], $target];
+ $count++;
+
+ }
+
+ ircd::setmode2(agent($chan), $cn, @modes) if scalar @modes;
+ ircd::notice(agent($chan), '%'.$cn, "$src used ".($de ? "de$cmd" : $cmd).' '.join(' ', @args))
+ if !$self and (lc $user->{AGENT} eq lc $csnick) and cr_chk_flag($chan, CRF_VERBOSE);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(drop)],
+ SYNTAX => '#chan',
+ CALL => \&cs_drop,
+};
+sub cs_drop($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ chk_registered($user, $chan) or return;
+
+ unless(get_best_acc($user, $chan) == FOUNDER or adminserv::can_do($user, 'SERVOP')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ drop($chan);
+ notice($user, $cn.' has been dropped.');
+ services::ulog($csnick, LOG_INFO(), "dropped $cn", $user, $chan);
+
+ undef($enforcers{lc $cn});
+ botserv::bot_part_if_needed(undef(), $chan, "Channel dropped.");
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(kick)],
+ SYNTAX => '#chan target TEXT:reason',
+ CALL => sub { cs_kick(shift @_, shift @_, shift @_, 0, shift @_); },
+};
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(kb kban kickb)],
+ SYNTAX => '#chan target TEXT:reason',
+ CALL => sub { cs_kick(shift @_, shift @_, shift @_, 1, shift @_); },
+};
+sub cs_kick($$$;$$) {
+ my ($user, $chan, $target, $ban, $reason) = @_;
+ my $cmd = ($ban ? 'KICKBAN' : 'KICK');
+ my $perm = ($ban ? 'BAN' : 'KICK');
+ if(ref($chan) ne 'HASH' || !defined($chan->{CHAN})) {
+ notice($user, "Invalid $cmd command, no channel specified");
+ return;
+ }
+
+ my $srclevel = get_best_acc($user, $chan);
+
+ my ($nick, $override) = can_do($chan, $perm, $user, { ACC => $srclevel });
+ return unless $nick;
+
+ my $src = get_user_nick($user);
+ my $cn = $chan->{CHAN};
+
+ $reason = "Requested by $src".($reason?": $reason":'');
+
+ my @errors = (
+ ["I'm sorry, $src, I'm afraid I can't do that."],
+ ["They are not in \002$cn\002."],
+ [$err_deny],
+ ["User not found"],
+ );
+ my @notinchan = ();
+ my $peace = ({modes::splitmodes(get_modelock($chan))}->{Q}->[0] eq '+');
+
+ my @targets = split(/\,/, $target);
+ foreach $target (@targets) {
+ my $tuser = { NICK => $target };
+ my $targetlevel = get_best_acc($tuser, $chan);
+
+ if(lc $target eq lc agent($chan) or adminserv::is_service($tuser)) {
+ push @{$errors[0]}, $target;
+ next;
+ }
+
+ if(get_user_id($tuser)) {
+ unless(is_in_chan($tuser, $chan)) {
+ if ($ban) {
+ push @notinchan, $tuser;
+ } else {
+ push @{$errors[1]}, $target;
+ }
+ next;
+ }
+ } else {
+ push @{$errors[3]}, $target;
+ next;
+ }
+
+ if( ( ($peace and $targetlevel > 0) or ($srclevel <= $targetlevel) )
+ and not ($override && check_override($user, ($ban ? 'BAN' : 'KICK'), "$cmd $cn $target")) )
+ {
+ push @{$errors[2]}, $target;
+ next;
+ }
+
+ if($ban) {
+ kickban($chan, $tuser, undef, $reason);
+ } else {
+ ircd::kick(agent($chan), $cn, $target, $reason) unless adminserv::is_service($user);
+ }
+ }
+
+ foreach my $errlist (@errors) {
+ if(@$errlist > 1) {
+ my $msg = shift @$errlist;
+
+ foreach my $e (@$errlist) { $e = "\002$e\002" }
+
+
+ notice($user,
+ "Cannot $cmd ".
+ enum("or", @$errlist).
+ ": $msg"
+ );
+ }
+ }
+ cs_ban($user, $chan, '', @notinchan) if ($ban and scalar (@notinchan));
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(kickmask kmask km)],
+ SYNTAX => '#chan mask TEXT:reason',
+ CALL => sub { cs_kickmask(shift @_, shift @_, shift @_, 0, shift @_); },
+};
+cs_command new SrSv::AgentUI::Simple {
+ #/^(k(ick)?b(an)?|b(an)?k(ick)?)m(ask)?$/
+ COMMAND => [qw(kickbanmask kbm kickbmask kbanmask kbmask)],
+ SYNTAX => '#chan mask TEXT:reason',
+ CALL => sub { cs_kickmask(shift @_, shift @_, shift @_, 1, shift @_); },
+};
+sub cs_kickmask($$$;$$) {
+ my ($user, $chan, $mask, $ban, $reason) = @_;
+
+ my $srclevel = get_best_acc($user, $chan);
+ my $src = get_user_nick($user);
+ my $cn = $chan->{CHAN};
+
+ my $candoOpts = { ACC => $srclevel, OVERRIDE_MSG => 'KICK'.($ban ? 'BAN' : '')."MASK $cn $mask $reason" };
+ my ($nick, $override) = can_do($chan, ($ban ? 'BAN' : 'KICK'), $user, $candoOpts);
+ return unless $nick;
+
+
+ $reason = "Requested by $src".($reason?": $reason":'');
+
+ my $count = kickmask_noacc($chan, $mask, $reason, $ban);
+ notice($user, ($count ? "Users kicked from \002$cn\002: $count." : "No users in \002$cn\002 matched $mask."))
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(ban)],
+ SYNTAX => '#chan LIST:nick',
+ CALL => sub { cs_kickmask(shift @_, shift @_, undef, @_); },
+};
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(qban)],
+ SYNTAX => '#chan LIST:nick',
+ CALL => sub { cs_kickmask(shift @_, shift @_, 'q', @_); },
+};
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(nban)],
+ SYNTAX => '#chan LIST:nick',
+ CALL => sub { cs_kickmask(shift @_, shift @_, 'n', @_); },
+};
+sub cs_ban($$$@) {
+ my ($user, $chan, $type, $targetList) = @_;
+ my $cn = $chan->{CHAN};
+ my $src = get_user_nick($user);
+
+ my $srclevel = get_best_acc($user, $chan);
+ my $candoOpts = { ACC => $srclevel, OVERRIDE_MSG => "BAN $cn @$targetList" };
+ my ($nick, $override) = can_do($chan, 'BAN', $user, $candoOpts);
+ return unless $nick;
+
+ my @errors = (
+ ["I'm sorry, $src, I'm afraid I can't do that."],
+ ["User not found"],
+ [$err_deny]
+ );
+
+ my (@bans, @unbans);
+ foreach my $target (@$targetList) {
+ my $tuser;
+
+ if(ref($target)) {
+ $tuser = $target;
+ }
+ elsif($target =~ /\,/) {
+ push @$targetList, split(',', $target);
+ next;
+ }
+ elsif($target eq '') {
+ # Should never happen
+ # but it could, given the split above
+ next;
+ }
+ elsif($target =~ /^-/) {
+ $target =~ s/^\-//;
+ push @unbans, $target;
+ next;
+ }
+=cut
+ elsif($target =~ /[!@]+/) {
+ ircd::debug("normalizing hostmask $target");
+ #$target = normalize_hostmask($target);
+#=cut
+ my ($nick, $ident, $host) = parse_mask($target);
+ $nick = '*' unless length($nick);
+ $ident = '*' unless length($ident);
+ $host = '*' unless length($host);
+ $target = "$nick\!$ident\@$host";
+#=cut
+ ircd::debug("normalized hostmask: $target");
+
+ push @bans, $target;
+ next;
+ }
+=cut
+ elsif(valid_nick($target)) {
+ $tuser = { NICK => $target };
+ }
+ elsif($target = validate_ban($target)) {
+ push @bans, $target;
+ next;
+ }
+ my $targetlevel = get_best_acc($tuser, $chan);
+
+ if(lc $target eq lc agent($chan) or adminserv::is_service($tuser)) {
+ push @{$errors[0]}, get_user_nick($tuser);
+ next;
+ }
+
+ unless(get_user_id($tuser)) {
+ push @{$errors[1]}, get_user_nick($tuser);
+ next;
+ }
+ if( $srclevel <= $targetlevel and not ($override && check_override($user, 'BAN', "BAN $cn $target")) ) {
+ push @{$errors[2]}, $target;
+ next;
+ }
+
+ push @bans, make_banmask($chan, $tuser, $type);
+ }
+
+ foreach my $errlist (@errors) {
+ if(@$errlist > 1) {
+ my $msg = shift @$errlist;
+
+ foreach my $e (@$errlist) { $e = "\002$e\002" }
+
+ notice($user,
+ "Cannot ban ".
+ enum("or", @$errlist).
+ ": $msg"
+ );
+ }
+ }
+
+ ircd::ban_list(agent($chan), $cn, +1, 'b', @bans) if (scalar(@bans));
+ ircd::notice(agent($chan), $cn, "$src used BAN ".join(' ', @bans))
+ if (lc $user->{AGENT} eq lc $csnick) and (cr_chk_flag($chan, CRF_VERBOSE) and scalar(@bans));
+ cs_unban($user, $chan, @unbans) if scalar(@unbans);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(invite)],
+ SYNTAX => '#chan LIST:nick',
+ CALL => \&cs_invite,
+};
+sub cs_invite($$@) {
+ my ($user, $chan, $targetList) = @_;
+ my $src = get_user_nick($user);
+ unless(scalar(@$targetList)) {
+ $targetList = [$src];
+ }
+ my $cn = $chan->{CHAN};
+ my $srclevel = get_best_acc($user, $chan);
+
+ my @errors = (
+ ["They are not online."],
+ ["They are already in \002$cn\002."],
+ [$err_deny]
+ );
+
+ my @invited;
+ foreach my $target (@$targetList) {
+ my $tuser;
+ if(lc($src) eq lc($target)) {
+ $tuser = $user;
+ }
+ elsif($target =~ /\,/) {
+ push @$targetList, split(',', $target);
+ next;
+ }
+ elsif($target eq '') {
+ # Should never happen
+ # but it could, given the split above
+ next;
+ }
+ else {
+ $tuser = { NICK => $target };
+ }
+
+ my $candoOpts = { ACC => $srclevel, NOREPLY => 1, OVERRIDE_MSG => "INVITE $cn $target" };
+ if(lc($src) eq lc($target)) {
+ unless(can_do($chan, 'InviteSelf', $user, $candoOpts)) {
+ push @{$errors[2]}, $target;
+ next;
+ }
+ }
+ else {
+ unless(can_do($chan, 'INVITE', $user, $candoOpts)) {
+ push @{$errors[2]}, $target;
+ next;
+ }
+
+ unless(nickserv::is_online($target)) {
+ push @{$errors[0]}, $target;
+ next;
+ }
+
+ # invite is annoying, so punish them mercilessly
+ return if operserv::flood_check($user, 2);
+ }
+
+ if(is_in_chan($tuser, $chan)) {
+ push @{$errors[1]}, $target;
+ next;
+ }
+
+ ircd::invite(agent($chan), $cn, $target); push @invited, $target;
+ ircd::notice(agent($chan), $target, "\002$src\002 has invited you to \002$cn\002.")
+ unless(lc($src) eq lc($target));
+ }
+
+ foreach my $errlist (@errors) {
+ if(@$errlist > 1) {
+ my $msg = shift @$errlist;
+
+ foreach my $e (@$errlist) { $e = "\002$e\002" }
+
+ notice($user,
+ "Cannot invite ".
+ enum("or", @$errlist).
+ ": $msg"
+ );
+ }
+ }
+
+ ircd::notice(agent($chan), $cn, "$src used INVITE ".join(' ', @invited))
+ if (lc $user->{AGENT} eq lc $csnick)and cr_chk_flag($chan, CRF_VERBOSE) and scalar(@invited);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(close)],
+ SYNTAX => '#chan TEXT:reason',
+ CALL => sub { cs_close(@_, CRF_CLOSE); },
+};
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(drone)],
+ SYNTAX => '#chan TEXT:reason',
+ CALL => sub { cs_close(@_, CRF_DRONE); },
+};
+sub cs_close($$$$) {
+ my ($user, $chan, $reason, $type) = @_;
+ # $type is a flag, either CRF_CLOSE or CRF_DRONE
+ my $cn = $chan->{CHAN};
+ my $oper;
+
+ unless($oper = adminserv::is_svsop($user, adminserv::S_ROOT())) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ my $rlength = length($reason);
+ if($rlength >= 350) {
+ notice($user, 'Close reason is too long by '. $rlength-350 .' character(s). Maximum length is 350 characters.');
+ return;
+ }
+
+ if(is_registered($chan)) {
+ $drop_acc->execute($cn);
+ $drop_lvl->execute($cn);
+ $del_close->execute($cn);
+ $drop_akick->execute($cn);
+ $drop_welcome->execute($cn);
+ $drop_chantext->execute($cn);
+ $drop_nicktext->execute($cn); # Leftover channel auths
+
+ $set_founder->execute($oper, $cn);
+ }
+ else {
+ $register->execute($cn, $reason, $oper);
+ }
+ $set_modelock->execute('+rsnt', $cn);
+ do_modelock($chan);
+ set_acc($oper, undef, $chan, FOUNDER);
+
+ $set_close->execute($cn, $reason, $oper, $type);
+ cr_set_flag($chan, (CRF_FREEZE | CRF_CLOSE | CRF_DRONE), 0); #unset flags
+ cr_set_flag($chan, CRF_HOLD, 1); #set flags
+
+ my $src = get_user_nick($user);
+ my $time = gmtime2(time);
+ my $cmsg = "is closed [$src $time]: $reason";
+
+ if ($type == CRF_CLOSE) {
+ clear_users($chan, "Channel $cmsg");
+ ircd::settopic(agent($chan), $cn, $src, time(), "Channel $cmsg")
+ }
+ elsif ($type == CRF_DRONE) {
+ chan_kill($chan, "$cn $cmsg");
+ }
+
+ notice($user, "The channel \002$cn\002 is now closed.");
+ services::ulog($csnick, LOG_INFO(), "closed $cn with reason: $reason", $user, $chan);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(clear)],
+ SYNTAX => '#chan users/modes/ops/bans [TEXT:reason]',
+ CALL => \&cs_clear_dispatch,
+};
+
+sub cs_clear_dispatch {
+ my ($user, $chan, $clearcmd, $reason) = @_;
+ unless ($chan and $clearcmd) {
+ notice($user, 'Syntax: CLEAR <channel> <MODES|OPS|USERS|BANS> [reason]');
+ return;
+ }
+ if($clearcmd =~ /^modes$/i) {
+ cs_clear_modes($user, $chan, $reason);
+ }
+ elsif($clearcmd =~ /^ops$/i) {
+ cs_clear_ops($user, $chan, $reason);
+ }
+ elsif($clearcmd =~ /^users$/i) {
+ cs_clear_users($user, $chan, $reason);
+ }
+ elsif($clearcmd =~ /^bans?$/i) {
+ cs_clear_bans($user, $chan, 0, $reason);
+ }
+ elsif($clearcmd =~ /^excepts?$/i) {
+ cs_clear_bans($user, $chan, 128, $reason);
+ }
+ else {
+ notice($user, "Unknown CLEAR command \002$clearcmd\002",
+ 'Syntax: CLEAR <channel> <MODES|OPS|USERS|BANS> [reason]');
+ }
+}
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(mkick)],
+ SYNTAX => '#chan [TEXT:reason]',
+ CALL => sub {cs_clear_dispatch(shift @_, shift @_, 'users', shift @_)},
+};
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(mdeop)],
+ SYNTAX => '#chan [TEXT:reason]',
+ CALL => sub {cs_clear_dispatch(shift @_, shift @_, 'ops', shift @_)},
+};
+sub cs_clear_pre($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ my $srclevel = get_best_acc($user, $chan);
+
+ my ($cando, $override) = can_do($chan, 'CLEAR', $user, { ACC => $srclevel });
+ return 0 unless($cando);
+
+ $get_highrank->execute($cn);
+ my ($highrank_nick, $highrank_level) = $get_highrank->fetchrow_array();
+ $get_highrank->finish();
+
+ if($highrank_level > $srclevel && !$override) {
+ notice($user, "$highrank_nick outranks you in $cn (level: $levels[$highrank_level])");
+ return 0;
+ }
+
+ return 1;
+}
+
+sub cs_clear_users($$;$) {
+ my ($user, $chan, $reason) = @_;
+ my $src = get_user_nick($user);
+
+ cs_clear_pre($user, $chan) or return;
+
+ my $rlength = length($reason);
+ if($rlength >= 350) {
+ notice($user, 'Clear reason is too long by '. $rlength-350 .' character(s). Maximum length is 350 characters.');
+ return;
+ }
+
+ clear_users($chan, "CLEAR USERS by \002$src\002".($reason?" reason: $reason":''));
+}
+
+sub cs_clear_modes($$;$) {
+ my ($user, $chan, $reason) = @_;
+ my $cn = $chan->{CHAN};
+ my $src = get_user_nick($user);
+
+ cs_clear_pre($user, $chan) or return;
+
+ my $rlength = length($reason);
+ if($rlength >= 350) {
+ notice($user, 'Clear reason is too long by '. $rlength-350 .' character(s). Maximum length is 350 characters.');
+ return;
+ }
+
+ my $agent = agent($chan);
+ ircd::notice($agent, $cn, "CLEAR MODES by \002$src\002".($reason?" reason: $reason":''));
+
+ $get_chanmodes->execute($cn);
+ my ($curmodes) = $get_chanmodes->fetchrow_array;
+ my $ml = get_modelock($chan);
+
+ # This method may exceed the 12-mode limit
+ # But it seems to succeed anyway, even with more than 12.
+ my ($modes, $parms) = split(/ /, modes::merge(modes::invert($curmodes), $ml, 1). ' * *', 2);
+ # we split this separately,
+ # as otherwise it insists on taking the result of the split as a scalar quantity
+ ircd::setmode($agent, $cn, $modes, $parms);
+ do_modelock($chan);
+}
+
+sub cs_clear_ops($$;$) {
+ my ($user, $chan, $reason) = @_;
+ my $cn = $chan->{CHAN};
+ my $src = get_user_nick($user);
+
+ cs_clear_pre($user, $chan) or return;
+
+ my $rlength = length($reason);
+ if($rlength >= 350) {
+ notice($user, 'Clear reason is too long by '. $rlength-350 .' character(s). Maximum length is 350 characters.');
+ return;
+ }
+
+ clear_ops($chan);
+
+ ircd::notice(agent($chan), $cn, "CLEAR OPS by \002$src\002".($reason?" reason: $reason":''));
+ return 1;
+}
+
+sub cs_clear_bans($$;$$) {
+ my ($user, $chan, $type, $reason) = @_;
+ my $cn = $chan->{CHAN};
+ my $src = get_user_nick($user);
+ $type = 0 unless defined $type;
+
+ cs_clear_pre($user, $chan) or return;
+
+ my $rlength = length($reason);
+ if($rlength >= 350) {
+ notice($user, 'Clear reason is too long by '. $rlength-350 .' character(s). Maximum length is 350 characters.');
+ return;
+ }
+
+ clear_bans($chan, $type);
+
+ ircd::notice(agent($chan), $cn, "CLEAR BANS by \002$src\002".($reason?" reason: $reason":''));
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(welcome)],
+ SYNTAX => '#chan add/del/list [TEXT:message/num]',
+ CALL => \&cs_welcome_dispatch,
+};
+sub cs_welcome_dispatch {
+ my ($user, $chan, $wcmd, $arg) = @_;
+ if(lc($wcmd) eq 'add') {
+ unless ($chan and $arg) {
+ notice($user, 'Syntax: WELCOME <channel> ADD <message>');
+ return;
+ }
+ cs_welcome_add($user, $chan, $arg);
+ }
+ elsif(lc($wcmd) eq 'del') {
+ if ($arg && !misc::isint($arg)) {
+ notice($user, 'Syntax: WELCOME <channnel> DEL <number>');
+ return;
+ }
+ cs_welcome_del($user, $chan, $arg);
+ }
+ elsif(lc($wcmd) eq 'list') {
+ if ($arg) {
+ notice($user, 'Syntax: WELCOME <channel> LIST');
+ return;
+ }
+ cs_welcome_list($user, $chan);
+ }
+ else {
+ notice($user, 'Syntax: WELCOME <channel> <ADD|DEL|LIST>');
+ }
+}
+
+sub cs_welcome_pre($$) {
+ my ($user, $chan) = @_;
+
+ return can_do($chan, 'WELCOME', $user);
+}
+
+sub cs_welcome_add($$$) {
+ my ($user, $chan, $msg) = @_;
+ my $src = get_best_acc($user, $chan, 1);
+ my $cn = $chan->{CHAN};
+
+ cs_welcome_pre($user, $chan) or return;
+
+ my $mlength = length($msg);
+ if($mlength >= 350) {
+ notice($user, 'Welcome Message is too long by '. $mlength-350 .' character(s). Maximum length is 350 characters.');
+ return;
+ }
+
+ $count_welcome->execute($cn);
+ my $count = $count_welcome->fetchrow_array;
+ if ($count >= 5) {
+ notice($user, 'There is a maximum of five (5) Channel Welcome Messages.');
+ return;
+ }
+
+ $add_welcome->execute($cn, ++$count, $src, $msg);
+
+ notice($user, "Welcome message number $count for \002$cn\002 set to:", " $msg");
+}
+
+sub cs_welcome_list($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ cs_welcome_pre($user, $chan) or return;
+
+ $list_welcome->execute($cn);
+
+ my @data;
+
+ while(my ($id, $time, $adder, $msg) = $list_welcome->fetchrow_array) {
+ push @data, ["$id.", $adder, gmtime2($time), $msg];
+ }
+ $list_welcome->finish();
+
+ notice($user, columnar {TITLE => "Welcome message list for \002$cn\002:", DOUBLE=>1,
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data);
+}
+
+sub cs_welcome_del($$$) {
+ my ($user, $chan, $id) = @_;
+ my $cn = $chan->{CHAN};
+
+ cs_welcome_pre($user, $chan) or return;
+
+ if ($del_welcome->execute($cn, $id) == 1) {
+ notice($user, "Welcome Message \002$id\002 deleted from \002$cn\002");
+ $consolidate_welcome->execute($cn, $id);
+ }
+ else {
+ notice($user,
+ "Welcome Message number $id for \002$cn\002 does not exist.");
+ }
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(alist)],
+ SYNTAX => '#chan [mask]',
+ CALL => \&cs_alist,
+};
+sub cs_alist($$;$) {
+ my ($user, $chan, $mask) = @_;
+ my $cn = $chan->{CHAN};
+
+ chk_registered($user, $chan) or return;
+
+ my $slevel = get_best_acc($user, $chan);
+
+ can_do($chan, 'ACCLIST', $user, { ACC => $slevel }) or return;
+
+ my @reply;
+
+ if($mask) {
+ my ($mnick, $mident, $mhost) = glob2sql(parse_mask($mask));
+ $mnick = '%' if($mnick eq '');
+ $mident = '%' if($mident eq '');
+ $mhost = '%' if($mhost eq '');
+
+ $get_acc_list2_mask->execute($mnick, $cn, $mnick, $mident, $mhost);
+ while(my ($nick, $adder, $level, $time, $last_used, $ident, $vhost) = $get_acc_list2_mask->fetchrow_array) {
+ push @reply, "*) $nick ($ident\@$vhost) Rank: ".$levels[$level] . ($adder ? ' Added by: '.$adder : '');
+ push @reply, ' '.($time ? 'Date/time added: '. gmtime2($time).' ' : '').
+ ($last_used ? 'Last used '.time_ago($last_used).' ago' : '') if ($time or $last_used);
+ }
+ $get_acc_list2_mask->finish();
+ } else {
+ $get_acc_list2->execute($cn);
+ while(my ($nick, $adder, $level, $time, $last_used, $ident, $vhost) = $get_acc_list2->fetchrow_array) {
+ push @reply, "*) $nick ($ident\@$vhost) Rank: ".$levels[$level] . ($adder ? ' Added by: '.$adder : '');
+ push @reply, ' '.($time ? 'Date/time added: '. gmtime2($time).' ' : '').
+ ($last_used ? 'Last used '.time_ago($last_used).' ago' : '') if ($time or $last_used);
+ }
+ $get_acc_list2->finish();
+ }
+
+ notice($user, "Access list for \002$cn\002:", @reply);
+
+ return;
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(banlist)],
+ SYNTAX => '#chan',
+ CALL => \&cs_banlist,
+};
+sub cs_banlist($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+ can_do($chan, 'UnbanSelf', $user, { NOREPLY => 1 }) or can_do($chan, 'BAN', $user) or return;
+
+ my $i = 0; my @data;
+ $list_bans->execute($cn, 0);
+ while(my ($mask, $setter, $time) = $list_bans->fetchrow_array()) {
+ push @data, ["\002".++$i."\002", sql2glob($mask), $setter, ($time ? gmtime2($time) : '')];
+ }
+
+ notice($user, columnar {TITLE => "Ban list of \002$cn\002:", DOUBLE=>1,
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(unban)],
+ SYNTAX => '#chan LIST:masks',
+ CALL => \&cs_unban,
+};
+sub cs_unban($$$) {
+ my ($user, $chan, $parmList) = @_;
+ my @parms = @$parmList;
+ if(scalar(@parms) == 0) {
+ @parms = get_user_nick($user);
+ }
+ my $cn = $chan->{CHAN};
+
+ my $self = 1 if ( (scalar(@parms) == 1) and ( lc($parms[0]) eq lc(get_user_nick($user)) ) );
+ if ($parms[0] eq '*') {
+ cs_clear_bans($user, $chan);
+ return;
+ }
+ else {
+ can_do($chan, ($self ? 'UnbanSelf' : 'UNBAN'), $user) or return;
+ }
+
+ my (@userlist, @masklist);
+ foreach my $parm (@parms) {
+ if(valid_nick($parm)) {
+ my $tuser = ($self ? $user : { NICK => $parm });
+ unless(get_user_id($tuser)) {
+ notice($user, "No such user: \002$parm\002");
+ next;
+ }
+ push @userlist, $tuser;
+ } elsif($parm =~ /^[0-9\.,-]+$/) {
+ foreach my $num (makeSeqList($parm)) {
+ push @masklist, get_ban_num($chan, $num);
+ }
+ } else {
+ push @masklist, $parm;
+ }
+ }
+
+ if(scalar(@userlist)) {
+ unban_user($chan, @userlist);
+ notice($user, "All bans affecting " .
+ ( $self ? 'you' : enum( 'and', map(get_user_nick($_), @userlist) ) ) .
+ " on \002$cn\002 have been removed.");
+ }
+ if(scalar(@masklist)) {
+ ircd::ban_list(agent($chan), $cn, -1, 'b', @masklist);
+ notice($user, "The following bans have been removed: ".join(' ', @masklist))
+ if scalar(@masklist);
+ }
+}
+
+cs_command [qw(up down)], \&cs_updown;
+sub cs_updown($$$) {
+ my ($user, $argList, $uiOpts) = @_;
+ my $cmd = $uiOpts->{CMD};
+ my (@chans) = split(/\s+/, $argList);
+ #ircd::debug("$user '$argList'");
+ #@chans = map { (length($_) ? $_ : undef ) } @chans;
+
+ if (defined($chans[1]) and $chans[1] !~ "^\#" and $chans[0] =~ "^\#") {
+ return cs_updown2($user, $cmd, { CHAN => shift @chans }, @chans);
+ }
+
+ @chans = get_user_chans($user)
+ unless (@chans);
+
+ if (uc($cmd) eq 'UP') {
+ foreach my $cn (@chans) {
+ next unless ($cn =~ /^\#/);
+ my $chan = { CHAN => $cn };
+ next if cr_chk_flag($chan, (CRF_DRONE | CRF_CLOSE | CRF_FREEZE), 1);
+ chanserv::set_modes($user, $chan, chanserv::get_best_acc($user, $chan));
+ }
+ }
+ elsif (uc($cmd) eq 'DOWN') {
+ foreach my $cn (@chans) {
+ next unless ($cn =~ /^\#/);
+ chanserv::unset_modes($user, { CHAN => $cn });
+ }
+ }
+}
+
+sub cs_updown2($$$@) {
+ my ($user, $cmd, $chan, @targets) = @_;
+ no warnings 'void';
+ my $agent = $user->{AGENT} or $csnick;
+ my $cn = $chan->{CHAN};
+
+ return unless chk_registered($user, $chan);
+ if (cr_chk_flag($chan, CRF_FREEZE())) {
+ notice($user, "\002$cn\002 is frozen and access suspended.");
+ return;
+ }
+
+ my $acc = get_best_acc($user, $chan);
+ return unless(can_do($chan, 'UPDOWN', $user, { ACC => $acc }));
+
+ my $updown = ((uc($cmd) eq 'UP') ? 1 : 0);
+
+ my ($override, $check_override);
+ my (@list, $count);
+ foreach my $target (@targets) {
+
+ my $tuser = { NICK => $target };
+
+ unless(is_in_chan($tuser, $chan)) {
+ notice($user, "\002$target\002 is not in \002$cn\002.");
+ next;
+ }
+
+ if($updown) {
+ push @list, $target;
+ chanserv::set_modes($tuser, $chan, chanserv::get_best_acc($tuser, $chan));
+ }
+ else {
+ my $top = get_op($tuser, $chan);
+ unless($top) {
+ notice($user, "\002$target\002 is already deopped in \002$cn\002.");
+ next;
+ }
+
+ if(!$override and get_best_acc($tuser, $chan) > $acc) {
+ unless($check_override) {
+ $override = adminserv::can_do($user, 'SUPER');
+ $check_override = 1;
+ }
+ if($check_override and !$override) {
+ notice($user, "\002$target\002 outranks you in \002$cn\002.");
+ next;
+ }
+ }
+ push @list, $target;
+ chanserv::unset_modes($tuser, { CHAN => $cn });
+ }
+ $count++;
+ }
+
+ my $src = get_user_nick($user);
+ ircd::notice(agent($chan), '%'.$cn, "$src used $cmd ".join(' ', @list))
+ if (lc $user->{AGENT} eq lc $csnick) and cr_chk_flag($chan, CRF_VERBOSE);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(getkey)],
+ SYNTAX => '#chan',
+ CALL => \&cs_getkey,
+};
+sub cs_getkey($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ can_do($chan, 'GETKEY', $user) or return;
+
+ $get_chanmodes->execute($cn);
+ my $modes = $get_chanmodes->fetchrow_array; $get_chanmodes->finish();
+
+ if(my $key = modes::get_key($modes)) {
+ notice($user, "Channel key for \002$cn\002: $key");
+ }
+ else {
+ notice($user, "\002$cn\002 has no channel key.");
+ }
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(auth)],
+ SYNTAX => '#chan list/remove/delete [arg]',
+ CALL => \&cs_auth,
+};
+sub cs_auth($$$@) {
+ my ($user, $chan, $cmd, @args) = @_;
+ my $cn = $chan->{CHAN};
+ $cmd = lc $cmd;
+
+ return unless chk_registered($user, $chan);
+ return unless can_do($chan, 'AccChange', $user);
+ my $userlevel = get_best_acc($user, $chan);
+ if($cmd eq 'list') {
+ my @data;
+ $list_auth_chan->execute($cn);
+ while(my ($nick, $data) = $list_auth_chan->fetchrow_array()) {
+ my ($adder, $old, $level, $time) = split(/:/, $data);
+ push @data, ["\002$nick\002", $levels[$level], $adder, gmtime2($time)];
+ }
+ if ($list_auth_chan->rows()) {
+ notice($user, columnar {TITLE => "Pending authorizations for \002$cn\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data);
+ }
+ else {
+ notice($user, "There are no pending authorizations for \002$cn\002");
+ }
+ $list_auth_chan->finish();
+ }
+ elsif($cmd eq 'remove' or $cmd eq 'delete' or $cmd eq 'del') {
+ my ($nick, $adder, $old, $level, $time);
+ my $parm = shift @args;
+ if(misc::isint($parm) and ($nick, $adder, $old, $level, $time) = get_auth_num($cn, $parm))
+ {
+ }
+ elsif (($adder, $old, $level, $time) = get_auth_nick($cn, $parm))
+ {
+ $nick = $parm;
+ }
+ unless ($nick) {
+ # This should normally be an 'else' as the elsif above should prove false
+ # For some reason, it doesn't work. the unless ($nick) fixes it.
+ # It only doesn't work for numbered entries
+ notice($user, "There is no entry for \002$parm\002 in \002$cn\002's AUTH list");
+ return;
+ }
+ $nickserv::del_auth->execute($nick, $cn); $nickserv::del_auth->finish();
+ my $log_str = "deleted AUTH entry $cn $nick $levels[$level]";
+ my $src = get_user_nick($user);
+ notice($user, "You have $log_str");
+ ircd::notice(agent($chan), '%'.$cn, "has \002$src\002 has $log_str")
+ if cr_chk_flag($chan, CRF_VERBOSE);
+ services::ulog($chanserv::csnick, LOG_INFO(), "has $log_str", $user, $chan);
+ }
+ else {
+ notice($user, "Unknown AUTH command \002$cmd\002");
+ }
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(mode)],
+ SYNTAX => '#chan modes [parms]',
+ CALL => \&cs_mode,
+};
+sub cs_mode($$$@) {
+ my ($user, $chan, $modes_in, @parms_in) = @_;
+ can_do($chan, 'MODE', $user) or return undef;
+ ($modes_in, @parms_in) = validate_chmodes($modes_in, @parms_in);
+
+ my %permhash = (
+ 'q' => 'OWNER',
+ 'a' => 'ADMIN',
+ 'o' => 'OP',
+ 'h' => 'HALFOP',
+ 'v' => 'VOICE',
+ );
+ my $sign = '+'; my $cn = $chan->{CHAN};
+ my ($modes_out, @parms_out);
+ foreach my $mode (split(//, $modes_in)) {
+ $sign = $mode if $mode =~ /[+-]/;
+ if ($permhash{$mode}) {
+ my $parm = shift @parms_in;
+ cs_setmodes($user, ($sign eq '-' ? 'de' : '').$permhash{$mode}, $chan->{CHAN}, [$parm]);
+ }
+ elsif($mode =~ /[beIlLkjf]/) {
+ $modes_out .= $mode;
+ push @parms_out, shift @parms_in;
+ } else {
+ $modes_out .= $mode;
+ }
+ }
+
+ return if $modes_out =~ /^[+-]*$/;
+ ircd::setmode(agent($chan), $chan->{CHAN}, $modes_out, join(' ', @parms_out));
+ do_modelock($chan, $modes_out.' '.join(' ', @parms_out));
+
+ $modes_out =~ s/^[+-]*([+-].*)$/$1/;
+ ircd::notice(agent($chan), '%'.$cn, get_user_nick($user).' used MODE '.join(' ', $modes_out, @parms_out))
+ if (lc $user->{AGENT} eq lc $csnick) and cr_chk_flag($chan, CRF_VERBOSE);
+}
+
+cs_command [qw(copy)], \&cs_copy;
+sub cs_copy($$@) {
+ my ($user, $arglist) = @_;
+ my ($cn1, @args) = split(/\s+/, $arglist);
+ my $chan1 = { CHAN => $cn1 };
+ my $cn2;
+ my $type;
+ if($args[0] =~ /^#/) {
+ $cn2 = shift @args;
+ $type = 'all';
+ }
+ if($args[0] =~ /(?:acc(?:ess)?|akick|levels|all)/i) {
+ $type = shift @args;
+ $cn2 = shift @args unless $cn2;
+ }
+ my $rank;
+ if($type =~ /^acc(?:ess)?/i) {
+ if($cn2 =~ /^#/) {
+ $rank = shift @args;
+ } else {
+ $rank = $cn2;
+ $cn2 = shift @args;
+ }
+ }
+ unless(defined $cn2 and defined $type) {
+ notice($user, "Unknown COPY command '$type'", 'Syntax: COPY #chan1 [type] #chan2');
+ }
+ my $chan2 = { CHAN => $cn2 };
+ if(lc($cn1) eq lc($cn2)) {
+ notice($user, "You cannot copy a channel onto itself.");
+ }
+ unless(is_registered($chan1)) {
+ notice($user, "Source channel \002$cn1\002 must be registered.");
+ return;
+ }
+ can_do($chan1, 'COPY', $user) or return undef;
+ if(lc $type eq 'all') {
+ if(is_registered($chan2)) {
+ notice($user, "When copying all channel details, destination channel cannot be registered.");
+ return;
+ } elsif(!(get_op($user, $chan2) & ($opmodes{o} | $opmodes{a} | $opmodes{q}))) {
+ # This would be preferred to be a 'opmode_mask' or something
+ # However that might be misleading due to hop not being enough to register
+ notice($user, "You must have channel operator status to register \002$cn2\002.");
+ return;
+ } else {
+ cs_copy_chan_all($user, $chan1, $chan2);
+ return;
+ }
+ } else {
+ unless(is_registered($chan2)) {
+ notice($user, "When copying channel lists, destination channel must be registered.");
+ return;
+ }
+ can_do($chan2, 'COPY', $user) or return undef;
+ }
+ if(lc $type eq 'akick') {
+ cs_copy_chan_akick($user, $chan1, $chan2);
+ } elsif(lc $type eq 'levels') {
+ cs_copy_chan_levels($user, $chan1, $chan2);
+ } elsif($type =~ /^acc(?:ess)?/i) {
+ cs_copy_chan_acc($user, $chan1, $chan2, xop_byname($rank));
+ }
+}
+
+sub cs_copy_chan_all($$$) {
+ my ($user, $chan1, $chan2) = @_;
+ cs_copy_chan_chanreg($user, $chan1, $chan2);
+ cs_copy_chan_levels($user, $chan1, $chan2);
+ cs_copy_chan_acc($user, $chan1, $chan2);
+ cs_copy_chan_akick($user, $chan1, $chan2);
+ return;
+}
+
+sub cs_copy_chan_chanreg($$$) {
+ my ($user, $chan1, $chan2) = @_;
+ my $cn1 = $chan1->{CHAN};
+ my $cn2 = $chan2->{CHAN};
+
+ copy_chan_chanreg($cn1, $cn2);
+ botserv::bot_join($chan2) unless (lc(agent($chan2)) eq lc($csnick) );
+ do_modelock($chan2);
+ notice($user, "Registration for \002$cn1\002 copied to \002$cn2\002");
+
+ my $log_str = "copied the channel registration for \002$cn1\002 to \002$cn2\002";
+ services::ulog($chanserv::csnick, LOG_INFO(), "$log_str", $user, $chan1);
+
+ my $src = get_user_nick($user);
+ ircd::notice(agent($chan1), '%'.$cn1, "\002$src\002 $log_str")
+ if cr_chk_flag($chan1, CRF_VERBOSE);
+ ircd::notice(agent($chan2), '%'.$cn2, "\002$src\002 $log_str")
+ if cr_chk_flag($chan2, CRF_VERBOSE);
+}
+
+sub cs_copy_chan_acc($$$;$) {
+ my ($user, $chan1, $chan2, $level) = @_;
+ my $cn1 = $chan1->{CHAN};
+ my $cn2 = $chan2->{CHAN};
+
+ copy_chan_acc($cn1, $cn2, $level);
+
+ unless(cr_chk_flag($chan2, CRF_NEVEROP)) {
+ $get_chan_users->execute($cn2); my @targets;
+ while (my ($nick, $uid) = $get_chan_users->fetchrow_array()) {
+ push @targets, $nick unless nr_chk_flag_user({ NICK => $nick, ID => $uid }, NRF_NEVEROP);
+ }
+ cs_updown2($user, 'UP', $chan2, @targets);
+ }
+
+ notice($user, "Access list for \002$cn1\002 ".
+ ($level ? "(rank: \002".$plevels[$level + $plzero]."\002) " : '').
+ "copied to \002$cn2\002");
+
+ my $log_str = "copied the channel access list for \002$cn1\002 ".
+ ($level ? "(rank: \002".$plevels[$level + $plzero]."\002) " : '').
+ "to \002$cn2\002";
+ services::ulog($chanserv::csnick, LOG_INFO(), "$log_str", $user, $chan1);
+
+ my $src = get_user_nick($user);
+ ircd::notice(agent($chan1), '%'.$cn1, "\002$src\002 $log_str")
+ if cr_chk_flag($chan1, CRF_VERBOSE);
+ ircd::notice(agent($chan2), '%'.$cn2, "\002$src\002 $log_str")
+ if cr_chk_flag($chan2, CRF_VERBOSE);
+}
+
+sub cs_copy_chan_levels($$$) {
+ my ($user, $chan1, $chan2) = @_;
+ my $cn1 = $chan1->{CHAN};
+ my $cn2 = $chan2->{CHAN};
+
+ copy_chan_levels($cn1, $cn2);
+ notice($user, "LEVELS for \002$cn1\002 copied to \002$cn2\002");
+
+ my $log_str = "copied the LEVELS list for \002$cn1\002 to \002$cn2\002";
+ services::ulog($chanserv::csnick, LOG_INFO(), "$log_str", $user, $chan1);
+
+ my $src = get_user_nick($user);
+ ircd::notice(agent($chan1), '%'.$cn1, "\002$src\002 $log_str")
+ if cr_chk_flag($chan1, CRF_VERBOSE);
+ ircd::notice(agent($chan2), '%'.$cn2, "\002$src\002 $log_str")
+ if cr_chk_flag($chan2, CRF_VERBOSE);
+}
+
+sub cs_copy_chan_akick($$$) {
+ my ($user, $chan1, $chan2) = @_;
+ my $cn1 = $chan1->{CHAN};
+ my $cn2 = $chan2->{CHAN};
+
+ copy_chan_akick($cn1, $cn2);
+ notice($user, "Channel AKick list for \002$cn1\002 copied to \002$cn2\002");
+
+ my $log_str = "copied the AKick list for \002$cn1\002 to \002$cn2\002";
+ services::ulog($chanserv::csnick, LOG_INFO(), "$log_str", $user, $chan1);
+
+ my $src = get_user_nick($user);
+ ircd::notice(agent($chan1), '%'.$cn1, "\002$src\002 $log_str")
+ if cr_chk_flag($chan1, CRF_VERBOSE);
+ ircd::notice(agent($chan2), '%'.$cn2, "\002$src\002 $log_str")
+ if cr_chk_flag($chan2, CRF_VERBOSE);
+}
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(mlock)],
+ SYNTAX => '#chan add/del/set modes [parms]',
+ CALL => \&cs_mlock,
+};
+sub cs_mlock($$$@) {
+ my ($user, $chan, $cmd, @args) = @_;
+ my $cn = $chan->{CHAN};
+ # does this need its own privilege now?
+ can_do($chan, 'SET', $user) or return;
+ my $modes;
+ {
+ my ($modes_in, @parms_in) = validate_chmodes(shift @args, @args);
+ $modes = $modes_in.' '.join(' ', @parms_in);
+ @args = undef;
+ }
+
+ my $cur_modelock = get_modelock($chan);
+ if(lc $cmd eq 'add') {
+ $modes = modes::merge($cur_modelock, $modes, 1);
+ $modes = sanitize_mlockable($modes);
+ $set_modelock->execute($modes, $cn);
+ }
+ elsif(lc $cmd eq 'del') {
+ $modes =~ s/[+-]//g;
+ $modes = modes::add($cur_modelock, "-$modes", 1);
+ $set_modelock->execute($modes, $cn);
+ }
+ elsif(lc $cmd eq 'set') {
+ $modes = modes::merge($modes, "+r", 1);
+ $set_modelock->execute($modes, $cn);
+ } else {
+ notice($user, "Unknown MLOCK command \"$cmd\"");
+ }
+
+ notice($user, "Mode lock for \002$cn\002 has been set to: \002$modes\002");
+ do_modelock($chan);
+
+=cut
+ notice($user, columnar {TITLE => "Ban list of \002$cn\002:", DOUBLE=>1,
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data);
+=cut
+}
+
+use SrSv::MySQL::Stub {
+ getChanUsers => ['COLUMN', "SELECT user.nick FROM chanuser, user
+ WHERE chanuser.chan=? AND user.id=chanuser.nickid AND chanuser.joined=1"]
+};
+
+cs_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(resync)],
+ SYNTAX => '#chan [more chans]',
+ CALL => \&cs_resync,
+ NO_WRAPPER => 1,
+};
+sub cs_resync($@) {
+ my ($user, @cns) = @_;
+ foreach my $cn (@cns) {
+ my $chan = { CHAN => $cn };
+ next unless cs_clear_ops($user, $chan, 'Resync');
+ cs_updown2($user, 'up', $chan, getChanUsers($cn));
+ }
+}
+
+### MISCELLANEA ###
+
+# these are helpers and do NOT check if $cn1 or $cn2 is reg'd
+sub copy_chan_acc($$;$) {
+ my ($cn1, $cn2, $level) = @_;
+ if($level) {
+ $copy_acc_rank->execute($cn2, $cn1, $level);
+ $copy_acc_rank->finish();
+ } else {
+ $get_founder->execute($cn2);
+ my ($founder) = $get_founder->fetchrow_array;
+ $get_founder->finish();
+
+ $copy_acc->execute($cn2, $cn1, $founder);
+ $copy_acc->finish();
+ }
+}
+
+sub copy_chan_akick($$;$) {
+ my ($cn1, $cn2) = @_;
+ $copy_akick->execute($cn2, $cn1);
+ $copy_akick->finish();
+ copy_chan_acc($cn1, $cn2, -1);
+}
+
+sub copy_chan_levels($$) {
+ my ($cn1, $cn2) = @_;
+ $copy_levels->execute($cn2, $cn1);
+ $copy_levels->finish();
+}
+
+sub copy_chan_chanreg($$) {
+ my ($cn1, $cn2) = @_;
+ $get_founder->execute($cn1);
+ my ($founder) = $get_founder->fetchrow_array;
+ $get_founder->finish();
+ set_acc($founder, undef, { CHAN => $cn2 }, FOUNDER);
+ $copy_chanreg->execute($cn2, $cn1);
+ $copy_chanreg->finish();
+}
+
+sub do_welcome($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ $get_welcomes->execute($cn);
+ if($get_welcomes->rows) {
+ my @welcomes;
+ while(my ($msg) = $get_welcomes->fetchrow_array) {
+ push @welcomes, (cr_chk_flag($chan, CRF_WELCOMEINCHAN) ? '' : "[$cn] " ).$msg;
+ }
+ if(cr_chk_flag($chan, CRF_WELCOMEINCHAN)) {
+ ircd::privmsg(agent($chan), $cn, @welcomes);
+ } else {
+ notice($user, @welcomes);
+ }
+ }
+ $get_welcomes->finish();
+}
+
+sub do_greet($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ if(can_do($chan, 'GREET', $user)) {
+ my $src = get_user_nick($user);
+ $nickserv::get_greet->execute(get_user_id($user));
+ my ($greet) = $nickserv::get_greet->fetchrow_array();
+ $nickserv::get_greet->finish();
+ ircd::privmsg(agent($chan), $cn, "[\002$src\002] $greet") if $greet;
+ }
+}
+
+sub chk_registered($$) {
+ my ($user, $chan) = @_;
+
+ unless(is_registered($chan)) {
+ my $cn = $chan->{CHAN};
+
+ notice($user, "The channel \002$cn\002 is not registered.");
+ return 0;
+ }
+
+ return 1;
+}
+
+sub make_banmask($$;$) {
+ my ($chan, $tuser, $type) = @_;
+ my $nick = get_user_nick($tuser);
+
+ my ($ident, $vhost) = get_vhost($tuser);
+ no warnings 'misc';
+ my ($nick, $ident, $vhost) = make_hostmask(get_bantype($chan), $nick, $ident, $vhost);
+ if($type eq 'q') {
+ $type = '~q:';
+ } elsif($type eq 'n') {
+ $type = '~n:';
+ } else {
+ $type = '';
+ }
+ return $type."$nick!$ident\@$vhost";
+}
+
+sub kickban($$$$) {
+ my ($chan, $user, $mask, $reason) = @_;
+ my $cn = $chan->{CHAN};
+ my $nick = get_user_nick($user);
+
+ return 0 if adminserv::is_service($user);
+
+ my $agent = agent($chan);
+
+ unless($mask) {
+ $mask = make_banmask($chan, $user);
+ }
+
+ enforcer_join($chan) if (get_user_count($chan) <= 1);
+ ircd::setmode($agent, $cn, '+b', $mask);
+ ircd::flushmodes();
+ ircd::kick($agent, $cn, $nick, $reason);
+ return 1;
+}
+
+sub kickban_multi($$$) {
+ my ($chan, $users, $reason) = @_;
+ my $cn = $chan->{CHAN};
+ my $agent = agent($chan);
+
+ enforcer_join($chan);
+ ircd::setmode($agent, $cn, '+b', '*!*@*');
+ ircd::flushmodes();
+
+ foreach my $user (@$users) {
+ next if adminserv::is_ircop($user) or adminserv::is_svsop($user, adminserv::S_HELP());
+ ircd::kick($agent, $cn, get_user_nick($user), $reason);
+ }
+}
+
+sub clear_users($$) {
+ my ($chan, $reason) = @_;
+ my $cn = $chan->{CHAN};
+ my $agent = agent($chan);
+ my $i;
+
+ enforcer_join($chan);
+ ircd::setmode($agent, $cn, '+b', '*!*@*');
+ ircd::flushmodes();
+ $get_chan_users->execute($cn);
+ while(my ($nick, $uid) = $get_chan_users->fetchrow_array) {
+ my $user = { NICK => $nick, ID => $uid };
+ ircd::kick($agent, $cn, $nick, $reason)
+ unless adminserv::is_ircop($user) or adminserv::is_svsop($user, adminserv::S_HELP());
+ $i++;
+ }
+
+ return $i;
+}
+
+sub kickmask($$$$) {
+ my ($chan, $mask, $reason, $ban) = @_;
+ my $cn = $chan->{CHAN};
+ my $agent = agent($chan);
+
+ my ($nick, $ident, $host) = glob2sql(parse_mask($mask));
+ $nick = '%' if ($nick eq '');
+ $ident = '%' if ($ident eq '');
+ $host = '%' if ($host eq '');
+
+ if ($ban) {
+ my $banmask = $nick.'!'.$ident.'@'.$host;
+ $banmask =~ tr/%_/*?/;
+ ircd::setmode($agent, $cn, '+b', $banmask);
+ ircd::flushmodes();
+ }
+
+ my $i;
+ $get_chan_users_mask->execute($cn, $nick, $ident, $host, $host, $host);
+ while(my ($nick, $uid) = $get_chan_users_mask->fetchrow_array) {
+ my $user = { NICK => $nick, ID => $uid };
+ ircd::kick($agent, $cn, $nick, $reason)
+ unless adminserv::is_service($user);
+ $i++;
+ }
+ $get_chan_users_mask->finish();
+
+ return $i;
+}
+
+sub kickmask_noacc($$$$) {
+ my ($chan, $mask, $reason, $ban) = @_;
+ my $cn = $chan->{CHAN};
+ my $agent = agent($chan);
+
+ my ($nick, $ident, $host) = glob2sql(parse_mask($mask));
+ $nick = '%' if ($nick eq '');
+ $ident = '%' if ($ident eq '');
+ $host = '%' if ($host eq '');
+
+ if ($ban) {
+ my $banmask = $nick.'!'.$ident.'@'.$host;
+ $banmask =~ tr/%_/*?/;
+ ircd::setmode($agent, $cn, '+b', $banmask);
+ ircd::flushmodes();
+ }
+
+ my $i;
+ $get_chan_users_mask_noacc->execute($cn, $nick, $ident, $host, $host, $host);
+ while(my ($nick, $uid) = $get_chan_users_mask_noacc->fetchrow_array) {
+ my $user = { NICK => $nick, ID => $uid };
+ ircd::kick($agent, $cn, $nick, $reason)
+ unless adminserv::is_service($user);
+ $i++;
+ }
+ $get_chan_users_mask_noacc->finish();
+
+ return $i;
+}
+
+sub clear_ops($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+ my @modelist;
+ my $agent = agent($chan);
+
+ $get_chan_users->execute($cn);
+ while(my ($nick, $uid) = $get_chan_users->fetchrow_array) {
+ my $user = { NICK => $nick, ID => $uid };
+ my $opmodes = get_op($user, $chan);
+ for(my $i; $i < 5; $i++) {
+ if($opmodes & 2**$i) {
+ push @modelist, ['-'.$opmodes[$i], $nick];
+ }
+ }
+ }
+
+ ircd::setmode2($agent, $cn, @modelist);
+}
+
+sub clear_bans($;$) {
+ my ($chan, $type) = @_;
+ my $cn = $chan->{CHAN};
+ my @args = ();
+ my $agent = agent($chan);
+ $type = 0 unless defined $type;
+ my $mode = ($type == 128 ? 'e' : 'b');
+
+ my @banlist = ();
+ $get_all_bans->execute($cn, $type);
+ while(my ($mask) = $get_all_bans->fetchrow_array) {
+ $mask =~ tr/\%\_/\*\?/;
+ push @banlist, $mask;
+ }
+
+ ircd::ban_list($agent, $cn, -1, $mode, @banlist);
+ ircd::flushmodes();
+}
+
+sub unban_user($@) {
+ my ($chan, @userlist) = @_;
+ my $cn = $chan->{CHAN};
+ my $count;
+ if (defined(&ircd::unban_nick)) {
+ my @nicklist;
+ foreach my $tuser (@userlist) {
+ push @nicklist, get_user_nick($tuser);
+ }
+ ircd::unban_nick(agent($chan), $cn, @nicklist);
+ return scalar(@nicklist);
+ }
+
+ foreach my $tuser (@userlist) {
+ my $tuid;
+ unless($tuid = get_user_id($tuser)) {
+ next;
+ }
+
+ my (@bans);
+ # We don't handle extended bans. Yet.
+ $find_bans_chan_user->execute($cn, $tuid, 0);
+ while (my ($mask) = $find_bans_chan_user->fetchrow_array) {
+ $mask =~ tr/\%\_/\*\?/;
+ push @bans, $mask;
+ }
+ $find_bans_chan_user->finish();
+
+ ircd::ban_list(agent($chan), $cn, -1, 'b', @bans) if scalar(@bans);
+ $delete_bans_chan_user->execute($cn, $tuid, 0); $delete_bans_chan_user->finish();
+ $count++;
+ }
+ return $count;
+}
+
+sub chan_kill($$;$) {
+ my ($chan, $reason, $tusers) = @_;
+ my $cn = $chan->{CHAN};
+ my $agent = agent($chan);
+ my $i;
+
+ enforcer_join($chan);
+ if ($tusers) {
+ foreach my $tuser (@$tusers) {
+ $tuser->{ID} = $tuser->{__ID} if defined($tuser->{__ID}); # user_join_multi does this.
+ nickserv::kline_user($tuser, services_conf_chankilltime, $reason)
+ unless adminserv::is_ircop($tuser) or adminserv::is_svsop($tuser, adminserv::S_HELP());
+ $i++;
+ }
+ }
+ else {
+ $get_chan_users->execute($cn);
+ while(my ($nick, $uid) = $get_chan_users->fetchrow_array) {
+ my $tuser = { NICK => $nick, ID => $uid, AGENT => $agent };
+ nickserv::kline_user($tuser, services_conf_chankilltime, $reason)
+ unless adminserv::is_ircop($tuser) or adminserv::is_svsop($tuser, adminserv::S_HELP());
+ $i++;
+ }
+ }
+
+ return $i;
+}
+
+sub do_nick_akick($$;$) {
+ my ($tuser, $chan, $root) = @_;
+ my $cn = $chan->{CHAN};
+ unless(defined($root)) {
+ (undef, $root) = get_best_acc($tuser, $chan, 2);
+ }
+
+ $get_nick_akick->execute($cn, $root);
+ my ($reason) = $get_nick_akick->fetchrow_array(); $get_nick_akick->finish();
+
+ return 0 if adminserv::is_svsop($tuser, adminserv::S_HELP());
+ kickban($chan, $tuser, undef, "User has been banned from ".$cn.($reason?": $reason":''));
+}
+
+sub do_status($$) {
+ my ($user, $chan) = @_;
+
+ return 0 if cr_chk_flag($chan, (CRF_CLOSE | CRF_DRONE));
+
+ my $uid = get_user_id($user);
+ my $nick = get_user_nick($user);
+ my $cn = $chan->{CHAN};
+
+ my ($acc, $root) = get_best_acc($user, $chan, 2);
+ if ($acc == -1) {
+ do_nick_akick($user, $chan, $root);
+ return 0;
+ }
+ unless(can_do($chan, 'JOIN', $user, { ACC => $acc })) {
+ kickban($chan, $user, undef, 'This is a private channel.');
+ return 0;
+ }
+
+ unless($acc or adminserv::is_svsop($user, adminserv::S_HELP()) ) {
+ $get_akick->execute($uid, $cn);
+ if(my @akick = $get_akick->fetchrow_array) {
+ akickban($cn, @akick);
+ return 0;
+ }
+ }
+
+ set_modes($user, $chan, $acc, cr_chk_flag($chan, CRF_SPLITOPS, 0))
+ if is_registered($chan)
+ and not is_neverop_user($user)
+ and not cr_chk_flag($chan, (CRF_CLOSE | CRF_DRONE | CRF_NEVEROP));
+
+ return 1;
+}
+
+sub akick_alluser($) {
+ my ($user) = @_;
+ my $uid = get_user_id($user);
+
+ $get_akick_alluser->execute($uid);
+ while(my @akick = $get_akick_alluser->fetchrow_array) {
+ akickban(@akick);
+ }
+}
+
+sub akick_allchan($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ $get_akick_allchan->execute($cn);
+ while(my @akick = $get_akick_allchan->fetchrow_array) {
+ akickban($cn, @akick);
+ }
+}
+
+sub akickban(@) {
+ my ($cn, $knick, $bnick, $ident, $host, $reason, $bident) = @_;
+
+ my $target = { NICK => $knick };
+ my $chan = { CHAN => $cn };
+ return 0 if adminserv::is_svsop($target, adminserv::S_HELP());
+
+ if($bident) {
+ ($bnick, $ident, $host) = make_hostmask(get_bantype($chan), $knick, $bident, $host);
+ } elsif($host =~ /^(\d{1,3}\.){3}\d{1,3}$/) {
+ ($bnick, $ident, $host) = make_hostmask(4, $knick, $bident, $host);
+ } else {
+ $bnick =~ tr/\%\_/\*\?/;
+ $ident =~ tr/\%\_/\*\?/;
+ $host =~ tr/\%\_/\*\?/;
+ }
+
+ return kickban($chan, $target, "$bnick!$ident\@$host", "User has been banned from ".$cn.($reason?": $reason":''));
+}
+
+sub notice_all_nicks($$$) {
+ my ($user, $nick, $msg) = @_;
+ my $src = get_user_nick($user);
+
+ notice($user, $msg);
+ foreach my $u (get_nick_user_nicks $nick) {
+ notice({ NICK => $u, AGENT => $csnick }, $msg) unless lc $src eq lc $u;
+ }
+}
+
+sub xop_byname($) {
+ my ($name) = @_;
+ my $level;
+
+ if($name =~ /^uop$/i) { $level=1; }
+ elsif($name =~ /^vop$/i) { $level=2; }
+ elsif($name =~ /^hop$/i) { $level=3; }
+ elsif($name =~ /^aop$/i) { $level=4; }
+ elsif($name =~ /^sop$/i) { $level=5; }
+ elsif($name =~ /^co?f(ounder)?$/i) { $level=6; }
+ elsif($name =~ /^founder$/i) { $level=7; }
+ elsif($name =~ /^(any|all|user)/i) { $level=0; }
+ elsif($name =~ /^akick$/i) { $level=-1; }
+ elsif($name =~ /^(none|disabled?|nobody)$/i) { $level=8; }
+
+ return $level;
+}
+
+sub expire {
+ return if services_conf_noexpire;
+
+ $get_expired->execute(time() - (86400 * services_conf_chanexpire));
+ while(my ($cn, $founder) = $get_expired->fetchrow_array) {
+ drop({ CHAN => $cn });
+ wlog($csnick, LOG_INFO(), "\002$cn\002 has expired. Founder: $founder");
+ }
+}
+
+sub enforcer_join($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+ my $bot = agent($chan);
+
+ return if $enforcers{lc $cn};
+ $enforcers{lc $cn} = lc $bot;
+
+ botserv::bot_join($chan);
+
+ add_timer("CSEnforce $bot $cn", 60, __PACKAGE__, 'chanserv::enforcer_part');
+}
+
+sub enforcer_part($) {
+ my ($cookie) = @_;
+ my ($junk, $bot, $cn) = split(/ /, $cookie);
+
+ return unless $enforcers{lc $cn};
+ undef($enforcers{lc $cn});
+
+ botserv::bot_part_if_needed($bot, {CHAN => $cn}, 'Enforcer Leaving');
+}
+
+sub fix_private_join_before_id($) {
+ my ($user) = @_;
+
+ my @cns;
+
+ $get_recent_private_chans->execute(get_user_id($user));
+ while(my ($cn) = $get_recent_private_chans->fetchrow_array) {
+ my $chan = { CHAN => $cn };
+ unban_user($chan, $user);
+ push @cns, $cn;
+ }
+
+ ircd::svsjoin($csnick, get_user_nick($user), @cns) if @cns;
+}
+
+### DATABASE UTILITY FUNCTIONS ###
+
+sub get_user_count($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ $get_user_count->execute($cn);
+
+ return $get_user_count->fetchrow_array;
+}
+
+sub get_lock($) {
+ my ($chan) = @_;
+
+ $chan = lc $chan;
+
+ $chanuser_table++;
+
+ if($cur_lock) {
+ if($cur_lock ne $chan) {
+ really_release_lock($chan);
+ $chanuser_table--;
+ die("Tried to get two locks at the same time: $cur_lock, $chan")
+ }
+ $cnt_lock++;
+ } else {
+ $cur_lock = $chan;
+ $get_lock->execute(sql_conf_mysql_db.".chan.$chan");
+ $get_lock->finish;
+ }
+}
+
+sub release_lock($) {
+ my ($chan) = @_;
+
+ $chan = lc $chan;
+
+ $chanuser_table--;
+
+ if($cur_lock and $cur_lock ne $chan) {
+ really_release_lock($cur_lock);
+
+ die("Tried to release the wrong lock");
+ }
+
+ if($cnt_lock) {
+ $cnt_lock--;
+ } else {
+ really_release_lock($chan);
+ }
+}
+
+sub really_release_lock($) {
+ my ($chan) = @_;
+
+ $cnt_lock = 0;
+ $release_lock->execute(sql_conf_mysql_db.".chan.$chan");
+ $release_lock->finish;
+ undef $cur_lock;
+}
+
+#sub is_free_lock($) {
+# $is_free_lock->execute($_[0]);
+# return $is_free_lock->fetchrow_array;
+#}
+
+sub get_modelock($) {
+ my ($chan) = @_;
+ my $cn;
+ if(ref($chan)) {
+ $cn = $chan->{CHAN}
+ } else {
+ $cn = $chan;
+ }
+
+ $get_modelock->execute($cn);
+ my ($ml) = $get_modelock->fetchrow_array;
+ $get_modelock->finish();
+ return $ml;
+}
+
+sub do_modelock($;$) {
+ my ($chan, $modes) = @_;
+ my $cn = $chan->{CHAN};
+
+ my $seq = $ircline;
+
+ $get_modelock_lock->execute; $get_modelock_lock->finish;
+
+ $get_chanmodes->execute($cn);
+ my ($omodes) = $get_chanmodes->fetchrow_array;
+ my $ml = get_modelock($chan);
+
+ $ml = do_modelock_fast($cn, $modes, $omodes, $ml);
+
+ $unlock_tables->execute; $unlock_tables->finish;
+
+ ircd::setmode(agent($chan), $cn, $ml) if($ml);
+}
+
+sub do_modelock_fast($$$$) {
+ my ($cn, $modes, $omodes, $ml) = @_;
+ my $nmodes = modes::add($omodes, $modes, 1);
+ $ml = modes::diff($nmodes, $ml, 1);
+ $set_chanmodes->execute(modes::add($nmodes, $ml, 1), $cn);
+
+ return $ml;
+}
+
+sub update_modes($$) {
+ my ($cn, $modes) = @_;
+
+ $get_update_modes_lock->execute; $get_update_modes_lock->finish;
+ $get_chanmodes->execute($cn);
+ my ($omodes) = $get_chanmodes->fetchrow_array;
+
+ $set_chanmodes->execute(modes::add($omodes, $modes, 1), $cn);
+ $unlock_tables->execute; $unlock_tables->finish;
+}
+
+sub is_level($) {
+ my ($perm) = @_;
+
+ $is_level->execute($perm);
+
+ return $is_level->fetchrow_array;
+}
+
+sub is_neverop($) {
+ return nr_chk_flag($_[0], NRF_NEVEROP(), 1);
+}
+
+sub is_neverop_user($) {
+ return nr_chk_flag_user($_[0], NRF_NEVEROP(), 1);
+}
+
+sub is_in_chan($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+ my $uid = get_user_id($user);
+
+ return (__is_in_chan($uid, $cn) ? 1 : 0);
+}
+
+sub is_registered($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ return (__is_registered($cn) ? 1 : 0);
+}
+
+sub get_user_chans($) {
+ my ($user) = @_;
+ my $uid = get_user_id($user);
+ my @chans;
+
+ $get_user_chans->execute($uid, $ircline, $ircline+1000);
+ while(my ($chan) = $get_user_chans->fetchrow_array) {
+ push @chans, $chan;
+ }
+
+ return (@chans);
+}
+
+sub get_user_chans_recent($) {
+ my ($user) = @_;
+ my $uid = get_user_id($user);
+ my (@curchans, @oldchans);
+
+ $get_user_chans_recent->execute($uid);
+ while(my ($cn, $joined, $op) = $get_user_chans_recent->fetchrow_array) {
+ if ($joined) {
+ push @curchans, make_op_prefix($op).$cn;
+ }
+ else {
+ push @oldchans, $cn;
+ }
+ }
+
+ return (\@curchans, \@oldchans);
+}
+
+my ($prefixes, $modes);
+sub make_op_prefix($) {
+ my ($op) = @_;
+ return unless $op;
+
+ unless(defined($prefixes) and defined($modes)) {
+ $IRCd_capabilities{PREFIX} =~ /^\((\S+)\)(\S+)$/;
+ ($modes, $prefixes) = ($1, $2);
+ $modes = reverse $modes;
+ $prefixes = reverse $prefixes;
+ }
+
+ my $op_prefix = '';
+ for(my $i = 0; $i < length($prefixes); $i++) {
+ $op_prefix = substr($prefixes, $i, 1).$op_prefix if ($op & (2**$i));
+ }
+ return $op_prefix;
+}
+
+sub get_op($$) {
+ my ($user, $chan) = @_;
+ my $cn = $chan->{CHAN};
+ my $uid = get_user_id($user);
+
+ $get_op->execute($uid, $cn);
+ my ($op) = $get_op->fetchrow_array;
+
+ return $op;
+}
+
+sub get_best_acc($$;$) {
+ my ($user, $chan, $retnick) = @_;
+ my $uid = get_user_id($user);
+ my $cn = $chan->{CHAN};
+
+ $get_best_acc->execute($uid, $cn);
+ my ($bnick, $best) = $get_best_acc->fetchrow_array;
+ $get_best_acc->finish();
+
+ if($retnick == 2) {
+ return ($best, $bnick);
+ } elsif($retnick == 1) {
+ return $bnick;
+ } else {
+ return $best;
+ }
+}
+
+sub get_acc($$) {
+ my ($nick, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ return undef
+ if cr_chk_flag($chan, (CRF_DRONE | CRF_CLOSE | CRF_FREEZE), 1);
+
+ $get_acc->execute($cn, $nick);
+ my ($acc) = $get_acc->fetchrow_array;
+
+ return $acc;
+}
+
+sub set_acc($$$$) {
+ my ($nick, $user, $chan, $level) = @_;
+ my $cn = $chan->{CHAN};
+ my $adder = get_best_acc($user, $chan, 1) if $user;
+
+ $set_acc1->execute($cn, $level, $nick);
+ $set_acc2->execute($level, $adder, $cn, $nick);
+
+ if ( ( $level > 0 and !is_neverop($nick) and !cr_chk_flag($chan, CRF_NEVEROP) )
+ or $level < 0)
+ {
+ set_modes_allnick($nick, $chan, $level);
+ }
+}
+
+sub del_acc($$) {
+ my ($nick, $chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ $del_acc->execute($cn, $nick);
+
+ foreach my $user (get_nick_users $nick) {
+ set_modes($user, $chan, 0, 1) if is_in_chan($user, $chan);
+ }
+}
+
+sub get_auth_nick($$) {
+ my ($cn, $nick) = @_;
+
+ $get_auth_nick->execute($cn, $nick);
+ my ($data) = $get_auth_nick->fetchrow_array();
+ $get_auth_nick->finish();
+
+ return split(/:/, $data);
+}
+sub get_auth_num($$) {
+ my ($cn, $num) = @_;
+
+ $get_auth_num->execute($cn, $num - 1);
+ my ($nick, $data) = $get_auth_num->fetchrow_array();
+ $get_auth_num->finish();
+
+ return ($nick, split(/:/, $data));
+}
+sub find_auth($$) {
+ my ($cn, $nick) = @_;
+
+ $find_auth->execute($cn, $nick);
+ my ($ret) = $find_auth->fetchrow_array();
+ $find_auth->finish();
+
+ return $ret;
+}
+
+# Only call this if you've checked the user for NEVEROP already.
+sub set_modes_allchan($;$) {
+ my ($user, $neverop) = @_;
+ my $uid = get_user_id($user);
+
+ $get_user_chans->execute($uid, $ircline, $ircline+1000);
+ while(my ($cn) = $get_user_chans->fetchrow_array) {
+ my $chan = { CHAN => $cn };
+ my $acc = get_best_acc($user, $chan);
+ if($acc > 0) {
+ set_modes($user, $chan, $acc) unless ($neverop or cr_chk_flag($chan, CRF_NEVEROP));
+ } elsif($acc < 0) {
+ do_nick_akick($user, $chan);
+ }
+ }
+}
+
+# Only call this if you've checked for NEVEROP already.
+sub set_modes_allnick($$$) {
+ my ($nick, $chan, $level) = @_;
+ my $cn = $chan->{CHAN};
+
+ $get_using_nick_chans->execute($nick, $cn);
+ while(my ($n) = $get_using_nick_chans->fetchrow_array) {
+ my $user = { NICK => $n };
+ my $l = get_best_acc($user, $chan);
+ if($l > 0) {
+ set_modes($user, $chan, $level, 1) if($level == $l);
+ } elsif($l < 0) {
+ do_nick_akick($user, $chan);
+ }
+ }
+}
+
+# If channel has OPGUARD, $doneg is true.
+sub set_modes($$$;$) {
+ my ($user, $chan, $acc, $doneg) = @_;
+ my $cn = $chan->{CHAN};
+
+
+ if ($acc < 0) {
+ # Do akick stuff here.
+ }
+
+ my $dst = $ops[$acc];
+ my $cur = get_op($user, $chan);
+ my ($pos, $neg);
+
+ if (cr_chk_flag($chan, CRF_FREEZE)) {
+ set_mode_mask($user, $chan, $cur, undef);
+ return;
+ }
+ if (($acc == 0) and cr_chk_flag($chan, CRF_AUTOVOICE)) {
+ set_mode_mask($user, $chan, $cur, 1);
+ return;
+ }
+
+ $pos = $dst ^ ($dst & $cur);
+ $neg = ($dst ^ $cur) & $cur if $doneg;
+
+ if($pos or $neg) {
+ set_mode_mask($user, $chan, $neg, $pos);
+ }
+
+ if($pos) {
+ set_lastop($cn);
+ set_lastused($cn, get_user_id($user));
+ }
+}
+
+sub unset_modes($$) {
+ my ($user, $chan) = @_;
+
+ my $mask = get_op($user, $chan);
+
+ set_mode_mask($user, $chan, $mask, 0);
+}
+
+sub set_mode_mask($$$$) {
+ my ($user, $chan, @masks) = @_;
+ my $nick = get_user_nick($user);
+ my $cn = $chan->{CHAN};
+ my (@args, $out);
+
+ for(my $sign; $sign < 2; $sign++) {
+ next if($masks[$sign] == 0);
+
+ $out .= '-' if $sign == 0;
+ $out .= '+' if $sign == 1;
+
+ for(my $i; $i < 5; $i++) {
+ my @l = ('v', 'h', 'o', 'a', 'q');
+
+ if($masks[$sign] & 2**$i) {
+ $out .= $l[$i];
+ push @args, $nick;
+ }
+ }
+ }
+
+ if(@args) {
+ ircd::setmode(agent($chan), $cn, $out, join(' ', @args));
+ }
+}
+
+sub get_level($$) {
+ my ($chan, $perm) = @_;
+ my $cn = $chan->{CHAN};
+
+ $get_level->execute($cn, $perm);
+ my ($level, $isnotnull) = $get_level->fetchrow_array;
+ $get_level->finish();
+
+ if (wantarray()) {
+ return ($level, $isnotnull);
+ }
+ else {
+ return $level;
+ }
+}
+
+sub check_override($$;$) {
+ my ($user, $perm, $logMsg) = @_;
+ $perm = uc $perm;
+
+ #{OVERRIDE::$perm} produces funny package problems, so wrap it in double-quotes.
+ if(exists($user->{"OVERRIDE::$perm"}) && (my $nick = $user->{"OVERRIDE::$perm"})) {
+ if(defined($nick)) {
+ if(services_conf_log_overrides && $logMsg) {
+ my $src = get_user_nick($user);
+ wlog($csnick, LOG_INFO(), "\002$src\002 used override $logMsg");
+ }
+ return (wantarray ? ($nick, 1) : $nick);
+ } else {
+ return;
+ }
+ }
+ foreach my $o (@override) {
+ my ($operRank, $permHashRef) = @$o;
+ if($permHashRef->{$perm} and my $nick = adminserv::can_do($user, $operRank)) {
+ $user->{"OVERRIDE::$perm"} = $nick;
+ if(services_conf_log_overrides && $logMsg) {
+ my $src = get_user_nick($user);
+ wlog($csnick, LOG_INFO(), "\002$src\002 used override $logMsg");
+ }
+ return (wantarray ? ($nick, 1) : $nick);
+ }
+ }
+ $user->{"OVERRIDE::$perm"} = undef;
+}
+
+sub can_do($$$;$) {
+ my ($chan, $perm, $user, $data) = @_;
+ $data = {} unless defined $data;
+ # $data is a hashref/struct
+ my $noreply = $data->{NOREPLY};
+ my $acc = $data->{ACC};
+ my $overrideMsg = $data->{OVERRIDE_MSG};
+
+ if(my $nick = __can_do($chan, $perm, $user, $acc)) {
+ # This is becoming increasingly complicated
+ # and checking if an override was used is becoming tricky.
+ # We had a case in cs_kick where an oper should be able to override +Q/$peace
+ # but cannot b/c they have regular access in that channel.
+ my (undef, $override) = check_override($user, $perm);
+ return (wantarray ? ($nick, $override) : $nick);
+ } elsif ( $user and adminserv::is_svsop($user, adminserv::S_HELP()) ) {
+ #set_lastused($cn, get_user_id($user));
+ my ($nick, $override) = check_override($user, $perm, $overrideMsg);
+ return (wantarray ? ($nick, $override) : $nick) if $override;
+ }
+ if($user and !$noreply) {
+ my $cn = $chan->{CHAN};
+ if (cr_chk_flag($chan, (CRF_CLOSE | CRF_DRONE))) {
+ notice($user, "\002$cn\002 is closed and cannot be used".
+ ((uc $perm eq 'INFO') ? ': '.get_close($chan) : '.'));
+ }
+ elsif(cr_chk_flag($chan, CRF_FREEZE)) {
+ notice($user, "\002$cn\002 is frozen and access suspended.");
+ }
+ else {
+ notice($user, "$cn: $err_deny");
+ }
+ }
+ return 0;
+}
+
+sub __can_do($$$;$) {
+ my ($chan, $perm, $user, $acc) = @_;
+ my $nick;
+ my $cn = $chan->{CHAN};
+ $perm = uc $perm;
+
+ my $level;
+ unless(exists($chan->{"PERM::$perm"})) {
+ $level = $chan->{"PERM::$perm"} = get_level($chan, $perm);
+ } else {
+ $level = $chan->{"PERM::$perm"};
+ }
+
+ unless(defined($acc)) {
+ unless (defined $user && ref($user) eq 'HASH') {
+ die "invalid __can_do call";
+ }
+ my $chanuser = $user->{lc $cn};
+ unless (defined($chanuser) && exists($chanuser->{ACC})) {
+ ($acc, $nick) = get_best_acc($user, $chan, 2);
+ ($chanuser->{ACC}, $chanuser->{ACCNICK}) = ($acc, $nick);
+ } else {
+ ($acc, $nick) = ($chanuser->{ACC}, $chanuser->{ACCNICK});
+ }
+ }
+ $nick = 1 unless $nick;
+
+ if($acc >= $level and !cr_chk_flag($chan, (CRF_CLOSE | CRF_FREEZE | CRF_DRONE))) {
+ set_lastused($cn, get_user_id($user)) if $user;
+ return (wantarray ? ($nick, 0) : $nick);
+ }
+
+ if(cr_chk_flag($chan, CRF_FREEZE) and ($perm eq 'JOIN')) {
+ return (wantarray ? ($nick, 0) : $nick);
+ }
+
+ return 0;
+}
+
+sub can_keep_op($$$$) {
+# This is a naïve implemenation using a loop.
+# If we ever do a more flexible version that further restricts how
+# LEVELS affect opguard, the loop will have to be unrolled.
+# --
+# Only call this if you've already checked opguard, as we do not check it here.
+# --
+# Remember, this isn't a permission check if someone is allowed to op someone [else],
+# rather this checks if the person being opped is allowed to keep/have it.
+ my ($user, $chan, $tuser, $opmode) = @_;
+ return 1 if $opmode eq 'v'; # why remove a voice?
+ my %permhash = (
+ 'q' => ['OWNER', 4],
+ 'a' => ['ADMIN', 3],
+ 'o' => ['OP', 2],
+ 'h' => ['HALFOP', 1],
+ 'v' => ['VOICE', 0]
+ );
+
+ my $self = (lc(get_user_nick($user)) eq lc(get_user_nick($tuser)));
+
+ #my ($level, $isnotnull) = get_level($chan, $permhash{$opmode}[1]);
+ my $level = get_level($chan, $permhash{$opmode}[0]);
+
+ foreach my $luser ($tuser, $user) {
+ # We check target first, as there seems no reason that
+ # someone who has access can't be opped by someone
+ # who technically doesn't.
+ return 1 if (adminserv::is_svsop($luser, adminserv::S_HELP()) and
+ check_override($luser, $permhash{$opmode}[0]));
+
+ my $acc = get_best_acc($luser, $chan);
+ return 1 if ($self and ($permhash{opmode}[2] + 2) <= $acc);
+
+ if($acc < $level) {
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+sub agent($) {
+ my ($chan) = @_;
+
+ return $chan->{AGENT} if($chan->{AGENT});
+
+ unless(initial_synced()) {
+ return $csnick;
+ }
+
+ $botserv::get_chan_bot->execute($chan->{CHAN});
+ my ($agent) = $botserv::get_chan_bot->fetchrow_array;
+
+ $agent = $csnick unless $agent;
+
+ return $chan->{AGENT} = $agent;
+}
+
+sub drop($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ undef($enforcers{lc $cn});
+ my $agent = agent($chan);
+ agent_part($agent, $cn, 'Channel dropped') unless (lc($agent) eq lc($csnick));
+ if (module::is_loaded('logserv')) {
+ eval { logserv::delchan(undef, $cn); }
+ }
+
+ $drop_acc->execute($cn);
+ $drop_lvl->execute($cn);
+ $del_close->execute($cn);
+ $drop_akick->execute($cn);
+ $drop_welcome->execute($cn);
+ $drop_chantext->execute($cn);
+ $drop_nicktext->execute($cn); # Leftover channel auths
+ $drop->execute($cn);
+ ircd::setmode($csnick, $cn, '-r');
+}
+
+sub drop_nick_chans($) {
+ my ($nick) = @_;
+
+ $delete_successors->execute($nick);
+
+ $get_nick_own_chans->execute($nick);
+ while(my ($cn) = $get_nick_own_chans->fetchrow_array) {
+ succeed_chan($cn, $nick);
+ }
+}
+
+sub succeed_chan($$) {
+ my ($cn, $nick) = @_;
+
+ $get_successor->execute($cn);
+ my ($suc) = $get_successor->fetchrow_array;
+
+ if($suc) {
+ $set_founder->execute($suc, $cn);
+ set_acc($suc, undef, {CHAN => $cn}, FOUNDER);
+ $del_successor->execute($cn);
+ } else {
+ drop({CHAN => $cn});
+ wlog($csnick, LOG_INFO(), "\002$cn\002 has been dropped due to expiry/drop of \002$nick\002");
+ }
+}
+
+sub get_close($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+ return undef unless cr_chk_flag($chan, CRF_CLOSE | CRF_DRONE);
+
+ $get_close->execute($cn);
+ my ($reason, $opnick, $time) = $get_close->fetchrow_array();
+ $get_close->finish();
+
+ $reason = "[$opnick ".gmtime2($time)."] - $reason";
+
+ return (wantarray ? ($reason, $opnick, $time) : $reason);
+}
+
+sub get_users_nochans(;$) {
+ my ($noid) = @_;
+ my @users;
+
+ if($noid) {
+ $get_users_nochans_noid->execute();
+ while (my ($usernick, $userid) = $get_users_nochans_noid->fetchrow_array()) {
+ push @users, { NICK => $usernick, ID => $userid };
+ }
+ $get_users_nochans_noid->finish();
+ }
+ else {
+ $get_users_nochans->execute();
+ while (my ($usernick, $userid) = $get_users_nochans->fetchrow_array()) {
+ push @users, { NICK => $usernick, ID => $userid };
+ }
+ $get_users_nochans->finish();
+ }
+
+ return @users;
+}
+
+sub get_bantype($) {
+ my ($chan) = @_;
+ my $cn = $chan->{CHAN};
+
+ unless (exists($chan->{BANTYPE})) {
+ $get_bantype->execute($cn);
+ ($chan->{BANTYPE}) = $get_bantype->fetchrow_array();
+ $get_bantype->finish();
+ }
+
+ return $chan->{BANTYPE};
+}
+
+sub memolog($$) {
+ my ($chan, $log) = @_;
+
+ my $level = get_level($chan, "MemoAccChange");
+ return if $level == 8; # 8 is 'disable'
+ $level = 1 if $level == 0;
+ memoserv::send_chan_memo($csnick, $chan, $log, $level);
+}
+
+sub get_ban_num($$) {
+ my ($chan, $num) = @_;
+ $get_ban_num->execute($chan->{CHAN}, $num-1);
+ my ($mask) = $get_ban_num->fetchrow_array();
+ $get_ban_num->finish();
+ return sql2glob($mask);
+}
+
+### IRC EVENTS ###
+
+sub user_join($$) {
+# Due to special casing of '0' this wrapper should be used
+# by anyone handling a JOIN (not SJOIN, it's a JOIN) event.
+# This is an RFC1459 requirement.
+ my ($nick, $cn) = @_;
+ my $user = { NICK => $nick };
+ my $chan = { CHAN => $cn };
+
+ if ($cn == 0) {
+ # This should be treated as a number
+ # Just in case we ever got passed '000', not that Unreal does.
+ # In C, you could check that chan[0] != '#' && chan[0] == '0'
+ user_part_multi($user, [ get_user_chans($user) ], 'Left all channels');
+ }
+ else {
+ user_join_multi($chan, [$user]);
+ }
+}
+
+sub handle_sjoin($$$$$$$) {
+ my ($server, $cn, $ts, $chmodes, $chmodeparms, $userarray, $banarray, $exceptarray) = @_;
+ my $chan = { CHAN => $cn };
+
+ if(synced()) {
+ chan_mode($server, $cn, $chmodes, $chmodeparms) if $chmodes;
+ } else {
+ update_modes($cn, "$chmodes $chmodeparms") if $chmodes;
+ }
+ user_join_multi($chan, $userarray) if scalar @$userarray;
+
+ foreach my $ban (@$banarray) {
+ process_ban($cn, $ban, $server, 0, 1);
+ }
+ foreach my $except (@$exceptarray) {
+ process_ban($cn, $except, $server, 128, 1);
+ }
+}
+
+sub user_join_multi($$) {
+ my ($chan, $users) = @_;
+ my $cn = $chan->{CHAN};
+ my $seq = $ircline;
+ my $multi_tradeoff = 2; # could use some synthetic-benchmark tuning
+
+ foreach my $user (@$users) {
+ $user->{__ID} = get_user_id($user);
+ unless (defined($user->{__ID})) {
+ # This does happen occasionally. it's a BUG.
+ # At least we have a diagnostic for it now.
+ # Normally we'd just get a [useless] warning from the SQL server
+ ircd::debug($user->{NICK}.' has a NULL user->{__ID} in user_join_multi('.$cn.', ...');
+ }
+ }
+
+ $get_joinpart_lock->execute; $get_joinpart_lock->finish;
+
+ $chan_create->execute($seq, $cn);
+
+ $get_user_count->execute($cn);
+ my ($count) = $get_user_count->fetchrow_array;
+
+ if(scalar(@$users) < $multi_tradeoff) {
+ foreach my $user (@$users) {
+ # see note above in get_user_id loop
+ if (defined($user->{__ID})) {
+ $chanjoin->execute($seq, $user->{__ID}, $cn, $user->{__OP});
+ }
+ }
+ }
+ else {
+ my $query = "REPLACE INTO chanuser (seq, nickid, chan, op, joined) VALUES ";
+ foreach my $user (@$users) {
+ # a join(',', list) would be nice but would involve preparing the list first.
+ # I think this will be faster.
+ if (defined($user->{__ID})) {
+ # see note above in get_user_id loop
+ $query .= '('.$dbh->quote($seq).','.
+ $dbh->quote($user->{__ID}).','.
+ $dbh->quote($cn).','.
+ $dbh->quote($user->{__OP}).', 1),';
+ }
+ }
+ $query =~ s/\,$//;
+ $dbh->do($query);
+ }
+
+ $unlock_tables->execute; $unlock_tables->finish;
+
+ my $bot = agent($chan);
+ foreach my $user (@$users) {
+ $user->{AGENT} = $bot;
+ }
+
+ if(initial_synced() and cr_chk_flag($chan, (CRF_CLOSE | CRF_DRONE))) {
+ my ($reason, $opnick, $time) = get_close($chan);
+ my $cmsg = "$cn is closed: $reason";
+ my $preenforce = $enforcers{lc $chan};
+
+ if (cr_chk_flag($chan, CRF_CLOSE)) {
+ kickban_multi($chan, $users, $cmsg);
+ }
+ elsif (cr_chk_flag($chan, CRF_DRONE)) {
+ chan_kill($chan, $cmsg, $users);
+ }
+
+ unless($preenforce) {
+ ircd::settopic($bot, $cn, $opnick, $time, $cmsg);
+
+ my $ml = get_modelock($chan);
+ ircd::setmode($bot, $cn, $ml) if($ml);
+ }
+ }
+
+ if(($count == 0 or !is_agent_in_chan($bot, $cn)) and initial_synced()) {
+ unless (lc($bot) eq lc($csnick)) {
+ unless(is_agent_in_chan($bot, $cn)) {
+ botserv::bot_join($chan);
+ }
+ }
+ }
+
+ return unless synced() and not cr_chk_flag($chan, (CRF_CLOSE | CRF_DRONE));
+
+ my $n;
+ foreach my $user (@$users) {
+ if(do_status($user, $chan)) {
+ $n++;
+ $user->{__DO_WELCOME} = 1;
+ }
+ }
+
+ if($count == 0 and $n) {
+ my ($ml) = get_modelock($chan);
+ ircd::setmode($bot, $cn, $ml) if($ml);
+
+ $get_topic->execute($cn);
+ my ($ntopic, $nsetter, $ntime) = $get_topic->fetchrow_array;
+ ircd::settopic($bot, $cn, $nsetter, $ntime, $ntopic) if $ntopic;
+ }
+
+ ircd::flushmodes();
+
+ if($n) {
+ foreach my $user (@$users) {
+ if ($user->{__DO_WELCOME} and chk_user_flag($user, UF_FINISHED())) {
+ do_welcome($user, $chan);
+ do_greet($user, $chan)
+ if can_do($chan, 'GREET', $user, { NOREPLY => 1 });
+ }
+ }
+ }
+}
+
+sub user_part($$$) {
+ my ($nick, $cn, $reason) = @_;
+
+ my $user = ( ref $nick eq 'HASH' ? $nick : { NICK => $nick });
+
+ user_part_multi($user, [ $cn ], $reason);
+}
+
+sub user_part_multi($$$) {
+# user_join_multi takes a channel and multiple users
+# user_part_multi takes a user and multiple channels
+# There should probably be a user_join_* that takes one user, multiple channels
+# However, it seems that so far, Unreal splits both PART and JOIN (non-SJOIN)
+# into multiple events/cmds. The reason is unclear.
+# Other ircds may not do so.
+# There is also KICK. some IRCds allow KICK #chan user1,user2,...
+# Unreal it's _supposed_ to work, but it does not.
+
+ my ($user, $chanlist, $reason) = @_;
+ my @chans;
+ foreach my $cn (@$chanlist) {
+ push @chans, { CHAN => $cn };
+
+ }
+
+ my $uid = get_user_id($user);
+ my $seq = $ircline;
+
+ $get_joinpart_lock->execute; $get_joinpart_lock->finish;
+
+ foreach my $chan (@chans) {
+ my $cn = $chan->{CHAN};
+ $chanpart->execute($seq, $uid, $cn, $seq, $seq+1000);
+ $get_user_count->execute($cn);
+ $chan->{COUNT} = $get_user_count->fetchrow_array;
+ }
+
+ $unlock_tables->execute; $unlock_tables->finish;
+
+ foreach my $chan (@chans) {
+ channel_emptied($chan) if $chan->{COUNT} == 0;
+ }
+}
+
+sub channel_emptied($) {
+ my ($chan) = @_;
+
+ botserv::bot_part_if_needed(undef, $chan, 'Nobody\'s here', 1);
+ $chan_delete->execute($chan->{CHAN});
+ $wipe_bans->execute($chan->{CHAN});
+}
+
+sub process_kick($$$$) {
+ my ($src, $cn, $target, $reason) = @_;
+ my $tuser = { NICK => $target };
+ user_part($tuser, $cn, 'Kicked by '.$src.' ('.$reason.')');
+
+ my $chan = { CHAN => $cn };
+ if ( !(is_agent($src) or $src =~ /\./ or adminserv::is_ircop({ NICK => $src })) and
+ ({modes::splitmodes(get_modelock($chan))}->{Q}->[0] eq '+') )
+ {
+ my $srcUser = { NICK => $src };
+ #ircd::irckill(agent($chan), $src, "War script detected (kicked $target past +Q in $cn)");
+ nickserv::kline_user($srcUser, 300, "War script detected (kicked $target past +Q in $cn)");
+ # SVSJOIN won't work while they're banned, unless you invite.
+ ircd::invite(agent($chan), $cn, $target);
+ ircd::svsjoin(undef, $target, $cn);
+ unban_user($chan, $tuser);
+ }
+}
+
+sub chan_mode($$$$) {
+ my ($src, $cn, $modes, $args) = @_;
+ my $user = { NICK => $src };
+ my $chan = { CHAN => $cn };
+ my ($sign, $num);
+
+ # XXX This is not quite right, but maybe it's good enough.
+ my $mysync = ($src =~ /\./ ? 0 : 1);
+
+ if($modes !~ /^[beIvhoaq+-]+$/ and (!synced() or $mysync)) {
+ do_modelock($chan, "$modes $args");
+ }
+
+ my $opguard = (!current_message->{SYNC} and cr_chk_flag($chan, CRF_OPGUARD, 1));
+
+ my @perms = ('VOICE', 'HALFOP', 'OP', 'PROTECT');
+ my $unmodes = '-';
+ my @unargs;
+
+ my @modes = split(//, $modes);
+ my @args = split(/ /, $args);
+
+ foreach my $mode (@modes) {
+ if($mode eq '+') { $sign = 1; next; }
+ if($mode eq '-') { $sign = 0; next; }
+
+ my $arg = shift(@args) if($mode =~ $scm or $mode =~ $ocm);
+ my $auser = { NICK => $arg };
+
+ if($mode =~ /^[vhoaq]$/) {
+ next if $arg eq '';
+ next if is_agent($arg);
+ $num = 0 if $mode eq 'v';
+ $num = 1 if $mode eq 'h';
+ $num = 2 if $mode eq 'o';
+ $num = 3 if $mode eq 'a';
+ $num = 4 if $mode eq 'q';
+
+ if($opguard and $sign == 1 and
+ !can_keep_op($user, $chan, $auser, $mode)
+ ) {
+ $unmodes .= $mode;
+ push @unargs, $arg;
+ } else {
+ my $nid = get_user_id($auser) or next;
+ my ($r, $i);
+ do {
+ if($sign) {
+ $r = $chop->execute((2**$num), (2**$num), $nid, $cn);
+ } else {
+ $r = $chdeop->execute((2**$num), (2**$num), $nid, $cn);
+ }
+ $i++;
+ } while($r==0 and $i<10);
+ }
+ }
+ if ($mode eq 'b') {
+ next if $arg eq '';
+ process_ban($cn, $arg, $src, 0, $sign);
+ }
+ if ($mode eq 'e') {
+ next if $arg eq '';
+ process_ban($cn, $arg, $src, 128, $sign);
+ }
+ if ($mode eq 'I') {
+ next;# if $arg eq '';
+ #process_ban($cn, $arg, $src, 128, $sign);
+ }
+ }
+ ircd::setmode(agent($chan), $cn, $unmodes, join(' ', @unargs)) if($opguard and @unargs);
+}
+
+sub process_ban($$$$) {
+ my ($cn, $arg, $src, $type, $sign) = @_;
+
+ $arg =~ tr/\*\?/\%\_/;
+
+ if ($sign > 0) {
+ $add_ban->execute($cn, $arg, $src, $type);
+ } else {
+ $delete_ban->execute($cn, $arg, $type);
+ }
+}
+
+sub chan_topic {
+ my ($src, $cn, $setter, $time, $topic) = @_;
+ my $chan = { CHAN => $cn };
+ my $suser = { NICK => $setter, AGENT => agent($chan) };
+
+ return if cr_chk_flag($chan, CRF_CLOSE, 1);
+
+ if(current_message->{SYNC}) { # We don't need to undo our own topic changes.
+ $set_topic1->execute($setter, $time, $cn);
+ $set_topic2->execute($cn, $topic);
+ return;
+ }
+
+ if(!synced()) {
+ $get_topic->execute($cn);
+ my ($ntopic, $nsetter, $ntime) = $get_topic->fetchrow_array;
+ if($topic ne '' and $time == $ntime or can_do($chan, 'SETTOPIC', undef)) {
+ $set_topic1->execute($setter, $time, $cn);
+ $set_topic2->execute($cn, $topic);
+ } else {
+ ircd::settopic(agent($chan), $cn, $nsetter, $ntime, $ntopic);
+ }
+ }
+
+ elsif(lc($src) ne lc($setter) or can_do($chan, 'SETTOPIC', $suser)) {
+ $set_topic1->execute($setter, $time, $cn);
+ $set_topic2->execute($cn, $topic);
+ } else {
+ $get_topic->execute($cn);
+ my ($ntopic, $nsetter, $ntime) = $get_topic->fetchrow_array;
+ ircd::settopic(agent($chan), $cn, $nsetter, $ntime, $ntopic);
+ }
+}
+
+sub eos(;$) {
+ my ($server) = @_;
+ my $gsa;
+
+ $get_all_closed_chans->execute(CRF_DRONE|CRF_CLOSE);
+ while(my ($cn, $type, $reason, $opnick, $time) = $get_all_closed_chans->fetchrow_array) {
+ my $chan = { CHAN => $cn };
+
+ my $cmsg = " is closed [$opnick ".gmtime2($time)."]: $reason";
+ if($type == CRF_DRONE) {
+ chan_kill($chan, $cn.$cmsg);
+ } else {
+ ircd::settopic(agent($chan), $cn, $opnick, $time, "Channel".$cmsg);
+ clear_users($chan, "Channel".$cmsg);
+ }
+ }
+
+ while($chanuser_table > 0) { }
+
+ $get_eos_lock->execute(); $get_eos_lock->finish;
+ $get_akick_all->execute();
+ if($server) {
+ $get_status_all_server->execute($server);
+ $gsa = $get_status_all_server;
+ } else {
+ $get_status_all->execute();
+ $gsa = $get_status_all;
+ }
+ #$unlock_tables->execute(); $unlock_tables->finish;
+
+ while(my @akick = $get_akick_all->fetchrow_array) {
+ akickban(@akick);
+ }
+
+ $get_modelock_all->execute();
+ while(my ($cn, $modes, $ml) = $get_modelock_all->fetchrow_array) {
+ $ml = do_modelock_fast($cn, '', $modes, $ml);
+ ircd::setmode(agent({CHAN=>$cn}), $cn, $ml) if $ml;
+ }
+
+ while(my ($cn, $cflags, $agent, $nick, $uid, $uflags, $level, $op, $neverop) = $gsa->fetchrow_array) {
+ my $user = { NICK => $nick, ID => $uid };
+ #next if chk_user_flag($user, UF_FINISHED);
+ $agent = $csnick unless $agent;
+ my $chan = { CHAN => $cn, FLAGS => $cflags, AGENT => $agent };
+
+ set_modes($user, $chan, $level, ($cflags & CRF_OPGUARD)) if not $neverop and $ops[$level] != $op and not $cflags & (CRF_FREEZE | CRF_CLOSE | CRF_DRONE);
+ do_welcome($user, $chan);
+ }
+
+ set_user_flag_all(UF_FINISHED());
+ $unlock_tables->execute(); $unlock_tables->finish;
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package hostserv;
+
+use strict;
+
+use SrSv::Text::Format qw(columnar);
+use SrSv::Errors;
+
+use SrSv::HostMask qw(parse_mask);
+
+use SrSv::User qw(get_user_nick get_user_id);
+use SrSv::User::Notice;
+use SrSv::Help qw( sendhelp );
+
+use SrSv::NickReg::Flags qw(NRF_NOHIGHLIGHT nr_chk_flag_user);
+use SrSv::NickReg::User qw(is_identified);
+
+use SrSv::MySQL '$dbh';
+use SrSv::MySQL::Glob;
+
+our $hsnick_default = 'HostServ';
+our $hsnick = $hsnick_default;
+
+our (
+ $set_vhost, $get_vhost, $del_vhost,
+ $vhost_chgroot,
+
+ $get_matching_vhosts
+);
+
+sub init() {
+ $set_vhost = $dbh->prepare("REPLACE INTO vhost SELECT id, ?, ?, ?, UNIX_TIMESTAMP() FROM nickreg WHERE nick=?");
+ $get_vhost = $dbh->prepare("SELECT vhost.ident, vhost.vhost FROM vhost, nickalias WHERE nickalias.nrid=vhost.nrid AND nickalias.alias=?");
+ $del_vhost = $dbh->prepare("DELETE FROM vhost USING vhost, nickreg WHERE nickreg.nick=? AND vhost.nrid=nickreg.id");
+
+ $get_matching_vhosts = $dbh->prepare("SELECT nickreg.nick, vhost.ident, vhost.vhost, vhost.adder, vhost.time FROM
+ vhost, nickreg WHERE vhost.nrid=nickreg.id AND nickreg.nick LIKE ? AND vhost.ident LIKE ? AND vhost.vhost LIKE ?
+ ORDER BY nickreg.nick");
+}
+
+sub dispatch($$$) {
+ my ($src, $dst, $msg) = @_;
+ $msg =~ s/^\s+//;
+ my @args = split(/\s+/, $msg);
+ my $cmd = shift @args;
+
+ my $user = { NICK => $src, AGENT => $dst };
+
+ return if operserv::flood_check($user);
+
+ if(lc $cmd eq 'on') {
+ hs_on($user, $src, 0);
+ }
+ elsif(lc $cmd eq 'off') {
+ hs_off($user);
+ }
+ elsif($cmd =~ /^(add|set(host))?$/i) {
+ if (@args == 2) {
+ hs_sethost($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: SETHOST <nick> <[ident@]vhost>');
+ }
+ }
+ elsif($cmd =~ /^del(ete)?$/i) {
+ if (@args == 1) {
+ hs_delhost($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: DELETE <nick>');
+ }
+ }
+ elsif($cmd =~ /^list$/i) {
+ if (@args == 1) {
+ hs_list($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: LIST <nick!vident@vhost>');
+ }
+ }
+ elsif($cmd =~ /^help$/i) {
+ sendhelp($user, 'hostserv', @args)
+ }
+ else { notice($user, "Unknown command."); }
+}
+
+sub hs_on($$;$) {
+ my ($user, $nick, $identify) = @_;
+ my $src = get_user_nick($user);
+
+ unless(nickserv::is_registered($nick)) {
+ notice($user, "Your nick, \002$nick\002, is not registered.");
+ return;
+ }
+
+ if(!$identify and !is_identified($user, $nick)) {
+ notice($user, "You are not identified to \002$nick\002.");
+ return;
+ }
+
+ $get_vhost->execute($nick);
+ my ($vident, $vhost) = $get_vhost->fetchrow_array;
+ unless ($vhost) {
+ notice($user, "You don't have a vHost.") unless $identify;
+ return;
+ }
+ if ($vident) {
+ ircd::chgident($hsnick, $src, $vident);
+ }
+ ircd::chghost($hsnick, $src, $vhost);
+
+ notice($user, "Your vHost has been changed to \002".($vident?"$vident\@":'')."$vhost\002");
+}
+
+sub hs_off($) {
+ my ($user) = @_;
+ my $src = get_user_nick($user);
+
+ # This requires a hack that is only known to work in UnrealIRCd 3.2.6 and later.
+ ircd::reset_cloakhost($hsnick, $src);
+
+ notice($user, "vHost reset to cloakhost.");
+}
+
+sub hs_sethost($$$) {
+ my ($user, $target, $vhost) = @_;
+ unless(adminserv::is_svsop($user, adminserv::S_OPER())) {
+ notice($user, $err_deny);
+ return;
+ }
+ my $rootnick = nickserv::get_root_nick($target);
+
+ unless ($rootnick) {
+ notice($user, "\002$target\002 is not registered.");
+ return;
+ }
+
+ my $vident = '';
+ if($vhost =~ /\@/) {
+ ($vident, $vhost) = split(/\@/, $vhost);
+ }
+ my $src = get_user_nick($user);
+ $set_vhost->execute($vident, $vhost, $src, $rootnick);
+
+ notice($user, "vHost for \002$target ($rootnick)\002 set to \002".($vident?"$vident\@":'')."$vhost\002");
+}
+
+sub hs_delhost($$) {
+ my ($user, $target) = @_;
+ unless(adminserv::is_svsop($user, adminserv::S_OPER())) {
+ notice($user, $err_deny);
+ return;
+ }
+ my $rootnick = nickserv::get_root_nick($target);
+
+ unless ($rootnick) {
+ notice($user, "\002$target\002 is not registered.");
+ return;
+ }
+
+ $del_vhost->execute($rootnick);
+
+ notice($user, "vHost for \002$target ($rootnick)\002 deleted.");
+}
+
+sub hs_list($$) {
+ my ($user, $mask) = @_;
+
+ unless(adminserv::is_svsop($user, adminserv::S_HELP())) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ my ($mnick, $mident, $mhost) = glob2sql(parse_mask($mask));
+
+ $mnick = '%' if($mnick eq '');
+ $mident = '%' if($mident eq '');
+ $mhost = '%' if($mhost eq '');
+
+ my @data;
+ $get_matching_vhosts->execute($mnick, $mident, $mhost);
+ while(my ($rnick, $vident, $vhost) = $get_matching_vhosts->fetchrow_array) {
+ push @data, [$rnick, ($vident?"$vident\@":'').$vhost];
+ }
+
+ notice($user, columnar({TITLE => "vHost list matching \002$mask\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data));
+}
+
+
+### MISCELLANEA ###
+
+
+
+## IRC EVENTS ##
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package memoserv;
+
+use strict;
+use DBI qw(:sql_types);
+#use constant {
+# READ => 1,
+# DEL => 2,
+# ACK => 4,
+# NOEXP => 8
+#};
+
+use SrSv::Agent qw(is_agent);
+
+use SrSv::Time;
+use SrSv::Text::Format qw(columnar);
+use SrSv::Errors;
+
+use SrSv::User qw(get_user_nick get_user_id);
+use SrSv::User::Notice;
+use SrSv::Help qw( sendhelp );
+
+use SrSv::NickReg::Flags;
+use SrSv::NickReg::User qw(is_identified get_nick_user_nicks);
+
+use SrSv::MySQL '$dbh';
+
+use SrSv::Util qw( makeSeqList );
+
+use constant (
+ MAX_MEMO_LEN => 400
+);
+
+our $msnick_default = 'MemoServ';
+our $msnick = $msnick_default;
+
+our (
+ $send_memo, $send_chan_memo, $get_chan_recipients,
+
+ $get_memo_list,
+
+ $get_memo, $get_memo_full, $get_memo_count, $get_unread_memo_count,
+
+ $set_flag,
+
+ $delete_memo, $purge_memos, $delete_all_memos,
+ $memo_chgroot,
+
+ $add_ignore, $get_ignore_num, $del_ignore_nick, $list_ignore, $chk_ignore,
+ $wipe_ignore, $purge_ignore,
+);
+
+sub init() {
+ $send_memo = $dbh->prepare("INSERT INTO memo SELECT ?, id, NULL, UNIX_TIMESTAMP(), NULL, ? FROM nickreg WHERE nick=?");
+ $send_chan_memo = $dbh->prepare("INSERT INTO memo SELECT ?, nickreg.id, ?, ?, NULL, ? FROM chanacc, nickreg
+ WHERE chanacc.chan=? AND chanacc.level >= ? AND chanacc.nrid=nickreg.id
+ AND !(nickreg.flags & ". NRF_NOMEMO() . ")");
+ $get_chan_recipients = $dbh->prepare("SELECT user.nick FROM user, nickid, nickreg, chanacc WHERE
+ user.id=nickid.id AND nickid.nrid=chanacc.nrid AND chanacc.nrid=nickreg.id AND chanacc.chan=?
+ AND level >= ? AND
+ !(nickreg.flags & ". NRF_NOMEMO() . ")");
+
+ $get_memo_list = $dbh->prepare("SELECT memo.src, memo.chan, memo.time, memo.flag, memo.msg FROM memo, nickreg WHERE nickreg.nick=? AND memo.dstid=nickreg.id ORDER BY memo.time ASC");
+
+ $get_memo = $dbh->prepare("SELECT memo.src, memo.chan, memo.time
+ FROM memo JOIN nickreg ON (memo.dstid=nickreg.id) WHERE nickreg.nick=? ORDER BY memo.time ASC LIMIT 1 OFFSET ?");
+ $get_memo->bind_param(2, 0, SQL_INTEGER);
+ $get_memo_full = $dbh->prepare("SELECT memo.src, memo.chan, memo.time, memo.flag, memo.msg FROM memo, nickreg WHERE nickreg.nick=? AND memo.dstid=nickreg.id ORDER BY memo.time ASC LIMIT 1 OFFSET ?");
+ $get_memo_full->bind_param(2, 0, SQL_INTEGER);
+ $get_memo_count = $dbh->prepare("SELECT COUNT(*) FROM memo, nickreg WHERE nickreg.nick=? AND memo.dstid=nickreg.id");
+ $get_unread_memo_count = $dbh->prepare("SELECT COUNT(*) FROM memo, nickreg WHERE nickreg.nick=? AND memo.dstid=nickreg.id AND memo.flag=0");
+
+ $set_flag = $dbh->prepare("UPDATE memo, nickreg SET memo.flag=? WHERE memo.src=? AND nickreg.nick=? AND memo.dstid=nickreg.id AND memo.chan=? AND memo.time=?");
+
+ $delete_memo = $dbh->prepare("DELETE FROM memo USING memo, nickreg WHERE memo.src=? AND nickreg.nick=? AND memo.dstid=nickreg.id AND memo.chan=? AND memo.time=?");
+ $purge_memos = $dbh->prepare("DELETE FROM memo USING memo, nickreg WHERE nickreg.nick=? AND memo.dstid=nickreg.id AND memo.flag=1");
+ $delete_all_memos = $dbh->prepare("DELETE FROM memo USING memo, nickreg WHERE nickreg.nick=? AND memo.dstid=nickreg.id");
+
+ $add_ignore = $dbh->prepare("INSERT INTO ms_ignore (ms_ignore.nrid, ms_ignore.ignoreid, time)
+ SELECT nickreg.id, ignorenick.id, UNIX_TIMESTAMP() FROM nickreg, nickreg AS ignorenick
+ WHERE nickreg.nick=? AND ignorenick.nick=?");
+ $del_ignore_nick = $dbh->prepare("DELETE FROM ms_ignore USING ms_ignore
+ JOIN nickreg ON (ms_ignore.nrid=nickreg.id)
+ JOIN nickreg AS ignorenick ON(ms_ignore.ignoreid=ignorenick.id)
+ WHERE nickreg.nick=? AND ignorenick.nick=?");
+ $get_ignore_num = $dbh->prepare("SELECT ignorenick.nick FROM ms_ignore
+ JOIN nickreg ON (ms_ignore.nrid=nickreg.id)
+ JOIN nickreg AS ignorenick ON(ms_ignore.ignoreid=ignorenick.id)
+ WHERE nickreg.nick=?
+ ORDER BY ms_ignore.time LIMIT 1 OFFSET ?");
+ $get_ignore_num->bind_param(2, 0, SQL_INTEGER);
+
+ $list_ignore = $dbh->prepare("SELECT ignorenick.nick, ms_ignore.time
+ FROM ms_ignore, nickreg, nickreg AS ignorenick
+ WHERE nickreg.nick=? AND ms_ignore.nrid=nickreg.id AND ms_ignore.ignoreid=ignorenick.id
+ ORDER BY ms_ignore.time");
+ $chk_ignore = $dbh->prepare("SELECT 1
+ FROM ms_ignore, nickreg, nickreg AS ignorenick
+ WHERE nickreg.nick=? AND ms_ignore.nrid=nickreg.id AND ignorenick.nick=? AND ms_ignore.ignoreid=ignorenick.id");
+
+ $wipe_ignore = $dbh->prepare("DELETE FROM ms_ignore USING ms_ignore JOIN nickreg ON(ms_ignore.nrid=nickreg.id) WHERE nickreg.nick=?");
+ $purge_ignore = $dbh->prepare("DELETE FROM ms_ignore USING ms_ignore JOIN nickreg ON(ms_ignore.ignoreid=nickreg.id) WHERE nickreg.nick=?");
+}
+
+### MEMOSERV COMMANDS ###
+
+sub dispatch($$$) {
+ my ($src, $dst, $msg) = @_;
+ $msg =~ s/^\s+//;
+ my @args = split(/\s+/, $msg);
+ my $cmd = shift @args;
+
+ my $user = { NICK => $src, AGENT => $dst };
+
+ return if operserv::flood_check($user);
+
+ if($cmd =~ /^send$/i) {
+ if(@args >= 2) {
+ my @args = split(/\s+/, $msg, 3);
+ ms_send($user, $args[1], $args[2], 0);
+ } else {
+ notice($user, 'Syntax: SEND <recipient> <message>');
+ }
+ }
+ elsif($cmd =~ /^csend$/i) {
+ if(@args >= 3 and $args[1] =~ /^(?:[uvhas]op|co?f(ounder)?|founder)$/i) {
+ my @args = split(/\s+/, $msg, 4);
+ my $level = chanserv::xop_byname($args[2]);
+ ms_send($user, $args[1], $args[3], $level);
+ } else {
+ notice($user, 'Syntax: CSEND <recipient> <uop|vop|hop|aop|sop|cf|founder> <message>');
+ }
+ }
+ elsif($cmd =~ /^read$/i) {
+ if(@args == 1 and (lc($args[0]) eq 'last' or $args[0] > 0)) {
+ ms_read($user, $args[0]);
+ } else {
+ notice($user, 'Syntax: READ <num|LAST>');
+ }
+ }
+ elsif($cmd =~ /^list$/i) {
+ ms_list($user);
+ }
+ elsif($cmd =~ /^del(ete)?$/i) {
+ if(@args >= 1 and (lc($args[0]) eq 'all' or $args[0] > 0)) {
+ ms_delete($user, $args[0]);
+ } else {
+ notice($user, 'Syntax: DELETE <num|num1-num2|ALL>');
+ }
+ }
+ elsif($cmd =~ /^ign(ore)?$/i) {
+ my $cmd2 = shift @args;
+ if($cmd2 =~ /^a(dd)?$/i) {
+ if(@args == 1) {
+ ms_ignore_add($user, $args[0]);
+ }
+ else {
+ notice($user, 'Syntax: IGNORE ADD <nick>');
+ }
+ }
+ elsif($cmd2 =~ /^d(el)?$/i) {
+ if(@args == 1) {
+ ms_ignore_del($user, $args[0]);
+ }
+ else {
+ notice($user, 'Syntax: IGNORE DEL [nick|num]');
+ }
+ }
+ elsif($cmd2 =~ /^l(ist)?$/i) {
+ ms_ignore_list($user);
+ }
+ else {
+ notice($user, 'Syntax: IGNORE <ADD|DEL|LIST> [nick|num]');
+ }
+ }
+ elsif($cmd =~ /^help$/i) {
+ sendhelp($user, 'memoserv', @args);
+ }
+ else {
+ notice($user, "Unrecognized command. For help, type: \002/ms help\002");
+ }
+}
+
+sub ms_send($$$$) {
+ my ($user, $dst, $msg, $level) = @_;
+ my $src = get_user_nick($user);
+
+ my $root = auth($user) or return;
+
+ if(length($msg) > MAX_MEMO_LEN()) {
+ notice($user, 'Memo too long. Maximum memo length is '.MAX_MEMO_LEN().' characters.');
+ return;
+ }
+
+ if($dst =~ /^#/) {
+ my $chan = { CHAN => $dst };
+ unless(chanserv::is_registered($chan)) {
+ notice($user, "$dst is not registered");
+ return;
+ }
+
+ my $srcnick = chanserv::can_do($chan, 'MEMO', $user) or return;
+
+ send_chan_memo($srcnick, $chan, $msg, $level);
+ } else {
+ nickserv::chk_registered($user, $dst) or return;
+
+ if (nr_chk_flag($dst, NRF_NOMEMO(), +1)) {
+ notice($user, "\002$dst\002 is not accepting memos.");
+ return;
+ }
+ $chk_ignore->execute(nickserv::get_root_nick($dst), $root);
+ if ($chk_ignore->fetchrow_array) {
+ notice($user, "\002$dst\002 is not accepting memos.");
+ return;
+ }
+
+ send_memo($src, $dst, $msg);
+ }
+
+ notice($user, "Your memo has been sent.");
+}
+
+sub ms_read($$) {
+ my ($user, $num) = @_;
+ my ($from, $chan, $time, $flag, $msg);
+ my $src = get_user_nick($user);
+
+ my $root = auth($user) or return;
+
+ my @nums;
+ if(lc($num) eq 'last') {
+ $get_memo_count->execute($root);
+ ($num) = $get_memo_count->fetchrow_array;
+ if (!$num) {
+ notice($user, "Memo \002$num\002 not found.");
+ return;
+ }
+ @nums = ($num);
+ } else {
+ @nums = makeSeqList($num);
+ }
+
+ my $count = 0;
+ my @reply;
+ while (my $num = shift @nums) {
+ if (++$count > 5) {
+ push @reply, "You can only read 5 memos at a time.";
+ last;
+ }
+ $get_memo_full->execute($root, $num-1);
+ unless(($from, $chan, $time, $flag, $msg) = $get_memo_full->fetchrow_array) {
+ push @reply, "Memo \002$num\002 not found.";
+ next;
+ }
+ $set_flag->execute(1, $from, $root, $chan, $time);
+ push @reply, "Memo \002$num\002 from \002$from\002 ".
+ ($chan ? "to \002$chan\002 " : "to \002$root\002 ").
+ "at ".gmtime2($time), ' ', ' '.$msg, ' --';
+ }
+ notice($user, @reply);
+}
+
+sub ms_list($) {
+ my ($user) = @_;
+ my ($i, @data, $mnlen, $mclen);
+ my $src = get_user_nick($user);
+
+ my $root = auth($user) or return;
+
+ $get_memo_list->execute($root);
+ while(my ($from, $chan, $time, $flag, $msg) = $get_memo_list->fetchrow_array) {
+ $i++;
+
+ push @data, [
+ ($flag ? '' : "\002") . $i,
+ $from, $chan, gmtime2($time),
+ (length($msg) > 20 ? substr($msg, 0, 17) . '...' : $msg)
+ ];
+ }
+
+ unless(@data) {
+ notice($user, "You have no memos.");
+ return;
+ }
+
+ notice($user, columnar( { TITLE => "Memo list for \002$root\002. To read, type \002/ms read <num>\002",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT) }, @data));
+}
+
+sub ms_delete($@) {
+ my ($user, @args) = @_;
+ my $src = get_user_nick($user);
+
+ my $root = auth($user) or return;
+
+ if(scalar(@args) == 1 and lc($args[0]) eq 'all') {
+ $delete_all_memos->execute($root);
+ notice($user, 'All of your memos have been deleted.');
+ return;
+ }
+ my (@deleted, @notDeleted);
+ foreach my $num (reverse makeSeqList(@args)) {
+ if(int($num) ne $num) { # can this happen, given makeSeqList?
+ notice($user, "\002$num\002 is not an integer number");
+ next;
+ }
+ my ($from, $chan, $time);
+ $get_memo->execute($root, $num-1);
+ if(my ($from, $chan, $time) = $get_memo->fetchrow_array) {
+ $delete_memo->execute($from, $root, $chan, $time);
+ push @deleted, $num;
+ } else {
+ push @notDeleted, $num;
+ }
+ }
+ if(scalar(@deleted)) {
+ my $plural = (scalar(@deleted) == 1);
+ my $msg = sprintf("Memo%s deleted: ".join(', ', @deleted), ($plural ? '' : 's'));
+ notice($user, $msg);
+ }
+ if(scalar(@notDeleted)) {
+ my $msg = sprintf("Memos not found: ".join(', ', @notDeleted));
+ notice($user, $msg);
+ }
+}
+
+sub ms_ignore_add($$) {
+ my ($user, $nick) = @_;
+ my $src = get_user_nick($user);
+
+ unless(is_identified($user, $src) or adminserv::can_do($user, 'SERVOP')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ my $nickroot = nickserv::get_root_nick($nick);
+ unless ($nickroot) {
+ notice($user, "$nick is not registered");
+ return;
+ }
+
+ my $srcroot = nickserv::get_root_nick($src);
+
+ $add_ignore->execute($srcroot, $nickroot);
+
+ notice($user, "\002$nick\002 (\002$nickroot\002) added to \002$src\002 (\002$srcroot\002) memo ignore list.");
+}
+
+sub ms_ignore_del($$) {
+ my ($user, $entry) = @_;
+ my $src = get_user_nick($user);
+
+ unless(is_identified($user, $src) or adminserv::can_do($user, 'SERVOP')) {
+ notice($user, $err_deny);
+ return;
+ }
+ my $srcroot = nickserv::get_root_nick($src);
+
+ my $ignorenick;
+ if (misc::isint($entry)) {
+ $get_ignore_num->execute($srcroot, $entry - 1);
+ ($ignorenick) = $get_ignore_num->fetchrow_array();
+ $get_ignore_num->finish();
+ }
+ my $ret = $del_ignore_nick->execute($srcroot, ($ignorenick ? $ignorenick : $entry));
+ if($ret == 1) {
+ notice($user, "Delete succeeded for ($srcroot): $entry");
+ }
+ else {
+ notice($user, "Delete failed for ($srcroot): $entry. entry does not exist?");
+ }
+}
+
+sub ms_ignore_list($) {
+ my ($user) = @_;
+ my $src = get_user_nick($user);
+
+ unless(is_identified($user, $src) or adminserv::can_do($user, 'SERVOP')) {
+ notice($user, $err_deny);
+ return;
+ }
+ my $srcroot = nickserv::get_root_nick($src);
+
+ my @data;
+ $list_ignore->execute($srcroot);
+ while (my ($nick, $time) = $list_ignore->fetchrow_array) {
+ push @data, [$nick, '('.gmtime2($time).')'];
+ }
+
+ notice($user, columnar({TITLE => "Memo ignore list for \002$src\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data));
+}
+
+sub notify($;$) {
+ my ($user, $root) = @_;
+ my (@nicks);
+
+ unless(ref($user)) {
+ $user = { NICK => $user };
+ }
+
+ if($root) { @nicks = ($root) }
+ else { @nicks = nickserv::get_id_nicks($user) }
+
+ my $hasmemos;
+ foreach my $n (@nicks) {
+ $get_unread_memo_count->execute($n);
+ my ($c) = $get_unread_memo_count->fetchrow_array;
+ next unless $c;
+ notice($user, "You have \002$c\002 unread memo(s). " . (@nicks > 1 ? "(\002$n\002) " : ''));
+ $hasmemos = 1;
+ }
+
+ notice($user, "To view them, type: \002/ms list\002") if $hasmemos;
+}
+
+### DATABASE UTILITY FUNCTIONS ###
+
+sub send_memo($$$) {
+ my ($src, $dst, $msg) = @_;
+
+ # This construct is intended to allow agents to send memos.
+ # Unfortunately this is raceable against %nickserv::enforcers.
+ # I don't want to change the %nickserv::enforcers decl tho, s/my/our/
+ $src = (is_agent($src) ? $src : nickserv::get_root_nick($src));
+ $dst = nickserv::get_root_nick($dst);
+
+ $send_memo->execute($src, $msg, $dst);
+ notice_all_nicks($dst, "You have a new memo from \002$src\002. To read it, type: \002/ms read last\002");
+}
+
+sub send_chan_memo($$$$) {
+ my ($src, $chan, $msg, $level) = @_;
+ my $cn = $chan->{CHAN};
+ $src = (is_agent($src) ? $src : nickserv::get_root_nick($src));
+
+ $send_chan_memo->execute($src, $cn, time(), $msg, $cn, $level);
+ # "INSERT INTO memo SELECT ?, nick, ?, ?, 0, ? FROM chanacc WHERE chan=? AND level >= ?"
+
+ $get_chan_recipients->execute($cn, $level);
+ while(my ($u) = $get_chan_recipients->fetchrow_array) {
+ notice({ NICK => $u, AGENT => $msnick },
+ "You have a new memo from \002$src\002 to \002$cn\002. To read it, type: \002/ms read last\002");
+ }
+}
+
+sub notice_all_nicks($$) {
+ my ($nick, $msg) = @_;
+
+ foreach my $u (get_nick_user_nicks $nick) {
+ notice({ NICK => $u, AGENT => $msnick }, $msg);
+ }
+}
+
+sub auth($) {
+ my ($user) = @_;
+ my $src = get_user_nick($user);
+
+ my $root = nickserv::get_root_nick($src);
+ unless($root) {
+ notice($user, "Your nick is not registered.");
+ return 0;
+ }
+
+ unless(is_identified($user, $root)) {
+ notice($user, $err_deny);
+ return 0;
+ }
+
+ return $root;
+}
+
+### IRC EVENTS ###
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package nickserv;
+
+use strict;
+use Time::Local;
+use DBI qw(:sql_types);
+
+use SrSv::Timer qw(add_timer);
+use SrSv::IRCd::State qw($ircline synced initial_synced %IRCd_capabilities);
+use SrSv::Agent;
+use SrSv::Conf qw(main services);
+use SrSv::Conf2Consts qw(main services sql);
+use SrSv::HostMask qw(normalize_hostmask hostmask_to_regexp parse_mask parse_hostmask make_hostmask);
+
+use SrSv::MySQL '$dbh';
+use SrSv::MySQL::Glob;
+
+use SrSv::Shared qw(%newuser %olduser);
+
+use SrSv::Time;
+use SrSv::Text::Format qw(columnar);
+use SrSv::Errors;
+
+use SrSv::Log;
+
+use SrSv::User '/./';
+use SrSv::User::Notice;
+use SrSv::Help qw( sendhelp );
+
+use SrSv::NickReg::Flags;
+use SrSv::NickReg::User '/./';
+use SrSv::Hash::Passwords;
+
+use SrSv::NickControl::Enforcer qw(%enforcers);
+
+use SrSv::Email;
+
+use SrSv::Util qw( makeSeqList );
+
+require SrSv::MySQL::Stub;
+
+use SrSv::NickServ;
+
+use constant {
+ # Clone exception max limit.
+ # This number typically means infinite/no-limit.
+ # It is 2**24-1
+ MAX_LIM => 16777215,
+
+ OLD_USER_AGE => 300,
+
+ NTF_QUIT => 1,
+ NTF_GREET => 2,
+ NTF_JOIN => 3,
+ NTF_AUTH => 4,
+ NTF_UMODE => 5,
+ NTF_VACATION => 6,
+ NTF_AUTHCODE => 7,
+ NTF_PROFILE => 8,
+
+ # This could be made a config option
+ # But our config system currently sucks.
+ MAX_PROFILE => 10,
+ # This value likely cannot be increased very far
+ # as the following limits would apply:
+ # 106 (nick/hostmask), 6 (NOTICE), 30 (destination-nick), 32 (key length) = 174
+ # 510 - 174 = 336
+ # but this does not take into account additional spaces/colons
+ # or reformatting by the SrSv::Format code.
+ # Likely the maximum value is ~300
+ MAX_PROFILE_LEN => 250,
+};
+
+#our $nsnick_default = 'NickServ';
+#our $nsnick = $nsnick_default;
+
+our $cur_lock;
+our $cnt_lock = 0;
+
+our @protect_short = ('none', 'normal', 'high', 'kill');
+our @protect_long = (
+ 'You will not be required to identify to use this nick.',
+ 'You must identify within 60 seconds to use this nick.',
+ 'You must identify before using this nick.',
+ 'You must identify before using this nick or you will be disconnected.'
+);
+our %protect_level = (
+ 'none' => 0,
+ 'no' => 0,
+ 'false' => 0,
+ 'off' => 0,
+ '0' => 0,
+
+ 'true' => 1,
+ 'yes' => 1,
+ 'on' => 1,
+ 'normal' => 1,
+ '1' => 1,
+
+ 'high' => 2,
+ '2' => 2,
+
+ 'kill' => 3,
+ '3' => 3
+);
+
+our (
+ $nick_check,
+ $nick_create, $nick_create_old, $nick_change, $nick_quit, $nick_delete, $nick_id_delete,
+ $get_quit_empty_chans, $nick_chan_delete, $chan_user_partall,
+ $get_hostless_nicks,
+
+ $get_squit_lock, $squit_users, $squit_nickreg, $get_squit_empty_chans, $squit_lastquit,
+
+ $del_nickchg_id, $add_nickchg, $reap_nickchg,
+
+ $get_nick_inval, $inc_nick_inval,
+ $is_alias_of,
+
+ $get_guest, $set_guest,
+
+ $get_lock, $release_lock,
+
+ $get_umodes, $set_umodes,
+
+ $get_info,
+ $set_vhost, $set_ident, $set_ip,
+ $update_regnick_vhost, $get_regd_time, $get_nickreg_quit,
+
+ $chk_clone_except, $count_clones,
+
+ $set_pass,
+ $set_email,
+
+ $get_root_nick, $get_id_nick, $chk_pass, $identify, $identify_ign, $id_update, $logout, $unidentify, $unidentify_single,
+ $update_lastseen, $quit_update, $update_nickalias_last,
+ $set_protect_level,
+
+ $get_register_lock, $register, $create_alias, $drop, $change_root,
+
+ $get_aliases, $get_glist, $count_aliases, $get_random_alias, $delete_alias, $delete_aliases,
+ $get_all_access, $del_all_access, $change_all_access, $change_akicks, $change_founders,
+ $change_successors, $change_svsops,
+
+ $lock_user_table, $unlock_tables,
+
+ $get_matching_nicks,
+
+ $cleanup_nickid, $cleanup_users, $cleanup_chanuser,
+ $get_expired, $get_near_expired, $set_near_expired,
+
+ $get_watches, $check_watch, $set_watch, $del_watch, $drop_watch,
+ $get_silences, $check_silence, $set_silence, $del_silence, $drop_silence,
+ $get_silence_by_num,
+ $get_expired_silences, $del_expired_silences,
+
+ $get_seen,
+
+ $set_greet, $get_greet, $get_greet_nick, $del_greet,
+ $get_num_nicktext_type, $drop_nicktext,
+
+ $get_auth_chan, $get_auth_num, $del_auth, $list_auth, $add_auth,
+
+ $del_nicktext,
+
+ $set_umode_ntf, $get_umode_ntf,
+
+ $set_vacation_ntf, $get_vacation_ntf,
+
+ $set_authcode_ntf, $get_authcode_ntf,
+);
+
+sub init() {
+ $nick_check = $dbh->prepare("SELECT id FROM user WHERE nick=? AND online=0 AND time=?");
+ $nick_create = $dbh->prepare("INSERT INTO user SET nick=?, time=?, inval=0, ident=?, host=?, vhost=?, server=?, modes=?,
+ gecos=?, flags=?, cloakhost=?, online=1");
+# $nick_create = $dbh->prepare("INSERT INTO user SET id=(RAND()*294967293)+1, nick=?, time=?, inval=0, ident=?, host=?, vhost=?, server=?, modes=?, gecos=?, flags=?, cloakhost=?, online=1");
+ $nick_create_old = $dbh->prepare("UPDATE user SET nick=?, ident=?, host=?, vhost=?, server=?, modes=?, gecos=?,
+ flags=?, cloakhost=?, online=1 WHERE id=?");
+ $nick_change = $dbh->prepare("UPDATE user SET nick=?, time=? WHERE nick=?");
+ $nick_quit = $dbh->prepare("UPDATE user SET online=0, quittime=UNIX_TIMESTAMP() WHERE nick=?");
+ $nick_delete = $dbh->prepare("DELETE FROM user WHERE nick=?");
+ $nick_id_delete = $dbh->prepare("DELETE FROM nickid WHERE id=?");
+ $get_quit_empty_chans = $dbh->prepare("SELECT cu2.chan, COUNT(*) AS c
+ FROM chanuser AS cu1, chanuser AS cu2
+ WHERE cu1.nickid=?
+ AND cu1.chan=cu2.chan AND cu1.joined=1 AND cu2.joined=1
+ GROUP BY cu2.chan HAVING c=1 ORDER BY NULL");
+ $nick_chan_delete = $dbh->prepare("DELETE FROM chanuser WHERE nickid=?");
+ $chan_user_partall = $dbh->prepare("UPDATE chanuser SET joined=0 WHERE nickid=?");
+ $get_hostless_nicks = $dbh->prepare("SELECT nick FROM user WHERE vhost='*'");
+
+ $get_squit_lock = $dbh->prepare("LOCK TABLES chanuser WRITE, chanuser AS cu1 READ LOCAL, chanuser AS cu2 READ LOCAL, user WRITE, nickreg WRITE, nickid WRITE, chanban WRITE, chan WRITE, chanreg READ LOCAL, nicktext WRITE");
+ $squit_users = $dbh->prepare("UPDATE chanuser, user
+ SET chanuser.joined=0, user.online=0, user.quittime=UNIX_TIMESTAMP()
+ WHERE user.id=chanuser.nickid AND user.server=?");
+ # Must call squit_nickreg and squit_lastquit before squit_users as it modifies user.online
+ $squit_nickreg = $dbh->prepare("UPDATE nickreg, nickid, user
+ SET nickreg.last=UNIX_TIMESTAMP()
+ WHERE nickreg.id=nickid.nrid AND nickid.id=user.id
+ AND user.online=1 AND user.server=?");
+=cut
+ $squit_lastquit = $dbh->prepare("UPDATE nickid, user, nicktext
+ SET nicktext.data=?
+ WHERE nicktext.nrid=nickid.nrid AND nickid.id=user.id
+ AND user.online=1 AND user.server=?");
+=cut
+ $squit_lastquit = $dbh->prepare("REPLACE INTO nicktext ".
+ "SELECT nickid.nrid, ".NTF_QUIT.", 0, '', ? ".
+ "FROM nickid JOIN user ON (nickid.id=user.id) ".
+ "WHERE user.online=1 AND user.server=?");
+ $get_squit_empty_chans = $dbh->prepare("SELECT cu2.chan, COUNT(*) AS c
+ FROM user, chanuser AS cu1, chanuser AS cu2
+ WHERE user.server=? AND cu1.nickid=user.id
+ AND cu1.chan=cu2.chan AND cu1.joined=1 AND cu2.joined=1
+ GROUP BY cu2.chan HAVING c=1 ORDER BY NULL");
+
+ $del_nickchg_id = $dbh->prepare("DELETE FROM nickchg WHERE nickid=?");
+ $add_nickchg = $dbh->prepare("REPLACE INTO nickchg SELECT ?, id, ? FROM user WHERE nick=?");
+ $reap_nickchg = $dbh->prepare("DELETE FROM nickchg WHERE seq<?");
+
+ $get_nick_inval = $dbh->prepare("SELECT nick, inval FROM user WHERE id=?");
+ $inc_nick_inval = $dbh->prepare("UPDATE user SET inval=inval+1 WHERE id=?");
+
+ $is_alias_of = $dbh->prepare("SELECT 1 FROM nickalias AS n1 LEFT JOIN nickalias AS n2 ON n1.nrid=n2.nrid
+ WHERE n1.alias=? AND n2.alias=? LIMIT 1");
+
+ $get_guest = $dbh->prepare("SELECT guest FROM user WHERE nick=?");
+ $set_guest = $dbh->prepare("UPDATE user SET guest=? WHERE nick=?");
+
+ $get_lock = $dbh->prepare("SELECT GET_LOCK(?, 10)");
+ $release_lock = $dbh->prepare("SELECT RELEASE_LOCK(?)");
+
+ $get_umodes = $dbh->prepare("SELECT modes FROM user WHERE id=?");
+ $set_umodes = $dbh->prepare("UPDATE user SET modes=? WHERE id=?");
+
+ $get_info = $dbh->prepare("SELECT nickreg.email, nickreg.regd, nickreg.last, nickreg.flags, nickreg.ident,
+ nickreg.vhost, nickreg.gecos, nickalias.last
+ FROM nickreg, nickalias WHERE nickalias.nrid=nickreg.id AND nickalias.alias=?");
+ $get_nickreg_quit = $dbh->prepare("SELECT nicktext.data FROM nickreg, nicktext, nickalias
+ WHERE nickalias.nrid=nickreg.id AND nickalias.alias=? AND
+ (nicktext.nrid=nickreg.id AND nicktext.type=".NTF_QUIT.")");
+ $set_ident = $dbh->prepare("UPDATE user SET ident=? WHERE id=?");
+ $set_vhost = $dbh->prepare("UPDATE user SET vhost=? WHERE id=?");
+ $set_ip = $dbh->prepare("UPDATE user SET ip=? WHERE id=?");
+ $update_regnick_vhost = $dbh->prepare("UPDATE nickreg,nickid SET nickreg.vhost=?
+ WHERE nickreg.id=nickid.nrid AND nickid.id=?");
+ $get_regd_time = $dbh->prepare("SELECT nickreg.regd FROM nickreg, nickalias
+ WHERE nickalias.nrid=nickreg.id and nickalias.alias=?");
+
+ $chk_clone_except = $dbh->prepare("SELECT
+ GREATEST(IF((user.ip >> (32 - sesexip.mask)) = (sesexip.ip >> (32 - sesexip.mask)), sesexip.lim, 0),
+ IF(IF(sesexname.serv, user.server, user.host) LIKE sesexname.host, sesexname.lim, 0)) AS n
+ FROM user, sesexip, sesexname WHERE user.id=? ORDER BY n DESC LIMIT 1");
+ $count_clones = $dbh->prepare("SELECT COUNT(*) FROM user WHERE ip=? AND online=1");
+
+ $get_root_nick = $dbh->prepare("SELECT nickreg.nick FROM nickreg, nickalias WHERE nickreg.id=nickalias.nrid AND nickalias.alias=?");
+ $get_id_nick = $dbh->prepare("SELECT nickreg.nick FROM nickreg WHERE nickreg.id=?");
+ $identify = $dbh->prepare("INSERT INTO nickid SELECT ?, nickalias.nrid FROM nickalias WHERE alias=?");
+ $identify_ign = $dbh->prepare("INSERT IGNORE INTO nickid SELECT ?, nickalias.nrid FROM nickalias WHERE alias=?");
+ $id_update = $dbh->prepare("UPDATE nickreg, user SET
+ nickreg.last=UNIX_TIMESTAMP(), nickreg.ident=user.ident,
+ nickreg.vhost=user.vhost, nickreg.gecos=user.gecos,
+ nickreg.nearexp=0, nickreg.flags = (nickreg.flags & ~". NRF_VACATION .")
+ WHERE nickreg.nick=? AND user.id=?");
+ $logout = $dbh->prepare("DELETE FROM nickid WHERE id=?");
+ $unidentify = $dbh->prepare("DELETE FROM nickid USING nickreg, nickid WHERE nickreg.nick=? AND nickid.nrid=nickreg.id");
+
+ $update_lastseen = $dbh->prepare("UPDATE nickreg,nickid SET nickreg.last=UNIX_TIMESTAMP()
+ WHERE nickreg.id=nickid.nrid AND nickid.id=?");
+ $update_nickalias_last = $dbh->prepare("UPDATE nickalias SET last=UNIX_TIMESTAMP() WHERE alias=?");
+ $quit_update = $dbh->prepare("REPLACE INTO nicktext
+ SELECT nickreg.id, ".NTF_QUIT().", 0, NULL, ? FROM nickreg, nickid
+ WHERE nickreg.id=nickid.nrid AND nickid.id=?");
+
+ $set_protect_level = $dbh->prepare("UPDATE nickalias SET protect=? WHERE alias=?");
+
+
+ $set_email = $dbh->prepare("UPDATE nickreg, nickalias SET nickreg.email=? WHERE nickalias.nrid=nickreg.id AND nickalias.alias=?");
+
+ $set_pass = $dbh->prepare("UPDATE nickreg, nickalias SET nickreg.pass=? WHERE nickalias.nrid=nickreg.id AND nickalias.alias=?");
+
+ $get_register_lock = $dbh->prepare("LOCK TABLES nickalias WRITE, nickreg WRITE");
+ $register = $dbh->prepare("INSERT INTO nickreg SET nick=?, pass=?, email=?, flags=".NRF_HIDEMAIL().", regd=UNIX_TIMESTAMP(), last=UNIX_TIMESTAMP()");
+ $create_alias = $dbh->prepare("INSERT INTO nickalias SELECT id, ?, NULL, NULL FROM nickreg WHERE nick=?");
+
+ $drop = $dbh->prepare("DELETE FROM nickreg WHERE nick=?");
+
+ $get_aliases = $dbh->prepare("SELECT nickalias.alias FROM nickalias, nickreg WHERE
+ nickalias.nrid=nickreg.id AND nickreg.nick=? ORDER BY nickalias.alias");
+ $get_glist = $dbh->prepare("SELECT nickalias.alias, nickalias.protect, nickalias.last
+ FROM nickalias, nickreg WHERE
+ nickalias.nrid=nickreg.id AND nickreg.nick=? ORDER BY nickalias.alias");
+ $count_aliases = $dbh->prepare("SELECT COUNT(*) FROM nickalias, nickreg WHERE
+ nickalias.nrid=nickreg.id AND nickreg.nick=?");
+ $get_random_alias = $dbh->prepare("SELECT nickalias.alias FROM nickalias, nickreg WHERE
+ nickalias.nrid=nickreg.id AND nickreg.nick=? AND nickalias.alias != nickreg.nick LIMIT 1");
+ $delete_alias = $dbh->prepare("DELETE FROM nickalias WHERE alias=?");
+ $delete_aliases = $dbh->prepare("DELETE FROM nickalias USING nickreg, nickalias WHERE
+ nickalias.nrid=nickreg.id AND nickreg.nick=?");
+
+ $get_all_access = $dbh->prepare("SELECT chanacc.chan, chanacc.level, chanacc.adder, chanacc.time FROM nickalias, chanacc WHERE chanacc.nrid=nickalias.nrid AND nickalias.alias=? ORDER BY chanacc.chan");
+ $del_all_access = $dbh->prepare("DELETE FROM chanacc USING chanacc, nickreg WHERE chanacc.nrid=nickreg.id AND nickreg.nick=?");
+
+ $change_root = $dbh->prepare("UPDATE nickreg SET nick=? WHERE nick=?");
+
+ $unlock_tables = $dbh->prepare("UNLOCK TABLES");
+
+ $get_matching_nicks = $dbh->prepare("SELECT nickalias.alias, nickreg.nick, nickreg.ident, nickreg.vhost FROM nickalias, nickreg WHERE nickalias.nrid=nickreg.id AND nickalias.alias LIKE ? AND nickreg.ident LIKE ? AND nickreg.vhost LIKE ? LIMIT 50");
+
+ $cleanup_chanuser = $dbh->prepare("DELETE FROM chanuser USING chanuser
+ LEFT JOIN user ON (chanuser.nickid=user.id) WHERE user.id IS NULL;");
+ $cleanup_nickid = $dbh->prepare("DELETE FROM nickid, user USING nickid LEFT JOIN user ON(nickid.id=user.id) WHERE user.id IS NULL OR (user.online=0 AND quittime<?)");
+ $cleanup_users = $dbh->prepare("DELETE FROM user WHERE online=0 AND quittime<?");
+
+ $get_expired = $dbh->prepare("SELECT nickreg.nick, nickreg.email, nickreg.ident, nickreg.vhost
+ FROM nickreg LEFT JOIN nickid ON(nickreg.id=nickid.nrid)
+ LEFT JOIN svsop ON(nickreg.id=svsop.nrid)
+ WHERE nickid.nrid IS NULL AND svsop.nrid IS NULL ".
+ 'AND ('.(services_conf_nearexpire ? 'nickreg.nearexp!=0 AND' : '').
+ " ( !(nickreg.flags & " . NRF_HOLD . ") AND !(nickreg.flags & " . NRF_VACATION . ") AND nickreg.last<? ) OR
+ ( (nickreg.flags & " . NRF_VACATION . ") AND nickreg.last<? ) ) OR
+ ( (nickreg.flags & ". NRF_EMAILREG .") AND nickreg.last<?)");
+ $get_near_expired = $dbh->prepare("SELECT nickreg.nick, nickreg.email, nickreg.flags, nickreg.last
+ FROM nickreg LEFT JOIN nickid ON(nickreg.id=nickid.nrid)
+ LEFT JOIN svsop ON(nickreg.id=svsop.nrid)
+ WHERE nickid.nrid IS NULL AND svsop.nrid IS NULL AND nickreg.nearexp=0 AND
+ ( ( !(nickreg.flags & " . NRF_HOLD . ") AND !(nickreg.flags & " . NRF_VACATION . ") AND nickreg.last<? ) OR
+ ( (nickreg.flags & " . NRF_VACATION . ") AND nickreg.last<? )
+ )");
+ $set_near_expired = $dbh->prepare("UPDATE nickreg SET nearexp=1 WHERE nick=?");
+
+ $get_watches = $dbh->prepare("SELECT watch.mask, watch.time
+ FROM watch
+ JOIN nickalias ON (watch.nrid=nickalias.nrid)
+ WHERE nickalias.alias=?");
+ $check_watch = $dbh->prepare("SELECT 1
+ FROM watch
+ JOIN nickalias ON (watch.nrid=nickalias.nrid)
+ WHERE nickalias.alias=? AND watch.mask=?");
+ $set_watch = $dbh->prepare("INSERT INTO watch SELECT nrid, ?, ? FROM nickalias WHERE alias=?");
+ $del_watch = $dbh->prepare("DELETE FROM watch USING watch
+ JOIN nickalias ON (watch.nrid=nickalias.nrid)
+ WHERE nickalias.alias=? AND watch.mask=?");
+ $drop_watch = $dbh->prepare("DELETE FROM watch
+ USING nickreg JOIN watch ON (watch.nrid=nickreg.id)
+ WHERE nickreg.nick=?");
+ $get_silences = $dbh->prepare("SELECT silence.mask, silence.time, silence.expiry, silence.comment
+ FROM silence
+ JOIN nickalias ON (silence.nrid=nickalias.nrid)
+ WHERE nickalias.alias=? ORDER BY silence.time");
+ $check_silence = $dbh->prepare("SELECT 1 FROM silence
+ JOIN nickalias ON (silence.nrid=nickalias.nrid)
+ WHERE nickalias.alias=? AND silence.mask=?");
+ $set_silence = $dbh->prepare("INSERT INTO silence SELECT nrid, ?, ?, ?, ? FROM nickalias WHERE alias=?");
+ $del_silence = $dbh->prepare("DELETE FROM silence USING silence, nickalias
+ WHERE silence.nrid=nickalias.nrid AND nickalias.alias=? AND silence.mask=?");
+ $drop_silence = $dbh->prepare("DELETE FROM silence USING nickreg, silence
+ WHERE silence.nrid=nickreg.id AND nickreg.nick=?");
+ $get_expired_silences = $dbh->prepare("SELECT nickreg.nick, silence.mask, silence.comment
+ FROM nickreg
+ JOIN silence ON (nickreg.id=silence.nrid)
+ WHERE silence.expiry < UNIX_TIMESTAMP() AND silence.expiry!=0 ORDER BY nickreg.nick");
+ $del_expired_silences = $dbh->prepare("DELETE silence.* FROM silence
+ WHERE silence.expiry < UNIX_TIMESTAMP() AND silence.expiry!=0");
+ $get_silence_by_num = $dbh->prepare("SELECT silence.mask, silence.time, silence.expiry, silence.comment
+ FROM silence
+ JOIN nickalias ON (silence.nrid=nickalias.nrid)
+ WHERE nickalias.alias=? ORDER BY silence.time LIMIT 1 OFFSET ?");
+ $get_silence_by_num->bind_param(2, 0, SQL_INTEGER);
+
+ $get_seen = $dbh->prepare("SELECT nickalias.alias, nickreg.nick, nickreg.last FROM nickreg, nickalias
+ WHERE nickalias.nrid=nickreg.id AND nickalias.alias=?");
+
+ $set_greet = $dbh->prepare("REPLACE INTO nicktext SELECT nickreg.id, ".NTF_GREET.", 0, NULL, ?
+ FROM nickreg, nickalias WHERE nickreg.id=nickalias.nrid AND nickalias.alias=?");
+ $get_greet = $dbh->prepare("SELECT nicktext.data FROM nicktext, nickid
+ WHERE nicktext.nrid=nickid.nrid AND nicktext.type=".NTF_GREET." AND nickid.id=?
+ LIMIT 1");
+ $get_greet_nick = $dbh->prepare("SELECT nicktext.data FROM nicktext, nickalias
+ WHERE nicktext.nrid=nickalias.nrid AND nicktext.type=".NTF_GREET." AND nickalias.alias=?");
+ $del_greet = $dbh->prepare("DELETE nicktext.* FROM nicktext, nickreg, nickalias WHERE
+ nicktext.type=".NTF_GREET." AND nickreg.id=nickalias.nrid AND nickalias.alias=?");
+
+ $get_num_nicktext_type = $dbh->prepare("SELECT COUNT(nicktext.id) FROM nicktext, nickalias
+ WHERE nicktext.nrid=nickalias.nrid AND nickalias.alias=? AND nicktext.type=?");
+ $drop_nicktext = $dbh->prepare("DELETE FROM nicktext USING nickreg
+ JOIN nicktext ON (nicktext.nrid=nickreg.id)
+ WHERE nickreg.nick=?");
+
+ $get_auth_chan = $dbh->prepare("SELECT nicktext.data FROM nicktext, nickalias WHERE
+ nicktext.nrid=nickalias.nrid AND nicktext.type=(".NTF_AUTH().") AND nickalias.alias=? AND nicktext.chan=?");
+ $get_auth_num = $dbh->prepare("SELECT nicktext.chan, nicktext.data FROM nicktext, nickalias WHERE
+ nicktext.nrid=nickalias.nrid AND nicktext.type=(".NTF_AUTH().") AND nickalias.alias=? LIMIT 1 OFFSET ?");
+ $get_auth_num->bind_param(2, 0, SQL_INTEGER);
+ $del_auth = $dbh->prepare("DELETE nicktext.* FROM nicktext, nickalias WHERE
+ nicktext.nrid=nickalias.nrid AND nicktext.type=(".NTF_AUTH().") AND nickalias.alias=? AND nicktext.chan=?");;
+ $list_auth = $dbh->prepare("SELECT nicktext.chan, nicktext.data FROM nicktext, nickalias WHERE
+ nicktext.nrid=nickalias.nrid AND nicktext.type=(".NTF_AUTH().") AND nickalias.alias=?");
+
+ $del_nicktext = $dbh->prepare("DELETE nicktext.* FROM nickreg
+ JOIN nickalias ON (nickalias.nrid=nickreg.id)
+ JOIN nicktext ON (nicktext.nrid=nickreg.id)
+ WHERE nicktext.type=? AND nickalias.alias=?");
+
+ $set_umode_ntf = $dbh->prepare("REPLACE INTO nicktext SELECT nickreg.id, ".NTF_UMODE().", 1, ?, NULL
+ FROM nickreg, nickalias WHERE nickreg.id=nickalias.nrid AND nickalias.alias=?");
+ $get_umode_ntf = $dbh->prepare("SELECT nicktext.chan FROM nickreg, nickalias, nicktext
+ WHERE nicktext.type=(".NTF_UMODE().") AND nicktext.nrid=nickalias.nrid AND nickalias.alias=?");
+
+ $set_vacation_ntf = $dbh->prepare("INSERT INTO nicktext SELECT nickreg.id, ".NTF_VACATION().", 0, ?, NULL
+ FROM nickreg, nickalias WHERE nickreg.id=nickalias.nrid AND nickalias.alias=?");
+ $get_vacation_ntf = $dbh->prepare("SELECT nicktext.chan FROM nickalias, nicktext
+ WHERE nicktext.nrid=nickalias.nrid AND nicktext.type=".NTF_VACATION()." AND nickalias.alias=?");
+
+ $set_authcode_ntf = $dbh->prepare("REPLACE INTO nicktext SELECT nickreg.id, ".NTF_AUTHCODE().", 0, '', ?
+ FROM nickreg, nickalias WHERE nickreg.id=nickalias.nrid AND nickalias.alias=?");
+ $get_authcode_ntf = $dbh->prepare("SELECT 1 FROM nickalias, nicktext
+ WHERE nicktext.nrid=nickalias.nrid AND nicktext.type=".NTF_AUTHCODE()." AND nickalias.alias=? AND nicktext.data=?");
+
+}
+import SrSv::MySQL::Stub {
+ __is_registered => ['SCALAR', "SELECT 1 FROM nickalias WHERE alias=?"],
+
+
+ add_profile_ntf => ['INSERT', "REPLACE INTO nicktext SELECT nickreg.id, @{[NTF_PROFILE]}, 0, ?, ?
+ FROM nickreg JOIN nickalias ON (nickreg.id=nickalias.nrid) WHERE nickalias.alias=?"],
+ get_profile_ntf => ['ARRAY', "SELECT chan, data FROM nicktext
+ JOIN nickalias ON (nicktext.nrid=nickalias.nrid)
+ WHERE nicktext.type=@{[NTF_PROFILE]} AND nickalias.alias=?"],
+ del_profile_ntf => ['NULL', "DELETE nicktext.* FROM nicktext
+ JOIN nickalias ON (nicktext.nrid=nickalias.nrid)
+ WHERE nicktext.type=@{[NTF_PROFILE]} AND nickalias.alias=? AND nicktext.chan=?"],
+ wipe_profile_ntf => ['NULL', "DELETE nicktext.* FROM nicktext
+ JOIN nickalias ON (nicktext.nrid=nickalias.nrid)
+ WHERE nicktext.type=@{[NTF_PROFILE]} AND nickalias.alias=?"],
+ count_profile_ntf => ['SCALAR', "SELECT COUNT(chan) FROM nicktext
+ JOIN nickalias ON (nicktext.nrid=nickalias.nrid)
+ WHERE nicktext.type=@{[NTF_PROFILE]} AND nickalias.alias=?"],
+
+ protect_level => ['SCALAR', 'SELECT protect FROM nickalias WHERE alias=?'],
+ get_pass => ['SCALAR', "SELECT nickreg.pass
+ FROM nickreg JOIN nickalias ON (nickreg.id=nickalias.nrid)
+ WHERE nickalias.alias=?"],
+ get_email => ['SCALAR', "SELECT nickreg.email
+ FROM nickalias JOIN nickreg ON (nickreg.id=nickalias.nrid)
+ WHERE nickalias.alias=?"],
+ count_silences => ['SCALAR', "SELECT COUNT(silence.nrid) FROM silence
+ JOIN nickalias ON (silence.nrid=nickalias.nrid)
+ WHERE nickalias.alias=?"],
+ count_watches => ['SCALAR', "SELECT COUNT(watch.nrid) FROM watch
+ JOIN nickalias ON (watch.nrid=nickalias.nrid)
+ WHERE nickalias.alias=?"],
+
+ add_autojoin_ntf => ['INSERT', "INSERT INTO nicktext
+ SELECT nickreg.id, @{[NTF_JOIN]}, 0, ?, NULL
+ FROM nickreg JOIN nickalias ON (nickreg.id=nickalias.nrid)
+ WHERE nickalias.alias=?"],
+ get_autojoin_ntf => ['COLUMN', "SELECT chan
+ FROM nicktext
+ JOIN nickalias ON (nicktext.nrid=nickalias.nrid)
+ WHERE nicktext.type=@{[NTF_JOIN]} AND nickalias.alias=?"],
+ del_autojoin_ntf => ['NULL', "DELETE nicktext.* FROM nickreg
+ JOIN nickalias ON (nickalias.nrid=nickreg.id)
+ JOIN nicktext ON (nicktext.nrid=nickreg.id)
+ WHERE nicktext.type=@{[NTF_JOIN]} AND nickalias.alias=? AND nicktext.chan=?"],
+ check_autojoin_ntf => ['SCALAR', "SELECT 1 FROM nicktext
+ JOIN nickalias ON (nicktext.nrid=nickalias.nrid)
+ WHERE nicktext.type=@{[NTF_JOIN]} AND nickalias.alias=? AND nicktext.chan=?"],
+ get_autojoin_by_num => ['SCALAR', "SELECT nicktext.chan
+ FROM nicktext
+ JOIN nickalias ON (nicktext.nrid=nickalias.nrid)
+ WHERE nicktext.type=@{[NTF_JOIN]} AND nickalias.alias=? LIMIT 1 OFFSET ?"],
+};
+
+
+### NICKSERV COMMANDS ###
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(ajoin)],
+ SYNTAX => '[nick] LIST/ADD/DEL #chan',
+ CALL => \&ns_ajoin,
+ OPTIONAL_DEFAULT_SRC => 1,
+};
+sub ns_ajoin_list($$) {
+ my ($user, $nick) = @_;
+ my @data;
+ my $i = 0;
+ foreach my $chan (get_autojoin_ntf($nick)) {
+ push @data, [++$i, $chan];
+ }
+
+ notice( $user, columnar( {TITLE => "Channels in \002$nick\002's ajoin",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data ) );
+}
+sub ns_ajoin_del($$@) {
+ my ($user, $nick, @args) = @_;
+ my @entries;
+ foreach my $arg (@args) {
+ if ($arg =~ /^[0-9\.,-]+$/) {
+ foreach my $num (makeSeqList($arg)) {
+ if(my $chan = get_autojoin_by_num($nick, $num - 1)) {
+ push @entries, $chan;
+ } else {
+ notice($user, "No entry \002#$num\002 was found in your ajoin list");
+ }
+ }
+ } else {
+ push @entries, $arg;
+ }
+ }
+ foreach my $entry (@entries) {
+ if(check_autojoin_ntf($nick, $entry)) {
+ del_autojoin_ntf($nick, $entry);
+ notice($user,"Successfully removed \002$entry\002 from your ajoin list.");
+ }
+ else {
+ notice($user, "\002$entry\002 was not in your ajoin!");
+ }
+ }
+}
+
+sub ns_ajoin($$@) {
+ my ($user, $nick, $cmd, @args) = @_;
+ my $src = get_user_nick($user);
+ if(!is_identified($user, $nick)) {
+ if(!is_registered($nick)) {
+ notice($user, "\002$nick\002 is not registered.");
+ } else {
+ notice($user, "Permission denied for \002$nick\002");
+ }
+ }
+ if ($cmd =~ /^add$/i) {
+ if(!scalar(@args)) {
+ notice($user, "Syntax: \002AJOIN ADD #channel\002");
+ notice ($user, "Type \002/msg NickServ HELP AJOIN\002 for more help");
+ }
+ foreach my $chan (@args) {
+ if (defined($chan) && $chan !~ /^#/) {
+ $chan = "#" . $chan;
+ }
+ if(check_autojoin_ntf($nick, $chan)) {
+ notice ($user, $chan . " is already in your ajoin list! ");
+ next;
+ } else {
+ add_autojoin_ntf($chan, $nick);
+ notice($user, "\002$chan\002 added to your ajoin.");
+ }
+ }
+ }
+ elsif ($cmd =~ /^list$/i) {
+ ns_ajoin_list($user, $nick);
+ }
+ elsif ($cmd =~ /^del(ete)?$/i) {
+ ns_ajoin_del($user, $nick, @args);
+ }
+ else {
+ notice($user,"Syntax: AJOIN ADD/DEL/LIST");
+ notice ($user,"Type \002/msg NickServ HELP AJOIN\002 for more help!");
+ }
+}
+
+=cut
+sub dispatch($$$) {
+ my ($src, $dst, $msg) = @_;
+ $msg =~ s/^\s+//;
+ my @args = split(/\s+/, $msg);
+ my $cmd = shift @args;
+
+ my $user = { NICK => $src, AGENT => $dst };
+
+ return if operserv::flood_check($user);
+
+ if($cmd =~ /^help$/i) {
+ sendhelp($user, 'nickserv', @args)
+ }
+ elsif ($cmd =~ /^ajoin$/i) {
+ ns_ajoin($user, shift @args, @args);
+ }
+ elsif($cmd =~ /^id(entify)?$/i) {
+ if(@args == 1) {
+ ns_identify($user, $src, $args[0]);
+ } elsif(@args == 2) {
+ ns_identify($user, $args[0], $args[1]);
+ } else {
+ notice($user, 'Syntax: IDENTIFY [nick] <password>');
+ }
+ }
+ elsif($cmd =~ /^sid(entify)?$/i) {
+ if(@args == 2) {
+ ns_identify($user, $args[0], $args[1], 1);
+ } else {
+ notice($user, 'Syntax: SIDENTIFY <nick> <password>');
+ }
+ }
+ elsif($cmd =~ /^gid(entify)?$/i) {
+ if(@args == 2) {
+ ns_identify($user, $args[0], $args[1], 2);
+ } else {
+ notice($user, 'Syntax: GIDENTIFY <nick> <password>');
+ }
+ }
+ elsif($cmd =~ /^logout$/i) {
+ ns_logout($user);
+ }
+ elsif($cmd =~ /^release$/i) {
+ if(@args == 1) {
+ ns_release($user, $args[0]);
+ } elsif(@args == 2) {
+ ns_release($user, $args[0], $args[1]);
+ } else {
+ notice($user, 'Syntax: RELEASE <nick> [password]');
+ }
+ }
+ elsif($cmd =~ /^ghost$/i) {
+ if(@args == 1) {
+ ns_ghost($user, $args[0]);
+ } elsif(@args == 2) {
+ ns_ghost($user, $args[0], $args[1]);
+ } else {
+ notice($user, 'Syntax: GHOST <nick> [password]');
+ }
+ }
+ elsif($cmd =~ /^register$/i) {
+ if(@args == 2) {
+ ns_register($user, $args[0], $args[1]);
+ } else {
+ notice($user, 'Syntax: REGISTER <password> <email>');
+ }
+ }
+ elsif($cmd =~ /^(?:link|group)$/i) {
+ if(@args == 2) {
+ ns_link($user, $args[0], $args[1]);
+ } else {
+ notice($user, 'Syntax: LINK <nick> <password>');
+ }
+ }
+ elsif($cmd =~ /^info$/i) {
+ if(@args >= 1) {
+ ns_info($user, @args);
+ } else {
+ notice($user, 'Syntax: INFO <nick> [nick ...]');
+ }
+ }
+ elsif($cmd =~ /^set$/i) {
+ ns_set_parse($user, @args);
+ }
+ elsif($cmd =~ /^(drop|unlink)$/i) {
+ if(@args == 1) {
+ ns_unlink($user, $src, $args[0]);
+ }
+ elsif(@args == 2) {
+ ns_unlink($user, $args[0], $args[1]);
+ }
+ else {
+ notice($user, 'Syntax: UNLINK [nick] <password>');
+ }
+ }
+ elsif($cmd =~ /^dropgroup$/i) {
+ if(@args == 1) {
+ ns_dropgroup($user, $src, $args[0]);
+ }
+ elsif(@args == 2) {
+ ns_dropgroup($user, $args[0], $args[1]);
+ }
+ else {
+ notice($user, 'Syntax: DROPGROUP [nick] <password>');
+ }
+ }
+ elsif($cmd =~ /^chgroot$/i) {
+ if(@args == 1) {
+ ns_changeroot($user, $src, $args[0]);
+ }
+ elsif(@args == 2) {
+ ns_changeroot($user, $args[0], $args[1]);
+ }
+ else {
+ notice($user, 'Syntax: CHGROOT [oldroot] <newroot>');
+ }
+ }
+ elsif($cmd =~ /^sendpass$/i) {
+ if(@args == 1) {
+ ns_sendpass($user, $args[0]);
+ } else {
+ notice($user, 'Syntax: SENDPASS <nick>');
+ }
+ }
+ elsif($cmd =~ /^(?:glist|links)$/i) {
+ if(@args == 0) {
+ ns_glist($user, $src);
+ }
+ elsif(@args >= 1) {
+ ns_glist($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: GLIST [nick] [nick ...]');
+ }
+ }
+ elsif($cmd =~ /^(?:alist|listchans)$/i) {
+ if(@args == 0) {
+ ns_alist($user, $src);
+ }
+ elsif(@args >= 1) {
+ ns_alist($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: ALIST [nick] [nick ...]');
+ }
+ }
+ elsif($cmd =~ /^list$/i) {
+ if(@args == 1) {
+ ns_list($user, $args[0]);
+ } else {
+ notice($user, 'Syntax: LIST <mask>');
+ }
+ }
+ elsif($cmd =~ /^watch$/i) {
+ if ($args[0] =~ /^(add|del|list)$/i) {
+ ns_watch($user, $src, @args);
+ }
+ elsif ($args[1] =~ /^(add|del|list)$/i) {
+ ns_watch($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: WATCH <ADD|DEL|LIST> [nick]');
+ }
+ }
+ elsif($cmd =~ /^silence$/i) {
+ if ($args[0] =~ /^(add|del|list)$/i) {
+ ns_silence($user, $src, @args);
+ }
+ elsif ($args[1] =~ /^(add|del|list)$/i) {
+ ns_silence($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: SILENCE [nick] <ADD|DEL|LIST> [mask] [+expiry] [comment]');
+ }
+ }
+ elsif($cmd =~ /^(acc(ess)?|stat(us)?)$/i) {
+ if (@args >= 1) {
+ ns_acc($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: ACC <nick> [nick ...]');
+ }
+ }
+ elsif($cmd =~ /^seen$/i) {
+ if(@args >= 1) {
+ ns_seen($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: SEEN <nick> [nick ...]');
+ }
+ }
+ elsif($cmd =~ /^recover$/i) {
+ if(@args == 1) {
+ ns_recover($user, $args[0]);
+ } elsif(@args == 2) {
+ ns_recover($user, $args[0], $args[1]);
+ } else {
+ notice($user, 'Syntax: RECOVER <nick> [password]');
+ }
+ }
+ elsif($cmd =~ /^auth$/i) {
+ if (@args >= 1) {
+ ns_auth($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: AUTH [nick] <LIST|ACCEPT|DECLINE> [num|chan]');
+ }
+ }
+ elsif($cmd =~ /^(?:emailreg|(?:auth|email)code)$/i) {
+ if(scalar(@args) >= 2 and scalar(@args) <= 3) {
+ ns_authcode($user, @args);
+ } else {
+ notice($user, 'Syntax: AUTHCODE <nick> <code> [newpassword]');
+ }
+ }
+ elsif($cmd =~ /^profile$/i) {
+ ns_profile($user, @args);
+ }
+ else {
+ notice($user, "Unrecognized command.", "For help, type: \002/msg nickserv help\002");
+ wlog($nsnick, LOG_DEBUG(), "$src tried to use NickServ $msg");
+ }
+}
+=cut
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(identify id)],
+ SYNTAX => '[nick] password',
+ CALL => \&ns_identify,
+ OPTIONAL_DEFAULT_SRC => 1,
+};
+
+sub ns_identify($$$;$) {
+ my ($user, $nick, $pass, $svsnick) = @_;
+ my $src = get_user_nick($user);
+
+ my $root = get_root_nick($nick);
+ unless($root) {
+ notice($user, 'Your nick is not registered.');
+ return 0;
+ }
+
+ if($svsnick) {
+ if(lc($src) ne lc($nick) and is_online($nick)) {
+ if($svsnick == 2) {
+ ns_ghost($user, $nick, $pass) or return;
+ } else {
+ notice($user, $nick.' is already in use. Please use GHOST, GIDENTIFY or RECOVER');
+ $svsnick = 0;
+ }
+ }
+ if (is_identified($user, $nick)) {
+ if(lc $src eq lc $nick) {
+ notice($user, "Cannot only change case of nick");
+ return;
+ }
+ ircd::svsnick($nsnick, $src, $nick);
+ ircd::setumode($nsnick, $nick, '+r');
+ return 1;
+ }
+ }
+ # cannot be an else, note change of $svsnick above.
+ if (!$svsnick and is_identified($user, $nick)) {
+ notice($user, 'You are already identified for nick '.$nick.'.');
+ return 0;
+ }
+
+ my $flags = nr_get_flags($root);
+
+ if($flags & NRF_FREEZE) {
+ notice($user, "This nick has been frozen and may not be used.", $err_deny);
+ services::ulog($nsnick, LOG_INFO(), "\00305attempted to identify to frozen nick \003\002$nick\002", $user);
+ return;
+ }
+
+ if($flags & NRF_EMAILREG) {
+ notice($user, "This nick is awaiting an email validation code. Please check your email for instructions.");
+ return;
+ }
+
+ elsif($flags & NRF_SENDPASS) {
+ notice($user, "This nick is awaiting a SENDPASS authentication code. Please check your email for instructions.");
+ return;
+ }
+
+ my $uid = get_user_id($user);
+ unless(chk_pass($root, $pass, $user)) {
+ if(inc_nick_inval($user)) {
+ notice($user, $err_pass);
+ }
+ services::ulog($nsnick, LOG_INFO(), "failed to identify to nick $nick (root: $root)", $user);
+ return 0;
+ }
+
+ return do_identify($user, $nick, $root, $flags, $svsnick);
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(sidentify sid)],
+ SYNTAX => 'nick password',
+ CALL => \&ns_sidentify,
+};
+
+sub ns_sidentify($$$) {
+ push @_, 1;
+ goto &ns_identify;
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(gidentify gid)],
+ SYNTAX => 'nick password',
+ CALL => \&ns_gidentify,
+};
+
+sub ns_gidentify($$$) {
+ push @_, 2;
+ goto &ns_identify;
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(logout)],
+ SYNTAX => '',
+ CALL => \&ns_logout,
+};
+
+sub ns_logout($) {
+ my ($user) = @_;
+ my $uid = get_user_id($user);
+
+ $update_lastseen->execute($uid);
+ $logout->execute($uid);
+ delete($user->{NICKFLAGS});
+ ircd::nolag($nsnick, '-', get_user_nick($user));
+ notice($user, 'You are now logged out');
+ services::ulog($nsnick, LOG_INFO(), "used NickServ LOGOUT", $user);
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(release)],
+ SYNTAX => 'nick [password]',
+ CALL => \&ns_release,
+};
+
+sub ns_release($$;$) {
+ my ($user, $nick, $pass) = @_;
+
+ if(nr_chk_flag($nick, NRF_FREEZE)) {
+ notice($user, "This nick has been frozen and may not be used.", $err_deny);
+ services::ulog($nsnick, LOG_INFO(), "\00305attempted to release frozen nick \003\002$nick\002", $user);
+ return;
+ }
+
+ unless(is_identified($user, $nick)) {
+ if($pass) {
+ my $s = ns_identify($user, $nick, $pass);
+ return if($s == 0); #failed to identify
+ if($s == 1) {
+ notice($user, "Nick $nick is not being held.");
+ return;
+ }
+ } else {
+ notice($user, $err_deny);
+ return;
+ }
+ }
+ elsif(enforcer_quit($nick)) {
+ notice($user, 'Your nick has been released from custody.');
+ } else {
+ notice($user, "Nick $nick is not being held.");
+ }
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(ghost)],
+ SYNTAX => 'nick [password]',
+ CALL => \&ns_ghost,
+};
+
+sub ns_ghost($$;$) {
+
+my @ghostbusters_quotes = (
+ 'Ray. If someone asks if you are a god, you say, "yes!"',
+ 'I feel like the floor of a taxicab.',
+ 'I don\'t have to take this abuse from you, I\'ve got hundreds of people dying to abuse me.',
+ 'He slimed me.',
+ 'This chick is *toast*.',
+ '"Where do these stairs go?" "They go up."',
+ '"That\'s the bedroom, but nothing ever happened in there." "What a crime."',
+ 'NOBODY steps on a church in my town.',
+ 'Whoa, whoa, whoa! Nice shootin\', Tex!',
+ 'It\'s the Stay Puft Marshmallow Man.',
+ '"Symmetrical book stacking. Just like the Philadelphia mass turbulence of 1947." "You\'re right, no human being would stack books like this."',
+ '"Egon, this reminds me of the time you tried to drill a hole through your head. Remember that?" "That would have worked if you hadn\'t stopped me."',
+ '"Ray has gone bye-bye, Egon... what\'ve you got left?" "Sorry, Venkman, I\'m terrified beyond the capacity for rational thought."',
+ 'Listen! Do you smell something?',
+ 'As they say in T.V., I\'m sure there\'s one big question on everybody\'s mind, and I imagine you are the man to answer that. How is Elvis, and have you seen him lately?',
+ '"You know, you don\'t act like a scientist." "They\'re usually pretty stiff." "You\'re more like a game show host."',
+);
+ my ($user, $nick, $pass) = @_;
+ my $src = get_user_nick($user);
+
+ if(nr_chk_flag($nick, NRF_FREEZE)) {
+ notice($user, "This nick has been frozen and may not be used.", $err_deny);
+ services::ulog($nsnick, LOG_INFO(), "\00305attempted to ghost frozen nick \003\002$nick\002", $user);
+ return 0;
+ }
+
+ unless(is_identified($user, $nick)) {
+ if($pass) {
+ my $s = ns_identify($user, $nick, $pass);
+ return 0 if($s == 0); #failed to identify
+ } else {
+ notice($user, $err_deny);
+ return 0;
+ }
+ }
+
+ if(!is_online($nick)) {
+ notice($user, "\002$nick\002 is not online");
+ return 0;
+ } elsif(lc $src eq lc $nick) {
+ notice($user, "I'm sorry, $src, I'm afraid I can't do that.");
+ return 0;
+
+ } else {
+ my $ghostbusters = @ghostbusters_quotes[int rand(scalar(@ghostbusters_quotes))];
+ ircd::irckill($nsnick, $nick, "GHOST command used by $src ($ghostbusters)");
+ notice($user, "Your ghost has been disconnected");
+ services::ulog($nsnick, LOG_INFO(), "used NickServ GHOST on $nick", $user);
+ #nick_delete($nick);
+ return 1;
+ }
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(register)],
+ SYNTAX => 'password email',
+ CALL => \&ns_register,
+};
+
+sub ns_register($$$) {
+ my ($user, $pass, $email) = @_;
+ my $src = get_user_nick($user);
+
+ if($src =~ /^guest/i) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ unless(validate_email($email)) {
+ notice($user, $err_email);
+ return;
+ }
+
+ if ($pass =~ /pass/i) {
+ notice($user, 'Try a more secure password.');
+ return;
+ }
+
+ my $uid = get_user_id($user);
+
+ $get_register_lock->execute; $get_register_lock->finish;
+
+ if(not is_registered($src)) {
+ $register->execute($src, hash_pass($pass), $email); $register->finish();
+ $create_alias->execute($src, $src); $create_alias->finish;
+ if (defined(services_conf_default_protect)) {
+ $set_protect_level->execute((defined(services_conf_default_protect) ?
+ $protect_level{lc services_conf_default_protect} : 1), $src);
+ $set_protect_level->finish();
+ }
+ $unlock_tables->execute; $unlock_tables->finish;
+
+ if(services_conf_validate_email) {
+ nr_set_flag($src, NRF_EMAILREG());
+ authcode($src, 'emailreg', $email);
+ notice($user, "Your registration is not yet complete.",
+ "Your nick will expire within ".
+ (services_conf_validate_expire == 1 ? '24 hours' : services_conf_validate_expire.' days').
+ " if you do not enter the validation code.",
+ "Check your email for further instructions.");
+ }
+ else {
+ $identify->execute($uid, $src); $identify->finish();
+ notice($user, 'You are now registered and identified.');
+ ircd::setumode($nsnick, $src, '+r');
+ }
+
+ $id_update->execute($src, $uid); $id_update->finish();
+ services::ulog($nsnick, LOG_INFO(), "registered $src (email: $email)".
+ (services_conf_validate_email ? ' requires email validation code' : ''),
+ $user);
+ } else {
+ $unlock_tables->execute; $unlock_tables->finish;
+ notice($user, 'Your nickname has already been registered.');
+ }
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(link group)],
+ SYNTAX => 'nick password',
+ CALL => \&ns_link,
+};
+
+sub ns_link($$$) {
+ my ($user, $nick, $pass) = @_;
+
+ my $root = get_root_nick($nick);
+ my $src = get_user_nick($user);
+ my $uid = get_user_id($user);
+
+ if($src =~ /^guest/i) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ unless (is_registered($nick)) {
+ if(is_registered($src)) {
+ notice($user, "The nick \002$nick\002 is not registered. You need to change your nick to \002$nick\002 and then link to \002$src\002.");
+ } else { # if neither $nick nor $src are registered
+ notice($user, "You need to register your nick first. For help, type \002/ns help register");
+ }
+ return;
+ }
+
+ unless(chk_pass($root, $pass, $user)) {
+ notice($user, $err_pass);
+ return;
+ }
+
+ if(nr_chk_flag($nick, NRF_FREEZE) and (lc $pass ne 'force')) {
+ notice($user, "\002$root\002 has been frozen and may not be used.");
+ return;
+ }
+
+ if(is_alias_of($src, $nick)) {
+ notice($user, "\002$nick\002 is already linked to \002$src\002.");
+ return;
+ }
+
+ $get_register_lock->execute; $get_register_lock->finish;
+
+ if(is_registered($src)) {
+ $unlock_tables->execute; $unlock_tables->finish;
+
+ if(is_identified($user, $src)) {
+ notice($user, "You cannot link an already registered nick. Type this and try again: \002/ns drop $src <password>");
+ return;
+ } else {
+ notice($user, 'Your nickname has already been registered.');
+ return;
+ }
+ } else {
+ $create_alias->execute($src, $root); $create_alias->finish();
+ if (defined(services_conf_default_protect)) {
+ $set_protect_level->execute((defined(services_conf_default_protect) ?
+ $protect_level{lc services_conf_default_protect} : 1), $src);
+ $set_protect_level->finish();
+ }
+ $unlock_tables->execute; $unlock_tables->finish;
+
+ if(is_identified($user, $root)) {
+ $identify_ign->execute($uid, $root); $identify_ign->finish();
+ $id_update->execute($root, $uid); $id_update->finish();
+ } else {
+ ns_identify($user, $root, $pass);
+ }
+ }
+
+ notice($user, "\002$src\002 is now linked to \002$root\002.");
+ services::ulog($nsnick, LOG_INFO(), "made $src an alias of $root.", $user);
+
+ check_identify($user);
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(unlink drop)],
+ SYNTAX => '[nick] password',
+ OPTIONAL_DEFAULT_SRC => 1,
+ CALL => \&ns_unlink,
+};
+
+sub ns_unlink($$$) {
+ my ($user, $nick, $pass) = @_;
+ my $uid = get_user_id($user);
+ my $src = get_user_nick($user);
+
+ my $root = get_root_nick($nick);
+ unless(chk_pass($root, $pass, $user)) {
+ notice($user, $err_pass);
+ return;
+ }
+
+ if(nr_chk_flag($nick, NRF_FREEZE) and (lc $pass ne 'force')) {
+ notice($user, "\002$root\002 has been frozen and may not be used.", $err_deny);
+ services::ulog($nsnick, LOG_INFO(), "\00305attempted to unlink \002$nick\002 from frozen nick \002$root\002", $user);
+ return;
+ }
+
+ if(lc $root eq lc $nick) {
+ $count_aliases->execute($root);
+ my ($count) = $count_aliases->fetchrow_array;
+ if($count == 1) {
+ ns_dropgroup_real($user, $root);
+ return;
+ }
+
+ $get_random_alias->execute($root);
+ my ($new) = $get_random_alias->fetchrow_array;
+ ns_changeroot($user, $root, $new, 1);
+
+ $root = $new;
+ }
+
+ unidentify_single($nick);
+ delete_alias($nick);
+ enforcer_quit($nick);
+
+ notice($user, "\002$nick\002 has been unlinked from \002$root\002.");
+ services::ulog($nsnick, LOG_INFO(), "removed alias $nick from $root.", $user);
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(dropgroup)],
+ SYNTAX => '[nick] password',
+ OPTIONAL_DEFAULT_SRC => 1,
+ CALL => \&ns_dropgroup,
+};
+
+sub ns_dropgroup($$$) {
+ my ($user, $nick, $pass) = @_;
+ my $uid = get_user_id($user);
+ my $src = get_user_nick($user);
+ my $root = get_root_nick($nick);
+
+ if(adminserv::get_svs_level($root)) {
+ notice($user, "A nick with services access may not be dropped.");
+ return;
+ }
+
+ unless(chk_pass($root, $pass, $user)) {
+ notice($user, $err_pass);
+ return;
+ }
+
+ if(nr_chk_flag($nick, NRF_FREEZE) and (lc $pass ne 'force')) {
+ notice($user, "This nick has been frozen and may not be used.", $err_deny);
+ services::ulog($nsnick, LOG_INFO(), "\00305attempted to dropgroup frozen nick \002$root\002", $user);
+ return;
+ }
+
+ ns_dropgroup_real($user, $root);
+}
+
+sub ns_dropgroup_real($$) {
+ my ($user, $root) = @_;
+ my $src = get_user_nick($user);
+
+ unidentify($root, "Your nick, \002$root\002, was dropped by \002$src\002.", $src);
+ dropgroup($root);
+ #enforcer_quit($nick);
+ notice($user, "Your nick(s) have been dropped. Thanks for playing.");
+
+ services::ulog($nsnick, LOG_INFO(), "dropped group $root.", $user);
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(chgroot changeroot)],
+ SYNTAX => '[oldnick] newroot',
+ OPTIONAL_DEFAULT_SRC => 1,
+ CALL => \&ns_changeroot,
+};
+
+sub ns_changeroot($$$;$) {
+ my ($user, $old, $new, $force) = @_;
+
+ $force or chk_identified($user, $old) or return;
+
+ my $root = get_root_nick($old);
+
+ if(lc($new) eq lc($root)) {
+ notice($user, "\002$root\002 is already your root nick.");
+ return;
+ }
+
+ unless(get_root_nick($new) eq $root) {
+ notice($user, "\002$new\002 is not an alias of your nick. Type \002/msg nickserv help link\002 for information about creating aliases.");
+ return;
+ }
+
+ changeroot($root, $new);
+
+ notice($user, "Your root nick is now \002$new\002.");
+ services::ulog($nsnick, LOG_INFO(), "changed root $root to $new.", $user);
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(info)],
+ SYNTAX => 'LIST:nick',
+ CALL => \&ns_info,
+};
+
+sub ns_info($$$) {
+ my ($user, $nick1, $nickList) = @_;
+ my @nicks = ($nickList ? @$nickList : () );
+ if(scalar(@nicks) == 0) {
+ @nicks = (get_user_nick($user));
+ }
+ foreach my $nick (@nicks) {
+ my $root = get_root_nick($nick);
+
+ $get_info->execute($nick);
+ my @result = $get_info->fetchrow_array;
+ $get_info->finish();
+
+ unless(@result) {
+ notice($user, "The nick \002$nick\002 is not registered.");
+ next;
+ }
+
+ my ($email, $regd, $last, $flags, $ident, $vhost, $gecos, $alias_used) = @result;
+ # the quit entry might not exist if the user hasn't quit yet.
+ $get_nickreg_quit->execute($nick);
+ my ($quit) = $get_nickreg_quit->fetchrow_array(); $get_nickreg_quit->finish();
+ my $hidemail = $flags & NRF_HIDEMAIL;
+
+ $get_greet_nick->execute($nick);
+ my ($greet) = $get_greet_nick->fetchrow_array(); $get_greet_nick->finish();
+ $get_umode_ntf->execute($nick);
+ my ($umode) = $get_umode_ntf->fetchrow_array(); $get_umode_ntf->finish();
+
+ my $svslev = adminserv::get_svs_level($root);
+ my $protect = protect_level($nick);
+ my $showprivate = (is_identified($user, $nick) or
+ adminserv::is_svsop($user, adminserv::S_HELP()));
+
+ my ($seens, $seenm) = do_seen($nick);
+
+ my @data;
+
+ push @data, {FULLROW=>"(Online now, $seenm.)"} if $seens == 2;
+ push @data, ["Last seen:", "$seenm."] if $seens == 1;
+
+ push @data,
+ ["Last seen address:", "$ident\@$vhost"],
+ ["Registered:", gmtime2($regd)];
+ push @data, ["Last used:", ($alias_used ? gmtime2($alias_used) : 'Unknown')] if $showprivate;
+ push @data, ["Last real name:", $gecos];
+
+ push @data, ["Services Rank:", $adminserv::levels[$svslev]]
+ if $svslev;
+ push @data, ["E-mail:", $email] unless $hidemail;
+ push @data, ["E-mail:", "$email (Hidden)"]
+ if($hidemail and $showprivate);
+ push @data, ["Alias of:", $root]
+ if ((lc $root ne lc $nick) and $showprivate);
+
+ my @extra;
+
+ push @extra, "Last quit: $quit" if $quit;
+ push @extra, $protect_long[$protect] if $protect;
+ push @extra, "Does not accept memos." if($flags & NRF_NOMEMO);
+ push @extra, "Cannot be added to channel access lists." if($flags & NRF_NOACC);
+ push @extra, "Will not be automatically opped in channels." if($flags & NRF_NEVEROP);
+ push @extra, "Requires authorization to be added to channel access lists."
+ if($flags & NRF_AUTH);
+ push @extra, "Is frozen and may not be used." if($flags & NRF_FREEZE);
+ push @extra, "Will not expire." if($flags & NRF_HOLD);
+ push @extra, "Is currently on vacation." if($flags & NRF_VACATION);
+ push @extra, "Registration pending email-code verification." if($flags & NRF_EMAILREG);
+ push @extra, "UModes on Identify: ".$umode if ($umode and $showprivate);
+ push @extra, "Greeting: ".$greet if ($greet and $showprivate);
+ push @extra, "Disabled highlighting of alternating lines." if ($flags & NRF_NOHIGHLIGHT);
+
+ notice($user, columnar({TITLE => "NickServ info for \002$nick\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)},
+ @data, {COLLAPSE => \@extra, BULLET => 1}));
+ }
+}
+
+
+ns_command ['set'], \&ns_set_parse;
+
+sub ns_set_parse($$) {
+ my ($user, $p) = @_;
+ my @parms = split(/\s+/, $p);
+ my $src = get_user_nick($user);
+# This is a new NS SET parser
+# required due to it's annoying syntax
+#
+# Most commands have only 2 params at most
+# the target (which is implied to be src when not spec'd)
+# However in the case of GREET num-params is unbounded
+#
+# Alternative parsings would be possible,
+# one being to use a regexp for valid set/keys
+ if (lc($parms[1]) eq 'greet') {
+ ns_set($user, @parms);
+ }
+ elsif(lc($parms[0]) eq 'greet') {
+ ns_set($user, $src, @parms);
+ }
+ else {
+ if(@parms == 2) {
+ ns_set($user, $src, $parms[0], $parms[1]);
+ }
+ elsif(@parms == 3) {
+ ns_set($user, $parms[0], $parms[1], $parms[2]);
+ }
+ else {
+ notice($user, 'Syntax: SET [nick] <option> <value>');
+ return;
+ }
+ }
+}
+
+sub ns_set($$$$) {
+ my ($user, $target, $set, @parms) = @_;
+ my $src = get_user_nick($user);
+ my $override = (adminserv::can_do($user, 'SERVOP') or
+ (adminserv::can_do($user, 'FREEZE') and $set =~ /^freeze$/i) ? 1 : 0);
+
+ unless(is_registered($target)) {
+ notice($user, "\002$target\002 is not registered.");
+ return;
+ }
+ unless(is_identified($user, $target) or $override) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ unless (
+ $set =~ /^protect$/i or
+ $set =~ /^e?-?mail$/i or
+ $set =~ /^pass(?:w(?:or)?d)?$/i or
+ $set =~ /^hidee?-?mail$/i or
+ $set =~ /^nomemo$/i or
+ $set =~ /^no(?:acc|op)$/i or
+ $set =~ /^neverop$/i or
+ $set =~ /^auth$/i or
+ $set =~ /^(hold|no-?expire)$/i or
+ $set =~ /^freeze$/i or
+ $set =~ /^vacation$/i or
+ $set =~ /^greet$/i or
+ $set =~ /^u?modes?$/i or
+ $set =~ /^(email)?reg$/i or
+ $set =~ /^nohighlight$/i or
+ $set =~ /^(?:(?:chg)?root|display)$/i
+ ) {
+ notice($user, qq{"$set" is not a valid NickServ setting.});
+ return;
+ }
+
+ my ($subj, $obj);
+ if($src eq $target) {
+ $subj='Your';
+ $obj='You';
+ } else {
+ $subj="\002$target\002\'s";
+ $obj="\002$target\002";
+ }
+ delete($user->{NICKFLAGS});
+
+ if($set =~ /^protect$/i) {
+ my $level = $protect_level{lc shift @parms};
+ unless (defined($level)) {
+ notice($user, "Syntax: SET PROTECT <none|normal|high|kill>");
+ return;
+ }
+
+ $set_protect_level->execute($level, $target);
+ notice($user, "$subj protection level is now set to \002".$protect_short[$level]."\002. ".$protect_long[$level]);
+
+ return;
+ }
+
+ elsif($set =~ /^e?-?mail$/i) {
+ unless(@parms == 1) {
+ notice($user, 'Syntax: SET EMAIL <address>');
+ return;
+ }
+ my $email = $parms[0];
+
+ unless(validate_email($email)) {
+ notice($user, $err_email);
+ return;
+ }
+
+ $set_email->execute($email, $target);
+ notice($user, "$subj email address has been changed to \002$email\002.");
+ services::ulog($nsnick, LOG_INFO(), "changed email of \002$target\002 to $email", $user);
+
+ return;
+ }
+
+ elsif($set =~ /^pass(?:w(?:or)?d)?$/i) {
+ unless(@parms == 1) {
+ notice($user, 'Syntax: SET PASSWD <address>');
+ return;
+ }
+ if($parms[0] =~ /pass/i) {
+ notice($user, 'Try a more secure password.');
+ }
+
+ $set_pass->execute(hash_pass($parms[0]), $target);
+ notice($user, "$subj password has been changed.");
+ services::ulog($nsnick, LOG_INFO(), "changed password of \002$target\002", $user);
+ if(nr_chk_flag($target, NRF_SENDPASS())) {
+ $del_nicktext->execute(NTF_AUTHCODE, $target); $del_nicktext->finish();
+ nr_set_flag($target, NRF_SENDPASS(), 0);
+ }
+
+ return;
+ }
+
+ elsif($set =~ /^greet$/i) {
+ unless(@parms) {
+ notice($user, 'Syntax: SET [nick] GREET <NONE|greeting>');
+ return;
+ }
+
+ my $greet = join(' ', @parms);
+ if ($greet =~ /^(none|off)$/i) {
+ $del_greet->execute($target);
+ notice($user, "$subj greet has been deleted.");
+ services::ulog($nsnick, LOG_INFO(), "deleted greet of \002$target\002", $user);
+ }
+ else {
+ $set_greet->execute($greet, $target);
+ notice($user, "$subj greet has been set to \002$greet\002");
+ services::ulog($nsnick, LOG_INFO(), "changed greet of \002$target\002", $user);
+ }
+
+ return;
+ }
+ elsif($set =~ /^u?modes?$/i) {
+ unless(@parms == 1) {
+ notice($user, 'Syntax: SET UMODE <+modes-modes|none>');
+ return;
+ }
+
+ if (lc $parms[0] eq 'none') {
+ $del_nicktext->execute(NTF_UMODE, $target); $del_nicktext->finish();
+ notice($user, "umode on identify for \002$obj\002 deleted");
+ }
+ else {
+ my $modes = modes::allowed_umodes($parms[0]);
+ $del_nicktext->execute(NTF_UMODE, $target); $del_nicktext->finish(); # don't allow dups
+ $set_umode_ntf->execute($modes, $target); $set_umode_ntf->finish();
+ foreach my $usernick (get_nick_user_nicks $target) {
+ ircd::setumode($nsnick, $usernick, $modes)
+ }
+ notice($user, "umode on identify for \002$obj\002 set to $modes");
+ }
+ return;
+ }
+ elsif($set =~ /^(?:(?:chg)?root|display)$/i) {
+ ns_changeroot($user, $target, $parms[0], $override);
+ return;
+ }
+
+ my $val;
+ if($parms[0] =~ /^(?:no|off|false|0)$/i) { $val = 0; }
+ elsif($parms[0] =~ /^(?:yes|on|true|1)$/i) { $val = 1; }
+ else {
+ notice($user, "Please say \002on\002 or \002off\002.");
+ return;
+ }
+
+ if($set =~ /^hidee?-?mail$/i) {
+ nr_set_flag($target, NRF_HIDEMAIL, $val);
+
+ if($val) {
+ notice($user, "$subj email address is now hidden.");
+ } else {
+ notice($user, "$subj email address is now visible.");
+ }
+
+ return;
+ }
+
+ if($set =~ /^nomemo$/i) {
+ nr_set_flag($target, NRF_NOMEMO, $val);
+
+ if($val) {
+ notice($user, "$subj memos will be blocked.");
+ } else {
+ notice($user, "$subj memos will be delivered.");
+ }
+
+ return;
+ }
+
+ if($set =~ /^no(?:acc|op)$/i) {
+ nr_set_flag($target, NRF_NOACC, $val);
+
+ if($val) {
+ notice($user, "$obj may not be added to channel access lists.");
+ } else {
+ notice($user, "$obj may be added to channel access lists.");
+ }
+
+ return;
+ }
+
+ if($set =~ /^neverop$/i) {
+ nr_set_flag($target, NRF_NEVEROP, $val);
+
+ if($val) {
+ notice($user, "$obj will not be granted status upon joining channels.");
+ } else {
+ notice($user, "$obj will be granted status upon joining channels.");
+ }
+
+ return;
+ }
+
+ if($set =~ /^auth$/i) {
+ nr_set_flag($target, NRF_AUTH, $val);
+
+ if($val) {
+ notice($user, "$obj must now authorize additions to channel access lists.");
+ } else {
+ notice($user, "$obj will not be asked to authorize additions to channel access lists.");
+ }
+
+ return;
+ }
+
+ if($set =~ /^(hold|no-?expire)$/i) {
+ unless (adminserv::can_do($user, 'SERVOP') or
+ is_identified($user, $target) and adminserv::is_ircop($user))
+ {
+ notice($user, $err_deny);
+ return;
+ }
+
+ nr_set_flag($target, NRF_HOLD, $val);
+
+ if($val) {
+ notice($user, "\002$target\002 is now held from expiration.");
+ services::ulog($nsnick, LOG_INFO(), "has held \002$target\002", $user);
+ } else {
+ notice($user, "\002$target\002 will now expire normally.");
+ services::ulog($nsnick, LOG_INFO(), "released \002$target\002 from hold", $user);
+ }
+
+ return;
+ }
+
+ if($set =~ /^freeze$/i) {
+ unless (adminserv::can_do($user, 'FREEZE') or
+ is_identified($user, $target) and adminserv::is_ircop($user))
+ {
+ notice($user, $err_deny);
+ return;
+ }
+
+ nr_set_flag($target, NRF_FREEZE, $val);
+
+ if($val) {
+ notice($user, "\002$target\002 is now frozen.");
+ unidentify($target, "Your nick, \002$target\002, has been frozen and may no longer be used.");
+ services::ulog($nsnick, LOG_INFO(), "froze \002$target\002", $user);
+ } else {
+ notice($user, "\002$target\002 is no longer frozen.");
+ services::ulog($nsnick, LOG_INFO(), "unfroze \002$target\002", $user);
+ }
+
+ return;
+ }
+
+ if($set =~ /^vacation$/i) {
+ if ($val) {
+ $get_regd_time->execute($target);
+ my ($regd) = $get_regd_time->fetchrow_array;
+ $get_regd_time->finish();
+
+ if(($regd > (time() - 86400 * int(services_conf_vacationexpire / 3))) and !$override) {
+ notice($user, "$target is not old enough to use VACATION",
+ 'Minimum age is '.int(services_conf_vacationexpire / 3).' days');
+ return;
+ }
+
+ $get_vacation_ntf->execute($target);
+ my ($last_vacation) = $get_vacation_ntf->fetchrow_array();
+ $get_vacation_ntf->finish();
+ if(defined($last_vacation)) {
+ $last_vacation = unpack('N', MIME::Base64::decode($last_vacation));
+ if ($last_vacation > (time() - 86400 * int(services_conf_vacationexpire / 3)) and !$override) {
+ notice($user, "I'm sorry, \002$src\002, I'm afraid I can't do that.",
+ "Last vacation ended ".gmtime2($last_vacation),
+ 'Minimum time between vacations is '.int(services_conf_vacationexpire / 3).' days.');
+ return;
+ }
+ }
+ }
+
+ nr_set_flag($target, NRF_VACATION, $val);
+
+ services::ulog($nsnick, LOG_INFO(),
+ ($val ? 'enabled' : 'disabled')." vacation mode for \002$target\002", $user);
+ notice($user, "Vacation mode ".($val ? 'enabled' : 'disabled')." for \002$target\002");
+ return;
+ }
+
+ if($set =~ /^(email)?reg$/i) {
+ unless (adminserv::can_do($user, 'SERVOP'))
+ {
+ notice($user, $err_deny);
+ return;
+ }
+
+ nr_set_flag($target, NRF_EMAILREG, $val);
+
+ if($val) {
+ authcode($target, 'emailreg');
+ notice($user, "\002$target\002 now needs an email validation code.");
+ unidentify($target, ["Your nick, \002$target\002, has been flagged for an email validation audit.",
+ "Your nick will expire within 24 hours if you do not enter the validation code.",
+ "Check your email for further instructions."]);
+ services::ulog($nsnick, LOG_INFO(), "requested an email audit for \002$target\002", $user);
+ } else {
+ $del_nicktext->execute(NTF_AUTHCODE, $target); $del_nicktext->finish();
+ notice($user, "\002$target\002 is now fully registered.");
+ services::ulog($nsnick, LOG_INFO(), "validated the email for \002$target\002", $user);
+ }
+
+ return;
+ }
+
+ if($set =~ /^nohighlight$/i) {
+ nr_set_flag($target, NRF_NOHIGHLIGHT, $val);
+
+ if($val) {
+ notice($user, "$obj will no longer have alternative highlighting of lists.");
+ } else {
+ notice($user, "$obj will have alternative highlighting of lists.");
+ }
+
+ return;
+ }
+
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(sendpass)],
+ SYNTAX => 'nick',
+ CALL => \&ns_sendpass,
+};
+
+sub ns_sendpass($$) {
+ my ($user, $nick) = @_;
+
+ unless(adminserv::is_svsop($user, adminserv::S_HELP() )) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ my $email = get_email($nick);
+
+ unless($email) {
+ notice($user, "\002$nick\002 is not registered or does not have an email address.");
+ return;
+ }
+
+ my $pass = get_pass($nick);
+ if ($pass and !is_hashed($pass)) {
+ send_email($email, "$nsnick Password Reminder",
+ "The password for the nick $nick is:\n$pass");
+ notice($user, "Password for \002$nick\002 has been sent to \002$email\002.");
+ } else {
+ authcode($nick, 'sendpass', $email);
+ nr_set_flag($nick, NRF_SENDPASS);
+ notice($user, "Password authentication code for \002$nick\002 has been sent to \002$email\002.");
+ }
+
+ services::ulog($nsnick, LOG_INFO(), "used SENDPASS on $nick ($email)", $user);
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(glist links)],
+ SYNTAX => '[LIST:nick]',
+ CALL => \&ns_glist,
+};
+
+sub ns_glist($$) {
+ my ($user, $targetList) = @_;
+ my @targets = @$targetList;
+ if(scalar(@targets) == 0) {
+ @targets = (get_user_nick($user));
+ }
+
+ foreach my $target (@targets) {
+ my $root = get_root_nick($target);
+ unless($root) {
+ notice $user, "\002$target\002 is not registered.";
+ next;
+ }
+
+ unless(is_identified($user, $target) or
+ adminserv::is_svsop($user, adminserv::S_HELP())
+ ) {
+ notice $user, "$target: $err_deny";
+ next;
+ }
+
+ my @data;
+ $get_glist->execute($root);
+ while(my ($alias, $protect, $last) = $get_glist->fetchrow_array) {
+ my $time_ago;
+ if(0) {
+ # This needs a new NS GLIST cmd, like NS GLISTA or something.
+ # The idea is a command that shows the long version of the time_ago.
+ $time_ago = time_ago($last, 1);
+ } else {
+ $time_ago = time_ago($last);
+ }
+ push @data, ["\002$alias\002", "Protect: $protect_short[$protect]",
+ ($last ? "Last used $time_ago ago" : '')
+ ];
+ }
+
+ notice $user, columnar {TITLE => "Group list for \002$root\002 (" . $get_glist->rows . " nicks):",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data;
+
+ $get_glist->finish();
+ }
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(alist listchans)],
+ SYNTAX => '[LIST:nick]',
+ CALL => \&ns_alist,
+};
+
+sub ns_alist($$) {
+ my ($user, $targetList) = @_;
+ my @targets = @$targetList;
+ if(scalar(@targets) == 0) {
+ @targets = (get_user_nick($user));
+ }
+
+ foreach my $target (@targets) {
+ (adminserv::is_svsop($user, adminserv::S_HELP()) and (
+ chk_registered($user, $target) or next)
+ ) or chk_identified($user, $target) or next;
+
+ my @data;
+
+ $get_all_access->execute($target);
+ while(my ($c, $l, $a, $t) = $get_all_access->fetchrow_array) {
+ next unless $l > 0;
+ push @data, [$c, $chanserv::plevels[$l+$chanserv::plzero], ($a ? "($a)" : ''),
+ gmtime2($t)];
+ }
+
+ notice $user, columnar {TITLE => "Access listing for \002$target\002 (".scalar(@data)." entries)",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data;
+ }
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(list)],
+ SYNTAX => 'mask',
+ CALL => \&ns_list,
+};
+
+sub ns_list($$) {
+ my ($user, $mask) = @_;
+
+ unless(adminserv::is_svsop($user, adminserv::S_HELP())) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ my ($mnick, $mident, $mhost) = glob2sql(parse_mask($mask));
+
+ $mnick = '%' if($mnick eq '');
+ $mident = '%' if($mident eq '');
+ $mhost = '%' if($mhost eq '');
+
+ my @data;
+ $get_matching_nicks->execute($mnick, $mident, $mhost);
+ while(my ($rnick, $rroot, $rident, $rhost) = $get_matching_nicks->fetchrow_array) {
+ push @data, [$rnick, ($rroot ne $rnick ? $rroot : ''), $rident . '@' . $rhost];
+ }
+
+ notice $user, columnar {TITLE => "Registered nicks matching \002$mask\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data;
+}
+
+ns_command ['watch'], sub {
+ my $user = shift;
+ my @args = split ' ', shift;
+
+ if ($args[0] =~ /^(add|del|list)$/i) {
+ ns_watch($user, get_user_nick($user), @args);
+ }
+ elsif ($args[1] =~ /^(add|del|list)$/i) {
+ ns_watch($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: WATCH <ADD|DEL|LIST> [nick]');
+ }
+};
+
+sub ns_watch($$$;$) {
+ my ($user, $target, $cmd, $mask) = @_;
+ my $src = get_user_nick($user);
+
+ my $root = get_root_nick($target);
+ unless ($root) {
+ notice($user, "\002$target\002 is not registered.");
+ return;
+ }
+ unless(is_identified($user, $target)) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if ($cmd =~ /^add$/i) {
+ my $max_watches = $IRCd_capabilities{WATCH}; # load here for caching.
+ if(count_watches($root) >= $max_watches) {
+ notice($user, "WATCH list for $target full, there is a limit of $max_watches. Please trim your list.");
+ return;
+ }
+
+ if($mask =~ /\!/ or $mask =~ /\@/) {
+ my ($mnick, $mident, $mhost) = parse_mask($mask);
+ if ($mnick =~ /\*/) {
+ notice($user, "Invalid mask: \002$mask\002",
+ 'A WATCH mask cannot wildcard the nick.');
+ return;
+ }
+ }
+
+ $check_watch->execute($root, $mask);
+ if ($check_watch->fetchrow_array) {
+ notice($user, "\002$mask\002 is already in \002$target\002's watch list.");
+ return;
+ }
+
+ $set_watch->execute($mask, time(), $root);
+ ircd::svswatch($nsnick, $src, "+$mask");
+ notice($user, "\002$mask\002 added to \002$target\002's watch list.");
+ return;
+ }
+ elsif ($cmd =~ /^del(ete)?$/i) {
+ $check_watch->execute($root, $mask);
+ unless ($check_watch->fetchrow_array) {
+ notice($user, "\002$mask\002 is not in \002$target\002's watch list.");
+ return;
+ }
+ $del_watch->execute($root, $mask);
+ ircd::svswatch($nsnick, $src, "-$mask");
+ notice($user, "\002$mask\002 removed from \002$target\002's watch list.");
+ }
+ elsif ($cmd =~ /^list$/i) {
+ my @data;
+
+ $get_watches->execute($root);
+ while(my ($mask, $time) = $get_watches->fetchrow_array) {
+ push @data, [$mask, gmtime2($time)];
+ }
+
+ notice $user, columnar {TITLE => "Watch list for \002$target\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data;
+ }
+ else {
+ notice($user, 'Syntax: WATCH <ADD|DEL|LIST> [nick]');
+ }
+}
+
+ns_command ['silence'], sub {
+ my $user = shift;
+ my @args = split ' ', shift;
+
+ if ($args[0] =~ /^(add|del|list)$/i) {
+ ns_silence($user, get_user_nick($user), @args);
+ }
+ elsif ($args[1] =~ /^(add|del|list)$/i) {
+ ns_silence($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: SILENCE [nick] <ADD|DEL|LIST> [mask] [+expiry] [comment]');
+ }
+};
+
+sub ns_silence($$$;$@) {
+ my ($user, $target, $cmd, $mask, @args) = @_;
+ my ($expiry, $comment);
+ my $src = get_user_nick($user);
+
+sub get_silence_by_num($$) {
+# This one cannot be converted to SrSv::MySQL::Stub, due to bind_param call
+ my ($nick, $num) = @_;
+ $get_silence_by_num->execute($nick, $num-1);
+ my ($mask) = $get_silence_by_num->fetchrow_array();
+ $get_silence_by_num->finish();
+ return $mask;
+}
+
+ my $root = get_root_nick($target);
+ unless ($root) {
+ notice($user, "\002$target\002 is not registered.");
+ return;
+ }
+
+ unless(is_identified($user, $target)) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if ($cmd =~ /^add$/i) {
+ my $max_silences = $IRCd_capabilities{SILENCE};
+ if(count_silences($root) >= $max_silences) {
+ notice($user, "SILENCE list for $target full, there is a limit of $max_silences. Please trim your list.");
+ return;
+ }
+
+ if (substr($args[0],0,1) eq '+') {
+ $expiry = shift @args;
+ }
+ elsif (substr($args[-1],0,1) eq '+') {
+ $expiry = pop @args;
+ }
+ $comment = join(' ', @args);
+
+ if($mask !~ /[!@.]/) {
+ my $target_user = { NICK => $mask };
+ unless(get_user_id($target_user)) {
+ notice($user, qq{"\002$mask\002" is not a known user, nor a valid hostmask.});
+ return;
+ }
+ $comment = $mask unless $comment;
+ no warnings 'misc';
+ my ($ident, $vhost) = get_vhost($target_user);
+ my ($nick, $ident, $vhost) = make_hostmask(10, $mask, $ident, $vhost);
+ $mask = $nick.'!'.$ident.'@'.$vhost;
+ }
+ else {
+ $mask = normalize_hostmask($mask);
+ }
+
+ if("$nsnick!services\@".main_conf_local =~ hostmask_to_regexp($mask)) {
+ notice($user, "You shouldn't add NickServ to your SILENCE list.");
+ return;
+ }
+
+ $check_silence->execute($root, $mask);
+ if ($check_silence->fetchrow_array) {
+ notice($user, "\002$mask\002 is already in \002$target\002's SILENCE list.");
+ return;
+ }
+
+ if(defined $expiry) {
+ $expiry = parse_time($expiry) + time();
+ }
+ else {
+ $expiry = 0;
+ };
+ $set_silence->execute($mask, time(), $expiry, $comment, $root);
+ ircd::svssilence($nsnick, $src, "+$mask");
+ notice($user, "\002$mask\002 added to \002$target\002's SILENCE list.");
+ }
+ elsif ($cmd =~ /^del(ete)?$/i) {
+ my @masks;
+ if ($mask =~ /^[0-9\.,-]+$/) {
+ foreach my $num (makeSeqList($mask)) {
+ push @masks, get_silence_by_num($root, $num) or next;
+ }
+ if(scalar(@masks) == 0) {
+ notice($user, "Unable to find any silences matching $mask");
+ return;
+ }
+ } else {
+ @masks = ($mask);
+ }
+ my @reply; my @out_masks;
+ foreach my $mask (@masks) {
+ $check_silence->execute($root, $mask);
+ unless ($check_silence->fetchrow_array) {
+ $mask = normalize_hostmask($mask);
+
+ $check_silence->execute($root, $mask);
+ unless ($check_silence->fetchrow_array) {
+ push @reply, "\002$mask\002 is not in \002$target\002's SILENCE list.";
+ next;
+ }
+ }
+ $del_silence->execute($root, $mask);
+ push @out_masks, "-$mask";
+ push @reply, "\002$mask\002 removed from \002$target\002's SILENCE list.";
+ }
+ ircd::svssilence($nsnick, $src, @out_masks);
+ notice($user, @reply);
+ }
+ elsif ($cmd =~ /^list$/i) {
+ $get_silences->execute($root);
+
+ my @reply; my $i = 1;
+ while(my ($mask, $time, $expiry, $comment) = $get_silences->fetchrow_array) {
+ push @reply, "$i \002[\002 $mask \002]\002 Date added: ".gmtime2($time),
+ ' '.($comment ? "\002[\002 $comment \002]\002 " : '').
+ ($expiry ? 'Expires in '.time_rel($expiry-time()) :
+ "\002[\002 Never expires \002]\002");
+ $i++;
+ }
+
+ notice($user, "SILENCE list for \002$target\002:", (scalar @reply ? @reply : " list empty"));
+ }
+ else {
+ notice($user, 'Syntax: SILENCE [nick] <ADD|DEL|LIST> [mask] [+expiry] [comment]');
+ }
+
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(acc access stat status)],
+ SYNTAX => 'LIST:nick',
+ CALL => \&ns_acc,
+};
+
+sub ns_acc($$) {
+ my ($user, $targetList) = @_;
+ my @reply;
+ my @targets = @$targetList;
+ if(scalar(@targets) == 0) {
+ @targets = (get_user_nick($user));
+ }
+
+ foreach my $target (@targets) {
+ unless(is_registered($target)) {
+ push @reply, "ACC 0 \002$target\002 is not registered.";
+ next;
+ }
+
+ unless(is_online($target)) {
+ push @reply, "ACC 1 \002$target\002 is registered and offline.";
+ next;
+ }
+
+ unless(is_identified({NICK => $target}, $target)) {
+ push @reply, "ACC 2 \002$target\002 is online but not identified.";
+ next;
+ }
+
+ push @reply, "ACC 3 \002$target\002 is registered and identified.";
+ }
+ notice($user, @reply);
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(seen)],
+ SYNTAX => 'LIST:nick',
+ CALL => \&ns_seen,
+};
+
+sub ns_seen($$) {
+ my ($user, $nicks) = @_;
+
+ foreach my $nick (@$nicks) {
+ if(lc $nick eq lc $user->{AGENT}) {
+ notice($user, "Oh, a wise guy, eh?");
+ next;
+ }
+ my ($status, $msg) = do_seen($nick);
+ if($status == 2) {
+ notice($user, "\002$nick\002 is online now, ".$msg.'.');
+ } elsif($status == 1) {
+ notice($user, "\002$nick\002 was last seen ".$msg.'.');
+ } else {
+ notice($user, "The nick \002$nick\002 is not registered.");
+ }
+ }
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(recover)],
+ SYNTAX => 'nick [password]',
+ CALL => \&ns_recover,
+};
+
+sub ns_recover($$;$) {
+ my ($user, $nick, $pass) = @_;
+ my $src = get_user_nick($user);
+
+ if(nr_chk_flag($nick, NRF_FREEZE)) {
+ notice($user, "This nick has been frozen and may not be used.", $err_deny);
+ services::ulog($nsnick, LOG_INFO(), "\00305attempted to recover frozen nick \003\002$nick\002", $user);
+ return;
+ }
+
+ unless(is_identified($user, $nick)) {
+ if($pass) {
+ my $s = ns_identify($user, $nick, $pass);
+ return if($s == 0); #failed to identify
+ } else {
+ notice($user, $err_deny);
+ return;
+ }
+ }
+
+ if(!is_online($nick)) {
+ notice($user, "\002$nick\002 is not online");
+ return;
+ } elsif(lc $src eq lc $nick) {
+ notice($user, "I'm sorry, $src, I'm afraid I can't do that.");
+ return;
+
+ } else {
+ collide($nick);
+ notice($user, "User claiming your nick has been collided",
+ "/msg NickServ RELEASE $nick to get it back before the one-minute timeout.");
+ services::ulog($nsnick, LOG_INFO(), "used NickServ RECOVER on $nick", $user);
+ return;
+ }
+}
+
+ns_command ['auth'], sub {
+ my $user = shift;
+ my @args = split ' ', shift;
+
+ if (@args >= 1) {
+ ns_auth($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: AUTH [nick] <LIST|ACCEPT|DECLINE> [num|chan]');
+ }
+};
+
+sub ns_auth($@) {
+ my ($user, @args) = @_;
+ my ($target, $cmd);
+
+#These helpers shouldn't be needed anywhere else.
+# If they ever are, move them to the helpers section
+ sub get_auth_num($$) {
+ # this cannot be converted to SrSv::MySQL::Stub, due to bind_param
+ my ($nick, $num) = @_;
+ $get_auth_num->execute($nick, $num - 1);
+ my ($cn, $data) = $get_auth_num->fetchrow_array();
+ $get_auth_num->finish();
+ return ($data ? ($cn, split(/:/, $data)) : undef);
+ }
+ sub get_auth_chan($$) {
+ my ($nick, $cn) = @_;
+ $get_auth_chan->execute($nick, $cn);
+ my ($data) = $get_auth_chan->fetchrow_array();
+ $get_auth_chan->finish();
+ return (split(/:/, $data));
+ }
+
+ if ($args[0] =~ /^(list|accept|approve|decline|reject)$/i) {
+ $target = get_user_nick($user);
+ $cmd = lc shift @args;
+ }
+ else {
+ $target = shift @args;
+ $cmd = lc shift @args;
+ }
+
+ unless (is_registered($target)) {
+ notice($user, "The nickname \002$target\002 is not registered");
+ return;
+ }
+ unless (is_identified($user, $target)) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if ($cmd eq 'list') {
+ my @data;
+ $list_auth->execute($target);
+ while (my ($cn, $data) = $list_auth->fetchrow_array()) {
+ my ($adder, $old, $level, $time) = split(':', $data);
+ push @data, [$cn, $chanserv::levels[$level], $adder, gmtime2($time)];
+ }
+ if ($list_auth->rows()) {
+ notice $user, columnar {TITLE => "Pending authorizations for \002$target\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data;
+ }
+ else {
+ notice($user, "There are no pending authorizations for \002$target\002");
+ }
+ }
+ elsif ($cmd eq 'accept' or $cmd eq 'approve') {
+ my $parm = shift @args;
+ my ($cn, $adder, $old, $level, $time);
+ if(misc::isint($parm) and
+ ($cn, $adder, $old, $level, $time) = get_auth_num($target, $parm))
+ {
+ }
+ elsif ($parm =~ /^\#/ and
+ ($adder, $old, $level, $time) = get_auth_chan($target, $parm))
+ {
+ $cn = $parm;
+ }
+ unless ($cn) {
+ # This should normally be an 'else' as the elsif above should prove false
+ # For some reason, it doesn't work. the unless ($cn) fixes it.
+ # It only doesn't work for numbered entries
+ notice($user, "There is no entry for \002$parm\002 in \002$target\002's AUTH list");
+ return;
+ }
+ my $chan = { CHAN => $cn };
+ my $root = get_root_nick($target);
+
+ # These next 3 lines should use chanserv::set_acc() but it doesn't seem to work.
+ # It won't let me use a $nick instead of $user
+ $chanserv::set_acc1->execute($cn, $level, $root);
+ $chanserv::set_acc2->execute($level, $adder, $cn, $root);
+ chanserv::set_modes_allnick($root, $chan, $level) unless chanserv::is_neverop($root);
+
+ my $log_str = ($old?'move':'addition')." \002$root\002"
+ . ($old ? ' from the '.$chanserv::levels[$old] : '') .
+ ' to the '.$chanserv::levels[$level]." list of \002$cn\002";
+ services::ulog($chanserv::csnick, LOG_INFO(), "accepted the $log_str from $adder", $user, $chan);
+ notice($user, "You have accepted the $log_str");
+ $del_auth->execute($target, $cn);
+ $del_auth->finish();
+ memoserv::send_memo($chanserv::csnick, $adder, "$target accepted the $log_str");
+ }
+ elsif ($cmd eq 'decline' or $cmd eq 'reject') {
+ my $parm = shift @args;
+ my ($cn, $adder, $old, $level, $time);
+ if(misc::isint($parm) and
+ ($cn, $adder, $old, $level, $time) = get_auth_num($target, $parm))
+ {
+ }
+ elsif ($parm =~ /^\#/ and
+ ($adder, $old, $level, $time) = get_auth_chan($target, $parm))
+ {
+ $cn = $parm;
+ }
+ unless ($cn) {
+ # This should normally be an 'else' as the elsif above should prove false
+ # For some reason, it doesn't work. the unless ($cn) fixes it.
+ # It only doesn't work for numbered entries
+ notice($user, "There is no entry for \002$parm\002 in \002$target\002's AUTH list");
+ return;
+ }
+ my $chan = { CHAN => $cn };
+
+ my $root = get_root_nick($target);
+ my $log_str = ($old?'move':'addition')." \002$root\002"
+ . ($old ? ' from the '.$chanserv::levels[$old] : '') .
+ ' to the '.$chanserv::levels[$level]." list of \002$cn\002";
+ services::ulog($chanserv::csnick, LOG_INFO(), "declined the $log_str from $adder", $user, $chan);
+ notice($user, "You have declined $log_str");
+ $del_auth->execute($target, $cn);
+ $del_auth->finish();
+ memoserv::send_memo($chanserv::csnick, $adder, "$target declined the $log_str");
+ }
+ #elsif ($cmd eq 'read') {
+ #}
+ else {
+ notice($user, "Unknown AUTH cmd");
+ }
+}
+
+ns_command new SrSv::AgentUI::Simple {
+ COMMAND => [qw(emailreg authcode emailcode)],
+ SYNTAX => 'nick code [newpassword]',
+ CALL => \&ns_authcode,
+};
+
+sub ns_authcode($$$;$) {
+ my ($user, $target, $code, $pass) = @_;
+
+ if ($pass and $pass =~ /pass/i) {
+ notice($user, 'Try a more secure password.');
+ return;
+ }
+
+ unless(is_registered($target)) {
+ notice($user, "\002$target\002 isn't registered.");
+ return;
+ }
+
+ if(authcode($target, undef, $code)) {
+ notice($user, "\002$target\002 authenticated.");
+ services::ulog($nsnick, LOG_INFO(), "logged in to \002$target\002 using an authcode", $user);
+
+ do_identify($user, $target, $target);
+ if($pass) {
+ ns_set($user, $target, 'PASSWD', $pass)
+ } elsif(nr_chk_flag($target, NRF_SENDPASS())) {
+ notice($user, "YOU MUST CHANGE YOUR PASSWORD NOW", "/NS SET $target PASSWD <newpassword>");
+ }
+ }
+ else {
+ notice($user, "\002$target\002 authentication failed. Please verify that you typed or pasted the code correctly.");
+ }
+}
+
+ns_command ['profile'], \&ns_profile;
+
+sub ns_profile($$@) {
+ my ($user, $first, @args) = @_;
+
+ my %profile_dispatch = (
+ 'read' => \&ns_profile_read,
+ 'info' => \&ns_profile_read,
+
+ 'del' => \&ns_profile_del,
+ 'delete' => \&ns_profile_del,
+
+ 'set' => \&ns_profile_update,
+ 'update' => \&ns_profile_update,
+ 'add' => \&ns_profile_update,
+
+ 'wipe' => \&ns_profile_wipe,
+ );
+
+ no warnings 'misc';
+ if(my $sub = $profile_dispatch{$args[0]}) {
+ # Second command with nick
+ shift @args;
+ $sub->($user, $first, @args);
+ }
+ elsif(my $sub = $profile_dispatch{$first}) {
+ # Second command without nick
+ $sub->($user, get_user_nick($user), @args);
+ }
+ elsif(@args == 0) {
+ # No second command
+ ns_profile_read($user, ($first || get_user_nick($user)));
+ }
+ else {
+ notice $user,
+ "Syntax: PROFILE [nick] [SET|DEL|READ|WIPE ...]",
+ "For help, type: \002/ns help profile\002";
+ }
+}
+
+sub ns_profile_read($$@) {
+ my ($user, $target, @args) = @_;
+
+ foreach my $nick ((scalar(@args) ? @args : $target)) {
+ next unless chk_registered($user, $nick);
+ my @profile_entries = get_profile_ntf($nick);
+ if(scalar(@profile_entries)) {
+ notice $user, columnar({TITLE => "Profile information for \002$nick\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)},
+ map( ["$_->[0]:", $_->[1]], @profile_entries )
+ );
+ }
+ else {
+ notice $user, "\002$nick\002 has not created a profile.";
+ }
+ }
+}
+
+sub ns_profile_update($$@) {
+ my ($user, $target, @args) = @_;
+
+ return unless chk_registered($user, $target);
+
+ unless(is_identified($user, $target) or
+ adminserv::is_svsop($user, adminserv::S_HELP())
+ ) {
+ notice($user, "$target: $err_deny");
+ return;
+ }
+
+ my ($key, $data) = (shift @args, join(' ', @args));
+
+ unless ($key and $data) {
+ notice $user, "Syntax: PROFILE [nick] SET <item> <text>",
+ "For help, type: \002/ns help profile\002";
+ return;
+ }
+
+ if(count_profile_ntf($target) >= MAX_PROFILE) {
+ notice($user, "You may not have more than ".MAX_PROFILE." profile items.");
+ return;
+ }
+ elsif (length($key) > 32) {
+ notice($user, "Item name may not be longer than 32 characters.");
+ return;
+ }
+ elsif (length($data) > MAX_PROFILE_LEN) {
+ my $over = length($data) - MAX_PROFILE_LEN;
+ notice($user, "Your entry is $over characters too long. (".MAX_PROFILE_LEN." max.)");
+ return;
+ }
+ add_profile_ntf($key, $data, $target);
+ notice($user, "\002$target\002's \002$key\002 is now \002$data\002");
+}
+
+sub ns_profile_del($$@) {
+ my ($user, $target, @args) = @_;
+
+ return unless chk_registered($user, $target);
+
+ unless(is_identified($user, $target) or
+ adminserv::is_svsop($user, adminserv::S_HELP())
+ ) {
+ notice($user, "$target: $err_deny");
+ return;
+ }
+
+ my $key = shift @args;
+
+ unless ($key) {
+ notice $user, "Syntax: PROFILE [nick] DEL <item>",
+ "For help, type: \002/ns help profile\002";
+ return;
+ }
+
+ if(del_profile_ntf($target, $key) == 0) {
+ notice($user, "There is no profile item \002$key\002 for \002$target\002");
+ } else {
+ notice($user, "Profile item \002$key\002 for \002$target\002 deleted.");
+ }
+}
+
+sub ns_profile_wipe($$@) {
+ my ($user, $target, undef) = @_;
+
+ unless (is_registered($target)) {
+ notice($user, "$target is not registered.");
+ next;
+ }
+ unless(is_identified($user, $target) or
+ adminserv::is_svsop($user, adminserv::S_HELP())
+ ) {
+ notice($user, "$target: $err_deny");
+ return;
+ }
+
+ wipe_profile_ntf($target);
+ notice($user, "Profile for \002$target\002 wiped.");
+}
+
+
+### MISCELLANEA ###
+
+sub do_seen($$) {
+ my ($nick) = @_;
+ my ($status, $msg);
+
+ $get_seen->execute($nick);
+ if (my ($alias, $root, $lastseen) = $get_seen->fetchrow_array) {
+ if(my @usernicks = get_nick_user_nicks($nick)) {
+ $status = 2;
+ $msg = "using ".(@usernicks==1 ? 'the nick ' : 'the following nicks: ').join(', ', map "\002$_\002", @usernicks);
+ }
+ else {
+ $status = 1;
+ $msg = time_ago($lastseen) . " ago (".gmtime2($lastseen).")";
+ }
+ }
+ else {
+ $status = 0; $msg = undef();
+ }
+ $get_seen->finish();
+
+ return ($status, $msg);
+}
+
+# For a whole group:
+sub unidentify($$;$) {
+ my ($nick, $msg, $src) = @_;
+
+ $nick = get_root_nick($nick);
+
+ foreach my $t (get_nick_user_nicks $nick) {
+ ircd::notice($nsnick, $t, (ref $msg ? @$msg : $msg)) unless(lc $t eq lc $src);
+ if(is_alias_of($nick, $t)) {
+ ircd::setumode($nsnick, $t, '-r');
+ }
+ }
+
+ $unidentify->execute($nick);
+}
+
+# For a single alias:
+sub unidentify_single($$) {
+ my ($nick, $msg) = @_;
+
+ if(is_online($nick)) {
+ ircd::setumode($nsnick, $nick, '-r');
+ }
+}
+
+sub kill_clones($$) {
+ my ($user, $ip) = @_;
+ my $uid = get_user_id($user);
+ my $src = get_user_nick($user);
+
+ return 0 if $ip == 0;
+
+ $chk_clone_except->execute($uid);
+ my ($lim) = $chk_clone_except->fetchrow_array;
+ return 0 if $lim == MAX_LIM();
+ $lim = services_conf_clone_limit unless $lim;
+
+ $count_clones->execute($ip);
+ my ($c) = $count_clones->fetchrow_array;
+
+ if($c > $lim) {
+ ircd::irckill($nsnick, $src, "Session Limit Exceeded");
+ return 1;
+ }
+}
+
+sub kill_user($$) {
+ my ($user, $reason) = @_;
+
+ ircd::irckill(get_user_agent($user) || main_conf_local, get_user_nick($user), $reason);
+}
+
+sub kline_user($$$) {
+ my ($user, $time, $reason) = @_;
+ my $agent = get_user_agent($user);
+ my ($ident, $host) = get_host($user);
+
+ ircd::kline($agent, '*', $host, $time, $reason);
+}
+
+sub do_identify ($$$;$$) {
+ my ($user, $nick, $root, $flags, $svsnick) = @_;
+ my $uid = get_user_id($user);
+ my $src = get_user_nick($user);
+
+ $identify_ign->execute($uid, $root);
+ $id_update->execute($root, $uid);
+
+ notice($user, 'You are now identified.');
+
+ delete($user->{NICKFLAGS});
+ if($flags & NRF_VACATION) {
+ notice($user, "Welcome back from your vacation, \002$nick\002.");
+ my $ts = MIME::Base64::encode(pack('N', time()));
+ chomp $ts;
+ $del_nicktext->execute(NTF_VACATION, $root); $del_nicktext->finish(); #don't allow dups
+ $set_vacation_ntf->execute($ts, $root);
+ $set_vacation_ntf->finish();
+ }
+
+ $get_umode_ntf->execute($nick);
+ my ($umodes) = $get_umode_ntf->fetchrow_array();
+ $get_umode_ntf->finish();
+ if(adminserv::get_svs_level($root)) {
+ $umodes = modes::merge_umodes('+h', $umodes);
+ ircd::nolag($nsnick, '+', $src);
+ }
+ $umodes = modes::merge_umodes('+r', $umodes) if(is_identified($user, $src));
+
+ hostserv::hs_on($user, $root, 1);
+
+ if(my @chans = get_autojoin_ntf($nick)) {
+ ircd::svsjoin($nsnick, $src, @chans);
+ }
+ nickserv::do_svssilence($user, $root);
+ nickserv::do_svswatch($user, $root);
+
+ chanserv::akick_alluser($user);
+ chanserv::set_modes_allchan($user, $flags & NRF_NEVEROP);
+ chanserv::fix_private_join_before_id($user);
+
+ services::ulog($nsnick, LOG_INFO(), "identified to nick $nick (root: $root)", $user);
+
+ memoserv::notify($user, $root);
+ notify_auths($user, $root) if $flags & NRF_AUTH;
+
+ my $enforced;
+ if(enforcer_quit($nick)) {
+ notice($user, 'Your nick has been released from custody.');
+ $enforced = 1;
+ }
+
+ if (lc($src) eq lc($nick)) {
+ ircd::setumode($nsnick, $src, $umodes);
+ $update_nickalias_last->execute($nick); $update_nickalias_last->finish();
+ }
+ elsif($svsnick) {
+ ircd::svsnick($nsnick, $src, $nick);
+ ircd::setumode($nsnick, $nick, modes::merge_umodes('+r', $umodes) );
+ # the update _should_ be taken care of in nick_change()
+ #$update_nickalias_last->execute($nick); $update_nickalias_last->finish();
+ }
+ elsif(defined $umodes) {
+ ircd::setumode($nsnick, $src, $umodes);
+ }
+ return ($enforced ? 2 : 1);
+}
+
+sub authcode($;$$) {
+ my ($nick, $type, $email) = @_;
+ if($type) {
+ unless (defined($email)) {
+ $email = get_email($nick);
+ }
+
+ my $authcode = misc::gen_uuid(4, 5);
+ $set_authcode_ntf->execute($authcode, $nick); $set_authcode_ntf->finish();
+ send_email($email, "Nick Authentication Code for $nick",
+ "Hello $nick,\n\n".
+
+ "You are receiving this message from the automated nickname\n".
+ "management system of the ".$IRCd_capabilities{NETWORK}." network.\n\n".
+ (lc($type) eq 'emailreg' ?
+ "If you did not try to register your nickname with us, you can\n".
+ "ignore this message. If you continue getting similar e-mails\n".
+ "from us, chances are that someone is intentionally abusing your\n".
+ "e-mail address. Please contact an administrator for help.\n".
+
+ "In order to complete your registration, you must follow the\n".
+ "instructions in this e-mail before ".gmtime2(time+86400)."\n".
+
+ "To complete the registration, the next time you connect, issue the\n".
+ "following command to NickServ:\n\n".
+
+ "After you issue the command, your registration will be complete and\n".
+ "you will be able to use your nickname.\n\n"
+
+ : '').
+ (lc($type) eq 'sendpass' ?
+ "You requested a password authentication code for the nickname '$nick'\n".
+ "on the ".$IRCd_capabilities{'NETWORK'}." IRC Network.\n".
+ "As per our password policies, an authcode has been created for\n".
+ "you and e-mailed to the address you set in NickServ.\n".
+ "To complete the process, you need to return to ".$IRCd_capabilities{'NETWORK'}.",\n".
+ "and execute the following command: \n\n"
+ : '').
+
+ "/NS EMAILCODE $nick $authcode\n\n".
+
+ (lc($type) eq 'sendpass' ?
+ "YOU MUST CHANGE YOUR PASSWORD AT THIS POINT.\n".
+ "You can do so via the following command: \n\n".
+ "/NS SET $nick PASSWD newpassword\n\n".
+ "alternately, try this command: \n\n".
+
+ "/NS EMAILCODE $nick $authcode <password>\n\n"
+ : '').
+
+ "---\n".
+ "If you feel you have gotten this e-mail in error, please contact\n".
+ "an administrator.\n\n".
+
+ "----\n".
+ "If this e-mail came to you unsolicited and appears to be spam -\n".
+ "please e-mail ".main_conf_replyto." with a copy of this e-mail\n".
+ "including all headers.\n\n".
+
+ "Thank you.\n");
+ }
+ else {
+ $get_authcode_ntf->execute($nick, $email);
+ my ($passed) = $get_authcode_ntf->fetchrow_array();
+ $get_authcode_ntf->finish();
+ if ($passed) {
+ nr_set_flag($nick, NRF_EMAILREG(), 0);
+ unless(nr_chk_flag($nick, NRF_SENDPASS)) {
+ $del_nicktext->execute(NTF_AUTHCODE, $nick); $del_nicktext->finish();
+ }
+ return 1;
+ }
+ else {
+ return 0;
+ }
+ }
+}
+
+# This is mostly for logging, be careful using it for anything else
+sub get_hostmask($) {
+ my ($user) = @_;
+ my ($ident, $host);
+ my $src = get_user_nick($user);
+
+ ($ident, $host) = get_host($user);
+
+ return "$src!$ident\@$host";
+}
+
+sub guestnick($) {
+ my ($nick) = @_;
+
+ $set_guest->execute(1, $nick);
+ my $randnick = 'Guest'.int(rand(10)).int(rand(10)).int(rand(10)).int(rand(10)).int(rand(10));
+ #Prevent collisions.
+ while (is_online($randnick)) {
+ $randnick = 'Guest'.int(rand(10)).int(rand(10)).int(rand(10)).int(rand(10)).int(rand(10));
+ }
+ ircd::svsnick($nsnick, $nick, $randnick);
+
+ return $randnick;
+}
+
+sub expire {
+ return if services_conf_noexpire;
+
+=cut
+ my ($ne, $e, $ve, $eve) = (services_conf_nearexpire, services_conf_nickexpire, services_conf_vacationexpire,
+ services_conf_validate_expire);
+=cut
+
+ $get_expired->execute(time() - (86400 * services_conf_nickexpire),
+ time() - (86400 * services_conf_vacationexpire),
+ time() - (86400 * services_conf_validate_expire));
+ while(my ($nick, $email, $ident, $vhost) = $get_expired->fetchrow_array) {
+ dropgroup($nick);
+ wlog($nsnick, LOG_INFO(), "$nick has expired. Email: $email Vhost: $ident\@$vhost");
+ }
+
+ my $time = time();
+
+ return unless services_conf_nearexpire; # if nearexpire is zero, don't.
+ $get_near_expired->execute(
+ $time - (86400 * (services_conf_nickexpire - services_conf_nearexpire)),
+ $time - (86400 * (services_conf_vacationexpire - services_conf_nearexpire))
+ );
+ while(my ($nick, $email, $flags, $last) = $get_near_expired->fetchrow_array) {
+ my $expire_days = services_conf_nearexpire;
+ if ( ( $flags & NRF_VACATION ) and ( $last < time() - (86400 * services_conf_vacationexpire) )
+ or (($last < time() - (86400 * services_conf_nickexpire)) ) )
+ {
+ $expire_days = 0;
+ } elsif ( ( $flags & NRF_VACATION ) and ( $last > time() - (86400 * services_conf_vacationexpire) )
+ or (($last > time() - (86400 * services_conf_nickexpire)) ) )
+ {
+ # this terrible invention is to determine how many days until their nick will expire.
+ # this should almost always be ~7, unless something weird happens like
+ # F_HOLD or svsop status is removed.
+ # int truncates, so we add 0.5.
+ $expire_days = -int(($time - ($last + (86400 *
+ ( ( $flags & NRF_VACATION ) ? services_conf_vacationexpire : services_conf_nickexpire ) )))
+ / 86400 + .5);
+ }
+ if($expire_days >= 1) {
+
+ $get_aliases->execute($nick);
+ my $aliases = $get_aliases->fetchrow_arrayref();
+
+ my $message = "We would like to remind you that your registered nick, $nick, will expire\n".
+ "in approximately $expire_days days unless you sign on and identify.";
+ if(scalar(@$aliases) > 1) {
+ $message .= "\n\nThe following nicks are linked in this group:\n " . join("\n ", @$aliases);
+ }
+
+ send_email($email, "$nsnick Expiration Notice", $message);
+ }
+
+ wlog($nsnick, LOG_INFO(), "$nick will expire ".($expire_days <= 0 ? "today" : "in $expire_days days.")." ($email)");
+ $set_near_expired->execute($nick);
+ }
+}
+
+sub expire_silence_timed {
+ my ($time) = shift;
+ $time = 60 unless $time;
+ add_timer('', $time, __PACKAGE__, 'nickserv::expire_silence_timed');
+
+ find_expired_silences();
+}
+
+# This code is a mess b/c we can only pull one entry at a time
+# and we want to batch the list to the user and to the ircd.
+# our SQL statement explicitly orders the silence entries by nickreg.nick
+sub find_expired_silences() {
+ $get_expired_silences->execute();
+ my ($lastnick, @entries);
+ while(my ($nick, $mask, $comment) = $get_expired_silences->fetchrow_array()) {
+ if ($nick eq $lastnick) {
+ } else {
+ do_expired_silences($lastnick, \@entries);
+ @entries = ();
+ $lastnick = $nick;
+ }
+ push @entries, [$mask, $comment];
+ }
+ if (@entries) {
+ do_expired_silences($lastnick, \@entries);
+ }
+ $get_expired_silences->finish();
+ $del_expired_silences->execute(); $del_expired_silences->finish();
+ return;
+}
+
+sub do_expired_silences($$) {
+ my $nick = $_[0];
+ my (@entries) = @{$_[1]};
+
+ foreach my $user (get_nick_users $nick) {
+ $user->{AGENT} = $nsnick;
+ ircd::svssilence($nsnick, get_user_nick($user), map ( { '-'.$_->[0] } @entries) );
+ #notice($user, "The following SILENCE entries have expired: ".
+ # join(', ', map ( { $_->[0] } @entries) ));
+ notice($user, map( { "The following SILENCE entry has expired: \002".$_->[0]."\002 ".$_->[1] } @entries ) );
+ }
+}
+sub do_svssilence($$) {
+ my ($user, $rootnick) = @_;
+ my $target = get_user_nick($user);
+
+ $get_silences->execute($rootnick);
+ my $count = $get_silences->rows;
+ unless ($get_silences->rows) {
+ $get_silences->finish;
+ return;
+ }
+ my @silences;
+ for(my $i = 1; $i <= $count; $i++) {
+ my ($mask, $time, $expiry) = $get_silences->fetchrow_array;
+ push @silences, "+$mask";
+ }
+ $get_silences->finish;
+ ircd::svssilence($nsnick, $target, @silences);
+ return;
+}
+
+sub do_svswatch($$) {
+ my ($user, $rootnick) = @_;
+ my $target = get_user_nick($user);
+
+ $get_watches->execute($rootnick);
+ my $count = $get_watches->rows;
+ unless ($get_watches->rows) {
+ $get_watches->finish;
+ return;
+ }
+ my @watches;
+ for(my $i = 1; $i <= $count; $i++) {
+ my ($mask, $time, $expiry) = $get_watches->fetchrow_array;
+ push @watches, "+$mask";
+ }
+ $get_watches->finish;
+ ircd::svswatch($nsnick, $target, @watches);
+ return;
+}
+
+sub do_umode($$) {
+ my ($user, $rootnick) = @_;
+ my $target = get_user_nick($user);
+
+ $get_umode_ntf->execute($rootnick);
+ my ($umodes) = $get_umode_ntf->fetchrow_array; $get_umode_ntf->finish();
+
+ ircd::setumode($nsnick, $target, $umodes) if $umodes;
+ return
+}
+
+sub notify_auths($$) {
+ my ($user, $nick) = @_;
+
+ $get_num_nicktext_type->execute($nick, NTF_AUTH);
+ my ($count) = $get_num_nicktext_type->fetchrow_array(); $get_num_nicktext_type->finish();
+ notice($user, "$nick has $count channel authorizations awaiting action.",
+ "To list them, type /ns auth $nick list") if $count;
+}
+
+### PROTECTION AND ENFORCEMENT ###
+
+sub protect($) {
+ my ($nick) = @_;
+
+ return if nr_chk_flag($nick, NRF_EMAILREG());
+ my $lev = protect_level($nick);
+ my $user = { NICK => $nick, AGENT => $nsnick };
+
+ notice($user,
+ "This nickname is registered and protected. If it is your",
+ "nick, type \002/msg NickServ IDENTIFY <password>\002. Otherwise,",
+ "please choose a different nick."
+ ) unless($lev==3);
+
+ if($lev == 1) {
+ warn_countdown("$nick 60");
+ }
+ elsif($lev==2) {
+ collide($nick);
+ }
+ elsif($lev==3) {
+ ircd::svshold($nick, 60, "If this is your nick, type /NS SIDENTIFY $nick \002password\002");
+ kill_user($user, "Unauthorized nick use with KILL protection enabled.");
+ $enforcers{lc $nick} = 1;
+ add_timer($nick, 60, __PACKAGE__, "nickserv::enforcer_delete");
+ }
+
+ return;
+}
+
+sub warn_countdown($) {
+ my ($cookie) = @_;
+ my ($nick, $rem) = split(/ /, $cookie);
+ my $user = { NICK => $nick, AGENT => $nsnick };
+
+ if (is_identified($user, $nick)) {
+ $update_nickalias_last->execute($nick); $update_nickalias_last->finish();
+ return;
+ }
+ elsif(!(is_online($nick)) or !(is_registered($nick))) { return; }
+
+ if($rem == 0) {
+ notice($user, 'Your nick is now being changed.');
+ collide($nick);
+ } else {
+ notice($user,
+ "If you do not identify or change your nick in $rem seconds, your nick will be changed.");
+ $rem -= 20;
+ add_timer("$nick $rem", 20, __PACKAGE__, "nickserv::warn_countdown");
+ }
+}
+
+sub collide($) {
+ my ($nick) = @_;
+
+ ircd::svshold($nick, 60, "If this is your nick, type /NS SIDENTIFY $nick \002password\002");
+ $enforcers{lc $nick} = 1;
+ add_timer($nick, 60, __PACKAGE__, "nickserv::enforcer_delete");
+
+ return guestnick($nick);
+}
+
+sub enforcer_delete($) {
+ my ($nick) = @_;
+ delete($enforcers{lc $nick});
+};
+
+sub enforcer_quit($) {
+ my ($nick) = @_;
+ if($enforcers{lc $nick}) {
+ enforcer_delete($nick);
+ ircd::svsunhold($nick);
+ return 1;
+ }
+ return 0;
+}
+
+### DATABASE UTILITY FUNCTIONS ###
+
+sub get_lock($) {
+ my ($nick) = @_;
+
+ $nick = lc $nick;
+
+ if($cur_lock) {
+ if($cur_lock ne $nick) {
+ really_release_lock($nick);
+ die("Tried to get two locks at the same time");
+ }
+ $cnt_lock++;
+ } else {
+ $cur_lock = $nick;
+ $get_lock->execute(sql_conf_mysql_db.".user.$nick");
+ $get_lock->finish;
+ }
+}
+
+sub release_lock($) {
+ my ($nick) = @_;
+
+ $nick = lc $nick;
+
+ if($cur_lock and $cur_lock ne $nick) {
+ really_release_lock($cur_lock);
+
+ die("Tried to release the wrong lock");
+ }
+
+ if($cnt_lock) {
+ $cnt_lock--;
+ } else {
+ really_release_lock($nick);
+ }
+}
+
+sub really_release_lock($) {
+ my ($nick) = @_;
+
+ $cnt_lock = 0;
+ $release_lock->execute(sql_conf_mysql_db.".user.$nick");
+ $release_lock->finish;
+ undef $cur_lock;
+}
+
+sub get_user_modes($) {
+ my ($user) = @_;
+
+ my $uid = get_user_id($user);
+ $get_umodes->execute($uid);
+ my ($umodes) = $get_umodes->fetchrow_array;
+ $get_umodes->finish();
+ return $umodes;
+};
+
+sub set_vhost($$) {
+ my ($user, $vhost) = @_;
+ my $id = get_user_id($user);
+
+ return $set_vhost->execute($vhost, $id);
+}
+
+sub set_ident($$) {
+ my ($user, $ident) = @_;
+ my $id = get_user_id($user);
+
+ return $set_ident->execute($ident, $id);
+}
+
+sub set_ip($$) {
+ my ($user, $ip) = @_;
+ my $id = get_user_id($user);
+
+ return $set_ip->execute($ip, $id);
+}
+
+sub get_root_nick($) {
+ my ($nick) = @_;
+
+ $get_root_nick->execute($nick);
+ my ($root) = $get_root_nick->fetchrow_array;
+
+ return $root;
+}
+
+sub get_id_nick($) {
+ my ($id) = @_;
+
+ $get_id_nick->execute($id);
+ my ($root) = $get_id_nick->fetchrow_array;
+
+ return $root;
+}
+
+sub drop($) {
+ my ($nick) = @_;
+
+ my $ret = $drop->execute($nick);
+ $drop->finish();
+ return $ret;
+}
+
+sub changeroot($$) {
+ my ($old, $new) = @_;
+
+ return if(lc $old eq lc $new);
+
+ $change_root->execute($new, $old);
+}
+
+sub dropgroup($) {
+ my ($root) = @_;
+
+ $del_all_access->execute($root);
+ $memoserv::delete_all_memos->execute($root);
+ $memoserv::wipe_ignore->execute($root);
+ $memoserv::purge_ignore->execute($root);
+ chanserv::drop_nick_chans($root);
+ $hostserv::del_vhost->execute($root);
+ $drop_watch->execute($root);
+ $drop_silence->execute($root);
+ $drop_nicktext->execute($root);
+ $delete_aliases->execute($root);
+ $chanserv::drop_nick_akick->execute($root);
+ drop($root);
+}
+
+sub is_alias($) {
+ my ($nick) = @_;
+
+ return (get_root_nick($nick) eq $nick);
+}
+
+sub delete_alias($) {
+ my ($nick) = @_;
+ return $delete_alias->execute($nick);
+}
+
+sub delete_aliases($) {
+ my ($root) = @_;
+ return $delete_aliases->execute($root);
+}
+
+sub get_all_access($) {
+ my ($nick) = @_;
+
+ $get_all_access->execute($nick);
+ return $get_all_access->fetchrow_array;
+}
+
+sub del_all_access($) {
+ my ($root) = @_;
+
+ return $del_all_access->execute($root);
+}
+
+sub chk_pass($$$) {
+ my ($nick, $pass, $user) = @_;
+
+ if(lc($pass) eq 'force' and adminserv::can_do($user, 'SERVOP')) {
+ if(adminserv::get_best_svs_level($user) > adminserv::get_svs_level($nick)) {
+ return 1;
+ }
+ }
+
+ return validate_pass(get_pass($nick), $pass);
+}
+
+sub inc_nick_inval($) {
+ my ($user) = @_;
+ my $id = get_user_id($user);
+
+ $inc_nick_inval->execute($id);
+ $get_nick_inval->execute($id);
+ my ($nick, $inval) = $get_nick_inval->fetchrow_array;
+ if($inval > 3) {
+ ircd::irckill($nsnick, $nick, 'Too many invalid passwords.');
+ # unnecessary as irckill calls the quit handler.
+ #nick_delete($nick);
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+sub is_registered($) {
+ my ($nick) = @_;
+
+ return (__is_registered($nick) ? 1 : 0);
+}
+
+sub chk_registered($;$) {
+ my ($user, $nick) = @_;
+ my $src = get_user_nick($user);
+ my $what;
+
+ if($nick) {
+ if(lc $src eq lc $nick) {
+ $what = "Your nick";
+ } else {
+ $what = "The nick \002$nick\002";
+ }
+ } else {
+ $nick = get_user_nick($user) unless $nick;
+ $what = "Your nick";
+ }
+
+ unless(is_registered($nick)) {
+ notice($user, "$what is not registered.");
+ return 0;
+ }
+
+ return 1;
+}
+
+sub is_alias_of($$) {
+ $is_alias_of->execute($_[0], $_[1]);
+ return ($is_alias_of->fetchrow_array ? 1 : 0);
+}
+
+sub check_identify($) {
+ my ($user) = @_;
+ my $nick = get_user_nick($user);
+ if(is_registered($nick)) {
+ if(is_identified($user, $nick)) {
+ ircd::setumode($nsnick, $nick, '+r');
+ $update_nickalias_last->execute($nick); $update_nickalias_last->finish();
+ return 1;
+ } else {
+ protect($nick);
+ }
+ }
+ return 0;
+}
+
+sub cleanup_users() {
+ add_timer('', OLD_USER_AGE(), __PACKAGE__, 'nickserv::cleanup_users');
+ my $time = (time() - OLD_USER_AGE()*2);
+ $cleanup_users->execute($time);
+ $cleanup_nickid->execute($time);
+ $cleanup_chanuser->execute();
+}
+
+sub fix_vhosts() {
+ return; # XXX
+ add_timer('fix_vhosts', 5, __PACKAGE__, 'nickserv::fix_vhosts');
+ $get_hostless_nicks->execute();
+ while (my ($nick) = $get_hostless_nicks->fetchrow_array) {
+ ircd::notice($nsnick, main_conf_diag, "HOSTLESS NICK $nick");
+ ircd::userhost($nick);
+ ircd::userip($nick);
+ }
+ $get_hostless_nicks->finish();
+}
+
+sub nick_cede($) {
+ my ($nick) = @_;
+ my $id;
+
+ $get_user_id->execute($nick);
+ if($id = $get_user_id->fetchrow_array) {
+ $nick_id_delete->execute($id);
+ $nick_delete->execute($nick);
+ }
+}
+
+### IRC EVENTS ###
+
+sub nick_create {
+ my ($nick, $time, $ident, $host, $vhost, $server, $svsstamp, $modes, $gecos, $ip, $cloakhost) = @_;
+ my $user = { NICK => $nick };
+ get_lock($nick);
+ if ($vhost eq '*') {
+ if ({modes::splitumodes($modes)}->{x} eq '+') {
+ if(defined($cloakhost)) {
+ $vhost = $cloakhost;
+ }
+ else { # This should never happen with CLK or VHP
+ ircd::userhost($nick);
+ }
+ } else {
+ $vhost = $host;
+ }
+ }
+
+ my $id;
+ if($svsstamp) {
+ $get_user_nick->execute($svsstamp);
+ my ($oldnick) = $get_user_nick->fetchrow_array();
+ $id = $svsstamp if defined($oldnick);
+ }
+ else {
+ $nick_check->execute($nick, $time);
+ ($id) = $nick_check->fetchrow_array;
+ }
+
+ if($id) {
+ $olduser{lc $nick} = 1;
+ $nick_create_old->execute($nick, $ident, $host, $vhost, $server, $modes, $gecos, UF_FINISHED(), $cloakhost, $id);
+ } else {
+ nick_cede($nick);
+
+ my $flags = (synced() ? UF_FINISHED() : 0);
+ my $i;
+ while($i < 10 and !$nick_create->execute($nick, $time, $ident, $host, $vhost, $server, $modes, $gecos, $flags, $cloakhost)) { $i++ }
+ $id = get_user_id( { NICK => $nick } ); # There needs to be a better way to do this
+ }
+ ircd::setsvsstamp($nsnick, $nick, $id) unless $svsstamp == $id;
+
+ $add_nickchg->execute($ircline, $nick, $nick);
+
+ release_lock($nick);
+
+ $newuser{lc $nick} = 1;
+
+ if($ip) {
+ nickserv::userip(undef, $nick, $ip);
+ }
+ else { # This should never happen with NICKIP
+ ircd::userip($nick);
+ }
+
+ return $id;
+}
+
+sub nick_create_post($) {
+ my ($nick) = @_;
+ my $user = { NICK => $nick };
+ my $old = $olduser{lc $nick};
+ delete $olduser{lc $nick};
+
+ operserv::do_news($nick, 'u') unless($old);
+
+ get_lock($nick);
+
+ check_identify($user);
+
+ release_lock($nick);
+}
+
+sub nick_delete($$) {
+ my ($nick, $quit) = @_;
+ my $user = { NICK => $nick };
+
+ get_lock($nick);
+
+ my $id = get_user_id($user);
+
+ $del_nickchg_id->execute($id); $del_nickchg_id->finish();
+
+ $quit_update->execute($quit, $id); $quit_update->finish();
+ $update_lastseen->execute($id); $update_lastseen->finish();
+
+ $get_quit_empty_chans->execute($id);
+
+ $chan_user_partall->execute($id); $chan_user_partall->finish();
+ #$nick_chan_delete->execute($id); $nick_chan_delete->finish();
+ $nick_quit->execute($nick); $nick_quit->finish();
+
+ release_lock($nick);
+
+ while(my ($cn) = $get_quit_empty_chans->fetchrow_array) {
+ chanserv::channel_emptied({CHAN => $cn});
+ }
+ $get_quit_empty_chans->finish();
+}
+
+sub squit($$$) {
+ my (undef, $servers, $reason) = @_;
+
+ $get_squit_lock->execute; $get_squit_lock->finish;
+
+ foreach my $server (@$servers) {
+ $get_squit_empty_chans->execute($server);
+
+ $squit_nickreg->execute($server);
+ $squit_nickreg->finish;
+
+ $squit_lastquit->execute("Netsplit from $server", $server);
+ $squit_lastquit->finish;
+
+ $squit_users->execute($server);
+ $squit_users->finish;
+
+ while(my ($cn) = $get_squit_empty_chans->fetchrow_array) {
+ chanserv::channel_emptied({CHAN => $cn});
+ }
+ $get_squit_empty_chans->finish;
+ }
+
+ $unlock_tables->execute; $unlock_tables->finish;
+}
+
+sub nick_change($$$) {
+ my ($old, $new, $time) = @_;
+
+ return if(lc $old eq lc $new);
+
+ get_lock($old);
+ nick_cede($new);
+ $nick_change->execute($new, $time, $old);
+ $add_nickchg->execute($ircline, $new, $new);
+ release_lock($old);
+
+ if($new =~ /^guest/i) {
+ $get_guest->execute($new);
+ if($get_guest->fetchrow_array) {
+ $set_guest->execute(0, $new);
+ } else {
+ guestnick($new);
+ }
+ return;
+ }
+
+ ircd::setumode($nsnick, $new, '-r')
+ unless check_identify({ NICK => $new });
+}
+
+sub umode($$) {
+ my ($nick, $modes) = @_;
+ my $user = { NICK => $nick };
+
+ get_lock($nick);
+
+ my $id = get_user_id($user);
+
+ $get_umodes->execute($id);
+ my ($omodes) = $get_umodes->fetchrow_array;
+ $set_umodes->execute(modes::add($omodes, $modes, 0), $id);
+
+
+ my %modelist = modes::splitumodes($modes);
+ if (defined($modelist{x})) {
+ if($modelist{x} eq '-') {
+ my ($ident, $host) = get_host($user);
+ do_chghost(undef, $nick, $host, 1);
+ }
+ elsif(($modelist{x} eq '+') and !defined($modelist{t}) ) {
+ my (undef, $cloakhost) = get_cloakhost($user);
+ if($cloakhost) {
+ do_chghost(undef, $nick, $cloakhost, 1);
+ } else {
+ ircd::userhost($nick);
+ }
+ }
+ }
+=cut
+# awaiting resolution UnrealIRCd bug 2613
+ elsif ($modelist{t} eq '-') {
+ my %omodelist = modes::splitumodes($omodes);
+ if($omodelist->{x} eq '+') {
+ my (undef, $cloakhost) = get_cloakhost($user);
+ if($cloakhost) {
+ do_chghost(undef, $nick, $cloakhost, 1);
+ } else {
+ ircd::userhost($nick);
+ }
+ }
+ }
+=cut
+ release_lock($nick);
+
+ # Else we will get it in a sethost or chghost
+ # Also be aware, our tracking of umodes xt is imperfect
+ # as the ircd doesn't always report it to us
+ # This might need fixing up in chghost()
+}
+
+sub killhandle($$$$) {
+ my ($src, $dst, $path, $reason) = @_;
+ unless (is_agent($dst)) {
+ nick_delete($dst, "Killed ($src ($reason))");
+ }
+}
+
+sub userip($$$) {
+ my($src, $nick, $ip) = @_;
+ my $user = { 'NICK' => $nick };
+ my $new = $newuser{lc $nick};
+ delete $newuser{lc $nick};
+ #my $targetid = get_nick_id($target);
+ my $iip; my @ips = split(/\./, $ip);
+ for(my $i; $i < 4; $i++) {
+ $iip += $ips[$i] * (2 ** ((3 - $i) * 8));
+ }
+
+ get_lock($nick);
+
+ my $id = get_user_id($user);
+ set_ip($user, $iip);
+ my $killed = kill_clones($user, $iip);
+
+ release_lock($nick);
+
+ nick_create_post($nick) if(!$killed and $new);
+}
+
+sub chghost($$$) {
+ my ($src, $dst, $vhost) = @_;
+ my $user = { NICK => $dst };
+ my $uid = get_user_id($user);
+
+ get_lock($dst);
+ do_chghost($src, $dst, $vhost, 1);
+
+ $get_umodes->execute($uid);
+ my ($omodes) = $get_umodes->fetchrow_array;
+ # I'm told that this is only valid if CLK is set, and
+ # there is no good way yet to get info from the ircd/net
+ # module to this code. it stinks of ircd-specific too
+ # Also, we currently do any USERHOST replies as CHGHOST events
+ # However, that is no longer necessary with CLK
+ $set_umodes->execute(modes::add($omodes, '+xt', 0), $uid);
+ release_lock($dst);
+}
+
+sub do_chghost($$$;$) {
+# Don't use this for the handler,
+# this is only for internal use
+# where we don't want full loopback semantics.
+# We call it from the normal handler.
+ my ($src, $dst, $vhost, $no_lock) = @_;
+# $no_lock is for where we already took the lock in the caller
+# MySQL's GET LOCK doesn't allow recursive locks
+ my $user = { NICK => $dst };
+ my $uid = get_user_id($user);
+
+ $update_regnick_vhost->execute($vhost, $uid);
+ $update_regnick_vhost->finish();
+
+ get_lock($dst) unless $no_lock;
+
+ set_vhost($user, $vhost);
+ chanserv::akick_alluser($user);
+
+ release_lock($dst) unless $no_lock;
+}
+
+sub chgident($$$) {
+ my ($src, $dst, $ident) = @_;
+ my $user = { NICK => $dst };
+
+ set_ident($user, $ident);
+ chanserv::akick_alluser($user);
+}
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package operserv;
+
+use strict;
+
+use SrSv::Timer qw(add_timer);
+
+use SrSv::IRCd::State qw(get_server_state);
+use SrSv::Unreal::Validate qw( valid_server valid_nick );
+
+use SrSv::Time;
+use SrSv::Text::Format qw(columnar);
+use SrSv::Errors;
+use SrSv::Log;
+
+use SrSv::Conf2Consts qw(main services);
+
+use SrSv::User qw(get_user_nick get_user_id get_user_agent is_online get_user_info);
+use SrSv::User::Notice;
+use SrSv::Help qw( sendhelp );
+
+use SrSv::NickReg::Flags qw(NRF_NOHIGHLIGHT nr_chk_flag_user);
+
+use SrSv::MySQL '$dbh';
+
+use constant {
+ MAX_LIM => 16777215
+};
+
+*kill_user = \&nickserv::kill_user;
+
+our $osnick_default = 'OperServ';
+our $osnick = $osnick_default;
+
+my %newstypes = (
+ u => 'User',
+ o => 'Oper'
+);
+
+=cut
+ $add_akill, $del_akill, $get_all_akills, $get_expired_akills,
+ $get_akill, $check_akill,
+=cut
+
+our (
+ $add_qline, $del_qline, $get_all_qlines, $get_expired_qlines,
+ $get_qline, $check_qline,
+
+ $add_logonnews, $del_logonnews, $list_logonnews, $get_logonnews,
+ $consolidate_logonnews, $count_logonnews, $del_expired_logonnews,
+
+ $add_clone_exceptname, $add_clone_exceptserver, $add_clone_exceptip,
+ $del_clone_exceptname, $del_clone_exceptip,
+ $list_clone_exceptname, $list_clone_exceptserver, $list_clone_exceptip,
+
+ $get_clones_fromhost, $get_clones_fromnick, $get_clones_fromid, $get_clones_fromipv4,
+
+ $get_session_list
+);
+
+sub init() {
+=cut
+ $add_akill = $dbh->prepare("INSERT INTO akill SET setter=?, mask=?, reason=?, time=?, expire=?");
+ $del_akill = $dbh->prepare("DELETE FROM akill WHERE mask=?");
+ $get_all_akills = $dbh->prepare("SELECT setter, mask, reason, time, expire FROM akill ORDER BY time ASC");
+ $get_akill = $dbh->prepare("SELECT setter, mask, reason, time, expire FROM akill WHERE mask=?");
+ $check_akill = $dbh->prepare("SELECT 1 FROM akill WHERE mask=?");
+
+ $get_expired_akills = $dbh->prepare("SELECT setter, mask, reason, time, expire FROM akill WHERE expire < UNIX_TIMESTAMP() AND expire!=0");
+=cut
+
+ $add_qline = $dbh->prepare("INSERT INTO qline SET setter=?, mask=?, reason=?, time=?, expire=?");
+ $del_qline = $dbh->prepare("DELETE FROM qline WHERE mask=?");
+ $get_all_qlines = $dbh->prepare("SELECT setter, mask, reason, time, expire FROM qline ORDER BY time ASC");
+ $get_qline = $dbh->prepare("SELECT setter, mask, reason, time, expire FROM qline WHERE mask=?");
+ $check_qline = $dbh->prepare("SELECT 1 FROM qline WHERE mask=?");
+
+ $get_expired_qlines = $dbh->prepare("SELECT mask FROM qline WHERE expire < UNIX_TIMESTAMP() AND expire!=0");
+
+ $add_logonnews = $dbh->prepare("INSERT INTO logonnews SET setter=?, expire=?, type=?, id=?, msg=?, time=UNIX_TIMESTAMP()");
+ $del_logonnews = $dbh->prepare("DELETE FROM logonnews WHERE type=? AND id=?");
+ $list_logonnews = $dbh->prepare("SELECT setter, time, expire, id, msg FROM logonnews WHERE type=? ORDER BY id ASC");
+ $get_logonnews = $dbh->prepare("SELECT setter, time, msg FROM logonnews WHERE type=? ORDER BY id ASC");
+ $consolidate_logonnews = $dbh->prepare("UPDATE logonnews SET id=id-1 WHERE type=? AND id>?");
+ $count_logonnews = $dbh->prepare("SELECT COUNT(*) FROM logonnews WHERE type=?");
+ $del_expired_logonnews = $dbh->prepare("DELETE FROM logonnews WHERE expire < UNIX_TIMESTAMP() AND expire!=0");
+
+ $add_clone_exceptname = $dbh->prepare("REPLACE INTO sesexname SET host=?, serv=0, adder=?, lim=?");
+ $add_clone_exceptserver = $dbh->prepare("REPLACE INTO sesexname SET host=?, serv=1, adder=?, lim=?");
+ $add_clone_exceptip = $dbh->prepare("REPLACE INTO sesexip SET ip=INET_ATON(?), mask=?, adder=?, lim=?");
+
+ $del_clone_exceptname = $dbh->prepare("DELETE FROM sesexname WHERE host=?");
+ $del_clone_exceptip = $dbh->prepare("DELETE FROM sesexip WHERE ip=INET_ATON(?)");
+
+ $list_clone_exceptname = $dbh->prepare("SELECT host, adder, lim FROM sesexname WHERE serv=0 ORDER BY host ASC");
+ $list_clone_exceptserver = $dbh->prepare("SELECT host, adder, lim FROM sesexname WHERE serv=1 ORDER BY host ASC");
+ $list_clone_exceptip = $dbh->prepare("SELECT INET_NTOA(ip), mask, adder, lim FROM sesexip ORDER BY ip ASC");
+
+ $get_clones_fromhost = $dbh->prepare("SELECT user.nick, user.id, user.online
+ FROM user JOIN user AS clone ON (user.ip=clone.ip)
+ WHERE clone.host=? GROUP BY id");
+ $get_clones_fromnick = $dbh->prepare("SELECT user.nick, user.id, user.online
+ FROM user JOIN user AS clone ON (user.ip=clone.ip)
+ WHERE clone.nick=? GROUP BY id");
+ $get_clones_fromid = $dbh->prepare("SELECT user.nick, user.id, user.online
+ FROM user JOIN user AS clone ON (user.ip=clone.ip)
+ WHERE clone.id=? GROUP BY id");
+ $get_clones_fromipv4 = $dbh->prepare("SELECT user.nick, user.id, user.online
+ FROM user JOIN user AS clone ON (user.ip=clone.ip)
+ WHERE clone.ip=INET_ATON(?) GROUP BY id");
+
+
+ $get_session_list = $dbh->prepare("SELECT host, COUNT(*) AS c FROM user WHERE online=1 GROUP BY host HAVING c >= ?");
+}
+import SrSv::MySQL::Stub {
+ __flood_check => ['SCALAR', "SELECT flood FROM user WHERE id=?"],
+ __flood_inc => ['NULL', "UPDATE user SET flood = flood + ? WHERE id=?"],
+ __flood_expire => ['NULL', "UPDATE user SET flood = flood >> 1"], # shift is faster than mul
+};
+
+sub dispatch($$$) {
+ my ($src, $dst, $msg) = @_;
+ $msg =~ s/^\s+//;
+ my @args = split(/\s+/, $msg);
+ my $cmd = shift @args;
+
+ my $user = { NICK => $src, AGENT=> $dst };
+
+ services::ulog($osnick, LOG_INFO(), "cmd: [$msg]", $user);
+
+ return if flood_check($user);
+ unless(adminserv::is_svsop($user) or adminserv::is_ircop($user)) {
+ notice($user, $err_deny);
+ ircd::globops($osnick, "\002$src\002 failed access to $osnick $msg");
+ return;
+ }
+
+ if ($cmd =~ /^fjoin$/i) { os_fjoin($user, @args); }
+ elsif ($cmd =~ /^fpart$/i) { os_fpart($user, @args); }
+ elsif ($cmd =~ /^unidentify$/i) { os_unidentify($user, @args); }
+ elsif ($cmd =~ /^qline$/i) {
+ my $cmd2 = shift @args;
+
+ if($cmd2 =~ /^add$/i) {
+ if(@args >= 3 and $args[0] =~ /^\+/) {
+ @args = split(/\s+/, $msg, 5);
+
+ os_qline_add($user, $args[2], $args[3], $args[4]);
+ }
+ elsif(@args >= 2) {
+ @args = split(/\s+/, $msg, 4);
+
+ os_qline_add($user, 0, $args[2], $args[3]);
+ }
+ else {
+ notice($user, 'Syntax: QLINE ADD [+expiry] <mask> <reason>');
+ }
+ }
+ elsif($cmd2 =~ /^del$/i) {
+ if(@args == 1) {
+ os_qline_del($user, $args[0]);
+ }
+ else {
+ notice($user, 'Syntax: QLINE DEL <mask>');
+ }
+ }
+ elsif($cmd2 =~ /^list$/i) {
+ if(@args == 0) {
+ os_qline_list($user);
+ }
+ else {
+ notice($user, 'Syntax: QLINE LIST');
+ }
+ }
+ }
+ elsif ($cmd =~ /^jupe$/i) {
+ if(@args >= 2) {
+ os_jupe($user, shift @args, join(' ', @args));
+ }
+ else {
+ notice($user, 'Syntax: JUPE <server> <reason>');
+ }
+ }
+ elsif ($cmd =~ /^uinfo$/i) { os_uinfo($user, @args); }
+ elsif ($cmd =~ /^ninfo$/i) { os_ninfo($user, @args); }
+ elsif ($cmd =~ /^svsnick$/i) { os_svsnick($user, $args[0], $args[1]); }
+ elsif ($cmd =~ /^gnick$/i) { os_gnick($user, @args); }
+ elsif ($cmd =~ /^help$/i) { sendhelp($user, 'operserv', @args) }
+ elsif ($cmd =~ /^(staff|listadm)$/i) { adminserv::as_staff($user) }
+ elsif ($cmd =~ /^logonnews$/i) {
+ my $cmd2 = shift @args;
+
+ if($cmd2 =~ /^add$/i) {
+ if(@args >= 3 and $args[1] =~ /^\+/) {
+ @args = split(/\s+/, $msg, 5);
+
+ os_logonnews_add($user, $args[2], $args[3], $args[4]);
+ }
+ elsif(@args >= 2) {
+ @args = split(/\s+/, $msg, 4);
+
+ os_logonnews_add($user, $args[2], 0, $args[3]);
+ }
+ else {
+ notice($user, 'Syntax: LOGONNEWS ADD <type> [+expiry] <reason>');
+ }
+ }
+ elsif($cmd2 =~ /^del$/i) {
+ if(@args == 2) {
+ os_logonnews_del($user, $args[0], $args[1]);
+ }
+ else {
+ notice($user, 'Syntax: LOGONNEWS DEL <type> <id>');
+ }
+ }
+ elsif($cmd2 =~ /^list$/i) {
+ if(@args == 1) {
+ os_logonnews_list($user, $args[0]);
+ }
+ else {
+ notice($user, 'Syntax: LOGONNEWS LIST <type>');
+ }
+ }
+ else {
+ notice($user, 'Syntax: LOGONNEWS <LIST|ADD|DEL> <type>');
+ }
+ }
+ elsif($cmd =~ /^except(ion)?$/i) {
+ my $cmd2 = shift @args;
+ if($cmd2 =~ /^server$/i) {
+ my $cmd3 = shift @args;
+ if($cmd3 =~ /^a(dd)?$/) {
+ if(@args == 2) {
+ os_except_server_add($user, $args[0], $args[1]);
+ }
+ else {
+ notice($user, 'Syntax EXCEPT SERVER ADD <hostname> <limit>');
+ }
+ }
+ elsif($cmd =~ /^d(el)?$/) {
+ if(@args == 1) {
+ os_except_server_del($user, $args[0]);
+ }
+ else {
+ notice($user, 'Syntax EXCEPT SERVER DEL <hostname>');
+ }
+ }
+ else {
+ notice($user, 'Syntax EXCEPT SERVER <ADD|DEL>');
+ }
+ }
+ elsif($cmd2 =~ /^h(ostname)?$/i) {
+ my $cmd3 = shift @args;
+ if($cmd3 =~ /^a(dd)?$/) {
+ if(@args == 2) {
+ os_except_hostname_add($user, $args[0], $args[1]);
+ }
+ else {
+ notice($user, 'Syntax EXCEPT HOSTNAME ADD <hostname> <limit>');
+ }
+ }
+ elsif($cmd3 =~ /^d(el)?$/) {
+ if(@args == 1) {
+ os_except_hostname_del($user, $args[0]);
+ }
+ else {
+ notice($user, 'Syntax EXCEPT HOSTNAME DEL <hostname>');
+ }
+ }
+ else {
+ notice($user, 'Syntax EXCEPT HOSTNAME <ADD|DEL>');
+ }
+ }
+ elsif($cmd2 =~ /^i(p)?$/i) {
+ my $cmd3 = shift @args;
+ if($cmd3 =~ /^a(dd)?$/) {
+ if(@args == 2) {
+ os_except_IP_add($user, $args[0], $args[1]);
+ }
+ else {
+ notice($user, 'Syntax EXCEPT IP ADD <IP/mask> <limit>');
+ }
+ }
+ elsif($cmd3 =~ /^d(el)?$/) {
+ if(@args == 1) {
+ os_except_IP_del($user, $args[0]);
+ }
+ else {
+ notice($user, 'Syntax EXCEPT IP DEL <IP>');
+ }
+ }
+ else {
+ notice($user, 'Syntax EXCEPT IP <ADD|DEL>');
+ }
+ }
+ elsif($cmd2 =~ /^l(ist)?$/i) {
+ if(@args == 0) {
+ os_except_list($user);
+ }
+ else {
+ notice($user, 'Syntax EXCEPT LIST');
+ }
+ }
+ else {
+ notice($user, 'Syntax: EXCEPT <SERVER|HOSTNAME|IP|LIST>');
+ }
+ }
+ elsif($cmd =~ /^session$/i) {
+ if(@args == 1) {
+ os_session_list($user, $args[0]);
+ } else {
+ notice($user, 'Syntax SESSION <lim>');
+ }
+ }
+ elsif($cmd =~ /^chankill$/i) {
+ if(@args >= 2) {
+ (undef, @args) = split(/\s+/, $msg, 3);
+ os_chankill($user, @args);
+ } else {
+ notice($user, 'Syntax: CHANKILL <#chan> <reason>');
+ }
+ }
+ elsif ($cmd =~ /^rehash$/i) {
+ if(@args <= 1) {
+ os_rehash($user, @args);
+ }
+ else {
+ notice($user, 'Syntax: REHASH [type]');
+ }
+ }
+ elsif ($cmd =~ /^loners$/i) {
+ os_loners($user, @args);
+ }
+ elsif($cmd =~ /^svskill$/i) {
+ if(@args >= 2) {
+ os_svskill($user, shift @args, join(' ', @args));
+ }
+ else {
+ notice($user, 'Syntax SVSKILL <target> <reason here>');
+ }
+ }
+ elsif($cmd =~ /^kill$/i) {
+ if(@args >= 1) {
+ os_kill($user, shift @args, join(' ', @args));
+ }
+ else {
+ notice($user, 'Syntax KILL <target> <reason here>');
+ }
+ }
+ elsif ($cmd =~ /^clones$/i) {
+ os_clones($user, @args);
+ }
+ elsif ($cmd =~ /^m(ass)?kill$/i) {
+ os_clones($user, 'KILL', @args);
+ }
+ elsif($cmd =~ /^(kline|gline)$/i) {
+ if(@args >= 1) {
+ os_gline($user, 0, @args);
+ }
+ else {
+ notice($user, 'Syntax GLINE <target> [+time] [reason here]');
+ }
+ }
+ elsif($cmd =~ /^(zline|gzline)$/i) {
+ if(@args >= 1) {
+ os_gline($user, 1, @args);
+ }
+ else {
+ notice($user, 'Syntax GZLINE <target> [+time] [reason here]');
+ }
+ }
+
+ else { notice($user, "Unknown command."); }
+}
+
+sub os_fjoin($$@) {
+ my ($user, $target, @chans) = @_;
+ if ((!$target or !@chans) or !($chans[0] =~ /^#/)) {
+ notice($user, "Syntax: /OS FJOIN <nick> <#channel1> [#channel2]");
+ }
+ unless (is_online($target)) {
+ notice($user, "\002$target\002 is not online");
+ return;
+ }
+
+ if (!adminserv::can_do($user, 'FJOIN')) {
+ notice($user, "You don't have the right access");
+ return $event::SUCCESS;
+ }
+ ircd::svsjoin($osnick, $target, @chans);
+}
+
+sub os_fpart($$@) {
+ my ($user, $target, @params) = @_;
+ if ((!$target or !@params) or !($params[0] =~ /^#/)) {
+ notice($user, "Syntax: /OS FPART <nick> <#channel1> [#channel2] [reason]");
+ }
+ unless (is_online($target)) {
+ notice($user, "\002$target\002 is not online");
+ return;
+ }
+
+ if (!adminserv::can_do($user, 'FJOIN')) {
+ notice($user, "You don't have the right access");
+ return $event::SUCCESS;
+ }
+
+ my ($reason, @chans);
+ while ($params[0] =~ /^#/) {
+ push @chans, shift @params;
+ }
+ $reason = join(' ', @params) if @params;
+
+ ircd::svspart($osnick, $target, $reason, @chans);
+}
+
+sub os_qline_add($$$$) {
+ my ($user, $expiry, $mask, $reason) = @_;
+
+ chk_auth($user, 'QLINE') or return;
+
+ $expiry = parse_time($expiry);
+ if($expiry) { $expiry += time() }
+ else { $expiry = 0 }
+
+ $check_qline->execute($mask);
+ if ($check_qline->fetchrow_array) {
+ notice($user, "$mask is already qlined");
+ return $event::SUCCESS;
+ } else {
+ my $src = get_user_nick($user);
+ $add_qline->execute($src, $mask, $reason, time(), $expiry);
+ ircd::sqline($mask, $reason);
+ notice($user, "$mask is now Q:lined");
+ }
+}
+
+sub os_qline_del($$) {
+ my($user, $mask) = @_;
+
+ chk_auth($user, 'QLINE') or return;
+
+ $check_qline->execute($mask);
+ if($check_qline->fetchrow_array) {
+ $del_qline->execute($mask);
+ ircd::unsqline($mask);
+ notice($user, "$mask unqlined");
+ } else {
+ notice($user, "$mask is not qlined");
+ }
+}
+
+sub os_qline_list($) {
+ my ($user) = @_;
+ my (@reply);
+
+ chk_auth($user, 'QLINE') or return;
+
+ push @reply, 'Q:line list:';
+
+ $get_all_qlines->execute();
+ my $i;
+ while (my ($setter, $mask, $reason, $time, $expiry) = $get_all_qlines->fetchrow_array) {
+ $i++;
+ my $akill_entry1 = " $i) \002$mask\002 $reason";
+ my $akill_entry2 = " set by $setter on ".gmtime2($time).'; ';
+ if($expiry) {
+ my ($weeks, $days, $hours, $minutes, $seconds) = split_time($expiry-time());
+ $akill_entry2 .= "Expires in ".($weeks?"$weeks weeks ":'').
+ ($days?"$days days ":'').
+ ($hours?"$hours hours ":'').
+ ($minutes?"$minutes minutes ":'');
+ }
+ else {
+ $akill_entry2 .= "Does not expire.";
+ }
+ push @reply, $akill_entry1; push @reply, $akill_entry2;
+ }
+ $get_all_qlines->finish();
+ push @reply, ' --';
+
+ notice($user, @reply) if @reply;
+}
+
+sub os_jupe($$$) {
+ # introduces fake server to network.
+ my ($user, $server, $reason) = @_;
+
+ unless (adminserv::is_svsop($user, adminserv::S_ROOT())) {
+ notice($user, $err_deny);
+ return $event::SUCCESS;
+ }
+ unless (valid_server($server)) {
+ notice($user, "$server is not a valid servername.");
+ return $event::SUCCESS;
+ }
+ if (get_server_state($server)) {
+ notice($user, "$server is currently connected. You must SQUIT before using JUPE.");
+ return $event::SUCCESS;
+ }
+
+ ircd::jupe_server($server, "Juped by ".get_user_nick($user).": $reason");
+ notice($user, "$server is now juped.");
+ return $event::SUCCESS;
+}
+
+sub os_unidentify($$) {
+ my ($user, $tnick) = @_;
+
+ my $tuser = { NICK => $tnick };
+ my $tuid;
+
+ unless ($tuid = get_user_id($tuser)) {
+ notice($user, "\002$tnick\002 is not online");
+ }
+ unless (adminserv::can_do($user, 'SERVOP')) {
+ notice($user, $err_deny);
+ }
+ $nickserv::logout->execute($tuid);
+ notice($user, "$tnick logged out from all nick identifies");
+}
+
+sub os_uinfo($@) {
+ my ($user, @targets) = @_;
+
+ my @userlist;
+ foreach my $target (@targets) {
+ if($target =~ /\,/) {
+ push @targets, split(',', $target);
+ next;
+ }
+ my @data;
+ my $tuser = { NICK => $target };
+ my $tuid = get_user_id($tuser);
+ unless ($tuid) {
+ notice($user, "\002$target\002: user not found");
+ next;
+ }
+ push @userlist, $tuser;
+ }
+
+ notice($user, get_uinfo($user, @userlist));
+ return $event::SUCCESS;
+}
+
+sub os_ninfo($@) {
+ my ($user, @targetsIn) = @_;
+
+ my @targetsOut;
+ foreach my $target (@targetsIn) {
+ if(not nickserv::is_registered($target)) {
+ notice($user, "\002$target\002: is not registered.");
+ }
+ my @targets = nickserv::get_nick_user_nicks($target);
+ if(scalar(@targets) == 0) {
+ notice($user, "\002$target\002: no user[s] online.");
+ next;
+ }
+ push @targetsOut, @targets;
+ }
+ if(scalar(@targetsOut)) {
+ return os_uinfo($user, @targetsOut);
+ }
+ return $event::SUCCESS;
+}
+
+sub os_svsnick($$$) {
+ my ($user, $curnick, $newnick) = @_;
+ my $tuser = { NICK => $curnick };
+
+ if(!adminserv::is_svsop($user, adminserv::S_ROOT())) {
+ notice($user, $err_deny);
+ return $event::SUCCESS;
+ }
+ if ((!$curnick) or (!$newnick)) {
+ notice($user, "Syntax: SVSNICK <curnick> <newnick>");
+ return $event::SUCCESS;
+ }
+ if (!is_online($tuser)) {
+ notice($user, $curnick.' is not online.');
+ return $event::SUCCESS;
+ }
+ if (nickserv::is_online($newnick)) {
+ notice($user, $newnick.' already exists.');
+ return $event::SUCCESS;
+ }
+ nickserv::enforcer_quit($newnick);
+ ircd::svsnick($osnick, $curnick, $newnick);
+ notice($user, $curnick.' changed to '.$newnick);
+ return $event::SUCCESS;
+}
+
+sub os_gnick($@) {
+ my ($user, @targets) = @_;
+
+ if(!adminserv::can_do($user, 'QLINE')) {
+ notice($user, $err_deny);
+ return $event::SUCCESS;
+ }
+ if (@targets == 0) {
+ notice($user, "Syntax: GNICK <nick>");
+ return $event::SUCCESS;
+ }
+ foreach my $target (@targets) {
+ if (!is_online($target)) {
+ notice($user, $target.' is not online.');
+ next;
+ }
+ my $newnick = nickserv::collide($target);
+ notice($user, $target.' changed to '.$newnick);
+ }
+ return $event::SUCCESS;
+}
+
+sub os_logonnews_pre($$) {
+ my ($user, $type) = @_;
+
+ unless(adminserv::is_svsop($user, adminserv::S_ADMIN())) {
+ notice($user, $err_deny);
+ return undef;
+ }
+
+ return 'u' if($type =~ /^(user)|(u)$/i);
+ return 'o' if($type =~ /^(oper)|(o)$/i);
+ notice($user, 'invalid LOGONNEWS <type>');
+ return undef;
+}
+
+sub os_logonnews_add($$$) {
+ my ($user, $type, $expiry, $msg) = @_;
+
+ return unless ($type = os_logonnews_pre($user, $type));
+
+ my $mlength = length($msg);
+ if($mlength >= 350) {
+ notice($user, 'Message is too long by '. $mlength-350 .' character(s). Maximum length is 350 chars');
+ return;
+ }
+
+ if($expiry) {
+ $expiry = parse_time($expiry);
+ }
+ else {
+ $expiry = 0;
+ }
+
+ my $src = get_user_nick($user);
+ $count_logonnews->execute($type);
+ my $count = $count_logonnews->fetchrow_array;
+
+ $add_logonnews->execute($src, $expiry ? time()+$expiry : 0, $type, ++$count, $msg);
+
+ notice($user, "Added new $newstypes{$type} News #\002$count\002");
+}
+
+sub os_logonnews_del($$$) {
+ my ($user, $type, $id) = @_;
+
+ return unless ($type = os_logonnews_pre($user, $type));
+
+ my $ret = $del_logonnews->execute($type, $id);
+
+ if ($ret == 1) {
+ notice($user, "News Item $newstypes{$type} News #\002$id\002 deleted");
+ $consolidate_logonnews->execute($type, $id);
+ }
+ else {
+ notice($user, "Delete of $newstypes{$type} News #\002$id\002 failed.",
+ "$newstypes{$type} #\002$id\002 does not exist?");
+ }
+}
+
+sub os_logonnews_list($$) {
+ my ($user, $type) = @_;
+
+ return unless ($type = os_logonnews_pre($user, $type));
+
+ my @reply;
+ push @reply, "\002$newstypes{$type}\002 News";
+
+ $list_logonnews->execute($type);
+ push @reply, "There is no $newstypes{$type} News"
+ unless($list_logonnews->rows);
+ while(my ($adder, $time, $expiry, $id, $msg) = $list_logonnews->fetchrow_array) {
+ my ($weeks, $days, $hours, $minutes, $seconds) = split_time($expiry-time());
+ my $expire_string = ($expiry?"Expires in ".($weeks?"$weeks weeks ":'').
+ ($days?"$days days ":'').
+ ($hours?"$hours hours ":'').
+ ($minutes?"$minutes minutes ":'')
+ :'Does not expire');
+ push @reply, "$id\) $msg";
+ push @reply, join(' ', '', 'added: '.gmtime2($time), $expire_string, "added by: $adder");
+ }
+ $list_logonnews->finish();
+ notice($user, @reply);
+}
+
+sub os_except_pre($) {
+ my ($user) = @_;
+
+ if (adminserv::is_svsop($user, adminserv::S_ADMIN()) ) {
+ return 1;
+ }
+ else {
+ notice($user, $err_deny);
+ return 0;
+ }
+}
+
+sub os_except_hostname_add($$$) {
+ my ($user, $hostname, $limit) = @_;
+
+ os_except_pre($user) or return 0;
+
+ if ($hostname =~ m/\@/ or not $hostname =~ /\./) {
+ notice($user, 'Invalid hostmask.', 'A clone exception hostmask is the HOST portion only, no ident',
+ 'and must contain at least one dot \'.\'');
+ return;
+ }
+
+ $limit = MAX_LIM() unless $limit;
+
+ my $src = get_user_nick($user);
+ my $hostmask = $hostname;
+ $hostmask =~ s/\*/\%/g;
+ $add_clone_exceptname->execute($hostmask, $src, $limit);
+ notice($user, "Clone exception for host \002$hostname\002 added.");
+}
+
+sub os_except_server_add($$$) {
+ my ($user, $hostname, $limit) = @_;
+
+ os_except_pre($user) or return 0;
+
+ if ($hostname =~ m/\@/ or not $hostname =~ /\./) {
+ notice($user, 'Invalid hostmask.', 'A clone exception servername has no ident',
+ 'and must contain at least one dot \'.\'');
+ return;
+ }
+
+ $limit = MAX_LIM() unless $limit;
+
+ my $src = get_user_nick($user);
+ my $hostmask = $hostname;
+ $hostmask =~ s/\*/\%/g;
+ $add_clone_exceptserver->execute($hostmask, $src, $limit);
+ notice($user, "Clone exception for server \002$hostname\002 added.");
+}
+
+sub os_except_IP_add($$$$) {
+ my ($user, $IP, $limit) = @_;
+
+ os_except_pre($user) or return 0;
+
+ my $mask;
+ ($IP, $mask) = split(/\//, $IP);
+ $mask = 32 unless $mask;
+ if ($IP =~ m/\@/ or not $IP =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {
+ notice($user, 'Invalid hostmask.', 'A clone exception IP has no ident',
+ 'and must be a valid IP address with 4 octets (example: 1.2.3.4)');
+ return;
+ }
+
+ $limit = MAX_LIM() unless $limit;
+
+ my $src = get_user_nick($user);
+ $add_clone_exceptip->execute($IP, $mask, $src, $limit);
+ notice($user, "IP clone exception \002$IP\/$mask\002 added.");
+}
+
+sub os_except_hostname_del($$) {
+ my ($user, $hostname) = @_;
+
+ os_except_pre($user) or return 0;
+
+ my $hostmask = $hostname;
+ $hostmask =~ s/\*/\%/g;
+ my $ret = $del_clone_exceptname->execute($hostmask);
+ ircd::notice($osnick, main_conf_diag, "hostname: $hostname; hostmask: $hostmask");
+
+ if($ret == 1) {
+ notice($user, "\002$hostname\002 successfully deleted from the hostname exception list");
+ }
+ else {
+ notice($user, "Deletion of \002$hostname\002 \037failed\037. \002$hostname\002 entry does not exist?");
+ }
+}
+
+sub os_except_server_del($$) {
+ my ($user, $hostname) = @_;
+
+ os_except_pre($user) or return 0;
+
+ my $hostmask = $hostname;
+ $hostmask =~ s/\*/\%/g;
+ my $ret = $del_clone_exceptname->execute($hostmask);
+
+ if($ret == 1) {
+ notice($user, "\002$hostname\002 successfully deleted from the server exception list");
+ }
+ else {
+ notice($user, "Deletion of \002$hostname\002 \037failed\037. \002$hostname\002 entry does not exist?");
+ }
+}
+
+sub os_except_IP_del($$$) {
+ my ($user, $IP) = @_;
+
+ os_except_pre($user) or return 0;
+
+ no warnings 'misc';
+ my ($IP, $mask) = split(/\//, $IP);
+ $mask = 32 unless $mask;
+ my $ret = $del_clone_exceptip->execute($IP);
+
+ if($ret == 1) {
+ notice($user, "\002$IP/$mask\002 successfully deleted from the IP exception list");
+ }
+ else {
+ notice($user, "Deletion of \002$IP/$mask\002 \037failed\037. \002$IP/$mask\002 entry does not exist?");
+ }
+}
+
+sub os_except_list($) {
+ my ($user) = @_;
+ my @data;
+
+ $list_clone_exceptserver->execute();
+ while(my ($host, $adder, $lim) = $list_clone_exceptserver->fetchrow_array) {
+ $host =~ s/\%/\*/g;
+ push @data, ['Server:', $host, $lim!=MAX_LIM()?$lim:'unlimited', "($adder)"];
+ }
+
+ $list_clone_exceptname->execute();
+ while(my ($host, $adder, $lim) = $list_clone_exceptname->fetchrow_array) {
+ $host =~ s/\%/\*/g;
+ push @data, ['Host:', $host, $lim!=MAX_LIM()?$lim:'unlimited', "($adder)"];
+ }
+
+ $list_clone_exceptip->execute();
+ while(my ($ip, $mask, $adder, $lim) = $list_clone_exceptip->fetchrow_array) {
+ push @data, ['IP:', "$ip/$mask", $lim!=MAX_LIM()?$lim:'unlimited', "($adder)"];
+ }
+
+ notice($user, columnar {TITLE => "Clone exception list:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data);
+}
+
+sub os_session_list($) {
+ my ($user, $lim) = @_;
+
+ unless($lim > 1) {
+ notice($user, "Please specify a number greater than 1.");
+ return;
+ }
+
+ $get_session_list->execute($lim);
+ my $data = $get_session_list->fetchall_arrayref;
+
+ notice($user, columnar {TITLE => "Hosts with at least $lim sessions:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @$data);
+}
+
+sub os_chankill($$$) {
+ my ($user, $cn, $reason) = @_;
+
+ unless(adminserv::is_svsop($user, adminserv::S_OPER())) {
+ notice($user, $err_deny);
+ return;
+ }
+ my $src = get_user_nick($user);
+
+ chanserv::chan_kill({ CHAN => $cn }, "$reason ($src - ".gmtime2(time()).")");
+}
+
+sub os_rehash($;$) {
+ my ($user, $type) = @_;
+
+ unless (adminserv::is_svsop($user, adminserv::S_ROOT())) {
+ notice($user, $err_deny);
+ return $event::SUCCESS;
+ }
+
+ ircd::rehash_all_servers($type);
+ return $event::SUCCESS;
+}
+
+sub os_loners($@) {
+ my ($user, @args) = @_;
+ my $cmd = shift @args;
+ my $noid;
+ if ($cmd =~ /(not?id|noidentify)/) {
+ $noid = 1;
+ $cmd = shift @args;
+ }
+ if (defined($args[0]) and $args[0] =~ /(not?id|noidentify)/) {
+ $noid = 1;
+ shift @args;
+ }
+
+ if(!$cmd or $cmd =~ /^list$/i) {
+ my @reply;
+ foreach my $tuser (chanserv::get_users_nochans($noid)) {
+ push @reply, get_user_nick($tuser);
+ }
+ notice($user, "Users in zero channels", @reply);
+ }
+ elsif($cmd =~ /^uinfo$/i) {
+ notice($user, get_uinfo($user, chanserv::get_users_nochans($noid)));
+ }
+ elsif($cmd =~ /^kill$/i) {
+ unless(adminserv::can_do($user, 'KILL')) {
+ notice($user, $err_deny);
+ return;
+ }
+ foreach my $tuser (chanserv::get_users_nochans($noid)) {
+ $tuser->{AGENT} = $osnick;
+ nickserv::kill_user($tuser,
+ "Killed by \002".get_user_nick($user)."\002".
+ (@args ? ": ".join(' ', @args) : '')
+ );
+ }
+ }
+ elsif($cmd =~ /^kline$/i) {
+ unless(adminserv::is_svsop($user, adminserv::S_OPER())) {
+ notice($user, $err_deny);
+ return;
+ }
+ foreach my $tuser (chanserv::get_users_nochans($noid)) {
+ $tuser->{AGENT} = $osnick;
+ nickserv::kline_user($tuser, services_conf_chankilltime,
+ "K:Lined by \002".get_user_nick($user)."\002".
+ (@args ? ": ".join(' ', @args) : '')
+ );
+ }
+ }
+ elsif($cmd =~ /^(msg|message|notice)$/i) {
+ notice($user, "Must have message to send") unless(@args);
+ foreach my $tuser (chanserv::get_users_nochans($noid)) {
+ $tuser->{AGENT} = $osnick;
+ notice($tuser,
+ "Automated message from \002".get_user_nick($user),
+ join(' ', @args)
+ );
+ }
+ }
+ elsif($cmd =~ /^fjoin$/i) {
+ unless(adminserv::can_do($user, 'FJOIN')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if ($args[0] !~ /^#/) {
+ notice($user, "\002".$args[0]."\002 is not a valid channel name");
+ return;
+ }
+
+ foreach my $tuser (chanserv::get_users_nochans($noid)) {
+ $tuser->{AGENT} = $osnick;
+ ircd::svsjoin($osnick, get_user_nick($tuser), $args[0]);
+ }
+ }
+ else {
+ notice($user, "Unknown LONERS command: $cmd",
+ 'Syntax: OS LONERS [LIST|UINFO|MSG|FJOIN|KILL|KLINE] [NOID] [msg/reason]');
+ }
+}
+
+sub os_svskill($$$) {
+ my ($user, $targets, $reason) = @_;
+
+
+ if(!adminserv::is_svsop($user, adminserv::S_ROOT())) {
+ notice($user, $err_deny);
+ return $event::SUCCESS;
+ }
+
+ foreach my $target (split(',', $targets)) {
+ #my $tuser = { NICK => $target };
+ if (!is_online({ NICK => $target })) {
+ notice($user, $target.' is not online.');
+ return $event::SUCCESS;
+ }
+
+ ircd::svskill($osnick, $target, $reason);
+ }
+
+ return $event::SUCCESS;
+}
+
+sub os_kill($$$) {
+ my ($user, $targets, $reason) = @_;
+
+
+ if(!adminserv::can_do($user, 'KILL')) {
+ notice($user, $err_deny);
+ return $event::SUCCESS;
+ }
+
+ foreach my $target (split(',', $targets)) {
+ my $tuser = { NICK => $target, AGENT => $osnick };
+ if (!get_user_id($tuser)) {
+ notice($user, $target.' is not online.');
+ return $event::SUCCESS;
+ }
+
+ nickserv::kill_user($tuser, "Killed by ".get_user_nick($user).($reason ? ': '.$reason : ''));
+ }
+
+}
+
+sub os_gline($$$@) {
+ my ($user, $zline, $target, @args) = @_;
+
+ my $opernick;
+ return unless ($opernick = adminserv::is_svsop($user, adminserv::S_OPER));
+
+ my $expiry = parse_time(shift @args) if $args[0] =~ /^\+/;
+ my $reason = join(' ', @args);
+ $reason =~ s/^\:// if $reason;
+ my $remove;
+ if($target =~ /^-/) {
+ $remove = 1;
+ $target =~ s/^-//;
+ }
+
+ my ($ident, $host);
+ if($target =~ /\!/) {
+ notice($user, "Invalid G:line target \002$target\002");
+ return;
+ }
+ elsif($target =~ /^(\S+)\@(\S+)$/) {
+ ($ident, $host) = ($1, $2);
+ } elsif($target =~ /\./) {
+ ($ident, $host) = ('*', $target);
+ } elsif(valid_nick($target)) {
+ my $tuser = { NICK => $target };
+ unless(get_user_id($tuser)) {
+ notice($user, "Unknown user \002$target\002");
+ return;
+ }
+ unless($zline) {
+ (undef, $host) = nickserv::get_host($tuser);
+ $ident = '*';
+ } else {
+ $host = nickserv::get_ip($tuser);
+ }
+ } else {
+ notice($user, "Invalid G:line target \002$target\002");
+ return;
+ }
+ unless($zline) {
+ if(!$remove) {
+ ircd::kline($opernick, $ident, $host, $expiry, $reason);
+ } else {
+ ircd::unkline($opernick, $ident, $host);
+ }
+
+ } else {
+ if($ident and $ident !~ /^\**$/) {
+ notice($user, "You cannot specify an ident in a Z:line");
+ }
+ elsif ($host =~ /^(?:\d{1,3}\.){3}(?:\d{1,3})/) {
+ # all is well, do nothing
+ }
+ elsif ($host =~ /^[0-9\/\*\?\.]+$/) {
+ # This may allow invalid CIDR, not sure.
+ # We're trusting our opers to not do stupid things.
+ # THIS MAY BE A SOURCE OF BUGS.
+
+ # all is well, do nothing
+ } else {
+ notice($user, "Z:lines can only be placed on IPs or IP ranges");
+ return;
+ }
+ if(!$remove) {
+ ircd::zline($opernick, $host, $expiry, $reason);
+ } else {
+ ircd::unzline($opernick, $host);
+ }
+ }
+
+ return $event::SUCCESS;
+}
+
+sub os_clones($@) {
+ my ($user, @args) = @_;
+ my $cmd = shift @args;
+ my $target = shift @args;
+
+ if($cmd =~ /^list$/i) {
+ my @data;
+ foreach my $tuser (get_clones($target)) {
+ push @data, [get_user_nick($tuser), (is_online($tuser) ? "\002Online\002" : "\002Offline\002")];
+ }
+ notice($user, columnar {TITLE => "Clones matching \002$target\002",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data);
+ }
+ elsif($cmd =~ /^uinfo$/i) {
+ notice($user, get_uinfo($user, get_clones($target)));
+ }
+ elsif($cmd =~ /^kill$/i) {
+ unless(adminserv::can_do($user, 'KILL')) {
+ notice($user, $err_deny);
+ return;
+ }
+ foreach my $tuser (get_clones($target)) {
+ next unless is_online($tuser);
+ $tuser->{AGENT} = $osnick;
+ nickserv::kill_user($tuser,
+ "Killed by \002".get_user_nick($user)."\002".
+ (@args ? ": ".join(' ', @args) : '')
+ );
+ }
+ }
+ elsif($cmd =~ /^kline$/i) {
+ unless(adminserv::is_svsop($user, adminserv::S_OPER())) {
+ notice($user, $err_deny);
+ return;
+ }
+ foreach my $tuser (get_clones($target)) {
+ next unless is_online($tuser);
+ $tuser->{AGENT} = $osnick;
+ nickserv::kline_user($tuser, services_conf_chankilltime,
+ "K:Lined by \002".get_user_nick($user)."\002".
+ (@args ? ": ".join(' ', @args) : '')
+ );
+ }
+ }
+ elsif($cmd =~ /^(msg|message|notice)$/i) {
+ notice($user, "Must have message to send") unless(@args);
+ foreach my $tuser (get_clones($target)) {
+ next unless is_online($tuser);
+ $tuser->{AGENT} = $osnick;
+ notice($tuser,
+ "Automated message from \002".get_user_nick($user),
+ join(' ', @args)
+ );
+ }
+ }
+ elsif($cmd =~ /^fjoin$/i) {
+ unless(adminserv::can_do($user, 'FJOIN')) {
+ notice($user, $err_deny);
+ return;
+ }
+
+ if ($args[0] !~ /^#/) {
+ notice($user, "\002".$args[0]."\002 is not a valid channel name");
+ return;
+ }
+
+ foreach my $tuser (get_clones($target)) {
+ next unless is_online($tuser);
+ $tuser->{AGENT} = $osnick;
+ ircd::svsjoin($osnick, get_user_nick($tuser), $args[0]);
+ }
+ }
+ else {
+ notice($user, "Unknown CLONES command: $cmd",
+ 'Syntax: OS CLONES [LIST|UINFO|MSG|FJOIN|KILL|KLINE] [msg/reason]');
+ }
+}
+
+### MISCELLANEA ###
+
+sub do_news($$) {
+ my ($nick, $type) = @_;
+
+ my ($banner, @reply);
+
+ if ($type eq 'u') {
+ $banner = "\002Logon News\002";
+ }
+ elsif ($type eq 'o') {
+ $banner = "\002Oper News\002";
+ }
+ $get_logonnews->execute($type);
+ while(my ($adder, $time, $msg) = $get_logonnews->fetchrow_array) {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($time);
+ $year += 1900;
+ push @reply, "[$banner ".$months[$mon]." $mday $year] $msg";
+ }
+ $get_logonnews->finish();
+ ircd::notice(main_conf_local, $nick, @reply) if scalar(@reply);
+}
+
+sub chk_auth($$) {
+ my ($user, $perm) = @_;
+
+ if(adminserv::can_do($user, $perm)) {
+ return 1;
+ }
+
+ notice($user, $err_deny);
+ return 0;
+}
+
+sub expire(;$) {
+ add_timer('OperServ Expire', 60, __PACKAGE__, 'operserv::expire');
+
+ $get_expired_qlines->execute();
+ while (my ($mask) = $get_expired_qlines->fetchrow_array() ) {
+ ircd::unsqline($mask);
+ $del_qline->execute($mask);
+ }
+ $get_expired_qlines->finish();
+
+ #don't run this code yet.
+=cut
+ $get_expired_akills->execute();
+ while (my ($mask) = $get_expired_akills->fetchrow_array() ) {
+ ($ident, $host) = split('@', $mask);
+ ircd::unkline($osnick, $ident, $host);
+ $del_akill->execute($mask);
+ }
+ $get_expired_akills->finish();
+=cut
+
+ $del_expired_logonnews->execute();
+}
+
+sub flood_expire(;$) {
+ add_timer('flood_expire', 10, __PACKAGE__, 'operserv::flood_expire');
+ __flood_expire();
+}
+
+sub get_flood_level($) {
+ my ($user) = @_;
+
+ return __flood_check(get_user_id($user));
+}
+
+sub flood_check($;$) {
+ my ($user, $amt) = @_;
+ $amt = 1 unless defined($amt);
+
+ if(adminserv::is_svsop($user, adminserv::S_HELP()) or adminserv::is_service($user)) {
+ return 0;
+ }
+ __flood_inc($amt, get_user_id($user));
+
+ my $flev;
+ if(defined($user->{FLOOD})) {
+ $user->{FLOOD} += $amt;
+ $flev = $user->{FLOOD};
+ } else {
+ $user->{FLOOD} = $flev = get_flood_level($user);
+ }
+ if($flev > 8) {
+ kill_user($user, "Flooding services.");
+ return 1;
+ }
+ elsif($flev > 6) {
+ notice($user, "You are flooding services.") if $amt == 1;
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+sub get_uinfo($@) {
+ my ($user, @userlist) = @_;
+ my @reply;
+ foreach my $tuser (@userlist) {
+ my ($ident, $host, $vhost, $gecos, $server) = get_user_info($tuser);
+ my $modes = nickserv::get_user_modes($tuser);
+ my $target = get_user_nick($tuser);
+
+ my ($curchans, $oldchans) = chanserv::get_user_chans_recent($tuser);
+
+ my @data = (
+ ["Status:", (nickserv::is_online($tuser) ? "Online" : "Offline")],
+ ["ID Nicks:", join(', ', nickserv::get_id_nicks($tuser))],
+ ["Channels:", join(', ', @$curchans)],
+ ["Recently Parted:", join(', ', @$oldchans)],
+ ["Flood level:", get_flood_level($tuser)],
+ ["Hostmask:", "$target\!$ident\@$vhost"],
+ ["GECOS:", $gecos],
+ ["Connecting from:", "$host"],
+ ["Current Server:", $server],
+ ["Modes:", $modes]
+ );
+ if(module::is_loaded('country')) {
+ push @data, ["Country:", country::get_user_country_long($tuser)];
+ } elsif(module::is_loaded('geoip')) {
+ push @data, ["Location:", geoip::stringify_location(geoip::get_user_location($tuser))];
+ }
+
+ push @reply, columnar {TITLE => "User info for \002$target\002:",
+ NOHIGHLIGHT => nr_chk_flag_user($user, NRF_NOHIGHLIGHT)}, @data;
+ }
+ return @reply;
+}
+
+sub get_clones($) {
+ my ($targets) = @_;
+ my @users;
+ foreach my $target (split(',', $targets)) {
+ my $sth; # statement handle. You'll see what I'll do with it next!
+ if($target =~ /^(?:\d{1,3}\.){3}\d{1,3}$/) {
+ $sth = $get_clones_fromipv4;
+ } elsif($target =~ /\./) { # doesn't really work with localhost. oh well.
+ $sth = $get_clones_fromhost;
+ } else {
+ $sth = $get_clones_fromnick;
+ }
+
+ $sth->execute($target);
+ while(my ($nick, $id, $online) = $sth->fetchrow_array()) {
+ push @users, { NICK => $nick, ID => $id, ONLINE => $online };
+ }
+ $sth->finish();
+ }
+ return @users;
+}
+
+## IRC EVENTS ##
+
+1;
--- /dev/null
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+package sql;
+use strict;
+
+use SrSv::MySQL qw( $dbh );
+use SrSv::Text::Format qw( columnar );
+use SrSv::IRCd::Event qw( addhandler );
+use SrSv::Agent;
+use SrSv::Conf2Consts qw( main );
+use SrSv::User qw( get_user_nick );
+use SrSv::User::Notice;
+
+
+my $sqlnick = 'SQLServ';
+
+agent_connect($sqlnick, 'services', 'services.SC.net', '+pqzBGHS', 'Database Query Agent');
+agent_join($sqlnick, main_conf_diag);
+ircd::setmode($sqlnick, main_conf_diag, '+o', $sqlnick);
+
+addhandler('PRIVMSG', undef, lc $sqlnick, 'sql::ev_privmsg');
+sub ev_privmsg {
+ my ($src, $dst, $payload) = @_;
+ my $user = { NICK => $src, AGENT => $sqlnick };
+ if(adminserv::is_svsop($user, adminserv::S_ROOT)) {
+ notice($user, "Permission denied"); #FIXME: need $err_deny
+ }
+ if($payload =~ /^SELECT (.*)$/) {
+ my $arrayRef;
+ eval {
+ $arrayRef = $dbh->selectall_arrayref("SELECT $1");
+ };
+ if($@) {
+ #ircd::debug("AIEEEEE! $@");
+ } elsif(scalar(@$arrayRef)) {
+ notice($user, columnar( { BORDER => 1, NOHIGHLIGHT => 1 }, @$arrayRef ) );
+ } else {
+ notice($user, "Empty result.");
+ }
+ }
+}
+
+sub init { }
+sub begin { }
+sub end { }
+sub unload { }
+
+1;
--- /dev/null
+Index: modules/country.pm
+===================================================================
+--- modules/country.pm (revision 2760)
++++ modules/country.pm (working copy)
+@@ -37,11 +37,11 @@ our ($get_ip_country, $get_ip_country_at
+
+ proc_init {
+ $get_ip_country = $dbh->prepare_cached("SELECT country FROM country WHERE
+- ? BETWEEN low AND high");
++ MBRCONTAINS(ip_poly, POINTFROMWKB(POINT(?, 0)))");
+ $get_ip_country_aton = $dbh->prepare_cached("SELECT country FROM country WHERE
+- INET_ATON(?) BETWEEN low AND high");
++ MBRCONTAINS(ip_poly, POINTFROMWKB(POINT(INET_ATON(?), 0)))");
+ $get_user_country = $dbh->prepare_cached("SELECT country FROM country, user WHERE
+- user.ip BETWEEN low AND high and user.id=?");
++ MBRCONTAINS(ip_poly, POINTFROMWKB(POINT(user.ip, 0))) and user.id=?");
+ };
+
+ sub get_ip_country($) {
+Index: utils/country-table.pl
+===================================================================
+--- utils/country-table.pl (revision 2785)
++++ utils/country-table.pl (working copy)
+@@ -52,6 +52,8 @@ sub main() {
+ newTable($dbh);
+ print "Inserting data... ";
+ loadData($dbh);
++ print "Converting data...\n";
++ convert($dbh);
+ print "Removing old table...\n";
+ cleanup($dbh);
+ $dbh->disconnect();
+@@ -124,7 +126,7 @@ sub newTable($) {
+
+ $dbh->do("DROP TABLE IF EXISTS newcountry");
+ $dbh->do(
+- "CREATE TABLE `newcountry` (
++ "CREATE TABLE `tmpcountry` (
+ `low` int unsigned NOT NULL default 0,
+ `high` int unsigned NOT NULL default 0,
+ `country` char(2) NOT NULL default '-',
+@@ -136,7 +138,7 @@ sub newTable($) {
+ sub loadData($) {
+ my ($dbh) = @_;
+
+- my $add_entry = $dbh->prepare("INSERT INTO newcountry SET low=INET_ATON(?), high=INET_ATON(?), country=?");
++ my $add_entry = $dbh->prepare("INSERT INTO tmpcountry SET low=INET_ATON(?), high=INET_ATON(?), country=?");
+
+ $| = 1;
+ my $unpackFile = PREFIX."/data/$unpackname";
+@@ -145,8 +147,8 @@ sub loadData($) {
+ my ($i, @entries);
+
+ open ((my $COUNTRYTABLE), '<', $unpackFile);
+- $dbh->do("ALTER TABLE `newcountry` DISABLE KEYS");
+- $dbh->do("LOCK TABLES newcountry WRITE");
++ $dbh->do("ALTER TABLE `tmpcountry` DISABLE KEYS");
++ $dbh->do("LOCK TABLES tmpcountry WRITE");
+ while(my $x = <$COUNTRYTABLE>) {
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+@@ -158,19 +160,40 @@ sub loadData($) {
+ push @entries,
+ '(INET_ATON('.$dbh->quote($low).'),'.'INET_ATON('.$dbh->quote($high).'),'.$dbh->quote($country).')';
+ if (scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+- $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries));
++ $dbh->do("INSERT IGNORE INTO tmpcountry (low, high, country) VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+- $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
++ $dbh->do("INSERT IGNORE INTO tmpcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
+ $dbh->do("UNLOCK TABLES");
+- $dbh->do("ALTER TABLE `newcountry` ENABLE KEYS");
++ $dbh->do("ALTER TABLE `tmpcountry` ENABLE KEYS");
+ close $COUNTRYTABLE;
+ print "\b\b\b\bdone.\n";
+ }
+
++sub convert($) {
++ my ($dbh) = @_;
++ $dbh->do(
++ "CREATE TABLE newcountry (
++ id int unsigned not null AUTO_INCREMENT,
++ ip_poly polygon not null,
++ low int unsigned not null,
++ high int unsigned not null,
++ country char(2) not null default '-',
++ PRIMARY KEY (id),
++ SPATIAL INDEX (ip_poly)
++ );"
++ );
++ $dbh->do(
++ "INSERT INTO newcountry (low,high,country,ip_poly)
++ SELECT low, high, country,
++ GEOMFROMWKB(POLYGON(LINESTRING( POINT(low, -1), POINT(high, -1),
++ POINT(high, 1), POINT(low, 1), POINT(low, -1)))) FROM tmpcountry;"
++ );
++}
++
+ sub cleanup() {
+ my ($dbh) = @_;
+
+Index: utils/country-table2.pl
+===================================================================
+--- utils/country-table2.pl (revision 2785)
++++ utils/country-table2.pl (working copy)
+@@ -58,6 +58,9 @@ sub main() {
+ newTable($dbh);
+ print "Inserting data... ";
+ loadData($dbh);
++ print "Converting data...\n";
++ convert($dbh);
++ print "Performing cleanup...\n";
+ cleanup($dbh);
+ $dbh->disconnect();
+ print "Country table update complete.\n";
+@@ -124,7 +127,7 @@ sub newTable($) {
+
+ $dbh->do("DROP TABLE IF EXISTS newcountry");
+ $dbh->do(
+- "CREATE TABLE `newcountry` (
++ "CREATE TEMPORARY TABLE `tmpcountry` (
+ `low` int unsigned NOT NULL default 0,
+ `high` int unsigned NOT NULL default 0,
+ `country` char(2) NOT NULL default '-',
+@@ -142,9 +145,9 @@ sub loadData($) {
+ my ($i, @entries);
+
+ open ((my $COUNTRYTABLE), '<', $unpackPath);
+- my $add_entry = $dbh->prepare("INSERT INTO newcountry SET low=INET_ATON(?), high=INET_ATON(?), country=?");
+- $dbh->do("ALTER TABLE `newcountry` DISABLE KEYS");
+- $dbh->do("LOCK TABLES newcountry WRITE");
++ my $add_entry = $dbh->prepare("INSERT INTO tmpcountry SET low=INET_ATON(?), high=INET_ATON(?), country=?");
++ $dbh->do("ALTER TABLE `tmpcountry` DISABLE KEYS");
++ $dbh->do("LOCK TABLES tmpcountry WRITE");
+ while(my $x = <$COUNTRYTABLE>) {
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+@@ -159,18 +162,40 @@ sub loadData($) {
+ push @entries,
+ '(INET_ATON('.$dbh->quote($low).'),'.'INET_ATON('.$dbh->quote($high).'),'.$dbh->quote($country).')';
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+- $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries));
++ $dbh->do("INSERT IGNORE INTO tmpcountry (low, high, country) VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+- $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
++ $dbh->do("INSERT IGNORE INTO tmpcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
+ $dbh->do("UNLOCK TABLES");
+- $dbh->do("ALTER TABLE `newcountry` ENABLE KEYS");
++ $dbh->do("ALTER TABLE `tmpcountry` ENABLE KEYS");
+ close $COUNTRYTABLE;
+ }
+
++sub convert($) {
++ my ($dbh) = @_;
++ $dbh->do(
++ "CREATE TABLE newcountry (
++ id int unsigned not null AUTO_INCREMENT,
++ ip_poly polygon not null,
++ low int unsigned not null,
++ high int unsigned not null,
++ country char(2) not null default '-',
++ PRIMARY KEY (`id`),
++ UNIQUE KEY (`low`, `high`),
++ SPATIAL INDEX (`ip_poly`)
++ );"
++ );
++ $dbh->do(
++ "INSERT INTO newcountry (low,high,country,ip_poly)
++ SELECT low, high, country,
++ GEOMFROMWKB(POLYGON(LINESTRING( POINT(low, -1), POINT(high, -1),
++ POINT(high, 1), POINT(low, 1), POINT(low, -1)))) FROM tmpcountry;"
++ );
++}
++
+ sub cleanup($) {
+ my ($dbh) = @_;
+
+Index: utils/country-table3.pl
+===================================================================
+--- utils/country-table3.pl (revision 2785)
++++ utils/country-table3.pl (working copy)
+@@ -58,6 +58,8 @@ sub main() {
+ newTable($dbh);
+ print "Inserting data... ";
+ loadData($dbh);
++ print "Converting data...\n";
++ convert($dbh);
+ print "Removing old table...\n";
+ cleanup($dbh);
+ $dbh->disconnect();
+@@ -95,7 +97,7 @@ sub newTable($) {
+
+ $dbh->do("DROP TABLE IF EXISTS newcountry");
+ $dbh->do(
+- "CREATE TABLE `newcountry` (
++ "CREATE TEMPORARY TABLE `tmpcountry` (
+ `low` int unsigned NOT NULL default 0,
+ `high` int unsigned NOT NULL default 0,
+ `country` char(2) NOT NULL default '-',
+@@ -106,7 +108,7 @@ sub newTable($) {
+
+ sub loadData($) {
+ my ($dbh) = @_;
+- my $add_entry = $dbh->prepare("INSERT IGNORE INTO newcountry SET low=?, high=?, country=?");
++ my $add_entry = $dbh->prepare("INSERT IGNORE INTO tmpcountry SET low=?, high=?, country=?");
+
+ $| = 1;
+ my $unpackPath = PREFIX.'/data/'.srcname;
+@@ -115,8 +117,8 @@ sub loadData($) {
+ my ($i, @entries);
+
+ open ((my $COUNTRYTABLE), '<', $unpackPath);
+- $dbh->do("ALTER TABLE `newcountry` DISABLE KEYS");
+- $dbh->do("LOCK TABLES newcountry WRITE");
++ $dbh->do("ALTER TABLE `tmpcountry` DISABLE KEYS");
++ $dbh->do("LOCK TABLES tmpcountry WRITE");
+ while(my $x = <$COUNTRYTABLE>) {
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+@@ -131,21 +133,43 @@ sub loadData($) {
+ next if lc $country eq 'eu';
+ push @entries, '('.$dbh->quote($low).','.$dbh->quote($high).','.$dbh->quote($country).')';
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+- $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries));
++ $dbh->do("INSERT IGNORE INTO tmpcountry (low, high, country) VALUES ".join(',', @entries));
+ @entries = ();
+ }
+ }
+
+ $i++;
+ }
+- $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
++ $dbh->do("INSERT IGNORE INTO tmpcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
+
+ $dbh->do("UNLOCK TABLES");
+- $dbh->do("ALTER TABLE `newcountry` ENABLE KEYS");
++ $dbh->do("ALTER TABLE `tmpcountry` ENABLE KEYS");
+ close $COUNTRYTABLE;
+ print "\b\b\b\bdone.\n";
+ }
+
++sub convert($) {
++ my ($dbh) = @_;
++ $dbh->do(
++ "CREATE TABLE newcountry (
++ id int unsigned not null AUTO_INCREMENT,
++ ip_poly polygon not null,
++ low int unsigned not null,
++ high int unsigned not null,
++ country char(2) not null default '-',
++ PRIMARY KEY (id),
++ UNIQUE KEY (`low`, `high`),
++ SPATIAL INDEX (ip_poly)
++ );"
++ );
++ $dbh->do(
++ "INSERT INTO newcountry (low,high,country,ip_poly)
++ SELECT low, high, country,
++ GEOMFROMWKB(POLYGON(LINESTRING( POINT(low, -1), POINT(high, -1),
++ POINT(high, 1), POINT(low, 1), POINT(low, -1)))) FROM tmpcountry;"
++ );
++}
++
+ sub cleanup($) {
+ my ($dbh) = @_;
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+
+my (%cmd_hash, %tok_hash);
+my $debug = 0;
+
+#open MSGH, "include/msg.h";
+while (my $l = <STDIN>) {
+ chomp $l;
+ next unless $l =~ /^#define/;
+ if ($l =~ /^#define(\s|\t)MSG_(\w+)(\s|\t)+\"(\S+)\".*/) {
+ $cmd_hash{$2}->{MSG} = $4;
+ print $l."\n" if $debug;
+ print "$2 $4"."\n" if $debug;
+ }
+ elsif ($l =~ /^#define(\s|\t)TOK_(\w+)(\s|\t)+\"(\S+)\".*/) {
+ $cmd_hash{$2}->{TOK} = $4;
+ print $l."\n" if $debug;
+ print "$2 $4"."\n" if $debug;
+ }
+}
+#close MSGH;
+
+
+foreach my $key (keys(%cmd_hash)) {
+ my $tok = $cmd_hash{$key}{TOK};
+ my $msg = $cmd_hash{$key}{MSG};
+# print $msg.' 'x(12-length($msg)). $tok."\n" if ($msg and $tok);
+ $tok_hash{$tok} = $msg if ($msg and $tok);
+}
+
+for(my $l = 1; $l <= 2; $l++) {
+ foreach my $key (sort keys %tok_hash) {
+ print $tok_hash{$key}.' 'x(12-length($tok_hash{$key})). $key."\n" if length($key) == $l;
+ }
+}
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+no strict 'refs';
+
+use constant { # Need them up here, before anybody derefs them.
+ ST_PRECONNECT => 0,
+ ST_LOADMOD => 1,
+ ST_NORMAL => 2,
+ ST_SHUTDOWN => 3,
+ ST_CLOSED => 4,
+ NETDUMP => 0,
+};
+
+use Cwd 'abs_path';
+use File::Basename;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => dirname(abs_path($0)),
+ );
+ require constant; import constant(\%constants);
+}
+chdir PREFIX;
+use lib PREFIX;
+
+use Getopt::Long;
+BEGIN {
+ my @debug_pkgs;
+ my $compile_only = 0;
+
+ GetOptions(
+ "debug:s" => \@debug_pkgs,
+ "compile" => \$compile_only,
+ );
+
+ if(@debug_pkgs) {
+ require SrSv::Debug;
+
+ SrSv::Debug::enable();
+ push @debug_pkgs, 'main';
+ foreach my $pkg (@debug_pkgs) {
+ $SrSv::Debug::debug_pkgs{$pkg} = 1;
+ }
+ }
+ import constant { COMPILE_ONLY => $compile_only };
+}
+
+use SrSv::OnIRC (1);
+
+use SrSv::Debug;
+use SrSv::Log;
+use SrSv::Conf2Consts qw(main);
+
+use IO::Socket;
+use Carp;
+
+use SrSv::IRCd::IRCdSpecific; # <-- is package ircd
+#use libs::config;
+use libs::misc;
+use libs::event;
+use libs::modes;
+use libs::module;
+
+use SrSv::Process::Init ();
+use SrSv::Process::Worker qw(spawn);
+use SrSv::Message qw(add_callback);
+use SrSv::Timer qw(begin_timer);
+
+#*conf = \%main_conf; #FIXME
+
+STDOUT->autoflush(1);
+
+our $progname = 'SurrealServices';
+our $version = '0.4.3-pre';
+our $extraversion = 'configured for UnrealIRCd 3.2.7';
+
+#FIXME: Figure out where $rsnick belongs and update all references
+our $rsnick; *rsnick = \$core::rsnick;
+
+print "Starting $progname $version.\n";
+
+#config::loadconfig();
+
+module::load();
+exit() if COMPILE_ONLY;
+ircd::serv_connect();
+
+unless(DEBUG) {
+ exit if fork;
+ close STDIN;
+ close STDOUT;
+ close STDERR;
+ open STDIN, '<', '/dev/null';
+ open STDOUT, '>', '/dev/null';
+ open STDERR, '>', '/dev/null';
+ setpgrp();
+}
+
+if(main_conf_procs) {
+ for(1..main_conf_procs) { spawn(); }
+}
+
+SrSv::Process::Init::do_init();
+module::begin();
+
+begin_timer();
+
+event::loop();
--- /dev/null
+0.4.2 is the first time in a long time that we are changing the database
+format that requires a script to run.
+
+This version has both an updatedb-0.4.2.sql file, and an
+upgrade-0.4.2.pl script. The order you run this in does not matter.
+
+fwiw, for now, the upgrade script is optional, but recommended for
+security reasons. For now, 0.4.2 will remain compatible with the
+non-hashed passwords, but this may be removed at a later date.
+
+This is a major change in how passwords will work. SENDPASS is being
+changed. If the password is hashed, it will not send the actual password
+but an authentication code that will allow the user to identify and
+change their password. Additionally, GETPASS has been removed, as it
+will no longer work.
+
+Please notify your staff. Notify your users too.
--- /dev/null
+CREATE TABLE `akick` (
+ `chan` varchar(32) NOT NULL default '',
+ `nick` varchar(30) NOT NULL default '',
+ `ident` varchar(10) NOT NULL default '',
+ `host` varchar(64) NOT NULL default '',
+ `adder` varchar(30) NOT NULL default '',
+ `reason` text,
+ `time` int(10) unsigned NOT NULL default '0',
+ PRIMARY KEY (`chan`,`nick`,`ident`,`host`)
+) TYPE=MyISAM;
+
+
+CREATE TABLE `bot` (
+ `nick` char(30) NOT NULL default '',
+ `ident` char(10) NOT NULL default '',
+ `vhost` char(64) NOT NULL default '',
+ `gecos` char(50) NOT NULL default '',
+ `flags` mediumint NOT NULL default '1',
+ PRIMARY KEY (`nick`)
+) TYPE=MyISAM;
+
+CREATE TABLE `chanacc` (
+ `chan` char(32) NOT NULL default '',
+ `nrid` int(11) unsigned NOT NULL default '0',
+ `level` tinyint(3) NOT NULL default '0',
+ `adder` char(30) NOT NULL default '',
+ `time` int(10) unsigned NOT NULL default '0',
+ `last` int(10) unsigned NOT NULL default '0',
+ PRIMARY KEY (`chan`,`nrid`)
+) TYPE=MyISAM;
+
+CREATE TABLE `chanclose` (
+ `chan` char(30) NOT NULL default '',
+ `nick` char(30) NOT NULL default '',
+ `reason` text NOT NULL default '',
+ `time` int(11) unsigned NOT NULL default '0',
+ `type` tinyint(3) unsigned NOT NULL default '0',
+ PRIMARY KEY (`chan`)
+) TYPE=MyISAM;
+
+CREATE TABLE `chanlvl` (
+ `chan` char(32) NOT NULL default '',
+ `perm` smallint(5) unsigned NOT NULL default '0',
+ `level` tinyint(4) NOT NULL default '0',
+ PRIMARY KEY (`chan`,`perm`)
+) TYPE=MyISAM;
+
+CREATE TABLE `chanperm` (
+ `name` char(10) NOT NULL default '',
+ `id` smallint(5) unsigned NOT NULL auto_increment,
+ `level` tinyint(4) NOT NULL default '0',
+ `max` tinyint(3) unsigned NOT NULL default 0,
+ PRIMARY KEY (`name`),
+ UNIQUE KEY `id` (`id`)
+) TYPE=MyISAM;
+
+CREATE TABLE `chanreg` (
+ `chan` varchar(32) NOT NULL default '',
+ `descrip` varchar(255) default NULL,
+ `regd` int(11) unsigned NOT NULL default '0',
+ `last` int(11) unsigned NOT NULL default '0',
+ `topicer` varchar(30) NOT NULL default '',
+ `topicd` int(11) unsigned NOT NULL default '0',
+ `modelock` varchar(63) binary NOT NULL default '+ntr',
+ `founderid` int(11) unsigned NOT NULL default '0',
+ `successorid` int(11) unsigned NOT NULL default '0',
+ `bot` varchar(30) NOT NULL default '',
+ `flags` mediumint(8) unsigned NOT NULL default '0',
+ `bantype` tinyint(8) unsigned NOT NULL default '0',
+ PRIMARY KEY (`chan`)
+) TYPE=MyISAM;
+
+
+CREATE TABLE `ircop` (
+ `nick` char(30) NOT NULL default '',
+ `level` tinyint(3) unsigned NOT NULL default '0',
+ `pass` char(127) binary NOT NULL default '',
+ PRIMARY KEY (`nick`)
+) TYPE=MyISAM;
+
+CREATE TABLE `logonnews` (
+ `setter` char(30) NOT NULL default '',
+ `type` char(1) NOT NULL default 'u',
+ `id` tinyint(3) unsigned NOT NULL default 0,
+ `time` int(11) unsigned NOT NULL default '0',
+ `expire` int(11) unsigned NOT NULL default '0',
+ `msg` text NOT NULL
+) TYPE=MyISAM;
+
+CREATE TABLE `memo` (
+ `src` varchar(30) NOT NULL default '',
+ `dstid` int(11) unsigned NOT NULL default '0',
+ `chan` varchar(32) NOT NULL default '',
+ `time` int(11) unsigned NOT NULL default '0',
+ `flag` tinyint(3) unsigned NOT NULL default '0',
+ `msg` text NOT NULL,
+ PRIMARY KEY (`src`,`dstid`,`chan`,`time`),
+ KEY `dst` (`dstid`)
+) TYPE=MyISAM;
+
+CREATE TABLE `ms_ignore` (
+ `nrid` int(11) unsigned NOT NULL default '0',
+ `ignoreid` int(11) unsigned NOT NULL default '0',
+ `time` int(11) unsigned NOT NULL default '0',
+ PRIMARY KEY (`nrid`,`ignoreid`)
+) TYPE=MyISAM;
+
+CREATE TABLE `nickalias` (
+ `nrid` int(11) unsigned NOT NULL default '0',
+ `alias` char(30) NOT NULL default '',
+ `protect` tinyint(4) NOT NULL default '1',
+ `last` int(11) unsigned NOT NULL default 0,
+ PRIMARY KEY (`nrid`,`alias`),
+ UNIQUE KEY `alias` (`alias`)
+) TYPE=MyISAM;
+
+CREATE TABLE `nickid` (
+ `id` int(10) unsigned NOT NULL default '0',
+ `nrid` int(11) unsigned NOT NULL default '0',
+ PRIMARY KEY (`id`,`nrid`),
+ KEY `nrid` (`nrid`)
+) TYPE=HEAP;
+
+CREATE TABLE `nickreg` (
+ `id` int(11) unsigned NOT NULL AUTO_INCREMENT,
+ `nick` char(30) NOT NULL default '',
+ `pass` char(127) binary NOT NULL default '',
+ `email` char(127) NOT NULL default '',
+ `regd` int(11) unsigned NOT NULL default '0',
+ `last` int(11) unsigned NOT NULL default '0',
+ `flags` mediumint(3) unsigned NOT NULL default '1',
+ `ident` char(10) NOT NULL default '',
+ `vhost` char(64) NOT NULL default '',
+ `gecos` char(50) NOT NULL default '',
+ `quit` char(127) NOT NULL default '',
+ `nearexp` tinyint(3) unsigned NOT NULL default '0',
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `nick` (`nick`)
+) TYPE=MyISAM;
+
+CREATE TABLE `sesexname` (
+ `host` varchar(64) NOT NULL default '',
+ `serv` tinyint(1) NOT NULL default 0,
+ `adder` varchar(3) NOT NULL default '',
+ `lim` mediumint(8) unsigned NOT NULL default 0,
+ `reason` varchar(255) NOT NULL default '',
+ PRIMARY KEY (`host`)
+);
+
+CREATE TABLE `sesexip` (
+ `ip` int(10) unsigned NOT NULL default 0,
+ `mask` tinyint(3) NOT NULL default 0,
+ `adder` varchar(3) NOT NULL default '',
+ `lim` mediumint(8) unsigned NOT NULL default 0,
+ `reason` varchar(255) NOT NULL default '',
+ PRIMARY KEY (`ip`)
+);
+
+CREATE TABLE `qline` (
+ `mask` varchar(30) NOT NULL default '',
+ `setter` varchar(30) NOT NULL default '',
+ `time` int(11) unsigned NOT NULL default '0',
+ `expire` int(11) unsigned NOT NULL default '0',
+ `reason` text NOT NULL,
+ PRIMARY KEY (`mask`),
+ KEY `time` (`time`),
+ KEY `expire` (`expire`)
+) TYPE=MyISAM;
+
+CREATE TABLE `silence` (
+ `nrid` int(11) unsigned NOT NULL default '0',
+ `mask` char(106) NOT NULL default '',
+ `time` int(10) unsigned NOT NULL default '0',
+ `expiry` int(10) unsigned NOT NULL default '0',
+ `comment` char(100) default NULL,
+ PRIMARY KEY (`nrid`,`mask`)
+) TYPE=MyISAM;
+
+
+CREATE TABLE `svsop` (
+ `nrid` int(11) unsigned NOT NULL default '0',
+ `level` tinyint(3) unsigned NOT NULL default '0',
+ `adder` char(30) NOT NULL default '',
+ PRIMARY KEY (`nrid`)
+) TYPE=MyISAM;
+
+CREATE TABLE `vhost` (
+ `nrid` int(11) unsigned NOT NULL default '0',
+ `ident` char(10) NOT NULL default '',
+ `vhost` char(64) NOT NULL default '',
+ `adder` char(30) NOT NULL default '',
+ `time` int(10) unsigned NOT NULL default '0',
+ PRIMARY KEY (`nrid`)
+) TYPE=MyISAM;
+
+CREATE TABLE `watch` (
+ `nrid` int(11) unsigned NOT NULL default '0',
+ `mask` char(106) NOT NULL default '',
+ `time` int(10) unsigned NOT NULL default '0',
+ PRIMARY KEY (`nrid`,`mask`)
+) TYPE=MyISAM;
+
+CREATE TABLE `welcome` (
+ `chan` varchar(32) NOT NULL default '',
+ `id` tinyint(3) NOT NULL default '0',
+ `adder` varchar(30) NOT NULL default '',
+ `time` int(10) NOT NULL default '0',
+ `msg` text NOT NULL,
+ PRIMARY KEY (`chan`,`id`)
+) TYPE=MyISAM;
+
+CREATE TABLE `nicktext` (
+ `nrid` int(11) unsigned NOT NULL default 0,
+ `type` tinyint(3) unsigned NOT NULL default 0,
+ `id` mediumint(8) unsigned NOT NULL default 0,
+ `chan` varchar(32) default NULL,
+ `data` text default NULL,
+ PRIMARY KEY (`nrid`, `type`, `id`, `chan`)
+) TYPE=MyISAM;
+
+#################################################
+# Volatile tables
+
+DROP TABLE IF EXISTS `chan`;
+CREATE TABLE `chan` (
+ `chan` char(32) NOT NULL default '',
+ `modes` char(63) binary NOT NULL default '',
+ `seq` mediumint(8) unsigned NOT NULL default '0',
+ PRIMARY KEY (`chan`)
+) TYPE=HEAP;
+
+DROP TABLE IF EXISTS `chanban`;
+CREATE TABLE `chanban` (
+ `chan` varchar(32) NOT NULL default '',
+ `mask` varchar(110) NOT NULL default '',
+ `setter` varchar(30) NOT NULL default '',
+ `time` int(10) unsigned NOT NULL default '0',
+ `type` tinyint(3) unsigned NOT NULL default '0',
+ PRIMARY KEY (`chan`,`mask`,`type`)
+) TYPE=HEAP;
+
+#DROP TABLE IF EXISTS `chantext`;
+CREATE TABLE `chantext` (
+ `chan` varchar(32) NOT NULL default '',
+ `type` tinyint(3) unsigned NOT NULL default 0,
+ `key` varchar(32) default NULL,
+ `data` text default NULL,
+ PRIMARY KEY (`chan`, `type`, `key`)
+) TYPE=MyISAM;
+
+DROP TABLE IF EXISTS `chanuser`;
+CREATE TABLE `chanuser` (
+ `seq` mediumint(8) unsigned NOT NULL default '0',
+ `nickid` int(11) unsigned NOT NULL default '0',
+ `chan` char(32) NOT NULL default '',
+ `joined` tinyint(3) unsigned NOT NULL default '0',
+ `op` tinyint(4) NOT NULL default '0',
+ PRIMARY KEY (`nickid`,`chan`),
+ KEY `chan` (`chan`),
+ KEY `nickid` (`nickid`)
+) TYPE=HEAP;
+
+DROP TABLE IF EXISTS `nickchg`;
+CREATE TABLE `nickchg` (
+ `seq` mediumint(8) unsigned NOT NULL default '0',
+ `nickid` int(11) unsigned NOT NULL default '0',
+ `nick` char(30) NOT NULL default '',
+ PRIMARY KEY (`nick`)
+) TYPE=HEAP;
+
+DROP TABLE IF EXISTS `tklban`;
+CREATE TABLE `tklban` (
+ `type` char(1) NOT NULL default '',
+ `ident` char(10) NOT NULL default '',
+ `host` char(64) NOT NULL default '',
+ `setter` char(106) NOT NULL default '',
+ `expire` int(11) unsigned NOT NULL default 0,
+ `time` int(11) unsigned NOT NULL default 0,
+ `reason` char(255) NOT NULL default '',
+ PRIMARY KEY (`type`, `ident`, `host`)
+) TYPE = HEAP;
+
+DROP TABLE IF EXISTS `spamfilter`;
+CREATE TABLE `spamfilter` (
+ `target` char(20) NOT NULL default '',
+ `action` char(20) NOT NULL default '',
+ `setter` char(106) NOT NULL default '',
+ `expire` int(11) unsigned NOT NULL default 0,
+ `time` int(11) unsigned NOT NULL default 0,
+ `bantime` int(11) unsigned NOT NULL default 0,
+ `reason` char(255) NOT NULL default '',
+ `mask` char(255) NOT NULL default '',
+ PRIMARY KEY (`target`, `action`, `mask`)
+) TYPE = HEAP;
+
+# Keep this even though it is volatile; it still contains useful data
+CREATE TABLE `user` (
+ `id` int(11) unsigned NOT NULL default '0',
+ `nick` char(30) NOT NULL default '',
+ `time` int(11) unsigned NOT NULL default '0',
+ `inval` tinyint(4) NOT NULL default '0',
+ `ident` char(10) NOT NULL default '',
+ `host` char(64) NOT NULL default '',
+ `vhost` char(64) NOT NULL default '',
+ `cloakhost` char(64) default NULL,
+ `ip` int(8) unsigned NOT NULL default '0',
+ `server` char(64) NOT NULL default '',
+ `modes` char(30) NOT NULL default '',
+ `gecos` char(50) NOT NULL default '',
+ `guest` tinyint(1) NOT NULL default '0',
+ `online` tinyint(1) unsigned NOT NULL default '0',
+ `quittime` int(11) unsigned NOT NULL default '0',
+ `flood` tinyint(1) unsigned NOT NULL default '0',
+ `flags` mediumint(10) unsigned NOT NULL,
+ PRIMARY KEY (`id`),
+ UNIQUE KEY `nick` (`nick`),
+ KEY `ip` (`ip`)
+) TYPE=HEAP;
+
+#################################################
+# Not used
+
+DROP TABLE IF EXISTS `olduser`;
+
+DROP TABLE IF EXISTS `chanlog`;
+#CREATE TABLE `chanlog` (
+# `chan` char(30) NOT NULL default '',
+# `adder` char(30) NOT NULL default '',
+# `time` unsigned int NOT NULL default 0,
+# `email` varchar(100) NOT NULL default ''
+# PRIMARY KEY (`chan`)
+#) TYPE = MyISAM;
+
+#################################################
+# Upgrades
+
+# 0.4.2
+ALTER TABLE chanperm MODIFY `name` char(16) NOT NULL default '';
+UPDATE chanperm SET name='AkickEnforce' WHERE name LIKE 'AkickEn%';
+ALTER TABLE `ms_ignore` DROP KEY `nickid`, DROP COLUMN id;
+
+alter table user
+ modify column id int(11) unsigned not null auto_increment,
+ drop primary key,
+ add primary key using btree (id),
+ drop key nick,
+ add key nick using hash (nick),
+ drop key ip,
+ add key using btree (ip);
+
+# Duplicate key given PRIMARY already indexes this column first.
+ALTER TABLE `nickalias` DROP KEY `root`;
+
+# Duplicate keys given PRIMARY already indexes this column first.
+ALTER TABLE `akick` DROP INDEX `chan`;
+ALTER TABLE `silence` DROP KEY `nick`;
+ALTER TABLE `nickid` DROP INDEX `id`, ADD KEY `nrid` (`nrid`);
+ALTER TABLE `watch` DROP KEY `nick`;
--- /dev/null
+#!/usr/bin/perl
+
+sub say(@) {
+ print map({ "$_\n" } @_);
+}
+use strict;
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename qw( dirname );
+ use constant { PREFIX => dirname(abs_path($0)), }
+}
+use lib PREFIX;
+
+#use Digest::SHA::PurePerl;
+use SrSv::Hash::SaltedHash qw( makeHash_v0 makeHash verifyHash extractMeta extractSalt );
+
+#say makeHash_v0('fumafuma', 'fufu', 'SHA256');
+#exit;
+
+my ($algorithm, $version, $salt) = extractMeta('{SSHA}zIdhML+axPWmpSymzKlTciJ5asoryacr');
+my $hash = makeHash_v0('choice81', $salt, $algorithm);
+say $hash;
+exit;
+my $check = verifyHash($hash, 'fumafuma');
+print (($check ? 'true' : 'false')."\n");
+
+#my $hash = makeHash_v0('fumafuma');
+#my ($algo, $version, $salt) = extractMeta($hash);
+#say "$algo $version $salt";
+#say length(makeHash_v0('fumafuma', 'fufu', 'SHA256'));
--- /dev/null
+/*
+ * NEW: alias {}
+ * OLD: N/A
+ * This allows you to set command aliases such as /identify, /services, etc
+ *
+ * Syntax:
+ * alias "name" {
+ * format "format string" {
+ * nick "points to";
+ * type aliastype;
+ * parameters "parameters to send";
+ * };
+ * type command;
+ * };
+ */
+/* This is shown seperately because even though it has the same name as the previous directive, it is very
+ * different in syntax, although it provides a similar function and relys on the standard aliases to work.
+ */
+include "config/net/aliases/genericservices.conf";
+include "config/net/aliases/surrealservices.conf";
+include "config/net/aliases/ircd.conf";
+
--- /dev/null
+/* Standard Aliases */
+
+alias identify {
+/* format "^#" {
+ nick chanserv;
+ type services;
+ parameters "IDENTIFY %1-";
+ };*/
+ format "^[^#]" {
+ nick nickserv;
+ type services;
+ parameters "IDENTIFY %1-";
+ };
+ type command;
+};
+
+alias id {
+/* format "^#" {
+ nick chanserv;
+ type services;
+ parameters "IDENTIFY %1-";
+ };*/
+ format "^[^#]" {
+ nick nickserv;
+ type services;
+ parameters "IDENTIFY %1-";
+ };
+ type command;
+};
+
+alias services {
+ format "^#" {
+ nick chanserv;
+ type services;
+ parameters "%1-";
+ };
+ format "^[^#]" {
+ nick nickserv;
+ type services;
+ parameters "%1-";
+ };
+ type command;
+ spamfilter yes;
+};
+
+alias register {
+ format "^#" {
+ nick chanserv;
+ type services;
+ parameters "REGISTER %1-";
+ };
+ format "^[^#]" {
+ nick nickserv;
+ type services;
+ parameters "REGISTER %1-";
+ };
+ type command;
+};
--- /dev/null
+alias umode {
+ format "" {
+ command "MODE";
+ type real;
+ parameters "%n %1-";
+ };
+ type command;
+};
--- /dev/null
+/* SurrealServices Aliases */
+
+alias nickserv { type services; };
+alias ns { target nickserv; type services; spamfilter yes; };
+
+alias chanserv { type services; spamfilter yes; };
+alias cs { target chanserv; type services; spamfilter yes; };
+
+alias memoserv { type services; spamfilter yes; };
+alias ms { target memoserv; type services; spamfilter yes; };
+
+alias hostserv { type services; };
+alias hs { target hostserv; type services; };
+
+alias operserv { type services; };
+alias os { target operserv; type services; };
+
+alias rootserv { target servserv; type services; };
+/* alias rs { target servserv; type services; }; */
+
+alias botserv { type services; spamfilter yes; };
+alias bs { target botserv; type services; spamfilter yes; };
+
+alias adminserv { target adminserv; type services; };
+alias as { target adminserv; type services; };
+
+alias uinfo {
+ format "" { // basically anything can be fed to this alias, tho we only want nicks
+ nick operserv;
+ type services;
+ parameters "UINFO %1-";
+ };
+ type command;
+};
+
+alias seen {
+ format "" { // basically anything can be fed to this alias, tho we only want nicks
+ nick nickserv;
+ type services;
+ parameters "SEEN %1-";
+ };
+ type command;
+};
+
+alias fjoin {
+ format "" {
+ nick operserv;
+ type services;
+ parameters "FJOIN %1-";
+ };
+ type command;
+};
+
+alias fpart {
+ format "" {
+ nick operserv;
+ type services;
+ parameters "FPART %1-";
+ };
+ type command;
+};
+
+alias gnick {
+ format "" {
+ nick operserv;
+ type services;
+ parameters "GNICK %1-";
+ };
+ type command;
+};
+
+alias mkill {
+ format "" {
+ nick operserv;
+ type services;
+ parameters "CLONES KILL %1-"; // this should become MASSKILL when SrSv 0.4.2 goes -final
+ };
+ type command;
+};
+
+alias masskill {
+ format "" {
+ nick operserv;
+ type services;
+ parameters "CLONES KILL %1-";
+ };
+ type command;
+};
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use File::stat;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => abs_path(dirname(abs_path($0)).'/..'),
+ );
+ require constant; import constant(\%constants);
+}
+chdir PREFIX;
+use lib PREFIX;
+
+use SrSv::Time;
+
+my $logdir = PREFIX.'/logs';
+my $chanlogdir = "$logdir/chanlogs";
+my $gzip = qx(which gzip);
+my $bzip2 = qx(which bzip2);
+chomp ($gzip, $bzip2);
+# greater than 1000 bytes, bzip2, else gzip.
+# This is based on an average observed from chanlogs.
+# Thankfully bzcat and bzgrep tend to be agnostic.
+my $bzip_threshold = 1000;
+
+opendir ((my $LOGDIR), $logdir.'/');
+
+my $i = 0; my @today = gmt_date();
+while (my $filename = readdir($LOGDIR)) {
+ next if $filename eq '..' or $filename =~ /\.(gz|bz2)$/ or !(-f "$logdir/$filename");
+ my $dir; my ($year, $month, $day);
+ if($filename =~ /^services.log-(\d{4})-(\d{2})-(\d{2})$/i) {
+ ($year, $month, $day) = ($1, $2, $3);
+ if($year == $today[0] and $month == $today[1] and $day == $today[3]) {
+ # Don't process today's logs
+ print "Skipping $filename\n";
+ next;
+ }
+
+ $dir = $logdir;
+ }
+ elsif ($filename =~ /^#.*\.log-(\d{4})-(\d{2})-(\d{2})$/i) {
+ ($year, $month, $day) = ($1, $2, $3);
+ if($year == $today[0] and $month == $today[1] and $day == $today[3]) {
+ # Don't process today's logs
+ print "Skipping $filename\n";
+ next;
+ }
+ # Eventual plan is to make these available on the website...
+ # This may necessitate only using gzip however (mod_deflate)
+
+ $dir = $chanlogdir;
+ mkdir $chanlogdir unless (-d $chanlogdir);
+
+ }
+ else { next; }
+ # rename() is 'move', or really link($newname) and unlink($oldname)
+ unless(-d "$dir/$year/$month") {
+ mkdir "$dir/$year" unless (-d "$dir/$year");
+ mkdir "$dir/$year/$month";
+ }
+ rename "$logdir/$filename", "$dir/$year/$month/$filename";
+ system(((stat("$dir/$year/$month/$filename")->[7] > $bzip_threshold) ? $bzip2 : $gzip),
+ '-9vv', "$dir/$year/$month/$filename");
+ $i++;
+}
+closedir $LOGDIR;
+
+print "Processed $i logs\n";
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# SurrealChat.net does not provide the Blacklist Data
+# is in no way associated with dronebl.org,
+# nor are we providing a license to download/use it.
+# Be sure to direct availability/accuracy/licensing questions to
+# http://dronebl.org/docs/howtouse
+
+use strict;
+use DBI;
+use Cwd 'abs_path';
+use File::Basename;
+
+use Cwd qw( abs_path getcwd );
+use File::Basename qw( dirname );
+BEGIN {
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => abs_path(dirname(abs_path($0)).'/../'),
+ );
+ require constant; import constant \%constants;
+}
+use lib PREFIX;
+
+#Date::Parse might not be on the user's system, so we ship our own copy.
+use Date::Parse;
+
+use SrSv::SimpleHash qw(readHash);
+use SrSv::Conf2Consts 'sql';
+
+my $srcname = 'http://www.dronebl.org/buildzone.do';
+my $bindip = undef;
+my $unpackname = $srcname;
+my $diffname = $srcname.'.diff';
+
+my $OPMDATA;
+unless(open $OPMDATA, '-|', "wget -q -O - http://www.dronebl.org/buildzone.do") {
+ print STDERR "FATAL: Processing failed.\n";
+ exit -1;
+}
+
+print "Connecting to database...\n";
+
+my $dbh;
+eval {
+ $dbh = DBI->connect("DBI:mysql:".sql_conf_mysql_db, sql_conf_mysql_user, sql_conf_mysql_pass,
+ { AutoCommit => 1, RaiseError => 1, PrintError => 1 })
+};
+
+if($@) {
+ print STDERR "FATAL: Can't connect to database:\n$@\n";
+ print STDERR "You must have SrSv properly setup before you attempt to use this helper script.\n\n";
+ exit -1;
+}
+
+print "Creating new table...\n";
+
+$dbh->do("DROP TABLE IF EXISTS `newopm`");
+$dbh->do(
+"CREATE TABLE `newopm` (
+ `ipnum` int(11) unsigned NOT NULL default 0,
+ `ipaddr` char(15) NOT NULL default '0.0.0.0',
+ `type` tinyint(3) NOT NULL default 0,
+ PRIMARY KEY (`ipnum`),
+ UNIQUE KEY `addrkey` (`ipaddr`)
+) TYPE=MyISAM;"
+);
+
+sub save2DB($@) {
+ my ($baseQuery, @rows) = @_;
+ $dbh->do("$baseQuery ".join(',', @rows));
+}
+
+sub processData() {
+ print "Inserting data... ";
+
+ $dbh->do("ALTER TABLE `newopm` DISABLE KEYS");
+ $dbh->do("LOCK TABLES newopm WRITE");
+ my $type;
+ my $baseQuery = "REPLACE INTO `newopm` (ipnum, ipaddr, type) VALUES ";
+ my @rows;
+ my $count = 0;
+ while(my $x = <$OPMDATA>) {
+ chomp $x;
+ if($x =~ /^:(\d+):$/) {
+ $type = $1;
+ } elsif($x =~ /^(\d+\.\d+\.\d+\.\d+)$/) {
+ next unless $type;
+ my $ipaddr = $1;
+ push @rows, '(INET_ATON('.$dbh->quote($ipaddr).'),'.$dbh->quote($ipaddr).','.$type.')';
+ $count++;
+ if(scalar(@rows)) {
+ save2DB($baseQuery, @rows);
+ @rows = ();
+ }
+ }
+ }
+ die "No entries found\n" unless $count;
+
+ #rename($unpackname, $srcname.'.old');
+ save2DB($baseQuery, @rows) if scalar(@rows);
+
+ $dbh->do("UNLOCK TABLES");
+ $dbh->do("ALTER TABLE `newopm` ENABLE KEYS");
+}
+
+processData();
+close $OPMDATA;
+
+print "done.\nRemoving old table...\n";
+$dbh->do("DROP TABLE IF EXISTS `oldopm`");
+$dbh->do("OPTIMIZE TABLE `newopm`");
+print "Renaming new table...\n";
+$dbh->{RaiseError} = $dbh->{PrintError} = 0; # the following commands can fail, but are harmless.
+$dbh->do("RENAME TABLE `opm` TO `oldopm`");
+$dbh->do("RENAME TABLE `newopm` TO `opm`");
+$dbh->do("DROP TABLE IF EXISTS `oldopm`");
+
+print "Blacklist table update complete.\n";
+
+exit;
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# SurrealChat.net does not provide the Country/Allocation data,
+# is in no way associated with ludost.net,
+# nor are we providing a license to download/use it.
+# Be sure to direct availability/accuracy/licensing questions to ludost.net
+use strict;
+use DBI;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => abs_path(dirname(abs_path($0)).'/..'),
+ );
+ require constant; import constant(\%constants);
+}
+chdir PREFIX;
+use lib PREFIX;
+
+use Date::Parse;
+
+use SrSv::Conf 'sql';
+
+my $countrydb_url= 'http://ip.ludost.net/raw/country.db.gz';
+my $srcname = 'country.db.gz';
+my $unpackname = 'country.db';
+
+main();
+
+sub main() {
+ downloadData();
+ print "Connecting to database...\n";
+ my $dbh = dbConnect();
+ newTable($dbh);
+ print "Inserting data... ";
+ loadData($dbh);
+ print "Removing old table...\n";
+ cleanup($dbh);
+ $dbh->disconnect();
+ print "Country table update complete.\n";
+
+ unlink PREFIX."/data/$unpackname";
+
+ exit;
+}
+
+sub downloadData() {
+ # This MAY be implementable with an open of a pipe
+ # pipe the output of wget through gzip -d
+ # and then into the load-loop.
+ # It's a bit heavy to run directly from inside services however.
+ # I'd recommend it be run as a crontab script separate from services.
+
+ my (@stats, $date, $size);
+ if(@stats = stat(PREFIX."/data/$srcname")) {
+ print "Checking for updated country data...\n";
+ my $header = qx{wget --spider -S $countrydb_url 2>&1};
+ ($date) = ($header =~ /Last-Modified: (.*)/);
+ ($size) = ($header =~ /Content-Length: (.*)/);
+ }
+
+ if(@stats and $stats[7] == $size and $stats[9] >= str2time($date)) {
+ print "Country data is up to date.\n";
+ } else {
+ print "Downloading country data...\n";
+
+ unlink PREFIX."/data/$srcname";
+ system("wget $countrydb_url -O ".PREFIX."/data/$srcname");
+ unless(-e PREFIX."/data/$srcname") {
+ print STDERR "FATAL: Download failed.\n";
+ exit -1;
+ }
+ }
+
+ print "Decompressing...\n";
+ unlink PREFIX."/data/$unpackname";
+ system("gunzip -c ".PREFIX."/data/$srcname > ".PREFIX."/data/$unpackname");
+ unless(-e PREFIX."/data/$unpackname") {
+ print STDERR "FATAL: Decompression failed.\n";
+ exit -1;
+ }
+}
+
+sub dbConnect() {
+ my $dbh;
+ eval {
+ $dbh = DBI->connect("DBI:mysql:".sql_conf_mysql_db, sql_conf_mysql_user, sql_conf_mysql_pass,
+ { AutoCommit => 1, RaiseError => 1 })
+ };
+
+ if($@) {
+ print STDERR "FATAL: Can't connect to database:\n$@\n";
+ print STDERR "You must edit config/sql.conf and create a corresponding\nMySQL user and database!\n\n";
+ exit -1;
+ }
+
+ print "Creating new table...\n";
+
+ $dbh->{RaiseError} = 1;
+ $dbh->{PrintError} = 1;
+ return $dbh;
+}
+
+sub newTable($) {
+ my ($dbh) = @_;
+
+ $dbh->do("DROP TABLE IF EXISTS newcountry");
+ $dbh->do(
+ "CREATE TABLE `newcountry` (
+ `low` int unsigned NOT NULL default 0,
+ `high` int unsigned NOT NULL default 0,
+ `country` char(2) NOT NULL default '-',
+ PRIMARY KEY (`low`, `high`)
+ ) TYPE=MyISAM"
+ );
+}
+
+sub loadData($) {
+ my ($dbh) = @_;
+
+ my $add_entry = $dbh->prepare("INSERT INTO newcountry SET low=INET_ATON(?), high=INET_ATON(?), country=?");
+
+ $| = 1;
+ my $unpackFile = PREFIX."/data/$unpackname";
+ my ($lines) = qx{wc -l $unpackFile};
+ my $div = int($lines/100);
+ my ($i, @entries);
+
+ open ((my $COUNTRYTABLE), '<', $unpackFile);
+ $dbh->do("ALTER TABLE `newcountry` DISABLE KEYS");
+ $dbh->do("LOCK TABLES newcountry WRITE");
+ while(my $x = <$COUNTRYTABLE>) {
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+
+ chomp $x;
+ my ($low, $high, $country) = split(/ /, $x);
+ #$add_entry->execute($low, $high, $country);
+ push @entries,
+ '(INET_ATON('.$dbh->quote($low).'),'.'INET_ATON('.$dbh->quote($high).'),'.$dbh->quote($country).')';
+ if (scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+ $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
+ $dbh->do("UNLOCK TABLES");
+ $dbh->do("ALTER TABLE `newcountry` ENABLE KEYS");
+ close $COUNTRYTABLE;
+ print "\b\b\b\bdone.\n";
+}
+
+sub cleanup() {
+ my ($dbh) = @_;
+
+ $dbh->do("DROP TABLE IF EXISTS `oldcountry`");
+ print "Renaming new table...\n";
+ $dbh->{RaiseError} = 0;
+ $dbh->do("OPTIMIZE TABLE `newcountry`");
+ $dbh->do("ANALYZE TABLE `newcountry`");
+ # Doing the renames cannot be done atomically
+ # as sometimes `country` doesn't exist yet.
+ $dbh->do("RENAME TABLE `country` TO `oldcountry`");
+ $dbh->do("RENAME TABLE `newcountry` TO `country`");
+ $dbh->do("DROP TABLE `oldcountry`");
+}
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# SurrealChat.net does not provide the Country/Allocation data,
+# is in no way associated with maxmind.com,
+# nor are we providing a license to download/use it.
+# Be sure to direct availability/accuracy/licensing questions to maxmind.com
+
+use strict;
+use DBI;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => abs_path(dirname(abs_path($0)).'/..'),
+ );
+ require constant; import constant(\%constants);
+}
+chdir PREFIX;
+use lib PREFIX;
+
+use Date::Parse;
+
+use SrSv::Conf 'sql';
+
+use constant {
+ countrydb_url => 'http://www.maxmind.com/download/geoip/database/GeoIPCountryCSV.zip',
+ #countrydb_url => 'http://www.tabris.net/tmp/GeoIPCountryCSV.zip',
+ srcname => 'GeoIPCountryCSV.zip',
+ unpackname => 'GeoIPCountryWhois.csv',
+};
+
+main();
+exit 0;
+
+sub main() {
+ downloadData();
+ print "Connecting to database...\n";
+ my $dbh = dbConnect();
+ print "Creating new table...\n";
+ newTable($dbh);
+ print "Inserting data... ";
+ loadData($dbh);
+ cleanup($dbh);
+ $dbh->disconnect();
+ print "Country table update complete.\n";
+}
+
+sub downloadData() {
+ # This MAY be implementable with an open of a pipe
+ # pipe the output of wget through gzip -d
+ # and then into the load-loop.
+ # It's a bit heavy to run directly from inside services however.
+ # I'd recommend it be run as a crontab script separate from services.
+
+ my (@stats, $date, $size);
+ my $srcPath = PREFIX.'/data/'.srcname;
+ if(@stats = stat($srcPath)) {
+ print "Checking for updated country data...\n";
+ my $header = qx "wget --spider -S ".countrydb_url." 2>&1";
+ ($date) = ($header =~ /Last-Modified: (.*)/);
+ ($size) = ($header =~ /Content-Length: (.*)/);
+ }
+
+ if(@stats and $stats[7] == $size and $stats[9] >= str2time($date)) {
+ print "Country data is up to date.\n";
+ } else {
+ print "Downloading country data...\n";
+
+ unlink $srcPath;
+ system('wget '.countrydb_url." -O $srcPath");
+ unless(-e $srcPath) {
+ print STDERR "FATAL: Download failed.\n";
+ exit;
+ }
+ }
+
+ my $unpackPath = PREFIX.'/data/'.unpackname;
+ print "Decompressing...\n";
+ unlink $unpackPath;
+ system("unzip $srcPath -d ".PREFIX.'/data/');
+ unless(-f $unpackPath) {
+ print STDERR "FATAL: Decompression failed.\n";
+ exit;
+ }
+}
+
+sub dbConnect() {
+ my $dbh;
+ eval {
+ $dbh = DBI->connect("DBI:mysql:".sql_conf_mysql_db, sql_conf_mysql_user, sql_conf_mysql_pass,
+ { AutoCommit => 1, RaiseError => 1 })
+ };
+
+ if($@) {
+ print STDERR "FATAL: Can't connect to database:\n$@\n";
+ print STDERR "You must edit config/sql.conf and create a corresponding\nMySQL user and database!\n\n";
+ exit -1;
+ }
+ return $dbh;
+}
+
+sub newTable($) {
+ my ($dbh) = @_;
+ $dbh->{RaiseError} = 1;
+ $dbh->{PrintError} = 1;
+
+ $dbh->do("DROP TABLE IF EXISTS newcountry");
+ $dbh->do(
+ "CREATE TABLE `newcountry` (
+ `low` int unsigned NOT NULL default 0,
+ `high` int unsigned NOT NULL default 0,
+ `country` char(2) NOT NULL default '-',
+ PRIMARY KEY (`low`, `high`)
+ ) TYPE=MyISAM"
+ );
+}
+
+sub loadData($) {
+ my ($dbh) = @_;
+ $| = 1;
+ my $unpackPath = PREFIX.'/data/'.unpackname;
+ my ($lines) = qx{wc -l $unpackPath};
+ my $div = int($lines/100);
+ my ($i, @entries);
+
+ open ((my $COUNTRYTABLE), '<', $unpackPath);
+ my $add_entry = $dbh->prepare("INSERT INTO newcountry SET low=INET_ATON(?), high=INET_ATON(?), country=?");
+ $dbh->do("ALTER TABLE `newcountry` DISABLE KEYS");
+ $dbh->do("LOCK TABLES newcountry WRITE");
+ while(my $x = <$COUNTRYTABLE>) {
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+
+ chomp $x;
+ #"2.6.190.56","2.6.190.63","33996344","33996351","GB","United Kingdom"
+ #$x =~ /\"(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\"\,\"(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\"\,\"(\d+)\"\,\"(\d+)\"\,\"\w{2}\",\"(.+)\"/;
+ $x =~ s/\"//g;
+ my ($low, $high, undef, undef, $country, undef) = split(',', $x);
+ #$add_entry->execute($low, $high, $country);
+ push @entries,
+ '(INET_ATON('.$dbh->quote($low).'),'.'INET_ATON('.$dbh->quote($high).'),'.$dbh->quote($country).')';
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+ $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
+ $dbh->do("UNLOCK TABLES");
+ $dbh->do("ALTER TABLE `newcountry` ENABLE KEYS");
+ close $COUNTRYTABLE;
+}
+
+sub cleanup($) {
+ my ($dbh) = @_;
+
+ print "\b\b\b\bdone.\nRemoving old table...\n";
+ $dbh->do("DROP TABLE IF EXISTS `oldcountry`");
+ print "Renaming new table...\n";
+ $dbh->{RaiseError} = 0;
+ $dbh->do("OPTIMIZE TABLE `newcountry`");
+ $dbh->do("ANALYZE TABLE `newcountry`");
+ # Doing the renames cannot be done atomically
+ # as sometimes `country` doesn't exist yet.
+ $dbh->do("RENAME TABLE `country` TO `oldcountry`");
+ $dbh->do("RENAME TABLE `newcountry` TO `country`");
+ $dbh->do("DROP TABLE `oldcountry`");
+ unlink PREFIX.'/data/'.unpackname;
+}
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# SurrealChat.net does not provide the Country/Allocation data,
+# is in no way associated with maxmind.com,
+# nor are we providing a license to download/use it.
+# Be sure to direct availability/accuracy/licensing questions to maxmind.com
+
+use strict;
+use DBI;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => abs_path(dirname(abs_path($0)).'/..'),
+ );
+ require constant; import constant(\%constants);
+}
+chdir PREFIX;
+use lib PREFIX;
+
+use Date::Parse;
+
+use SrSv::Conf 'sql';
+
+use constant {
+ countrydb_url => 'rsync://countries-ns.mdc.dk/zone/zz.countries.nerd.dk.rbldnsd',
+ srcname => 'zz.countries.nerd.dk.rbldnsd',
+};
+
+main();
+exit 0;
+
+sub main() {
+
+ print "Synching country-data file...\n";
+ downloadData();
+ print "Connecting to database...\n";
+ my $dbh = dbConnect();
+ print "Creating new table...\n";
+ newTable($dbh);
+ print "Inserting data... ";
+ loadData($dbh);
+ print "Removing old table...\n";
+ cleanup($dbh);
+ $dbh->disconnect();
+ print "Country table update complete.\n";
+}
+
+sub downloadData() {
+ my $srcPath = PREFIX.'/data/'.srcname;
+ system('rsync -azvv --progress '.countrydb_url.' '.$srcPath);
+ unless(-e $srcPath) {
+ print STDERR "FATAL: Download failed.\n";
+ exit -1;
+ }
+}
+
+sub dbConnect() {
+
+ my $dbh;
+ eval {
+ $dbh = DBI->connect("DBI:mysql:"..sql_conf_mysql_db, sql_conf_mysql_user, sql_conf_mysql_pass,
+ { AutoCommit => 1, RaiseError => 1, PrintError => 1 })
+ };
+
+ if($@) {
+ print STDERR "FATAL: Can't connect to database:\n$@\n";
+ print STDERR "You must edit config/sql.conf and create a corresponding\nMySQL user and database!\n\n";
+ exit -1;
+ }
+ return $dbh;
+}
+
+
+sub newTable($) {
+ my ($dbh) = @_;
+
+ $dbh->do("DROP TABLE IF EXISTS newcountry");
+ $dbh->do(
+ "CREATE TABLE `newcountry` (
+ `low` int unsigned NOT NULL default 0,
+ `high` int unsigned NOT NULL default 0,
+ `country` char(2) NOT NULL default '-',
+ PRIMARY KEY (`low`, `high`)
+ ) TYPE=MyISAM"
+ );
+}
+
+sub loadData($) {
+ my ($dbh) = @_;
+ my $add_entry = $dbh->prepare("INSERT IGNORE INTO newcountry SET low=?, high=?, country=?");
+
+ $| = 1;
+ my $unpackPath = PREFIX.'/data/'.srcname;
+ my ($lines) = qx{wc -l $unpackPath};
+ my $div = int($lines/100);
+ my ($i, @entries);
+
+ open ((my $COUNTRYTABLE), '<', $unpackPath);
+ $dbh->do("ALTER TABLE `newcountry` DISABLE KEYS");
+ $dbh->do("LOCK TABLES newcountry WRITE");
+ while(my $x = <$COUNTRYTABLE>) {
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+
+ chomp $x;
+ #85.10.224.152/29 :127.0.0.20:ad
+ if ($x =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\/(\d{1,2}) \:(\S+)\:([a-z]{1,2})$/) {
+ my $low = $1 << 24 | $2 << 16 | $3 << 8 | $4;
+ my $high = $low + ((2 << (31 - $5)));
+ my $country = $7;
+ next if lc $country eq 'eu';
+ push @entries, '('.$dbh->quote($low).','.$dbh->quote($high).','.$dbh->quote($country).')';
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries));
+ @entries = ();
+ }
+ }
+
+ $i++;
+ }
+ $dbh->do("INSERT IGNORE INTO newcountry (low, high, country) VALUES ".join(',', @entries)) if scalar(@entries);
+
+ $dbh->do("UNLOCK TABLES");
+ $dbh->do("ALTER TABLE `newcountry` ENABLE KEYS");
+ close $COUNTRYTABLE;
+ print "\b\b\b\bdone.\n";
+}
+
+sub cleanup($) {
+ my ($dbh) = @_;
+
+ $dbh->do("DROP TABLE IF EXISTS `oldcountry`");
+ print "Renaming new table...\n";
+ $dbh->{RaiseError} = 0;
+ $dbh->do("OPTIMIZE TABLE `newcountry`");
+ $dbh->do("ANALYZE TABLE `newcountry`");
+ # Doing the renames cannot be done atomically
+ # as sometimes `country` doesn't exist yet.
+ $dbh->do("RENAME TABLE `country` TO `oldcountry`");
+ $dbh->do("RENAME TABLE `newcountry` TO `country`");
+ $dbh->do("DROP TABLE `oldcountry`");
+}
--- /dev/null
+#!/usr/bin/perl
+
+########################################################################
+# #
+# SurrealServices Database Dumper 0.2.3 #
+# #
+# This was written b/c the mysqldump program we had was broken. #
+# It will be made both stupid enough and generic enough that it may #
+# be used for other databases as well. #
+# #
+# (C) Copyleft tabris@surrealchat.net 2005, 2006 #
+# All rights reversed, All wrongs avenged. #
+# #
+########################################################################
+
+use strict;
+use DBI;
+
+# Add tables to this list to be skipped
+# SrSv wants to skip the country table
+our %skipList = ( 'country' => 1 );
+
+use constant {
+ DROP_TABLE => 1,
+# Default maximum packet size is 1MB
+# according to the documentation.
+ MAX_PACKET => (512*1024), # 512KiB
+
+ # Set to 1 if you have large tables, say over 32MB
+ # Reduces memory requirements, but will probably be slower.
+ # If set to zero, we fetch the entire table into memory
+ # then dump it.
+ # WARNING: Doing this with hundred megabyte tables
+ # will probably be slow, and possibly DoS your system
+ # with an Out of Memory condition.
+ LARGE_TABLES => 0,
+ # Most of the time, you don't want to preserve the contents
+ # of a MEMORY or HEAP table, since they're just temporary
+ # and would have been lost on a server restart anyway.
+ # Then again, maybe you want to keep them. If so, set this to 0.
+ # This does still save the schema.
+ SKIP_HEAP_DUMP => 1,
+
+ # This should only be used for debugging purposes
+ # as otherwise it throws junk into the output stream
+ VERBOSE => 0,
+};
+
+our $dbh;
+our $prefix;
+
+BEGIN {
+use Cwd qw( abs_path getcwd );
+use File::Basename;
+ $prefix = dirname(dirname(abs_path($0)).'../');
+ chdir $prefix;
+ import constant { PREFIX => $prefix, CWD => getcwd() };
+}
+
+# WARNING: for the generic case, this needs to be adapted
+# Either adapt the config file that you use,
+# or create a static hash table
+sub get_sql_conn {
+# These libs aren't needed for the generic case
+use SrSv::Conf2Consts qw( sql );
+
+ my %MySQL_config = (
+ 'mysql-db' => sql_conf_mysql_db,
+ 'mysql-user' => sql_conf_mysql_user,
+ 'mysql-pass' => sql_conf_mysql_pass
+ );
+
+ $dbh = DBI->connect(
+ "DBI:mysql:".$MySQL_config{'mysql-db'},
+ $MySQL_config{'mysql-user'},
+ $MySQL_config{'mysql-pass'},
+ {
+ AutoCommit => 1,
+ RaiseError => 1
+ }
+ );
+}
+
+sub get_schema($) {
+ my ($table) = @_;
+ my ($l, $column_data);
+ my $get_table = $dbh->prepare("SHOW CREATE TABLE `$table`");
+ $get_table->execute();
+ my $result = $get_table->fetchrow_array;
+ $get_table->finish();
+
+ $l .= "\n--\n-- Table structure for table `$table`\n--\n".
+ "$result;\n";
+ my $get_column_info = $dbh->column_info(undef, undef, $table, '%');
+ $get_column_info->execute();
+ print "\n";
+ while(my $column_info = $get_column_info->fetchrow_hashref()) {
+ print '#'. $table.'.'.$column_info->{COLUMN_NAME} .'(column #'.$column_info->{ORDINAL_POSITION}.')' . ' is type '.$column_info->{TYPE_NAME}."\n" if VERBOSE;
+ $column_data->[$column_info->{ORDINAL_POSITION}] = $column_info;
+ }
+
+ return ($l, $column_data);
+}
+
+sub prepare_output($$) {
+ my ($table, $data) = @_;
+ return "INSERT INTO `$table` VALUES ".$data.";\n";
+}
+
+sub get_data($$) {
+ my ($table, $column_data) = @_;
+ my @lines = ();
+
+ # This is typically faster than a select loop
+ # However, with REALLY BIG tables, it may become a DoS
+ # Due to selecting too much data at once.
+ my $results = $dbh->selectall_arrayref('SELECT * FROM '."`$table`");
+ my $data = '';
+ foreach my $row (@$results) {
+ my $i = 0;
+ foreach my $element (@$row) {
+ if ($column_data->[++$i]->{TYPE_NAME} =~ /^(TEXT|BLOB)$/i and
+ length($element))
+ {
+ $element = '0x' . unpack ('H*', $element);
+ }
+ elsif ($column_data->[$i]->{TYPE_NAME} =~ /int$/i and
+ length($element))
+ {
+ # do nothing
+ } else {
+ $element = $dbh->quote($element);
+ }
+ }
+ my $l = '('.join(',', @$row).')';
+ if ((length($data) + length($l)) > MAX_PACKET) {
+ push @lines, prepare_output($table, $data);
+ $data = $l;
+ } else {
+ if(length($data)) {
+ $data .= ",$l";
+ } else {
+ $data = $l;
+ }
+ }
+ }
+
+ push @lines, prepare_output($table, $data) if length($data);
+ return @lines;
+}
+
+sub get_data_large($$) {
+ my ($table, $column_data) = @_;
+
+ my $data = '';
+ my $query = $dbh->prepare('SELECT * FROM '."`$table`");
+ $query->execute();
+ while (my @row = $query->fetchrow_array) {
+ my $i = 0;
+ foreach my $element (@row) {
+ if ($column_data->[++$i]->{TYPE_NAME} =~ /^(TEXT|BLOB)$/i and
+ length($element))
+ {
+ $element = unpack ('H', $element);
+ }
+ elsif ($column_data->[$i]->{TYPE_NAME} =~ /int$/i and
+ length($element))
+ {
+ # do nothing
+ } else {
+ $element = $dbh->quote($element);
+ }
+ }
+ my $l = '('.join(',', @row).')';
+ if ((length($data) + length($l)) > MAX_PACKET) {
+ print prepare_output($table, $data);
+ $data = $l;
+ } else {
+ if(length($data)) {
+ $data .= ",$l";
+ } else {
+ $data = $l;
+ }
+ }
+ }
+
+ print prepare_output($table, $data) if length($data);
+}
+
+sub do_dump() {
+ my $tables = $dbh->selectcol_arrayref("SHOW TABLES");
+
+ TABLE: foreach my $table (@$tables) {
+ print "DROP TABLE IF EXISTS `$table`;" if DROP_TABLE;
+ my $column_data;
+
+ {
+ my $schema;
+ ($schema, $column_data) = get_schema($table);
+ print $schema."\n";
+ if ((SKIP_HEAP_DUMP) and
+ (($schema =~ /(ENGINE|TYPE)=(HEAP|MEMORY)/)) or ($skipList{lc $table})
+ ) {
+ next TABLE;
+ }
+ }
+
+ print "--\n-- Dumping data for table '$table'\n--\n".
+ "LOCK TABLES `$table` WRITE;\n".
+ "/*!40000 ALTER TABLE `$table` DISABLE KEYS */;\n";
+ if(LARGE_TABLES) {
+ get_data_large($table, $column_data);
+ } else {
+ print join("\n", get_data($table, $column_data));
+ }
+ print "/*!40000 ALTER TABLE `$table` ENABLE KEYS */;\n".
+ "UNLOCK TABLES;\n".
+ "\n";
+ }
+}
+
+get_sql_conn();
+do_dump();
+exit 0;
--- /dev/null
+#!/usr/bin/perl
+
+# This file is part of SurrealServices.
+#
+# SurrealServices is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# SurrealServices is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with SurrealServices; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# SurrealChat.net does not provide the Country/Allocation data,
+# is in no way associated with maxmind.com,
+# nor are we providing a license to download/use it.
+# Be sure to direct availability/accuracy/licensing questions to maxmind.com
+
+use strict;
+#use warnings;
+use DBI;
+
+BEGIN {
+ use Cwd qw( abs_path getcwd );
+ use File::Basename;
+ my %constants = (
+ CWD => getcwd(),
+ PREFIX => abs_path(dirname(abs_path($0)).'/..'),
+ );
+ require constant; import constant(\%constants);
+}
+#chdir PREFIX;
+use lib PREFIX;
+
+use Date::Parse;
+use Text::ParseWords; # is a standard (in 5.8) module
+
+use SrSv::Conf2Consts qw( sql );
+use SrSv::Util qw( :say );
+
+sub runSQL($@) {
+ my ($dbh, @strings) = @_;
+ foreach my $string (@strings) {
+ my $sql;
+ foreach my $x (split($/, $string)) { $sql .= $x unless $x =~ /^(#|--)/ or $x eq "\n"}
+# $dbh->do("START TRANSACTION");
+ my $printError = $dbh->{PrintError};
+ $dbh->{PrintError} = 0;
+ foreach my $line (split(/;/s, $sql)) {
+ next unless length($line);
+ #print "$line\n";
+ eval { $dbh->do($line); };
+ if($@) {
+ $line =~ s/\s{2,}/ /g;
+ $line =~ s/\n//g;
+ print "$line\n";
+ }
+
+ }
+ $dbh->{PrintError} = $printError;
+# $dbh->do("COMMIT");
+ }
+}
+
+BEGIN {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime();
+ $year += 1900;
+ $mon++; # gmtime returns months January=0
+ my $date = sprintf("%04d%02d01", $year, $mon);
+ require constant;
+ import constant {
+ #countrydb_url => 'http://www.maxmind.com/download/geoip/database/GeoIPCountryCSV.zip',
+ #FIXME: This needs a date generator!
+ countrydb_url => "http://www.maxmind.com/download/geoip/database/GeoLiteCity_CSV/GeoLiteCity_${date}.zip",
+ srcname => "GeoLiteCity_${date}.zip",
+ };
+}
+
+sub main() {
+ downloadData();
+ say "Connecting to database...";
+ my $dbh = dbConnect();
+ say "Creating new table...";
+ newTable($dbh);
+ say "Inserting data... ";
+ loadData($dbh);
+ say "Converting geoip table (several minutes, tight loop in mysqld)... ";
+ convert($dbh);
+ cleanup($dbh);
+ $dbh->disconnect();
+ say "GeoIP update complete.";
+}
+
+main();
+exit 0;
+
+sub downloadData() {
+ # This MAY be implementable with an open of a pipe
+ # pipe the output of wget through gzip -d
+ # and then into the load-loop.
+ # It's a bit heavy to run directly from inside services however.
+ # I'd recommend it be run as a crontab script separate from services.
+
+ #return;
+ my ($stat, $date, $size);
+ my $srcPath = PREFIX.'/data/'.srcname;
+ say $srcPath;
+ use File::stat;
+ if($stat = stat($srcPath)) {
+ print "Checking for updated country data...\n";
+ my $header = qx "wget --spider -S @{[countrydb_url]} 2>&1";
+ ($date) = ($header =~ /Last-Modified: (.*)/);
+ ($size) = ($header =~ /Content-Length: (.*)/);
+ }
+
+ if($stat and $stat->size == $size and $stat->mtime >= str2time($date)) {
+ say "Country data is up to date.";
+ } else {
+# say $stat->size == $size;
+# say $stat->mtime >= str2time($date);
+ say "Downloading country data...";
+# return;
+
+ unlink $srcPath;
+ system('wget '.countrydb_url." -O $srcPath");
+ unless(-e $srcPath) {
+ sayERR "FATAL: Download failed.";
+ exit;
+ }
+ }
+
+ mkdir PREFIX.'/data/GeoIP/';
+ say "Decompressing...";
+ unlink(glob(PREFIX.'/data/GeoIP/Geo*.csv'));
+ system("unzip -j $srcPath -d ".PREFIX.'/data/GeoIP/');
+ unless(-f PREFIX.'/data/GeoIP/GeoLiteCity-Blocks.csv') {
+ sayERR "FATAL: Decompression failed.";
+ exit -1;
+ }
+}
+
+sub dbConnect() {
+ my $dbh;
+ eval {
+ $dbh = DBI->connect("DBI:mysql:".sql_conf_mysql_db, sql_conf_mysql_user, sql_conf_mysql_pass,
+ { AutoCommit => 1, RaiseError => 1 })
+ };
+
+ if($@) {
+ print STDERR "FATAL: Can't connect to database:\n$@\n";
+ print STDERR "You must edit config/sql.conf and create a corresponding\nMySQL user and database!\n\n";
+ exit -1;
+ }
+ return $dbh;
+}
+
+sub newTable($) {
+ my ($dbh) = @_;
+ $dbh->{RaiseError} = 1;
+ $dbh->{PrintError} = 1;
+
+ runSQL($dbh,
+ "DROP TABLE IF EXISTS new_geoip",
+ "CREATE TABLE `new_geoip` (
+ `low` int unsigned NOT NULL default 0,
+ `high` int unsigned NOT NULL default 0,
+ `location` int NOT NULL default '0',
+ PRIMARY KEY (`low`, `high`)
+ ) TYPE=MyISAM",
+
+ "DROP TABLE IF EXISTS new_geolocation",
+ #"locId,country,region,city,postalCode,latitude,longitude,metroCode,areaCode";
+ "CREATE TABLE `new_geolocation` (
+ `id` int unsigned NOT NULL default 0,
+ `country` char(2) NOT NULL default '-',
+ `region` char(2) NOT NULL default '-',
+ `city` varchar(255) NOT NULL default '-',
+ `postalcode` varchar(6) NOT NULL default '-',
+ `latitude` float NOT NULL default 0.0,
+ `longitude` float NOT NULL default 0.0,
+ `metrocode` int unsigned NOT NULL default 0,
+ `areacode` int unsigned NOT NULL default 0,
+ PRIMARY KEY (`id`),
+ KEY `countrykey` (`country`)
+ ) TYPE=MyISAM;",
+
+ "DROP TABLE IF EXISTS `new_metrocode`",
+ "CREATE TABLE `new_metrocode` (
+ `id` smallint NOT NULL default 0,
+ `metro` varchar(128) NOT NULL default '',
+ PRIMARY KEY (`id`)
+ ) TYPE=MyISAM;",
+
+ "DROP TABLE IF EXISTS `new_geocountry`",
+ #"locId,country,region,city,postalCode,latitude,longitude,metroCode,areaCode";
+ "CREATE TABLE `new_geocountry` (
+ `code` char(2) NOT NULL default '',
+ `country` varchar(255) default '',
+ PRIMARY KEY (`code`)
+ ) TYPE=MyISAM;",
+
+ "DROP TABLE IF EXISTS `new_georegion`",
+ #"locId,country,region,city,postalCode,latitude,longitude,metroCode,areaCode";
+ "CREATE TABLE `new_georegion` (
+ `country` char(2) NOT NULL default '',
+ `region` char(2) NOT NULL default '',
+ `name` varchar(255) default '',
+ PRIMARY KEY (`country`, `region`)
+ ) TYPE=MyISAM;",
+
+ );
+}
+
+sub loadData($) {
+ my ($dbh) = @_;
+ $| = 1;
+=cut
+ my $unpackPath = PREFIX.'/data/'.unpackname;
+ my ($lines) = qx{wc -l $unpackPath};
+ my $div = int($lines/100);
+=cut
+ my ($i, @entries);
+ my $fh;
+ my $table;
+
+ print "Loading geoip data (takes several minutes, ~3million rows)...";
+####### geoip #######
+ open ($fh, '<', PREFIX.'/data/GeoIP/GeoLiteCity-Blocks.csv');
+ $table = 'geoip';
+ #my $add_entry = $dbh->prepare("INSERT INTO `new_geoip` (low, high, location) VALUES (?,?,?)");
+ runSQL($dbh,
+# "LOCK TABLES `new_geoip` WRITE, `new_geolocation` WRITE,
+# `new_metrocode` WRITE, `new_georegion` WRITE, `new_geocountry` WRITE",
+ "ALTER TABLE `new_$table` DISABLE KEYS",
+ );
+
+ my $columns = '(low, high, location)';
+ <$fh>; <$fh>; # pop first 2 lines off.
+ while(my $x = <$fh>) {
+ chomp $x;
+=cut
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+=cut
+ my $argCount = scalar split(',', $x);
+ push @entries, "($x)" if $argCount == 3;
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+ $dbh->do(("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries))) if scalar(@entries);
+ $dbh->do("ALTER TABLE `new_$table` ENABLE KEYS");
+ @entries = ();
+ close $fh;
+####### END geoip #######
+ say " Done.";
+
+ print "Loading location data (takes ~1 minute, ~250k rows)...";
+####### locations #######
+ $table = 'geolocation';
+ $columns = "(`id`, `country`, `region`, `city`, `postalcode`, `latitude`, `longitude`, `metrocode`, `areacode`)";
+ open ($fh, '<', PREFIX.'/data/GeoIP/GeoLiteCity-Location.csv');
+
+ $dbh->do("ALTER TABLE `new_$table` DISABLE KEYS");
+
+ <$fh>; <$fh>; # pop first 2 lines off.
+ while(my $x = <$fh>) {
+ chomp $x;
+=cut
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+=cut
+ my @args = map( { $dbh->quote($_) } parse_line(",\\s*", 0, $x) );
+ push @entries, '(' . join(',', @args) . ')' if scalar(@args) == 9;
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+ $dbh->do(("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries))) if scalar(@entries);
+ @entries = ();
+ $dbh->do("ALTER TABLE `new_$table` ENABLE KEYS");
+ close $fh;
+####### END locations #######
+ say " Done.";
+
+
+ print "Loading metrocode data...";
+####### metrocodes #######
+ open ($fh, '<', PREFIX.'/data/GeoIP/metrocodes.txt');
+ $table = 'metrocode';
+ $columns = "(`id`, `metro`)";
+
+ $dbh->do("ALTER TABLE `new_$table` DISABLE KEYS");
+
+ while(my $x = <$fh>) {
+ chomp $x;
+=cut
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+=cut
+ my @args = map( { $dbh->quote($_) } split(' ', $x, 2) );
+ push @entries, '(' . join(',', @args) . ')' if scalar(@args) == 2;
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+ $dbh->do(("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries))) if scalar(@entries);
+ @entries = ();
+ $dbh->do("ALTER TABLE `new_$table` ENABLE KEYS");
+ close $fh;
+####### END metrocodes #######
+ say " Done.";
+
+ print "Loading region data...";
+####### regions #######
+ $table = 'georegion';
+ $columns = "(`country`, `region`, `name`)";
+
+ $dbh->do("ALTER TABLE `new_$table` DISABLE KEYS");
+ open ($fh, '<', PREFIX.'/data/fips10_4');
+ <$fh>; # pop first line off.
+ while(my $x = <$fh>) {
+ chomp $x;
+=cut
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+=cut
+ my @args = map( { $dbh->quote($_) } parse_line(",\\s*", 0, $x) );
+ push @entries, '(' . join(',', @args) . ')' if scalar(@args) == 3;
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+ close $fh;
+
+ open ($fh, '<', PREFIX.'/data/iso3166_2');
+ <$fh>; # pop first line off.
+ while(my $x = <$fh>) {
+ chomp $x;
+=cut
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+=cut
+ my @args = map( { $dbh->quote($_) } parse_line(",\\s*", 0, $x) );
+ push @entries, '(' . join(',', @args) . ')' if scalar(@args) == 3;
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+ close $fh;
+ $dbh->do(("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries))) if scalar(@entries);
+ @entries = ();
+ $dbh->do("ALTER TABLE `new_$table` ENABLE KEYS");
+####### END regions #######
+ say " Done.";
+
+ print "Loading country data...";
+####### iso3166 Country Names #######
+ open ($fh, '<', PREFIX.'/data/iso3166');
+ $table = 'geocountry';
+ $columns = "(`code`, `country`)";
+
+ $dbh->do("ALTER TABLE `new_$table` DISABLE KEYS");
+
+ while(my $x = <$fh>) {
+ chomp $x;
+=cut
+ if($i == 0 or !($i % $div)) {
+ printf("\b\b\b\b%3d%", ($i/$lines)*100);
+ }
+=cut
+ my @args = map( { $dbh->quote($_) } parse_line(",\\s*", 0, $x) );
+ push @entries, '(' . join(',', @args) . ')' if scalar(@args) == 2;
+ if(scalar(@entries) >= 100) { #1000 only gives another 10% boost for 10x as much memory
+ $dbh->do("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries));
+ @entries = ();
+ }
+
+ $i++;
+ }
+ $dbh->do(("INSERT DELAYED INTO `new_$table` $columns VALUES ".join(',', @entries))) if scalar(@entries);
+ @entries = ();
+ $dbh->do("ALTER TABLE `new_$table` ENABLE KEYS");
+ close $fh;
+####### END iso3166 Country Names #######
+ say " Done.";
+
+
+# $dbh->do("UNLOCK TABLES");
+}
+
+sub convert($) {
+ my ($dbh) = @_;
+
+ runSQL($dbh,
+ "DROP TABLE IF EXISTS `tmp_geoip`",
+ "RENAME TABLE `new_geoip` TO `tmp_geoip`",
+ "CREATE TABLE `new_geoip` (
+ `low` int unsigned NOT NULL default 0,
+ `high` int unsigned NOT NULL default 0,
+ `location` int NOT NULL default '0',
+ `ip_poly` polygon not null,
+ PRIMARY KEY (`low`, `high`),
+ SPATIAL INDEX (`ip_poly`)
+ ) TYPE=MyISAM",
+ "ALTER TABLE `new_geoip` DISABLE KEYS",
+ "INSERT DELAYED INTO new_geoip (low,high,location,ip_poly)
+ SELECT low, high, location,
+ GEOMFROMWKB(POLYGON(LINESTRING( POINT(low, -1), POINT(high, -1),
+ POINT(high, 1), POINT(low, 1), POINT(low, -1)))) FROM tmp_geoip;",
+ "ALTER TABLE `new_geoip` ENABLE KEYS",
+ "DROP TABLE IF EXISTS `tmp_geoip`",
+ );
+}
+
+sub cleanup($) {
+ my ($dbh) = @_;
+
+# print "\b\b\b\bdone.\nRemoving old table...\n";
+ $dbh->do("DROP TABLE IF EXISTS `oldcountry`");
+ say "Renaming new tables...";
+ $dbh->{RaiseError} = 0;
+ $dbh->{PrintError} = 0;
+ $dbh->do("OPTIMIZE TABLE `new_geoip`");
+ $dbh->do("ANALYZE TABLE `new_geoip`");
+ # Doing the renames cannot be done atomically
+ # as sometimes `country` doesn't exist yet.
+ $dbh->do("START TRANSACTION");
+ $dbh->do("RENAME TABLE `geoip` TO `old_geoip`");
+ $dbh->do("RENAME TABLE `new_geoip` TO `geoip`");
+
+ $dbh->do("RENAME TABLE `geolocation` TO `old_geolocation`");
+ $dbh->do("RENAME TABLE `new_geolocation` TO `geolocation`");
+
+ $dbh->do("RENAME TABLE `metrocode` TO `old_metrocode`");
+ $dbh->do("RENAME TABLE `new_metrocode` TO `metrocode`");
+
+ $dbh->do("RENAME TABLE `georegion` TO `old_georegion`");
+ $dbh->do("RENAME TABLE `new_georegion` TO `georegion`");
+
+ $dbh->do("RENAME TABLE `geocountry` TO `old_geocountry`");
+ $dbh->do("RENAME TABLE `new_geocountry` TO `geocountry`");
+
+ $dbh->do("DROP TABLE `old_geoip`");
+ $dbh->do("DROP TABLE `old_geolocation`");
+ $dbh->do("DROP TABLE `old_metrocode`");
+ $dbh->do("DROP TABLE `old_georegion`");
+ $dbh->do("DROP TABLE `old_geocountry`");
+ $dbh->do("COMMIT");
+ #unlink PREFIX.'/data/'.unpackname;
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+
+use Event 'loop';
+use IO::Handle;
+use IO::Socket::INET;
+use Errno ':POSIX';
+
+sign_on_clients(200);
+
+our @chans;
+for(ord 'a' .. ord 'z') {
+ push @chans, '#' . chr($_) x 3;
+}
+
+our @clients;
+
+sub create_line_splitter($$) {
+ my ($sock, $cb) = @_;
+ my $part;
+
+ return sub {
+ my $event = shift;
+ my ($r, $in);
+ while($r = $sock->sysread($in, 4096) > 0) {
+ my @lines = split(/\r?\n/s, $in, -1);
+
+ $lines[0] = $part . $lines[0];
+ $part = pop @lines;
+
+ $cb->($_) foreach (@lines);
+ }
+
+ if($r <= 0 and not $!{EAGAIN}) {
+ $event->w->cancel;
+ $sock->close;
+ }
+ }
+}
+
+sub send_lines($@) {
+ my $sock = shift;
+ print "<< ", join("\n", @_), "\n";
+ $sock->syswrite(join("\r\n", @_) . "\r\n");
+}
+
+sub junk($) {
+ my $maxlen = shift;
+ my $len = int(rand($maxlen/2) + $maxlen/2);
+
+ my $out;
+ while(--$len > 0) {
+ $out .= chr(rand((ord 'z') - (ord 'a')) + ord 'a');
+ }
+
+ return $out;
+}
+
+sub irc_connect($) {
+ my $sock = IO::Socket::INET->new (
+ PeerAddr => $_[0],
+ Type => SOCK_STREAM,
+ Blocking => 0,
+ );
+
+ send_lines($sock,
+ "NICK " . junk(9),
+ "USER " . (junk(9) . ' ') x 3 . " :". junk(50),
+ );
+
+ push @clients, $sock;
+
+ my $process_line = sub {
+ my $line = shift;
+ print ">> ", $line, "\n";
+
+ if($line =~ /^PING :(.*)/) {
+ send_lines($sock, "PONG :$1");
+ }
+ elsif($line =~ /\S+ 422/) {
+ foreach (@chans) {
+ send_lines($sock, "JOIN " . $_);
+ }
+ }
+ };
+
+ Event->io (
+ fd => $sock,
+ cb => create_line_splitter($sock, $process_line),
+ );
+}
+
+sub sign_on_clients($) {
+ my $num = shift;
+ Event->timer (
+ interval => 1,
+ cb => sub {
+ my $i = $num;
+ return sub {
+ $_[0]->w->cancel if(--$i < 0);
+ irc_connect('localhost:6667');
+ }
+ }->(),
+ );
+}
+
+our $stdin = new IO::Handle;
+$stdin->fdopen(fileno(STDIN), "r");
+
+Event->io (
+ fd => $stdin,
+ cb => create_line_splitter($stdin, sub {
+ print eval $_[0], "\n";
+ print $@ if $@;
+ }),
+);
+
+loop();
projects / irc / SurrealServices / srsv.git / commitdiff
