102 Commits
Author SHA1 Message Date
Elijah Perrault 11ea707bbe Updated. 2011-03-06 19:45:41 -07:00
Elijah Perrault 506921214d Updated for alpha7. 2011-03-06 19:40:20 -07:00
Elijah Perrault 9de77699f9 Fixed a bug in UNO where rehashing during a game caused a crash. 2011-03-05 16:39:49 -07:00
Matthew Barksdale f0807a8306 And sasl_timeout, else we're going to get an error 2011-03-05 15:54:02 -05:00
Matthew Barksdale 3ce0003c9e We should really check for password too here... 2011-03-05 15:52:11 -05:00
Matthew Barksdale 51d8bb69dd Fixed some spacing issues 2011-03-05 15:03:42 -05:00
Matthew Barksdale c3ac079e14 Fixed the POD for EightBall to follow the new CoC 2011-03-05 14:51:00 -05:00
Matthew Barksdale ad3340d82a Wth? 2011-03-05 14:46:54 -05:00
Matthew Barksdale 978a1585c8 Fix the POD for HelloChan to follow the new CoC 2011-03-05 14:45:43 -05:00
Matthew Barksdale 4337f29d0a Added a subroutine to access the OPER command, I'm eventually going to build upon this to be a full API for oper commands 2011-03-05 14:40:39 -05:00
Matthew Barksdale a587bab1c9 uhm... what? 2011-03-05 00:10:08 -05:00
Matthew Barksdale 1b13f4c39b Fixed the Oper module to actually work correctly when it's really not opered. 2011-03-05 00:09:27 -05:00
Elijah Perrault e61fdee14c Proto::IRC::umodes renamed to Proto::IRC::botinfo{svr}{modes}. 2011-03-04 21:54:12 -07:00
Elijah Perrault 9b0e692a8f Fixed a bug where incoming PART's from ourselves were not parsed. 2011-03-04 21:48:21 -07:00
Elijah Perrault 70723dfe68 Add a =cut. 2011-03-04 21:13:13 -07:00
Elijah Perrault 10fbddd2a6 Our usermodes are now tracked in Proto::IRC::umodes. 2011-03-04 20:45:31 -07:00
Elijah Perrault 963f55cc01 Added events on_cmode and on_umode. 2011-03-04 20:34:04 -07:00
Elijah Perrault 123357c448 Added event on_myinfo for RPL_MYINFO (numeric 004). 2011-03-04 20:14:09 -07:00
Matthew Barksdale 0b6ed4c0cc Fixed a few bugs 2011-03-04 21:28:32 -05:00
Matthew Barksdale 004c89f416 Added a module allowing you to oper up your bot, this will eventually be expanded upon. In addition, this allows you to call M::Oper::is_opered(server) to check if your Auto instance is an oper on the specified server. 2011-03-04 21:24:29 -05:00
Elijah Perrault d4ff35a5f9 Raw hooks now take hook names and support multiple hooks. This changes rchook_add and rchook_del. 2011-03-04 19:14:18 -07:00
Elijah Perrault f4448302e2 Vim modelines must be at the bottom of files. Modules updated. 2011-03-04 15:49:43 -07:00
Elijah Perrault 348ee6dc79 Forgot the quotes. 2011-03-03 18:54:51 -07:00
Elijah Perrault 604097ee1c Eh, might as well add xsm, to shut Perl::Critic up. 2011-03-03 15:58:49 -07:00
Elijah Perrault 3a7ffb24ee Fixed some Perl::Critic violations. 2011-03-03 15:55:55 -07:00
Elijah Perrault 60edbba15d Rest of renaming. 2011-03-03 15:38:58 -07:00
Elijah Perrault 12ed97b398 Renamed Lib::Users to Core::IRC::Users. 2011-03-03 15:38:11 -07:00
Elijah Perrault bd6571bbf5 Added Lib::User, for network-wide user tracking. This brings many new possibilities to modules, including an account system. 2011-03-03 15:34:41 -07:00
Elijah Perrault c15c945262 Added hook on_namesreply. 2011-03-03 15:19:15 -07:00
Elijah Perrault 5f1bf3785c Parse -nuc as well. 2011-03-02 22:17:18 -07:00
Elijah Perrault 45bb7e668c Fixed a bug where a CAP entry for a network was not recreated on a reconnect. 2011-03-02 22:05:13 -07:00
Elijah Perrault c268f27308 Include this as well. 2011-03-02 22:02:46 -07:00
Elijah Perrault 62551dc6c9 Added hook on_disconnect. 2011-03-02 22:02:24 -07:00
Elijah Perrault 12356984fc Don't surpass 80 characters. 2011-03-02 21:39:48 -07:00
Elijah Perrault 223cdd7860 Updated. 2011-03-02 20:28:30 -07:00
Elijah Perrault 9e8018c98e Added various options to bin/auto, including support for multiple config files. See bin/auto -h for details. 2011-03-02 20:26:34 -07:00
Elijah Perrault 0e708c5ee3 Lots of cleanup. 2011-03-02 19:08:00 -07:00
Elijah Perrault a66d6993cd Matthew failed. 2011-03-02 15:46:13 -07:00
Matthew Barksdale 328eac87b0 Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-03-02 17:39:58 -05:00
Matthew Barksdale 0e46850a65 Changed on_nick, on_quit, on_part, and on_kick source hashrefs to include server, removing svr. 2011-03-02 17:37:27 -05:00
Elijah Perrault 5da0eb0f6e Fixed all modules. 2011-03-02 15:05:46 -07:00
Elijah Perrault 8c037a9a35 Bumped minimum API version to 3.0.0a7. 2011-03-02 15:04:42 -07:00
Elijah Perrault 4e0384d645 Added UNO to this list. 2011-03-01 22:08:58 -07:00
Elijah Perrault 117ef08c23 Forgot to commit this... 2011-02-28 20:26:46 -07:00
Elijah Perrault e67b4b265c This undef is no longer needed. 2011-02-28 20:24:40 -07:00
Elijah Perrault 4dbfac1f5e We're alpha7. 2011-02-28 20:22:29 -07:00
Elijah Perrault 956cd12e5b Fixed the arguments on_whoreply passes. 2011-02-28 20:21:28 -07:00
Elijah Perrault af92eed006 Updated. 2011-02-27 21:40:59 -07:00
Elijah Perrault f904d3e991 Updated for alpha6 release. 2011-02-27 21:38:00 -07:00
Elijah Perrault f51e695a2a My last commit also included a bugfix regarding SASL timeout. 2011-02-27 21:36:06 -07:00
Elijah Perrault e65f5d6f0a Cleanup, CAP is now core and added hook on_capack. 2011-02-27 21:33:47 -07:00
Elijah Perrault b48e77a4b3 Trigger on_shutdown in the event of a fatal error. 2011-02-27 20:26:37 -07:00
Elijah Perrault bfa0baf51e Cleaned up socket creation heavily. 2011-02-27 20:23:56 -07:00
Elijah Perrault c5f8a31bd0 Fixed a bug with multi-prefix support. 2011-02-27 16:55:06 -07:00
Elijah Perrault 66cc08fd87 Use fpfmt here. 2011-02-27 16:18:38 -07:00
Elijah Perrault b0fc9065f5 Added fpfmt() to API::Std, and removed the %20's from Bin. 2011-02-27 16:17:40 -07:00
Elijah Perrault ec363be888 Replace spaces in the file path with %20. 2011-02-27 12:52:06 -07:00
Elijah Perrault eda22e02db Use quotes to satisfy Windows. 2011-02-27 12:50:27 -07:00
Elijah Perrault 8d5664c7ef Added an extra note. 2011-02-27 12:49:47 -07:00
Elijah Perrault 7e8ba692f7 Add a check for Solaris. 2011-02-26 23:49:57 -07:00
Elijah Perrault 3e418271c7 Some notes for when running on Windows. 2011-02-26 23:32:45 -07:00
Elijah Perrault c3b3c56322 Windows is now supported. 2011-02-26 23:16:32 -07:00
Elijah Perrault f7b5428c60 Auto::GR renamed to $Auto::VERGITREV. 2011-02-26 23:11:37 -07:00
Elijah Perrault ef75910c0e Invoke perl from command line instead. 2011-02-26 21:11:33 -07:00
Elijah Perrault 6d0efb08f7 Cleanup. 2011-02-26 21:07:43 -07:00
Elijah Perrault 3ca1685044 Needs more exit. 2011-02-26 20:09:40 -07:00
Elijah Perrault aa1302c1bb Cleaning up. 2011-02-26 20:08:15 -07:00
Elijah Perrault 14334122bc Cleaning up. 2011-02-26 19:54:50 -07:00
Elijah Perrault c88c8f66f3 Whoops. 2011-02-26 17:21:09 -07:00
Elijah Perrault 0ba0d8e030 A list of abbreviated with full name licenses, for future reference. 2011-02-26 17:02:09 -07:00
Elijah Perrault db3f388006 Fixed a few warnings. 2011-02-26 14:49:53 -07:00
Elijah Perrault 5b8568f811 Bumped minimum version for API to 3.0.0a6. 2011-02-26 14:36:43 -07:00
Elijah Perrault d33d47afd2 Cleaned up TOPIC parsing. 2011-02-26 14:27:57 -07:00
Elijah Perrault 5c517b8093 This has been removed. 2011-02-26 14:09:40 -07:00
Elijah Perrault 58063f147d New hook on_isupport, code cleanup, and now parsing numeric 004 (RPL_MYINFO). 2011-02-26 14:08:39 -07:00
Elijah Perrault 8f5da92a45 Updated list. 2011-02-25 23:16:30 -07:00
Elijah Perrault 88e8930aff Fixed a bug in TOP10. 2011-02-25 22:21:51 -07:00
Elijah Perrault 2e7ab78f7e Removed a comma. 2011-02-25 21:29:20 -07:00
Elijah Perrault a8b8256385 Added a BotStats module for returning statistics about the bot. 2011-02-25 21:26:40 -07:00
Elijah Perrault 501dd30a0b Now parsing numeric 396. 2011-02-25 20:48:45 -07:00
Elijah Perrault 8512ea129a * Added who() to API::IRC.
* Added hook on_whoreply.
* PRIVMSGs and NOTICEs that would cause a >512 bytes resulting message are now divided into multiple messages.
* Renamed botnick to botinfo.
2011-02-25 20:14:19 -07:00
Elijah Perrault 9c8200fb78 Updated. 2011-02-25 18:23:51 -07:00
Elijah Perrault d5378cca9f Continue renaming. 2011-02-25 18:22:13 -07:00
Elijah Perrault 06aaf41ef0 Continue renaming process. 2011-02-25 18:19:58 -07:00
Elijah Perrault 402dfade65 Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-02-25 18:16:22 -07:00
Elijah Perrault 217fdbd1e7 We're renaming Parser::IRC to Proto::IRC. 2011-02-25 18:15:57 -07:00
Elijah Perrault a895a77418 Sigh. Now, fix it. 2011-02-25 13:06:26 -07:00
Elijah Perrault 91185e5ec3 Now, fix it. 2011-02-25 13:06:16 -07:00
Elijah Perrault 989d52b7f7 Set et to true in modelines. 2011-02-25 13:02:59 -07:00
Elijah Perrault b25ec915b9 Can now be used in a channel and, now returns any errors that occur. 2011-02-23 15:02:17 -07:00
Elijah Perrault 064f1099e3 Added an Eval module for evaluating Perl code. 2011-02-23 14:43:19 -07:00
Elijah Perrault b7d6da07b0 Accept alpha6 modules. 2011-02-23 14:27:29 -07:00
Elijah Perrault f481f9d4e7 Whoops, this was for 3.0.0a6, not 3.0.0a5. 2011-02-23 14:25:24 -07:00
Elijah Perrault fdb4093ad6 Added 'any' option for uno:edition (see POD:INSTALL) and made edition update on rehash. 2011-02-23 11:55:11 -07:00
Elijah Perrault 0bbcdd7f4b Fix formatting. 2011-02-23 11:34:21 -07:00
Elijah Perrault 71056bc2ed Fixed a bug with wildcards and made red|green|blue|yellow valid colors. 2011-02-22 22:30:01 -07:00
Elijah Perrault 88cdde59ce Updated. 2011-02-22 22:16:46 -07:00
Elijah Perrault 910c1afb86 Added an UNO module for endless fun playing the UNO card game. Warning: Can be addicting. MAKE SURE TO READ THE DOCS. 2011-02-22 22:14:59 -07:00
Elijah Perrault 39ce9b2da4 Updated. 2011-02-22 21:19:15 -07:00
Elijah Perrault cae3f191a8 Initialize the on_part event. 2011-02-22 21:18:27 -07:00
Elijah Perrault 47605fd33e Remove any leading colons. 2011-02-22 11:10:11 -07:00
Elijah Perrault 4de600d91a Updated for 3.0.0a5. 2011-02-21 23:31:55 -07:00
40 changed files with 2905 additions and 559 deletions

No files matched your search

+12 -10
View File
@@ -11,23 +11,25 @@
The future of IRC bots is here! Xelhua gives to you, Auto 3.0, a new version of
the popular Auto IRC bot.
In this alpha5 release, we have added:
In this alpha7 release, we have added:
* LinkTitle module for returning the page title of links sent to a channel.
* Added core command MODLIST.
* Added SEARCH and MORE to QDB. Amount of results returned at a time with
qdb_search_resnum in the config.
* Support for multiple configuration files using bin/auto -c=FILENAME. See
bin/auto -h for details.
* Added network-wide user tracking through Core::IRC::Users.
Bug fixes:
* Fixed a bug when viewing non-existent quotes.
* SEVERE: Fixed a bug that caused rehash to fail.
* Fixed a bug where a CAP entry for a network was not recreated on a reconnect.
* Fixed a bug where incoming PART's from ourselves were not parsed.
* Fixed a bug in UNO where rehashing during a game caused a crash.
* Fixed a bug where appropriate data was not cleared after a disconnect.
* Fixed a bug where Vim modelines were in an incorrect spot in modules.
Incompatibilities:
None
* Many API changes - Minimum version bumped to 3.0.0a7.
We thank you for choosing Auto. Please remember that he is still in early
We thank you for choosing Auto. Please remember that he is still in mid-
development stages. But we hope we've piqued your interest, as Auto's upcoming
module repository will allow modules to be created by anyone and uploaded
there for everyone to use.
@@ -35,4 +37,4 @@ there for everyone to use.
Auto's goal is to create an efficient, stable and highly customizable IRC bot
in Perl. To offer an alternative to other platforms.
Enjoy Auto 3.0.0 Alpha 5!
Enjoy Auto 3.0.0 Alpha 7!
+1 -1
View File
@@ -50,4 +50,4 @@ else
echo "Usage: auto (start|stop|rehash|status|getmodules)"
fi
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+96 -100
View File
@@ -14,6 +14,7 @@ use English qw(-no_match_vars);
use Sys::Hostname;
use IO::Socket;
use IO::Select;
use Getopt::Long;
use DBI;
use Class::Unload;
use FindBin qw($Bin);
@@ -21,6 +22,10 @@ our $Bin = $Bin; ## no critic qw(NamingConventions::Capitalization Variables::Pr
BEGIN {
unshift @INC, "$Bin/../lib";
open my $gitfh, '<', "$Bin/../.git/refs/heads/indev";
our $VERGITREV = substr readline $gitfh, 0, 7;
close $gitfh;
# Set version information.
use constant { ## no critic qw(ValuesAndExpressions::ProhibitConstantPragma)
NAME => 'Auto IRC Bot',
@@ -28,7 +33,6 @@ BEGIN {
SVER => 0,
REV => 0,
RSTAGE => 'd',
GR => substr `cat $Bin/../.git/refs/heads/indev`, 0, 7
};
}
use Lib::Auto;
@@ -37,11 +41,12 @@ use API::Log qw(alog dbug);
#use DB::Flatfile;
use Parser::Config;
use Parser::Lang;
use Parser::IRC;
use Proto::IRC;
use Core::IRC;
use Core::IRC::Users;
use Core::Cmd;
our $VERSION = 3.0.0;
our $VERSION = 3.000000;
local $PROGRAM_NAME = 'auto';
# Check for build files.
@@ -94,6 +99,63 @@ API::Std::event_add('on_sigterm');
API::Std::event_add('on_sigint');
API::Std::event_add('on_sighup');
# Get arguments.
our ($DEBUG, $NUC);
my ($opt_help, $opt_version, $USECONFIG);
GetOptions(
'nuc' => \$NUC,
'c=s' => \$USECONFIG,
'config=s' => \$USECONFIG,
'h' => \$opt_help,
'help' => \$opt_help,
'd' => \$DEBUG,
'debug' => \$DEBUG,
'v' => \$opt_version,
'version' => \$opt_version
);
# If we were passed -h, print help.
if ($opt_help) {
print <<'HELP';
Usage: $PROGRAM_NAME [options]
--help, -h Prints this help.
--version, -v Prints the version of this Auto.
--debug, -d Runs Auto in debug mode. Debug mode will print out debug
messages, including IRC raw data, to screen. This will also
stop Auto from forking into the background.
--config=FILENAME, -c Uses etc/FILENAME for the configuration file.
HELP
exit 1;
}
# If we were passed -v, print version.
if ($opt_version) {
say q{};
say NAME.' version '.VER.', subversion '.SVER.', revision '.REV.' ('.VER.q{.}.SVER.q{.}.REV.RSTAGE.').';
print <<'VERINFO';
Copyright (C) 2010-2011, Xelhua Development Group. All rights reserved.
Auto is released under the licensing terms of the New (3-Clause) BSD License,
which may be found in doc/LICENSE.
For documentation, you might refer to README, doc/*, and the Xelhua Wiki at
http://wiki.xelhua.org. Documentation for modules is stored in Man Page and
HTML form in autodoc/.
For support, visit the Xelhua Forums at http://forums.xelhua.org, or drop by
the official IRC chatroom at irc.xelhua.org #xelhua. Please report bugs and
request new features at http://rm.xelhua.org.
VERINFO
exit 1;
}
undef $opt_help;
undef $opt_version;
# Print startup message.
say <<'EOF';
@@ -108,18 +170,6 @@ say '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
our ($APID, %TIMERS);
# Get arguments.
our $DEBUG = 0;
our $NUC = 0;
if (defined $ARGV[0]) {
foreach (@ARGV) {
given ($_) {
when ('-d') { $DEBUG = 1; }
when ('-nuc') { $NUC = 1; }
}
}
}
# Check for updates.
Lib::Auto::checkver();
@@ -129,10 +179,14 @@ if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6; }
if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL; }
# Parse configuration file.
say '* Parsing configuration file auto.conf...';
our $CONF = Parser::Config->new('auto.conf') or err(1, 'Failed to parse configuration file!', 1);
my $configfile = 'auto.conf';
if ($USECONFIG) { $configfile = $USECONFIG; }
say "* Parsing configuration file $configfile...";
our $CONF = Parser::Config->new($configfile) or err(1, 'Failed to parse configuration file!', 1);
our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
say ' Success';
undef $configfile;
undef $USECONFIG;
if (conf_get('die')) {
if ((conf_get('die'))[0][0] == 1) {
@@ -179,8 +233,9 @@ given (lc((conf_get('database:format'))[0][0])) {
if (!-e "$Bin/../etc/".(conf_get('database:filename'))[0][0]) {
# Create <database:filename> if it's missing.
system "touch $Bin/../etc/".(conf_get('database:filename'))[0][0];
system "chmod a+x $Bin/../etc/".(conf_get('database:filename'))[0][0];
open my $dbfh, '>', "$Bin/../etc/".(conf_get('database:filename'))[0][0];
close $dbfh;
chmod 0755, "$Bin/../etc/".(conf_get('database:filename'))[0][0];
}
# Connect to database.
$DB = DBI->connect("dbi:SQLite:dbname=$Bin/../etc/".(conf_get('database:filename'))[0][0]) or err(2, 'Failed to connect to database!', 1);
@@ -303,6 +358,14 @@ our $STARTTIME = time;
say '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.};
alog 'Auto successfully started.';
# If we're on Windows, disable forking.
if ($OSNAME =~ /win/i) {
if (!$DEBUG) {
say '!!! Forking unavailable (OS is Microsoft Windows), continuing in debug mode.';
$DEBUG = 1;
}
}
# Fork into the background if not in debug mode.
if (!$DEBUG) {
say '*** Becoming a daemon...';
@@ -312,9 +375,6 @@ if (!$DEBUG) {
$APID = fork;
if ($APID != 0) {
alog '* Successfully forked into the background. Process ID: '.$APID;
if (!-e "$Bin/auto.pid") {
system "touch $Bin/auto.pid";
}
open my $FPID, '>', "$Bin/auto.pid" or exit;
print {$FPID} "$APID\n" or exit;
close $FPID or exit;
@@ -328,6 +388,12 @@ else {
# Events.
API::Std::event_add('on_preconnect');
# CAP.
my %tcsvrs = conf_get('server');
foreach my $svr (keys %tcsvrs) {
$Proto::IRC::cap{$svr} = 'multi-prefix';
}
undef %tcsvrs;
# Load modules.
if (conf_get('module')) {
@@ -346,89 +412,19 @@ my %cservers = conf_get('server');
# Set the socket hash and select instance.
our (%SOCKET, $SELECT);
$SELECT = IO::Select->new();
my $it = 0;
# Iterate through each configured server.
foreach my $cskey (keys %cservers) {
# Prepare socket data.
my %conndata = (
Proto => 'tcp',
LocalAddr => $cservers{$cskey}{'bind'}[0],
PeerAddr => $cservers{$cskey}{'host'}[0],
PeerPort => $cservers{$cskey}{'port'}[0],
Timeout => 20,
);
# Set IPv6/SSL data.
my $use6 = 0;
my $usessl = 0;
if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
if (defined $cservers{$cskey}{'ssl'}[0]) { $usessl = $cservers{$cskey}{'ssl'}[0]; }
# CertFP.
if ($usessl) {
if (defined $cservers{$cskey}{'certfp'}[0]) {
if ($cservers{$cskey}{'certfp'}[0] eq 1) {
$conndata{'SSL_use_cert'} = 1;
if (defined $cservers{$cskey}{'certfp_cert'}[0]) {
$conndata{'SSL_cert_file'} = "$Bin/../etc/certs/".$cservers{$cskey}{'certfp_cert'}[0];
}
if (defined $cservers{$cskey}{'certfp_key'}[0]) {
$conndata{'SSL_key_file'} = "$Bin/../etc/certs/".$cservers{$cskey}{'certfp_key'}[0];
}
if (defined $cservers{$cskey}{'certfp_pass'}[0]) {
$conndata{'SSL_passwd_cb'} = sub { return $cservers{$cskey}{'certfp_pass'}[0]; };
}
}
}
}
# Create the socket.
if ($use6) {
$SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $SOCKET{$cskey} and next;
}
else {
if ($usessl) {
$SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $SOCKET{$cskey} and next;
}
else {
$SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $SOCKET{$cskey} and next;
}
}
# Send PASS if we have one.
if (defined $cservers{$cskey}{'pass'}[0]) {
socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next;
}
API::Std::event_run('on_preconnect', $cskey);
# Send NICK/USER.
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next;
# Add to select.
$SELECT->add($SOCKET{$cskey});
# Success!
alog '** Successfully connected to server: '.$cskey;
dbug '** Successfully connected to server: '.$cskey;
$it = 1;
Lib::Auto::ircsock(\%{$cservers{$cskey}}, $cskey);
}
# Success!
if ($it) {
if (keys %SOCKET) {
alog '** Success: Connected to server(s).';
dbug '** Success: Connected to server(s).';
}
else {
err(2, 'No server connections.', 1);
err(2, 'No IRC connections -- Exiting program.', 1);
}
undef $it;
# Create core commands.
API::Std::cmd_add('MODLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLOAD, \&Core::Cmd::cmd_modload);
@@ -477,6 +473,7 @@ while (1) {
err(2, "Lost connection to $sockid!", 0);
$SELECT->remove($sock);
delete $SOCKET{$sockid};
API::Std::event_run('on_disconnect', $sockid);
if (!keys %SOCKET) {
# No more connections, stop the program.
API::Std::event_run('on_shutdown');
@@ -499,7 +496,7 @@ while (1) {
dbug $sockid.' >> '.$line;
# Parse data.
Parser::IRC::ircparse($sockid, $line);
Proto::IRC::ircparse($sockid, $line);
}
}
}
@@ -509,12 +506,11 @@ while (1) {
###############
# Send data to socket.
sub socksnd
{
sub socksnd {
my ($svr, $data) = @_;
if (defined $SOCKET{$svr}) {
syswrite $SOCKET{$svr}, $data."\n", POSIX::BUFSIZ, 0;
syswrite $SOCKET{$svr}, $data."\r\n", POSIX::BUFSIZ, 0;
dbug "$svr << $data";
return 1;
}
@@ -547,4 +543,4 @@ sub mod_load {
return;
}
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+2 -2
View File
@@ -126,7 +126,7 @@ foreach my $line (@MPBUF) {
$got_end = 1;
}
if ($got_end and $line ne '__END__') {
if ($got_end and $line ne '__END__' and $line !~ m/^# vim:/sm) {
$podbuf .= $line."\n";
}
}
@@ -150,4 +150,4 @@ $manifier->parse_from_file("$Bin/../autodoc/$module.pod", "$Bin/../autodoc/$modu
print $RS;
say 'Done.';
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+1 -1
View File
@@ -58,4 +58,4 @@ foreach (@violations) {
}
say "$count violations in $ARGV[0].";
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+1 -1
View File
@@ -44,4 +44,4 @@ while ($fpr =~ s/(.*\n)//) {
# Print the fingerprint.
say 'Done. Fingerprint: '.$fp;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+53
View File
@@ -2,6 +2,59 @@ Auto IRC Bot 3.0: Change Log
-------------------------------------------------------------------------------
3.0 Indev
===============================================================================
3.0 Alpha 7
===============================================================================
* Fixed a bug in UNO where rehashing during a game caused a crash.
* Proto::IRC::umodes renamed to Proto::IRC::botinfo{svr}{modes}.
* Fixed a bug where incoming PART's from ourselves were not parsed.
* Our usermodes are now tracked in Proto::IRC::umodes.
* Added events on_cmode and on_umode.
* Added event on_myinfo for RPL_MYINFO (numeric 004).
* Raw hooks now take hook names and support multiple hooks. This changes
rchook_add and rchook_del.
* Vim modelines must be at the bottom of files. Modules updated.
* Renamed Lib::Users to Core::IRC::Users.
* Added Lib::Users, for network-wide user tracking. This brings many new
possibilities to modules, including an account system.
* Added hook on_namesreply.
* All data related to a network is now deleted on disconnect.
* Added hook on_disconnect.
* Added various options to bin/auto, including support for multiple config
files. See bin/auto -h for details.
* Changed on_nick, on_quit, on_part, and on_kick source hashrefs to include
server, removing svr.
* Bumped minimum API version to 3.0.0a7.
* Fixed the arguments on_whoreply passes.
3.0 Alpha 6
===============================================================================
* Bug fix: Fixed an issue with SASL timeout.
* Added hook on_capack.
* CAP is now core.
* Fixed a bug with multi-prefix support.
* Added fpfmt() to API::Std.
* Auto::GR renamed to $Auto::VERGITREV.
* Bumped minimum version for API to 3.0.0a6.
* Changed on_topic args to: full source hashref, new topic array
* on_topic is now triggered for any topic change, regardless of source.
* Now parsing numeric 004.
* Added hook on_isupport.
* Added a BotStats module for returning statistics about the bot.
* Now parsing numeric 396.
* Added who() to API::IRC.
* Added hook on_whoreply.
* PRIVMSGs and NOTICEs that would cause a >512 bytes resulting message are
now divided into multiple messages.
* Renamed botnick to botinfo.
* Renamed Parser::IRC to Proto::IRC.
* Added an Eval module.
* Added an UNO module.
* Added on_part hook.
3.0 Alpha 5
===============================================================================
* Bug fix: Fixed broken rehash.
* Ignore PRIVMSG's if they're from an invalid source.
+2 -2
View File
@@ -42,7 +42,7 @@ Legend:
[!] Features
[X] Weather module
[!] Urban Dictionary module
[ ] UNO module
[X] UNO module
[ ] Google Search module
[ ] IRC Relay module
[ ] (Google?) News module
@@ -51,7 +51,7 @@ Legend:
[X] Google Calculator module
[ ] YouTube Search module
[ ] Twitter module
[!] Advanced Topics module
[X] Advanced Topics module
[ ] Custom Triggers module
[X] Shorten URL (bit.ly?) module
[?] Bot Talk module
+18
View File
@@ -0,0 +1,18 @@
Auto IRC Bot 3.0: Microsoft Windows Notes
===============================================================================
When running Auto on Microsoft Windows, you should be aware of the following:
* Windows support has not been thoroughly tested, some scripts/features may not
function correctly.
* Forking into the background is disabled.
* Some file system operations may fail if Auto is installed to a path with
spaces. Please report these.
For the full power of Auto; run him in a UNIX environment.
Since Windows support can be considered experimental, testers are welcome and
you should report anything you find to malfunction.
At some point in the future, we hope to achieve Windows support with no core
caveats. Again, reporting issues in Auto on Windows is highly appreciated.
+16 -21
View File
@@ -21,15 +21,15 @@ my $features = 'base ssl sqlite';
if (defined $ARGV[0]) {
foreach (@ARGV) {
if ($_ eq '-h' or $_ eq '--help') {
println '*** ./install help ***';
println ' --enable-sasl - Enable support for SASL.';
println '*** ./install help ***';
println ' --enable-sasl - Enable support for SASL.';
println ' --enable-ipv6 - Enable support for IPv6.';
println ' --disable-ssl - Disable support for SSL.';
println '*** End of Help ***';
exit 1;
println '*** End of Help ***';
exit 1;
}
elsif ($_ eq '--enable-sasl') {
$features .= ' sasl';
$features .= ' sasl';
}
elsif ($_ eq '--disable-ssl') {
$features =~ s/ ssl//g;
@@ -44,7 +44,7 @@ if (defined $ARGV[0]) {
$features =~ s/(sqlite|mysql)/pgsql/g;
}
else {
println "Warning: Unknown option '$_'";
println "Warning: Unknown option '$_'";
}
}
}
@@ -59,18 +59,21 @@ eval {
print "Checking operating system..... $OSNAME - ";
if ($OSNAME =~ /dos/i) {
print "DOS is not supported.\r\n";
exit;
}
elsif ($OSNAME eq "MSWin32") {
print "Microsoft Windows is not supported. Support is planned for the future.\r\n";
print "OK\r\n";
}
elsif ($OSNAME eq "NetWare") {
print "NetWare is not supported.\r\n";
exit;
}
elsif ($OSNAME eq "linux") {
print "OK\n";
}
elsif ($OSNAME eq "os2") {
print "IBM OS/2 is not supported.\r\n";
exit;
}
elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) {
print "OK\r";
@@ -81,8 +84,12 @@ elsif ($OSNAME eq "freebsd") {
elsif ($OSNAME eq "openbsd") {
print "OK\n";
}
elsif ($OSNAME eq "solaris") {
print "OK\n";
}
else {
print "Unknown operating system. Contact support.\r\n";
exit;
}
# Check for Perl core modules.
@@ -124,19 +131,7 @@ else {
println "\0";
println "Building.....";
if (!-d "$Bin/build") {
system "mkdir $Bin/build";
}
if (!-e "$Bin/build/time") {
system "touch $Bin/build/time";
}
if (!-e "$Bin/build/os") {
system "touch $Bin/build/os";
}
if (!-e "$Bin/build/perl") {
system "touch $Bin/build/perl";
}
if (!-e "$Bin/build/ver") {
system "touch $Bin/build/ver";
mkdir "$Bin/build";
}
build($features);
@@ -149,4 +144,4 @@ println q{};
# Success!
println "Done. Auto successfully installed.";
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+39 -16
View File
@@ -9,8 +9,10 @@ use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(ban cjoin cpart cmode umode kick privmsg notice quit nick names
topic usrc match_mask);
topic who usrc match_mask);
# Create the on_disconnect event.
API::Std::event_add('on_disconnect');
# Set a ban, based on config bantype value.
sub ban
@@ -67,8 +69,6 @@ sub cpart
Auto::socksnd($svr, "PART $chan :Leaving");
}
if (defined $Parser::IRC::botchans{$svr}{$chan}) { delete $Parser::IRC::botchans{$svr}{$chan}; }
return 1;
}
@@ -87,7 +87,7 @@ sub umode
{
my ($svr, $modes) = @_;
Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes");
Auto::socksnd($svr, "MODE ".$Proto::IRC::botinfo{$svr}{nick}." $modes");
return 1;
}
@@ -97,7 +97,15 @@ sub privmsg
{
my ($svr, $target, $message) = @_;
Auto::socksnd($svr, "PRIVMSG $target :$message");
# Get maximum length.
my $maxlen = 510 - length q{:}.$Proto::IRC::botinfo{$svr}{nick}.q{!}.$Proto::IRC::botinfo{$svr}{user}.q{@}.$Proto::IRC::botinfo{$svr}{mask}." PRIVMSG $target :";
# Divide message if it surpasses the maximum length.
while (length $message >= $maxlen) {
my $submsg = substr $message, 0, $maxlen, q{};
Auto::socksnd($svr, "PRIVMSG $target :$submsg");
}
if (length $message) { Auto::socksnd($svr, "PRIVMSG $target :$message") }
return 1;
}
@@ -107,7 +115,15 @@ sub notice
{
my ($svr, $target, $message) = @_;
Auto::socksnd($svr, "NOTICE $target :$message");
# Get maximum length.
my $maxlen = 510 - length q{:}.$Proto::IRC::botinfo{$svr}{nick}.q{!}.$Proto::IRC::botinfo{$svr}{user}.q{@}.$Proto::IRC::botinfo{$svr}{mask}." NOTICE $target :";
# Divide message if it surpasses the maximum length.
while (length $message >= $maxlen) {
my $submsg = substr $message, 0, $maxlen, q{};
Auto::socksnd($svr, "NOTICE $target :$submsg");
}
if (length $message) { Auto::socksnd($svr, "NOTICE $target :$message") }
return 1;
}
@@ -129,8 +145,8 @@ sub nick
Auto::socksnd($svr, "NICK $newnick");
$Parser::IRC::botnick{$svr}{newnick} = $newnick;
$Proto::IRC::botinfo{$svr}{newnick} = $newnick;
return 1;
}
@@ -165,23 +181,30 @@ sub kick
}
# Quit IRC.
sub quit
{
sub quit {
my ($svr, $reason) = @_;
if (defined $reason) {
Auto::socksnd($svr, "QUIT :$reason");
}
else {
Auto::socksnd($svr, "QUIT :Leaving");
Auto::socksnd($svr, 'QUIT :Leaving');
}
delete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr});
delete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr});
# Trigger on_disconnect.
API::Std::event_run('on_disconnect', $svr);
return 1;
}
# Send a WHO.
sub who {
my ($svr, $nick) = @_;
Auto::socksnd($svr, "WHO $nick");
return 1;
}
# Get nick, ident and host from a <nick>!<ident>@<host>
sub usrc
@@ -219,4 +242,4 @@ sub match_mask
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+5 -9
View File
@@ -10,7 +10,7 @@ use POSIX;
use Time::Local;
use Exporter;
use base qw(Exporter);
use API::Std qw(conf_get);
use API::Std qw(conf_get fpfmt);
our @EXPORT_OK = qw(println dbug alog slog);
@@ -59,10 +59,6 @@ sub alog
if (!-d "$Auto::Bin/../var") {
mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
}
# Create var/DATE.log if it doesn't exist.
if (!-e "$Auto::Bin/../var/$date.log") {
system "touch $Auto::Bin/../var/$date.log";
}
# Open the logfile, print the log message to it and close it.
open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return;
@@ -89,7 +85,7 @@ sub expire_logs
}
# Iterate through each logfile.
foreach my $file (glob "$Auto::Bin/../var/*") {
foreach my $file (glob fpfmt("$Auto::Bin/../var/*")) {
my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
# Convert filename to UNIX time.
@@ -118,7 +114,7 @@ sub slog
# It is, continue.
# Split the network and channel.
my ($net, $chan) = split '/', (conf_get('logchan'))[0][0];
my ($net, $chan) = split m/[\/]/xsm, (conf_get('logchan'))[0][0];
$chan = lc $chan;
# Check if we're connected to the network.
@@ -129,7 +125,7 @@ sub slog
}
# Check if we're in the channel.
if (!defined $Parser::IRC::botchans{$net}{$chan}) {
if (!defined $Proto::IRC::botchans{$net}{$chan}) {
dbug 'WARNING: slog(): Unable to log to IRC: Not in channel.';
alog 'WARNING: slog(): Unable to log to IRC: Not in channel.';
return;
@@ -143,4 +139,4 @@ sub slog
}
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+34 -17
View File
@@ -9,10 +9,10 @@ use Exporter;
use base qw(Exporter);
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS, %RAWHOOKS);
our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add
cmd_del hook_add hook_del rchook_add rchook_del match_user
has_priv mod_exists ratelimit_check);
has_priv mod_exists ratelimit_check fpfmt);
# Initialize a module.
@@ -26,7 +26,7 @@ sub mod_init
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); }
# Check if this module is compatible with this version of Auto.
if ($autover ne '3.0.0a4' and $autover ne '3.0.0a5') {
if ($autover !~ m/^3\.0\.0a(7)$/xsm) {
API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); }
@@ -263,12 +263,16 @@ sub timer_del
# Hook onto a raw command.
sub rchook_add
{
my ($cmd, $sub) = @_;
my ($cmd, $name, $sub) = @_;
$cmd = uc $cmd;
if (defined $Parser::IRC::RAWC{$cmd}) { return; }
$Parser::IRC::RAWC{$cmd} = $sub;
# Make sure core doesn't already handle this.
if (defined $Proto::IRC::RAWC{$cmd}) { return }
# If the hook already exists, ignore it.
if (defined $RAWHOOKS{$cmd}{$name}) { return }
# Create the hook.
$RAWHOOKS{$cmd}{$name} = $sub;
return 1;
}
@@ -276,12 +280,14 @@ sub rchook_add
# Delete a raw command hook.
sub rchook_del
{
my ($cmd) = @_;
my ($cmd, $name) = @_;
$cmd = uc $cmd;
if (!defined $Parser::IRC::RAWC{$cmd}) { return; }
# Make sure the hook exists.
if (!defined $RAWHOOKS{$cmd}{$name}) { return }
delete $Parser::IRC::RAWC{$cmd};
# Delete it.
delete $RAWHOOKS{$cmd}{$name};
return 1;
}
@@ -386,15 +392,15 @@ sub match_user
my $svr = $ulhp{net}[0];
if (defined $Auto::SOCKET{$svr}) {
if ($ccnm eq 'CURRENT' and defined $user{chan}) {
if (defined $Parser::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) {
if ($Parser::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
if (defined $Proto::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) {
if ($Proto::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
}
}
else {
foreach my $bcj (keys %{ $Parser::IRC::botchans{$svr} }) {
foreach my $bcj (keys %{ $Proto::IRC::botchans{$svr} }) {
if (API::IRC::match_mask($bcj, $ccnm)) {
if (defined $Parser::IRC::chanusers{$svr}{$bcj}{$user{nick}}) {
if ($Parser::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
if (defined $Proto::IRC::chanusers{$svr}{$bcj}{$user{nick}}) {
if ($Proto::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
}
}
}
@@ -485,7 +491,10 @@ sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
}
# If it's a fatal error, exit the program.
if ($fatal) { exit; }
if ($fatal) {
API::Std::event_run('on_shutdown');
exit;
}
return 1;
}
@@ -516,6 +525,14 @@ sub awarn
return 1;
}
# Formatting a file path.
sub fpfmt {
my ($path) = @_;
if ($path =~ m/\s/xsm) { return "\"$path\""; }
else { return $path; }
}
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+3 -3
View File
@@ -186,10 +186,10 @@ sub cmd_restart
# Time to come back from the dead!
if ($Auto::DEBUG) {
system("$Auto::Bin/auto -d -nuc");
exec "perl $Auto::Bin/auto -d -nuc";
}
else {
system("$Auto::Bin/auto -nuc");
exec "perl $Auto::Bin/auto -nuc";
}
exit;
@@ -314,4 +314,4 @@ sub cmd_help
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+108 -5
View File
@@ -19,7 +19,7 @@ hook_add("on_uprivmsg", "ctcp_version_reply", sub {
notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE." ".$OSNAME."\001");
}
else {
notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE."-".Auto::GR." ".$OSNAME."\001");
notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE."-$Auto::VERGITREV ".$OSNAME."\001");
}
}
@@ -28,12 +28,12 @@ hook_add("on_uprivmsg", "ctcp_version_reply", sub {
# QUIT hook; delete user from chanusers.
hook_add("on_quit", "quit_update_chanusers", sub {
my (($svr, $src, undef)) = @_;
my (($src, undef)) = @_;
my %src = %{ $src };
# Delete the user from all channels.
foreach my $ccu (keys %{ $Parser::IRC::chanusers{$svr} }) {
if (defined $Parser::IRC::chanusers{$svr}{$ccu}{$src{nick}}) { delete $Parser::IRC::chanusers{$svr}{$ccu}{$src{nick}}; }
foreach my $ccu (keys %{ $Proto::IRC::chanusers{$src{svr}}}) {
if (defined $Proto::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}}) { delete $Proto::IRC::chanusers{$src{svr}}{$ccu}{$src{nick}}; }
}
return 1;
@@ -51,6 +51,15 @@ hook_add("on_connect", "on_connect_modes", sub {
return 1;
});
# Self-WHO on connect.
hook_add('on_connect', 'on_connect_selfwho', sub {
my ($svr) = @_;
API::IRC::who($svr, $Proto::IRC::botinfo{$svr}{nick});
return 1;
});
# Plaintext auth.
hook_add("on_connect", "plaintext_auth", sub {
my ($svr) = @_;
@@ -114,6 +123,54 @@ hook_add("on_connect", "autojoin", sub {
return 1;
});
# WHO reply.
hook_add('on_whoreply', 'selfwho.getdata', sub {
my (($svr, $nick, undef, $user, $mask, undef, undef, undef, undef)) = @_;
# Check if it's for us.
if ($nick eq $Proto::IRC::botinfo{$svr}{nick}) {
# It is. Set data.
$Proto::IRC::botinfo{$svr}{user} = $user;
$Proto::IRC::botinfo{$svr}{mask} = $mask;
}
return 1;
});
# ISUPPORT - Set prefixes and channel modes.
hook_add('on_isupport', 'core.prefixchanmode.getdata', sub {
my (($svr, @ex)) = @_;
# Find PREFIX and CHANMODES.
foreach my $ex (@ex) {
if ($ex =~ m/^PREFIX/xsm) {
# Found PREFIX.
my $rpx = substr($ex, 8);
my ($pm, $pp) = split('\)', $rpx);
my @apm = split(//, $pm);
my @app = split(//, $pp);
foreach my $ppm (@apm) {
# Store data.
$Proto::IRC::csprefix{$svr}{$ppm} = shift(@app);
}
}
elsif ($ex =~ m/^CHANMODES/xsm) {
# Found CHANMODES.
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
# List modes.
foreach (split(//, $mtl)) { $Proto::IRC::chanmodes{$svr}{$_} = 1; }
# Modes with parameter.
foreach (split(//, $mtp)) { $Proto::IRC::chanmodes{$svr}{$_} = 2; }
# Modes with parameter when +.
foreach (split(//, $mtpp)) { $Proto::IRC::chanmodes{$svr}{$_} = 3; }
# Modes without parameter.
foreach (split(//, $mts)) { $Proto::IRC::chanmodes{$svr}{$_} = 4; }
}
}
return 1;
});
sub clear_usercmd_timer
{
# If ratelimit is set to 1 in config, add this timer.
@@ -131,6 +188,52 @@ sub clear_usercmd_timer
return 1;
}
# Server data deletion on disconnect.
hook_add('on_disconnect', 'core.irc.deldata', sub {
my ($svr) = @_;
# Delete all data related to the server.
if (defined $Proto::IRC::got_001{$svr}) { delete $Proto::IRC::got_001{$svr} }
if (defined $Proto::IRC::botinfo{$svr}) { delete $Proto::IRC::botinfo{$svr} }
if (defined $Proto::IRC::botchans{$svr}) { delete $Proto::IRC::botchans{$svr} }
if (defined $Proto::IRC::chanusers{$svr}) { delete $Proto::IRC::chanusers{$svr} }
if (defined $Proto::IRC::csprefix{$svr}) { delete $Proto::IRC::csprefix{$svr} }
if (defined $Proto::IRC::chanmodes{$svr}) { delete $Proto::IRC::chanmodes{$svr} }
if (defined $Proto::IRC::cap{$svr}) { delete $Proto::IRC::cap{$svr} }
return 1;
});
# Track our usermodes.
hook_add('on_umode', 'core.irc.state.umode', sub {
my (($svr, $modes)) = @_;
# Remove anything after a space.
$modes =~ s/(\s.*)//xsm;
# Split the modes.
my @modes = split //, $modes;
# Set operator to 1.
my $op = 1;
# Iterate through the modes.
foreach (@modes) {
if ($_ eq '-') { $op = 0 }
elsif ($_ eq '+') { $op = 1 }
else {
# Adjust our modes.
if ($op) {
$Proto::IRC::botinfo{$svr}{modes} .= $_;
}
else {
$Proto::IRC::botinfo{$svr}{modes} =~ s/($_)//xsm;
}
}
}
return 1;
});
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+132
View File
@@ -0,0 +1,132 @@
# lib/Core/IRC/Users.pm - IRC user tracking.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package Core::IRC::Users;
use strict;
use warnings;
use API::Std qw(hook_add);
our %users;
# Initialize the ircusers_create and ircusers_delete events.
API::Std::event_add('ircusers_create');
API::Std::event_add('ircusers_delete');
# Create the on_rcjoin hook.
hook_add('on_rcjoin', 'ircusers.onjoin', sub {
my ($src, $chan) = @_;
# Add the user to the users hash, if not already defined.
if (!$users{$src->{svr}}{lc $src->{nick}}) {
$users{$src->{svr}}{lc $src->{nick}} = $src->{nick};
API::Std::event_run('ircusers_create', ($src->{svr}, $src->{nick}));
}
return 1;
});
# Create the on_namesreply hook.
hook_add('on_namesreply', 'ircusers.names', sub {
my ($svr, $chan, undef) = @_;
# Iterate through the users for this channel.
foreach (keys %{$Proto::IRC::chanusers{$svr}{$chan}}) {
# Check if the user already exists.
if (!$users{$svr}{$_}) {
# They do not; WHO them.
API::IRC::who($svr, $_);
}
}
return 1;
});
# Create the on_whoreply hook.
hook_add('on_whoreply', 'ircusers.who', sub {
my ($svr, $nick, undef) = @_;
# Ensure it is not us.
if (lc $nick ne lc $Proto::IRC::botinfo{$svr}{nick}) {
# It is not. Check if they're already in the users hash.
if (!$users{$svr}{lc $nick}) {
# They are not; add them.
$users{$svr}{lc $nick} = $nick;
}
}
return 1;
});
# Create the on_nick hook.
hook_add('on_nick', 'ircusers.onnick', sub {
my ($src, $newnick) = @_;
# Modify the user's entry in the users hash.
if ($users{$src->{svr}}{lc $src->{nick}}) {
$users{$src->{svr}}{lc $newnick} = $newnick;
delete $users{$src->{svr}}{lc $src->{nick}};
}
return 1;
});
# Create the on_kick hook.
hook_add('on_kick', 'ircusers.onkick', sub {
my ($src, $kchan, $user, undef) = @_;
# Ensure there is a users hash entry for this user.
if ($users{$src->{svr}}{lc $user}) {
# Figure out if the user is in any other channel we're in.
my $ri = 0;
foreach my $chan (keys %{$Proto::IRC::chanusers{$src->{svr}}}) {
if ($chan ne $kchan) {
if (defined $Proto::IRC::chanusers{$src->{svr}}{$chan}{lc $user}) { $ri++; last; }
}
}
if (!$ri) {
# They are not, delete them.
delete $users{$src->{svr}}{lc $user};
API::Std::event_run('ircusers_delete', ($src->{svr}, $user));
}
}
return 1;
});
# Create the on_part hook.
hook_add('on_part', 'ircusers.onpart', sub {
my ($src, $pchan, undef) = @_;
# Ensure there is a users hash entry for this user.
if ($users{$src->{svr}}{lc $src->{nick}}) {
# Figure out if the user is in any other channel we're in.
my $ri = 0;
foreach my $chan (keys %{$Proto::IRC::chanusers{$src->{svr}}}) {
if ($chan ne $pchan) {
if (defined $Proto::IRC::chanusers{$src->{svr}}{$chan}{lc $src->{nick}}) { $ri++; last; }
}
}
if (!$ri) {
# They are not, delete them.
delete $users{$src->{svr}}{lc $src->{nick}};
API::Std::event_run('ircusers_delete', ($src->{svr}, $src->{nick}));
}
}
return 1;
});
# Create the on_quit hook.
hook_add('on_quit', 'ircusers.onquit', sub {
my ($src, undef) = @_;
# Delete the user's entry from the users hash.
if ($users{$src->{svr}}{lc $src->{nick}}) {
delete $users{$src->{svr}}{lc $src->{nick}};
}
return 1;
});
1;
# vim: set ai et sw=4 ts=4:
+94 -69
View File
@@ -134,83 +134,108 @@ sub rehash
# Iterate through each configured server.
foreach my $cskey (keys %cservers) {
if (!defined $Auto::SOCKET{$cskey}) {
# Prepare socket data.
my %conndata = (
Proto => 'tcp',
LocalAddr => $cservers{$cskey}{'bind'}[0],
PeerAddr => $cservers{$cskey}{'host'}[0],
PeerPort => $cservers{$cskey}{'port'}[0],
Timeout => 20,
);
# Set IPv6/SSL data.
my $use6 = 0;
my $usessl = 0;
if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
if (defined $cservers{$cskey}{'ssl'}[0]) { $usessl = $cservers{$cskey}{'ssl'}[0]; }
# CertFP.
if ($usessl) {
if (defined $cservers{$cskey}{'certfp'}[0]) {
if ($cservers{$cskey}{'certfp'}[0] eq 1) {
$conndata{'SSL_use_cert'} = 1;
if (defined $cservers{$cskey}{'certfp_cert'}[0]) {
$conndata{'SSL_cert_file'} = "$Auto::Bin/../etc/certs/".$cservers{$cskey}{'certfp_cert'}[0];
}
if (defined $cservers{$cskey}{'certfp_key'}[0]) {
$conndata{'SSL_key_file'} = "$Auto::Bin/../etc/certs/".$cservers{$cskey}{'certfp_key'}[0];
}
if (defined $cservers{$cskey}{'certfp_pass'}[0]) {
$conndata{'SSL_passwd_cb'} = sub { return $cservers{$cskey}{'certfp_pass'}[0]; };
}
}
}
}
# Create the socket.
if ($use6) {
$Auto::SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $Auto::SOCKET{$cskey} and next;
}
else {
if ($usessl) {
$Auto::SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $Auto::SOCKET{$cskey} and next;
}
else {
$Auto::SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $Auto::SOCKET{$cskey} and next;
}
}
# Send PASS if we have one.
if (defined $cservers{$cskey}{'pass'}[0]) {
Auto::socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next;
}
API::Std::event_run('on_preconnect', $cskey);
# Send NICK/USER.
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
Auto::socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next;
# Add to select.
$Auto::SELECT->add($Auto::SOCKET{$cskey});
# Success!
alog '** Successfully connected to server: '.$cskey;
dbug '** Successfully connected to server: '.$cskey;
ircsock(\%{$cservers{$cskey}}, $cskey);
}
}
# Check for server connections.
if (!keys %Auto::SOCKET) {
err(2, 'No IRC connections -- Exiting program.', 0);
API::Std::event_run('on_shutdown');
exit 1;
}
# Now trigger on_rehash.
API::Std::event_run('on_rehash');
return 1;
}
# Socket creation.
sub ircsock {
my ($cdata, $svrname) = @_;
# Prepare socket data.
my %conndata = (
Proto => 'tcp',
LocalAddr => $cdata->{'bind'}[0],
PeerAddr => $cdata->{'host'}[0],
PeerPort => $cdata->{'port'}[0],
Timeout => 20,
);
# Set IPv6/SSL data.
my $use6 = 0;
my $usessl = 0;
if (defined $cdata->{'ipv6'}[0]) { $use6 = $cdata->{'ipv6'}[0]; }
if (defined $cdata->{'ssl'}[0]) { $usessl = $cdata->{'ssl'}[0]; }
# Check for appropriate build data.
if ($usessl) {
if ($Auto::ENFEAT !~ m/ssl/ixsm) { err(2, '** Auto not built with SSL support: Aborting connection to '.$svrname, 0); return; }
}
if ($use6) {
if ($Auto::ENFEAT !~ m/ipv6/ixsm) { err(2, '** Auto not built with IPv6 support: Aborting connection to '.$svrname, 0); return; }
}
# CertFP.
if ($usessl) {
if (defined $cdata->{'certfp'}[0]) {
if ($cdata->{'certfp'}[0] eq 1) {
$conndata{'SSL_use_cert'} = 1;
if (defined $cdata->{'certfp_cert'}[0]) {
$conndata{'SSL_cert_file'} = "$Auto::Bin/../etc/certs/".$cdata->{'certfp_cert'}[0];
}
if (defined $cdata->{'certfp_key'}[0]) {
$conndata{'SSL_key_file'} = "$Auto::Bin/../etc/certs/".$cdata->{'certfp_key'}[0];
}
if (defined $cdata->{'certfp_pass'}[0]) {
$conndata{'SSL_passwd_cb'} = sub { return $cdata->{'certfp_pass'}[0]; };
}
}
}
}
# Create the socket.
if ($use6) {
$Auto::SOCKET{$svrname} = IO::Socket::INET6->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
and delete $Auto::SOCKET{$svrname} and return;
}
else {
if ($usessl) {
$Auto::SOCKET{$svrname} = IO::Socket::SSL->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
and delete $Auto::SOCKET{$svrname} and next;
}
else {
$Auto::SOCKET{$svrname} = IO::Socket::INET->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
and delete $Auto::SOCKET{$svrname} and next;
}
}
# Create a CAP entry if it doesn't already exist.
if (!$Proto::IRC::cap{$svrname}) { $Proto::IRC::cap{$svrname} = 'multi-prefix' }
# Send PASS if we have one.
if (defined $cdata->{'pass'}[0]) {
Auto::socksnd($svrname, 'PASS :'.$cdata->{'pass'}[0]) or return;
}
# Send CAP LS.
Auto::socksnd($svrname, 'CAP LS');
# Trigger on_preconnect.
API::Std::event_run('on_preconnect', $svrname);
# Send NICK/USER.
API::IRC::nick($svrname, $cdata->{'nick'}[0]);
Auto::socksnd($svrname, 'USER '.$cdata->{'ident'}[0].q{ }.hostname.q{ }.$cdata->{'host'}[0].' :'.$cdata->{'realname'}[0]) or return;
# Add to select.
$Auto::SELECT->add($Auto::SOCKET{$svrname});
# Success!
alog '** Successfully connected to server: '.$svrname;
dbug '** Successfully connected to server: '.$svrname;
return 1;
}
# Shutdown.
hook_add('on_shutdown', 'shutdown.core_cleanup', sub {
if (defined $Auto::DB) { $Auto::DB->disconnect; }
@@ -283,4 +308,4 @@ sub signal_perldie
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+3 -3
View File
@@ -119,16 +119,16 @@ sub installmods
chomp $response;
if (lc $response eq 'y') {
println 'What modules would you like to install? (separate by commas)';
println 'Available modules: Badwords, Bitly, Calc, EightBall, FML, Greet, HelloChan, IsItUp, QDB, SASLAuth, Weather';
println 'Available modules: Badwords, Bitly, BotStats, Calc, ChanTopics, Dictionary, EightBall, Eval, FML, Greet, HelloChan, IsItUp, LinkTitle, QDB, SASLAuth, UNO, Weather';
print '> ';
my $modules = <STDIN>; chomp $modules;
$modules =~ s/ //g;
my @modst = split ',', $modules;
foreach (@modst) {
system "$Bin/bin/buildmod $_";
system "perl \"$Bin/bin/buildmod\" $_";
}
}
}
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+1 -1
View File
@@ -177,4 +177,4 @@ sub parse
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+1 -1
View File
@@ -64,4 +64,4 @@ sub parse
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+275 -181
View File
@@ -1,17 +1,21 @@
# lib/Parser/IRC.pm - Subroutines for parsing incoming data from IRC.
# lib/Proto/IRC.pm - Subroutines for parsing incoming data from IRC.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package Parser::IRC;
package Proto::IRC;
use strict;
use warnings;
use feature qw(switch);
use API::Std qw(conf_get err awarn trans);
use API::IRC;
# Raw parsing hash.
our %RAWC = (
'001' => \&num001,
'004' => \&num004,
'005' => \&num005,
'352' => \&num352,
'353' => \&num353,
'396' => \&num396,
'432' => \&num432,
'433' => \&num433,
'438' => \&num438,
@@ -21,6 +25,7 @@ our %RAWC = (
'474' => \&num474,
'475' => \&num475,
'477' => \&num477,
'CAP' => \&cap,
'JOIN' => \&cjoin,
'KICK' => \&kick,
'MODE' => \&mode,
@@ -33,25 +38,34 @@ our %RAWC = (
);
# Variables for various functions.
our (%got_001, %botnick, %botchans, %csprefix, %chanusers, %chanmodes);
our (%got_001, %botinfo, %botchans, %csprefix, %chanusers, %chanmodes, %cap);
# Events.
API::Std::event_add("on_connect");
API::Std::event_add("on_rcjoin");
API::Std::event_add("on_ucjoin");
API::Std::event_add("on_kick");
API::Std::event_add("on_nick");
API::Std::event_add("on_notice");
API::Std::event_add("on_cprivmsg");
API::Std::event_add("on_uprivmsg");
API::Std::event_add("on_quit");
API::Std::event_add("on_topic");
API::Std::event_add('on_capack');
API::Std::event_add('on_cmode');
API::Std::event_add('on_umode');
API::Std::event_add('on_connect');
API::Std::event_add('on_rcjoin');
API::Std::event_add('on_ucjoin');
API::Std::event_add('on_isupport');
API::Std::event_add('on_kick');
API::Std::event_add('on_myinfo');
API::Std::event_add('on_namesreply');
API::Std::event_add('on_nick');
API::Std::event_add('on_notice');
API::Std::event_add('on_part');
API::Std::event_add('on_upart');
API::Std::event_add('on_cprivmsg');
API::Std::event_add('on_uprivmsg');
API::Std::event_add('on_quit');
API::Std::event_add('on_topic');
API::Std::event_add('on_whoreply');
# Parse raw data.
sub ircparse
{
my ($svr, $data) = @_;
# Split spaces into @ex.
my @ex = split /\s+/, $data;
@@ -60,22 +74,28 @@ sub ircparse
# If it's a ping...
if ($ex[0] eq 'PING') {
# send a PONG.
Auto::socksnd($svr, "PONG ".$ex[1]);
Auto::socksnd($svr, "PONG $ex[1]");
}
# If it's AUTHENTICATE
elsif ($ex[0] eq 'AUTHENTICATE') {
if (API::Std::mod_exists("SASLAuth")) {
if (API::Std::mod_exists('SASLAuth')) {
M::SASLAuth::handle_authenticate($svr, @ex);
}
}
# Check if it's handled by core.
elsif (defined $RAWC{$ex[1]}) {
&{ $RAWC{$ex[1]} }($svr, @ex);
}
else {
# otherwise, check %RAWC for ex[1].
if (defined $RAWC{$ex[1]}) {
&{ $RAWC{$ex[1]} }($svr, @ex);
# otherwise, check for a raw hook.
if (defined $API::Std::RAWHOOKS{$ex[1]}) {
foreach (keys %{$API::Std::RAWHOOKS{$ex[1]}}) {
&{ $API::Std::RAWHOOKS{$ex[1]}{$_} }($svr, @ex);
}
}
}
}
return 1;
}
@@ -85,224 +105,288 @@ sub ircparse
# Parse: Numeric:001
# Successful connection.
sub num001
{
sub num001 {
my ($svr, @ex) = @_;
$got_001{$svr} = 1;
# In case we don't get NICK from the server.
if (defined $botnick{$svr}{newnick}) {
$botnick{$svr}{nick} = $botnick{$svr}{newnick};
delete $botnick{$svr}{newnick};
if (!defined $botinfo{$svr}{nick}) {
$botinfo{$svr}{nick} = $botinfo{$svr}{newnick};
delete $botinfo{$svr}{newnick};
}
# Log.
API::Log::alog "! Successfully connected to $svr as $botinfo{$svr}{nick}";
API::Log::dbug "! Successfully connected to $svr as $botinfo{$svr}{nick}";
# Trigger on_connect.
API::Std::event_run("on_connect", $svr);
API::Std::event_run('on_connect', $svr);
return 1;
}
# Parse: Numeric:004
# Server information.
sub num004 {
my ($svr, @ex) = @_;
# Log server name and version.
API::Log::alog "! $svr: $ex[3] running version $ex[4]";
API::Log::dbug "! $svr: $ex[3] running version $ex[4]";
# Trigger on_myinfo.
API::Std::event_run('on_myinfo', ($svr, @ex[3..$#ex]));
return 1;
}
# Parse: Numeric:005
# Prefixes and channel modes.
sub num005
{
# Server ISUPPORT.
sub num005 {
my ($svr, @ex) = @_;
# Find PREFIX and CHANMODES.
foreach my $ex (@ex) {
if ($ex =~ m/^PREFIX/xsm) {
# Found PREFIX.
my $rpx = substr($ex, 8);
my ($pm, $pp) = split('\)', $rpx);
my @apm = split(//, $pm);
my @app = split(//, $pp);
foreach my $ppm (@apm) {
# Store data.
$csprefix{$svr}{$ppm} = shift(@app);
}
}
elsif ($ex =~ m/^CHANMODES/xsm) {
# Found CHANMODES.
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
# List modes.
foreach (split(//, $mtl)) { $chanmodes{$svr}{$_} = 1; }
# Modes with parameter.
foreach (split(//, $mtp)) { $chanmodes{$svr}{$_} = 2; }
# Modes with parameter when +.
foreach (split(//, $mtpp)) { $chanmodes{$svr}{$_} = 3; }
# Modes without parameter.
foreach (split(//, $mts)) { $chanmodes{$svr}{$_} = 4; }
}
}
# Trigger on_isupport.
API::Std::event_run('on_isupport', ($svr, @ex[3..$#ex]));
return 1;
}
# Parse: Numeric:352
# WHO reply.
sub num352 {
my ($svr, @ex) = @_;
# Trigger on_whoreply.
$ex[9] =~ s/^://xsm;
API::Std::event_run('on_whoreply', ($svr, $ex[7], $ex[3], $ex[4], $ex[5], $ex[6], $ex[8], $ex[9], @ex[10..$#ex]));
return 1;
}
# Parse: Numeric:353
# NAMES reply.
sub num353
{
sub num353 {
my ($svr, @ex) = @_;
# Get rid of the colon.
$ex[5] = substr($ex[5], 1);
$ex[5] =~ s/^://xsm;
# Delete the old chanusers hash if it exists.
delete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]});
if (defined $chanusers{$svr}{$ex[4]}) { delete $chanusers{$svr}{$ex[4]} }
# Iterate through each user.
for (my $i = 5; $i < scalar(@ex); $i++) {
for (5..$#ex) {
my $fi = 0;
foreach (keys %{ $csprefix{$svr} }) {
PFITER: foreach my $spfx (keys %{ $csprefix{$svr} }) {
# Check if the user has status in the channel.
if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) {
if (substr($ex[$_], 0, 1) eq $csprefix{$svr}{$spfx}) {
# He/she does. Lets set that.
if (defined $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))}) {
if (defined $chanusers{$svr}{$ex[4]}{lc $ex[$_]}) {
# If the user has multiple statuses.
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} .= $_;
$chanusers{$svr}{$ex[4]}{lc substr $ex[$_], 1} = $chanusers{$svr}{$ex[4]}{lc $ex[$_]}.$spfx;
delete $chanusers{$svr}{$ex[4]}{lc $ex[$_]};
}
else {
# Or not.
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
$chanusers{$svr}{$ex[4]}{lc substr $ex[$_], 1} = $spfx;
}
$fi = 1;
$ex[$_] = substr $ex[$_], 1;
}
}
# Check if there's still a prefix.
foreach my $spfx (keys %{$csprefix{$svr}}) {
if (substr($ex[$_], 0, 1) eq $csprefix{$svr}{$spfx}) { goto 'PFITER' }
}
# They had status, so go to the next user.
next if $fi;
# They didn't, set them as a normal user.
if (!defined $chanusers{$svr}{$ex[4]}{lc($ex[$i])}) {
$chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1;
if (!defined $chanusers{$svr}{$ex[4]}{lc $ex[$_]}) {
$chanusers{$svr}{$ex[4]}{lc $ex[$_]} = 1;
}
}
# Trigger on_namesreply.
API::Std::event_run('on_namesreply', ($svr, $ex[4], @ex[5..$#ex]));
return 1;
}
# Parse: Numeric:396
# Hidden host changed.
sub num396 {
my ($svr, @ex) = @_;
# Update our mask.
$botinfo{$svr}{mask} = $ex[3];
return 1;
}
# Parse: Numeric:432
# Erroneous nickname.
sub num432
{
sub num432 {
my ($svr, undef) = @_;
if ($got_001{$svr}) {
err(3, "Got error from server[".$svr."]: Erroneous nickname.", 0);
err(3, "Got error from server[$svr]: Erroneous nickname.", 0);
}
else {
err(2, "Got error from server[".$svr."] before 001: Erroneous nickname. Closing connection.", 0);
API::IRC::quit($svr, "An error occurred.");
err(2, "Got error from server[$svr] before connection complete: Erroneous nickname. Closing connection.", 0);
API::IRC::quit($svr, 'An error occurred.');
}
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
if (defined $botinfo{$svr}{newnick}) { delete $botinfo{$svr}{newnick} }
return 1;
}
# Parse: Numeric:433
# Nickname is already in use.
sub num433
{
sub num433 {
my ($svr, undef) = @_;
if (defined $botnick{$svr}{newnick}) {
API::IRC::nick($svr, $botnick{$svr}{newnick}."_");
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
if (defined $botinfo{$svr}{newnick}) {
API::IRC::nick($svr, $botinfo{$svr}{newnick}.'_');
}
return 1;
}
# Parse: Numeric:438
# Nick change too fast.
sub num438
{
sub num438 {
my ($svr, @ex) = @_;
if (defined $botnick{$svr}{newnick}) {
API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub {
API::IRC::nick($Parser::IRC::botnick{$svr}{newnick});
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
if (defined $botinfo{$svr}{newnick}) {
API::Std::timer_add('num438_'.$botinfo{$svr}{newnick}, 1, $ex[11], sub {
API::IRC::nick($Proto::IRC::botinfo{$svr}{newnick});
if (defined $botinfo{$svr}{newnick}) { delete $botinfo{$svr}{newnick} }
});
}
return 1;
}
# Parse: Numeric:465
# You're banned creep!
sub num465
{
sub num465 {
my ($svr, undef) = @_;
err(3, "Banned from ".$svr."! Closing link...", 0);
err(3, "Banned from $svr.! Closing link...", 0);
return 1;
}
# Parse: Numeric:471
# Cannot join channel: Channel is full.
sub num471
{
sub num471 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is full.", 0);
err(3, "Cannot join channel $chan on $svr: Channel is full.", 0);
return 1;
}
# Parse: Numeric:473
# Cannot join channel: Channel is invite-only.
sub num473
{
sub num473 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is invite-only.", 0);
err(3, "Cannot join channel $chan on $svr: Channel is invite-only.", 0);
return 1;
}
# Parse: Numeric:474
# Cannot join channel: Banned from channel.
sub num474
{
sub num474 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0);
err(3, "Cannot join channel $chan on $svr: Banned from channel.", 0);
return 1;
}
# Parse: Numeric:475
# Cannot join channel: Bad key.
sub num475
{
sub num475 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0);
err(3, "Cannot join channel $chan on $svr: Bad key.", 0);
return 1;
}
# Parse: Numeric:477
# Cannot join channel: Need registered nickname.
sub num477
{
sub num477 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Need registered nickname.", 0);
err(3, "Cannot join channel $chan on $svr: Need registered nickname.", 0);
return 1;
}
# Parse: CAP
sub cap {
my ($svr, @ex) = @_;
my $capout;
# Iterate ex[3].
given ($ex[3]) {
when ('LS') {
# Get our CAP REQ list.
my @capreq = ();
if ($cap{$svr} =~ m/\s/xsm) { @capreq = split ' ', $cap{$svr} }
else { push @capreq, $cap{$svr} }
# Iterate through what we received from the server.
$ex[4] =~ s/^://xsm;
foreach my $scap (@ex[4..$#ex]) {
# Check if we support this.
foreach my $icap (@capreq) {
if ($icap eq $scap) {
$capout .= " $scap";
}
}
}
# Send CAP REQ/CAP END based on what both we and the server support.
if (!$capout) { Auto::socksnd($svr, 'CAP END'); }
else {
$capout = substr $capout, 1;
Auto::socksnd($svr, "CAP REQ :$capout");
}
}
when ('ACK') {
# Iterate through the ACK arguments.
$ex[4] =~ s/^://xsm;
my $sasl = 0;
foreach (@ex[4..$#ex]) {
if ($_ eq 'sasl') { $sasl++ }
API::Std::event_run('on_capack', ($svr, $_));
}
Auto::socksnd($svr, 'CAP END') unless $sasl;
}
when ('NAK') {
# This should never happen, but just in case...
API::Log::awarn(2, "$svr: CAP failed: Server refused '$capout'");
Auto::socksnd($svr, 'CAP END');
}
}
return 1;
}
# Parse: JOIN
sub cjoin
{
sub cjoin {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
my $chan = $ex[2];
$chan =~ s/^://gxsm;
# Check if this is coming from ourselves.
if ($src{nick} eq $botnick{$svr}{nick}) {
if ($src{nick} eq $botinfo{$svr}{nick}) {
$botchans{$svr}{lc $chan} = 1;
API::Std::event_run("on_ucjoin", ($svr, $chan));
}
@@ -317,10 +401,11 @@ sub cjoin
}
# Parse: KICK
sub kick
{
sub kick {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
$src{svr} = $svr;
# Update chanusers.
delete $chanusers{$svr}{$ex[2]}{$ex[3]} if defined $chanusers{$svr}{$ex[2]}{$ex[3]};
@@ -337,7 +422,7 @@ sub kick
}
# Check if we were the ones kicked.
if (lc($ex[3]) eq lc($botnick{$svr}{nick})) {
if (lc($ex[3]) eq lc($botinfo{$svr}{nick})) {
# We were kicked!
# Delete channel from botchans.
@@ -356,21 +441,23 @@ sub kick
else {
# We weren't. Update chanusers and trigger on_kick.
if (defined $chanusers{$svr}{$ex[2]}{$ex[3]}) { delete $chanusers{$svr}{$ex[2]}{$ex[3]}; }
API::Std::event_run("on_kick", ($svr, \%src, $ex[2], $ex[3], $msg));
API::Std::event_run("on_kick", (\%src, $ex[2], $ex[3], $msg));
}
return 1;
}
# Parse: MODE
sub mode
{
sub mode {
my ($svr, @ex) = @_;
if ($ex[2] ne $botnick{$svr}{nick}) {
if ($ex[2] ne $botinfo{$svr}{nick}) {
# Set data we'll need later.
my $chan = $ex[2];
$ex[3] =~ s/^://xsm;
my $modes = $ex[3];
my $fmodes = join ' ', @ex[3..$#ex];
$modes =~ s/^://xsm;
# Get rid of the useless data, so the mode parser will work smoothly.
shift @ex; shift @ex; shift @ex; shift @ex;
@@ -446,24 +533,30 @@ sub mode
}
}
}
# Trigger on_cmode.
API::Std::event_run('on_cmode', ($svr, $chan, $fmodes));
}
else {
# User mode change; trigger on_umode.
$ex[3] =~ s/^://xsm;
API::Std::event_run('on_umode', ($svr, @ex[3..$#ex]));
}
return 1;
}
# Parse: NICK
sub nick
{
sub nick {
my ($svr, ($uex, undef, $nex)) = @_;
$nex = substr($nex, 1);
$nex =~ s/^://gxsm;
my %src = API::IRC::usrc(substr($uex, 1));
$src{svr} = $svr;
# Check if this is coming from ourselves.
if ($src{nick} eq $botnick{$svr}{nick}) {
if ($src{nick} eq $botinfo{$svr}{nick}) {
# It is. Update bot nick hash.
$botnick{$svr}{nick} = $nex;
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
$botinfo{$svr}{nick} = $nex;
delete $botinfo{$svr}{newnick} if (defined $botinfo{$svr}{newnick});
}
else {
# It isn't. Update chanusers and trigger on_nick.
@@ -473,15 +566,14 @@ sub nick
delete $chanusers{$svr}{$chk}{$src{nick}};
}
}
API::Std::event_run("on_nick", ($svr, \%src, $nex));
API::Std::event_run("on_nick", (\%src, $nex));
}
return 1;
}
# Parse: NOTICE
sub notice
{
sub notice {
my ($svr, @ex) = @_;
# Ensure this is coming from a user rather than a server.
@@ -501,34 +593,43 @@ sub notice
}
# Parse: PART
sub part
{
sub part {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
# Delete them from chanusers.
delete $chanusers{$svr}{$ex[2]}{$src{nick}} if defined $chanusers{$svr}{$ex[2]}{$src{nick}};
my %src = API::IRC::usrc(substr($ex[0], 1));
$src{svr} = $svr;
# Set $msg to the part message.
my $msg = 0;
if (defined $ex[3]) {
$msg = substr($ex[3], 1);
if (defined $ex[4]) {
for (my $i = 4; $i < scalar(@ex); $i++) {
$msg .= " ".$ex[$i];
# Check if it's from us or someone else.
if ($src{nick} eq $botinfo{$svr}{nick}) {
# Delete this channel from botchans.
if ($botchans{$svr}{$ex[2]}) { delete $botchans{$svr}{$ex[2]}; }
# Trigger on_upart.
API::Std::event_run('on_upart', ($svr, $ex[2]));
}
else {
# Delete them from chanusers.
delete $chanusers{$svr}{$ex[2]}{$src{nick}} if defined $chanusers{$svr}{$ex[2]}{$src{nick}};
# Set $msg to the part message.
my $msg = 0;
if (defined $ex[3]) {
$msg = substr($ex[3], 1);
if (defined $ex[4]) {
for (my $i = 4; $i < scalar(@ex); $i++) {
$msg .= " ".$ex[$i];
}
}
}
}
# Trigger on_part.
API::Std::event_run("on_part", ($svr, \%src, $ex[2], $msg));
# Trigger on_part.
API::Std::event_run("on_part", (\%src, $ex[2], $msg));
}
return 1;
}
# Parse: PRIVMSG
sub privmsg
{
sub privmsg {
my ($svr, @ex) = @_;
my %data = API::IRC::usrc(substr($ex[0], 1));
@@ -543,7 +644,7 @@ sub privmsg
my ($cmd, $cprefix, $rprefix);
# Check if it's to a channel or to us.
if (lc($ex[2]) eq lc($botnick{$svr}{nick})) {
if (lc($ex[2]) eq lc($botinfo{$svr}{nick})) {
# It is coming to us in a private message.
# Ensure it's a valid length.
@@ -655,10 +756,11 @@ sub privmsg
}
# Parse: QUIT
sub quit
{
sub quit {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
$src{svr} = $svr;
# Set $msg to the quit message.
my $msg = 0;
@@ -672,33 +774,25 @@ sub quit
}
# Trigger on_quit.
API::Std::event_run("on_quit", ($svr, \%src, $msg));
API::Std::event_run("on_quit", (\%src, $msg));
return 1;
}
# Parse: TOPIC
sub topic
{
sub topic {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
$src{svr} = $svr;
$src{chan} = $ex[2];
$ex[3] = substr $ex[3], 1;
# Ignore it if it's coming from us.
if (lc($src{nick}) ne lc($botnick{$svr}{nick})) {
$src{chan} = $ex[2];
my (@argv);
$argv[0] = substr($ex[3], 1);
if (defined $ex[4]) {
for (my $i = 4; $i < scalar(@ex); $i++) {
push(@argv, $ex[$i]);
}
}
API::Std::event_run("on_topic", ($svr, \%src, @argv));
}
# Trigger on_topic.
API::Std::event_run('on_topic', (\%src, @ex[3..$#ex]));
return 1;
}
1;
# vim: set ai sw=4 ts=4:
# vim: set ai et sw=4 ts=4:
+4 -3
View File
@@ -70,8 +70,7 @@ sub actonbadword
}
API::Std::mod_init('Badwords', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('Badwords', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
@@ -122,6 +121,8 @@ Changing the obvious to your wish.
=over
This module is compatible with Auto version 3.0.0a4+.
This module is compatible with Auto version 3.0.0a7+.
=back
# vim: set ai et sw=4 ts=4:
+4 -3
View File
@@ -118,8 +118,7 @@ sub reverse
# Start initialization.
API::Std::mod_init('Bitly', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('Bitly', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: cpan=LWP::UserAgent,URI::Escape perl=5.010000
__END__
@@ -179,6 +178,8 @@ Add Bitly to module auto-load and the following to your configuration file:
This module adds extra dependencies: LWP::UserAgent and URI::Escape. You can
get it from the CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+.
This module is compatible with Auto version 3.0.0a7+.
=back
# vim: set ai et sw=4 ts=4:
+116
View File
@@ -0,0 +1,116 @@
# Module: BotStats. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::BotStats;
use strict;
use warnings;
use English qw(-no_match_vars);
use API::Std qw(cmd_add cmd_del);
use API::IRC qw(privmsg);
# Initialization subroutine.
sub _init {
# Create the STATS command.
cmd_add('STATS', 2, 0, \%M::BotStats::HELP_STATS, \&M::BotStats::stats) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void {
# Delete the STATS command.
cmd_del('STATS') or return;
# Success.
return 1;
}
# Help hash for STATS. Spanish, German and French translations needed.
our %HELP_STATS = (
'en' => "This command will return information about the bot (uptime, version, etc.). \2Syntax:\2 STATS",
);
# Callback for STATS command.
sub stats {
my ($src, undef) = @_;
# Check if this was private or public.
my $target;
if ($src->{chan}) {
$target = $src->{chan};
}
else {
$target = $src->{nick};
}
# Get uptime data.
my $uptime = time - $Auto::STARTTIME;
my $days = my $hours = my $mins = my $secs = 0;
while ($uptime >= 86_400) { $days++; $uptime -= 86_400; }
while ($uptime >= 3_600) { $hours++; $uptime -= 3_600; }
while ($uptime >= 60) { $mins++; $uptime -= 60; }
while ($uptime >= 1) { $secs++; $uptime--; }
# Return it.
privmsg($src->{svr}, $target, "I have been running for \2$days\2 days, \2$hours\2 hours, \2$mins\2 minutes, and \2$secs\2 seconds.");
# Return version data.
privmsg($src->{svr}, $target, 'I am running '.Auto::NAME.' (version '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.") for Perl $PERL_VERSION on $OSNAME.");
# Get network and channel data.
my $nets = keys %Auto::SOCKET;
my $chans;
foreach my $net (keys %Auto::SOCKET) {
foreach (keys %{$Proto::IRC::botchans{$net}}) { $chans++; }
}
# Return network/channel data.
privmsg($src->{svr}, $target, "I am on \2$chans\2 channels across \2$nets\2 networks.");
return 1;
}
API::Std::mod_init('BotStats', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
=head1 NAME
BotStats - General information about the bot
=head1 VERSION
1.00
=head1 SYNOPSIS
<starcoder> !stats
<blue> I have been running for 0 days, 0 hours, 1 minutes, and 5 seconds.
<blue> I am running Auto IRC Bot (version 3.0.0a7) for Perl v5.12.3 on linux.
<blue> I am on 2 channels, across 1 networks.
=head1 DESCRIPTION
This module creates the STATS command, for returning general information about
the bot such as uptime, version, etc.
This module is compatible with Auto v3.0.0a7+.
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
This module is released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+4 -3
View File
@@ -78,8 +78,7 @@ sub calc
}
# Start initialization.
API::Std::mod_init('Calc', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('Calc', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: cpan=LWP::UserAgent,URI::Escape,JSON,JSON::PP perl=5.010000
__END__
@@ -119,6 +118,8 @@ Google Calculator.
This module requires LWP::UserAgent, URI::Escape and JSON/JSON::PP.
All are obtainable from the CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+.
This module is compatible with Auto version 3.0.0a7+.
=back
# vim: set ai et sw=4 ts=4:
+4 -3
View File
@@ -282,8 +282,7 @@ sub _getdata
}
API::Std::mod_init('ChanTopics', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('ChanTopics', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
@@ -338,8 +337,10 @@ This module adds no extra dependencies.
This module is not compatible with PostgreSQL, yet.
This module is compatible with Auto v3.0.0a4+.
This module is compatible with Auto v3.0.0a7+.
Ported from v1.0.
=back
# vim: set ai et sw=4 ts=4:
+4 -3
View File
@@ -75,8 +75,7 @@ sub cmd_dict
# Start initialization.
API::Std::mod_init('Dictionary', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('Dictionary', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: cpan=Net::Dict perl=5.010000
__END__
@@ -99,6 +98,8 @@ DICT command.
This module adds an extra dependency: Net::Dict. You can get it from the CPAN
<http://www.cpan.org>.
This module is compatible with Auto v3.0.0a4+.
This module is compatible with Auto v3.0.0a7+.
=back
# vim: set ai et sw=4 ts=4:
+28 -29
View File
@@ -99,52 +99,51 @@ sub rigball
# Start initialization.
API::Std::mod_init('EightBall', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('EightBall', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
=head1 EightBall
=head1 NAME
=head2 Description
Eightball - A magic eightball module.
=over
=head1 VERSION
1.00
=head1 SYNOPSIS
<JohnSmith> !8ball Will I be rich?
<Auto> Question: Will I be rich?
<Auto> Answer: Heck no!
>Auto< rigball Of course!
<JohnSmith> !8ball Will I be famous?
<Auto> Question: Will I be famous?
<Auto> Answer: Of course!
=head1 DESCRIPTION
This module adds the 8BALL and RIGBALL commands, 8BALL is a channel
command for asking the magic 8-Ball a question, RIGBALL is a private
command for setting ("rigging") the 8-Ball's next answer.
=back
=head1 INSTALL
=head2 Examples
No additonal steps need to be taking to use this module.
=over
=head1 AUTHOR
<JohnSmith> !8ball Will I be rich?
<Auto> Question: Will I be rich?
<Auto> Answer: Heck no!
>Auto< rigball Of course!
<JohnSmith> !8ball Will I be famous?
<Auto> Question: Will I be famous?
<Auto> Answer: Of course!
This module was written by Elijah Perrault.
=back
This module is maintained by Xelhua Development Group.
=head2 To Do
=head1 LICENSE AND COPYRIGHT
=over
This module is Copyright 2010-2011 Xelhua Development Group.
* Add Spanish, French and German translations for the help hashes.
Released under the same licensing terms as Auto itself.
=back
=cut
=head2 Technical
=over
This module is compatible with Auto version 3.0.0a4+.
Ported from Auto 1.0.
=back
# vim: set ai et sw=4 ts=4:
+107
View File
@@ -0,0 +1,107 @@
# Module: Eval. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::Eval;
use strict;
use warnings;
use English qw(-no_match_vars);
use API::Std qw(cmd_add cmd_del trans);
use API::IRC qw(privmsg notice);
# Initialization subroutine.
sub _init {
# Create the EVAL command.
cmd_add('EVAL', 2, 'cmd.eval', \%M::Eval::HELP_EVAL, \&M::Eval::cmd_eval) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void {
# Delete the EVAL command.
cmd_del('EVAL') or return;
# Success.
return 1;
}
# Help hash for EVAL command. Spanish, German and French translations are needed.
our %HELP_EVAL = (
'en' => "This command allows you to eval Perl code. USE WITH CAUTION. \2Syntax:\2 EVAL <expression>",
);
# Callback for EVAL command.
sub cmd_eval {
my ($src, @argv) = @_;
# Check for needed parameter.
if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return;
}
# Evaluate the expression and return the result.
my $expr = join ' ', @argv;
my $result = eval($expr);
if (!defined $result) { $result = 'None'; }
if ($EVAL_ERROR) {
$result = $EVAL_ERROR;
$result =~ s/(\r|\n)//gxsm;
}
# Return the result.
if (!defined $src->{chan}) {
notice($src->{svr}, $src->{nick}, "Output: $result");
}
else {
privmsg($src->{svr}, $src->{chan}, "$src->{nick}: $result");
}
return 1;
}
# Start initialization.
API::Std::mod_init('Eval', 'Xelhua', '1.01', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
=head1 NAME
Eval - Allows you to evaluate Perl code from IRC
=head1 VERSION
1.01
=head1 SYNOPSIS
>blue< eval 1;
-blue- Output: 1
=head1 DESCRIPTION
This module adds the EVAL command which allows you to evaluate Perl code from
IRC, returning the output via notice.
This command requires the cmd.eval privilege.
This module is compatible with Auto v3.0.0a7+.
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
This module is released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+4 -3
View File
@@ -67,8 +67,7 @@ sub fml
}
# Start initialization.
API::Std::mod_init('FML', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('FML', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: cpan=LWP::UserAgent perl=5.010000
__END__
@@ -110,8 +109,10 @@ have my hand back?" FML
This module adds an extra dependency: LWP::UserAgent. You can get it from
the CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+.
This module is compatible with Auto version 3.0.0a7+.
Ported from Auto 2.0.
=back
# vim: set ai et sw=4 ts=4:
+4 -3
View File
@@ -125,8 +125,7 @@ sub hook_rcjoin
}
# Start initialization.
API::Std::mod_init('Greet', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('Greet', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
@@ -154,6 +153,8 @@ user that has a greet in the database joins a channel the bot is in.
=over
This module is compatible with Auto version 3.0.0a4+.
This module is compatible with Auto version 3.0.0a7+.
=back
# vim: set ai et sw=4 ts=4:
+35 -6
View File
@@ -36,16 +36,45 @@ sub hello
# Start initialization.
API::Std::mod_init('HelloChan', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('HelloChan', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
=head1 HelloChan
=head1 NAME
=over
HelloChan - An example module. Also, cows go moo.
This is an example module. Also, cows go moo.
=head1 VERSION
=back
1.00
=head1 SYNOPSIS
* Auto has joined #moocows
<Auto> Hello channel! I am a bot!
=head1 DESCRIPTION
This module sends "Hello channel! I am a bot!" whenever it
joins a channel.
=head1 INSTALL
No additonal steps need to be taking to use this module.
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
Released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+4 -3
View File
@@ -69,8 +69,7 @@ sub check
}
# Start initialization.
API::Std::mod_init('IsItUp', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('IsItUp', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: cpan=LWP::UserAgent perl=5.010000
__END__
@@ -110,6 +109,8 @@ appears up or down to Auto.
This module requires LWP::UserAgent. You can get it from
the CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+.
This module is compatible with Auto version 3.0.0a7+.
=back
# vim: set ai et sw=4 ts=4:
+5 -2
View File
@@ -66,8 +66,7 @@ sub gettitle
}
# Start initialization.
API::Std::mod_init('LinkTitle', 'Xelhua', '1.00', '3.0.0a5', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('LinkTitle', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: cpan=LWP::UserAgent,HTML::Entities perl=5.010000
__END__
@@ -120,3 +119,7 @@ This module is Copyright 2010-2011 Xelhua Development Group. All rights
reserved.
This module is released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+119
View File
@@ -0,0 +1,119 @@
# Module: Oper.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::Oper;
use strict;
use warnings;
use API::Std qw(hook_add hook_del rchook_add rchook_del conf_get);
use API::Log qw(alog);
# Initialization subroutine.
sub _init
{
# Add a hook for when we join a channel.
hook_add("on_connect", "Oper.onconnect", \&M::Oper::on_connect) or return 0;
# Add a hook for when we get numeric 491 (ERR_NOOPERHOST)
rchook_add("491", "Oper.on381", \&M::Oper::on_num491) or return 0;
return 1;
}
# Void subroutine.
sub _void
{
# Delete the hooks.
hook_del("on_connect", "Oper.onconnect") or return 0;
rchook_del("381", "Oper.on381") or return 0;
rchook_del("313", "Oper.on313") or return 0;
rchook_del("491", "Oper.on491") or return 0;
return 1;
}
# On connect subroutine.
sub on_connect
{
my ($svr) = @_;
# Get the configuration values.
my $u = (conf_get("server:$svr:oper_username"))[0][0] if conf_get("server:$svr:oper_username");
my $p = (conf_get("server:$svr:oper_password"))[0][0] if conf_get("server:$svr:oper_password");
# They don't exist - don't continue.
return if !$u or !$p;
# Send the OPER command.
oper($svr, $u, $p);
return 1;
}
# On 491 subroutine
sub on_num491 {
my ($svr, @ex) = @_;
my $reason = join ' ', @ex[3 .. $#ex];
$reason =~ s/://xsm;
alog("FAILED OPER on ".$svr.": ".$reason);
return 1;
}
# A subroutine to check if we are opered on a server
sub is_opered {
my ($svr) = @_;
# Auto is not opered.
return 0 if $Proto::IRC::botinfo{$svr}{modes} !~ m/o/xsm;
# Auto is opered.
return 1 if $Proto::IRC::botinfo{$svr}{modes} =~ m/o/xsm;
return;
}
# Start of the API
# Sends the OPER command to the specified server.
sub oper {
my ($svr, $user, $pass) = @_;
Auto::socksnd($svr, "OPER $user $pass");
return 1;
}
# Start initialization.
API::Std::mod_init('Oper', 'Xelhua', '1.01', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
=head1 NAME
Oper - Auto oper-on-connect module.
=head1 VERSION
1.01
=head1 SYNOPSIS
No commands are currently associated with Oper.
=head1 DESCRIPTION
This module adds the ability for Auto to oper on networks he is
configured to do so on.
=head1 INSTALL
Before using Oper, add the following to the server block in your
configuration file, only for servers you wish for Auto to oper on
though:
oper_username <username>;
oper_password <password>;
=head1 AUTHOR
This module was written by Matthew Barksdale.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
Released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+3 -2
View File
@@ -211,8 +211,7 @@ sub cmd_qdb
}
API::Std::mod_init('QDB', 'Xelhua', '1.02', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('QDB', 'Xelhua', '1.02', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
@@ -260,3 +259,5 @@ This module is Copyright 2010-2011 Xelhua Development Group.
Released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+32 -50
View File
@@ -14,18 +14,20 @@ use API::IRC qw(privmsg);
sub _init
{
# Check if this Auto was built with SASL support.
err(2, "Auto was not built with SASL support. Aborting SASLAuth.", 0) and return 0 if $Auto::ENFEAT !~ /sasl/;
# Add a hook for before we connect.
hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); }
) or return 0;
# Hook for parsing CAP.
rchook_add('CAP', \&M::SASLAuth::handle_cap) or return 0;
if ($Auto::ENFEAT !~ m/sasl/xsm) { err(2, 'Auto was not built with SASL support. Aborting SASLAuth.', 0) and return; }
# Add sasl to supported CAP for servers configured with SASL.
my %servers = conf_get('server');
foreach my $svr (keys %servers) {
if (conf_get("server:$svr:sasl_username") and conf_get("server:$svr:sasl_password") and conf_get("server:$svr:sasl_timeout")) { $Proto::IRC::cap{$svr} .= ' sasl'; }
}
# Hook for when CAP ACK sasl is received.
hook_add('on_capack', 'sasl.cap', \&M::SASLAuth::handle_capack) or return;
# Hook for parsing 903.
rchook_add('903', \&M::SASLAuth::handle_903) or return 0;
rchook_add('903', 'sasl.903', \&M::SASLAuth::handle_903) or return;
# Hook for parsing 904.
rchook_add('904', \&M::SASLAuth::handle_904) or return 0;
rchook_add('904', 'sasl.904', \&M::SASLAuth::handle_904) or return;
# Hook for parsing 906.
rchook_add('906', \&M::SASLAuth::handle_906) or return 0;
rchook_add('906', 'sasl.906', \&M::SASLAuth::handle_906) or return;
return 1;
}
@@ -33,42 +35,21 @@ sub _init
sub _void
{
# Delete the hooks.
hook_del("on_preconnect", "CAP") or return 0;
rchook_del('CAP');
rchook_del('903');
rchook_del('904');
rchook_del('906');
hook_del('on_capack') or return;
rchook_del('903', 'sasl.903') or return;
rchook_del('904', 'sasl.904') or return;
rchook_del('906', 'sasl.906') or return;
return 1;
}
sub handle_cap {
my ($srv, @parv) = @_;
my $line = join(' ',@parv);
my ($tosend);
given ($line) {
when (/ LS /) {
$tosend .= 'multi-prefix ' if $line =~ /multi-prefix/i;
$tosend .= 'sasl ' if $line =~ /sasl/ and conf_get("server:$srv:sasl_username");
awarn(2, "SASL is unavailable on this server.") if $tosend !~ /sasl/;
if ($tosend eq '') { Auto::socksnd($srv, 'CAP END') }
else { Auto::socksnd($srv, "CAP REQ :$tosend"); }
}
when (/ ACK /) {
if ( $line =~ /sasl/) {
Auto::socksnd($srv, 'AUTHENTICATE PLAIN');
timer_add('auth_timeout', 1, (conf_get("server:$srv:sasl_timeout"))[0][0], sub { Auto::socksnd($srv, 'CAP END'); });
}
else {
Auto::socksnd($srv, 'CAP END');
awarn(2, "SASL authentication failed at ACK");
}
}
when (/ NAK /) {
Auto::socksnd($srv, 'CAP END');
awarn(2, "SASL authentication failed. Server refused ".$tosend);
}
sub handle_capack {
my (($svr, $sacap)) = @_;
if ($sacap eq 'sasl') {
Auto::socksnd($svr, 'AUTHENTICATE PLAIN');
timer_add('auth_timeout_'.$svr, 1, (conf_get("server:$svr:sasl_timeout"))[0][0], sub { Auto::socksnd($svr, 'CAP END'); });
}
return 1;
}
@@ -105,8 +86,8 @@ sub handle_authenticate
sub handle_903
{
my ($srv, undef) = @_;
Auto::socksnd($srv, 'CAP END');
timer_del('auth_timeout');
timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
timer_del('auth_timeout_'.$srv);
}
# Parse: Numeric:904
@@ -114,8 +95,8 @@ sub handle_903
sub handle_904
{
my ($srv, undef) = @_;
Auto::socksnd($srv, 'CAP END');
timer_del('auth_timeout');
timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
timer_del('auth_timeout_'.$srv);
awarn(2, "SASL authentication failed!");
}
@@ -124,14 +105,13 @@ sub handle_904
sub handle_906
{
my ($svr, undef) = @_;
Auto::socksnd($svr, 'CAP END');
timer_del('auth_timeout');
timer_add('cap_end_'.$svr, 1, 2, sub { Auto::socksnd($svr, 'CAP END') });
timer_del('auth_timeout_'.$svr);
awarn(2, "SASL authentication aborted!");
}
# Start initialization.
API::Std::mod_init('SASLAuth', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('SASLAuth', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: perl=5.010000
__END__
@@ -188,6 +168,8 @@ block(s) you wish to use SASL with:
This adds an extra dependency: You must build Auto with the
--enable-sasl option.
This module is compatible with Auto v3.0.0a4+.
This module is compatible with Auto v3.0.0a7+.
=back
# vim: set ai et sw=4 ts=4:
+1457
View File
File diff suppressed because it is too large. Load diff
+4 -3
View File
@@ -78,8 +78,7 @@ sub weather
}
# Start initialization.
API::Std::mod_init('Weather', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
# vim: set ai sw=4 ts=4:
API::Std::mod_init('Weather', 'Xelhua', '1.00', '3.0.0a7', __PACKAGE__);
# build: cpan=LWP::UserAgent,XML::Simple perl=5.010000
__END__
@@ -121,6 +120,8 @@ From the NE at 9 MPH Gusting to 22 MPH Conditions: Overcast
This module requires LWP::UserAgent and XML::Simple. Both are
obtainable from CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+.
This module is compatible with Auto version 3.0.0a7+.
=back
# vim: set ai et sw=4 ts=4:
+70
View File
@@ -0,0 +1,70 @@
# OSI-approved software licenses as of February 26, 2011.
my %licenses = (
auto => 'Same license as Auto itself',
afl => 'Academic Free License',
agpl => 'Affero GNU Public License',
apl => 'Adaptive Public License',
apache => 'Apache License',
apsl => 'Apple Public Source License',
art => 'Artistic License',
aal => 'Attribution Assurance License',
nbsd => 'New BSD License',
sbsd => 'Simplified BSD License',
bsl => 'Boost Software License',
catosl => 'Computer Associates Trusted Open Source License',
cddl => 'Common Development and Distribution License',
cpal => 'Common Public Attribution License',
cua => 'CUA Office Public License',
eudgsl => 'EU DataGrid Software License',
epl => 'Eclipse Public License',
ecl => 'Educational Community License',
efl => 'Eiffel Forum License',
enpl => 'Entessa Public License',
eupl => 'European Union Public License',
fair => 'Fair License',
fwl => 'Frameworx License',
gpl2 => 'GNU General Public License v2',
gpl3 => 'GNU General Public License v3',
lgpl => 'GNU Lesser General Public License',
ibm => 'IBM Public License',
ipa => 'IPA Font License',
isc => 'ISC License',
lppl => 'LaTeX Project Public License',
lpl => 'Lucent Public License',
miros => 'MirOS Licence',
mspl => 'Microsoft Public License',
msrl => 'Microsoft Reciprocal License',
mit => 'MIT License',
msl => 'Motosoto License',
mpl => 'Mozilla Public License',
mtl => 'Multics License',
nasa => 'NASA Open Source Agreement',
ntpl => 'NTP License',
naumen => 'Naumen Public License',
nhgpl => 'Nethack General Public License',
nosl => 'Nokia Open Source License',
nposl => 'Non-Profit Open Software License',
oclc => 'OCLC Research Public License',
ofl => 'Open Font License',
ogtsl => 'Open Group Test Suite License',
osl => 'Open Software License',
php => 'PHP License',
pgsql => 'The PostgreSQL License',
python => 'Python License',
pysfl => 'Python Software Foundation License',
qpl => 'Qt Public License',
real => 'RealNetworks Public Source License',
rpl => 'Reciprocal Public License',
rscpl => 'Ricoh Source Code Public License',
simple => 'Simple Public License',
scl => 'Sleepycat License',
spl => 'Sun Public License',
sowpl => 'Sybase Open Watcom Public License',
ncsa => 'University of Illinois/NCSA Open Source License',
vsl => 'Vovida Software License',
w3c => 'W3C License',
wxwll => 'wxWindows Library License',
xnet => 'X.Net License',
zpl => 'Zope Public License',
zlib => 'zlib/libpng license'
);