470 lines
14 KiB
Perl
Executable File
470 lines
14 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
# bin/auto - Main file.
|
|
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
|
|
# This program is free software; rights to this code are stated in doc/LICENSE.
|
|
package Auto;
|
|
use 5.010_000;
|
|
use strict;
|
|
use warnings;
|
|
no feature qw(say state);
|
|
use POSIX;
|
|
use locale;
|
|
use English qw(-no_match_vars);
|
|
use Sys::Hostname;
|
|
use IO::Socket;
|
|
use IO::Select;
|
|
use DBI;
|
|
use DBD::SQLite;
|
|
use Class::Unload;
|
|
use FindBin qw($Bin);
|
|
our $Bin = $Bin; ## no critic qw(NamingConventions::Capitalization Variables::ProhibitPackageVars)
|
|
BEGIN {
|
|
unshift @INC, "$Bin/../lib";
|
|
|
|
# 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
|
|
};
|
|
}
|
|
use Lib::Auto;
|
|
use API::Std qw(conf_get err);
|
|
use API::Log qw(println alog dbug);
|
|
#use DB::Flatfile;
|
|
use Parser::Config;
|
|
use Parser::Lang;
|
|
use Parser::IRC;
|
|
use Core::IRC;
|
|
use Core::Cmd;
|
|
|
|
our $VERSION = 3.0.0;
|
|
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") {
|
|
println 'Missing build file(s). Please build Auto before running it.' and exit;
|
|
}
|
|
|
|
# Check build OS.
|
|
open my $BFOS, '<', "$Bin/../build/os" or println 'Cannot start: Broken build.' and exit;
|
|
my @BFOS = <$BFOS>;
|
|
close $BFOS or println 'Cannot start: Broken build.' and exit;
|
|
if ($BFOS[0] ne $OSNAME."\n") {
|
|
println 'Cannot start: Broken build.' and exit;
|
|
}
|
|
undef @BFOS;
|
|
|
|
# Check build features.
|
|
our $ENFEAT;
|
|
open my $BFFEAT, '<', "$Bin/../build/feat" or println 'Cannot start: Broken build.' and exit;
|
|
my @BFFEAT = <$BFFEAT>;
|
|
close $BFFEAT or println 'Cannot start: Broken build.' and exit;
|
|
$ENFEAT = substr $BFFEAT[0], 0, length($BFFEAT[0]) - 1;
|
|
undef @BFFEAT;
|
|
|
|
# Check build Perl version.
|
|
open my $BFPERL, '<', "$Bin/../build/perl" or println 'Cannot start: Broken build.' and exit;
|
|
my @BFPERL = <$BFPERL>;
|
|
close $BFPERL or println 'Cannot start: Broken build.' and exit;
|
|
if ($BFPERL[0] ne $]."\n") {
|
|
println 'Cannot start: Broken build.' and exit;
|
|
}
|
|
undef @BFPERL;
|
|
|
|
# Check build Auto version.
|
|
open my $BFVER, '<', "$Bin/../build/ver" or println 'Cannot start: Broken build.' and exit;
|
|
my @BFVER = <$BFVER>;
|
|
close $BFVER or println 'Cannot start: Broken build.' and exit;
|
|
if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
|
|
println 'Cannot start: Broken build.' and exit;
|
|
}
|
|
undef @BFVER;
|
|
|
|
# Set signal handlers.
|
|
local $SIG{TERM} = \&Lib::Auto::signal_term;
|
|
local $SIG{INT} = \&Lib::Auto::signal_int;
|
|
local $SIG{HUP} = \&Lib::Auto::signal_hup;
|
|
local $SIG{'__WARN__'} = \&Lib::Auto::signal_perlwarn;
|
|
local $SIG{'__DIE__'} = \&Lib::Auto::signal_perldie;
|
|
API::Std::event_add('on_sigterm');
|
|
API::Std::event_add('on_sigint');
|
|
API::Std::event_add('on_sighup');
|
|
|
|
|
|
# Print startup message.
|
|
println <<'EOF';
|
|
8""""8
|
|
8 8 e e eeeee eeeee
|
|
8eeee8 8 8 8 8 88
|
|
88 8 8e 8 8e 8 8
|
|
88 8 88 8 88 8 8
|
|
88 8 88ee8 88 8eee8
|
|
EOF
|
|
println '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
|
|
|
|
our ($APID, %TIMERS);
|
|
|
|
# Get arguments.
|
|
our $DEBUG = 0;
|
|
our $NUC = 0;
|
|
if (defined $ARGV[0]) {
|
|
foreach (@ARGV) {
|
|
given ($_) {
|
|
when ('-d') { $DEBUG = 1; }
|
|
when ('-nuc') { $NUC = 1; }
|
|
}
|
|
}
|
|
}
|
|
|
|
# Check for updates.
|
|
Lib::Auto::checkver();
|
|
|
|
# Include IPv6 if Auto was built for it.
|
|
if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6; }
|
|
# Include SSL if Auto was built for it.
|
|
if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL; }
|
|
|
|
# Parse configuration file.
|
|
println '* Parsing configuration file auto.conf...';
|
|
our $CONF = Parser::Config->new('auto.conf') or err(1, 'Failed to parse configuration file!', 1);
|
|
our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
|
|
println ' Success';
|
|
|
|
if (conf_get('die')) {
|
|
if ((conf_get('die'))[0][0] == 1) {
|
|
println '!!! You didn\'t read the whole config.';
|
|
println '!!! Insert new user then try again.';
|
|
exit;
|
|
}
|
|
}
|
|
|
|
# Check for required configuration values.
|
|
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit);
|
|
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);
|
|
}
|
|
}
|
|
undef @REQCVALS;
|
|
|
|
# Parse translations.
|
|
println '* Parsing translation files...';
|
|
our $LOCALE = (conf_get('locale'))[0][0];
|
|
my @lang = split m/[_]/, $LOCALE;
|
|
Parser::Lang::parse($lang[0]) or err(2, 'Failed to parse translation files!', 1);
|
|
undef @lang;
|
|
println ' Success';
|
|
|
|
# Expire old logs.
|
|
API::Log::expire_logs();
|
|
|
|
# Connect to database.
|
|
if (!-e "$Bin/../etc/auto.db") {
|
|
system "touch $Bin/../etc/auto.db";
|
|
system "chmod a+x $Bin/../etc/auto.db";
|
|
}
|
|
our $DB = DBI->connect("dbi:SQLite:dbname=$Bin/../etc/auto.db", q{}, q{});
|
|
|
|
# Ratelimit timer.
|
|
Core::IRC::clear_usercmd_timer();
|
|
|
|
# Parse privileges.
|
|
our (%PRIVILEGES);
|
|
# If there are any privsets.
|
|
if (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");
|
|
|
|
# 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} } = ($_);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Successful startup.
|
|
our $STARTTIME = time;
|
|
println '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.};
|
|
alog 'Auto successfully started.';
|
|
|
|
# Fork into the background if not in debug mode.
|
|
if (!$DEBUG) {
|
|
println '*** Becoming a daemon...';
|
|
open STDIN, '<', '/dev/null' or err(2, "Can't read /dev/null: $ERRNO", 1);
|
|
open STDOUT, '>>', '/dev/null' or err(2, "Can't write to /dev/null: $ERRNO", 1);
|
|
open STDERR, '>>', '/dev/null' or err(2, "Can't write to /dev/null: $ERRNO", 1);
|
|
$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;
|
|
exit;
|
|
}
|
|
POSIX::setsid() or err(2, "Can't start a new session: $ERRNO", 1);
|
|
}
|
|
else {
|
|
$APID = $PID;
|
|
}
|
|
|
|
# Events.
|
|
API::Std::event_add('on_preconnect');
|
|
|
|
# Load modules.
|
|
if (conf_get('module')) {
|
|
alog '* Loading modules...';
|
|
dbug '* Loading modules...';
|
|
foreach (@{ (conf_get('module'))[0] }) {
|
|
mod_load($_);
|
|
}
|
|
}
|
|
|
|
## Create sockets.
|
|
alog '* Connecting to servers...';
|
|
dbug '* Connecting to servers...';
|
|
# Get servers from config.
|
|
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;
|
|
}
|
|
|
|
# Success!
|
|
if ($it) {
|
|
alog '** Success: Connected to server(s).';
|
|
dbug '** Success: Connected to server(s).';
|
|
}
|
|
else {
|
|
err(2, 'No server connections.', 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('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);
|
|
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;
|
|
|
|
# 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};
|
|
next;
|
|
}
|
|
|
|
# Read the buffer.
|
|
my $data .= $idata;
|
|
while ($data =~ s/(.*\n)//) {
|
|
my $line = $1;
|
|
|
|
# Remove the newlines.
|
|
chomp $line;
|
|
# Debug.
|
|
dbug $sockid.' >> '.$line;
|
|
|
|
# Parse data.
|
|
Parser::IRC::ircparse($sockid, $line);
|
|
}
|
|
}
|
|
}
|
|
|
|
###############
|
|
# Subroutines #
|
|
###############
|
|
|
|
# Send data to socket.
|
|
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;
|
|
}
|
|
}
|
|
|
|
# Load a module.
|
|
sub mod_load {
|
|
my ($module) = @_;
|
|
|
|
if (-e "$Bin/../modules/$module.pm") {
|
|
do "$Bin/../modules/$module.pm" and return 1;
|
|
}
|
|
else {
|
|
if (-e "$Bin/../modules/$module/main.pm") {
|
|
do "$Bin/../modules/$module/main.pm" and return 1;
|
|
}
|
|
}
|
|
|
|
my $errs = $EVAL_ERROR;
|
|
while ($errs =~ s/(.*\n)//) {
|
|
my $line = $1;
|
|
$line =~ s/(\r|\n)//g;
|
|
alog 'Error in '.$module.': '.$line;
|
|
dbug 'Error in '.$module.': '.$line;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
# vim: set ai sw=4 ts=4:
|