#!/usr/bin/perl

# VHCS(tm) - Virtual Hosting Control System
# Copyright (c) 2001-2004 by moleSoftware GmbH
# http://www.molesoftware.com
#
#
# License:
#    This program is free software; you can redistribute it and/or
#    modify it under the terms of the MPL Mozilla Public License
#    as published by the Free Software Foundation; either version 1.1    
#    of the License, or (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
#    MPL Mozilla Public License for more details.
#    
#    You may have received a copy of the MPL Mozilla Public License
#    along with this program.
#    
#    An on-line copy of the MPL Mozilla Public License can be found
#    http://www.mozilla.org/MPL/MPL-1.1.html
#
#
# The VHCS Home Page is at:
#
#    http://www.vhcs.net

#
# common code: BEGIN
#

BEGIN {
    
    my @needed = (strict, 
                  warnings, 
                  IO::Socket, 
                  DBI, 
                  DBD::mysql, 
                  MIME::Entity,
                  MIME::Parser, 
                  Crypt::CBC, 
                  Crypt::Blowfish,
                  MIME::Base64,
                  Mail::Address,
                  Term::ReadPassword);
    
    my ($mod, $mod_err, $mod_missing) = ('', '_off_', '');
    
    for $mod (@needed) {
        
        if (eval "require $mod") {
            
            $mod -> import();
            
        } else {
            
            print STDERR "\nCRITICAL ERROR: Module [$mod] WAS NOT FOUND !\n" ;
            
            $mod_err = '_on_';
            
            if ($mod_missing eq '') {
                
                $mod_missing .= $mod;
                
            } else {
                
                $mod_missing .= ", $mod";
                
            }
        }
        
    }
    
    if ($mod_err eq '_on_') {
        
        print STDERR "\nModules [$mod_missing] WAS NOT FOUND in your system...\n";
        
        exit 1;
        
    } else {
        
        $| = 1;
        
    }
}

$main::cc_stdout = '/tmp/vhcs2-cc.stdout';

$main::cc_stderr = '/tmp/vhcs2-cc.stderr';

$main::el_sep = "\t#\t";

@main::el = ();

sub push_el {
    
    my ($el, $sub_name, $msg) = @_;
    
    push @$el, "$sub_name".$main::el_sep."$msg";
    
    if (defined($main::engine_debug)) {
        
        print STDOUT "DEBUG: push_el() sub_name: $sub_name, msg: $msg\n";
        
    }
        
    
}

sub pop_el {
    
    my ($el) = @_;
    
    my $data = pop @$el;
    
    if (!defined($data)) {
        
        if (defined($main::engine_debug)) {
            
            print STDOUT "DEBUG: pop_el() Empty 'EL' Stack !\n";
                
        }
        
        return undef;
    }
    
    my ($sub_name, $msg) = split(/$main::el_sep/, $data);
    
    if (defined($main::engine_debug)) {
        
        print STDOUT "DEBUG: pop_el() sub_name: $sub_name, msg: $msg\n";
        
    }
        
    
    return $data;
    
}


sub dump_el {
    
    my ($el, $fname) = @_;
    
    my $res;
    
    if ($fname ne 'stdout') {
        
        $res = open(FP, ">", $fname);
        
        if (!defined($res)) {
            
            return 0;
            
        }
        
    }
    
    my $el_data = undef;
    
    #
    #if ($fname eq 'stdout') {
    #    
    #    print STDOUT "%-20s | %s\n",  ' function', 'message';
    #    
    #    print STDOUT "---------------------|---------------------------------------------------------------\n";
    #    
    #} else {
    #    
    #    print FP "%-20s | %s\n",  ' function', 'message';
    #    
    #    print FP "---------------------|---------------------------------------------------------------\n";
    #    
    #}
    #
    
    while (defined($el_data = pop_el(\@main::el))) {
        
        my ($sub_name, $msg) = split(/$main::el_sep/, $el_data);
        
        if ($fname eq 'stdout') {
            
            printf STDOUT "%-30s | %s\n",  $sub_name, $msg;
            
        } else {
            
            printf FP "%-30s | %s\n",  $sub_name, $msg;
            
        }
        
    }
    
    close(FP);
    
}

# Global variables;

$main::db_host = undef;

$main::db_user = undef;
    
$main::db_pwd = undef;
    
$main::db_name = undef;
    
@main::db_connect = ();

$main::db = undef;

# 

sub doSQL {
    
    my ($sql) = @_;
    
    my $qr = undef;
    
    push_el(\@main::el, 'doSQL()', 'Starting...');
    
    if (!defined($sql) || ($sql eq '')) {
        
        push_el(\@main::el, 'doSQL()', 'ERROR: Undefined SQL query !');
        
        return (-1, '');
        
    }
    
    if (!defined($main::db) || !ref($main::db)) {
        
        $main::db = DBI -> connect(@main::db_connect, {PrintError => 0});
        
        if ( !defined($main::db) ) {
            
            push_el(
                    \@main::el, 
                    'doSQL()', 
                    'ERROR: Unable to connect SQL server !'
                   ); 
            
            return (-1, '');
            
        }
    }
    
    if ($sql =~ /select/i) {
        
        $qr = $main::db -> selectall_arrayref($sql);
        
    } else {
        
        $qr = $main::db -> do($sql);
        
    }
    
    if (defined($qr)) {
        
        push_el(\@main::el, 'doSQL()', 'Ending...');
        
        return (0, $qr);
        
    } else {
        
        push_el(\@main::el, 'doSQL()', 'ERROR: Incrrect SQL Query -> '.$main::db -> errstr);
        
        return (-1, '');
        
    }
    
}

sub setfmode {
    
    my ($fname, $fuid, $fgid, $fperms) = @_;
    
    push_el(\@main::el, 'setfmode()', 'Starting...');
    
    if (
        !defined($fname) || !defined($fuid) || 
        !defined($fgid) || !defined($fperms) ||
        $fname eq '' || $fuid eq '' ||
        $fgid eq '' || $fperms eq ''
       ) 
    {
        
        push_el(
                \@main::el, 
                'setfmode()', 
                "ERROR: Undefined input data, fname: |$fname|, fuid: |$fuid|, fgid: |$fgid|, fperms: |$fperms| !"
               );
        
        return -1;

    }
    
    if (! -e $fname) {
        
        push_el(
                \@main::el, 
                'setfmode()', 
                "ERROR: File '$fname' does not exist !"
               );
        
        return -1;
    }
    
    my @udata = ();
    
    my @gdata = ();
    
    my ($uid, $gid) = ($fuid, $fgid);

	if ($fuid =~ /^\d+$/) {
		
		$uid = $fuid;
		
    } elsif ($fuid ne '-1') {
        
        @udata = getpwnam($fuid);
        
        if (scalar(@udata) == 0) {
            
            push_el(
                    \@main::el,
                    'setfmode()',
                    "ERROR: Unknown user '$fuid' !"
                   );

            return -1;
            
        }
        
        $uid = $udata[2];
    }
    
	if ($fgid =~ /^\d+$/) {
		
		$gid = $fgid;
		
	} elsif ($fgid ne '-1') {
        
        @gdata = getgrnam($fgid);
        
        if (scalar(@gdata) == 0) {
            
            push_el(
                    \@main::el,
                    'setfmode()',
                    "ERROR: Unknown group '$fgid' !"
                   );

            return -1;
            
        }
        
        $gid = $gdata[2];
    }
    
    my $res = chmod ($fperms, $fname);
    
    if ($res != 1) {
        
        push_el(
                \@main::el,
                'setfmode()',
                "ERROR: Can not change permissions of file '$fname' !"
               );

        return -1;
        
    }
    
    $res = chown ($uid, $gid, $fname);
    
    if ($res != 1) {
        
        push_el(
                \@main::el,
                'setfmode()',
                "ERROR: Can not change user/group of file '$fname' !"
               );

        return -1;
        
    }
    
    push_el(\@main::el, 'setfmode()', 'Ending...');
    
    return 0;
    
}

sub get_file {
    
    my ($fname) = @_;
    
    push_el(\@main::el, 'get_file()', 'Starting...');
    
    if (!defined($fname) || ($fname eq '')) {
        
        push_el(
                \@main::el, 
                'get_file()', 
                "ERROR: Undefined input data, fname: |$fname| !"
               );
        
        return (-1, '');
        
    }
    
    if (! -e $fname) {
        
        push_el(
                \@main::el, 
                'get_file()', 
                "ERROR: File '$fname' does not exist !"
               );
        
        return (-1, '');
        
    }
    
    my $res = open(F, '<', $fname);
    
    if (!defined($res)) {
        
        push_el(
                \@main::el, 
                'get_file()', 
                "ERROR: Can't open '$fname' for reading !"
               );
        
        return (-1, '');
    
    }
    
    my @fdata = <F>;
    
    close(F);
    
    my $line = join('', @fdata);
    
    push_el(\@main::el, 'get_file()', 'Ending...');
    
    return (0, $line);
    
}

sub store_file {
    
    my ($fname, $fdata, $fuid, $fgid, $fperms) = @_;
    
    push_el(\@main::el, 'store_file()', 'Starting...');
    
    if (
        !defined($fname) || !defined($fuid) || 
        !defined($fgid) || !defined($fperms) || 
        $fname eq '' || $fuid eq '' || 
        $fgid eq '' || $fperms eq ''
       )
    {
        push_el(
                \@main::el, 
                'store_file()', 
                "ERROR: Undefined input data, fname: |$fname|, fdata, fuid: '$fuid', fgid: '$fgid', fperms: '$fperms'"
               );
        
        return -1;
    }
    
    my $res = open(F, '>', $fname);
    
    if (!defined($res)) {
        
        push_el(
                \@main::el, 
                'store_file()', 
                "ERROR: Can't open file |$fname| for writing !"
               );
        
        return -1;
        
    }
    
    print F $fdata;
    
    close(F);
    
    my ($rs, $rdata) = setfmode($fname, $fuid, $fgid, $fperms);
    
    return -1 if ($rs != 0);
    
    push_el(\@main::el, 'store_file()', 'Ending...');
    
    return 0;
    
}

sub del_file {
    
    my ($fname) = @_;
    
    push_el(\@main::el, 'del_file()', 'Starting...');
    
    if (!defined($fname) || ($fname eq '')) {
        
        push_el(
                \@main::el, 
                'del_file()', 
                "ERROR: Undefined input data, fname: |$fname| !"
               );
        
        return -1;
        
    }
    
    if (! -e $fname) {
        
        push_el(
                \@main::el, 
                'del_file()', 
                "ERROR: File '$fname' does not exist !"
               );
        
        return -1;
        
    }
    
    my $res = unlink ($fname);
    
    if ($res != 1) {
        
        push_el(
                \@main::el, 
                'del_file()', 
                "ERROR: Can't unlink '$fname' !"
               );
        
        return -1;
        
    }
    
    push_el(\@main::el, 'del_file()', 'Ending...');
    
    return 0;
    
}

sub sys_command {
    
    my ($cmd) = @_;
    
    push_el(\@main::el, 'sys_command()', 'Starting...');
    
    my $result = system($cmd);

    my $exit_value  = $? >> 8;
    
    my $signal_num  = $? & 127;
    
    my $dumped_core = $? & 128;
    
    if ($exit_value == 0) {
        
        push_el(\@main::el, "sys_command('$cmd')", 'Ending...');
        
        return 0;
        
    } else {
        
        push_el(\@main::el, 'sys_command()', "ERROR: External command '$cmd' returned '$exit_value' status !");
        
        return -1;
        
    }
    
}

sub sys_command_rs {
    
    my ($cmd) = @_;
    
    push_el(\@main::el, 'sys_command_rs()', 'Starting...');
    
    my $result = system($cmd);

    my $exit_value  = $? >> 8;
    
    my $signal_num  = $? & 127;
    
    my $dumped_core = $? & 128;
    
    push_el(\@main::el, 'sys_command_rs()', 'Ending...');
    
    if ($exit_value == 0) {
        
        return 0;
        
    } else {
        
        
        return $exit_value;
        
    }
    
}

sub make_dir {
    
    my ($dname, $duid, $dgid, $dperms) = @_;
    
    my ($rs, $rdata) = ('', '');
    
    push_el(\@main::el, 'make_dir()', 'Starting...');
    
    if (
        !defined($dname) || !defined($duid) ||
        !defined($dgid) || !defined($dperms) ||
        $dname eq '' || $duid eq '' || 
        $dgid eq '' || $dperms eq ''
       )
    {
        
        push_el(\@main::el, 'make_dir()', "ERROR: Undefined input data, dname: |$dname|, duid: |$duid|, dgid: |$dgid|, dperms: |$dperms| !");
        
        return -1;
        
    }
    
    if ( -e $dname && -f $dname ) {
        
        push_el(\@main::el,'make_dir()', "'$dname' exists as file ! removing file first...");
            
        return -1 if (del_file($dname) != 0);
        
    }
    
    if (!(-e $dname && -d $dname)) {
        
        push_el(\@main::el, 'make_dir()', "'$dname' doesn't exists as directory! creating..."); 
        
        $rs = mkdir($dname);
        
        if (!$rs) {
            
            push_el(\@main::el, 'make_dir()', "ERROR: mkdir() returned '$rs' status !");
            
            return -1;
            
        }
        
    } else {
        
        push_el(\@main::el, 'make_dir()', "'$dname' exists ! Setting its permissions...");
        
    }
    
    return -1 if (setfmode($dname, $duid, $dgid, $dperms) != 0);
    
    push_el(\@main::el, 'make_dir()', 'Ending...');
    
    return 0;
}

sub del_dir {
    
    my ($dname) = @_;
    
    push_el(\@main::el, 'make_dir()', 'Starting...');
    
    if (!defined($dname) || ($dname eq '')) {
        
        push_el(\@main::el, 'make_dir()', "ERROR: Undefined input data, dname: |$dname| !");
        
        return -1;
        
    }
    
    push_el(\@main::el, 'make_dir()', "Trying to remove '$dname'...");
    
    return -1 if (sys_command("rm -rf $dname") != 0);
    
    push_el(\@main::el, 'make_dir()', 'Ending...');
    
    return 0;
    
}

sub gen_rand_num {
    
    my ($len) = @_;
    
    push_el(\@main::el, 'gen_rand_num()', 'Starting...');
    
    if (!defined($len) || ($len eq '')) {
        
        push_el(\@main::el, 'gen_rand_num()', "ERROR: Undefined input data, len: |$len| !");
        
        return (-1, '');
        
    }
    
    if (!(0 < $len && $len < 11)) {
        
        push_el(\@main::el, 'gen_rand_num()', "ERROR: Input data length '$len' out of limits [1, 10] !");
        
        return (-1, '');
        
    }
    
    my @rand_data = ('A'..'Z', 'a'..'z', '0'..'9', '.', '/');
    
    my ($i, $rdata) = ('', '');
    
    for ($i = 0; $i < $len; $i++) {
        
        $rdata .= $rand_data[ rand() * ($#rand_data + 1) ];
        
    }
    
    push_el(\@main::el, 'gen_rand_num()', 'Ending...');
    
    return (0, $rdata);
    
}

sub crypt_data {
    
    my ($data) = @_;
    
    push_el(\@main::el, 'crypt_data()', 'Starting...');
    
    if (!defined($data) || $data eq '') {
        
        push_el(\@main::el, 'crypt_data()', "ERROR: Undefined input data, data: |$data| !");
        
        return (-1, '');
        
    }
    
    my ($rs, $rdata) = gen_rand_num(2);

    return (-1, '') if ($rs != 0);
    
    $rdata = crypt($data, $rdata);
    
    push_el(\@main::el, 'crypt_data()', 'Ending...');
    
    return (0, $rdata);
    
}

sub get_tag {
    
    my ($bt, $et, $src) = @_;
    
    push_el(\@main::el, 'get_tag()', "Starting...");
    
    if (
        !defined($bt) || !defined($et) || 
        !defined($src) || $bt eq '' || 
        $et eq '' || $src eq ''
       )
    {
        
        push_el(\@main::el, 'get_tag()', "ERROR: Undefined intput data, bt: |$bt|, et: |$et|, src !");
        
        return (-1, '');
        
    }
    
    my ($bt_len, $et_len, $src_len) = (
                                       length($bt), 
                                       length($et),
                                       length($src) 
                                      );
    
    #
    #return ('_e03_', $main::strerr{'_e03_'})
    #    
    #if ($bt_len > $src_len || $et_len > $src_len);
    #
    
    if ($bt eq $et) { 
        
       
        # Let's search for ...$tag... ;
       
        # $bt == $et == $tag ;
       
        
        my $tag = $bt;
        
        my $tag_pos = index($src, $tag);
        
        if ($tag_pos < 0) {
            
            push_el(\@main::el, 'get_tag()', "ERROR: '$bt' eq '$et', missing '$bt' in src !");
            
            return (-4, '');
            
        } else {
            
            push_el(\@main::el, 'get_tag()', 'Ending...');
            
            return (0, $tag);
            
        }
        
    } else {
        
        if ($bt_len + $et_len > $src_len) {
            
            push_el(\@main::el, 'get_tag()', "ERROR: len($bt) + len($et) > len(src) !");
            
            return (-1, '');
            
        }
        
       
        # Let's search for ...$bt...$et... ;
       
        
        my ($bt_pos, $et_pos) = (index($src, $bt), index($src, $et));
        
        if ($bt_pos < 0 || $et_pos < 0) {
            
            push_el(\@main::el, 'get_tag()', "ERROR: '$bt' ne '$et', '$bt' or '$et' missing in src !");
            
            return (-5, '');
            
        }
        
        if ($et_pos < $bt_pos + $bt_len) {
            
            push_el(\@main::el, 'get_tag()', "ERROR: '$bt' ne '$et', '$et' overlaps '$bt' in src !");
            
            return (-1, '');

        }
        
        push_el(\@main::el, 'get_tag()', 'Ending...');
        
        my $tag_len = $et_pos + $et_len - $bt_pos;
        
        return (0, substr($src, $bt_pos, $tag_len));
        
    }
    
}

sub repl_tag {
    
    my ($bt, $et, $src, $rwith) = @_;
    
    push_el(\@main::el, 'repl_tag()', "Starting...");
    
    if (!defined ($rwith)) {
        
        push_el(\@main::el, 'repl_tag()', "ERROR: Undefined input data, rwith: |$rwith| !");
        
        return (-1, '');
        
    }
    
    my ($rs, $rdata) = get_tag($bt, $et, $src);
    
    return $rs if ($rs != 0);
    
    my $tag = $rdata;
    
    my ($tag_pos, $tag_len) = (index($src, $tag), length($tag));
    
    if ($rwith eq '') {
        
        substr($src, $tag_pos, $tag_len, '');
        
    } else {
        
        substr($src, $tag_pos, $tag_len, $rwith);
        
    }
    
    push_el(\@main::el, 'repl_tag()', "Ending...");
    
    return (0, $src);
}

sub add_tag {
    
    my ($bt, $et, $src, $adata) = @_;
    
    push_el(\@main::el, 'add_tag()', "Starting...");
    
    if (!defined($adata) || $adata eq '') {
        
        push_el(\@main::el, 'add_tag()', "ERROR: Undefined input data, adata: |$adata| !");
        
        return (-1, '');
    }
    
    my ($rs, $rdata) = get_tag($bt, $et, $src);
    
    return ($rs, '') if ($rs != 0);
    
    my $rwith = '';
    
    if ($bt eq $et) {
        
        $rwith = "$adata$bt";
        
    } else {
        
        $rwith = "$adata$bt$et";
        
    }
    
    ($rs, $rdata) = repl_tag($bt, $et, $src, $rwith);
    
    return (-1, '') if ($rs != 0);
    
    push_el(\@main::el, 'add_tag()', "Ending...");
    
    return (0, $rdata);
}

sub del_tag {
    
    my ($bt, $et, $src) = @_;
    
    push_el(\@main::el, 'del_tag()', "Starting...");
    
    my ($rs, $rdata) = get_tag($bt, $et, $src); 
    
    return ($rs, '') if ($rs != 0);
    
    ($rs, $rdata) = repl_tag($bt, $et, $src, '');
    
    return (-1, '') if ($rs != 0);
    
    push_el(\@main::el, 'del_tag()', "Ending...");
    
    return (0, $rdata);

}

sub get_var {
    
    my ($var, $src) = @_;
    
    push_el(\@main::el, 'get_var()', "Starting...");
    
    my ($rs, $rdata) = get_tag($var, $var, $src);
    
    return ($rs, '') if ($rs != 0);
    
    push_el(\@main::el, 'get_var()', "Ending...");
    
    return (0, $rdata);
    
}

sub repl_var {
    
    my ($var, $src, $rwith) = @_;
    
    my ($rs, $rdata, $result) = (0, $src, '');
    
    push_el(\@main::el, 'repl_var()', "Starting...");
    
    while ($rs == 0) {
        
        $result = $rdata;
        
        ($rs, $rdata) = repl_tag($var, $var, $rdata, $rwith);
        
        return -1 if ($rs != 0 && $rs != -4);
        
    }
    
    push_el(\@main::el, 'repl_var()', "Ending...");
    
    return (0, $result);
}

sub add_var {
    
    my ($var, $src, $adata) = @_;
    
    push_el(\@main::el, 'add_var()', "Starting...");
    
    my ($rs, $rdata) = add_tag($var, $var, $src, $adata);
    
    return -1 if ($rs != 0);
    
    push_el(\@main::el, 'add_var()', "Ending...");
    
    return (0, $rdata);
    
}

sub del_var {
    
    my ($var, $src) = @_;
    
    push_el(\@main::el, 'del_var()', "Starting...");
    
    my ($rs, $rdata) = repl_var($var, $src, '');
    
    return -1 if ($rs != 0);
    
    push_el(\@main::el, 'del_var()', "Ending...");
    
    return ($rs, $rdata);
    
}

sub get_tpl {
    
    my $tpl_dir = $_[0];
    
    my @tpls = @_;
    
    my ($rs, $rdata, $tpl_file) = ('', '', '');
    
    my @res = (0);
    
    push_el(\@main::el, 'get_tpl()', "Starting...");
    
    if (scalar(@tpls) < 2) {
        
        push_el(\@main::el, 'get_tpl()', "ERROR: Template filename(s) missing !");
        
        return (-1, '');
        
    }
    
    shift(@tpls);
    
    foreach (@tpls) {
        
        $tpl_file = $_;
        
        ($rs, $rdata) = get_file("$tpl_dir/$tpl_file");
        
        return (-1, '') if ($rs != 0);
        
        push (@res, $rdata);
    }
    
    push_el(\@main::el, 'get_tpl()', "Ending...");
    
    return @res;
    
}

sub prep_tpl {
    
    my $hash_ptr = $_[0];
    
    my @tpls = @_;
    
    my ($rs, $rdata) = ('', '', '');
    
    my @res = (0);
    
    push_el(\@main::el, 'prep_tpl()', "Starting...");
    
    if (scalar(@tpls) < 2) {
        
        push_el(\@main::el, 'prep_tpl()', "ERROR: Template variable(s) missing !");
        
        return (-1, '');
        
    }
    
    shift(@tpls);
    
    my ($i, $key) = ('', '');
    
    for($i = 0; $i < scalar(@tpls); $i++) {
        
        foreach $key (keys %$hash_ptr) {
            
            my $name = $key;
            
            my $value = $hash_ptr -> {$key};
            
            ($rs, $rdata) = repl_var($name, $tpls[$i], $value);
            
            return (-1, '') if ($rs != 0);
            
            $tpls[$i] = $rdata;
            
        }
        
        push (@res, $tpls[$i]);
    }
    
    push_el(\@main::el, 'prep_tpl()', "Ending...");
    
    return @res;
}

$main::lock_file = '/tmp/vhcs2.lock';

sub lock_system {
    
    push_el(\@main::el, 'lock_system()', 'Starting...');
    
    if (-e $main::lock_file) {
        
        push_el(\@main::el, 'lock_system()', 'ERROR: request engine already locked !');
        
        return -1;
        
    }
    
    my $touch_cmd = "/bin/touch $main::lock_file";
    
    my $rs = sys_command($touch_cmd);
    
    return -1 if ($rs != 0);
    
    push_el(\@main::el, 'lock_system()', 'Ending...');
    
    return 0;
}

sub unlock_system {
    
    push_el(\@main::el, 'unlock_system()', 'Starting...');
    
    my $rm_cmd = "/bin/rm -rf $main::lock_file";
    
    my $rs = sys_command($rm_cmd);
    
    return -1 if ($rs != 0);
    
    push_el(\@main::el, 'unlock_system()', 'Ending...');
    
    return 0;

}

# License request function must not SIGPIPE;

$SIG{PIPE} = 'IGNORE';

$SIG{HUP} = 'IGNORE';

sub connect_vhcs2_daemon {
    
    push_el(\@main::el, 'connect_vhcs2_daemon()', 'Starting...');
    
    my $fd = IO::Socket::INET -> new(
                                     Proto => "tcp",
                                     PeerAddr => "127.0.0.1",
                                     PeerPort => "8668"
                                    );
    
    if (!defined($fd)) {
        
        push_el(\@main::el, 'connect_vhcs2_daemon()', "ERROR: Can't connect to VHCS2 license daemon !");
        
        return (-1, '');
        
    }
    
    push_el(\@main::el, 'connect_vhcs2_daemon()', 'Ending...');
    
    return (0, $fd);
}

sub recv_line {
    
    my ($fd) = @_; 
    
    my ($res, $row, $ch) = (undef, undef, undef, undef);
    
    push_el(\@main::el, 'recv_line()', 'Starting...');
    
    do {
        
        $res = recv($fd, $ch, 1, 0);
        
        if (!defined($res)) {
            
            push_el(\@main::el, 'recv_line()', "ERROR: unexpected IO prebolems !");
            
            return (-1, '');
            
        }
        
        $row .= $ch;
        
    } while ($ch ne "\n");
    
    push_el(\@main::el, 'recv_line()', 'Ending...');
    
    return (0, $row);
    
}

sub send_line {
    
    my ($fd, $line) = @_; 
    
    my ($i, $res, $ch) = (undef, undef, undef);
    
    push_el(\@main::el, 'send_line()', 'Starting...');
    
    for ($i = 0; $i < length($line); $i++) {
        
        $ch = substr($line, $i, 1);
        
        $res = send($fd, $ch, 0);
        
        if (!defined($res)) {
            
            push_el(\@main::el, 'send_line()', "ERROR: unexpected IO prebolems !");
            
            return (-1, '');
            
        }
            
    } 
    
    push_el(\@main::el, 'send_line()', 'Ending...');
    
    return (0, '');
}

sub close_vhcs2_daemon {
    
    my ($fd) = @_;
    
    push_el(\@main::el, 'close_vhcs2_daemon()', 'Starting...');
    
    close($fd);
    
    push_el(\@main::el, 'close_vhcs2_daemon()', 'Ending...');
    
}

sub license_request {
    
    push_el(\@main::el, 'license_query()', 'Starting...');
    
    my ($rs, $rdata) = connect_vhcs2_daemon();
    
    return ($rs, $rdata) if ($rs != 0);
    
    my $fd = $rdata;
    
    # Welcome message;
    
    ($rs, $rdata) = recv_line($fd);
    
    return ($rs, $rdata) if ($rs != 0);
    
    # 'helo' cmd;
    
    my $helo_cmd = "helo $main::cfg{'SERVER_HOSTNAME'}\r\n";
    
    ($rs, $rdata) = send_line($fd, $helo_cmd);
    
    return ($rs, $rdata) if ($rs != 0);

    ($rs, $rdata) = recv_line($fd);
    
    return ($rs, $rdata) if ($rs != 0);
    
    # 'license request' cmd';
    
    my $request_cmd = "license request\r\n";
    
    ($rs, $rdata) = send_line($fd, $request_cmd);
    
    return ($rs, $rdata) if ($rs != 0);

    ($rs, $rdata) = recv_line($fd);
    
    return ($rs, $rdata) if ($rs != 0);
    
    my $res = $rdata;
    
    if ($res =~ /^250 OK ([^\r]+)\r\n$/) {
        
        $rdata = $1;
        
        $main::working_license = $1;
        
    }
    
    
    # 'bye' cmd;
    
    ($rs, $rdata) = send_line($fd, "bye\r\n");

    ($rs, $rdata) = recv_line($fd);
    
    close_vhcs2_daemon($fd);
    
    push_el(\@main::el, 'license_query()', 'Ending...');
    
    return (0, $main::working_license);
    
}

$main::master_name = 'vhcs2-rqst-mngr';

sub check_master {
    
    if (defined($main::engine_debug)) {
        
        push_el(\@$main::el, 'check_master()', 'Starting...');
        
    }
    
    sys_command("export COLUMNS=120;/bin/ps aux | awk '\$0 ~ /$main::master_name/ && \$0 !~ /awk/ { print \$2 ;}' 1>$main::cc_stdout 2>$main::cc_stderr");
    
    if (-z $main::cc_stdout) {
        
        del_file($main::cc_stdout); del_file($main::cc_stderr);
        
        push_el(\@main::el, 'check_master()', 'ERROR: Master manager process is not running !');
        
        return -1;
        
    }
    
    del_file($main::cc_stdout); del_file($main::cc_stderr);
    
    if (defined($main::engine_debug)) {
        
        push_el(\@$main::el, 'check_master()', 'Starting...');
        
    }
    
    return 0;
    
}

# Global variables

%main::cfg = ();

%main::cfg_reg = ();

$main::cfg_file = '/etc/vhcs2/vhcs2.conf';

$main::cfg_re = '^([\_A-Za-z0-9]+) *= *([^\n\r]*)[\n\r]';

use FindBin;
use lib "$FindBin::Bin/";
require 'vhcs2-db-keys.pl';

sub encrypt_db_password {
    
    my ($pass) = @_;
    
    push_el(\@main::el, 'encrypt_db_password()', 'Starting...');
    
    if (!defined($pass) || $pass eq '') {
        
        push_el(\@main::el, 'encrypt_db_password()', 'ERROR: Undefined input data ($pass)...');
        
        return (1, '');
        
    }
    
    my $cipher = Crypt::CBC -> new( 
                                    {
                                        'key'             => $main::db_pass_key,
                                        'cipher'          => 'Blowfish',
                                        'iv'              => $main::db_pass_iv,
                                        'regenerate_key'  => 0,
                                        'padding'         => 'space',
                                        'prepend_iv'      => 0
                                    }
                                  );
    
    my $ciphertext = $cipher->encrypt($pass);
    
    my $encoded = encode_base64($ciphertext); chop($encoded);

    push_el(\@main::el, 'encrypt_db_password()', 'Ending...');
    
    return (0, $encoded);
    
}

sub decrypt_db_password {
    
    my ($pass) = @_;
    
    push_el(\@main::el, 'decrypt_db_password()', 'Starting...');
    
    if (!defined($pass) || $pass eq '') {
        
        push_el(\@main::el, 'decrypt_db_password()', 'ERROR: Undefined input data ($pass)...');
        
        return (1, '');
        
    }
    
    my $cipher = Crypt::CBC -> new( 
                                    {
                                        'key'             => $main::db_pass_key,
                                        'cipher'          => 'Blowfish',
                                        'iv'              => $main::db_pass_iv,
                                        'regenerate_key'  => 0,
                                        'padding'         => 'space',
                                        'prepend_iv'      => 0
                                    }
                                  );
    
    my $decoded = decode_base64("$pass\n");
    
    my $plaintext = $cipher -> decrypt($decoded);
    
    
    push_el(\@main::el, 'decrypt_db_password()', 'Ending...');
    
    return (0, $plaintext);
    
}

sub setup_main_vars {
    
    push_el(\@main::el, 'setup_main_vars()', 'Starting...');
    
    #
    # Database backend vars;
    #
    
    $main::db_host = $main::cfg{'DATABASE_HOST'};
    
    $main::db_user = $main::cfg{'DATABASE_USER'};
    
    $main::db_pwd = $main::cfg{'DATABASE_PASSWORD'};
    
    if ($main::db_pwd ne '') {
        
        my $rs = undef;
        
        ($rs, $main::db_pwd) = decrypt_db_password($main::db_pwd);
        
    }
    
    
    
    $main::db_name = $main::cfg{'DATABASE_NAME'};
    
    @main::db_connect = (
                         "DBI:mysql:$main::db_name:$main::db_host",
                         $main::db_user,
                         $main::db_pwd
                        );
    
    push_el(\@main::el, 'setup_main_vars()', 'Ending...');
    
    return 0;
}

sub get_conf {
    
    push_el(\@main::el, 'get_conf()', 'Starting...');
    
    my ($rs, $fline) = get_file($main::cfg_file);
    
    return -1 if ($rs != 0);
    
    my @frows = split(/\n/, $fline);
    
    my $i = '';
    
    for ($i = 0; $i < scalar(@frows); $i++) {
        
        $frows[$i] = "$frows[$i]\n";
        
        if ($frows[$i] =~ /$main::cfg_re/) {
            
            $main::cfg{$1} = $2; 
            
        }
        
    }
    
    return -1 if (setup_main_vars() != 0);
    
    push_el(\@main::el, 'get_conf()', 'Ending...');
    
    return 0;

}

sub set_conf_val {
    
    my ($name, $value) = @_;
    
    push_el(\@main::el, 'set_conf_val()', 'Starting...');
    
    if (!defined($name) || $name eq '') {
        
        push_el(\@main::el, 'set_conf_val()', 'ERROR: Undefined input data ($name)...');
        
        return 1;
        
    }
    
    $main::cfg_reg{$name} = $value;
    
    push_el(\@main::el, 'set_conf_value()', 'Ending...');
    
    return 0;
    
}

sub store_conf {

    my ($key, $value, $fline, $rs) = (undef, undef, undef, undef);

    my $rwith = undef;

    push_el(\@main::el, 'store_conf()', 'Starting...');

    ($rs, $fline) = get_file($main::cfg_file);

    return 1 if ($rs != 0);

    if (scalar(keys(%main::cfg_reg)) > 0) {

        while (($key, $value) = each %main::cfg_reg) {

            $rwith = "$key = $value\n";

            $fline =~ s/^$key *= *([^\n\r]*)[\n\r]/$rwith/gim;

        }

    }

    $rs = store_file($main::cfg_file, $fline, 'root', 'root', 0644);

    return 1 if ($rs != 0);

    $rs = get_conf($main::cfg_file);

    return 1 if ($rs != 0);

    push_el(\@main::el, 'store_conf()', 'Ending...');

    return 0;

}

my $rs = get_conf();
    
return $rs if ($rs != 0);

# debug dump files;
$main::log_dir = $main::cfg{'LOG_DIR'};

$main::vhcs2_arpl_msgr_el = "$main::log_dir/vhcs2-arpl-msgr.el";
#$main::vhcs2_arpl_msgr_stdout = "$main::log_dir/vhcs2-arpl-msgr.stdout";
#$main::vhcs2_arpl_msgr_stderr = "$main::log_dir/vhcs2-arpl-msgr.stderr";

#$main::engine_debug = '_on_';

#
# common code: END
#
use strict;

use warnings;

my @msg_rows = <STDIN>;

my $msg = join('', @msg_rows);

sub arpl_msgr_start_up {
    
    my ($rs, $rdata) = (undef, undef);
    
    push_el(\@main::el, 'arpl_msgr_start_up()', 'Starting...');
    
    # Let's clear Execution Logs, if any.
    
    if (-e $main::vhcs2_arpl_msgr_el) {
        
        $rs = del_file($main::vhcs2_arpl_msgr_el);
        
        return $rs if ($rs != 0);
        
    }
    
    # config check;
    
    $rs = get_conf();
    
    return $rs if ($rs != 0);
    
    # sql check;
   
    #
    # getting initial data also must be done here;
    #
    
    my $sql = "select * from domain;";
    
    ($rs, $rdata) = doSQL($sql);
    
    return $rs if ($rs != 0);
    
    push_el(\@main::el, 'arpl_msgr_start_up()', 'Ending...');
    
    return 0;
    
}

sub arpl_msgr_shut_down {
    
    my $rs = undef;
    
    push_el(\@main::el, 'arpl_msgr_shut_down()', 'Starting...');
    
	$main::db -> disconnect();
    
    push_el(\@main::el, 'arpl_msgr_shut_down()', 'Ending...');
    
    return 0;
    
}

sub arpl_msgr_engine {
    
	push_el(\@main::el, 'arpl_msgr_engine()', 'Starting...');

	my ($sql, $rs) = (undef, undef);
    
	my $msg_parser = new MIME::Parser;
    
	$msg_parser -> output_to_core(1);
    
    my $msg_entity = $msg_parser -> parse_data($msg);
    
    my $head = $msg_entity -> head();
    
	my @from_ma = Mail::Address->parse($head -> get('From'));
        
	my @to_addrs = Mail::Address->parse($head -> get('X-Original-To'));

	my $buffer = "0";

	my $name = undef;

	my $mail_to = undef;

	my $to_ma = undef;

	if(	$head -> get('X-Mailer') !~ m/Autoreply Manager/i && 
		!$head -> get('X-Autoresponse-From') && 
		$head -> get('Auto-Submitted') !~ m/auto-replied/i && 
		$head -> get('Sender')!~ m/autoresponder/i) {

		foreach $to_ma (@to_addrs) {

			if($to_ma->address =~ m/@/i && $to_ma->address !~ m/"/g) {

				if($buffer) {
					$name = $buffer;
					$buffer = "0";
				}
				else {
					if($to_ma->phrase) { $name = $to_ma->phrase; }
					else { $name = ""; }
				}

    			push_el(\@main::el, 'arpl_msgr_engine():', ">>> From: |".$from_ma[0]->address."|, To: |".$to_ma->address."|");

    	    	push_el(\@main::el, 'arpl_msgr_engine():', "loop!");

				my $ma = $to_ma->address."\n";

        		return 0 if (!($ma =~ /^([^\@]+)\@([^\n]+)\n$/));

	        	my ($user, $dmn) = ($1, $2);

    	    	my ($ref, $dmn_id, $sub_id, $pt) = (undef, undef, undef, undef, undef, undef);

       		 	my ($domainformsubdomain, $subformsubdomain) = (undef, undef);

        		$sql = "select count(domain_id) as cnt from domain where domain_name = '$dmn'";

	        	($rs, $ref) = doSQL($sql);

    	    	return $rs if ($rs != 0);

        		$ref = @$ref[0];
        
        		if (@$ref[0] == 1) {
            
            		$pt = 1;
            
	        	} else {
            
    	        	$pt = 2;
            
        		}

        		if ($pt == 1) {
            
            		$sql = "select domain_id from domain where domain_name = '$dmn';"; 
            
	            	($rs, $ref) = doSQL($sql);
            
    	        	return $rs if ($rs != 0);
            
        	    	$ref = @$ref[0]; $dmn_id = @$ref[0];            
            
	            	$sql = "select mail_auto_respond from mail_users where mail_acc = '$user' and domain_id = '$dmn_id' and sub_id = '0';";
            
    	    	} elsif ($pt == 2) {

					$sql = "select alias_id as alias_id, domain_id as domain_id from domain_aliasses where alias_name = '$dmn';";
            
					($rs, $ref) = doSQL($sql);
            
					return $rs if ($rs != 0);
            
					$ref = @$ref[0]; $sub_id = @$ref[0]; $dmn_id = @$ref[1];

 					if($dmn =~ /(.*)(\.)(.*\.)(.*)$/ && !$sub_id) 
					{
						$domainformsubdomain = $3.$4;

						$subformsubdomain = $1;

						push_el(\@main::el, 'arpl_msgr_engine():', "domainfromsubdomain: |".$domainformsubdomain."| subfromsubdomain".$subformsubdomain."|");

						$sql = "select count(domain_id) as cnt from domain where domain_name = '$domainformsubdomain'";

						($rs, $ref) = doSQL($sql);
            
						return $rs if ($rs != 0);
        
						$ref = @$ref[0];
        
		        	   	$sql = "select domain_id from domain where domain_name = '$domainformsubdomain';";
            	
	   		        	($rs, $ref) = doSQL($sql);
            
		   	        	return $rs if ($rs != 0);
        	    
			            $ref = @$ref[0]; $dmn_id = @$ref[0];

						$sql = "select subdomain_id from subdomain where subdomain_name = '$subformsubdomain';"; 
		            
						($rs, $ref) = doSQL($sql);
            
						return $rs if ($rs != 0);
           
						$ref = @$ref[0]; $sub_id = @$ref[0];
					}
	
					$sql = "select mail_auto_respond from mail_users where mail_acc = '$user' and sub_id = '$sub_id' and domain_id = '$dmn_id';";
            
		        }

    			push_el(\@main::el, 'arpl_msgr_engine():', "sql: |".$sql."|");
            
	    	    ($rs, $ref) = doSQL($sql);
            
	        	return $rs if ($rs != 0);
        
        
		        $ref = @$ref[0]; my $auto_message = @$ref[0];

				if($auto_message ne '_no_') {

					if($name) { $mail_to = "\"".$name."\" "."<".$to_ma->address.">"; }
					
					else{ $mail_to = $to_ma->address; }


			        my $out = new MIME::Entity;
            
					$out -> build(
    		    	              From => $mail_to,
        		    	          To => $head -> get('From'),
            		    	      Subject => "[Autoreply] ".$head -> get('Subject'),
                		    	  Type => "multipart/mixed",
	                    		  'X-Mailer' => "$main::cfg{'VersionH'} Autoreply Manager"
								);
        
        	
					$out -> attach(
	                    		  Type => "text/plain",
    	                		  Encoding => "7bit",
        	            		  Description => "Mail User Autoreply Message",
            	        		  Data => $auto_message
								);
        
					$out -> attach(
    	                		  Type => "message/rfc822",
        	            		  Description => "Original Message",
            	        		  Data => $msg
								);
            
					open MAIL, "| /usr/sbin/sendmail -t -oi";
    	    
					$out -> print(\*MAIL);
        
					close MAIL;
				}

		    	push_el(\@main::el, 'arpl_msgr_engine()', 'Ending...');

			}
			else
			{
				$buffer = $to_ma->address;
				$buffer =~ s/"//g;
			}

		}

	}
    
	return 0;
    
}

$rs = undef;

$rs = arpl_msgr_start_up();

if ($rs != 0) {
    
    dump_el(\@main::el, $main::vhcs2_arpl_msgr_el);
    
    arpl_msgr_shut_down();
    
    exit 1;
    
}

$rs = arpl_msgr_engine();

if ($rs != 0) {
    
    dump_el(\@main::el, $main::vhcs2_arpl_msgr_el);
    
    arpl_msgr_shut_down();
    
    exit 1;
    
}

$rs = arpl_msgr_shut_down();

if ($rs != 0) {
    
    dump_el(\@main::el, $main::vhcs2_arpl_msgr_el);
    
    exit 1;
    
}

exit 0;
