
## Base requirements
require 5.001;

## Flush the output
$|=1;

use strict;
use vars qw (@ISA);;
no warnings;

#####################################################
##                                                 ##
##           OpenCA Server initialization          ##
##                                                 ##
## 1. load all necessary modules                   ##
## 2. define all global variables                  ##
## 3. load libraries                               ##
## 4. init global environment                      ##
## 5. load version and init debugging              ##
## 6. activate server process                      ##
#####################################################

## start performance accounting
resetPerformancePoints ();

## 1. load all necessary modules

## do not use PreFork!!! it crashs with backticks

use OpenCA::TRIStateCGI;
use OpenCA::Session;
use OpenCA::AC;
use OpenCA::Crypto;
use OpenCA::Log;
use OpenCA::X509;
use OpenCA::CRL;
use OpenCA::Tools;
use OpenCA::REQ;
use OpenCA::PKCS7;
use OpenCA::XML::Cache;
use OpenCA::UI::HTML;
use Cwd;
use Net::Server::Fork;
@ISA = qw(Net::Server::Fork);
use POSIX;
use Locale::Messages (':locale_h');
use Locale::Messages (':libintl_h');
use Locale::Messages qw (nl_putenv);

setPerformancePoint ("modules loaded");

## 2. define all global variables

our (%AUTOCONF, $common_libs, $config);
our ($dbconfig, $dbiconfig, $DBCONFIG, $DBICONFIG, $role_config);
our ($crypto_layer, $access_control, %access_control_cache);
our ($cryptoShell, $tools, $db, $cmd, $self, $query, $session);
our ($versions, $errno, $errval, $log, $journal);
our ($xml_cache, $ui_html);

$role_config = undef;
$ui_html     = undef;
$self        = "";

our $VER = $AUTOCONF {"VERSION"};
our $PRG = gettext ($AUTOCONF {"PROGRAM"});
our $DEBUG = 0;

## 3. load and init libraries

## 3.1. load function libraries

require "$common_libs/misc-utils.lib";
setPerformancePoint ("misc-utils loaded");
require "$common_libs/log-utils.lib";
setPerformancePoint ("log-utils loaded");
require "$common_libs/crypto-utils.lib";
setPerformancePoint ("crypto-utils loaded");
require "$common_libs/rbac-utils.lib";
setPerformancePoint ("rbac-utils loaded");
require "$common_libs/mail-utils.lib";
setPerformancePoint ("mail-utils loaded");
require "$common_libs/ldap-utils.lib";
setPerformancePoint ("ldap-utils loaded");
require "$common_libs/export-import.lib";
setPerformancePoint ("export-import loaded");

initEncodings();
setLanguage (getRequired ('DEFAULT_LANGUAGE'), getRequired('DEFAULT_CHARSET'));

## 3.2. load commands

my $cmds_dir = getRequired ('CgiCmdsPath');
generalError (i18nGettext ("Cannot open directory __DIR__ which contains the commands.",
                           "__DIR__", $cmds_dir))
    if (not opendir DIR, $cmds_dir);
my @cmds = grep /^[^\.]/, readdir DIR;
closedir DIR;
$errval = "";
foreach my $command (@cmds)
{
    $command = $cmds_dir."/".$command;

    my $rc = undef;
    local $/ = undef;
    local *HANDLE;
    open HANDLE, "<$command" and
      $rc = eval "use warnings FATAL => qw(redefine); " . <HANDLE>;
    close HANDLE;

    debug("eval error: $@") if (defined $log);

    if ($@ or (not defined $rc)) {
        $errval .= i18nGettext ("The loading of the command __CMD__ failed. __ERRVAL__",
                                "__CMD__", $command,
                                "__ERRVAL__", $@);
    }
}
generalError ($errval) if ($errval);

## 4. init global environment

my $debug_ui_html = initHTML();
initXMLcache();
initTools();
initCrypto();
initLog();
initDatabase();
initSession();
initAccessControl();
$ui_html = $debug_ui_html;

require "$common_libs/initLDAP";
setPerformancePoint ("ldap ready");

## 5. load version and init debugging

$versions->{OpenSSL}		= OpenCA::OpenSSL->VERSION;
$versions->{Tools}		= OpenCA::Tools->VERSION;
$versions->{Configuration}	= OpenCA::Configuration->VERSION;
$versions->{TRIStateCGI}	= OpenCA::TRIStateCGI->VERSION;
$versions->{REQ}		= OpenCA::REQ->VERSION;
$versions->{X509}		= OpenCA::X509->VERSION;
$versions->{CRL}		= OpenCA::CRL->VERSION;
$versions->{PKCS7}		= OpenCA::PKCS7->VERSION;

setPerformancePoint ("variables initialized");

## 6. activate server process

unlink ($AUTOCONF{"var_prefix"}."/tmp/openca_socket");
OpenCA::Server->run (
     user       => $AUTOCONF{"httpd_user"},
     group      => $AUTOCONF{"httpd_group"},
     proto      => "unix",
     port       => $AUTOCONF{"var_prefix"}."/tmp/openca_socket|unix",
     background => 1,
     pid_file   => $AUTOCONF{"var_prefix"}."/tmp/openca_socket.pid");

################################end of global main#################################

sub process_request
{
    our $LANGUAGE;
    our $CHARSET;

    ##                  WARNING
    ## NEVER USE getRequired OR getRequiredList BEFORE YOU
    ## LOADED THE INTERFACE SPECIFIC CONFIGURATION

    resetPerformancePoints ();

    ## load length
    my $length = "";
    my $load = "";
    my $line;
    while (read (STDIN, $line, 1))
    {
        last if ($line =~ /\n/i);
        $length .= $line;
    }

    ## load n bytes
    read (STDIN, $load, $length);

    ## extract config_prefix
    $AUTOCONF{"config_prefix"} = $load;
    $AUTOCONF{"config_prefix"} =~ s/\n.*$//s;

    ## extract CGI data
    $load =~ s/^[^\n]*\n//s;
    $load =~ s/\n=\n$//;
    $load =~ s/\n/&/g;
    $query = OpenCA::TRIStateCGI->new ($load);
    $query->set_gettext (\&i18nGettext);

    ## validate input data
    ## 2004-08-27 Martin Bartosch <m.bartosch@cynops.de>
    validateCGIParameters(\$query);

    ## reinit configuration
    my $CONFIG = $AUTOCONF {"etc_prefix"}.'/servers/'.$AUTOCONF {"config_prefix"}.'.conf';
    if( not defined (my $ret = $config->loadCfg( "$CONFIG" )) ) {
        print STDERR i18nGettext ("Error while loading configuration (__FILENAME__)!",
                                  "__FILENAME__", $CONFIG);
        print "Content-type: text/html\n\n";
        print i18nGettext ("Error while loading configuration (__FILENAME__)!",
                           "__FILENAME__", $CONFIG);
        exit 100;
    }

    ## set language to  browser supported ones
    ## can get overwritten through user-selection later
    setBrowserLanguage ($query->param('HTTP_ACCEPT_LANGUAGE'), $query->param('HTTP_ACCEPT_CHARSET'));

    ## reinit session
    initSession();

    ## reinit database if it is a SQL database
    if ( getRequired ('DBmodule') =~ /DBI/i ) {
        generalError ($db->errval, $db->errno)
            if (not defined $db->connect());
    }

    ## initialize output module
    $ui_html = OpenCA::UI::HTML->new (HTDOCS_URL_PREFIX => getRequired('HtdocsUrlPrefix'),
                                      LANGUAGE          => $LANGUAGE,
                                      CHARSET           => $CHARSET,
                                      CGI               => $query);

    setPerformancePoint ("reinitialization complete");

    ## run command
    $ui_html->reset();
    libExecuteCommand();

    ## return true
    1;
}

## If the command will be changed in a script then executeCmd
## MUST be called again to check the permissions again.
## You MUST NOT call libDoCommand directly.

sub libExecuteCommand
{
    our ($DEBUG);
    our ($access_control, %access_control_cache, $ui_html);

    $query->param ('cmd', $_[0]) if ($_[0]);

    if (getRequired ("CgiServerType") =~ /SCEP/i)
    {
        ## Use the default variable for the pseudo SWITCH statement
        $_ = ( $query->param('operation') or "serverInfo" );

        ## We can have different operation, from the simple GetCACert
        ## to the more complete PKIOperation
        SWITCH: {
            /(GetCACert|GetCACertChain)/i
                    && do { $query->param ('cmd', 'scepGetCACert') ; last SWITCH; };

            /PKIOperation/i
                    && do { $query->param ('cmd', 'scepPKIOperation') ; last SWITCH; };

            # Otherwise
            /.*/
                    && do {
                            generalError (gettext ("This interface is only for SCEP.")) ; 
                            last SWITCH; };
        }
    }

    $query->param('cmd', 'serverInfo') if (not $query->param('cmd'));

    ## the access control must be initialized first because it uses cookies
    if (exists $access_control_cache{getRequired ('AccessControlConfiguration')})
    {
        $access_control = $access_control_cache{getRequired ('AccessControlConfiguration')};
        setPerformancePoint ("access control cached");
    } else {
        $access_control = OpenCA::AC->new (
                 CONFIG  => getRequired ('AccessControlConfiguration'),
                 CRYPTO  => $crypto_layer,
                 DB      => $db,
                 CGI     => $query,
                 LOG     => $log,
                 GETTEXT => \&i18nGettext,
                 SESSION => $session,
                 CACHE   => $xml_cache,
                 DEBUG   => $DEBUG);
        generalError ($OpenCA::AC::errval, $OpenCA::AC::errno)
            if (not $access_control);
        setPerformancePoint ("access control initialized by accident");
    }
    generalError ($access_control->errval, $access_control->errno)
        if (not $access_control->checkAccess(DB      => $db,
                                             GUI     => $ui_html,
                                             CGI     => $query,
                                             SESSION => $session));
    setPerformancePoint ("access control executed");
    $crypto_layer->setAccessControl ($access_control);

    $cmd = $query->param('cmd');

    if ( $cmd !~ /(bpRecoverCert|send_cert_key|send_cert_key_openssl|send_cert_key_pkcs12|send_cert_key_pkcs8|getcert|sendcert|send_email_cert|scepGetCACert|scepPKIOperation|getParams|setLanguage|setupInitialCert)/ ) {
        $ui_html->sendContentType();
    }

    libDoCommand ($cmd);

    setPerformancePoint ("command executed");

    ## show performance parameters
    printPerformancePoints();
}

sub setBrowserLanguage
{
    my $LANGUAGES = $_[0];
    my $CHARSETS  = $_[1];

    my @tempLang;
    my %supportedLanguages;
    my $browserLang;

    if (defined $log){
      debug ("initServer: BrowserSupportedLanguage(s) [".$query->param('HTTP_ACCEPT_LANGUAGE')."]");
      debug ("initServer: BrowserSupportedCharset(s)  [".$query->param('HTTP_ACCEPT_CHARSET')."]");
    }

    ## supported languages so far
    %supportedLanguages = (
      C  => { LANG => 'C', CHARSET => 'utf-8'},
      de => { LANG => 'de_DE', CHARSET => 'utf-8'},
      el => { LANG => 'el_GR', CHARSET => 'utf-8'},
      en => { LANG => 'en_GB', CHARSET => 'utf-8'},
      es => { LANG => 'es_ES', CHARSET => 'utf-8'},
      fr => { LANG => 'fr_FR', CHARSET => 'utf-8'},
      it => { LANG => 'it_IT', CHARSET => 'utf-8'},
      pl => { LANG => 'pl_PL', CHARSET => 'utf-8'},
      sl => { LANG => 'sl_SI', CHARSET => 'utf-8'},
      ja => { LANG => 'ja_JP', CHARSET => 'utf-8'},
      ru => { LANG => 'ru_RU', CHARSET => 'utf-8'}
    );

    ## get languages
    ## example firebird:
    ##  language: en,en-us;q=0.8,de;q=0.7,de-de;q=0.5,ja;q=0.3,ar;q=0.2
    ##  charset : ISO-8859-1,utf-8;q=0.7,*;q=0.7
    ## example explorer:
    ##  language: de,de-at;q=0.7,ja;q=0.3
    ##  charset :

    ## if first lang matches one of our support chooes it
    ## if not - take next
    ## if none matches - choose default C

    ## FIXME:
    ## ignore browser submitted charset for the moment
    ## set our own, regarding to found language

    @tempLang = split (/,/ , $LANGUAGES);

    ## check every browser supported lang till one matches our supported
    my $found = 0;
    foreach $browserLang (@tempLang){
      ## get only the firt two characters for each supported language
      ## skip country details and rating q=0.7 or something
      ## since they are usaly in order from first to last supported
      my $choose = substr($browserLang,0,2);
      debug ("select language: ".$choose) if (defined $log);
      if ($supportedLanguages{$choose}){
              setLanguage($supportedLanguages{$choose}->{'LANG'}, $supportedLanguages{$choose}->{'CHARSET'});
              $found = 1;
              ## stop after we have found a matching language
              last;
      }
    }
    
    ## FIXME:
    ## set default en if no matching language can be found
    ## or set it to the defined default language
    ## or do nothing so the initServer Lang gets used? set in line: 85
    setLanguage($supportedLanguages{'C'}->{'LANG'}, $supportedLanguages{'C'}->{'CHARSET'}) if not $found;
}

sub setLanguage
{
    our $LANGUAGE = $_[0];
    our $CHARSET  = $_[1];
    our %encodings;
    $encodings{$CHARSET} = $CHARSET if (not $encodings{$CHARSET});

    if ($LANGUAGE eq "C")
    {
        nl_putenv("LC_MESSAGES=C") if (setlocale(LC_MESSAGES, "C"));
        nl_putenv("LC_TIME=C") if (setlocale(LC_TIME, "C"));
    } else {
        my $loc = "${LANGUAGE}.$encodings{$CHARSET}";
        nl_putenv("LC_MESSAGES=$loc") if (setlocale(LC_MESSAGES, $loc));
        nl_putenv("LC_TIME=$loc") if (setlocale(LC_TIME, $loc));
    }
    textdomain("openca");
    bindtextdomain("openca", $AUTOCONF{"lib_prefix"}."/locale");
    bind_textdomain_codeset ("openca", $encodings{$CHARSET});
    if (defined $log)
    {
        my $enc = $log->setEncoding ($CHARSET);
        debug ("initServer: setLanguage: setEncoding for log return $enc");
    }
    $ui_html->setLanguage ($LANGUAGE, $CHARSET) if ($ui_html);
    debug ("initServer: setLanguage: $LANGUAGE :: $CHARSET") if (defined $log);
}

sub setPerformancePoint
{
    our ($performance_test, @performance);
    return 1 if (not $performance_test);
    $performance[scalar @performance]{time} = [ gettimeofday() ];
    $performance[scalar @performance -1]{name} = $_[0];
}

sub resetPerformancePoints
{
    our $performance_test = 0;
    ## activate the commented line if you want to use performance counters
    ## use Time::HiRes qw (tv_interval gettimeofday);
    return 1 if (not $performance_test);
    our @performance = (); 
    setPerformancePoint ("start time");
}

sub printPerformancePoints
{
    our ($performance_test, @performance);
    return 1 if (not $performance_test);
    my $first = $performance[0]{time};
    my $last = $first;
    shift @performance;
    foreach my $para (@performance)
    {
        print STDERR $para->{name}." in ".tv_interval ($last, $para->{time})."\n";
        $last = $para->{time};
    }
    print STDERR "total time ".tv_interval ($first, $last)."\n";
}

sub initXMLcache
{
    our %AUTOCONF;
    our $xml_cache;
    our $DEBUG;

    $xml_cache = OpenCA::XML::Cache->new (
                     "SOCKETFILE" => getRequired ("tempDir")."/openca_xml_cache",
                     "IPC_USER"   => $AUTOCONF{"httpd_user"},
                     "IPC_GROUP"  => $AUTOCONF{"httpd_group"});
    if (not $xml_cache)
    {
        configError( gettext ("Cannot initialize XML cache!")." ".
                              $OpenCA::XML::Cache::errval, $OpenCA::XML::Cache::errno );
    }
    $xml_cache->startDaemon(
        LOGFILE => getRequired ('LOG_DIR')."/xml_cache.log",
        PIDFILE => getRequired ('TempDir')."/xml_cache.pid"
                           );

    setPerformancePoint ("xml cache activated");
    sleep 1;
    setPerformancePoint ("xml cache is now available");
    my $stderr_file =  $xml_cache->get_xpath (
                                 FILENAME => getRequired( 'LogConfiguration'),
                                 XPATH    => [ 'stderr' ],
                                 COUNTER  => [ 0 ]);
    if (not $stderr_file)
    {
        configError ("The XML cache does not work properly - aborting.");
    }
    setPerformancePoint ("xml cache is now testeda");
    open STDERR, ">> ".$stderr_file;
    setPerformancePoint ("redirected stderr to file");
    $DEBUG = $xml_cache->get_xpath (
                                 FILENAME => getRequired( 'LogConfiguration'),
                                 XPATH    => [ 'debug' ],
                                 COUNTER  => [ 0 ]);
    setPerformancePoint ("debugging is configured");
    return 1;
}

sub initDatabase
{
    our ($dbconfig, $dbiconfig);
    our ($DBCONFIG, $DBICONFIG);
    our ($AUTOCONF, $common_libs);

    ## Generate a new reference to Configuration ( instance )
    $dbconfig = new OpenCA::Configuration;
    $dbiconfig = new OpenCA::Configuration;

    ##// Let's load our default configuration
    $DBCONFIG  = $AUTOCONF{'etc_prefix'}.'/database/DB.conf';
    $DBICONFIG = $AUTOCONF{'etc_prefix'}.'/database/DBI.conf';

    setPerformancePoint ("database config ready");

    if ( getRequired ('DBmodule') =~ /DBI/i ) {
        require "$common_libs/initDBI";
    } else {
        require "$common_libs/initDB";
    }

    setPerformancePoint ("database ready");

    return 1;
}

sub initCrypto
{
    our ($crypto_layer, $xml_cache, $cryptoShell, $DEBUG, $ca_token);

    my $token_xml = getRequired( 'TokenConfiguration');

    $versions = {};
    $errno    = 0;
    $errval   = "";

    $crypto_layer = new OpenCA::Crypto (CONFIG  => $token_xml,
                                        GETTEXT => \&i18nGettext,
                                        CACHE   => $xml_cache,
                                        DEBUG   => $DEBUG);

    if ( not $crypto_layer ) {
        configError( i18nGettext ("Cannot initialize cryptographic layer (configurationfile __FILE__)!",
                                  "__FILE__", $token_xml).
                     $OpenCA::Crypto::errval, $OpenCA::Crypto::errno );
    }

    $cryptoShell = $crypto_layer->getToken ();

    if ( not $cryptoShell ) {
        configError( i18nGettext ("Cannot initialize Crypto Shell!").
                     $OpenCA::Crypto::errval, $OpenCA::Crypto::errno );
    }

    #$ca_token = $crypto_layer->getToken ('CA');

    #if ( not $ca_token ) {
    #     configError( i18nGettext ("Cannot initialize Crypto token!").
    #                  $OpenCA::Crypto::errval, $OpenCA::Crypto::errno );
    #}


    setPerformancePoint ("cryptoshell ready");

    return 1;
}

sub initLog {
    our ($crypto_layer, $crypto_shell, $xml_cache, $log, $DEBUG);

    my $log_token = $crypto_layer->getToken ('LOG');
    $log_token = $cryptoShell if ( not $log_token );
    $log = OpenCA::Log->new (CONFIG  => getRequired ('LogConfiguration'),
                             GETTEXT => \&i18nGettext,
                             CACHE   => $xml_cache,
                             CRYPTO  => $log_token,
                             DEBUG   => $DEBUG);
    if ( not $log ) {
        configError( i18nGettext ("Cannot initialize logging (__CONFIG__)!",
                                  "__CONFIG__", getRequired ('LogConfiguration')).
                     $OpenCA::Log::errval, $OpenCA::Log::errno );
    }
    $log->setEncoding (getRequired('DEFAULT_CHARSET'));

    setPerformancePoint ("logging ready");
    return 1;
}

sub initHTML
{
    our ($query, $DEBUG);

    $query  = new OpenCA::TRIStateCGI ();
    $query->set_gettext (\&i18nGettext);
    my $debug_ui_html = OpenCA::UI::HTML->new (
                            HTDOCS_URL_PREFIX => getRequired('HtdocsUrlPrefix'),
                            LANGUAGE          => getRequired ('DEFAULT_LANGUAGE'),
                            CHARSET           => getRequired ('DEFAULT_CHARSET'));

    setPerformancePoint ("html ready");
    return $debug_ui_html;
}

sub initTools
{
    our ($tools, $DEBUG);

    $tools = new OpenCA::Tools("GETTEXT" => \&i18nGettext,
                               "DEBUG"   => $DEBUG);
    if ( not $tools ) {
	configError( gettext("Cannot initialize OpenCA::Tools class!") );
    }

    setPerformancePoint ("tools ready");

    return $tools;
}

sub initSession
{
    our ($session, $query, $log);
    our ($LANGUAGE, $CHARSET);
    $session = OpenCA::Session->new (
                   CGI      => $query,
                   LOG      => $log,
                   DIR      => getRequired ('SessionDir')."/".getRequired ('CgiServerName'),
                   LIFETIME => getRequired ('SessionLifetime'),
                   GETTEXT  => \&i18nGettext,
                   DEBUG    => $DEBUG
                                    );
    if ( not $session ) {
        configError( gettext("Cannot initialize OpenCA::Session class!") );
    }

    setPerformancePoint ("session ready");

    ## does this makes sense on server startup?!

    if ($session->load())
    {
        if ($session->getParam ('PREFERENCES_LANGUAGE'))
        {
            setLanguage ($session->getParam('PREFERENCES_LANGUAGE'),
                         $session->getParam('PREFERENCES_CHARSET'));
        } else
        {
            ## configure the language if it is not stored until now

            $session->setParam ('PREFERENCES_LANGUAGE', $LANGUAGE);
            if ($CHARSET)
            {
                $session->setParam ('PREFERENCES_CHARSET', $CHARSET);
            } else {
                $session->setParam ('PREFERENCES_CHARSET', "utf-8");
            }
        }
    }

    if ($CHARSET =~ m/^utf[_-]*8$/i) {
        $query->autoEscape(0);   
     }   
     else {   
        $query->autoEscape(1);   
     } 

    setPerformancePoint ("session loaded and language ready");
    return 1;
}

sub initAccessControl
{
    our ($crypto_layer, $log, $ui_html, $xml_cache, $DEBUG);
    our ($db, $query, $session);

    our %access_control_cache = ();
    use File::Basename;
    my $filename = getRequired ('AccessControlConfiguration');
    my $dir = dirname ($filename);
    
    generalError (
        i18nGettext ("Cannot open directory __DIR__ which contains the access control configurations.",
                     "__DIR__", $dir))
        if (not opendir DIR, $dir);
    my @confs = grep /^[^\.].*\.xml$/, readdir DIR;
    closedir DIR;

    foreach my $file (@confs)
    {
        $file = $dir."/".$file;
        $access_control_cache{$file} = OpenCA::AC->new (
                 CONFIG  => $file,
                 CRYPTO  => $crypto_layer,
                 DB      => $db,
                 CGI     => $query,
                 LOG     => $log,
                 GUI     => $ui_html,
                 GETTEXT => \&i18nGettext,
                 SESSION => $session,
                 CACHE   => $xml_cache,
                 DEBUG   => $DEBUG);
        configError ($OpenCA::AC::errval, $OpenCA::AC::errno)
            if (not $access_control_cache{$file});
    }

    setPerformancePoint ("access control configurations loaded and ACL cached");
    return 1;
}

sub initEncodings
{
    our (%encodings);

    %encodings = (
                  "UTF-8"      => "UTF-8"
                 );

    ## load all available encodings
    my $ret = `locale -m`;
    my @encs = split /\s*\n\s*/, $ret;

    foreach my $code (keys %encodings)
    {
        ## explode encoding parameters
        $code =~ /([[:alpha:]]+)[-_\s]*([[:alnum:]]+)[-_\s]*([[:digit:]]*)/;
        my $standard = $1;
        my $number   = $2;
        my $variant  = $3;

        foreach my $item (@encs)
        {
            $encodings{$code} = $item;
            last if ($item =~ /^$standard[-_\s]*$number[-_\s]*$variant$/i);
            $encodings{$code} = $code;
        }
    }

    return 1;
}

1;
