Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
af92eed006 | ||
|
|
f904d3e991 | ||
|
|
f51e695a2a | ||
|
|
e65f5d6f0a | ||
|
|
b48e77a4b3 | ||
|
|
bfa0baf51e | ||
|
|
c5f8a31bd0 | ||
|
|
66cc08fd87 | ||
|
|
b0fc9065f5 | ||
|
|
ec363be888 | ||
|
|
eda22e02db | ||
|
|
8d5664c7ef | ||
|
|
7e8ba692f7 | ||
|
|
3e418271c7 | ||
|
|
c3b3c56322 | ||
|
|
f7b5428c60 | ||
|
|
ef75910c0e | ||
|
|
6d0efb08f7 | ||
|
|
3ca1685044 | ||
|
|
aa1302c1bb | ||
|
|
14334122bc | ||
|
|
c88c8f66f3 | ||
|
|
0ba0d8e030 | ||
|
|
db3f388006 | ||
|
|
5b8568f811 | ||
|
|
d33d47afd2 | ||
|
|
5c517b8093 | ||
|
|
58063f147d | ||
|
|
8f5da92a45 | ||
|
|
88e8930aff | ||
|
|
2e7ab78f7e | ||
|
|
a8b8256385 | ||
|
|
501dd30a0b | ||
|
|
8512ea129a | ||
|
|
9c8200fb78 | ||
|
|
d5378cca9f | ||
|
|
06aaf41ef0 | ||
|
|
402dfade65 | ||
|
|
217fdbd1e7 | ||
|
|
a895a77418 | ||
|
|
91185e5ec3 | ||
|
|
989d52b7f7 | ||
|
|
b25ec915b9 | ||
|
|
064f1099e3 | ||
|
|
b7d6da07b0 | ||
|
|
f481f9d4e7 | ||
|
|
fdb4093ad6 | ||
|
|
0bbcdd7f4b | ||
|
|
71056bc2ed | ||
|
|
88cdde59ce | ||
|
|
910c1afb86 | ||
|
|
39ce9b2da4 | ||
|
|
cae3f191a8 | ||
|
|
47605fd33e | ||
|
|
4de600d91a | ||
|
|
7902aba4c5 | ||
|
|
f3f58c8f94 | ||
|
|
c616931339 | ||
|
|
92c9a64793 | ||
|
|
cc1c8fd5bc | ||
|
|
ad799a32a2 | ||
|
|
35f58bf5b7 | ||
|
|
9ad245fc79 | ||
|
|
f9cafa11e7 | ||
|
|
6a7cf754cc | ||
|
|
24ab4aaf9a | ||
|
|
9ff384866e | ||
|
|
4eb157ad8e | ||
|
|
bec120c70f | ||
|
|
8898e74341 | ||
|
|
18a8752e28 | ||
|
|
27521072c5 | ||
|
|
01cc71d564 | ||
|
|
634a68b5f2 | ||
|
|
c330a59474 | ||
|
|
be43449e74 | ||
|
|
445b7e0db3 | ||
|
|
30d9e11f1f | ||
|
|
66c4b3441a | ||
|
|
ba6f7dba40 | ||
|
|
5f74bb3171 | ||
|
|
15f188edfb | ||
|
|
6e0263bcd8 | ||
|
|
411e08fd1c | ||
|
|
e93939d4cf | ||
|
|
88d7799569 | ||
|
|
234c8d1657 | ||
|
|
11dae6b927 | ||
|
|
897ad85615 | ||
|
|
96384f853a | ||
|
|
c5e0853cb1 |
No files matched your search
+2
-1
@@ -1,3 +1,4 @@
|
||||
*.conf
|
||||
auto.conf
|
||||
build/*
|
||||
*.swp
|
||||
autodoc/*
|
||||
@@ -11,32 +11,26 @@
|
||||
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 alpha4 release, we have added:
|
||||
In this alpha6 release, we have added:
|
||||
|
||||
* MySQL support.
|
||||
* PostgreSQL support.
|
||||
* A Greet module for greeting users on join.
|
||||
* IRC logchan functionality.
|
||||
* Improved multilingual support.
|
||||
* A ChanTopics module for advanced management of channel topics.
|
||||
* buildmod now generates HTML and man(1) pages from a module's POD.
|
||||
* server:ajoin now supports channel keys by spacing the name and key.
|
||||
* A Dictionary module for looking up definitions of words.
|
||||
* Heavily improved module API.
|
||||
* Support for Microsoft Windows. See doc/WINDOWS if running on Windows.
|
||||
* Added an UNO module for playing the classic game of UNO.
|
||||
* Added an Eval module for evaluating Perl code.
|
||||
* Added a BotStats module for returning statistics about the bot.
|
||||
* PRIVMSG's and NOTICE's that would create a resulting message of >512 bytes are
|
||||
now divided into multiple messages.
|
||||
|
||||
Bug fixes:
|
||||
|
||||
* Commands getting Permission denied even with incorrect prefix.
|
||||
* Program not properly shutting down if all IRC connections close.
|
||||
* Fixed a bug that occurs when our configured nickname is in use.
|
||||
* Fixed a bug with multi-prefix support.
|
||||
* Fixed a bug with SASL timeouts.
|
||||
|
||||
Incompatibilities:
|
||||
|
||||
* Database: Changed structure of the `qdb` table. Modify the configuration
|
||||
values in upgrade.pl then run it to upgrade the database.
|
||||
* database:format is now required in the config.
|
||||
* bantype is now required in the config.
|
||||
* Module API changes. Minimum version is now 3.0.0a6 from 3.0.0a4.
|
||||
|
||||
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.
|
||||
@@ -44,4 +38,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 4!
|
||||
Enjoy Auto 3.0.0 Alpha 6!
|
||||
@@ -5,53 +5,49 @@
|
||||
# Written in sh because the user may not have Perl...to run Auto....
|
||||
|
||||
PID=bin/auto.pid
|
||||
MODS="Mouse Class::Unload"
|
||||
EMODS="MIME::Base64 XML::Simple"
|
||||
MODS="Class::Unload DBI"
|
||||
|
||||
if [ "$1" = "start" ] ; then
|
||||
if [ -e $PID ]; then
|
||||
if [ "$2" = "force" ]; then
|
||||
echo "Starting Auto. . ."
|
||||
bin/auto
|
||||
sleep 2
|
||||
if [ ! -r $PID ]; then
|
||||
echo "Possible failed startup... check Auto logs for more information."
|
||||
fi
|
||||
if [ -e $PID ]; then
|
||||
if [ "$2" = "force" ]; then
|
||||
echo "Starting Auto. . ."
|
||||
bin/auto
|
||||
sleep 2
|
||||
if [ ! -r $PID ]; then
|
||||
echo "Possible failed startup... check Auto logs for more information."
|
||||
fi
|
||||
else
|
||||
echo "Auto appears to be running already. Run ./auto start force to start anyway."
|
||||
fi
|
||||
else
|
||||
echo "Starting Auto. . ."
|
||||
bin/auto
|
||||
sleep 2
|
||||
if [ ! -r $PID ]; then
|
||||
echo "Possible failed startup... check Auto logs for more information"
|
||||
fi
|
||||
fi
|
||||
else
|
||||
echo "Starting Auto. . ."
|
||||
bin/auto
|
||||
sleep 2
|
||||
if [ ! -r $PID ]; then
|
||||
echo "Possible failed startup... check Auto logs for more information"
|
||||
fi
|
||||
fi
|
||||
|
||||
elif [ "$1" = "stop" ]; then
|
||||
echo "Stopping Auto. . ."
|
||||
kill -TERM `cat $PID`
|
||||
echo "Stopping Auto. . ."
|
||||
kill -TERM `cat $PID`
|
||||
|
||||
elif [ "$1" = "rehash" ]; then
|
||||
echo "Rehashing Auto. . ."
|
||||
kill -HUP `cat $PID`
|
||||
echo "Rehashing Auto. . ."
|
||||
kill -HUP `cat $PID`
|
||||
|
||||
elif [ "$1" = "status" ]; then
|
||||
if [ -e $PID ]; then
|
||||
echo "Status: Auto appears to be running."
|
||||
else
|
||||
echo "Status: Auto appears to not be running."
|
||||
fi
|
||||
if [ -e $PID ]; then
|
||||
echo "Status: Auto appears to be running."
|
||||
else
|
||||
echo "Status: Auto appears to not be running."
|
||||
fi
|
||||
|
||||
elif [ "$1" = "getmodules" ]; then
|
||||
cpan -i $MODS
|
||||
|
||||
elif [ "$1" = "getextras" ]; then
|
||||
cpan -i $EMODS
|
||||
cpan -i $MODS
|
||||
|
||||
else
|
||||
echo "Usage: auto (start|stop|rehash|status|getmodules|getextras)"
|
||||
echo "Usage: auto (start|stop|rehash|status|getmodules)"
|
||||
fi
|
||||
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
@@ -21,23 +21,26 @@ 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',
|
||||
VER => 3,
|
||||
SVER => 0,
|
||||
REV => 0,
|
||||
RSTAGE => 'd',
|
||||
GR => substr `cat $Bin/../.git/refs/heads/indev`, 0, 7
|
||||
NAME => 'Auto IRC Bot',
|
||||
VER => 3,
|
||||
SVER => 0,
|
||||
REV => 0,
|
||||
RSTAGE => 'd',
|
||||
};
|
||||
}
|
||||
use Lib::Auto;
|
||||
use API::Std qw(conf_get err);
|
||||
use API::Log qw(println alog dbug);
|
||||
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::Cmd;
|
||||
|
||||
@@ -46,7 +49,7 @@ local $PROGRAM_NAME = 'auto';
|
||||
|
||||
# Check for build files.
|
||||
if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") {
|
||||
say 'Missing build file(s). Please build Auto before running it.' and exit;
|
||||
say 'Missing build file(s). Please build Auto before running it.' and exit;
|
||||
}
|
||||
|
||||
# Check build OS.
|
||||
@@ -54,7 +57,7 @@ open my $BFOS, '<', "$Bin/../build/os" or say 'Cannot start: Broken build.' and
|
||||
my @BFOS = <$BFOS>;
|
||||
close $BFOS or say 'Cannot start: Broken build.' and exit;
|
||||
if ($BFOS[0] ne $OSNAME."\n") {
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
}
|
||||
undef @BFOS;
|
||||
|
||||
@@ -71,7 +74,7 @@ open my $BFPERL, '<', "$Bin/../build/perl" or say 'Cannot start: Broken build.'
|
||||
my @BFPERL = <$BFPERL>;
|
||||
close $BFPERL or say 'Cannot start: Broken build.' and exit;
|
||||
if ($BFPERL[0] ne $]."\n") {
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
}
|
||||
undef @BFPERL;
|
||||
|
||||
@@ -80,7 +83,7 @@ open my $BFVER, '<', "$Bin/../build/ver" or say 'Cannot start: Broken build.' an
|
||||
my @BFVER = <$BFVER>;
|
||||
close $BFVER or say 'Cannot start: Broken build.' and exit;
|
||||
if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
say 'Cannot start: Broken build.' and exit;
|
||||
}
|
||||
undef @BFVER;
|
||||
|
||||
@@ -112,8 +115,8 @@ our ($APID, %TIMERS);
|
||||
our $DEBUG = 0;
|
||||
our $NUC = 0;
|
||||
if (defined $ARGV[0]) {
|
||||
foreach (@ARGV) {
|
||||
given ($_) {
|
||||
foreach (@ARGV) {
|
||||
given ($_) {
|
||||
when ('-d') { $DEBUG = 1; }
|
||||
when ('-nuc') { $NUC = 1; }
|
||||
}
|
||||
@@ -135,23 +138,23 @@ our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1)
|
||||
say ' Success';
|
||||
|
||||
if (conf_get('die')) {
|
||||
if ((conf_get('die'))[0][0] == 1) {
|
||||
say '!!! You didn\'t read the whole config.';
|
||||
say '!!! Insert new user then try again.';
|
||||
exit;
|
||||
}
|
||||
if ((conf_get('die'))[0][0] == 1) {
|
||||
say '!!! You didn\'t read the whole config.';
|
||||
say '!!! Insert new user then try again.';
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
# Check for required configuration values.
|
||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype);
|
||||
foreach my $REQCVAL (@REQCVALS) {
|
||||
if (!conf_get($REQCVAL)) {
|
||||
my $err = 2;
|
||||
if ($REQCVAL eq 'expire_logs') {
|
||||
$err = 1;
|
||||
}
|
||||
err($err, "Missing required configuration value: $REQCVAL", 1);
|
||||
}
|
||||
if (!conf_get($REQCVAL)) {
|
||||
my $err = 2;
|
||||
if ($REQCVAL eq 'expire_logs') {
|
||||
$err = 1;
|
||||
}
|
||||
err($err, "Missing required configuration value: $REQCVAL", 1);
|
||||
}
|
||||
}
|
||||
undef @REQCVALS;
|
||||
|
||||
@@ -179,8 +182,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);
|
||||
@@ -253,49 +257,49 @@ Core::IRC::clear_usercmd_timer();
|
||||
our (%PRIVILEGES);
|
||||
# If there are any privsets.
|
||||
if (conf_get('privset')) {
|
||||
# Get them.
|
||||
my %tcprivs = conf_get('privset');
|
||||
# Get them.
|
||||
my %tcprivs = conf_get('privset');
|
||||
|
||||
foreach my $tckpriv (keys %tcprivs) {
|
||||
# For each privset, get the inner values.
|
||||
my %mcprivs = conf_get("privset:$tckpriv");
|
||||
# For each privset, get the inner values.
|
||||
my %mcprivs = conf_get("privset:$tckpriv");
|
||||
|
||||
# Iterate through them.
|
||||
foreach my $mckpriv (keys %mcprivs) {
|
||||
# Switch statement for the values.
|
||||
given ($mckpriv) {
|
||||
# If it's 'priv', save it as a privilege.
|
||||
when ('priv') {
|
||||
if (defined $PRIVILEGES{$tckpriv}) {
|
||||
# If this privset exists, push to it.
|
||||
push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0];
|
||||
}
|
||||
else {
|
||||
# Otherwise, create it.
|
||||
@{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]);
|
||||
}
|
||||
}
|
||||
# If it's 'inherit', inherit the privileges of another privset.
|
||||
when ('inherit') {
|
||||
# If the privset we're inheriting exists, continue.
|
||||
if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) {
|
||||
# Iterate through each privilege.
|
||||
foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) {
|
||||
# And save them to the privset inheriting them
|
||||
if (defined $PRIVILEGES{$tckpriv}) {
|
||||
# If this privset exists, push to it.
|
||||
push @{ $PRIVILEGES{$tckpriv} }, $_;
|
||||
}
|
||||
else {
|
||||
# Otherwise, create it.
|
||||
@{ $PRIVILEGES{$tckpriv} } = ($_);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach my $mckpriv (keys %mcprivs) {
|
||||
# Switch statement for the values.
|
||||
given ($mckpriv) {
|
||||
# If it's 'priv', save it as a privilege.
|
||||
when ('priv') {
|
||||
if (defined $PRIVILEGES{$tckpriv}) {
|
||||
# If this privset exists, push to it.
|
||||
push @{ $PRIVILEGES{$tckpriv} }, ($mcprivs{$mckpriv})[0][0];
|
||||
}
|
||||
else {
|
||||
# Otherwise, create it.
|
||||
@{ $PRIVILEGES{$tckpriv} } = (($mcprivs{$mckpriv})[0][0]);
|
||||
}
|
||||
}
|
||||
# If it's 'inherit', inherit the privileges of another privset.
|
||||
when ('inherit') {
|
||||
# If the privset we're inheriting exists, continue.
|
||||
if (defined $PRIVILEGES{($mcprivs{$mckpriv})[0][0]}) {
|
||||
# Iterate through each privilege.
|
||||
foreach (@{ $PRIVILEGES{($mcprivs{$mckpriv})[0][0]} }) {
|
||||
# And save them to the privset inheriting them
|
||||
if (defined $PRIVILEGES{$tckpriv}) {
|
||||
# If this privset exists, push to it.
|
||||
push @{ $PRIVILEGES{$tckpriv} }, $_;
|
||||
}
|
||||
else {
|
||||
# Otherwise, create it.
|
||||
@{ $PRIVILEGES{$tckpriv} } = ($_);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Successful startup.
|
||||
@@ -303,6 +307,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,12 +324,9 @@ 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;
|
||||
open my $FPID, '>', "$Bin/auto.pid" or exit;
|
||||
print {$FPID} "$APID\n" or exit;
|
||||
close $FPID or exit;
|
||||
exit;
|
||||
}
|
||||
POSIX::setsid() or err(2, "Can't start a new session: $ERRNO", 1);
|
||||
@@ -328,14 +337,20 @@ 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')) {
|
||||
alog '* Loading modules...';
|
||||
dbug '* Loading modules...';
|
||||
foreach (@{ (conf_get('module'))[0] }) {
|
||||
mod_load($_);
|
||||
}
|
||||
alog '* Loading modules...';
|
||||
dbug '* Loading modules...';
|
||||
foreach (@{ (conf_get('module'))[0] }) {
|
||||
mod_load($_);
|
||||
}
|
||||
}
|
||||
|
||||
## Create sockets.
|
||||
@@ -346,94 +361,25 @@ 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) {
|
||||
alog '** Success: Connected to server(s).';
|
||||
dbug '** Success: Connected to server(s).';
|
||||
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);
|
||||
API::Std::cmd_add('MODUNLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODUNLOAD, \&Core::Cmd::cmd_modunload);
|
||||
API::Std::cmd_add('MODRELOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODRELOAD, \&Core::Cmd::cmd_modreload);
|
||||
API::Std::cmd_add('MODLIST', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLIST, \&Core::Cmd::cmd_modlist);
|
||||
API::Std::cmd_add('SHUTDOWN', 2, 'cmd.shutdown', \%Core::Cmd::HELP_SHUTDOWN, \&Core::Cmd::cmd_shutdown);
|
||||
API::Std::cmd_add('RESTART', 2, 'cmd.restart', \%Core::Cmd::HELP_RESTART, \&Core::Cmd::cmd_restart);
|
||||
API::Std::cmd_add('REHASH', 2, 'cmd.rehash', \%Core::Cmd::HELP_REHASH, \&Core::Cmd::cmd_rehash);
|
||||
@@ -441,40 +387,40 @@ API::Std::cmd_add('HELP', 2, 0, \%Core::Cmd::HELP_HELP, \&Core::Cmd::cmd_help);
|
||||
|
||||
# Infinite while loop.
|
||||
while (1) {
|
||||
# Timer check.
|
||||
foreach my $tk (keys %TIMERS) {
|
||||
if ($TIMERS{$tk}{time} <= time) {
|
||||
&{ $TIMERS{$tk}{sub} }();
|
||||
if ($TIMERS{$tk}{type} == 1) {
|
||||
# If it's type 1, delete from memory.
|
||||
delete $TIMERS{$tk};
|
||||
}
|
||||
elsif ($TIMERS{$tk}{type} == 2) {
|
||||
# If it's type 2, reset timer.
|
||||
$TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs};
|
||||
}
|
||||
else {
|
||||
# This should never happen.
|
||||
delete $TIMERS{$tk};
|
||||
}
|
||||
}
|
||||
}
|
||||
# Socket check.
|
||||
foreach my $sock ($SELECT->can_read(1)) {
|
||||
# Figure out what network is sending us data.
|
||||
my $sockid;
|
||||
foreach (keys %SOCKET) {
|
||||
if ($SOCKET{$_} eq $sock) { $sockid = $_; }
|
||||
}
|
||||
# Read the data.
|
||||
my $idata;
|
||||
sysread $sock, $idata, POSIX::BUFSIZ, 0;
|
||||
# Timer check.
|
||||
foreach my $tk (keys %TIMERS) {
|
||||
if ($TIMERS{$tk}{time} <= time) {
|
||||
&{ $TIMERS{$tk}{sub} }();
|
||||
if ($TIMERS{$tk}{type} == 1) {
|
||||
# If it's type 1, delete from memory.
|
||||
delete $TIMERS{$tk};
|
||||
}
|
||||
elsif ($TIMERS{$tk}{type} == 2) {
|
||||
# If it's type 2, reset timer.
|
||||
$TIMERS{$tk}{time} = time + $TIMERS{$tk}{secs};
|
||||
}
|
||||
else {
|
||||
# This should never happen.
|
||||
delete $TIMERS{$tk};
|
||||
}
|
||||
}
|
||||
}
|
||||
# Socket check.
|
||||
foreach my $sock ($SELECT->can_read(1)) {
|
||||
# Figure out what network is sending us data.
|
||||
my $sockid;
|
||||
foreach (keys %SOCKET) {
|
||||
if ($SOCKET{$_} eq $sock) { $sockid = $_; }
|
||||
}
|
||||
# Read the data.
|
||||
my $idata;
|
||||
sysread $sock, $idata, POSIX::BUFSIZ, 0;
|
||||
|
||||
# Check for the data.
|
||||
if (!defined $idata || length($idata) == 0) {
|
||||
# Got EOF, close socket
|
||||
err(2, "Lost connection to $sockid!", 0);
|
||||
$SELECT->remove($sock);
|
||||
# Check for the data.
|
||||
if (!defined $idata || length($idata) == 0) {
|
||||
# Got EOF, close socket
|
||||
err(2, "Lost connection to $sockid!", 0);
|
||||
$SELECT->remove($sock);
|
||||
delete $SOCKET{$sockid};
|
||||
if (!keys %SOCKET) {
|
||||
# No more connections, stop the program.
|
||||
@@ -485,22 +431,22 @@ while (1) {
|
||||
exit;
|
||||
}
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
||||
# Read the buffer.
|
||||
my $data .= $idata;
|
||||
while ($data =~ s/(.*\n)//) {
|
||||
my $line = $1;
|
||||
my $data .= $idata;
|
||||
while ($data =~ s/(.*\n)//) {
|
||||
my $line = $1;
|
||||
|
||||
# Remove the newlines.
|
||||
chomp $line;
|
||||
# Debug.
|
||||
dbug $sockid.' >> '.$line;
|
||||
chomp $line;
|
||||
# Debug.
|
||||
dbug $sockid.' >> '.$line;
|
||||
|
||||
# Parse data.
|
||||
Parser::IRC::ircparse($sockid, $line);
|
||||
}
|
||||
}
|
||||
Proto::IRC::ircparse($sockid, $line);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
###############
|
||||
@@ -508,18 +454,17 @@ while (1) {
|
||||
###############
|
||||
|
||||
# Send data to socket.
|
||||
sub socksnd
|
||||
{
|
||||
my ($svr, $data) = @_;
|
||||
sub socksnd {
|
||||
my ($svr, $data) = @_;
|
||||
|
||||
if (defined $SOCKET{$svr}) {
|
||||
syswrite $SOCKET{$svr}, $data."\n", POSIX::BUFSIZ, 0;
|
||||
dbug "$svr << $data";
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return 0;
|
||||
}
|
||||
syswrite $SOCKET{$svr}, $data."\r\n", POSIX::BUFSIZ, 0;
|
||||
dbug "$svr << $data";
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
# Load a module.
|
||||
@@ -546,4 +491,4 @@ sub mod_load {
|
||||
return;
|
||||
}
|
||||
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
+1
-1
@@ -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
@@ -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
@@ -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:
|
||||
@@ -2,6 +2,49 @@ Auto IRC Bot 3.0: Change Log
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
3.0 Indev
|
||||
===============================================================================
|
||||
|
||||
|
||||
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.
|
||||
* Fixed an odd bug when viewing non-existent quotes.
|
||||
* You can now define how many results are returned by QDB SEARCH/MORE at a
|
||||
time with qdb_search_resnum in the config.
|
||||
* Added SEARCH and MORE to QDB.
|
||||
* Killed EMODS in the starter script and updated MODS
|
||||
* Added core command MODLIST.
|
||||
* Added command level 3 for logchan-only command.
|
||||
* Added a LinkTitle module for getting the title of a web page posted in a
|
||||
channel.
|
||||
|
||||
3.0 Alpha 4
|
||||
===============================================================================
|
||||
* Added a Dictionary module for looking up definitions of words.
|
||||
* server:ajoin now supports channel keys by spacing the name and key.
|
||||
|
||||
@@ -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
@@ -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.
|
||||
@@ -19,18 +19,18 @@ our $ERROR = 0;
|
||||
# Iterate through the arguments passed to us.
|
||||
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.';
|
||||
foreach (@ARGV) {
|
||||
if ($_ eq '-h' or $_ eq '--help') {
|
||||
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;
|
||||
}
|
||||
elsif ($_ eq '--enable-sasl') {
|
||||
$features .= ' sasl';
|
||||
}
|
||||
println '*** End of Help ***';
|
||||
exit 1;
|
||||
}
|
||||
elsif ($_ eq '--enable-sasl') {
|
||||
$features .= ' sasl';
|
||||
}
|
||||
elsif ($_ eq '--disable-ssl') {
|
||||
$features =~ s/ ssl//g;
|
||||
}
|
||||
@@ -40,13 +40,13 @@ if (defined $ARGV[0]) {
|
||||
elsif ($_ eq '--with-mysql') {
|
||||
$features =~ s/(sqlite|pgsql)/mysql/g;
|
||||
}
|
||||
elsif ($_ eq '--with-pgsql') {
|
||||
elsif ($_ eq '--with-pgsql') {
|
||||
$features =~ s/(sqlite|mysql)/pgsql/g;
|
||||
}
|
||||
else {
|
||||
println "Warning: Unknown option '$_'";
|
||||
}
|
||||
}
|
||||
println "Warning: Unknown option '$_'";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Check Perl version.
|
||||
@@ -58,32 +58,39 @@ eval {
|
||||
# Check operating system.
|
||||
print "Checking operating system..... $OSNAME - ";
|
||||
if ($OSNAME =~ /dos/i) {
|
||||
print "DOS is not supported.\r\n";
|
||||
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";
|
||||
print "NetWare is not supported.\r\n";
|
||||
exit;
|
||||
}
|
||||
elsif ($OSNAME eq "linux") {
|
||||
print "OK\n";
|
||||
print "OK\n";
|
||||
}
|
||||
elsif ($OSNAME eq "os2") {
|
||||
print "IBM OS/2 is not supported.\r\n";
|
||||
print "IBM OS/2 is not supported.\r\n";
|
||||
exit;
|
||||
}
|
||||
elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) {
|
||||
print "OK\r";
|
||||
print "OK\r";
|
||||
}
|
||||
elsif ($OSNAME eq "freebsd") {
|
||||
print "OK\n";
|
||||
print "OK\n";
|
||||
}
|
||||
elsif ($OSNAME eq "openbsd") {
|
||||
print "OK\n";
|
||||
print "OK\n";
|
||||
}
|
||||
elsif ($OSNAME eq "solaris") {
|
||||
print "OK\n";
|
||||
}
|
||||
else {
|
||||
print "Unknown operating system. Contact support.\r\n";
|
||||
}
|
||||
print "Unknown operating system. Contact support.\r\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
# Check for Perl core modules.
|
||||
println "Checking for core Perl 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:
|
||||
+116
-93
@@ -9,7 +9,7 @@ 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);
|
||||
|
||||
|
||||
# Set a ban, based on config bantype value.
|
||||
@@ -48,68 +48,84 @@ sub ban
|
||||
# Join a channel.
|
||||
sub cjoin
|
||||
{
|
||||
my ($svr, $chan, $key) = @_;
|
||||
|
||||
Auto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan"));
|
||||
|
||||
return 1;
|
||||
my ($svr, $chan, $key) = @_;
|
||||
|
||||
Auto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan"));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Part a channel.
|
||||
sub cpart
|
||||
{
|
||||
my ($svr, $chan, $reason) = @_;
|
||||
|
||||
if (defined $reason) {
|
||||
Auto::socksnd($svr, "PART $chan :$reason");
|
||||
}
|
||||
else {
|
||||
Auto::socksnd($svr, "PART $chan :Leaving");
|
||||
}
|
||||
my ($svr, $chan, $reason) = @_;
|
||||
|
||||
if (defined $reason) {
|
||||
Auto::socksnd($svr, "PART $chan :$reason");
|
||||
}
|
||||
else {
|
||||
Auto::socksnd($svr, "PART $chan :Leaving");
|
||||
}
|
||||
|
||||
if (defined $Parser::IRC::botchans{$svr}{$chan}) { delete $Parser::IRC::botchans{$svr}{$chan}; }
|
||||
|
||||
return 1;
|
||||
if (defined $Proto::IRC::botchans{$svr}{$chan}) { delete $Proto::IRC::botchans{$svr}{$chan}; }
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Set mode(s) on a channel.
|
||||
sub cmode
|
||||
{
|
||||
my ($svr, $chan, $modes) = @_;
|
||||
my ($svr, $chan, $modes) = @_;
|
||||
|
||||
Auto::socksnd($svr, "MODE $chan $modes");
|
||||
|
||||
return 1;
|
||||
Auto::socksnd($svr, "MODE $chan $modes");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Set mode(s) on us.
|
||||
sub umode
|
||||
{
|
||||
my ($svr, $modes) = @_;
|
||||
|
||||
Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes");
|
||||
|
||||
return 1;
|
||||
my ($svr, $modes) = @_;
|
||||
|
||||
Auto::socksnd($svr, "MODE ".$Proto::IRC::botinfo{$svr}{nick}." $modes");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Send a PRIVMSG.
|
||||
sub privmsg
|
||||
{
|
||||
my ($svr, $target, $message) = @_;
|
||||
|
||||
Auto::socksnd($svr, "PRIVMSG $target :$message");
|
||||
|
||||
return 1;
|
||||
my ($svr, $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;
|
||||
}
|
||||
|
||||
# Send a NOTICE.
|
||||
sub notice
|
||||
{
|
||||
my ($svr, $target, $message) = @_;
|
||||
|
||||
Auto::socksnd($svr, "NOTICE $target :$message");
|
||||
|
||||
return 1;
|
||||
my ($svr, $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;
|
||||
}
|
||||
|
||||
# Send an ACTION PRIVMSG.
|
||||
@@ -125,33 +141,33 @@ sub act
|
||||
# Change bot nickname.
|
||||
sub nick
|
||||
{
|
||||
my ($svr, $newnick) = @_;
|
||||
|
||||
Auto::socksnd($svr, "NICK $newnick");
|
||||
|
||||
$Parser::IRC::botnick{$svr}{newnick} = $newnick;
|
||||
|
||||
return 1;
|
||||
my ($svr, $newnick) = @_;
|
||||
|
||||
Auto::socksnd($svr, "NICK $newnick");
|
||||
|
||||
$Proto::IRC::botinfo{$svr}{newnick} = $newnick;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Request the users of a channel.
|
||||
sub names
|
||||
{
|
||||
my ($svr, $chan) = @_;
|
||||
|
||||
Auto::socksnd($svr, "NAMES $chan");
|
||||
|
||||
return 1;
|
||||
my ($svr, $chan) = @_;
|
||||
|
||||
Auto::socksnd($svr, "NAMES $chan");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Send a topic to the channel.
|
||||
sub topic
|
||||
{
|
||||
my ($svr, $chan, $topic) = @_;
|
||||
|
||||
Auto::socksnd($svr, "TOPIC $chan :$topic");
|
||||
|
||||
return 1;
|
||||
my ($svr, $chan, $topic) = @_;
|
||||
|
||||
Auto::socksnd($svr, "TOPIC $chan :$topic");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Kick a user.
|
||||
@@ -165,58 +181,65 @@ sub kick
|
||||
}
|
||||
|
||||
# Quit IRC.
|
||||
sub quit
|
||||
{
|
||||
my ($svr, $reason) = @_;
|
||||
|
||||
if (defined $reason) {
|
||||
Auto::socksnd($svr, "QUIT :$reason");
|
||||
}
|
||||
else {
|
||||
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});
|
||||
|
||||
return 1;
|
||||
sub quit {
|
||||
my ($svr, $reason) = @_;
|
||||
|
||||
if (defined $reason) {
|
||||
Auto::socksnd($svr, "QUIT :$reason");
|
||||
}
|
||||
else {
|
||||
Auto::socksnd($svr, "QUIT :Leaving");
|
||||
}
|
||||
|
||||
delete $Proto::IRC::got_001{$svr} if (defined $Proto::IRC::got_001{$svr});
|
||||
delete $Proto::IRC::botinfo{$svr} if (defined $Proto::IRC::botinfo{$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
|
||||
{
|
||||
my ($ex) = @_;
|
||||
|
||||
my @si = split('!', $ex);
|
||||
my @sii = split('@', $si[1]);
|
||||
|
||||
return (
|
||||
nick => $si[0],
|
||||
user => $sii[0],
|
||||
host => $sii[1]
|
||||
);
|
||||
my ($ex) = @_;
|
||||
|
||||
my @si = split('!', $ex);
|
||||
my @sii = split('@', $si[1]);
|
||||
|
||||
return (
|
||||
nick => $si[0],
|
||||
user => $sii[0],
|
||||
host => $sii[1]
|
||||
);
|
||||
}
|
||||
|
||||
# Match two IRC masks.
|
||||
sub match_mask
|
||||
{
|
||||
my ($mu, $mh) = @_;
|
||||
|
||||
# Prepare the regex.
|
||||
$mh =~ s/\./\\\./g;
|
||||
$mh =~ s/\?/\./g;
|
||||
$mh =~ s/\*/\.\*/g;
|
||||
$mh = '^'.$mh.'$';
|
||||
|
||||
# Let's grep the user's mask.
|
||||
if (grep(/$mh/, $mu)) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
my ($mu, $mh) = @_;
|
||||
|
||||
# Prepare the regex.
|
||||
$mh =~ s/\./\\\./g;
|
||||
$mh =~ s/\?/\./g;
|
||||
$mh =~ s/\*/\.\*/g;
|
||||
$mh = '^'.$mh.'$';
|
||||
|
||||
# Let's grep the user's mask.
|
||||
if (grep(/$mh/, $mu)) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
+54
-58
@@ -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);
|
||||
|
||||
@@ -18,11 +18,11 @@ our @EXPORT_OK = qw(println dbug alog slog);
|
||||
# Print with the system newline appended.
|
||||
sub println
|
||||
{
|
||||
my ($out) = @_;
|
||||
my ($out) = @_;
|
||||
|
||||
if (!defined $out) {
|
||||
print $RS;
|
||||
}
|
||||
if (!defined $out) {
|
||||
print $RS;
|
||||
}
|
||||
else {
|
||||
print $out.$RS;
|
||||
}
|
||||
@@ -33,79 +33,75 @@ sub println
|
||||
# Print only if in debug mode.
|
||||
sub dbug
|
||||
{
|
||||
my ($out) = @_;
|
||||
my ($out) = @_;
|
||||
|
||||
if ($Auto::DEBUG) {
|
||||
# We're in debug mode; print it out.
|
||||
say $out;
|
||||
}
|
||||
if ($Auto::DEBUG) {
|
||||
# We're in debug mode; print it out.
|
||||
say $out;
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Log to file.
|
||||
sub alog
|
||||
{
|
||||
my ($lmsg) = @_;
|
||||
my ($lmsg) = @_;
|
||||
|
||||
# Expire old logs first.
|
||||
expire_logs();
|
||||
# Expire old logs first.
|
||||
expire_logs();
|
||||
|
||||
# Get date and time in the desired format.
|
||||
my $date = POSIX::strftime('%Y%m%d', localtime);
|
||||
my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
|
||||
# Get date and time in the desired format.
|
||||
my $date = POSIX::strftime('%Y%m%d', localtime);
|
||||
my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
|
||||
|
||||
# Create var/ if it doesn't exist.
|
||||
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";
|
||||
}
|
||||
# Create var/ if it doesn't exist.
|
||||
if (!-d "$Auto::Bin/../var") {
|
||||
mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
}
|
||||
|
||||
# Open the logfile, print the log message to it and close it.
|
||||
open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return;
|
||||
print {$FLOG} "[$time] $lmsg\n" or return;
|
||||
close $FLOG or return;
|
||||
# Open the logfile, print the log message to it and close it.
|
||||
open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return;
|
||||
print {$FLOG} "[$time] $lmsg\n" or return;
|
||||
close $FLOG or return;
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Expire old logs.
|
||||
sub expire_logs
|
||||
{
|
||||
# Get configuration value.
|
||||
my $celog = (conf_get('expire_logs'))[0][0] or return;
|
||||
# Get configuration value.
|
||||
my $celog = (conf_get('expire_logs'))[0][0] or return;
|
||||
|
||||
# Check for invalid values.
|
||||
if ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
# Must be numbers only.
|
||||
return;
|
||||
}
|
||||
elsif (!$celog) {
|
||||
# No expire.
|
||||
return;
|
||||
}
|
||||
# Check for invalid values.
|
||||
if ($celog =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
# Must be numbers only.
|
||||
return;
|
||||
}
|
||||
elsif (!$celog) {
|
||||
# No expire.
|
||||
return;
|
||||
}
|
||||
|
||||
# Iterate through each logfile.
|
||||
foreach my $file (glob "$Auto::Bin/../var/*") {
|
||||
my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
|
||||
# Iterate through each logfile.
|
||||
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.
|
||||
my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
$mm = $mm - 1;
|
||||
my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy);
|
||||
# Convert filename to UNIX time.
|
||||
my $yyyy = substr $file, 0, 4; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
my $mm = substr $file, 4, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
$mm = $mm - 1;
|
||||
my $dd = substr $file, 6, 2; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
my $epoch = timelocal(0, 0, 0, $dd, $mm, $yyyy);
|
||||
|
||||
# If it's older than <config_value> days, delete it.
|
||||
if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
unlink "$Auto::Bin/../var/$file";
|
||||
}
|
||||
}
|
||||
# If it's older than <config_value> days, delete it.
|
||||
if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
|
||||
unlink "$Auto::Bin/../var/$file";
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Subroutine for logging to an IRC logchan.
|
||||
@@ -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:
|
||||
+280
-269
@@ -11,237 +11,237 @@ use base qw(Exporter);
|
||||
|
||||
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS);
|
||||
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);
|
||||
cmd_del hook_add hook_del rchook_add rchook_del match_user
|
||||
has_priv mod_exists ratelimit_check fpfmt);
|
||||
|
||||
|
||||
# Initialize a module.
|
||||
sub mod_init
|
||||
{
|
||||
my ($name, $author, $version, $autover, $pkg) = @_;
|
||||
my ($name, $author, $version, $autover, $pkg) = @_;
|
||||
|
||||
# Log/debug.
|
||||
API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
||||
API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
||||
API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
||||
API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
|
||||
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') {
|
||||
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 ($autover !~ m/^3\.0\.0a(6)$/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.'); }
|
||||
return;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# Run the module's _init sub.
|
||||
# Run the module's _init sub.
|
||||
my $mi = eval($pkg.'::_init();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
|
||||
|
||||
if ($mi) {
|
||||
# If successful, add to hash.
|
||||
$MODULE{$name}{name} = $name;
|
||||
$MODULE{$name}{version} = $version;
|
||||
$MODULE{$name}{author} = $author;
|
||||
$MODULE{$name}{pkg} = $pkg;
|
||||
if ($mi) {
|
||||
# If successful, add to hash.
|
||||
$MODULE{$name}{name} = $name;
|
||||
$MODULE{$name}{version} = $version;
|
||||
$MODULE{$name}{author} = $author;
|
||||
$MODULE{$name}{pkg} = $pkg;
|
||||
|
||||
API::Log::dbug('MODULES: '.$name.' successfully loaded.');
|
||||
API::Log::alog('MODULES: '.$name.' successfully loaded.');
|
||||
API::Log::dbug('MODULES: '.$name.' successfully loaded.');
|
||||
API::Log::alog('MODULES: '.$name.' successfully loaded.');
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.'); }
|
||||
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
# Otherwise, return a failed to load message.
|
||||
API::Log::dbug('MODULES: Failed to load '.$name.q{.});
|
||||
API::Log::alog('MODULES: Failed to load '.$name.q{.});
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
# Otherwise, return a failed to load message.
|
||||
API::Log::dbug('MODULES: Failed to load '.$name.q{.});
|
||||
API::Log::alog('MODULES: Failed to load '.$name.q{.});
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}); }
|
||||
|
||||
return;
|
||||
}
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# Check if a module exists.
|
||||
sub mod_exists
|
||||
{
|
||||
my ($name) = @_;
|
||||
my ($name) = @_;
|
||||
|
||||
if (defined $API::Std::MODULE{$name}) { return 1; }
|
||||
if (defined $API::Std::MODULE{$name}) { return 1; }
|
||||
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
# Void a module.
|
||||
sub mod_void
|
||||
{
|
||||
my ($module) = @_;
|
||||
my ($module) = @_;
|
||||
|
||||
# Log/debug.
|
||||
API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
|
||||
API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
|
||||
# Log/debug.
|
||||
API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
|
||||
API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to unload module: '.$module.'...'); }
|
||||
|
||||
# Check if this module exists.
|
||||
if (!defined $MODULE{$module}) {
|
||||
API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?');
|
||||
API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?');
|
||||
# Check if this module exists.
|
||||
if (!defined $MODULE{$module}) {
|
||||
API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?');
|
||||
API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?');
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?'); }
|
||||
return;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# Run the module's _void sub.
|
||||
# Run the module's _void sub.
|
||||
my $mi = eval($MODULE{$module}{pkg}.'::_void();'); ## no critic qw(BuiltinFunctions::ProhibitStringyEval)
|
||||
|
||||
if ($mi) {
|
||||
# If successful, delete class from program and delete module from hash.
|
||||
Class::Unload->unload($MODULE{$module}{pkg});
|
||||
delete $MODULE{$module};
|
||||
API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
|
||||
API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
|
||||
if ($mi) {
|
||||
# If successful, delete class from program and delete module from hash.
|
||||
Class::Unload->unload($MODULE{$module}{pkg});
|
||||
delete $MODULE{$module};
|
||||
API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
|
||||
API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Successfully unloaded '.$module.q{.}); }
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
# Otherwise, return a failed to unload message.
|
||||
API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
|
||||
API::Log::alog('MODULES: Failed to unload '.$module.q{.});
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
# Otherwise, return a failed to unload message.
|
||||
API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
|
||||
API::Log::alog('MODULES: Failed to unload '.$module.q{.});
|
||||
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}); }
|
||||
return;
|
||||
}
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# Add a command to Auto.
|
||||
sub cmd_add
|
||||
{
|
||||
my ($cmd, $lvl, $priv, $help, $sub) = @_;
|
||||
$cmd = uc $cmd;
|
||||
my ($cmd, $lvl, $priv, $help, $sub) = @_;
|
||||
$cmd = uc $cmd;
|
||||
|
||||
if (defined $API::Std::CMDS{$cmd}) { return; }
|
||||
if ($lvl =~ m/[^0-2]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
if (defined $API::Std::CMDS{$cmd}) { return; }
|
||||
if ($lvl =~ m/[^0-3]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
|
||||
$API::Std::CMDS{$cmd}{lvl} = $lvl;
|
||||
$API::Std::CMDS{$cmd}{help} = $help;
|
||||
$API::Std::CMDS{$cmd}{priv} = $priv;
|
||||
$API::Std::CMDS{$cmd}{sub} = $sub;
|
||||
$API::Std::CMDS{$cmd}{lvl} = $lvl;
|
||||
$API::Std::CMDS{$cmd}{help} = $help;
|
||||
$API::Std::CMDS{$cmd}{priv} = $priv;
|
||||
$API::Std::CMDS{$cmd}{'sub'} = $sub;
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
# Delete a command from Auto.
|
||||
sub cmd_del
|
||||
{
|
||||
my ($cmd) = @_;
|
||||
$cmd = uc $cmd;
|
||||
my ($cmd) = @_;
|
||||
$cmd = uc $cmd;
|
||||
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
delete $API::Std::CMDS{$cmd};
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
delete $API::Std::CMDS{$cmd};
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Add an event to Auto.
|
||||
sub event_add
|
||||
{
|
||||
my ($name) = @_;
|
||||
my ($name) = @_;
|
||||
|
||||
if (!defined $EVENTS{lc $name}) {
|
||||
$EVENTS{lc $name} = 1;
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...');
|
||||
return;
|
||||
}
|
||||
if (!defined $EVENTS{lc $name}) {
|
||||
$EVENTS{lc $name} = 1;
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
API::Log::dbug('DEBUG: Attempt to add a pre-existing event ('.lc $name.')! Ignoring...');
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# Delete an event from Auto.
|
||||
sub event_del
|
||||
{
|
||||
my ($name) = @_;
|
||||
my ($name) = @_;
|
||||
|
||||
if (defined $EVENTS{lc $name}) {
|
||||
delete $EVENTS{lc $name};
|
||||
delete $HOOKS{lc $name};
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...');
|
||||
return;
|
||||
}
|
||||
if (defined $EVENTS{lc $name}) {
|
||||
delete $EVENTS{lc $name};
|
||||
delete $HOOKS{lc $name};
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
API::Log::dbug('DEBUG: Attempt to delete a non-existing event ('.lc $name.')! Ignoring...');
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger an event.
|
||||
sub event_run
|
||||
{
|
||||
my ($event, @args) = @_;
|
||||
my ($event, @args) = @_;
|
||||
|
||||
if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
|
||||
foreach my $hk (keys %{ $HOOKS{lc $event} }) {
|
||||
my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
|
||||
if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
|
||||
foreach my $hk (keys %{ $HOOKS{lc $event} }) {
|
||||
my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
|
||||
if ($ri == -1) { last; }
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Add a hook to Auto.
|
||||
sub hook_add
|
||||
{
|
||||
my ($event, $name, $sub) = @_;
|
||||
my ($event, $name, $sub) = @_;
|
||||
|
||||
if (!defined $API::Std::HOOKS{lc $name}) {
|
||||
if (defined $API::Std::EVENTS{lc $event}) {
|
||||
$API::Std::HOOKS{lc $event}{lc $name} = $sub;
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
if (!defined $API::Std::HOOKS{lc $name}) {
|
||||
if (defined $API::Std::EVENTS{lc $event}) {
|
||||
$API::Std::HOOKS{lc $event}{lc $name} = $sub;
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# Delete a hook from Auto.
|
||||
sub hook_del
|
||||
{
|
||||
my ($event, $name) = @_;
|
||||
my ($event, $name) = @_;
|
||||
|
||||
if (defined $API::Std::HOOKS{lc $event}{lc $name}) {
|
||||
delete $API::Std::HOOKS{lc $event}{lc $name};
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
if (defined $API::Std::HOOKS{lc $event}{lc $name}) {
|
||||
delete $API::Std::HOOKS{lc $event}{lc $name};
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# Add a timer to Auto.
|
||||
sub timer_add
|
||||
{
|
||||
my ($name, $type, $time, $sub) = @_;
|
||||
$name = lc $name;
|
||||
my ($name, $type, $time, $sub) = @_;
|
||||
$name = lc $name;
|
||||
|
||||
# Check for invalid type/time.
|
||||
if ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
if ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
# Check for invalid type/time.
|
||||
if ($type =~ m/[^1-2]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
if ($time =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
|
||||
if (!defined $Auto::TIMERS{$name}) {
|
||||
$Auto::TIMERS{$name}{type} = $type;
|
||||
$Auto::TIMERS{$name}{time} = time + $time;
|
||||
if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; }
|
||||
$Auto::TIMERS{$name}{sub} = $sub;
|
||||
return 1;
|
||||
}
|
||||
if (!defined $Auto::TIMERS{$name}) {
|
||||
$Auto::TIMERS{$name}{type} = $type;
|
||||
$Auto::TIMERS{$name}{time} = time + $time;
|
||||
if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; }
|
||||
$Auto::TIMERS{$name}{sub} = $sub;
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
@@ -249,123 +249,123 @@ sub timer_add
|
||||
# Delete a timer from Auto.
|
||||
sub timer_del
|
||||
{
|
||||
my ($name) = @_;
|
||||
$name = lc $name;
|
||||
my ($name) = @_;
|
||||
$name = lc $name;
|
||||
|
||||
if (defined $Auto::TIMERS{$name}) {
|
||||
delete $Auto::TIMERS{$name};
|
||||
return 1;
|
||||
}
|
||||
if (defined $Auto::TIMERS{$name}) {
|
||||
delete $Auto::TIMERS{$name};
|
||||
return 1;
|
||||
}
|
||||
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
# Hook onto a raw command.
|
||||
sub rchook_add
|
||||
{
|
||||
my ($cmd, $sub) = @_;
|
||||
$cmd = uc $cmd;
|
||||
my ($cmd, $sub) = @_;
|
||||
$cmd = uc $cmd;
|
||||
|
||||
if (defined $Parser::IRC::RAWC{$cmd}) { return; }
|
||||
if (defined $Proto::IRC::RAWC{$cmd}) { return; }
|
||||
|
||||
$Parser::IRC::RAWC{$cmd} = $sub;
|
||||
$Proto::IRC::RAWC{$cmd} = $sub;
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Delete a raw command hook.
|
||||
sub rchook_del
|
||||
{
|
||||
my ($cmd) = @_;
|
||||
$cmd = uc $cmd;
|
||||
my ($cmd) = @_;
|
||||
$cmd = uc $cmd;
|
||||
|
||||
if (!defined $Parser::IRC::RAWC{$cmd}) { return; }
|
||||
if (!defined $Proto::IRC::RAWC{$cmd}) { return; }
|
||||
|
||||
delete $Parser::IRC::RAWC{$cmd};
|
||||
delete $Proto::IRC::RAWC{$cmd};
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Configuration value getter.
|
||||
sub conf_get
|
||||
{
|
||||
my ($value) = @_;
|
||||
my ($value) = @_;
|
||||
|
||||
# Create an array out of the value.
|
||||
my @val;
|
||||
if ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
@val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
}
|
||||
else {
|
||||
@val = ($value);
|
||||
}
|
||||
# Undefine this as it's unnecessary now.
|
||||
undef $value;
|
||||
# Create an array out of the value.
|
||||
my @val;
|
||||
if ($value =~ m/:/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
@val = split m/[:]/sm, $value; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
}
|
||||
else {
|
||||
@val = ($value);
|
||||
}
|
||||
# Undefine this as it's unnecessary now.
|
||||
undef $value;
|
||||
|
||||
# Get the count of elements in the array.
|
||||
my $count = scalar @val;
|
||||
# Get the count of elements in the array.
|
||||
my $count = scalar @val;
|
||||
|
||||
# Return the requested configuration value(s).
|
||||
if ($count == 1) {
|
||||
if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') {
|
||||
return %{ $Auto::SETTINGS{$val[0]} };
|
||||
}
|
||||
else {
|
||||
return $Auto::SETTINGS{$val[0]};
|
||||
}
|
||||
}
|
||||
elsif ($count == 2) {
|
||||
if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') {
|
||||
return %{ $Auto::SETTINGS{$val[0]}{$val[1]} };
|
||||
}
|
||||
else {
|
||||
return $Auto::SETTINGS{$val[0]}{$val[1]};
|
||||
}
|
||||
}
|
||||
elsif ($count == 3) {
|
||||
if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') {
|
||||
return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} };
|
||||
}
|
||||
else {
|
||||
return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]};
|
||||
}
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
# Return the requested configuration value(s).
|
||||
if ($count == 1) {
|
||||
if (ref $Auto::SETTINGS{$val[0]} eq 'HASH') {
|
||||
return %{ $Auto::SETTINGS{$val[0]} };
|
||||
}
|
||||
else {
|
||||
return $Auto::SETTINGS{$val[0]};
|
||||
}
|
||||
}
|
||||
elsif ($count == 2) {
|
||||
if (ref $Auto::SETTINGS{$val[0]}{$val[1]} eq 'HASH') {
|
||||
return %{ $Auto::SETTINGS{$val[0]}{$val[1]} };
|
||||
}
|
||||
else {
|
||||
return $Auto::SETTINGS{$val[0]}{$val[1]};
|
||||
}
|
||||
}
|
||||
elsif ($count == 3) {
|
||||
if (ref $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} eq 'HASH') {
|
||||
return %{ $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]} };
|
||||
}
|
||||
else {
|
||||
return $Auto::SETTINGS{$val[0]}{$val[1]}{$val[2]};
|
||||
}
|
||||
}
|
||||
else {
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
# Translation subroutine.
|
||||
sub trans
|
||||
{
|
||||
my $id = shift;
|
||||
$id =~ s/ /_/gsm;
|
||||
$id =~ s/ /_/gsm;
|
||||
|
||||
if (defined $API::Std::LANGE{$id}) {
|
||||
return sprintf $API::Std::LANGE{$id}, @_;
|
||||
}
|
||||
else {
|
||||
$id =~ s/_/ /gsm;
|
||||
return $id;
|
||||
}
|
||||
if (defined $API::Std::LANGE{$id}) {
|
||||
return sprintf $API::Std::LANGE{$id}, @_;
|
||||
}
|
||||
else {
|
||||
$id =~ s/_/ /gsm;
|
||||
return $id;
|
||||
}
|
||||
}
|
||||
|
||||
# Match user subroutine.
|
||||
sub match_user
|
||||
{
|
||||
my (%user) = @_;
|
||||
my (%user) = @_;
|
||||
|
||||
# Get data from config.
|
||||
# Get data from config.
|
||||
if (!conf_get('user')) { return; }
|
||||
my %uhp = conf_get('user');
|
||||
my %uhp = conf_get('user');
|
||||
|
||||
foreach my $userkey (keys %uhp) {
|
||||
# For each user block.
|
||||
my %ulhp = %{ $uhp{$userkey} };
|
||||
foreach my $uhk (keys %ulhp) {
|
||||
foreach my $userkey (keys %uhp) {
|
||||
# For each user block.
|
||||
my %ulhp = %{ $uhp{$userkey} };
|
||||
foreach my $uhk (keys %ulhp) {
|
||||
# For each user.
|
||||
|
||||
if ($uhk eq 'net') {
|
||||
if ($uhk eq 'net') {
|
||||
if (defined $user{svr}) {
|
||||
if (lc $user{svr} ne lc(($ulhp{$uhk})[0][0])) {
|
||||
# config.user:net conflicts with irc.user:svr.
|
||||
@@ -374,55 +374,55 @@ sub match_user
|
||||
}
|
||||
}
|
||||
elsif ($uhk eq 'mask') {
|
||||
# Put together the user information.
|
||||
my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host};
|
||||
if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) {
|
||||
# We've got a host match.
|
||||
return $userkey;
|
||||
}
|
||||
}
|
||||
# Put together the user information.
|
||||
my $mask = $user{nick}.q{!}.$user{user}.q{@}.$user{host};
|
||||
if (API::IRC::match_mask($mask, ($ulhp{$uhk})[0][0])) {
|
||||
# We've got a host match.
|
||||
return $userkey;
|
||||
}
|
||||
}
|
||||
elsif ($uhk eq 'chanstatus' and defined $ulhp{'net'}) {
|
||||
my ($ccst, $ccnm) = split m/[:]/sm, ($ulhp{$uhk})[0][0]; ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
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)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
# Privilege subroutine.
|
||||
sub has_priv
|
||||
{
|
||||
my ($cuser, $cpriv) = @_;
|
||||
my ($cuser, $cpriv) = @_;
|
||||
|
||||
if (conf_get("user:$cuser:privs")) {
|
||||
my $cups = (conf_get("user:$cuser:privs"))[0][0];
|
||||
if (conf_get("user:$cuser:privs")) {
|
||||
my $cups = (conf_get("user:$cuser:privs"))[0][0];
|
||||
|
||||
if (defined $Auto::PRIVILEGES{$cups}) {
|
||||
foreach (@{ $Auto::PRIVILEGES{$cups} }) {
|
||||
if ($_ eq $cpriv or $_ eq 'ALL') { return 1; }
|
||||
}
|
||||
}
|
||||
}
|
||||
if (defined $Auto::PRIVILEGES{$cups}) {
|
||||
foreach (@{ $Auto::PRIVILEGES{$cups} }) {
|
||||
if ($_ eq $cpriv or $_ eq 'ALL') { return 1; }
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
return;
|
||||
}
|
||||
|
||||
# Ratelimit check subroutine.
|
||||
@@ -461,61 +461,72 @@ sub ratelimit_check
|
||||
# Error subroutine.
|
||||
sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
|
||||
{
|
||||
my ($lvl, $msg, $fatal) = @_;
|
||||
my ($lvl, $msg, $fatal) = @_;
|
||||
|
||||
# Check for an invalid level.
|
||||
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
if ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
# Check for an invalid level.
|
||||
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
if ($fatal =~ m/[^0-1]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
|
||||
# Level 1: Print to screen.
|
||||
if ($lvl >= 1) {
|
||||
say "ERROR: $msg";
|
||||
}
|
||||
# Level 2: Log to file.
|
||||
if ($lvl >= 2) {
|
||||
API::Log::alog("ERROR: $msg");
|
||||
}
|
||||
# Level 1: Print to screen.
|
||||
if ($lvl >= 1) {
|
||||
say "ERROR: $msg";
|
||||
}
|
||||
# Level 2: Log to file.
|
||||
if ($lvl >= 2) {
|
||||
API::Log::alog("ERROR: $msg");
|
||||
}
|
||||
# Level 3: Log to IRC.
|
||||
if ($lvl >= 3) {
|
||||
API::Log::slog("ERROR: $msg");
|
||||
}
|
||||
|
||||
# If it's a fatal error, exit the program.
|
||||
if ($fatal) { exit; }
|
||||
# If it's a fatal error, exit the program.
|
||||
if ($fatal) {
|
||||
API::Std::event_run('on_shutdown');
|
||||
exit;
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Warn subroutine.
|
||||
sub awarn
|
||||
{
|
||||
my ($lvl, $msg) = @_;
|
||||
my ($lvl, $msg) = @_;
|
||||
|
||||
# Check for an invalid level.
|
||||
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
# Check for an invalid level.
|
||||
if ($lvl =~ m/[^0-9]/sm) { ## no critic qw(RegularExpressions::RequireExtendedFormatting)
|
||||
return;
|
||||
}
|
||||
|
||||
# Level 1: Print to screen.
|
||||
if ($lvl >= 1) {
|
||||
say "WARNING: $msg";
|
||||
}
|
||||
# Level 2: Log to file.
|
||||
if ($lvl >= 2) {
|
||||
API::Log::alog("WARNING: $msg");
|
||||
}
|
||||
# Level 1: Print to screen.
|
||||
if ($lvl >= 1) {
|
||||
say "WARNING: $msg";
|
||||
}
|
||||
# Level 2: Log to file.
|
||||
if ($lvl >= 2) {
|
||||
API::Log::alog("WARNING: $msg");
|
||||
}
|
||||
# Level 3: Log to IRC.
|
||||
if ($lvl >= 3) {
|
||||
API::Log::slog("WARNING: $msg");
|
||||
}
|
||||
|
||||
return 1;
|
||||
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:
|
||||
+26
-4
@@ -125,9 +125,31 @@ sub cmd_modreload
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hash for MODLIST. Spanish, French and German needed.
|
||||
our %HELP_MODLIST = (
|
||||
'en' => "This will return a list of all currently loaded modules. \2Syntax:\2 MODLIST",
|
||||
);
|
||||
# MODLIST callback.
|
||||
sub cmd_modlist
|
||||
{
|
||||
my ($src, undef) = @_;
|
||||
|
||||
# Iterate through all loaded modules.
|
||||
my $str;
|
||||
foreach (keys %API::Std::MODULE) {
|
||||
$str .= ", \2$_\2 (v".$API::Std::MODULE{$_}{version}.')';
|
||||
}
|
||||
|
||||
# Return it.
|
||||
$str = substr $str, 2;
|
||||
notice($src->{svr}, $src->{nick}, "\2Module List:\2 $str");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hash for SHUTDOWN. Spanish, French and German needed.
|
||||
our %HELP_SHUTDOWN = (
|
||||
'en' => 'This will send out shutdown notifications, quit all networks, flush the database then exit the program.',
|
||||
'en' => "This will send out shutdown notifications, quit all networks, flush the database then exit the program. \2Syntax:\2 SHUTDOWN",
|
||||
);
|
||||
# SHUTDOWN callback.
|
||||
sub cmd_shutdown
|
||||
@@ -164,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;
|
||||
|
||||
@@ -292,4 +314,4 @@ sub cmd_help
|
||||
|
||||
|
||||
1;
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
+82
-25
@@ -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");
|
||||
}
|
||||
}
|
||||
|
||||
@@ -32,8 +32,8 @@ hook_add("on_quit", "quit_update_chanusers", sub {
|
||||
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{$svr} }) {
|
||||
if (defined $Proto::IRC::chanusers{$svr}{$ccu}{$src{nick}}) { delete $Proto::IRC::chanusers{$svr}{$ccu}{$src{nick}}; }
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -43,22 +43,31 @@ hook_add("on_quit", "quit_update_chanusers", sub {
|
||||
hook_add("on_connect", "on_connect_modes", sub {
|
||||
my ($svr) = @_;
|
||||
|
||||
if (conf_get("server:$svr:modes")) {
|
||||
my $connmodes = (conf_get("server:$svr:modes"))[0][0];
|
||||
API::IRC::umode($svr, $connmodes);
|
||||
}
|
||||
if (conf_get("server:$svr:modes")) {
|
||||
my $connmodes = (conf_get("server:$svr:modes"))[0][0];
|
||||
API::IRC::umode($svr, $connmodes);
|
||||
}
|
||||
|
||||
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) = @_;
|
||||
my ($svr) = @_;
|
||||
|
||||
if (conf_get("server:$svr:idstr")) {
|
||||
my $idstr = (conf_get("server:$svr:idstr"))[0][0];
|
||||
Auto::socksnd($svr, $idstr);
|
||||
}
|
||||
my $idstr = (conf_get("server:$svr:idstr"))[0][0];
|
||||
Auto::socksnd($svr, $idstr);
|
||||
}
|
||||
|
||||
return 1;
|
||||
});
|
||||
@@ -67,14 +76,14 @@ hook_add("on_connect", "plaintext_auth", sub {
|
||||
hook_add("on_connect", "autojoin", sub {
|
||||
my ($svr) = @_;
|
||||
|
||||
# Get the auto-join from the config.
|
||||
my @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] };
|
||||
|
||||
# Join the channels.
|
||||
if (!defined $cajoin[1]) {
|
||||
# For single-line ajoins.
|
||||
my @sajoin = split(',', $cajoin[0]);
|
||||
|
||||
# Get the auto-join from the config.
|
||||
my @cajoin = @{ (conf_get("server:$svr:ajoin"))[0] };
|
||||
|
||||
# Join the channels.
|
||||
if (!defined $cajoin[1]) {
|
||||
# For single-line ajoins.
|
||||
my @sajoin = split(',', $cajoin[0]);
|
||||
|
||||
foreach (@sajoin) {
|
||||
# Check if a key was specified.
|
||||
if ($_ =~ m/\s/xsm) {
|
||||
@@ -84,13 +93,13 @@ hook_add("on_connect", "autojoin", sub {
|
||||
}
|
||||
else {
|
||||
# Else join without one.
|
||||
API::IRC::cjoin($svr, $_);
|
||||
API::IRC::cjoin($svr, $_);
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# For multi-line ajoins.
|
||||
foreach (@cajoin) {
|
||||
}
|
||||
else {
|
||||
# For multi-line ajoins.
|
||||
foreach (@cajoin) {
|
||||
# Check if a key was specified.
|
||||
if ($_ =~ m/\s/xsm) {
|
||||
# There was, join with it.
|
||||
@@ -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, 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.
|
||||
@@ -133,4 +190,4 @@ sub clear_usercmd_timer
|
||||
|
||||
|
||||
1;
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
+101
-77
@@ -4,11 +4,12 @@
|
||||
package Lib::Auto;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(say);
|
||||
use English qw(-no_match_vars);
|
||||
use Sys::Hostname;
|
||||
use feature qw(switch);
|
||||
use API::Std qw(hook_add conf_get err);
|
||||
use API::Log qw(println dbug alog);
|
||||
use API::Log qw(dbug alog);
|
||||
our $VERSION = 3.000000;
|
||||
|
||||
# Core events.
|
||||
@@ -19,7 +20,7 @@ API::Std::event_add('on_rehash');
|
||||
sub checkver
|
||||
{
|
||||
if (!$Auto::NUC and Auto::RSTAGE ne 'd') {
|
||||
println '* Connecting to update server...';
|
||||
say '* Connecting to update server...';
|
||||
my $uss = IO::Socket::INET->new(
|
||||
'Proto' => 'tcp',
|
||||
'PeerAddr' => 'dist.xelhua.org',
|
||||
@@ -37,11 +38,11 @@ sub checkver
|
||||
}
|
||||
elsif ($v eq 'version') {
|
||||
if (Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE ne $c) {
|
||||
println('!!! NOTICE !!! Your copy of Auto is outdated. Current version: '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.' - Latest version: '.$c);
|
||||
println('!!! NOTICE !!! You can get the latest Auto by downloading '.$dll);
|
||||
say('!!! NOTICE !!! Your copy of Auto is outdated. Current version: '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.' - Latest version: '.$c);
|
||||
say('!!! NOTICE !!! You can get the latest Auto by downloading '.$dll);
|
||||
}
|
||||
else {
|
||||
println('* Auto is up-to-date.');
|
||||
say('* Auto is up-to-date.');
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -54,7 +55,7 @@ sub rehash
|
||||
my %newsettings = $Auto::CONF->parse or err(2, 'Failed to parse configuration file!', 0) and return;
|
||||
|
||||
# Check for required configuration values.
|
||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype);
|
||||
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit bantype);
|
||||
foreach my $REQCVAL (@REQCVALS) {
|
||||
if (!defined $newsettings{$REQCVAL}) {
|
||||
err(2, "Missing required configuration value: $REQCVAL", 0) and return;
|
||||
@@ -133,83 +134,106 @@ 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;
|
||||
}
|
||||
}
|
||||
|
||||
# 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; }
|
||||
@@ -261,7 +285,7 @@ sub signal_perlwarn
|
||||
my ($warnmsg) = @_;
|
||||
$warnmsg =~ s/(\n|\r)//xsmg;
|
||||
alog 'Perl Warning: '.$warnmsg;
|
||||
if ($Auto::DEBUG) { println 'Perl Warning: '.$warnmsg; }
|
||||
if ($Auto::DEBUG) { say 'Perl Warning: '.$warnmsg; }
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -276,10 +300,10 @@ sub signal_perldie
|
||||
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'A fatal error occurred!'); }
|
||||
API::Std::event_run('on_shutdown');
|
||||
sleep 1;
|
||||
println 'FATAL: '.$diemsg;
|
||||
say 'FATAL: '.$diemsg;
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
+3
-3
@@ -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, 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:
|
||||
+153
-153
@@ -12,18 +12,18 @@ sub new
|
||||
my ($file) = @_;
|
||||
my $self = bless {}, $class;
|
||||
|
||||
# Check to see if the configuration file exists.
|
||||
if (!-e "$Auto::Bin/../etc/$file") {
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Open, read and close the config.
|
||||
open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0;
|
||||
my @cosfl = <$FCONF> or return 0;
|
||||
close $FCONF or return 0;
|
||||
|
||||
# Save it to self variable.
|
||||
$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file";
|
||||
# Check to see if the configuration file exists.
|
||||
if (!-e "$Auto::Bin/../etc/$file") {
|
||||
return 0;
|
||||
}
|
||||
|
||||
# Open, read and close the config.
|
||||
open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0;
|
||||
my @cosfl = <$FCONF> or return 0;
|
||||
close $FCONF or return 0;
|
||||
|
||||
# Save it to self variable.
|
||||
$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file";
|
||||
|
||||
return $self;
|
||||
}
|
||||
@@ -31,150 +31,150 @@ sub new
|
||||
# Parse the configuration file.
|
||||
sub parse
|
||||
{
|
||||
# Get the path to the file.
|
||||
my $self = shift;
|
||||
my $file = $self->{'config'}->{'path'};
|
||||
my $blk = 0;
|
||||
my (%rs);
|
||||
|
||||
# Open, read and close it.
|
||||
open(my $FCONF, q{<}, "$file") or return 0;
|
||||
my @fbuf = <$FCONF> or return 0;
|
||||
close $FCONF or return 0;
|
||||
|
||||
# Iterate the file.
|
||||
foreach my $buff (@fbuf) {
|
||||
# Main newline buffer.
|
||||
if (defined $buff) {
|
||||
# If the line begins with a #, it's a comment so ignore it.
|
||||
if (substr($buff, 0, 1) eq '#') {
|
||||
next;
|
||||
}
|
||||
|
||||
if ($buff =~ m/;/) {
|
||||
# Semicolon buffer.
|
||||
my @asbuf = split(';', $buff);
|
||||
foreach my $asbuff (@asbuf) {
|
||||
if (defined $asbuff) {
|
||||
|
||||
# Space buffer.
|
||||
my @ebuf = split(' ', $asbuff);
|
||||
if (!defined $ebuf[0] or !defined $ebuf[1]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
my $param = $ebuf[1];
|
||||
|
||||
if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
|
||||
# Multi-word string.
|
||||
$param = substr($param, 1);
|
||||
|
||||
for (my $i = 2; $i < scalar(@ebuf); $i++) {
|
||||
if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
|
||||
$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
|
||||
last;
|
||||
}
|
||||
else {
|
||||
$param .= " ".$ebuf[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
|
||||
# Single-word string.
|
||||
$param = substr($param, 1, length($ebuf[1]) - 2);
|
||||
}
|
||||
elsif ($param =~ m/[0-9]/) {
|
||||
# Numeric.
|
||||
$param =~ s/[^0-9.]//g;
|
||||
}
|
||||
else {
|
||||
# Garbage.
|
||||
next;
|
||||
}
|
||||
|
||||
my @param = ($param);
|
||||
|
||||
unless (!$blk) {
|
||||
# We're inside a block.
|
||||
if ($blk =~ m/@@@/) {
|
||||
# We're inside a block with a parameter.
|
||||
my @sblk = split('@@@', $blk);
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're inside a block with no parameter.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$blk}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
# Get the path to the file.
|
||||
my $self = shift;
|
||||
my $file = $self->{'config'}->{'path'};
|
||||
my $blk = 0;
|
||||
my (%rs);
|
||||
|
||||
# Open, read and close it.
|
||||
open(my $FCONF, q{<}, "$file") or return 0;
|
||||
my @fbuf = <$FCONF> or return 0;
|
||||
close $FCONF or return 0;
|
||||
|
||||
# Iterate the file.
|
||||
foreach my $buff (@fbuf) {
|
||||
# Main newline buffer.
|
||||
if (defined $buff) {
|
||||
# If the line begins with a #, it's a comment so ignore it.
|
||||
if (substr($buff, 0, 1) eq '#') {
|
||||
next;
|
||||
}
|
||||
|
||||
if ($buff =~ m/;/) {
|
||||
# Semicolon buffer.
|
||||
my @asbuf = split(';', $buff);
|
||||
foreach my $asbuff (@asbuf) {
|
||||
if (defined $asbuff) {
|
||||
|
||||
# Space buffer.
|
||||
my @ebuf = split(' ', $asbuff);
|
||||
if (!defined $ebuf[0] or !defined $ebuf[1]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
my $param = $ebuf[1];
|
||||
|
||||
if (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) ne '"') {
|
||||
# Multi-word string.
|
||||
$param = substr($param, 1);
|
||||
|
||||
for (my $i = 2; $i < scalar(@ebuf); $i++) {
|
||||
if (substr($ebuf[$i], length($ebuf[$i]) - 1, 1) eq '"') {
|
||||
$param .= " ".substr($ebuf[$i], 0, length($ebuf[$i]) - 1);
|
||||
last;
|
||||
}
|
||||
else {
|
||||
$param .= " ".$ebuf[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif (substr($param, 0, 1) eq '"' and substr($param, length($param) - 1, 1) eq '"') {
|
||||
# Single-word string.
|
||||
$param = substr($param, 1, length($ebuf[1]) - 2);
|
||||
}
|
||||
elsif ($param =~ m/[0-9]/) {
|
||||
# Numeric.
|
||||
$param =~ s/[^0-9.]//g;
|
||||
}
|
||||
else {
|
||||
# Garbage.
|
||||
next;
|
||||
}
|
||||
|
||||
my @param = ($param);
|
||||
|
||||
unless (!$blk) {
|
||||
# We're inside a block.
|
||||
if ($blk =~ m/@@@/) {
|
||||
# We're inside a block with a parameter.
|
||||
my @sblk = split('@@@', $blk);
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$sblk[0]}{$sblk[1]}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're inside a block with no parameter.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$blk}{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$blk}{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$blk}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're not inside a block.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# No semicolon space buffer.
|
||||
my @ebuf = split(' ', $buff);
|
||||
|
||||
if (!defined $ebuf[0]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
|
||||
if (defined $ebuf[1]) {
|
||||
if ($ebuf[1] eq '{') {
|
||||
# This is the beginning of a block with no parameter.
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$blk}{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# We're not inside a block.
|
||||
|
||||
# Check to see if this config option already exists.
|
||||
if (defined $rs{$ebuf[0]}) {
|
||||
# It does, so merely push this second one to the existing array.
|
||||
push(@{ $rs{$ebuf[0]} }, $param);
|
||||
}
|
||||
else {
|
||||
# It doesn't, create it as an array.
|
||||
@{ $rs{$ebuf[0]} } = @param;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
# No semicolon space buffer.
|
||||
my @ebuf = split(' ', $buff);
|
||||
|
||||
if (!defined $ebuf[0]) {
|
||||
# Garbage. Ignoring.
|
||||
next;
|
||||
}
|
||||
|
||||
if (defined $ebuf[1]) {
|
||||
if ($ebuf[1] eq '{') {
|
||||
# This is the beginning of a block with no parameter.
|
||||
$blk = $ebuf[0];
|
||||
}
|
||||
elsif (defined $ebuf[2]) {
|
||||
if ($ebuf[2] eq '{') {
|
||||
# This is the beginning of a block with a parameter.
|
||||
my $param = $ebuf[1];
|
||||
$param =~ s/"//g;
|
||||
$blk = $ebuf[0].'@@@'.$param;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($ebuf[0] eq '}') {
|
||||
# This is the end of a block.
|
||||
$blk = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Return the configuration data.
|
||||
return %rs;
|
||||
}
|
||||
elsif (defined $ebuf[2]) {
|
||||
if ($ebuf[2] eq '{') {
|
||||
# This is the beginning of a block with a parameter.
|
||||
my $param = $ebuf[1];
|
||||
$param =~ s/"//g;
|
||||
$blk = $ebuf[0].'@@@'.$param;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($ebuf[0] eq '}') {
|
||||
# This is the end of a block.
|
||||
$blk = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Return the configuration data.
|
||||
return %rs;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
@@ -1,679 +0,0 @@
|
||||
# lib/Parser/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;
|
||||
use strict;
|
||||
use warnings;
|
||||
use API::Std qw(conf_get err awarn trans);
|
||||
use API::IRC;
|
||||
|
||||
# Raw parsing hash.
|
||||
our %RAWC = (
|
||||
'001' => \&num001,
|
||||
'005' => \&num005,
|
||||
'353' => \&num353,
|
||||
'432' => \&num432,
|
||||
'433' => \&num433,
|
||||
'438' => \&num438,
|
||||
'465' => \&num465,
|
||||
'471' => \&num471,
|
||||
'473' => \&num473,
|
||||
'474' => \&num474,
|
||||
'475' => \&num475,
|
||||
'477' => \&num477,
|
||||
'JOIN' => \&cjoin,
|
||||
'KICK' => \&kick,
|
||||
'MODE' => \&mode,
|
||||
'NICK' => \&nick,
|
||||
'NOTICE' => \¬ice,
|
||||
'PART' => \&part,
|
||||
'PRIVMSG' => \&privmsg,
|
||||
'QUIT' => \&quit,
|
||||
'TOPIC' => \&topic,
|
||||
);
|
||||
|
||||
# Variables for various functions.
|
||||
our (%got_001, %botnick, %botchans, %csprefix, %chanusers, %chanmodes);
|
||||
|
||||
# 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");
|
||||
|
||||
# Parse raw data.
|
||||
sub ircparse
|
||||
{
|
||||
my ($svr, $data) = @_;
|
||||
|
||||
# Split spaces into @ex.
|
||||
my @ex = split /\s+/, $data;
|
||||
|
||||
# Make sure there is enough data.
|
||||
if (defined $ex[0] and defined $ex[1]) {
|
||||
# If it's a ping...
|
||||
if ($ex[0] eq 'PING') {
|
||||
# send a PONG.
|
||||
Auto::socksnd($svr, "PONG ".$ex[1]);
|
||||
}
|
||||
# If it's AUTHENTICATE
|
||||
elsif ($ex[0] eq 'AUTHENTICATE') {
|
||||
if (API::Std::mod_exists("SASLAuth")) {
|
||||
M::SASLAuth::handle_authenticate($svr, @ex);
|
||||
}
|
||||
}
|
||||
else {
|
||||
# otherwise, check %RAWC for ex[1].
|
||||
if (defined $RAWC{$ex[1]}) {
|
||||
&{ $RAWC{$ex[1]} }($svr, @ex);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
###########################
|
||||
# Raw parsing subroutines #
|
||||
###########################
|
||||
|
||||
# Parse: Numeric:001
|
||||
# Successful connection.
|
||||
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};
|
||||
}
|
||||
|
||||
# Trigger on_connect.
|
||||
API::Std::event_run("on_connect", $svr);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:005
|
||||
# Prefixes and channel modes.
|
||||
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; }
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:353
|
||||
# NAMES reply.
|
||||
sub num353
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
# Get rid of the colon.
|
||||
$ex[5] = substr($ex[5], 1);
|
||||
# Delete the old chanusers hash if it exists.
|
||||
delete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]});
|
||||
# Iterate through each user.
|
||||
for (my $i = 5; $i < scalar(@ex); $i++) {
|
||||
my $fi = 0;
|
||||
foreach (keys %{ $csprefix{$svr} }) {
|
||||
# Check if the user has status in the channel.
|
||||
if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) {
|
||||
# He/she does. Lets set that.
|
||||
if (defined $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))}) {
|
||||
# If the user has multiple statuses.
|
||||
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} .= $_;
|
||||
}
|
||||
else {
|
||||
# Or not.
|
||||
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
|
||||
}
|
||||
$fi = 1;
|
||||
}
|
||||
}
|
||||
# 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;
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:432
|
||||
# Erroneous nickname.
|
||||
sub num432
|
||||
{
|
||||
my ($svr, undef) = @_;
|
||||
|
||||
if ($got_001{$svr}) {
|
||||
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.");
|
||||
}
|
||||
|
||||
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:433
|
||||
# Nickname is already in use.
|
||||
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});
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:438
|
||||
# Nick change too fast.
|
||||
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});
|
||||
});
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:465
|
||||
# You're banned creep!
|
||||
sub num465
|
||||
{
|
||||
my ($svr, undef) = @_;
|
||||
|
||||
err(3, "Banned from ".$svr."! Closing link...", 0);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:471
|
||||
# Cannot join channel: Channel is full.
|
||||
sub num471
|
||||
{
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
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
|
||||
{
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
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
|
||||
{
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:475
|
||||
# Cannot join channel: Bad key.
|
||||
sub num475
|
||||
{
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:477
|
||||
# Cannot join channel: Need registered nickname.
|
||||
sub num477
|
||||
{
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Need registered nickname.", 0);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: JOIN
|
||||
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}) {
|
||||
$botchans{$svr}{lc(substr $ex[2], 1)} = 1;
|
||||
API::Std::event_run("on_ucjoin", ($svr, $chan));
|
||||
}
|
||||
else {
|
||||
# It isn't. Update chanusers and trigger on_rcjoin.
|
||||
$chanusers{$svr}{lc(substr $ex[2], 1)}{$src{nick}} = 1;
|
||||
$src{svr} = $svr;
|
||||
API::Std::event_run("on_rcjoin", (\%src, $chan));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: KICK
|
||||
sub kick
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
|
||||
# Update chanusers.
|
||||
delete $chanusers{$svr}{$ex[2]}{$ex[3]} if defined $chanusers{$svr}{$ex[2]}{$ex[3]};
|
||||
|
||||
# Set $msg to the kick message.
|
||||
my $msg = 0;
|
||||
if (defined $ex[4]) {
|
||||
$msg = substr($ex[4], 1);
|
||||
if (defined $ex[5]) {
|
||||
for (my $i = 5; $i < scalar(@ex); $i++) {
|
||||
$msg .= " ".$ex[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Check if we were the ones kicked.
|
||||
if (lc($ex[3]) eq lc($botnick{$svr}{nick})) {
|
||||
# We were kicked!
|
||||
|
||||
# Delete channel from botchans.
|
||||
delete $botchans{$svr}{$ex[2]};
|
||||
|
||||
# Log this horrible act.
|
||||
API::Log::alog("I was kicked from ".$svr."/".$ex[2]." by ".$src{nick}."! Reason: ".$msg);
|
||||
|
||||
# Rejoin if we're told to in config.
|
||||
if (conf_get("server:$svr:autorejoin")) {
|
||||
if ((conf_get("server:$svr:autorejoin"))[0][0] eq 1) {
|
||||
API::IRC::cjoin($svr, $ex[2]);
|
||||
}
|
||||
}
|
||||
}
|
||||
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));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: MODE
|
||||
sub mode
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
if ($ex[2] ne $botnick{$svr}{nick}) {
|
||||
# Set data we'll need later.
|
||||
my $chan = $ex[2];
|
||||
my $modes = $ex[3];
|
||||
# Get rid of the useless data, so the mode parser will work smoothly.
|
||||
shift @ex; shift @ex; shift @ex; shift @ex;
|
||||
|
||||
# Check if the modes contain any status modes.
|
||||
my $nt = 0;
|
||||
foreach (keys %{ $csprefix{$svr} }) {
|
||||
if ($modes =~ /($_)/) {
|
||||
$nt = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
if ($nt) {
|
||||
# It did. Lets parse the changes.
|
||||
|
||||
my @ma = split(//, $modes);
|
||||
|
||||
my $op = 1;
|
||||
foreach my $maf (@ma) {
|
||||
if ($maf eq '+') {
|
||||
# If it's a +, change the operator to 1.
|
||||
$op = 1;
|
||||
}
|
||||
elsif ($maf eq '-') {
|
||||
# If it's a -, change the operator to 2.
|
||||
$op = 2;
|
||||
}
|
||||
else {
|
||||
# It's a mode, lets check if it's a status mode.
|
||||
my $nnt = 0;
|
||||
foreach (keys %{ $csprefix{$svr} }) {
|
||||
if ($maf eq $_) {
|
||||
$nnt = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
if ($nnt) {
|
||||
# It is a status mode, lets parse changes.
|
||||
my $user = shift(@ex);
|
||||
|
||||
if (defined $chanusers{$svr}{$chan}{$user}) {
|
||||
if ($op == 1) {
|
||||
if ($chanusers{$svr}{$chan}{$user} eq 1) {
|
||||
$chanusers{$svr}{$chan}{$user} = $maf;
|
||||
}
|
||||
else {
|
||||
$chanusers{$svr}{$chan}{$user} .= $maf;
|
||||
}
|
||||
}
|
||||
elsif ($op == 2) {
|
||||
if (length($chanusers{$svr}{$chan}{$user}) == 1) {
|
||||
$chanusers{$svr}{$chan}{$user} = 1;
|
||||
}
|
||||
else {
|
||||
$chanusers{$svr}{$chan}{$user} =~ s/($maf)//gxsm;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$chanusers{$svr}{$chan}{$user} = $maf;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# It is not. Lets adjust arguments accordingly.
|
||||
if (defined $chanmodes{$svr}{$maf}) {
|
||||
if ($chanmodes{$svr}{$maf} == 1 || $chanmodes{$svr}{$maf} == 2) { shift @ex; }
|
||||
if ($chanmodes{$svr}{$maf} == 3) {
|
||||
if ($op == 1) { shift @ex; }
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: NICK
|
||||
sub nick
|
||||
{
|
||||
my ($svr, ($uex, undef, $nex)) = @_;
|
||||
$nex = substr($nex, 1);
|
||||
|
||||
my %src = API::IRC::usrc(substr($uex, 1));
|
||||
|
||||
# Check if this is coming from ourselves.
|
||||
if ($src{nick} eq $botnick{$svr}{nick}) {
|
||||
# It is. Update bot nick hash.
|
||||
$botnick{$svr}{nick} = $nex;
|
||||
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
|
||||
}
|
||||
else {
|
||||
# It isn't. Update chanusers and trigger on_nick.
|
||||
foreach my $chk (keys %{ $chanusers{$svr} }) {
|
||||
if (defined $chanusers{$svr}{$chk}{$src{nick}}) {
|
||||
$chanusers{$svr}{$chk}{$nex} = $chanusers{$svr}{$chk}{$src{nick}};
|
||||
delete $chanusers{$svr}{$chk}{$src{nick}};
|
||||
}
|
||||
}
|
||||
API::Std::event_run("on_nick", ($svr, \%src, $nex));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: NOTICE
|
||||
sub notice
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
# Ensure this is coming from a user rather than a server.
|
||||
if ($ex[0] !~ m/!/xsm) { return; }
|
||||
|
||||
# Prepare all the data.
|
||||
my %src = API::IRC::usrc(substr $ex[0], 1);
|
||||
my $target = $ex[2];
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
$src{svr} = $svr;
|
||||
|
||||
# Send it off.
|
||||
API::Std::event_run("on_notice", (\%src, $target, @ex));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: 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}};
|
||||
|
||||
# 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));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: PRIVMSG
|
||||
sub privmsg
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
my %data = API::IRC::usrc(substr($ex[0], 1));
|
||||
|
||||
my @argv;
|
||||
for (my $i = 4; $i < scalar(@ex); $i++) {
|
||||
push(@argv, $ex[$i]);
|
||||
}
|
||||
$data{svr} = $svr;
|
||||
|
||||
my ($cmd, $cprefix, $rprefix);
|
||||
# Check if it's to a channel or to us.
|
||||
if (lc($ex[2]) eq lc($botnick{$svr}{nick})) {
|
||||
# It is coming to us in a private message.
|
||||
|
||||
# Ensure it's a valid length.
|
||||
if (length($ex[3]) > 1) {
|
||||
$cmd = uc(substr($ex[3], 1));
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is private or all.
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command requires a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else execute the command without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger event on_uprivmsg.
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
API::Std::event_run("on_uprivmsg", (\%data, @ex));
|
||||
}
|
||||
else {
|
||||
# It is coming to us in a channel message.
|
||||
$data{chan} = $ex[2];
|
||||
# Ensure it's a valid length before continuing.
|
||||
if (length($ex[3]) > 1) {
|
||||
$cprefix = (conf_get("fantasy_pf"))[0][0];
|
||||
$rprefix = substr($ex[3], 1, 1);
|
||||
$cmd = uc(substr($ex[3], 2));
|
||||
if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is public or all.
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command takes a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else continue executing without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv) if $rprefix eq $cprefix;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger event on_cprivmsg.
|
||||
my $target = $ex[2]; delete $data{chan};
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: QUIT
|
||||
sub quit
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
|
||||
# Set $msg to the quit message.
|
||||
my $msg = 0;
|
||||
if (defined $ex[2]) {
|
||||
$msg = substr($ex[2], 1);
|
||||
if (defined $ex[3]) {
|
||||
for (my $i = 3; $i < scalar(@ex); $i++) {
|
||||
$msg .= " ".$ex[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger on_quit.
|
||||
API::Std::event_run("on_quit", ($svr, \%src, $msg));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: TOPIC
|
||||
sub topic
|
||||
{
|
||||
my ($svr, @ex) = @_;
|
||||
my %src = API::IRC::usrc(substr($ex[0], 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));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
# vim: set ai sw=4 ts=4:
|
||||
+51
-51
@@ -10,58 +10,58 @@ use API::Log qw(dbug alog);
|
||||
# Parser.
|
||||
sub parse
|
||||
{
|
||||
my ($lang) = @_;
|
||||
|
||||
# Check that the language file exists.
|
||||
unless (-e "$Auto::Bin/../lang/$lang.alf") {
|
||||
# Otherwise, use English.
|
||||
dbug "Language '$lang' not found. Using English.";
|
||||
alog "Language '$lang' not found. Using English.";
|
||||
$lang = "en";
|
||||
}
|
||||
|
||||
# Open, read and close the file.
|
||||
open(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0;
|
||||
my @fbuf = <$FALF>;
|
||||
close $FALF;
|
||||
|
||||
# Iterate the file buffer.
|
||||
foreach my $buff (@fbuf) {
|
||||
if (defined $buff) {
|
||||
# Space buffer.
|
||||
my @sbuf = split(' ', $buff);
|
||||
|
||||
# Check for all required values.
|
||||
if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
|
||||
# Missing a value.
|
||||
next;
|
||||
}
|
||||
|
||||
# Make sure the first value is "msge".
|
||||
if ($sbuf[0] ne "msge") {
|
||||
# It isn't.
|
||||
next;
|
||||
}
|
||||
|
||||
my $id = $sbuf[1];
|
||||
my $val = $sbuf[2];
|
||||
|
||||
# If the translation is multi-word, continue to parse.
|
||||
if (defined $sbuf[3]) {
|
||||
for (my $i = 3; $i < scalar(@sbuf); $i++) {
|
||||
$val .= " ".$sbuf[$i];
|
||||
}
|
||||
}
|
||||
|
||||
# Save to memory.
|
||||
$id =~ s/"//g;
|
||||
$val =~ s/"//g;
|
||||
$API::Std::LANGE{$id} = $val;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
my ($lang) = @_;
|
||||
|
||||
# Check that the language file exists.
|
||||
unless (-e "$Auto::Bin/../lang/$lang.alf") {
|
||||
# Otherwise, use English.
|
||||
dbug "Language '$lang' not found. Using English.";
|
||||
alog "Language '$lang' not found. Using English.";
|
||||
$lang = "en";
|
||||
}
|
||||
|
||||
# Open, read and close the file.
|
||||
open(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0;
|
||||
my @fbuf = <$FALF>;
|
||||
close $FALF;
|
||||
|
||||
# Iterate the file buffer.
|
||||
foreach my $buff (@fbuf) {
|
||||
if (defined $buff) {
|
||||
# Space buffer.
|
||||
my @sbuf = split(' ', $buff);
|
||||
|
||||
# Check for all required values.
|
||||
if (!defined $sbuf[0] or !defined $sbuf[1] or !defined $sbuf[2]) {
|
||||
# Missing a value.
|
||||
next;
|
||||
}
|
||||
|
||||
# Make sure the first value is "msge".
|
||||
if ($sbuf[0] ne "msge") {
|
||||
# It isn't.
|
||||
next;
|
||||
}
|
||||
|
||||
my $id = $sbuf[1];
|
||||
my $val = $sbuf[2];
|
||||
|
||||
# If the translation is multi-word, continue to parse.
|
||||
if (defined $sbuf[3]) {
|
||||
for (my $i = 3; $i < scalar(@sbuf); $i++) {
|
||||
$val .= " ".$sbuf[$i];
|
||||
}
|
||||
}
|
||||
|
||||
# Save to memory.
|
||||
$id =~ s/"//g;
|
||||
$val =~ s/"//g;
|
||||
$API::Std::LANGE{$id} = $val;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
# vim: set ai sw=4 ts=4:
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
@@ -0,0 +1,756 @@
|
||||
# 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 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,
|
||||
'465' => \&num465,
|
||||
'471' => \&num471,
|
||||
'473' => \&num473,
|
||||
'474' => \&num474,
|
||||
'475' => \&num475,
|
||||
'477' => \&num477,
|
||||
'CAP' => \&cap,
|
||||
'JOIN' => \&cjoin,
|
||||
'KICK' => \&kick,
|
||||
'MODE' => \&mode,
|
||||
'NICK' => \&nick,
|
||||
'NOTICE' => \¬ice,
|
||||
'PART' => \&part,
|
||||
'PRIVMSG' => \&privmsg,
|
||||
'QUIT' => \&quit,
|
||||
'TOPIC' => \&topic,
|
||||
);
|
||||
|
||||
# Variables for various functions.
|
||||
our (%got_001, %botinfo, %botchans, %csprefix, %chanusers, %chanmodes, %cap);
|
||||
|
||||
# Events.
|
||||
API::Std::event_add('on_capack');
|
||||
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_nick');
|
||||
API::Std::event_add('on_notice');
|
||||
API::Std::event_add('on_part');
|
||||
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;
|
||||
|
||||
# Make sure there is enough data.
|
||||
if (defined $ex[0] and defined $ex[1]) {
|
||||
# If it's a ping...
|
||||
if ($ex[0] eq 'PING') {
|
||||
# send a PONG.
|
||||
Auto::socksnd($svr, "PONG ".$ex[1]);
|
||||
}
|
||||
# If it's AUTHENTICATE
|
||||
elsif ($ex[0] eq 'AUTHENTICATE') {
|
||||
if (API::Std::mod_exists("SASLAuth")) {
|
||||
M::SASLAuth::handle_authenticate($svr, @ex);
|
||||
}
|
||||
}
|
||||
else {
|
||||
# otherwise, check %RAWC for ex[1].
|
||||
if (defined $RAWC{$ex[1]}) {
|
||||
&{ $RAWC{$ex[1]} }($svr, @ex);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
###########################
|
||||
# Raw parsing subroutines #
|
||||
###########################
|
||||
|
||||
# Parse: Numeric:001
|
||||
# Successful connection.
|
||||
sub num001 {
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
$got_001{$svr} = 1;
|
||||
|
||||
# In case we don't get NICK from the server.
|
||||
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);
|
||||
|
||||
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]";
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:005
|
||||
# Server ISUPPORT.
|
||||
sub num005 {
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
# 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.
|
||||
API::Std::event_run('on_whoreply', ($svr, $ex[2], $ex[3], $ex[4], $ex[5], $ex[6], @ex[7..$#ex]));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:353
|
||||
# NAMES reply.
|
||||
sub num353 {
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
# Get rid of the colon.
|
||||
$ex[5] = substr($ex[5], 1);
|
||||
# Delete the old chanusers hash if it exists.
|
||||
delete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]});
|
||||
# Iterate through each user.
|
||||
for (my $i = 5; $i < scalar(@ex); $i++) {
|
||||
my $fi = 0;
|
||||
PFITER: foreach (keys %{ $csprefix{$svr} }) {
|
||||
# Check if the user has status in the channel.
|
||||
if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) {
|
||||
# He/she does. Lets set that.
|
||||
if (defined $chanusers{$svr}{$ex[4]}{lc $ex[$i]}) {
|
||||
# If the user has multiple statuses.
|
||||
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $chanusers{$svr}{$ex[4]}{lc $ex[$i]}.$_;
|
||||
delete $chanusers{$svr}{$ex[4]}{lc $ex[$i]};
|
||||
}
|
||||
else {
|
||||
# Or not.
|
||||
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
|
||||
}
|
||||
$fi = 1;
|
||||
$ex[$i] = substr $ex[$i], 1;
|
||||
}
|
||||
}
|
||||
# Check if there's still a prefix.
|
||||
foreach (keys %{$csprefix{$svr}}) {
|
||||
if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) { 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;
|
||||
}
|
||||
}
|
||||
|
||||
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 {
|
||||
my ($svr, undef) = @_;
|
||||
|
||||
if ($got_001{$svr}) {
|
||||
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.");
|
||||
}
|
||||
|
||||
delete $botinfo{$svr}{newnick} if (defined $botinfo{$svr}{newnick});
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:433
|
||||
# Nickname is already in use.
|
||||
sub num433 {
|
||||
my ($svr, undef) = @_;
|
||||
|
||||
if (defined $botinfo{$svr}{newnick}) {
|
||||
API::IRC::nick($svr, $botinfo{$svr}{newnick}."_");
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:438
|
||||
# Nick change too fast.
|
||||
sub num438 {
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
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});
|
||||
delete $botinfo{$svr}{newnick} if (defined $botinfo{$svr}{newnick});
|
||||
});
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:465
|
||||
# You're banned creep!
|
||||
sub num465 {
|
||||
my ($svr, undef) = @_;
|
||||
|
||||
err(3, "Banned from ".$svr."! Closing link...", 0);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:471
|
||||
# Cannot join channel: Channel is full.
|
||||
sub num471 {
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
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 {
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
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 {
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:475
|
||||
# Cannot join channel: Bad key.
|
||||
sub num475 {
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
err(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: Numeric:477
|
||||
# Cannot join channel: Need registered nickname.
|
||||
sub num477 {
|
||||
my ($svr, (undef, undef, undef, $chan)) = @_;
|
||||
|
||||
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 {
|
||||
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 $botinfo{$svr}{nick}) {
|
||||
$botchans{$svr}{lc $chan} = 1;
|
||||
API::Std::event_run("on_ucjoin", ($svr, $chan));
|
||||
}
|
||||
else {
|
||||
# It isn't. Update chanusers and trigger on_rcjoin.
|
||||
$chanusers{$svr}{lc $chan}{$src{nick}} = 1;
|
||||
$src{svr} = $svr;
|
||||
API::Std::event_run("on_rcjoin", (\%src, $chan));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: KICK
|
||||
sub kick {
|
||||
my ($svr, @ex) = @_;
|
||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
|
||||
# Update chanusers.
|
||||
delete $chanusers{$svr}{$ex[2]}{$ex[3]} if defined $chanusers{$svr}{$ex[2]}{$ex[3]};
|
||||
|
||||
# Set $msg to the kick message.
|
||||
my $msg = 0;
|
||||
if (defined $ex[4]) {
|
||||
$msg = substr($ex[4], 1);
|
||||
if (defined $ex[5]) {
|
||||
for (my $i = 5; $i < scalar(@ex); $i++) {
|
||||
$msg .= " ".$ex[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Check if we were the ones kicked.
|
||||
if (lc($ex[3]) eq lc($botinfo{$svr}{nick})) {
|
||||
# We were kicked!
|
||||
|
||||
# Delete channel from botchans.
|
||||
delete $botchans{$svr}{$ex[2]};
|
||||
|
||||
# Log this horrible act.
|
||||
API::Log::alog("I was kicked from ".$svr."/".$ex[2]." by ".$src{nick}."! Reason: ".$msg);
|
||||
|
||||
# Rejoin if we're told to in config.
|
||||
if (conf_get("server:$svr:autorejoin")) {
|
||||
if ((conf_get("server:$svr:autorejoin"))[0][0] eq 1) {
|
||||
API::IRC::cjoin($svr, $ex[2]);
|
||||
}
|
||||
}
|
||||
}
|
||||
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));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: MODE
|
||||
sub mode {
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
if ($ex[2] ne $botinfo{$svr}{nick}) {
|
||||
# Set data we'll need later.
|
||||
my $chan = $ex[2];
|
||||
my $modes = $ex[3];
|
||||
$modes =~ s/^://xsm;
|
||||
# Get rid of the useless data, so the mode parser will work smoothly.
|
||||
shift @ex; shift @ex; shift @ex; shift @ex;
|
||||
|
||||
# Check if the modes contain any status modes.
|
||||
my $nt = 0;
|
||||
foreach (keys %{ $csprefix{$svr} }) {
|
||||
if ($modes =~ /($_)/) {
|
||||
$nt = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
if ($nt) {
|
||||
# It did. Lets parse the changes.
|
||||
|
||||
my @ma = split(//, $modes);
|
||||
|
||||
my $op = 1;
|
||||
foreach my $maf (@ma) {
|
||||
if ($maf eq '+') {
|
||||
# If it's a +, change the operator to 1.
|
||||
$op = 1;
|
||||
}
|
||||
elsif ($maf eq '-') {
|
||||
# If it's a -, change the operator to 2.
|
||||
$op = 2;
|
||||
}
|
||||
else {
|
||||
# It's a mode, lets check if it's a status mode.
|
||||
my $nnt = 0;
|
||||
foreach (keys %{ $csprefix{$svr} }) {
|
||||
if ($maf eq $_) {
|
||||
$nnt = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
if ($nnt) {
|
||||
# It is a status mode, lets parse changes.
|
||||
my $user = shift(@ex);
|
||||
|
||||
if (defined $chanusers{$svr}{$chan}{$user}) {
|
||||
if ($op == 1) {
|
||||
if ($chanusers{$svr}{$chan}{$user} eq 1) {
|
||||
$chanusers{$svr}{$chan}{$user} = $maf;
|
||||
}
|
||||
else {
|
||||
$chanusers{$svr}{$chan}{$user} .= $maf;
|
||||
}
|
||||
}
|
||||
elsif ($op == 2) {
|
||||
if (length($chanusers{$svr}{$chan}{$user}) == 1) {
|
||||
$chanusers{$svr}{$chan}{$user} = 1;
|
||||
}
|
||||
else {
|
||||
$chanusers{$svr}{$chan}{$user} =~ s/($maf)//gxsm;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$chanusers{$svr}{$chan}{$user} = $maf;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# It is not. Lets adjust arguments accordingly.
|
||||
if (defined $chanmodes{$svr}{$maf}) {
|
||||
if ($chanmodes{$svr}{$maf} == 1 || $chanmodes{$svr}{$maf} == 2) { shift @ex; }
|
||||
if ($chanmodes{$svr}{$maf} == 3) {
|
||||
if ($op == 1) { shift @ex; }
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: NICK
|
||||
sub nick {
|
||||
my ($svr, ($uex, undef, $nex)) = @_;
|
||||
$nex =~ s/^://gxsm;
|
||||
|
||||
my %src = API::IRC::usrc(substr($uex, 1));
|
||||
|
||||
# Check if this is coming from ourselves.
|
||||
if ($src{nick} eq $botinfo{$svr}{nick}) {
|
||||
# It is. Update bot nick hash.
|
||||
$botinfo{$svr}{nick} = $nex;
|
||||
delete $botinfo{$svr}{newnick} if (defined $botinfo{$svr}{newnick});
|
||||
}
|
||||
else {
|
||||
# It isn't. Update chanusers and trigger on_nick.
|
||||
foreach my $chk (keys %{ $chanusers{$svr} }) {
|
||||
if (defined $chanusers{$svr}{$chk}{$src{nick}}) {
|
||||
$chanusers{$svr}{$chk}{$nex} = $chanusers{$svr}{$chk}{$src{nick}};
|
||||
delete $chanusers{$svr}{$chk}{$src{nick}};
|
||||
}
|
||||
}
|
||||
API::Std::event_run("on_nick", ($svr, \%src, $nex));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: NOTICE
|
||||
sub notice {
|
||||
my ($svr, @ex) = @_;
|
||||
|
||||
# Ensure this is coming from a user rather than a server.
|
||||
if ($ex[0] !~ m/!/xsm) { return; }
|
||||
|
||||
# Prepare all the data.
|
||||
my %src = API::IRC::usrc(substr $ex[0], 1);
|
||||
my $target = $ex[2];
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
$src{svr} = $svr;
|
||||
|
||||
# Send it off.
|
||||
API::Std::event_run("on_notice", (\%src, $target, @ex));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: 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}};
|
||||
|
||||
# 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));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: PRIVMSG
|
||||
sub privmsg {
|
||||
my ($svr, @ex) = @_;
|
||||
my %data = API::IRC::usrc(substr($ex[0], 1));
|
||||
|
||||
# Ensure this is coming from a user rather than a server.
|
||||
if ($ex[0] !~ m/!/xsm) { return; }
|
||||
|
||||
my @argv;
|
||||
for (my $i = 4; $i < scalar(@ex); $i++) {
|
||||
push(@argv, $ex[$i]);
|
||||
}
|
||||
$data{svr} = $svr;
|
||||
|
||||
my ($cmd, $cprefix, $rprefix);
|
||||
# Check if it's to a channel or to us.
|
||||
if (lc($ex[2]) eq lc($botinfo{$svr}{nick})) {
|
||||
# It is coming to us in a private message.
|
||||
|
||||
# Ensure it's a valid length.
|
||||
if (length($ex[3]) > 1) {
|
||||
$cmd = uc(substr($ex[3], 1));
|
||||
if (defined $API::Std::CMDS{$cmd}) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is private or all.
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command requires a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else execute the command without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger event on_uprivmsg.
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
API::Std::event_run("on_uprivmsg", (\%data, @ex));
|
||||
}
|
||||
else {
|
||||
# It is coming to us in a channel message.
|
||||
$data{chan} = $ex[2];
|
||||
# Ensure it's a valid length before continuing.
|
||||
if (length($ex[3]) > 1) {
|
||||
$cprefix = (conf_get("fantasy_pf"))[0][0];
|
||||
$rprefix = substr($ex[3], 1, 1);
|
||||
$cmd = uc(substr($ex[3], 2));
|
||||
if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
|
||||
# If this is indeed a command, continue.
|
||||
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
|
||||
# Ensure the level is public or all.
|
||||
if (API::Std::ratelimit_check(%data)) {
|
||||
# Continue if the user has not passed the ratelimit amount.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command takes a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans('Permission denied').q{.});
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else continue executing without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Send them a notice about their bad deed.
|
||||
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
|
||||
}
|
||||
}
|
||||
elsif ($API::Std::CMDS{$cmd}{lvl} == 3) {
|
||||
# Or if it's a logchan command...
|
||||
my ($lcn, $lcc) = split '/', (conf_get('logchan'))[0][0];
|
||||
if ($lcn eq $data{svr} and lc $lcc eq lc $data{chan}) {
|
||||
# Check if it's being sent from the logchan.
|
||||
if ($API::Std::CMDS{$cmd}{priv}) {
|
||||
# If this command takes a privilege...
|
||||
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
|
||||
# Make sure they have it.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
else {
|
||||
# Else give them the boot.
|
||||
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans('Permission denied').q{.});
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Else continue executing without any extra checks.
|
||||
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger event on_cprivmsg.
|
||||
my $target = $ex[2]; delete $data{chan};
|
||||
shift @ex; shift @ex; shift @ex;
|
||||
$ex[0] = substr $ex[0], 1;
|
||||
API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: QUIT
|
||||
sub quit {
|
||||
my ($svr, @ex) = @_;
|
||||
my %src = API::IRC::usrc(substr($ex[0], 1));
|
||||
|
||||
# Set $msg to the quit message.
|
||||
my $msg = 0;
|
||||
if (defined $ex[2]) {
|
||||
$msg = substr($ex[2], 1);
|
||||
if (defined $ex[3]) {
|
||||
for (my $i = 3; $i < scalar(@ex); $i++) {
|
||||
$msg .= " ".$ex[$i];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Trigger on_quit.
|
||||
API::Std::event_run("on_quit", ($svr, \%src, $msg));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Parse: 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;
|
||||
|
||||
# Trigger on_topic.
|
||||
API::Std::event_run('on_topic', (\%src, @ex[3..$#ex]));
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
+11
-11
@@ -12,12 +12,12 @@ use API::IRC qw(privmsg notice kick ban);
|
||||
sub _init
|
||||
{
|
||||
# Check for required configuration values.
|
||||
if (!conf_get('badwords')) {
|
||||
err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0);
|
||||
return;
|
||||
}
|
||||
if (!conf_get('badwords')) {
|
||||
err(2, 'Please verify that you have a badwords block with word entries defined in your configuration file.', 0);
|
||||
return;
|
||||
}
|
||||
# Create the act_on_badword hook.
|
||||
hook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return;
|
||||
hook_add('on_cprivmsg', 'act_on_badword', \&M::Badwords::actonbadword) or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -27,16 +27,16 @@ sub _init
|
||||
sub _void
|
||||
{
|
||||
# Delete the act_on_badword hook.
|
||||
hook_del('act_on_badword') or return 0;
|
||||
hook_del('act_on_badword') or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for act_on_badword hook.
|
||||
sub actonbadword
|
||||
{
|
||||
my (($src, $chan, @msg)) = @_;
|
||||
my (($src, $chan, @msg)) = @_;
|
||||
|
||||
my $msg = join ' ', @msg;
|
||||
|
||||
@@ -70,8 +70,8 @@ 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -122,6 +122,6 @@ 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.0a6+.
|
||||
|
||||
=back
|
||||
+30
-30
@@ -13,13 +13,13 @@ use URI::Escape;
|
||||
sub _init
|
||||
{
|
||||
# Check for required configuration values.
|
||||
if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) {
|
||||
err(2, "Please verify that you have bitly_user and bitly_key defined in your configuration file.", 0);
|
||||
return 0;
|
||||
}
|
||||
if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) {
|
||||
err(2, "Please verify that you have bitly_user and bitly_key defined in your configuration file.", 0);
|
||||
return 0;
|
||||
}
|
||||
# Create the SHORTEN and REVERSE commands.
|
||||
cmd_add("SHORTEN", 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return 0;
|
||||
cmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return 0;
|
||||
cmd_add("SHORTEN", 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return 0;
|
||||
cmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -29,11 +29,11 @@ sub _init
|
||||
sub _void
|
||||
{
|
||||
# Delete the SHORTEN and REVERSE commands.
|
||||
cmd_del("SHORTEN") or return 0;
|
||||
cmd_del("REVERSE") or return 0;
|
||||
cmd_del("SHORTEN") or return 0;
|
||||
cmd_del("REVERSE") or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hashes.
|
||||
@@ -47,37 +47,37 @@ our %HELP_REVERSE = (
|
||||
# Callback for SHORTEN command.
|
||||
sub shorten
|
||||
{
|
||||
my ($src, @args) = @_;
|
||||
my ($src, @args) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
|
||||
# Put together the call to the Bit.ly API.
|
||||
if (!defined $args[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
|
||||
my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
|
||||
$surl = uri_escape($surl);
|
||||
my $url = "http://api.bit.ly/v3/shorten?version=3.0.1&longUrl=".$surl."&apiKey=".$key."&login=".$user."&format=txt";
|
||||
my $url = "http://api.bit.ly/v3/shorten?version=3.0.1&longUrl=".$surl."&apiKey=".$key."&login=".$user."&format=txt";
|
||||
# Get the response via HTTP.
|
||||
my $response = $ua->get($url);
|
||||
|
||||
if ($response->is_success) {
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $response->decoded_content;
|
||||
chomp $d;
|
||||
chomp $d;
|
||||
# And send to channel.
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
}
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while shortening your URL.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for REVERSE command.
|
||||
@@ -104,22 +104,22 @@ sub reverse
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $response->decoded_content;
|
||||
chomp $d;
|
||||
chomp $d;
|
||||
# And send it to channel.
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
}
|
||||
else {
|
||||
privmsg($src->{svr}, $src->{chan}, "URL: ".$d);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while reversing your URL.");
|
||||
}
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while reversing your URL.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent,URI::Escape perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -179,6 +179,6 @@ 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.0a6+.
|
||||
|
||||
=back
|
||||
@@ -0,0 +1,115 @@
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# 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.0a6) 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.0a6+.
|
||||
|
||||
=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
|
||||
+39
-39
@@ -13,73 +13,73 @@ use JSON -support_by_pp;
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# Create the CALC command.
|
||||
cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return 0;
|
||||
# Create the CALC command.
|
||||
cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
sub _void
|
||||
{
|
||||
# Delete the CALC command.
|
||||
cmd_del("CALC") or return 0;
|
||||
# Delete the CALC command.
|
||||
cmd_del("CALC") or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hash.
|
||||
our %FHELP_CALC = (
|
||||
'en' => "This command will calculate an expression using Google Calculator. \002Syntax:\002 CALC <expression>",
|
||||
'en' => "This command will calculate an expression using Google Calculator. \002Syntax:\002 CALC <expression>",
|
||||
);
|
||||
|
||||
# Callback for CALC command.
|
||||
sub calc
|
||||
{
|
||||
my ($src, @args) = @_;
|
||||
my ($src, @args) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
# Create an instance of JSON.
|
||||
my $json = JSON->new();
|
||||
# Put together the call to the Google Calculator API.
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
# Create an instance of JSON.
|
||||
my $json = JSON->new();
|
||||
# Put together the call to the Google Calculator API.
|
||||
if (!defined $args[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
my $expr = join(' ', @args);
|
||||
my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr);
|
||||
# Get the response via HTTP.
|
||||
my $response = $ua->get($url);
|
||||
my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr);
|
||||
# Get the response via HTTP.
|
||||
my $response = $ua->get($url);
|
||||
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content);
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $json->allow_nonref->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($response->decoded_content);
|
||||
|
||||
if ($d->{error} eq "" or $d->{error} == 0) {
|
||||
# And send to channel
|
||||
if ($d->{error} eq "" or $d->{error} == 0) {
|
||||
# And send to channel
|
||||
privmsg($src->{svr}, $src->{chan}, "Result: ".$d->{lhs}." = ".$d->{rhs});
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "Google Calculator sent an error.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while sending your expression to Google Calculator.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent,URI::Escape,JSON,JSON::PP perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -119,6 +119,6 @@ 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.0a6+.
|
||||
|
||||
=back
|
||||
@@ -282,8 +282,8 @@ 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -338,7 +338,7 @@ 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.0a6+.
|
||||
|
||||
Ported from v1.0.
|
||||
|
||||
|
||||
@@ -75,8 +75,8 @@ 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: cpan=Net::Dict perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -99,6 +99,6 @@ 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.0a6+.
|
||||
|
||||
=back
|
||||
+11
-11
@@ -13,8 +13,8 @@ our $ANSWER = 0;
|
||||
sub _init
|
||||
{
|
||||
# Create the 8BALL and RIGBALL commands.
|
||||
cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return 0;
|
||||
cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return 0;
|
||||
cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return 0;
|
||||
cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -24,11 +24,11 @@ sub _init
|
||||
sub _void
|
||||
{
|
||||
# Delete the 8BALL and RIGBALL commands.
|
||||
cmd_del('8BALL') or return 0;
|
||||
cmd_del('RIGBALL') or return 0;
|
||||
cmd_del('8BALL') or return 0;
|
||||
cmd_del('RIGBALL') or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hashes.
|
||||
@@ -42,7 +42,7 @@ our %HELP_RIGBALL = (
|
||||
# Callback for 8BALL command.
|
||||
sub c_8ball
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
@@ -77,7 +77,7 @@ sub c_8ball
|
||||
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Answer:\002 ".$a);
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Callback for RIGBALL command.
|
||||
@@ -94,13 +94,13 @@ sub rigball
|
||||
$ANSWER = join(" ", @argv);
|
||||
privmsg($src->{svr}, $src->{nick}, "Answer set to: ".$ANSWER);
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -143,7 +143,7 @@ command for setting ("rigging") the 8-Ball's next answer.
|
||||
|
||||
=over
|
||||
|
||||
This module is compatible with Auto version 3.0.0a4+.
|
||||
This module is compatible with Auto version 3.0.0a6+.
|
||||
|
||||
Ported from Auto 1.0.
|
||||
|
||||
|
||||
+106
@@ -0,0 +1,106 @@
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# 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.0a6+.
|
||||
|
||||
=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
|
||||
+15
-15
@@ -12,7 +12,7 @@ use LWP::UserAgent;
|
||||
sub _init
|
||||
{
|
||||
# Create the FML command.
|
||||
cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0;
|
||||
cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
@@ -22,10 +22,10 @@ sub _init
|
||||
sub _void
|
||||
{
|
||||
# Delete the FML command.
|
||||
cmd_del('FML') or return 0;
|
||||
cmd_del('FML') or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hash.
|
||||
@@ -36,39 +36,39 @@ our %HELP_FML = (
|
||||
# Callback for FML command.
|
||||
sub fml
|
||||
{
|
||||
my ($src, undef) = @_;
|
||||
my ($src, undef) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
|
||||
# Get the random FML via HTTP.
|
||||
my $rp = $ua->get('http://rscript.org/lookup.php?type=fml');
|
||||
|
||||
if ($rp->is_success) {
|
||||
if ($rp->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = $rp->decoded_content;
|
||||
$d =~ s/(\n|\r)//g;
|
||||
$d =~ s/(\n|\r)//g;
|
||||
|
||||
# Get the FML.
|
||||
my (undef, $dfa) = split('Text: ', $d);
|
||||
my ($fml, undef) = split('Agree:', $dfa);
|
||||
|
||||
# And send to channel.
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml);
|
||||
}
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Random FML:\002 ".$fml);
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving the FML.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -110,7 +110,7 @@ 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.0a6+.
|
||||
|
||||
Ported from Auto 2.0.
|
||||
|
||||
|
||||
+3
-3
@@ -125,8 +125,8 @@ 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -154,6 +154,6 @@ 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.0a6+.
|
||||
|
||||
=back
|
||||
+14
-14
@@ -10,34 +10,34 @@ use API::IRC qw(privmsg);
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# Add a hook for when we join a channel.
|
||||
hook_add("on_ucjoin", "HelloChan", \&M::HelloChan::hello) or return 0;
|
||||
return 1;
|
||||
# Add a hook for when we join a channel.
|
||||
hook_add("on_ucjoin", "HelloChan", \&M::HelloChan::hello) or return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
sub _void
|
||||
{
|
||||
# Delete the hook.
|
||||
hook_del("on_ucjoin", "HelloChan") or return 0;
|
||||
return 1;
|
||||
# Delete the hook.
|
||||
hook_del("on_ucjoin", "HelloChan") or return 0;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Main subroutine.
|
||||
sub hello
|
||||
{
|
||||
my (($svr, $chan)) = @_;
|
||||
|
||||
# Send a PRIVMSG.
|
||||
privmsg($svr, $chan, "Hello channel! I am a bot!");
|
||||
|
||||
return 1;
|
||||
my (($svr, $chan)) = @_;
|
||||
|
||||
# Send a PRIVMSG.
|
||||
privmsg($svr, $chan, "Hello channel! I am a bot!");
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
|
||||
+38
-38
@@ -11,66 +11,66 @@ use LWP::UserAgent;
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# Create the ISITUP command.
|
||||
cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return 0;
|
||||
# Create the ISITUP command.
|
||||
cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
sub _void
|
||||
{
|
||||
# Delete the ISITUP command.
|
||||
cmd_del('ISITUP') or return 0;
|
||||
# Delete the ISITUP command.
|
||||
cmd_del('ISITUP') or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hashes.
|
||||
our %HELP_ISITUP = (
|
||||
'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP <url>",
|
||||
'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP <url>",
|
||||
);
|
||||
|
||||
# Callback for ISITUP command.
|
||||
sub check
|
||||
{
|
||||
my ($src, @argv) = @_;
|
||||
my ($src, @argv) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
# Do we have enough parameters?
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return 0;
|
||||
}
|
||||
my $curl = $argv[0];
|
||||
# Does the URL start with http(s)?
|
||||
if ($curl !~ m/^http/) {
|
||||
$curl = 'http://'.$curl;
|
||||
}
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
# Do we have enough parameters?
|
||||
if (!defined $argv[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
|
||||
return 0;
|
||||
}
|
||||
my $curl = $argv[0];
|
||||
# Does the URL start with http(s)?
|
||||
if ($curl !~ m/^http/) {
|
||||
$curl = 'http://'.$curl;
|
||||
}
|
||||
|
||||
# Get the response via HTTP.
|
||||
my $response = $ua->get($curl);
|
||||
# Get the response via HTTP.
|
||||
my $response = $ua->get($curl);
|
||||
|
||||
if ($response->is_success) {
|
||||
# If successful, it's up.
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.');
|
||||
}
|
||||
else {
|
||||
# Otherwise, it's down.
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.');
|
||||
}
|
||||
if ($response->is_success) {
|
||||
# If successful, it's up.
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be up from here.');
|
||||
}
|
||||
else {
|
||||
# Otherwise, it's down.
|
||||
privmsg($src->{svr}, $src->{chan}, $curl.' appears to be down from here.');
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -110,6 +110,6 @@ 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.0a6+.
|
||||
|
||||
=back
|
||||
@@ -0,0 +1,122 @@
|
||||
# Module: LinkTitle. 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::LinkTitle;
|
||||
use strict;
|
||||
use warnings;
|
||||
use LWP::UserAgent;
|
||||
use HTML::Entities;
|
||||
use API::Std qw(hook_add hook_del);
|
||||
use API::IRC qw(privmsg);
|
||||
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# Create the on_cprivmsg hook.
|
||||
hook_add('on_cprivmsg', 'privmsg.html.returntitle', \&M::LinkTitle::gettitle) or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
sub _void
|
||||
{
|
||||
# Delete the hook we created.
|
||||
hook_del('on_cprivmsg', 'privmsg.html.returntitle') or return;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Hook callback.
|
||||
sub gettitle
|
||||
{
|
||||
my ($src, $chan, @msg) = @_;
|
||||
|
||||
# Check if the message contains a URL.
|
||||
foreach my $smw (@msg) {
|
||||
if ($smw =~ m{(http|https)://}xsm) {
|
||||
# We've got a match, connect to the server.
|
||||
my $srv = $1;
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(3);
|
||||
# Get data.
|
||||
my $res = $ua->get($smw);
|
||||
|
||||
# Check if we're successful.
|
||||
if ($res->is_success) {
|
||||
# We were, decode the data.
|
||||
my $data = $res->decoded_content;
|
||||
|
||||
# Check for <title>
|
||||
if ($data =~ m{<title>(.*)</title>}ixsm) {
|
||||
# Found. Decode it.
|
||||
my $title = decode_entities($1);
|
||||
# Return to channel.
|
||||
privmsg($src->{svr}, $chan, "\2Title:\2 $title");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Start initialization.
|
||||
API::Std::mod_init('LinkTitle', 'Xelhua', '1.00', '3.0.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent,HTML::Entities perl=5.010000
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
LinkTitle - A module for returning the page title of links.
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
1.00
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
<starcoder> http://xelhua.org/auto.php
|
||||
<blue> Title: Xelhua / Projects / Auto
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module will make Auto parse all links sent to a channel. When a link is
|
||||
detected, Auto will connect to it and get the page title by scanning for the
|
||||
<title> tag and returning its contents to the channel.
|
||||
|
||||
=head1 DEPENDENCIES
|
||||
|
||||
This module is dependent on two modules from the CPAN.
|
||||
|
||||
=over
|
||||
|
||||
=item L<LWP::UserAgent|LWP::UserAgent>
|
||||
|
||||
This module is used for connecting to the target web server via HTTP(S).
|
||||
|
||||
=item L<HTML::Entities|HTML::Entities>
|
||||
|
||||
This module is used for decoding HTML entities in the response we receive from
|
||||
the server.
|
||||
|
||||
=back
|
||||
|
||||
=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. All rights
|
||||
reserved.
|
||||
|
||||
This module is released under the same licensing terms as Auto itself.
|
||||
+114
-26
@@ -5,14 +5,15 @@ package M::QDB;
|
||||
use strict;
|
||||
use warnings;
|
||||
use feature qw(switch);
|
||||
use API::Std qw(cmd_add cmd_del trans has_priv match_user);
|
||||
use API::Std qw(cmd_add cmd_del trans has_priv conf_get match_user);
|
||||
use API::IRC qw(privmsg notice);
|
||||
our @BUFFER;
|
||||
|
||||
sub _init
|
||||
{
|
||||
# Create the QDB command.
|
||||
cmd_add('QDB', 0, 0, \%M::QDB::HELP_QDB, \&M::QDB::cmd_qdb) or return;
|
||||
|
||||
|
||||
# Check the database format. Fail to load if it's PostgreSQL.
|
||||
if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load QDB: PostgreSQL is not supported.', 0); return; }
|
||||
|
||||
@@ -34,7 +35,7 @@ sub _void
|
||||
|
||||
# Help hash for QDB. Spanish, French and German translations needed.
|
||||
our %HELP_QDB = (
|
||||
'en' => "This command allows you to add, read, and delete quotes. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]",
|
||||
'en' => "This command allows you to add, read, and delete quotes. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL) [quote|expression]",
|
||||
);
|
||||
sub cmd_qdb
|
||||
{
|
||||
@@ -46,7 +47,7 @@ sub cmd_qdb
|
||||
return;
|
||||
}
|
||||
|
||||
# ADD|VIEW|COUNT|RAND|DEL.
|
||||
# ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL.
|
||||
given (uc $argv[0]) {
|
||||
when ('ADD') {
|
||||
# QDB ADD.
|
||||
@@ -55,13 +56,10 @@ sub cmd_qdb
|
||||
return;
|
||||
}
|
||||
|
||||
# Get rid of the ADD part.
|
||||
shift @argv;
|
||||
|
||||
# Insert into database.
|
||||
my $dbq = $Auto::DB->prepare('INSERT INTO qdb (creator, time, quote) VALUES (?, ?, ?)') or
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
$dbq->execute($src->{nick}, time, join(q{ }, @argv)) or
|
||||
$dbq->execute($src->{nick}, time, join(q{ }, @argv[1..$#argv])) or
|
||||
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
|
||||
|
||||
# Get ID.
|
||||
@@ -83,6 +81,9 @@ sub cmd_qdb
|
||||
$dbq->execute($argv[1]) or notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.') and return;
|
||||
my @data = $dbq->fetchrow_array;
|
||||
|
||||
# Check for an unusual issue.
|
||||
if (!defined $data[1]) { notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.'); return; }
|
||||
|
||||
# Send it back.
|
||||
privmsg($src->{svr}, $src->{chan}, "\002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
|
||||
privmsg($src->{svr}, $src->{chan}, $data[3]);
|
||||
@@ -114,6 +115,78 @@ sub cmd_qdb
|
||||
privmsg($src->{svr}, $src->{chan}, "\002ID:\002 $data[0] - \002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
|
||||
privmsg($src->{svr}, $src->{chan}, $data[3]);
|
||||
}
|
||||
when ('SEARCH') {
|
||||
# QDB SEARCH.
|
||||
|
||||
# Get all quotes.
|
||||
my $dbq = $Auto::DB->prepare('SELECT * FROM qdb') or return;
|
||||
$dbq->execute or return;
|
||||
my $quotes = $dbq->fetchall_hashref('quoteid') or return;
|
||||
|
||||
# Set expression.
|
||||
my $expr = my $rexpr = join ' ', @argv[1 .. $#argv];
|
||||
$rexpr =~ s{\(}{\\\(}g;
|
||||
$rexpr =~ s{\)}{\\\)}g;
|
||||
$rexpr =~ s{\?}{\\\?}g;
|
||||
$rexpr =~ s{\*}{\\\*}g;
|
||||
$rexpr =~ s{\[}{\\\[}g;
|
||||
$rexpr =~ s{\]}{\\\]}g;
|
||||
$rexpr =~ s{\.}{\\\.}g;
|
||||
$rexpr =~ s{\$}{\\\$}g;
|
||||
$rexpr =~ s{\^}{\\\^}g;
|
||||
|
||||
# Clear the buffer.
|
||||
@BUFFER = ();
|
||||
|
||||
# Iterate through all quotes.
|
||||
foreach my $qkt (keys %$quotes) {
|
||||
# Check if we have a match.
|
||||
if ($quotes->{$qkt}->{quote} =~ m/$rexpr/ixsm) {
|
||||
# Match. Add to buffer.
|
||||
push @BUFFER, "\2ID:\2 $qkt - ".$quotes->{$qkt}->{quote};
|
||||
}
|
||||
}
|
||||
|
||||
# Check if we had any matches.
|
||||
if (!defined $BUFFER[0]) {
|
||||
privmsg($src->{svr}, $src->{chan}, "No results for \2$expr\2.");
|
||||
return;
|
||||
}
|
||||
|
||||
# Return four quotes.
|
||||
privmsg($src->{svr}, $src->{chan}, "\2".scalar @BUFFER."\2 results for \2$expr\2:");
|
||||
my $i = 0;
|
||||
my $si = 3;
|
||||
if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1; }
|
||||
while ($i <= $si) {
|
||||
if (!defined $BUFFER[0]) {
|
||||
last;
|
||||
}
|
||||
|
||||
privmsg($src->{svr}, $src->{chan}, shift @BUFFER);
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
when ('MORE') {
|
||||
# Check if there's any quotes in the buffer.
|
||||
if (!defined $BUFFER[0]) {
|
||||
notice($src->{svr}, $src->{nick}, 'No quotes in buffer.');
|
||||
return;
|
||||
}
|
||||
|
||||
# Return four quotes.
|
||||
my $i = 0;
|
||||
my $si = 3;
|
||||
if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1; }
|
||||
while ($i <= $si) {
|
||||
if (!defined $BUFFER[0]) {
|
||||
last;
|
||||
}
|
||||
|
||||
privmsg($src->{svr}, $src->{chan}, shift @BUFFER);
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
when ('DEL') {
|
||||
# Check for the cmd.qdbdel privilege.
|
||||
if (!has_priv(match_user(%$src), 'cmd.qdbdel')) {
|
||||
@@ -138,37 +211,52 @@ sub cmd_qdb
|
||||
}
|
||||
|
||||
|
||||
API::Std::mod_init('QDB', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__);
|
||||
# vim: set ai sw=4 ts=4:
|
||||
API::Std::mod_init('QDB', 'Xelhua', '1.02', '3.0.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
|
||||
=head1 QDB
|
||||
=head1 NAME
|
||||
|
||||
=head2 Description
|
||||
QDB - Quote database module.
|
||||
|
||||
=over
|
||||
=head1 VERSION
|
||||
|
||||
This module adds the QDB (ADD|VIEW|COUNT|RAND|DEL) command, for adding,
|
||||
viewing, listing number of, viewing a random, deleting a quote from the Auto
|
||||
database.
|
||||
1.02
|
||||
|
||||
=back
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head2 Examples
|
||||
<JohnSmith> !qdb add <JohnDoe> moocows
|
||||
<Auto> Quote successfully submitted. ID: 732
|
||||
|
||||
=over
|
||||
=head1 DESCRIPTION
|
||||
|
||||
<JohnSmith> !qdb add <JohnDoe> moocows
|
||||
<Auto> Quote successfully submitted. ID: 732
|
||||
This module adds the QDB (ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL) command, for
|
||||
adding, viewing, listing number of, viewing a random, deleting a quote from the
|
||||
Auto database.
|
||||
|
||||
=back
|
||||
=head1 INSTALL
|
||||
|
||||
=head2 Technical
|
||||
Before using QDB, we'd recommend adding the following to your configuration
|
||||
file:
|
||||
|
||||
=over
|
||||
qdb_search_resnum <number>;
|
||||
|
||||
This module is compatible with Auto v3.0.0a4+.
|
||||
Where <number> is the amount of results returned per SEARCH/MORE load.
|
||||
|
||||
=back
|
||||
This is not required, 4 will be used if it is not specified.
|
||||
|
||||
=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
|
||||
+36
-55
@@ -13,62 +13,43 @@ use API::IRC qw(privmsg);
|
||||
# Initialization subroutine.
|
||||
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;
|
||||
# Check if this Auto was built with SASL support.
|
||||
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")) { $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', \&M::SASLAuth::handle_903) or return;
|
||||
# Hook for parsing 904.
|
||||
rchook_add('904', \&M::SASLAuth::handle_904) or return 0;
|
||||
rchook_add('904', \&M::SASLAuth::handle_904) or return;
|
||||
# Hook for parsing 906.
|
||||
rchook_add('906', \&M::SASLAuth::handle_906) or return 0;
|
||||
return 1;
|
||||
rchook_add('906', \&M::SASLAuth::handle_906) or return;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
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');
|
||||
return 1;
|
||||
# Delete the hooks.
|
||||
hook_del('on_capack') or return;
|
||||
rchook_del('903') or return;
|
||||
rchook_del('904') or return;
|
||||
rchook_del('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!");
|
||||
}
|
||||
|
||||
@@ -123,15 +104,15 @@ sub handle_904
|
||||
# SASL authentication aborted.
|
||||
sub handle_906
|
||||
{
|
||||
my ($svr, undef) = @_;
|
||||
Auto::socksnd($svr, 'CAP END');
|
||||
timer_del('auth_timeout');
|
||||
my ($svr, undef) = @_;
|
||||
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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -188,6 +169,6 @@ 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.0a6+.
|
||||
|
||||
=back
|
||||
+1456
File diff suppressed because it is too large.
Load diff
+47
-47
@@ -12,74 +12,74 @@ use XML::Simple;
|
||||
# Initialization subroutine.
|
||||
sub _init
|
||||
{
|
||||
# Create the Weather command.
|
||||
cmd_add("WEATHER", 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return 0;
|
||||
# Create the Weather command.
|
||||
cmd_add("WEATHER", 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Void subroutine.
|
||||
sub _void
|
||||
{
|
||||
# Delete the Weather command.
|
||||
cmd_del("WEATHER") or return 0;
|
||||
# Delete the Weather command.
|
||||
cmd_del("WEATHER") or return 0;
|
||||
|
||||
# Success.
|
||||
return 1;
|
||||
# Success.
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Help hashes.
|
||||
our %HELP_WEATHER = (
|
||||
'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER <location>",
|
||||
'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER <location>",
|
||||
);
|
||||
|
||||
# Callback for Weather command.
|
||||
sub weather
|
||||
{
|
||||
my ($src, @args) = @_;
|
||||
my ($src, @args) = @_;
|
||||
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
# Put together the call to the Wunderground API.
|
||||
if (!defined $args[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
my $loc = join(' ', @args);
|
||||
$loc =~ s/ /%20/g;
|
||||
my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=".$loc;
|
||||
# Get the response via HTTP.
|
||||
my $response = $ua->get($url);
|
||||
# Create an instance of LWP::UserAgent.
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent('Auto IRC Bot');
|
||||
$ua->timeout(2);
|
||||
# Put together the call to the Wunderground API.
|
||||
if (!defined $args[0]) {
|
||||
notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
|
||||
return 0;
|
||||
}
|
||||
my $loc = join(' ', @args);
|
||||
$loc =~ s/ /%20/g;
|
||||
my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=".$loc;
|
||||
# Get the response via HTTP.
|
||||
my $response = $ua->get($url);
|
||||
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = XMLin($response->decoded_content);
|
||||
# And send to channel
|
||||
if (!ref($d->{observation_location}->{country})) {
|
||||
my $windc = $d->{wind_string};
|
||||
if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); }
|
||||
privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
|
||||
privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "Location not found.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving your weather.");
|
||||
}
|
||||
if ($response->is_success) {
|
||||
# If successful, decode the content.
|
||||
my $d = XMLin($response->decoded_content);
|
||||
# And send to channel
|
||||
if (!ref($d->{observation_location}->{country})) {
|
||||
my $windc = $d->{wind_string};
|
||||
if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); }
|
||||
privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
|
||||
privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "Location not found.");
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Otherwise, send an error message.
|
||||
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving your weather.");
|
||||
}
|
||||
|
||||
return 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
# 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.0a6', __PACKAGE__);
|
||||
# vim: set ai et sw=4 ts=4:
|
||||
# build: cpan=LWP::UserAgent,XML::Simple perl=5.010000
|
||||
|
||||
__END__
|
||||
@@ -121,6 +121,6 @@ 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.0a6+.
|
||||
|
||||
=back
|
||||
@@ -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'
|
||||
);
|
||||
Reference in new issue
Block a user