#!/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 DBI;
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(alog dbug);
#use DB::Flatfile;
use Parser::Config;
use Parser::Lang;
use Proto::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") {
    say 'Missing build file(s). Please build Auto before running it.' and exit;
}

# Check build OS.
open my $BFOS, '<', "$Bin/../build/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/../build/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/../build/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/../build/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;

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

# 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.
say '* 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);
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;
    }
}

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

# 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;
    	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('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};
            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/../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 et sw=4 ts=4: