#!/usr/bin/perl
# -----------------------------------------------------------------------------
# - T i a r r a - :::bootstrap:::
# Copyright (c) 2002-2004 phonohawk. All rights reserved.
# This is free software; you can redistribute it and/or modify it
#   under the same terms as Perl itself.
# -----------------------------------------------------------------------------
# $Id: tiarra,v 1.37 2004/08/22 11:28:42 topia Exp $
# -----------------------------------------------------------------------------
require 5.006;
use strict;
use warnings;
BEGIN {
    use File::Basename;
    use File::Spec;
    my $add_inc = sub {
	foreach my $path (@_) {
	    unshift(@INC,
		    map{ File::Spec->catdir($path, $_); } qw(main module));
	}
    };
    # untaint
    $0 =~ /^(.+)$/;
    my $self = $1;

    $add_inc->(File::Spec->rel2abs(map dirname($_), (readlink($self), $self)))
	if (-l $self);
    $add_inc->(dirname($self), ".");
}
use Configuration;
use RunLoop;
use ModuleManager;
use ReloadTrigger;
use IO::Handle;
my $conf_file = '';
my $quiet = 0;
my $no_fork = 0;
my $terminated = 0;


# version ϥСֹ
my $version = '0';

# based ϥ١ˤƤ Tiarra ΥС(ѥåޤ fork )
my $based_version = '';

# short ûСֹ档(CTCP-Version ˻Ȥ)
my $short_version = '';


# ꥸʥ(based_version ̤)ʤ ChangeLog 򸡺롣
&check_changelog unless $based_version;
# short_version ̤ʤ version ͤȤ
$short_version ||= $version;

&install_signal_handlers;

&check_whether_ipv6_enabled;

sub check_changelog {
    use IO::File;
    my $seek_offset = -300;
    my $changelog = 'ChangeLog';

    # get changelog path
    if ($0 =~ /^(.*)[\\\/][^\\\/]*$/) {
	$changelog = $1 . '/' . $changelog;
    } else {
	$changelog = './' . $changelog;
    }

    my $fh = IO::File->new($changelog, 'r');
    if (defined $fh) {
	my $revision = undef;
	my $date = undef;

	$fh->seek($seek_offset, 2);
	foreach my $line (<$fh>) {
	    if ($line =~ /\$\QRevision:\E ([\d.]+) \$/) {
		$revision = $1;
	    } elsif ($line =~ /\$\QDate:\E ([\d\/]+) [\d:]+ \$/) {
		$date = $1;
	    }
	}
	$version .= '+cvs-' . $revision if defined $revision;
	$version .= '(' . $date . ')' if defined $date;
    }
}

sub help {
    print "\n";
    print "Usage: tiarra [--config=config-file] [options]\n";
    print "\n";
    print "options:\n";
    print "  --help           print this message\n";
    print "  --version        print version infomation\n";
    print "  --dumpversion    print version\n";
    print "  --config=<file>  tiarra configuration file; default is 'tiarra.conf'\n";
    print "  --quiet          don't output any messages to stdout and stderr\n";
    print "  --no-fork        don't move to background when started in quiet mode\n";
    print "  --debug          show debug infomation\n";
    print "  --make-password  prompt you a password to encrypt.\n";
    print "                   *Tiarra doesn't do its normal work with this option*\n";
    print "   -D<symbol>[=<string>]\n";
    print "                   treat as `\@define <symbol> <string>' is in the conf\n";
    print "\n";
    print "If you omit --config=<file> parameter and execute with piped input,\n";
    print "Tiarra will read configuration from stdin(pipe).\n";
    print "  example:\n";
    print "      cat tiarra.conf | sed -e 's/Tiarra/arraiT/g' | ./tiarra --quiet\n";
    print "      gunzip -c tiarra.conf.gz | ./tiarra\n";
    print "\n";
}

sub make_password {
    eval 'use Crypt;';
    print "Tiarra encrypts your raw password to use it for config file.\n";
    print "\n";

    my $password = &find_option('make-password');
    if ($password eq "1") {
	eval 'use Term::ReadLine;';
	my $term = Term::ReadLine->new('tiarra');
	$password = $term->readline("Please enter raw password: ");
	print "\n";
    }
    print Crypt::encrypt($password)." is your encoded password.\n";
    print "Use this for the general/tiarra-password entry.\n";
}

sub find_option {
    my $option = shift;
    foreach my $arg (@ARGV) {
	if ($arg eq "--$option") {
	    return 1;
	} elsif ($arg =~ m/^--$option=(.+)$/) {
	    return $1;
	}
    }
    undef;
}

sub find_options {
    # $opt_regex: ץ̾ɽȤĤ
    # : ([$1, ], ...)
    my $opt_regex = shift;
    grep {
	defined;
    } map {
	if (m/^--?$opt_regex=(.+)/) {
	    [$1, $2];
	}
	elsif (m/^--?$opt_regex$/) {
	    [$1, 1];
	}
	else {
	    undef;
	}
    } @ARGV;
}

if (&find_option('help')) {
    &help;
    exit;
} elsif (&find_option('version')) {
    print join("\n",get_credit()) . "\n";
    exit;
} elsif (&find_option('dumpversion')) {
    print $version . "\n";
    exit;
} elsif (&find_option('make-password')) {
    &make_password;
    exit;
}

if (&find_option('debug')) {
    eval q(sub debug_printmsg{printmsg('debug: '.shift)});
    eval q(sub debug_mode{1;});
    $SIG{__WARN__} = sub {
	use Carp;
	::printmsg(Carp::longmess(@_));
    };
    $SIG{__DIE__} = sub {
	use Carp;
	die @_ if $_[0] =~ /^[Cc]ouldn't connect/;
	die(Carp::longmess(@_));
    }
} else {
    eval q(sub debug_printmsg{});
    eval q(sub debug_mode{0;});
}

foreach my $pp_define (&find_options(qr/D(.+?)/)) {
    &Configuration::Preprocessor::initial_define(@$pp_define);
}

$conf_file = &find_option('config');
if (!defined $conf_file) {
    if (!-t STDIN) {
	$conf_file = undef; # STDINɤundefƤ
    } elsif (-f 'tiarra.conf') {
	$conf_file = 'tiarra.conf';
    } else {
	&help;
	exit;
    }
}

$quiet = &find_option('quiet');
$no_fork = &find_option('no-fork');

my $load_config = sub {
    local($|) = 1;

    if (defined $conf_file) {
	print "Reading configuration from ${conf_file}... ";
    } else {
	$conf_file = IO::Handle->new->fdopen(fileno(STDIN),'r');
	print "Reading configuration from stdin... ";
    }

    eval {
	Configuration::shared_conf->load($conf_file);
    }; if ($@) {
	die "ERROR: $@\n";
    } else {
	print "ok\n";
    }
};

my $start_runloop = sub {
    eval {
	RunLoop::shared_loop->run;
    }; if ($@) {
	die "Tiarra aborted: $@\n";
    }
};

my $boot = sub  {
    foreach my $line (get_credit()) {
	print $line,"\n";
    }
    print "\n";
    $load_config->();
    ModuleManager->shared; # 
    $start_runloop->();
};

# quiet⡼ɤʤSTDIN, STDOUT, STDERRĤ롣
# config  read δϢ(STDIN) boot ˡ
if ($quiet) {
    close STDIN;
    close STDOUT;
    close STDERR;
    #open(STDOUT,"> /dev/null");
    #open(STDERR,"> /dev/null");
}

# quiet⡼ɤǤꡢno-forkץ󤬻ꤵʤäfork
if ($quiet && !$no_fork) {
    my $child_pid = fork;
    if ($child_pid == 0) {
	# ҥץ
	$boot->();
    } elsif (!defined $child_pid) {
	print "Tiarra: fork() failed.\n";
    }
} else {
    $boot->();
}
exit;



sub printmsg {
    # ʸɤUTF-8ǤʤФʤʤ
    my $msg = shift;
    local($|) = 1;
    if (!defined $msg) {
	$msg = '';
    }
    $msg =~ s/\n*$//s;

    # Configurationɤ߹ޤƤʤʸѴdie
    eval {
	local $SIG{__DIE__} = 'IGNORE';
	local $SIG{__WARN__} = 'IGNORE';
	$msg = Unicode::Japanese->new($msg,'utf8')->conv(
	    Configuration->shared_conf->get('general')->stdout_encoding);
    };

    my ($sec,$min,$hour,$day,$mon,$year) = localtime(time);
    $mon++;
    $year += 1900;

    #printf("[%02d/%02d/%04d %02d:%02d:%02d] %s\n",$mon,$day,$year,$hour,$min,$sec,$msg);
    printf("[%02d/%02d %02d:%02d:%02d] %s\n",$mon,$day,$hour,$min,$sec,$msg);
}

sub version {
    $short_version;
}

sub get_credit {
    return (
	(!$based_version ?
	     "- T i a r r a - :::version #${version}:::" :
		 ("- T i a r r a - :::version ${version}:::",
		  "                    based #${based_version}")
	    ),
	    "Copyright (c) 2002-2004 phonohawk. All rights reserved.",
	    "This is free software; you can redistribute it and/or modify it",
	    "  under the same terms as Perl itself.");
}

sub install_signal_handlers {
    local $SIG{__WARN__} = sub {};
    foreach (qw(INT QUIT ABRT TERM)) {
	$SIG{$_} = \&handle_exit;
    }
    $SIG{HUP} = \&handle_reload;
}

sub handle_exit {
    my $signame = shift;
    printmsg('Signal received.');
    &shutdown((defined $signame ? "SIG$signame" : 'Signal').
		  ' received; exit');
}

sub handle_reload {
    printmsg('SIGHUP received.');
    ReloadTrigger->reload_conf_if_updated;
    ReloadTrigger->reload_mods_if_updated;
}

sub shutdown {
    my $msg = shift;
    $msg = 'Shutdown Tiarra '.::version if !defined $msg;
    if ($terminated) {
	printmsg("Second Terminate Request; Force Exit! [$msg]");
	# force
	ModuleManager->shared_manager->terminate;
	exit;
    } else {
	$terminated = 1;
	printmsg("Shutting down... [$msg]");
	RunLoop->shared_loop->terminate($msg);
    }
}

our $ipv6_is_enabled;
sub check_whether_ipv6_enabled {
    eval q{
	use IO::Socket::INET6;
    };
    $ipv6_is_enabled = ($@ ? 0 : 1);
}

sub ipv6_enabled {
    # ƤɤIPv6ͭɤ򿿵֤ͤ
    $ipv6_is_enabled;
}
