#!/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 locale;
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 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,
    'c=s'      => \$USECONFIG,
    'config=s' => \$USECONFIG,
    'h'        => \$opt_help,
    'help'     => \$opt_help,
    'd'        => \$DEBUG,
    'debug'    => \$DEBUG,
    'v'        => \$opt_version,
    'version'  => \$opt_version
);

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

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

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

HELP
    exit 1;
}

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

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

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

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

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

VERINFO
    exit 1;
}

undef $opt_help;
undef $opt_version;

# Print startup message.
say <<'EOF';
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);;
        }
    }
    # CSV no work. :(
    #when ('csv') {
    #    # CSV.
    #    if ($ENFEAT !~ /csv/) { err(2, 'Auto not built with CSV support.', 1); }
    #    if (!conf_get('database:dir')) { err(2, 'Missing required configuration value database:dir. Aborting.', 1); }
    #
    #    # Import DBD::CSV.
    #    require DBD::CSV;
    #
    #    # Connect to database.
    #    $DB = DBI->connect("dbi:CSV:f_dir=$bin{etc}/".(conf_get('database:dir'))[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);

# 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};
            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 0;
    }
}

# 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:
