#!/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(state);
use POSIX;
use English qw(-no_match_vars);
use Sys::Hostname;
use IO::Socket;
use IO::Select;
use Getopt::Long;
use DBI;
use Class::Unload;
use FindBin qw($Bin);
our $Bin = $Bin; ## no critic qw(NamingConventions::Capitalization Variables::ProhibitPackageVars)
our (%bin, $UPREFIX);
BEGIN {
    $bin{cwd} = getcwd;
    if (!-e "$Bin/../build/syswide") {
        # Must be a custom PREFIX install.
        $bin{etc} = "$bin{cwd}/etc";
        $bin{var} = "$bin{cwd}/var";
        if (!-e "$Bin/lib/Lib/Auto.pm") {
            # Must be a system wide install.
            $bin{lib} = "$Bin/../lib/autobot/3.0.0";    
            $bin{bld} = "$bin{lib}/build";
            $bin{lng} = "$bin{lib}/lang";
            $bin{mod} = "$bin{lib}/modules";
        }
        else {
            # Or not.
            $bin{lib} = "$Bin/../lib";
            $bin{bld} = "$Bin/../build";
            $bin{lng} = "$Bin/../lang";
            $bin{mod} = "$Bin/../modules";
        }
        $UPREFIX = 1;
    }
    else {
        # Must be a standard install.
        $bin{etc} = "$Bin/../etc";
        $bin{var} = "$Bin/../var";
        $bin{lib} = "$Bin/../lib";
        $bin{bld} = "$Bin/../build";
        $bin{lng} = "$Bin/../lang";
        $bin{mod} = "$Bin/../modules";
        $UPREFIX = 0;
    }

    unshift @INC, $bin{lib};

    if (-d "$Bin/../.git") {
        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',
    };
}
use Lib::Auto;
use API::Std qw(conf_get err);
use API::Log qw(alog dbug);
#use DB::Flatfile;
use Parser::Config;
use Parser::Lang;
use Proto::IRC;
use State::IRC;
use Core::IRC;
use Core::IRC::Users;
use Core::Cmd;

our $VERSION = 3.000000;
local $PROGRAM_NAME = 'auto';

# Check for build files.
if (!-e "$bin{bld}/os" or !-e "$bin{bld}/perl" or !-e "$bin{bld}/time" or !-e "$bin{bld}/ver") {
    say 'Missing build file(s). Please build Auto before running it.' and exit;
}

# Check build OS.
open my $BFOS, '<', "$bin{bld}/os" or say 'Cannot start: Broken build.' and exit;
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;
}
undef @BFOS;

# Check build features.
our $ENFEAT;
open my $BFFEAT, '<', "$bin{bld}/feat" or say 'Cannot start: Broken build.' and exit;
my @BFFEAT = <$BFFEAT>;
close $BFFEAT or say '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{bld}/perl" or say 'Cannot start: Broken build.' and exit;
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;
}
undef @BFPERL;

# Check build Auto version.
open my $BFVER, '<', "$bin{bld}/ver" or say 'Cannot start: Broken build.' and exit;
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;
}
undef @BFVER;

# Check build path setup.
our $SYSWIDE;
open my $BFPATH, '<', "$bin{bld}/syswide" or say 'Cannot start: Broken build.' and exit;
my @BFPATH = <$BFPATH>;
close $BFPATH or say 'Cannot start: Broken build.' and exit;
if ($BFPATH[0] eq "1\n") { $SYSWIDE = 1 }
else { $SYSWIDE = 0 }

# 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');

# Get arguments.
our ($DEBUG, $NUC);
my ($opt_help, $opt_version, $USECONFIG);
GetOptions(
    'nuc'        => \$NUC,
    'config|c=s' => \$USECONFIG,
    'h|help'     => \$opt_help,
    'debug|d'    => \$DEBUG,
    'version|v'  => \$opt_version,
);

# If we were passed -h, print help.
if ($opt_help) {
    print <<"HELP";

Usage: $PROGRAM_NAME [options]
    --help, -h     Prints this help.
    --version, -v  Prints the version of this Auto.
    --debug, -d    Runs Auto in debug mode. Debug mode will print out debug
                   messages, including IRC raw data, to screen. This will also
                   stop Auto from forking into the background.

    --config=FILENAME, -c  Uses etc/FILENAME for the configuration file.

HELP
    exit 1;
}

# If we were passed -v, print version.
if ($opt_version) {
    say q{};
    say NAME.' version '.VER.', subversion '.SVER.', revision '.REV.' ('.VER.q{.}.SVER.q{.}.REV.RSTAGE.').';
    print <<'VERINFO';

Copyright (C) 2010-2011, Xelhua Development Group. All rights reserved.

Auto is released under the licensing terms of the New (3-Clause) BSD License,
which may be found in doc/LICENSE.

For documentation, you might refer to README, doc/*, and the Xelhua Wiki at
http://wiki.xelhua.org. Documentation for modules is stored in Man Page and
HTML form in autodoc/.

For support, visit the Xelhua Forums at http://forums.xelhua.org, or drop by
the official IRC chatroom at irc.xelhua.org #xelhua. Please report bugs and
request new features at http://rm.xelhua.org.

VERINFO
    exit 1;
}

undef $opt_help;
undef $opt_version;

# Print startup message.
say <<'EOF';
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
say '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';

our ($APID, %TIMERS);

# 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.
my $configfile = 'auto.conf';
if ($USECONFIG) { $configfile = $USECONFIG }
say "* Parsing configuration file $configfile...";
our $CONF = Parser::Config->new($configfile) or err(1, 'Failed to parse configuration file!', 1);
our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
say ' Success';
undef $configfile;
undef $USECONFIG;

if (conf_get('die')) {
    if ((conf_get('die'))[0][0] == 1) {
        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);
    }
}
undef @REQCVALS;

# Parse translations.
say '* 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;
say ' Success';

# Expire old logs.
API::Log::expire_logs();

# Connect to database.
our $DB;
given (lc((conf_get('database:format'))[0][0])) {
    when ('sqlite') {
        # SQLite.
        if ($ENFEAT !~ /sqlite/) { err(2, 'Auto not built with SQLite support. Aborting.', 1) }
        if (!conf_get('database:filename')) { err(2, 'Missing required configuration value database:filename. Aborting.', 1) }

        # Import DBD::SQLite.
        require DBD::SQLite;

        if (!-e "$bin{etc}/".(conf_get('database:filename'))[0][0]) {
            # Create <database:filename> if it's missing.
            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);
    }
    when ('mysql') {
        # MySQL.
        if ($ENFEAT !~ /mysql/) { err(2, 'Auto not built with MySQL support. Aborting.', 1) }
        my @reqcval = qw(database:host database:name database:username database:password);
        foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1) } }
        undef @reqcval;

        # Import DBD::mysql.
        require DBD::mysql;

        # Connect to database.
        if (conf_get('database:port')) {
            # If we were given a port, connect with it.
            $DB = DBI->connect('DBI:mysql:database='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0].';port='.(conf_get('database:port'))[0][0],
                (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);;
        }
        else {
            # If not, connect without specifying a port.
            $DB = DBI->connect('DBI:mysql:database='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0],
                (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);;
        }
    }
    when ('pgsql') {
        # PostgreSQL.
        if ($ENFEAT !~ /pgsql/) { err(2, 'Auto not built with PostgreSQL support. Aborting.', 1) }
        my @reqcval = qw(database:name database:host database:username database:password);
        foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1) } }
        undef @reqcval;

        # Import DBD::Pg.
        require DBD::Pg;

        # Connect to database.
        if (conf_get('database:port')) {
            # If a specific port was given, use it.
            $DB = DBI->connect('dbi:Pg:db='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0].';port='.(conf_get('database:port'))[0][0],
                (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);
        }
        else {
            # We were not given a port, connect using PGPORT (usually 5432)
            $DB = DBI->connect('dbi:Pg:db='.(conf_get('database:name'))[0][0].';host='.(conf_get('database:host'))[0][0],
                (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);
        }
    }
    # Unknown database format.
    default { err(2, 'Unknown database format \''.lc((conf_get('database:format'))[0][0]).'\'. Aborting.', 1) }
}


# 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;
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...';
    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;
        # Figure out where to throw auto.pid.
        my $pidfile;
        if ($UPREFIX) { $pidfile = "$bin{cwd}/auto.pid" }
        else { $pidfile = "$Bin/auto.pid" }
        open my $FPID, '>', $pidfile 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');
# 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($_);
    }
}

## 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();
# Iterate through each configured server.
foreach my $cskey (keys %cservers) {
    Lib::Auto::ircsock(\%{$cservers{$cskey}}, $cskey);
}

# Success!
if (keys %SOCKET) {
    alog '** Success: Connected to server(s).';
    dbug '** Success: Connected to server(s).';
}
else {
    err(2, 'No IRC connections -- Exiting program.', 1);
}

# 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);
API::Std::cmd_add('HELP', 2, 0, \%Core::Cmd::HELP_HELP, \&Core::Cmd::cmd_help);
# Aliases, if any.
if (conf_get('aliases:alias')) {
    my $aliases = (conf_get('aliases:alias'))[0];
    foreach (@{$aliases}) {
        if ($_ =~ m/\s/xsm) {
            my @data = split /\s/xsm, $_;
            API::Std::cmd_alias($data[0], join ' ', @data[1..$#data]);
        }
    }
}

# Infinite while loop.
while (1) {
    # Timer check.
    foreach my $tk (keys %TIMERS) {
        if (exists $TIMERS{$tk}) {
            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};
            API::Std::event_run('on_disconnect', $sockid);
            if (!keys %SOCKET) {
                # No more connections, stop the program.
                API::Std::event_run('on_shutdown');
                dbug '* No more IRC connections, shutting down.';
                alog '* No more IRC connections, shutting down.';
                sleep 1;
                exit;
            }
            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.
            Proto::IRC::ircparse($sockid, $line);
        }
    }
}

###############
# Subroutines #
###############

# Send data to socket.
sub socksnd {
    my ($svr, $data) = @_;

    if (defined $SOCKET{$svr}) {
        syswrite $SOCKET{$svr}, "$data\r\n", POSIX::BUFSIZ, 0;
        dbug "$svr << $data";
        return 1;
    }
    else {
        return;
    }
}

# Load a module.
sub mod_load {
    my ($module) = @_;

    if (-e "$bin{mod}/$module.pm") {
        do "$bin{mod}/$module.pm" and return 1;
    }
    else {
        if (-e "$bin{mod}/$module/main.pm") {
            do "$bin{mod}/$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 et sw=4 ts=4: