#!/usr/bin/perl
#
#  This is part of Cleo batch system project.
#  (C) Sergey Zhumatiy (serg@parallel.ru) 1999-2007
#
#
# You can redistribute and/or modify this program
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# See the GNU Library General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

#
# server side (head daemon)
#

#parameters: -p <port> -s queue_save_file -a queue_alt_save_file      -x
#   default port is 25000 ^/var/log/queue-status  ^/tmp/queue-status  ^skip auth.
#            -t <save_internal>           -r report_file
#           approximately in seconds :)    ^path to report file
#           ^ignored now... saves are performed when new tasks are executed or queued.
#            -f <config_file>      -v
#               ^alternate config  ^log more ;)

use vars qw($VERSION $self_path);

BEGIN {
    $VERSION = 5.13;
    eval "use lib '.';
         use lib '/usr/lib/cleo';
         use cleovars $VERSION;
         use cleosupport $VERSION;";
    die $@ if ($@);
}
$VARIANT = 'a';

use locale;
use IO::Socket;    #::INET;
use Fcntl;
use IO::Handle;
use IO::Select;
use IO::File;
#use IPC::SysV qw(IPC_RMID IPC_PRIVATE S_IRWXU IPC_CREAT IPC_NOWAIT);
use POSIX ":sys_wait_h";
use Cleo::Conn;

#use Getopt::Std;
use Time::Local;
use strict;

#
#  Global declarations
#
####################################################################

use vars qw($tmp $line $from $to $LST $RSH $Client @OutClients
    $hash $req_change $last_ping_time
    $local_count @args $dead_time_out $last_del $restarter $mon_port
    %rsh_cmd_lines %rsh_pids @ppids $last_cin
    $check_timed_out $program_start_time $restriction_time_changed
    %mon_by_conn %__by_mons %by_owner $stat_conn %local_rshells
    @free_own %rsh_data $cleanup_interval $norun_reason
    $next_check_running $mons_connecting %mon_vars
    @mons_delayed_sends);

# @mons_to_ping

$self_path = "/usr/sbin/cleo";

#$restarter="_base_/qrestart";
push @INC, ( "/usr/lib/cleo" );

#use lib ".";
use lib "/usr/lib/cleo";

# check for O_LARGEFILE and define it if not defined
eval { &O_LARGEFILE(); };
if ($@) {
    eval "sub O_LARGEFILE(){return 0;}";
}

#
#  Prototypes
#
sub _send_int_info_to_mon( $ );
sub ablock_handler($$$$ );
sub account_end( $ );
sub account_load( $ );
sub account_reset();
sub account_reset_daily();
sub account_save( $ );
sub account_start( $ );
sub after_death_user_part( $$$ );
sub can_run($ );
sub check_blocked_by_res();
sub check_children();
sub check_time_restrictions( $ );

sub add_handler($$$$ );
sub answer_to_parent($$$$;@ );
sub attach_handler($$$$ );
sub block_handler($$$$ );
sub block_pe_handler($$$$ );
sub chattr_handler($$$$ );
sub freeze_handler($$$$ );
sub get_io_handler($$$$ );
sub del_handler($$$$ );
sub del_local_handler($$$$ );
sub dmt_handler($$$$ );
sub debug_handler($$$$ );
sub finished_handler($$$$ );
sub id_by_pid_handler($$$$ );
sub int_info_handler($$$$ );
sub mode_handler($$$$ );
sub pri_handler($$$$ );
sub reload_conf_handler($$$$ );
sub reload_sced_handler($$$$ );
sub reload_users_handler($$$$ );
sub run_handler($$$$ );
sub run_pre_handler($$$$ );
sub rvm_handler($$$$ );
sub start_handler($$$$ );
sub stop_handler($$$$ );
sub test_id_handler($$$$ );
sub update_restrictions_handler($$$$ );
sub view_handler($$$$ );

sub child_message_process( $$$$ );
sub chld_ablock_handler($$$$$$ );
sub chld_add_handler($$$$$$ );
sub chld_attach_handler($$$$$$ );
sub chld_block_handler($$$$$$ );
sub chld_block_pe_handler($$$$$$ );
sub chld_chattr_handler($$$$$$ );
sub chld_freeze_handler($$$$$$ );
sub chld_clean_task_handler($$$$$$ );
sub chld_del_handler($$$$$$ );
sub chld_del_loc_handler($$$$$$ );
sub chld_every_ablock_handler($$$$$$ );
sub chld_every_add_handler($$$$$$ );
sub chld_every_del_handler($$$$$$ );
sub chld_every_del_loc_handler($$$$$$ );
sub chld_every_int_info_handler($$$$$$ );
sub chld_every_mode_handler($$$$$$ );
sub chld_every_view_handler($$$$$$ );
sub chld_get_io_handler($$$$$$ );
sub chld_got_handler($$$$$$ );
sub chld_init_attach_handler($$$$$$ );
sub chld_int_info_handler($$$$$$ );
sub chld_mode_handler($$$$$$ );
sub chld_pri_handler($$$$$$ );
sub chld_stop_task_handler($$$$$$ );
sub chld_test_id1($$$$$$ );
sub chld_view_handler($$$$$$ );

sub mon_message_process($$$$ );
sub mon_ping_handler($$$$$$ );
sub mon_run_handler($$$$$$ );
sub mon_attach_handler($$$$$$ );
sub mon_every_int_handler($$$$$$ );
sub mon_every_kill_handler($$$$$$ );
sub mon_every_run_handler($$$$$$ );
sub mon_init_attach_handler($$$$$$ );
sub mon_int_info_handler($$$$$$ );
sub mon_kill_handler($$$$$$ );

sub cleanup_data( );
sub correct_time_restrictions( ;$ );
sub count_user_tasks( $ );
sub default_scedule($\@\@\@ );
sub def_timeout_child_proc();
sub def_timeout_mon_proc();
sub do_external_scedule( $ );
sub dump_settings();
sub every_nil_sub( $$$$ );
sub extern_shuffle( $$$ );
sub filter_rsh( $ );
sub final_kill_mon_task( $$$ );
sub finished_from_mon_processor( $$ );
sub flush_to_childs();
sub flush_to_mons();
sub flush_to_parent();
sub get_all_ppids( $$ );
sub get_args_from_array( $$ );
sub GetOptsTillCan_hash;
sub get_parsed_block_x( $$ );
sub get_warnings();
sub glue_queues_replies( $$;$ );
sub handle_user_connection( $ );
sub id_by_pids_sub($$$$$$ );
sub is_rsh_valid( $ );
sub kill_mons();
sub load_restrictions( $ );
sub make_aliases($;@ );
sub mark_channel_dead( $ );
sub mon_fast_raise( $ );
sub mon_fast_raise_cancel( $ );
sub mons_connecter( $ );
sub mons_connecter2( $ );
sub mons_pinger( $ );
sub new_extern_shuffle( $ );
sub new_mon_connection( $ );
sub new_req_to_child( $$$$$$$;$$@ );
sub new_req_to_mon( $$$$$$;$$@ );
sub new_rsh_connection( $ );
sub new_rsh_filter( $ );
sub nil_sub();
#sub ad( $;$ );
sub on_mon_raise_back( $ );
sub on_mon_timed_out( $ );
sub rcv_from_childs();
sub rcv_from_mon();
sub rcv_from_parent();
sub rcv_from_rsh();
sub recreate_lst();
sub recreate_rsh();
sub register_parent_rcv( $$ );
sub rerun_extern_shuffles();
sub run_or_del($$ );
sub sceduler_event( $;$ );
sub send_to_parent( $ );
sub start_sceduler();
sub stop_sceduler();
sub task_after_death($$ );
sub task_node_dead( $$ );
sub test_dependencies( $ );
sub there_are_blocked_tasks();
sub try_to_run($;$ );
sub unregister_parent_rcv( $$ );

sub user_add_processor( $$ );
sub user_autoblock_processor( $$ );
sub user_block_pe_processor( $$ );
sub user_block_processor( $$ );
sub user_chattr_processor( $$ );
sub user_debug_processor( $$ );
sub user_del_processor( $$ );
sub user_get_io_processor( $$ );
sub user_mode_processor( $$ );
sub user_priority_processor( $$ );
sub user_view_processor( $$ );
sub user_freeze_processor( $$ );

my $cccount;           # DEBUG!
my $already_runned;    # DEBUG!
my $last_mon_ping;     # DEBUG!
my %_d_nolog_type;     # DEBUG!

my ( $out,  $paddr );
my ( @outs, @ready );
my (@cl_str);
my ( @messages_to_self, @answers_to_self );

#
#  Initial values
#
#########################################################################

%debug = (
    'aa'  => 0,        # secial debug purposes
    'cf'  => 0,        # 'count free' nodes
    'nc'  => 0,        # 'node not connectd' and pingers messages
    'yy'  => 0,        # completing messages ('Yahoo' in cleosupport.pm)
    'mc'  => 0,        # log message contents
    'pc'  => 0,        # pack/unpack values info
    'sc'  => 0,        # internal tasks
    'env' => 0,        # environment variables tracing (for tasks)
    'tr'  => 0,        # time restrictions checks
    'cs'  => 0,        # send packets to/from childs
    'ch'  => 0,        # cpu_per_hours caclculations
    'sbst'=> 0,        # substitution debug
    'tsk' => 0         # some tasks details (when exec eg)
);

%_d_nolog_type = ( 'ping' => 1 );

$log_level = 4;        # All except DEBUG2

$dead_time_out = 5;    # DEBUG!

#$child_req_tmout  = 15;
$cleanup_interval = 60;

$die_pipe    = '/tmp/qpipe';
$local_count = 10;
$dying       = 0;

umask(0133);  #    rw-r--r--


%mon_vars=('hard_kill_delay'=>'hard_kill_delay',
           'mon_rsh_command'=>'rsh_command',
           'mon_path_prepend'=>'path_prepend',
           'mon_path_append'=>'path_append'
           );


$usage =
      "Usage: $0 [options]\nOptions are: -h      This help\n"
    . "             -c file Use <file> as config file\n"
    . "             -p port Use <port> as listening port\n"
    . "             -s file Use <file> as queue-status file\n"
    . "             -a file Use <file> as alternate queue-status file\n"
    . "             -l file Use <file> as log file\n"
    . "             -i file Use <file> as pid file\n"
    . "             -x      No authorization checks\n"
    . "             -r      Restore ALL settings from save_file\n"
    . "             -v      Print more debug information\n";

$opts{c}                 = '/etc/cleo.conf';
$global_settings{min_np} = 1;
$rootisadm               = 1;
$runned_list_len         = 1023;

%shuffle_algorithms = (
    'random'       => \&cleosupport::shuffle_array,
    'random_hosts' => \&cleosupport::shuffle_only_hosts,
    'random_alone' => \&cleosupport::shuffle_hosts_alone );

#$admins                  = 'root';
$tcount      = 1;
$hashcount   = 1;
$mode        = MODE_RUN_ALLOW | MODE_QUEUE_ALLOW;
$safe_reload = 1;

@args = join( ' ', @ARGV );

#Check for '-c' and '-h' manualy...
for ( my $i = 0; $i < scalar(@ARGV); ++$i ) {
    if ( $ARGV[$i] eq '-c' && $ARGV[ $i + 1 ] ) {
        $opts{c} = $ARGV[ $i + 1 ];
        last;
    }
    if ( $ARGV[$i] eq '-h' ) {
        print $usage;
        exit(0);
    }
}

%error_codes = ();
for ( my $i = 1; $i < 128; ++$i ) {
    $! = $i;
    if (   ( $! eq "Bad file descriptor" )
        or ( $! eq "File too large" )
        or ( $! eq "Broken pipe" )
        or ( $! eq "Machine is not on the network" )
        or ( $! eq "Communication error on send" )
        or ( $! eq "Protocol error" )
        or ( $! eq "Network is down" )
        or ( $! eq "Network is unreachable" )
        or ( $! eq "Network dropped connection on reset" )
        or ( $! eq "Software caused connection abort" )
        or ( $! eq "Connection reset by peer" )
        or ( $! eq "Cannot send after transport endpoint shutdown" )
        or ( $! eq "Connection timed out" ) ) {
        $error_codes{$i} = 1;
        $error_codes{$!} = 1;
    }
}

$last_time = time;

$cleosupport::STATUS = new IO::File;
$cleosupport::STATUS->fdopen( fileno(STDOUT), "w" );
$cleosupport::SHORT_LOG = new IO::File;
$cleosupport::SHORT_LOG->open(">/dev/null");

undef $LST;    #=new IO::File;

#$LST->open("/dev/null");
#undef $MON;    #=new IO::File;

#$MON->open("/dev/null");
undef $RSH;    #=new IO::File;

#$RSH->open("/dev/null");

#set_default_values();
$safe_reload = 1;
$is_master   = 1;
load_conf_file(1);
$safe_reload = 0;

$scedule_proc         = 'default';
$pending_scedule_proc = 'default';
$foreign_scedule_proc = 'default';

$scedule{default}         = \&default_scedule;
$pending_scedule{default} = \&default_scedule;    #\&default_pending_scedule;
$foreign_scedule{default} = \&default_scedule;    #\&default_foreign_scedule;

#
#  Handlers for clients requests (via tcp/ip socket)
#
my %user_processors = (
    'add'       => \&user_add_processor,
    'del'       => \&user_del_processor,
    'view'      => \&user_view_processor,
    'debug'     => \&user_debug_processor,
    'priority'  => \&user_priority_processor,
    'chattr'    => \&user_chattr_processor,
    'autoblock' => \&user_autoblock_processor,
    'block'     => \&user_block_processor,
    'block_pe'  => \&user_block_pe_processor,
    'get_io'    => \&user_get_io_processor,
    'freeze'    => \&user_freeze_processor,
    'mode'      => \&user_mode_processor );

GetOptsTillCan_hash(
    \%opts, 'p=i', 's=s', 'a=s', 'x=', 'l=s',
    'i=s',  'c=s', 'v=',  'h=',  'r=', 'L=s' );

#getopts('p:s:a:xl:i:c:vhL:');

# -p <port> -s <status-file> -a <alt-state-file> -l <log-file>
# -c <config-file> -i <pid-file> -x
#                                ^dont use authorization
# -r restore SERVER data from save-files
# -L <short_log_file>

my $port = cleosupport::get_setting( 'port', '', '' );

print "Using $report_file as logfile and $short_rep_file as shortlogfile\n";
close $cleosupport::STATUS;
$cleosupport::STATUS->open( $report_file,
    O_WRONLY | O_CREAT | O_APPEND | O_LARGEFILE )
    or die "Cannot open report file '$report_file'\n";
$cleosupport::STATUS->autoflush(1);

$cleosupport::SHORT_LOG->open( $short_rep_file,
    O_WRONLY | O_CREAT | O_APPEND | O_LARGEFILE )
    or die "Cannot open short report file '$short_rep_file'\n";
$cleosupport::SHORT_LOG->autoflush(1);

$cluster_name = 'INIT';
daemonize();

open( PID, ">$opts{i}" ) or die "Cannot create pid file ($opts{i})\n";
print PID $$;
close PID;

$SIG{CHLD} = \&REAPER;
$SIG{USR1} = \&save_state;
$SIG{USR2} = \&recreate_lst;
$SIG{HUP}  = \&load_conf_file;

#$SIG{ABRT} = \&save_n_exit;
#$SIG{TERM} = sub {qlog "TERM???\n",LOG_ERR;};
$SIG{QUIT} = \&save_n_exit;
$SIG{BUS}  = \&save_n_exit;
$SIG{SEGV} = \&save_n_exit;
$SIG{FPE}  = \&save_n_exit;

#$SIG{INT}  = \&save_n_exit;
$SIG{ILL}  = \&save_n_exit;
{
    my $last=0;
    my $count=0;
    my $INTERVAL=30;

    $SIG{PIPE} = sub {
        if($last_time-$last>$INTERVAL){
            if($count>0){
                qlog "PIPE... (another $count suppressed)\n", LOG_ERR;
            }
            else{
                qlog "PIPE...\n", LOG_ERR;
            }
            $last=$last_time;
            $count=0;
        }
        else{
            ++$count;
        }
    };
};

#$SIG{TRAP}   = sub {qlog "Error! TRAP...\n";};
#$SIG{USR2}   = sub {qlog "Error! USR2...\n";};
#$SIG{CONT}   = sub {qlog "Error! CONT...\n";};
#$SIG{STOP}   = sub {qlog "Error! STOP...\n";};
#$SIG{TSTP}   = sub {qlog "Error! TSTP...\n";};
#$SIG{TTIN}   = sub {qlog "Error! TTIN...\n";};
#$SIG{TTOU}   = sub {qlog "Error! TTOU...\n";};
#$SIG{URG}    = sub {qlog "Error! URG...\n";};
$SIG{XCPU} = sub { qlog "XCPU...\n", LOG_ERR; };

#$SIG{XFSZ}   = sub {qlog "Error! XFSZ...\n";};
#$SIG{VTALRM} = sub {qlog "Error! VTALRM...\n";};
#$SIG{PROF}   = sub {qlog "Error! PROF...\n";};
#$SIG{WINCH}  = sub {qlog "Error! WINC...\n";};
#$SIG{IO}     = sub {qlog "Error! IO ...\n";};
#$SIG{GPWR}   = sub {qlog "Error! GPWR...\n";};
$SIG{ALRM}    = sub { die "alarm\n"; };
$SIG{__DIE__} = sub {
    qlog "A!!!!!!!!!! I'm dying: '$_[0]'\n", LOG_ERR;
    my ($rep,$package, $filename, $line, $subroutine,$i);
    for($i=1; $i<5; ++$i){
        (undef, $filename, $line, $subroutine)=caller($i);
        $rep.="$i [${filename}:${line} ${subroutine}]; ";
    }
    qlog "STACK: $rep\n", LOG_ERR;

};

##############################################################################
#
#   Create the tree of subclusters!
#
# $tree{'subclusters...'/'!pe-list'} ,where '!pe-list'-is list (@), ans subcl. are hashes
#
# $up_ch - handles to parent cluster
# $down_ch{'child_cluster_name'} - handles to child clusters
#

$root_pid = $$;

make_subclusters( cleosupport::get_setting( 'root_cluster_name', '', '' ) );
$is_master = ( $root_pid == $$ );
delete $clusters{INIT} if exists $clusters{INIT};

#if ( !$is_master ) {
#    recreate_lst();
#    recreate_rsh();
#}

qlog "Own1: "
    . scalar( keys(%own) )
    . " Shared: "
    . scalar( keys(%shared) )
    . "\n", LOG_INFO;
unless ( $pe_list{$cluster_name} ) {
    qlog "Empty cluster '$cluster_name'\n", LOG_WARN;
    @{ $pe_list{$cluster_name} } = ();
}

make_aliases($cluster_name);

qlog "Start new server. Ver $VERSION ($VARIANT). Port $port, "
    . scalar( @{ $pe_list{$cluster_name} } )
    . " processors\n", LOG_ALL;
qlog "PE_LIST [" . join( ';', @{ $pe_list{$cluster_name} } ) . "]\n", LOG_ALL;

$check_time = time + cleosupport::get_setting('time_qcheck');

# @mons_to_ping=('test');

$next_restriction_time = 0;
if ( load_restrictions( cleosupport::get_setting('time_restrict_file') ) ) {
    qlog "Cannot open restrictions file "
        . cleosupport::get_setting('time_restrict_file')
        . "\n", LOG_WARN;
} else {
    qlog "restrictions loaded\n", LOG_INFO;
    correct_time_restrictions(1);
}

qlog "Own2: "
    . scalar( keys(%own) )
    . " Shared: "
    . scalar( keys(%shared) )
    . "\n", LOG_DEBUG;

#$exec_queue =  msgget(9130, 0 | IPC_CREAT);

cleosupport::recreate_plugins_and_ports();

####################################################################
#
#      TRY TO RUN PE_SELECT PLUG-INS
#
####################################################################

for my $tmp ( keys(%child_aliases) ) {
    qlog "ALIASES FOR $tmp: " . join( ';', @{ $child_aliases{$tmp} } ) . "\n",
        LOG_INFO;
}

$global_settings{max_np} = scalar( keys(%pe) );    #BUG!!!!!!!!!!!!
qlog "pe_lists: " . join( ',', keys(%pe_list) ) . "\n", LOG_INFO;
for my $i ( keys(%clusters) ) {
    qlog "testing $i\n", LOG_DEBUG;
    if ( $i eq '' ) {
        delete $clusters{$i};
        next;
    }
    if ( !exists $cluster_settings{$i} ) {
        qlog "No settings for cluster'$i'\n", LOG_WARN;
        next;
    }
    $cluster_settings{$i}{max_np} = scalar( @{ $pe_list{$i} } )
        unless defined $cluster_settings{$i}{max_np};
    qlog "max_np($i) = $cluster_settings{$i}{max_np}\n", LOG_DEBUG;
}

$reserved_shared = 0;
$safe_reload     = 1;

my @save_sceds;
my $save_sced = $global_settings{sceduler};
push @save_sceds, @{ $global_settings{scedulers} };

&load_state($cluster_name);
qlog "Users: $cluster_name ("
    . join( ',', @{ $cluster_settings{$cluster_name}->{users} } )
    . ")\n", LOG_INFO;

$0 = "cleo - $cluster_name";

qlog "MASTER_PID=$$\n" if ($is_master);

$global_settings{sceduler} |= $save_sced;
push @{ $global_settings{scedulers} }, @save_sceds;

foreach my $i (keys(%pe)){
   $blocked_pe_reasons{$i}->{'Not connected yet'} = 1;
   $pe{$i}->{blocked} = 1;
}

#$mon_timeout=cleosupport::get_setting('mon_timeout');

$may_go        = 1;    # queue is changed, or new processors are available...
$check_running = 0;
dump_queue();

$SIG{HUP} = \&rerun_extern_shuffles;

load_exec_modules();
load_scedulers();
$sced_alarm = 0;
start_sceduler();

####################################################
#
#
#  register handlers on childs
#
#
####################################################

# ON CHILDS!!!
register_parent_rcv( 'add',                 \&add_handler );
register_parent_rcv( 'del',                 \&del_handler );
register_parent_rcv( 'del_local',           \&del_local_handler );
register_parent_rcv( 'run_via_mons',        \&rvm_handler );
register_parent_rcv( 'del_mon_task',        \&dmt_handler );
register_parent_rcv( 'finished',            \&finished_handler );
register_parent_rcv( 'init_attach',         \&init_attach_handler );
register_parent_rcv( 'attach',              \&attach_handler );
register_parent_rcv( 'view',                \&view_handler );
register_parent_rcv( 'mode',                \&mode_handler );
register_parent_rcv( 'priority',            \&pri_handler );
register_parent_rcv( 'block',               \&block_handler );
register_parent_rcv( 'block_pe',            \&block_pe_handler );
register_parent_rcv( 'internal_info',       \&int_info_handler );
register_parent_rcv( 'start',               \&start_handler );
register_parent_rcv( 'autoblock',           \&ablock_handler );
register_parent_rcv( 'debug',               \&debug_handler );
register_parent_rcv( 'update_restrictions', \&update_restrictions_handler );
register_parent_rcv( 'reload_conf',         \&reload_conf_handler );
register_parent_rcv( 'reload_users',        \&reload_users_handler );
register_parent_rcv( 'reload_sced',         \&reload_sced_handler );
register_parent_rcv( 'run_pre',             \&run_pre_handler );
register_parent_rcv( 'id_by_pids',          \&id_by_pid_handler );
register_parent_rcv( 'get_io',              \&get_io_handler );
register_parent_rcv( 'freeze',              \&freeze_handler );
register_parent_rcv( 'chattr',              \&chattr_handler );
register_parent_rcv( 'test_id',             \&test_id_handler );

#!! On parent all unhandled messages are handled by:   child_message_process !!!

# HEAD
#register_mon_rcv('run',\&mon_run_handler);
#register_mon_rcv('run_first',\&mon_run_first_handler);
#register_mon_rcv('init_attach',\&mon_init_attach_handler);
#register_mon_rcv('attach',\&mon_attach_handler);

#print "--------------------------\n";
$last_mon_ping      = time;
$program_start_time = $last_mon_ping;

my $use_monitors = get_setting('use_monitors');

if ($is_master) {
    if ($use_monitors) {    #master and monitors are enabled
        $run_fase = 1;
    } else {                #master, monitors disabled - start childs queues
        $run_fase      = 0;
        $check_running = 1;
        new_req_to_child(
            'start', {}, '__ALL__', 1,
            SUCC_ANY | SUCC_OK, \&nil_sub, \&every_nil_sub, 0,
            \&nil_sub );
    }
} else {    # child queue - wait for master signal
    $run_fase      = 10;
    $check_running = 0;
}
$next_check_running = time + get_setting('check_run_interval');
$Mons_select        = new IO::Select->new();

########################################################
#
#  Start monitors, if needed.
#
########################################################

if ( $is_master and $use_monitors ) {

    # now run on ALL nodes (need to correct!)

    my $runstring = cleosupport::get_setting('mon_run_string');
    my $nodeport  = cleosupport::get_setting('mon_node_port');
    my ( $rs, $fake, @addrs, $a, $b, $c, $d, $log, @pe_local );
    $fake->{id} = '0';
    foreach my $i ( keys(%the_nodes) ) {
        if ( $runstring ne '' ) {
            $fake->{node} = $i;
            $rs = $runstring;
            undef %subst_args;
            subst_task_prop( \$rs, $fake, '', '' );
            launch( 0, $rs, "MON_$i" );
        }
        $mons{$i}->{last_response} = 0;
        $mons{$i}->{port}          = $nodeport;
        @addrs                     = ();
        ( undef, undef, undef, undef, @addrs ) = gethostbyname($i);
        if ( scalar(@addrs) < 1 ) {
            qlog "$i has no IPs!!!!\n", LOG_WARN;
        }
        $log = "IPS for $i: '";
        foreach $tmp (@addrs) {
            ( $a, $b, $c, $d ) = unpack( 'C4', $tmp );
            push @{ $mons{$i}->{ips} }, "$a.$b.$c.$d";
            $log .= "$a.$b.$c.$d ";
        }
        qlog "$log'\n", LOG_INFO;

        $mons{$i}->{state} = 'dead';
        $mons{$i}->{conn}= new Cleo::Conn($i,$nodeport);

        mons_connecter($i);
    }
    $mons_connecting = scalar( keys(%the_nodes) );
    new_req_to_child(
        'internal_info', {},
        '__ALL__',                     1,
        SUCC_ALL | SUCC_OK,            \&chld_int_info_handler,
        \&chld_every_int_info_handler, get_setting('intra_timeout'),
        \&chld_int_info_handler );
}

# run periodically cleaning %rsh_data
cleanup_data();

########################################################
#
#  MAIN LOOP
#
########################################################

qlog "Entering MAIN LOOP\n", LOG_INFO;
eval {
    for ( ;; ) {

        #  my @mons_to_test;

        do_reap();
#        cleosupport::flush_channels();
        Cleo::Conn::allflush;
        $last_time = time;

        if (    $next_restriction_time > 0
            and $next_restriction_time < $last_time ) {
            $q_change = 1;
        }

        if ($is_master) {

            # connect to nodes, if needed
            if ( $run_fase == 1 ) {    # initial connection to monitors
                 #       if($last_time-$program_start_time>cleosupport::get_setting('init_mons_gap')){
                 #         qlog "Fase=2\n", LOG_INFO;
                 #         new_req_to_child('internal_info',{},'__ALL__',1,SUCC_ALL|SUCC_OK,
                 #                          \&chld_int_info_handler,\&chld_every_int_info_handler,
                 #                          10,\&chld_int_info_handler);
                $run_fase = 2;

                #       }
            } elsif ( $run_fase == 2 ) {    # get info from all children
                qlog "Fase 0!\n", LOG_INFO;
                $run_fase = 0;
            }
            ##########################################
            # accept connections from pseudo-rshells.
            if (defined $RSH) {
                for ( ;; ) {
                    undef $tmp;
                    $tmp = $RSH->accept;
                    last unless $tmp;
                    new_rsh_connection($tmp);
                }
            }
            ##########################################
            # accept connections from clients.
            if ($LST) {
                for ( ;; ) {
                    $Client = $LST->accept();

                    last unless defined $Client;

                    ##########################################
                    # proceed with new client connection
                    my $fd=$Client->get_h;
                    $fd->fcntl( Fcntl::F_SETFL(),
                        O_NONBLOCK()|$fd->fcntl(Fcntl::F_GETFL(),0));
                    my $ip = $Client->get_peer();
                    my $line;

                    qlog "Connection from $ip\n", LOG_INFO;
                    unless($global_settings{allowed_ips} =~ /\b$ip\b/){
                        qlog
                            "Illegal IP: $ip (allowed $global_settings{allowed_ips}\n",
                            LOG_ERR;
                        $Client->send("-You are not authorized to do this from this IP\n");
                        $Client->flush;
                        $Client->disconnect;
                        next;
                    }

                    my %args = (
                        begin => $last_time,
                        state => 1,
                        ch    => $Client);
                    handle_user_connection( \%args );
                }
            }    ## ~$LST
        }    ############################ ~  MASTER  ~  #####################

        if ( ++$local_count > 10 ) {

            #    print "zzzzzzz $cluster_name\n";
            $local_count = 0;
            if ($is_master) {
                ;    #block_delayed();
            } elsif ( kill( 0, $parent_pid ) == 0 ) {
                save_n_exit('[master died]');
                die("Master died! So I too...\n");
            }
        }

        sc_execute();

        if ( $sced_alarm > 0 and $last_time >= $sced_alarm ) {
            $sced_alarm = 0;
            sceduler_event('alarm');
        }

        #    qlog "Alive4!\n", LOG_DEBUG2 if($debug{aa});
        rcv_from_rsh();

        #    qlog "Alive5!\n", LOG_DEBUG2 if($debug{aa});
        flush_to_mons();

        #    qlog "Alive6!\n", LOG_DEBUG2 if($debug{aa});
        flush_to_childs();

        #    qlog "Alive7!\n", LOG_DEBUG2 if($debug{aa});
        rcv_from_parent();

        #    qlog "Alive8!\n", LOG_DEBUG2 if($debug{aa});

        # check messages from monitors
        rcv_from_mon() if ($is_master);
        rcv_from_childs();

        #    qlog "Alive9!\n", LOG_DEBUG2 if($debug{aa});

        if ( $next_check_running < $last_time ) {
            $check_running = 1;
        }

        check_children() if ( $run_fase == 0 );
        flush_to_parent();

        #check_msgqueues();

        #    qlog "Alive10!\n", LOG_DEBUG2 if($debug{aa});
        #  check_mons() if $is_master;

        select( undef, undef, undef, 0.1 );

        # write mark to log ant check for logrotate
        if ($is_master) {
            if ( $cccount > 1024 ) {
                $cccount = 0;
                qlog "MARK\n";
                log_rotate();
            }
            ++$cccount;
        }
    }    #infinite loop
};    # ~eval
qlog "Server has die. Reason:$@", LOG_ERR;
#msgctl($exec_queue,IPC_RMID,0);
die "Impossible death...\n";

##################################################################################
##################################################################################
##################################################################################

sub check_children() {
    my ($child, $cur_ch, $pe,   $dir, $i,   $j, $hour,
        $min,   $sec,    $yday, $num, $pid, $time, $starttime );
    my $q_entry;
    my $theid;

    if ($check_running) {

        #qlog( "Checking detached...\n", LOG_INFO );
        check_detached();

        # Check for correctness of all running childs...
        qlog( "Checking running...\n", LOG_INFO )
            unless ( $next_check_running < $last_time );
        $next_check_running = $last_time + get_setting('check_run_interval');

        foreach $child ( keys(%childs_info) ) {
            next unless $childs_info{$child}{pid};
            next
                if ( $childs_info{$child}{pid} < 0
                or $childs_info{$child}{pid} > 69999 );

        }
    }
    $check_running = 0;

    #
    #delete all dead children...
    #
    while ( $theid = shift @dead ) {    #dead cleaning
        unless ( exists( $childs_info{$theid} ) ) {
            qlog "ALREADY DEAD: $theid. Skip.\n", LOG_DEBUG;
            next;
        }
        qlog "_DEAD: $theid; CHILDS_INFOS2: "
            . join( ';', keys(%childs_info) )
            . "\n", LOG_DEBUG;
        qlog "DEADS: " . join( ';', @dead ) . "\n", LOG_INFO;

        $may_go   = 1;
        $q_change = 1;
        slog "END_TASK0 $theid\n";
        ( $sec, $min, $hour, undef, undef, undef, undef, undef, $yday ) =
            gmtime( $last_time - $childs_info{$theid}->{time} );
        $childs_info{$theid}->{endtime} =
            $sec + $min * 60 + $hour * 3600 + $yday * 3600 * 24;

        if ( $childs_info{$theid}->{attach_mask} ne '' ) {
            qlog "del_mon_task3\n", LOG_DEBUG;
            if ( $childs_info{$theid}->{owner} eq
                cleosupport::get_setting('root_cluster_name') ) {
                my ( $n, %n );
                my @nodes;
                foreach $i ( split( /\,/, $childs_info{$theid}->{nodes} ) ) {
                    ($n) = ( $i =~ /^([^:]+)/ );
                    next if $n eq '';
                    ++$n{$n};
                }
                @nodes = keys(%n);
                main::new_req_to_mon(
                    'kill',
                    $childs_info{$theid},
                    \@nodes,
                    SUCC_ALL | SUCC_OK,
                    \&main::mon_kill_handler,
                    undef,
                    cleosupport::get_setting('mon_run_timeout'),
                    \&main::mon_kill_handler );

                } else {
                answer_to_parent(
                    cleosupport::get_setting('root_cluster_name'),
                    0,
                    'del_mon_task',
                    SUCC_OK,
                    'id',
                    $theid,
                    'mons',
                    $childs_info{$theid}->{nodes} );
            }
        }

        foreach $i (
            @{ $ids{$theid}->{own} },
            @{ $ids{$theid}->{shared} },
            @{ $ids{$theid}->{extranodes} }
            ) {
            delete $pe{$i}->{ids}->{$theid};
            qlog "_freeing $i of $theid res=$reserved_shared\n", LOG_INFO;
        }

        unless ( exists( $childs_info{$theid} ) ) {
            qlog "Task is deleted already!!! ($theid)\n", LOG_WARN;
            next;
        }

        $extra_nodes_used -= $childs_info{$theid}->{npextra};

        #
        # write report file & exec killscript
        #
        if ( $childs_info{$theid}->{lastowner} eq $cluster_name ) {

            #we must report
            qlog ":: " . join( ";", %{ $childs_info{$theid} } ) . "\n",
                LOG_DEBUG2;
            task_after_death( $theid, $childs_info{$theid} );
        }    # ~ process dead children...
        else {
            qlog
                "NOT own child ($theid) - lastowner is $childs_info{$theid}->{lastowner}, owner - $childs_info{$theid}->{owner}\n",
                LOG_INFO;
        }

        #
        # Correct the runned list
        #
        $i = cleosupport::find_runned($theid);
        if ( $i < 0 ) {
            qlog
                "Dead id is not found in runned_list!!! ($theid,state=$childs_info{$theid}->{status})\n",
                LOG_WARN;
            new_runned( $theid, $childs_info{$theid}->{status} );
        } else {
            $runned_list[$i]->{exitcode} = $childs_info{$theid}->{status};
        }

        account_end($theid);

        del_from_queue($theid);

        for $i ( keys(%wait_run) ) {
            for $j ( keys( %{ $wait_run{$i} } ) ) {
                delete $wait_run{$i}->{$j}
                    if ( $wait_run{$i}->{$j} == $theid );
            }
        }

        delete $pids{$theid};

        # is made by del_from_queue  delete $childs_info{$theid};
        #                            delete $ids{$theid};
        qlog "Erased: $theid\n", LOG_INFO;
        dump_queue();
    }

    #########################################################
    #
    #       check ability to run new tasks...
    #
    #########################################################

    my $not_infinite = 15;    #Maximal number of tasks to run at once

    if ($q_change) {
        count_user_np_used();
        save_state($cluster_name);
        dump_queue();
        correct_time_restrictions();
        qlog "queue changed...\n", LOG_DEBUG;
        $q_change = 0;
        $may_go   = 1;
    }

    if ( $may_go > 0 ) {      # && ($mode & MODE_RUN_ALLOW)) {
                              #test queues for new run...

        $may_go = 0
            ; #reset flag for not execute this code until queue change or free new pe.
        qlog "-Own: "
            . scalar( keys(%own) )
            . " Shared: "
            . scalar( keys(%shared) )
            . "\n", LOG_DEBUG;
        qlog "Queue0 length="
            . scalar(@queue)
            . " foreign="
            . scalar(@foreign)
            . " running="
            . scalar(@running)
            . " $reserved_shared reserved\n", LOG_DEBUG;

        # try run prerunned tasks

        $starttime=time;
        foreach my $i ( @pending, @queue ) {    #  @foreign
            last if $starttime+get_setting('run_chunk_tmout')>time;

            my $runflag = 0;
            my @new;

            if ( ( $i->{state} eq 'prerun' ) and ( $i->{no_run_again} != 1 ) )
            {
                my ( @free_sh, $free_total, $free_shared_total, $id, $status,
                    $real_reserved );

                @free_own = ();

                #        $real_reserved=max($reserved_shared,0);
                count_free( \@free_own, \%own );    #

                for my $node (@free_own) {
                    push @{ $i->{own} }, $node;
                    push @new, $node;
                    $pe{$node}->{ids}->{ $i->{id} } =
                        -1;    # mark node as occupied by pre-run!!!
                    if ( @{ $i->{shared} } + @{ $i->{own} } >= $i->{np} ) {
                        $runflag = 1;
                        qlog "GOT ALL NODES!! ($i->{np})\n", LOG_INFO;
                        last;
                    }

                    #^^^^ YES, we got ALL nodes!
                }
            }
            if (   ( $i->{lastowner} ne $cluster_name )
                && ( scalar(@new) > 0 ) ) {

                # Tell master about gotten nodes
                qlog "TELL PARENT\n", LOG_DEBUG2;
                answer_to_parent( $i->{lastowner}, 0, 'got', SUCC_OK, 'id',
                    $i->{id}, 'nodes', join( ',', @new ) );
            }
            if ( $runflag and ( $i->{lastowner} eq $cluster_name ) ) {

                # run prerunned task!

                $i->{nodes} =
                    join( ',', sort( @{ $i->{own} }, @{ $i->{shared} } ) );

                #now clear all nodes fron 'waiting'
                undef $i->{wait_for};
                if ( run_id( $i->{id} ) < 0 ) {
                    qlog "Failed run task '$i->{task_args}->[0]' ".
                         "for user $i->{user} ($i->{id})\n", LOG_ERR;
                }
            }
        }

        #
        #  Now run sceduler!
        #    test

        my $sced = get_setting('sceduler');
        if ( $sced eq 'default'
            or do_external_scedule($sced) ) {

            #
            # do traditional scedule mode...
            #
            my @list;
            push @list,
                [
                \@foreign,     $foreign_scedule_proc,
                FOREIGN_QUEUE, \%foreign_scedule ];

#      push @list,[\@pending,$pending_scedule_proc,PENDING_QUEUE,\%pending_scedule];
            push @list, [ \@queue, $scedule_proc, NATIVE_QUEUE, \%scedule ];

            for $i ( @foreign, @pending, @queue ) {
                $i->{seen} = 0;
            }

            for my $x (@list) {
                #check if we try to run tasks too long time...
                last if $starttime+get_setting('run_chunk_tmout')>time;

                next if ( scalar( @{ $x->[0] } ) < 1 );    # queue is empty

                for ( ; $not_infinite; --$not_infinite )
                {    #work untill tasks queue is not empty
                    my ( @free_sh, $free_total, $free_shared_total, $id,
                        $status, $real_reserved );

                    @free_own = ();

                    #        $real_reserved=max($reserved_shared,0);
                    count_free( \@free_own, \%own );       #
                    count_free( \@free_sh,  \%shared );    # NOT RATIONAL!
                    $free_shared_total =
                        max( 0, @free_sh - $reserved_shared );
                    $free_total = $free_shared_total + @free_own;
                    qlog "Free: $free_total / $free_shared_total ("
                        . scalar(@free_own) . "/"
                        . scalar(@free_sh)
                        . " reserved $reserved_shared)\n", LOG_INFO;
                    last unless ( $free_total > 0 );    # no free nodes at all

                    ( $id, $status ) =
                        $x->[3]->{"$x->[1]"}
                        ->( $x->[2], \@{ $x->[0] }, \@free_own, \@free_sh );
                    if ( $id < 1 and $status ) {
                        qlog "End scedule (zero!)\n", LOG_DEBUG;
                        last;
                    }
                    qlog
                        "End scedule (id=$id / status=$status) '$ids{$id}->{seen}/$ids{$id}->{id}' "
                        . join( '.', keys(%ids) )
                        . "\n", LOG_DEBUG;

                    #        qlog "[$id] ".join('.',%{$ids{$id}}).";\n";
                    last if ( $ids{$id}->{seen} );

                    #        print "ID=$id, STATUS=$status\n";
                    if ($id) {
                        $may_go = 1;

                        #          print "ID=$id\n";
                        qlog "ID=$id [$ids{$id}->{gummy}]\n", LOG_INFO;
                        $ids{$id}->{seen} = 1;
                        try_to_run( $ids{$id}, $ids{$id}->{gummy} );
                        $q_change = 1;
                    }
                    if ($status) {
                        last;
                    }
                }

#      qlog "Foreign length=".scalar(@foreign)." Queue0 length=".scalar(@queue)."\n";
            }
        }
    }
    #############################################################################
    ##    ALL NEW TASKS ARE RAN
    ##############################################################################
    $may_go = ( $not_infinite ? 0 : 1 );

    # CHECK TIMED OUT TASKS !!!!!
    if ( $check_time < $last_time ) {
        qlog( "CHILDS_INFOS: " . join( ';', keys(%childs_info) ) . "\n",
            LOG_DEBUG2 )
            if $last_cin != keys(%childs_info);
        $last_cin = keys(%childs_info);
        while ( ( $cur_ch, $child ) = each(%childs_info) ) {
            next if ( $child->{state} ne 'run' );
            if (   $child->{time_to_delete} > 0
                && $child->{time_to_delete} < $last_time ) {
                qlog
                    "Task didnt send me SIGCHLD. Delete it... ($child->{pid} / $child->{id}))\n",
                    LOG_WARN;
                push @dead, $child->{id};
                $child->{status}     = 0;
                $child->{core}       = 0;
                $child->{signal}     = 9;
                $child->{final_kill} = 1;
                } elsif ( $child->{timelimit} > 0
                && $child->{timelimit} < $last_time ) {
                next if ( $child->{substate} eq 'deleting' );
                qlog "Task $child->{id} timed out.\n", LOG_INFO;
                if ( $child->{timelimit} + get_setting('hard_kill_delay') <
                    $last_time ) {
                    $child->{final_kill} = 1;
                    qlog "HARDKILL! $child->{pid} $child->{id}\n", LOG_INFO;
                    } else {
                    qlog
                        "KILL! $child->{pid} $child->{id} ($child->{timelimit} < $last_time) $child->{state}\n",
                        LOG_INFO;
                }
                del_task( $child->{id}, '__internal__', undef, undef, undef,
                    undef, 'Time limit exceeded' );
            }
        }    #checking all running children
        $check_time = $last_time + cleosupport::get_setting('time_qcheck');
    }
}    #~check_children

sub try_to_run($;$ ) {

    #     entry, gummy
    #
    #  We must have all nodes (may be including not reserved shared...)
    #
    #  retunrs:  0 if succeed
    #            1 if try to run task twice

    my ( $q_entry, $gummy ) = @_;
    my ( $tmp, $id, $np, $alg );
    my @new = ();

    $id = $q_entry->{id};
    $np = $q_entry->{np};

    if ( $id < 1 ) {
        qlog "Empty id: " . join( ';;', %$q_entry ) . "\n", LOG_WARN;
        return 1;
    }
    return 1 if ( $q_entry->{state} eq 'run' || defined $q_entry->{pid} );
    qlog "_Try to run $id\n", LOG_INFO;
    qlog "Needed (native) $np for id=$id [$gummy]\n", LOG_DEBUG;

    if (@free_own) {
        my %nodes_used;

        qlog "FREE_OWN: " . sort(join( ' ', @free_own )) . "\n", LOG_DEBUG;
        if ( $q_entry->{pe_select} ne '' ) {
            $alg = $q_entry->{pe_select};
        } else {
            $alg = cleosupport::get_setting(
                'pe_select',         $q_entry->{user},
                $q_entry->{profile}, $cluster_name );
        }
        if ( exists $shuffle_algorithms{$alg} ) {
            qlog "PE_SELECT USE $alg\n", LOG_DEBUG;
            $shuffle_algorithms{$alg}->( \@free_own );
        } else {
            qlog "PE_SELECT USE the EXTERN $alg\n", LOG_DEBUG;
            &extern_shuffle( $alg, $np, \@free_own );
            qlog "USE: " . join( ';', @free_own ) . "\n", LOG_DEBUG;
        }
        while ($np) {
            $tmp = shift(@free_own) or last;
            if ( exists $nodes_used{$tmp} ) {
                qlog "SHUFFLE: Node $tmp is already used!\n", LOG_WARN;
                next;
            }
            $nodes_used{$tmp} = 1;
            push @{ $q_entry->{own} }, $tmp;
            push @new, $tmp;
            $pe{$tmp}->{ids}->{$id} = -1;
            --$np unless ($gummy);
        }
        qlog "USED: " . join( ' ', @{ $q_entry->{own} } ) . "\n", LOG_INFO;
    }
    qlog "Needed now (native): $np\n", LOG_INFO;
    if ( $cluster_name ne $q_entry->{lastowner} and scalar(@new) > 0 ) {
        qlog "Sending got (own) "
            . scalar(@new)
            . " to $q_entry->{lastowner}\n", LOG_DEBUG;

#    answer_to_parent($q_entry->{owner},0,'got',$q_entry->{id},'nodes',join(',',@new));# OLD NOTATION
        answer_to_parent( $q_entry->{lastowner}, 0, 'got', SUCC_OK, 'id',
            $q_entry->{id}, 'nodes', join( ',', @new ) );
    }
    if ($np) {
        return 1 if ( $q_entry->{state} eq 'prerun' );

        $q_entry->{state} = 'prerun';

        # 1) request nodes to subclusters
        qlog "Req $np for $q_entry->{lastowner}\n", LOG_DEBUG;
        req_child_pe( $id, $np );

# 2) change task to foreign
#    move_to_queue($id,FOREIGN_QUEUE) if ($q_entry->{qtype} ne FOREIGN_QUEUE);

        # 3) mark shared nodes...
        my (@free_sh);
        count_free( \@free_sh, \%shared );    # NOT RATIONAL!
        qlog "TRY_TO_RUN: reserved $reserved_shared\n", LOG_DEBUG;
        unless ( $q_entry->{reserved} ) {
            $q_entry->{reserved} = min( $np, keys(%shared) );
            qlog "RESERVING $q_entry->{reserved} for $q_entry->{id}\n",
                LOG_DEBUG;
            $reserved_shared += $q_entry->{reserved};
            qlog "TRY_TO_RUN: reserved now $reserved_shared\n", LOG_DEBUG;
        }
        foreach my $p ( keys(%shared) ) {
            foreach $tmp ( @{ $pe{$p}->{level1} } ) {
                $q_entry->{wait_for}->{$p}->{$tmp} = 1;
            }
        }
    }    #    ~only shared nodes may be given
    else {

        # all nodes are gotten!
        if ( $q_entry->{lastowner} eq $cluster_name ) {
            run_id( $q_entry->{id} );
            $may_go   = 1;
            $q_change = 1;

#    } else {
#      move_to_queue($id,FOREIGN_QUEUE) if ($q_entry->{qtype} ne FOREIGN_QUEUE);
#      #  WAIT_FOR OWNER'S COMMAND...
        }
    }
    return 0;
}

sub can_run($ ) {

    #     entry
    #  returns 1 if there are enough nodes to run it

    my $q_entry = $_[0];
    my ( $tmp, $id, $np );
    my @free_sh;
    my @new = ();

    return 0 if ( $q_entry->{state} ne 'queued' );

    $id = $q_entry->{id};
    $np = $q_entry->{np};

    count_free( \@free_sh, \%shared );    # NOT RATIONAL!
    qlog "Can_run: id=$id own="
        . scalar(@free_own)
        . " shared="
        . scalar(@free_sh)
        . " req=$np res=$reserved_shared\n", LOG_INFO;
    return 1
        if ( @free_own + max( 0, @free_sh - $reserved_shared ) > 0
        && $q_entry->{gummy} );
    return 1 if ( @free_own >= $np );

    $np -= @free_own;
    return 1 if ( @free_sh - $reserved_shared >= $np );
    return 0;
}

# {
#   my $mons_last_ping=0;
#   my $mons_ping_end=0;
#   my $mon_ping_all_interval=5;
#   my %args=('value' => 0);

#   ######################################################################
#   #
#   # Sends 'ping'-s to monitors
#   #
#   ######################################################################
#   sub check_mons(){
#     my $time=usecs();
#     my $d;

#     return if($time-$mons_last_ping<0.2);
#     if($time>$mons_ping_end){
#       $mons_ping_end = $time + 3;#$mon_timeout*2/3;
#       undef @mons_to_ping;
#       push @mons_to_ping, keys(%mons);
#       $mons_last_ping=$time-1;
#     }

#     return if(@mons_to_ping<1);

#     $d=scalar(@mons_to_ping)*($time-$mons_last_ping)*3/($mon_timeout*2);
#     if($d<@mons_to_ping-5){
#       $d=scalar(@mons_to_ping);
#     }
# #    qlog "HH: $time; $mons_ping_end; ".join(':',@mons_to_ping).";\n";
#     while($d>=0){
# #      qlog "HH2: $d\n";
#       --$d;
#       $_=shift @mons_to_ping;
#       last if(!defined $_);
# #      qlog "HH2.5: $_\n";
#       new_req_to_mon('ping',\%args,$_,SUCC_ANY|SUCC_OK,
#                      \&mon_ping_handler,undef,
#                      $mon_timeout,\&mon_ping_handler
#                     );
#     }
# #    qlog "HH3: ".scalar(@mons_to_ping)."\n";
#     $mons_last_ping=$time;
#   }
# }

sub there_are_blocked_tasks() {
    return 1;
}

######################################################################
#
# Checks tasks for blocking caused blocked cpus.
# Also checks for unblocking of this reason.
#
######################################################################
sub check_blocked_by_res() {
    my ( $i, $u, $r, $tmp );

    if ( there_are_blocked_tasks() ) {
        my $not_blocked_cpus = count_enabled_cpus();
        foreach $i (@queue) {
            $u = '__internal__';
            $r = 'wait for blocked cpus';
            if ( cleosupport::test_block( $i->{id}, \$u, \$r ) ) {
                if ( $i->{np} <= $not_blocked_cpus ) {
                    block_task( $i->{id}, 0, $u, $r );
                }
            }
            $r = 'maximum np reached';
            if ( cleosupport::test_block( $i->{id}, \$u, \$r ) ) {
                $tmp =
                    cleosupport::get_setting( 'max_sum_np', $i->{user},
                    $i->{profile} );
                if ( $tmp > 0
                    and $user_np_used{ $i->{user} } + $i->{np} <= $tmp ) {
                    block_task( $i->{id}, 0, $u, $r );
                }
            }
            $r = 'maximum runned reached';
            if ( cleosupport::test_block( $i->{id}, \$u, \$r ) ) {
                $tmp =
                    cleosupport::get_setting( 'max_run', $i->{user},
                    $i->{profile} );
                if (   $tmp > 0
                    and count_runned($i->{user}) < $tmp ) {
                    block_task( $i->{id}, 0, $u, $r );
                }
            }
            $r = 'maximum cpu*hours reached';
            if ( cleosupport::test_block( $i->{id}, \$u, \$r ) ) {
                $tmp =
                    cleosupport::get_setting( 'max_cpuh', $i->{user},
                    $i->{profile} );
                # 0 = no limit
                if ( $tmp > 0 ){
                    if( cleosupport::check_cpuh($i->{user})
                        +($i->{np}*$i->{timelimit}/3600)<=$tmp) {
                        block_task( $i->{id}, 0, $u, $r );
                    }
                }
                else{
                    block_task( $i->{id}, 0, $u, $r );
                }
            }
            $r = 'wait for dependency';
            if ( cleosupport::test_block( $i->{id}, \$u, \$r ) ) {
                $tmp = test_dependencies($i);
                if ( $tmp == 0 ) {
                    block_task( $i->{id}, 0, $u, $r );
                } elsif ( $tmp == 2 ) {
                    qlog "Delete by dependency\n";
                    del_task( $i->{id}, '__internal__' );
                    next;
                }
            }
            if ($restriction_time_changed) {
                $r = 'time restrictions';
                if ( cleosupport::test_block( $i->{id}, \$u, \$r ) ) {
                    unless ( check_time_restrictions($i) ) {
                        block_task( $i->{id}, 0, $u, $r );
                    }
                }
            }
            next if ( $i->{blocked} );

            #      move_to_queue($i->{id},NATIVE_QUEUE,1);
        }
    }
    $restriction_time_changed = 0;
}

sub optimizator1( $$$ ) {
    my ( $np, $free_shared, $reserved_shared ) = @_;

    my $free = @$free_shared + @free_own - $reserved_shared;

    if ( $free > 0 ) {
        my ( $i, @times, $tmp, $need );

        for ( $i = 0; $i < @running; ++$i ) {
            undef $tmp;
            $tmp->{time} = $running[$i]->{timelimit};
            $tmp->{np}   = $running[$i]->{np};
            push @times, $tmp;
        }
        for ( $i = 0; $i < @foreign; ++$i ) {
            next if ( $foreign[$i]->{state} ne 'prerun' );
            undef $tmp;
            $tmp->{time} = $foreign[$i]->{timelimit} + $last_time;
            $tmp->{np}   = $foreign[$i]->{np};
            push @times, $tmp;
        }
        @times = sort { $a->{time} <=> $b->{time} } @times;
        for ( $i = 0; $i < @times; ++$i ) {
            $need -= $times[$i]->{np};
            last if $need < 0;
        }
        if ( $i < @times ) {
            $need = $times[$i]->{time};

            # now need = time when requested by top task np will be awailable
            for ( my $i = 1; $i < @queue; ++$i ) {
                next if ( $queue[$i]->{blocked} > 0 );
                next unless ( can_run( $queue[$i] ) );
                return ( $queue[$i]->{id}, 0 )
                    if ( $last_time + $queue[$i]->{timelimit} < $need );
            }
        }
    }
    return ( 0, 1 );
}

#return value - (id,action)
#               id = id of task to run, or 0, if no run.
#               action = 0 if more actions needed (continue loop)
#                        1 if all actions was made (end loop)
sub optimizator2( $$$ ) {
    my ( $np, $free_shared, $reserved_shared ) = @_;

    my $free = @$free_shared + @free_own - $reserved_shared;

    return ( 0, 1 ) if ( $free <= 0 );

    my ( $i, $j, @run_tasks, $tmp, $willbefree, $max_np_free );
    $max_np_free = $queue[0]->{np};

    qlog "O2 -> max_np_free= $max_np_free\n", LOG_DEBUG2;
    for ( $i = 0; $i < @running; ++$i ) {
        %$tmp        = ();
        $tmp->{time} = $running[$i]->{timelimit};
        $tmp->{np}   = $running[$i]->{np};
        push @run_tasks, $tmp;
    }
    for ( $i = 0; $i < @foreign; ++$i ) {
        next if ( $foreign[$i]->{state} ne 'prerun' );
        %$tmp        = ();
        $tmp->{time} = $foreign[$i]->{timelimit} + $last_time;
        $tmp->{np}   = $foreign[$i]->{np};
        push @run_tasks, $tmp;
    }
    @run_tasks = sort { $a->{time} <=> $b->{time} } @run_tasks;

    $willbefree = $free;
    qlog "O2 -> free= $free; run_tasks=" . scalar(@run_tasks) . "\n",
        LOG_DEBUG2;

    for ( $i = 0; $i < @run_tasks; ++$i ) {
        qlog "O2 -> will_free= $willbefree\n", LOG_DEBUG2;
        if ( $willbefree >= $max_np_free ) {    # head task will be runned
            return ( 0, 1 );                    # so no optimization...
        }

        # test if any small task can be runned in current timelimit...
        for ( $j = 1; $j < @queue; ++$j ) {
            next if ( $queue[$j]->{blocked} > 0 );

            # important! may be changed, but it must be guaranteed, that
            # children queues have FREE cpus!
            next unless ( can_run( $queue[$j] ) );

            qlog "O2 -> check! "
                . ( $last_time + $queue[$j]->{timelimit} )
                . " < $run_tasks[$i]->{time}\n", LOG_DEBUG2;

            # key check:
            return ( $queue[$j]->{id}, 0 )
                if ( $last_time + $queue[$j]->{timelimit} <
                $run_tasks[$i]->{time} );
        }

        $willbefree += $run_tasks[$i]->{np};
    }
    return ( 0, 1 );
}

######################################################################
#
#  DEFAULT   SCEDULE
#
######################################################################

sub default_scedule($\@\@\@ ) {

    #  type queue free_own_pe free_shared_pe (free-only names!)
    #return value - (id,action)
    #               id = id of task to run, or 0, if no run.
    #               action = 0 if more actions needed (continue loop)
    #                        1 if all actions was made (end loop)

    my ( $q_entry, $id, $user, $np, $needed, $tmp, $not_blocked_cpus );
    my ( $type, $queue, $free_own, $free_shared ) = @_;

    $not_blocked_cpus = count_enabled_cpus();

    qlog "S: own: "
        . scalar(@$free_own) . " sh: "
        . scalar(@$free_shared)
        . " res: $reserved_shared\n", LOG_DEBUG;
    return ( 0, 1 )
        if ( @$free_own + max( 0, @$free_shared - $reserved_shared ) < 1 );
    return ( 0, 1 ) if ( scalar(@$queue) < 1 );

    qlog "SCEDULE ($type)\n", LOG_INFO;

    #  check_blocked_by_res();

    for my $i (@queue) {
        qlog "YY1 $i->{id}\n", LOG_DEBUG2;
    }
    if ( $type eq NATIVE_QUEUE ) {
        if ( $mode & MODE_RUN_ALLOW ) {
            for ( $tmp = 0; $tmp < $#queue; ++$tmp ) {
                next if ( $queue->[$tmp]->{blocked} );
                $q_entry = $queue->[$tmp];
                last;
            }
        } else {
            undef $q_entry;

            #
            #  !!!!      Take it in account !!!!!!!!!!!!!!!!!!!
            #
            for ( my $i = 0; $i < @$queue; ++$i ) {
                if ( $queue->[$i]->{oldid} )
                {    # foreign task. dont block it as all other!
                    $q_entry = $queue->[$i];
                    last;
                }
            }
            return ( 0, 1 ) unless ( defined $q_entry );
        }
        $user = $q_entry->{user};
        $np   = $q_entry->{np};
        $id   = $q_entry->{id};

#     if ($q_entry->{blocked}>0) {
#       qlog "Move to pending $q_entry->{task} cause it's blockd\n", LOG_INFO;
#       move_to_queue($id,PENDING_QUEUE);
#       my %args=(
#                 'origid'   => $id,
#                 'val'      => 1,
#                 'username' => '__internal__',
#                 'reason'   => 'master task blocked'
#                );
#       new_req_to_child('block',\%args,'__all__',0,SUCC_ALL|SUCC_OK,
#                        \&nil_sub,\&every_nil_sub,
#                        $child_req_tmout,\&nil_sub
#                       );
#       return (0,0);
#     }

        if (   ( $q_entry->{lastowner} eq $cluster_name )
            && ( $q_entry->{np} > $not_blocked_cpus ) ) {
            block_task( $id, 1, '__internal__', 'wait for blocked cpus' );
            return ( 0, 0 );
        }
        if ( check_time_restrictions($q_entry) ) {
            block_task( $id, 1, '__internal__', 'time restrictions' );
            return ( 0, 0 );
        }

        $tmp =
            cleosupport::get_setting( 'max_sum_np', $user,
            $q_entry->{profile} );
        #qlog "MAX_SUM_NP=$tmp (used $user_np_used{$user})\n", LOG_INFO;
        if ( ($tmp > 0) and ($user_np_used{$user} + $np > $tmp) ) {
            qlog "Move to pending $q_entry->{task_args}->[0]".
                 " cause $user_np_used{$user} + $np > $tmp\n", LOG_INFO;
            block_task( $id, 1, '__internal__', 'maximum np reached' );

            #move_to_queue($id,PENDING_QUEUE);
            return ( 0, 0 );
        }

        $tmp = cleosupport::check_cpuh($user);
        #qlog "MAX_SUM_NP=$tmp (used $user_np_used{$user})\n", LOG_INFO;
        if ( ($tmp > 0) and
             ($q_entry->{timelimit}*$q_entry->{np})>$tmp*3600 ) {
            qlog "Move to pending $q_entry->{task_args}->[0]".
                 " cause only $tmp cpus*hours is left\n", LOG_INFO;
            block_task( $id, 1, '__internal__', 'maximum cpu*hours reached' );

            #move_to_queue($id,PENDING_QUEUE);
            return ( 0, 0 );
        }
        $tmp =
            cleosupport::get_setting( 'max_run', $user,
            $q_entry->{profile} );
        if ( $tmp > 0 && count_runned($user) >= $tmp ) {
            qlog "Move to pending $q_entry->{task_args}->[0]".
                 " cause maximum runned ($tmp) reached\n", LOG_INFO;
            block_task( $id, 1, '__internal__', 'maximum runned reached' );

            #move_to_queue($id,PENDING_QUEUE);
            return ( 0, 0 );
        }
        qlog "NATIVE $q_entry->{id}\n", LOG_DEBUG;
        if ( can_run($q_entry) ) {
            my $dep = test_dependencies($q_entry);
            if ( $dep == 1 ) {
                block_task( $id, 1, '__internal__', 'wait for dependency' );

                #move_to_queue($id,PENDING_QUEUE);
                return ( 0, 0 );
            }
            if ( $dep == 2 ) {
                qlog "Delete by dependency\n";
                del_task( $id, '__internal__' );
                return ( 0, 0 );
            }
            return ( $id, 0 );
        } else {

            # Try to run small fast task BEFORE top task, if
            # it will end before top task will run anyway...
            return optimizator2( $np, $free_shared, $reserved_shared );
        }
    } elsif ( $type eq PENDING_QUEUE ) {
        return ( 0, 1 );

        check_blocked_by_res();
        foreach $q_entry (@$queue) {

            #      $id=$q_entry->{id};
            #      $np=$q_entry->{np};
            #      $user=$q_entry->{user};

            #      $tmp=cleosupport::get_setting('max_sum_np',$user,'');
            #      next if($tmp>0 && $user_np_used{$user}+$np>$tmp);

            next if ( $q_entry->{blocked} );

            qlog "PENDING $q_entry->{id}\n", LOG_INFO;
            if ( can_run($q_entry) ) {
                return ( $id, 0 );
            } else {
                return ( 0, 1 );
            }
        }
        return ( 0, 1 );
    } elsif ( $type eq FOREIGN_QUEUE ) {
        return ( 0, 1 );

        if ( ( $mode & MODE_RUN_ALLOW )
            or cleosupport::get_setting('force_foreign_run') ) {
            $q_entry = $queue->[0];
            } else {
            undef $q_entry;
            for ( my $i = 0; $i < @$queue; ++$i ) {
                if ( $queue->[$i]->{oldid} )
                {    # foreign task. dont block it as all other!
                    $q_entry = $queue->[$i];
                    last;
                }
            }
            return ( 0, 1 ) unless ( defined $q_entry );
        }
        $user = $q_entry->{user};
        $np   = $q_entry->{np};
        $id   = $q_entry->{id};

        #     if ($q_entry->{blocked}>0) {
        #       qlog "Move to pending $q_entry->{task} cause it's blocked\n";
        #       move_to_queue($id,PENDING_QUEUE);
        #       my %args=(
        #                 'origid'   => $id,
        #                 'val'      => 1,
        #                 'username' => '__internal__',
        #                 'reason'   => 'master task blocked'
        #                );
        #       new_req_to_child('block',\%args,'__all__',0,SUCC_ALL|SUCC_OK,
        #                        \&nil_sub,\&every_nil_sub,
        #                        $child_req_tmout,\&nil_sub
        #                       );
        #       return (0,0);
        #     }

        $q_entry = $queue->[0];
        $id      = $q_entry->{id};

        qlog "FOREIGN $id $q_entry->{np}\n", LOG_INFO;
        if ( can_run($q_entry) ) {
            return ( $id, 0 );
        } else {
            return ( 0, 1 );
        }
    }
    qlog "Invalid queue type: $type\n", LOG_ERR;
    return ( 0, 1 );
}

sub make_aliases($;@ ) {
    my ( $cur, @parents ) = @_;
    return if ( $cur eq '' );
    @{ $child_aliases{$cur} } = ();
    push @{ $child_aliases{$cur} }, $cur;
    foreach my $p (@parents) {
        push @{ $child_aliases{$p} }, $cur if ( $p ne '' );
    }
    foreach my $p ( @{ $clusters{$cur}{childs} } ) {
        make_aliases( $p, $cur, @parents );
    }
}

sub run_or_del($$ ) {
    my ( $q, $sh ) = @_;
    my $entry = Storable::thaw( Storable::freeze($q) );    # clone q
    my ( %r, %d, $t, $p, %args );

    for $t ( @{ $clusters{$cluster_name}->{childs} } ) {
        $d{$t} = 1;
    }
    qlog "RUN4: @{$q->{shared}} / @$sh\n", LOG_DEBUG;
    for $p ( @{ $q->{shared} } ) {
        for $t ( @{ $pe{$p}->{level1} } ) {
            $r{$t} = 1;
            delete $d{$t};
        }
    }
    qlog "RUN3 $q->{id}; run:"
        . join( ',', keys(%r) )
        . " del: "
        . join( ',', keys(%d) )
        . "\n", LOG_DEBUG;
    for $t ( keys(%r) ) {

        #    new_req_to_child('run',$q,'__all__',0,SUCC_ALL|SUCC_OK,
        #                     \&nil_sub,\&every_nil_sub,1,\&nil_sub);
        my %answ =
            ( 'id' => $q->{id}, 'nodes' => join( ',', @{ $q->{shared} } ) );
        new_req_to_child(
            'run_pre',          \%answ,    '__all__',       1,
            SUCC_ALL | SUCC_OK, \&nil_sub, \&every_nil_sub, 1,
            \&every_nil_sub );
    }
    for $t ( keys(%d) ) {
        new_req_to_child(
            'del',              $entry,    '__all__',       0,
            SUCC_ALL | SUCC_OK, \&nil_sub, \&every_nil_sub, 1,
            \&nil_sub );
    }
}

sub dump_settings() {
    my $a;
    for $a ( keys(%global_settings) ) {
        qlog "> $a : " . cleosupport::get_setting( $a, '', '' ) . "\n";
    }
}

sub extern_shuffle( $$$ ) {
    my ( $name, $n, $array ) = @_;
    my ( @new_array, $a );

    $a = scalar(@$array);
    return if ( $a < 1 );

    $n = $a if ( $n > $a );

EXT_SH_MAIN: #Its the crazy! return does NOT WORK!!! (perl 5.6). Then I use this trick...
    {
    EXT_SH_LOOP:
        for ( ;; ) {
            if ( exists $pe_sel_method{$name} ) {
                $pe_sel_method{$name}->{conn}->send(
                    join( ' ', $n, @$array ) . "\n" );
                eval {
                    local $SIG{ALRM} = sub { die "ext_sh\n" };
                    alarm 5;
                    for(;;){
                        my $l=$pe_sel_method{$name}->{conn}->read();
                        last if($l =~ s/^(.*)\n//s);
                        $pe_sel_method{$name}->{conn}->unread($l);
                        sleep 1;
                    }
                    alarm 0;
                    if( $1 ne '' ){
                        @new_array = split( /\s+/, $1 );
                        if ( scalar(@new_array) == scalar(@$array) ) {
                            foreach my $i (@new_array) {
                                unless ( exists $pe{$i}
                                    and !$pe{$i}->{blocked} ) {
                                    qlog "Extern pe_select method ($name) spoofs the pe ($i)\n",
                                        LOG_WARN;
                                    last EXT_SH_LOOP;
                                }
                            }
                            @$array = @new_array;
                            qlog "PE_SELECT SUCCESS: "
                                . join( ' ', @new_array )
                                . "\n", LOG_DEBUG;
                            last EXT_SH_MAIN;

                            #return; # SUCCES!!!!!!!
                        } else {
                            qlog "Extern pe_select method ($name) returns illegal number of nodes ("
                                . scalar(@new_array)
                                . " instead of $n)\n", LOG_WARN;
                        }
                    } else {
                        if ( $pe_sel_method{$name}->{die_count} > 0 ) {
                            --$pe_sel_method{$name}->{die_count};
                            qlog
                                "Extern pe_select method ($name) has die...\n",
                                LOG_ERR;
                            kill 9, $pe_sel_method{$name}->{pid};
                            # That's for our assurance
                            $pe_sel_method{$name}->{conn}->disconnect;
                            new_extern_shuffle($name);
                            next EXT_SH_LOOP;
                        }
                    }
                    qlog "Successfull PE_SELECT [dead]\n", LOG_WARN;
                };    # eval
                alarm 0;
                if ( $@ eq "ext_sh\n" ) {
                    qlog "PE Select method timed out... TERMINATE IT!!!\n",
                        LOG_ERR;
                    --$pe_sel_method{$name}->{die_count};
                    $pe_sel_method{$name}->{conn}->send( "TERM\n" );
                    sleep 1;
                    kill 9, $pe_sel_method{$name}->{pid};
                    $pe_sel_method{$name}->{conn}->disconnect;
                }
            } else {
                qlog "Non-existent pe_select method called ($name)\n",
                    LOG_WARN;
            }
            last;
        }
        qlog "RESHUFFLING\n", LOG_WARN;
        cleosupport::shuffle_array($array);
    }    # ~ EXT_SH_MAIN
}

sub new_extern_shuffle( $ ) {
    my $name = $_[0];

    unless ( exists $cleosupport::global_settings{pe_sel_method}->{$name} ) {
        qlog "Undefined pe_select method ($name) is tryed to reanimate!\n",
            LOG_ERR;
        return;
    }

    my ( $pipe1, $pipe2, $pid );

    $pipe1 = new IO::Handle;
    $pipe2 = new IO::Handle;

    qlog "Starting extern_pe_select $name\n", LOG_INFO;
    unless(socketpair($pipe1, $pipe2, AF_UNIX, SOCK_STREAM, PF_UNSPEC)){
        qlog "Cannot create socketpair in new_extern_shuffle\n", LOG_ERR;
        return;
    }

    $pipe1->autoflush(1);
    $pipe2->autoflush(1);

    $pid = fork();
    die "Cannot fork!\n" unless defined $pid;
    die "Cannot fork!\n" if ( $pid < 0 );
    if ($pid) {

        #parent (master)

        close $pipe2;
        $pe_sel_method{$name}->{conn} = new_handle Cleo::Conn($pipe1);
        $pe_sel_method{$name}->{pid}  = $pid;
        $pe_sel_method{$name}->{die_count} =
            cleosupport::get_setting('pe_sel_die_count');
        $pe_sel_method{$name}->{conn}->send("CLEO version $VERSION\n");

        #    $pipe1->flush;
        eval {
            local $SIG{ALRM} = sub { die "new_ext_sh\n" };
            my $rep;
            alarm 2;
            for(;;){
                $rep = $pe_sel_method{$name}->{conn}->read;
                last if($rep =~ s/^(.*)\n//s);
                $pe_sel_method{$name}->{conn}->unread($rep);
                sleep 1;
            }
            alarm 0;
            if( $rep !~ /^QS_PE_SELECT\s.*PLAIN/ ) {
                qlog "Incorrect extern pe selector! ($name)\n", LOG_ERR;
                kill( 9, $pid ) if $pid;
                $pe_sel_method{$name}->{conn}->disconnect;
                $pe_sel_method{$name}->{die_count} = -1;
            }
        };
        alarm 0;
        if ( $@ eq "new_ext_sh\n" ) {
            qlog "New ext TMOUT!!!\n", LOG_ERR;
        } else {
            qlog "Extern_pe_select started\n", LOG_INFO;
        }
        return;
    }

    #child (the method itself)

    $pipe1->close;
    STDIN->fdopen( $pipe2,  "r" );
    STDOUT->fdopen( $pipe2, "w" );
    exec $cleosupport::global_settings{pe_sel_method}->{$name} or exit(0);
}

sub new_rsh_filter( $ ) {
    my $name = $_[0];

    unless ( exists $cleosupport::global_settings{rsh_filter}->{$name} ) {
        qlog "Undefined rsh_filter ($name) is tryed to reanimate!\n", LOG_ERR;
        return;
    }

    my ( $pipe1, $pipe2, $pid );

    qlog "Starting filter $name\n", LOG_INFO;
    $pipe1 = new IO::Handle;
    $pipe2 = new IO::Handle;

    socketpair( $pipe1, $pipe2, AF_UNIX, SOCK_STREAM, PF_UNSPEC );
    $pipe1->autoflush(1);
    $pipe2->autoflush(1);

    $pid = fork();
    unless ( defined $pid ) {
        qlog "Cannot fork(rsh)!\n", LOG_ERR;
        return;
    }
    if ( $pid < 0 ) {
        qlog "Cannot fork2(rsh)!\n", LOG_ERR;
        return;
    }
    if ( $pid > 0 ) {

        #parent (master)

        close $pipe2;
        $rsh_filter{$name}->{conn} = new_handle Cleo::Conn($pipe1);
        $rsh_filter{$name}->{pid}       = $pid;
        $rsh_filter{$name}->{die_count} =
            cleosupport::get_setting('rsh_filter_die_count');
        qlog "rsh filter '$name' started (pid=$rsh_filter{$name}->{pid})\n",
            LOG_INFO;
        return;
    }

    #child (the method itself)

    close $pipe1;
    STDIN->fdopen( $pipe2,  "r" );
    STDOUT->fdopen( $pipe2, "w" );
    exec $cleosupport::global_settings{rsh_filter}->{$name} or exit(0);
}

#
#  USR2 signal handler
#
#  Recreates main listening socket (on master only)
#  and rebuilds %own and %shared
#
########################################################
sub recreate_lst() {
    if ($is_master) {
        qlog "RECREATING LST (SIGUSR2)\n", LOG_INFO;
        eval {
            local $SIG{ALRM} = sub { die "recr_lst\n"; };
            $LST->close if defined $LST;
            undef $LST;
            $LST = new_listen Cleo::Conn(
                $port,get_setting('listen_number'));
            if($LST->listen){
                die "Cannot create listening socket on port $port! ($@)\n";
            }
        };
        recreate_rsh();
    }

    qlog "Initiate rechecking children and relink processors\n", LOG_DEBUG;
    $check_running = 1;
    %shared        = ();
    %own           = ();
RECRT_LST_LOOP:
    foreach my $p ( @{ $pe_list{$cluster_name} } ) {
        my ( $c_pe, $c_child );
        foreach $c_pe ( @{ $pe{$p}->{clusters} } ) {
            foreach $c_child ( @{ $clusters{$cluster_name}{childs} } ) {
                if ( $c_pe eq $c_child ) {
                    $shared{$p} = $pe{$p};
                    qlog "Node $p is shared by $c_child at least\n", LOG_INFO;
                    next RECRT_LST_LOOP;
                }
            }
        }
        $own{$p} = $pe{$p};
        qlog "Node $p is my own!\n", LOG_INFO;
    }
}

sub send_to_parent( $ ) {
    $up_ch->send( $_[0] );
}

sub rerun_extern_shuffles() {

    foreach
        my $i ( keys( %{ $cleosupport::global_settings{pe_sel_method} } ) ) {
        if ( $pe_sel_method{$i}->{pid} ) {
            kill 9, $pe_sel_method{$i}->{pid};
        }
        new_extern_shuffle($i);
    }
}

#
#  Recreates pseudo-rsh listening socket (on master only)
#
########################################################
sub recreate_rsh() {
    if ($is_master) {
        qlog "RECREATING PSEUDO-RSH\n", LOG_INFO;
        my $rsh_port = get_setting('pseudo_rsh_port');
        eval {
            local $SIG{ALRM} = sub { die "recr_rsh\n"; };
            $RSH->close;
            undef $RSH;
            $RSH = new_listen Cleo::Conn(
                $port,get_setting('listen_rsh_number'));
            if($RSH->listen){
                die "Cannot create listening socket on port $port! ($@)\n";
            }
        };
        if ($@) {
            chomp $@;
            qlog "FAIL ($@)\n", LOG_ERR;
        }
    }
}

sub get_all_ppids( $$ ) {
    my ( $pid, $ret_list ) = @_;
    my ($p);

    @ppids  = ();
    $#ppids = 65535;

    opendir( PROC, '/proc' ) or return;
    foreach $p ( readdir(PROC) ) {
        next if ( $p !~ /^\d+$/ );
        next unless ( open( P, "</proc/$p/status" ) );
        while (<P>) {
            if (/PPid:\s+(\d+)/) {
                $ppids[$p] = $1;
                last;
            }
        }
        close P;
    }
    closedir(PROC);

    $p = $pid;
    while ( $p > 1 ) {
        qlog "PUSH: $p\n";
        push @$ret_list, $p;
        $p = $ppids[$p];
    }
    return 0;
}

# arg: accepted Cleo::Conn
#
sub new_rsh_connection( $ ) {

    # connect from pseudo-rsh

    my $rsh = $_[0];

    if ( defined $RSH_select ) {
        $RSH_select->add($rsh->get_h);
    } else {
        $RSH_select = new IO::Select->new($rsh->get_h);
    }
    qlog "Connected rsh\n", LOG_DEBUG;
}

# !!!! rewrite it!
sub is_rsh_valid( $ ) {
    my ($pid) = @_;
    my ($i, @x);

    unless ( opendir DIR, "/proc/$pid/fd" ) {
        qlog "Cannot open /proc/$pid/fd\n", LOG_ERR;
        return 0;
    }
    foreach my $file ( readdir DIR ) {

        if ( $file =~ /\d/ ) {
            $i = readlink "/proc/$pid/fd/$file";

            if ( $i =~ /(\d+)/ ) {
                $i = $1;
                if ( open( TCP, "</proc/net/tcp" ) ) {
                    while (<TCP>) {
                        @x = split(/\s+/);

                        if ( $x[10] == $i ) {
                            close TCP;
                            closedir DIR;
                            return 1;
                        }
                    }
                    close TCP;
                }
            }
        }
    }
    closedir DIR;
    return 0;
}

#####################################################################
#
# Receive messages from pseudo_rshells
#
# args: NONE
# ret:  NONE
#
#####################################################################
sub rcv_from_rsh() {
    my ( $i, $cur, $entry );

    return unless ( defined $RSH_select );

    my ( @ready, $from, $to, $hash, $tmp, $cur_h, @ppids, $unpacked );

    @ready = $RSH_select->can_read(0.1);
RCV_FROM_RSH:
    foreach $cur_h (@ready) {
        $cur = Cleo::Conn::get_conn($cur_h);
        unless ( defined($cur) ) {
            qlog "RCV_FROM_RSH: Channel has no handle $cur_h\n", LOG_WARN;
            $RSH_select->remove($cur_h);
            next;
        }
        for( ;; ) {
            my %e = ();
            $entry = \%e;

            $hash = get_parsed_block_x( $cur, $entry );
            next RCV_FROM_RSH if ( ( $hash eq '-' ) or ( $hash eq '' ) );

            qlog("MESSAGE FROM RSH '$entry->{_from}' type=$entry->{_type}; \n",
                LOG_DEBUG )
                unless ( $_d_nolog_type{ $entry->{_type} } );
            if(( $entry->{_from} eq '' )){
                qlog "Empty from! (rsh connection)\n", LOG_ERR;
                $cur->send( "-Not valid\n" );
                $cur->flush;
                $cur->disconnect;
                $RSH_select->remove($cur_h);
                next RCV_FROM_RSH;
            }

            delete $entry->{_from};
            delete $entry->{_hash};
            delete $entry->{_to};
            delete $entry->{_type};
            foreach $tmp ( keys(%$entry) ) {
                undef $unpacked;
                unpack_value( \$unpacked, $entry->{$tmp} );
                $entry->{$tmp} = $unpacked;
            }

            # Now process the message! Fields are: pid,env,host,args
            if (   $entry->{pid} eq ''
                or $entry->{env} eq ''
                or $entry->{host} eq '' ) {
                qlog "Bad rsh request: " . join( ";", %$entry ) . "\n";
                $RSH_select->remove($cur_h);
                $cur->disconnect;
                next RCV_FROM_RSH;
            }
#            if ( !is_rsh_valid( $entry->{pid} ) ) {
#                qlog "Spoofed: " . join( ";", %$entry ) . "\n";
#
#                #kill_conn($cur);
#                next RCV_FROM_RSH;
#            }
            @ppids = ();
            if ( !get_all_ppids( $entry->{pid}, \@ppids ) ) {
#                qlog "Ok ($entry->{pid}):" . join( ",", @ppids ) . "\n";
                $cur->send( "+Ok\n" );
                $cur->flush;
                $entry->{list} = \@ppids;
                new_req_to_child(
                    'id_by_pids',       $entry,
                    '__ALL__',          1,
                    SUCC_ANY | SUCC_OK, \&id_by_pids_sub,
                    \&every_nil_sub,    get_setting('intra_timeout'),
                    \&nil_sub );
            } else {
#                qlog "Fail\n";
                $cur->send( "-Not valid\n" );
                $cur->flush;
            }
            $RSH_select->remove($cur_h);
            $cur->disconnect;
        }    # foreach message
    }    # foreach ready
}

#
#  Handle request from parent and return id of task,
#  which owns any of given PIDs
#
#############################################################
sub id_by_pid_handler($$$$ ) {
    my ( $type, $hash, $from, $args ) = @_;

    my ( $i, $j );

#    qlog "ID_BY_PIDS: GOT " . join( ";", %$args ) . "\n";
    foreach $i ( @{ $args->{list} } ) {
#        qlog "ID_BY_PIDS: iteration $i\n";
        foreach $j ( keys(%ids) ) {
            if ( $ids{$j}->{pid} == $i ) {
                my $gid = get_setting(
                    'gid',
                    $ids{$j}->{user},
                    $ids{$j}->{profile} );
                qlog "ID_BY_PIDS: $j,$ids{$j}->{group},$ids{$j}->{user},$ids{$j}->{nodes}\n",
                    LOG_DEBUG2;
                answer_to_parent(
                    $from,        $hash,
                    'id_by_pids', 1,
                    'id',         $j,
                    'group',      "$gid $gid $user_groups{$ids{$j}->{user}}",
                    'user',       $ids{$j}->{user},
                    'dir',        $ids{$j}->{dir},
                    'nodes',      $ids{$j}->{nodes} );
                $ids{$j}->{rsh_was_used} = 1;    # kill this rsh later...
                return;
            }
        }
    }
    qlog "ID Not found...\n", LOG_DEBUG;
}

#
#  Handle answer from child. Now react and run the rsh!
#
#########################################################
sub id_by_pids_sub($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    #!!! Check also, that node is in list of tasknodes!!!

    my ( $i, $j, %e, $ok );

    qlog "ID_BY_PIDS: $args->{host}\n", LOG_DEBUG2;
    foreach $i ( keys(%mons) ) {
        qlog "Try id_by_pid: $i ($args->{host})\n";
        if ( $i eq $args->{host} ) {    #ok!
            qlog "ID_BY_PIDS: found\n", LOG_DEBUG2;
            foreach $j ( split( /,/, $ret_args->{nodes} ) ) {
                $j =~ s/(\:.*)//;
                qlog "Try to confirm: $j ($i)\n", LOG_DEBUG2;
                if ( $j eq $i ) {
                    qlog "ID_BY_PIDS: confirmed\n", LOG_DEBUG2;
                    $ok = 1;
                    last;
                }
            }
            return unless $ok;          # node isn't in task nodes ist...

            push @{ $local_rshells{ "$from" . ":" . $ret_args->{id} } },
                { 'pid' => $args->{pid}, 'host' => $args->{host} };
            qlog "Saved rshell: $from : $ret_args->{id}.\n", LOG_DEBUG;
            $e{node}       = $args->{host};
            $e{is_rsh}     = 1;
            $e{user}       = $ret_args->{user};
            $e{owner}      = $from;
            $e{id}         = $ret_args->{id};
            $e{group}      = $ret_args->{group};
            $e{dir}        = $ret_args->{dir};
            $e{suexec_gid} = $ret_args->{group};
            $e{com_line}   = join( "\t", @{ $args->{args} } );

            qlog "REQUESTING6($i): $e{com_line} on $e{node}\n", LOG_DEBUG2;
            main::new_req_to_mon( 'run', \%e, $i, SUCC_ALL | SUCC_OK,
                \&nil_sub, undef,
                cleosupport::get_setting('mon_run_timeout') * 10, \&nil_sub );
            return;
        }
    }
}

#######################################################################
#
#   MONITOR COMMUNICATING PART
#
#######################################################################

#
#  Called when new monitor is connected
#
#  Args: Monitor name
#
#################################################
sub new_mon_connection( $ ) {

    my $mon = $_[0];

NEW_MON_CONN_LOOP:

#    $mons{$mon}->{last_response}        = $last_time;

    if ( defined $Mons_select ) {
        $Mons_select->add($mons{$mon}->{conn}->get_h);
    } else {
        $Mons_select = new IO::Select->new($mons{$mon}->{conn}->get_h);
    }
#    --$mons_connecting;
    qlog "Connected agent '$mon'.\n", LOG_INFO;
}

################################################################################
sub get_args_from_array( $$ ) {
    my ( $args, $cl_str ) = @_;
    my $line2;

    chomp @$cl_str;
    while (@$cl_str) {
        $line = shift @$cl_str;
        last if ( $line eq 'end' );
        next if $line eq '';
        unless ( $line =~ /^([^:]+)\s*:\s*(.*?)$/ ) {
            qlog "Bad line ($line)\n", LOG_ERR;
            next;
        }
        $args->{$1} = $2;
    }
}

sub selfcheck(){
    if ( exists( $mons{''} ) ) {
        qlog "NIL MONITOR NAME APPEARS!\n", LOG_ERR;
        delete $mons{''};
    }

}


#####################################################################
#
# 'Send' query to monitor(s) (actually only queue it, see flush_to_mons)
#
# args: what         - type
#       args         - % arguments
#       to           - @ or one name or '_all_'
#       success_cond - success condition
#       success_subr - success subroutine
#       every_subr   - every mon answer subroutine
# non-required
#       timeout      - timeout
#       timeout_subr - timeout subroutine
#
#####################################################################
#
#  PUSH NEW REQUEST TO MON(S)
#
sub new_req_to_mon( $$$$$$;$$@ ) {
    my ( $what, $args, $to, $succ, $spp, $epp, $tmout, $tpp, %uv ) = @_;

    #type/arguments(%)/to_whom(@)/success_cond/
    #sucess_subroutine/every_subroutine/
    #timeout/timeout_subroutine/initial_user_vars(%)

    unless ($is_master) {

        #BUG!!! resend this request to master!
        return;
    }

    qlog("REQ_TO_MON: $what, "
            . ( ref($to) eq 'ARRAY' ? join( ',', @$to ) : $to ) . ";\n",
        LOG_INFO )
        unless ( $_d_nolog_type{$what} );

    $tpp   = \&def_timeout_mon_proc                      unless ($tpp);
    $epp   = \&every_nil_sub                             unless ($epp);
    $spp   = \&every_nil_sub                             unless ($spp);
    $tmout = cleosupport::get_setting('mon_timeout') unless ($tmout);

    my ( $new_req, $wt );

    $wt = $succ & SUCC_WAIT;

    if ( $wt == SUCC_ANY || $wt == SUCC_FIRST ) {
        $new_req->{success} = ( ( $succ & SUCC_COND ) == SUCC_OK ) ? 0 : 1;
    }

    $new_req->{cond} = $succ & SUCC_COND;
    $new_req->{wait} = $succ & SUCC_WAIT;

    if ( ref($to) eq 'ARRAY' ) {
        my %nodes;
        my $i;
        foreach $i (@$to) {
            $i =~ s/:.*//;
            if ( !exists( $mons{$i} ) ) {
                qlog "Monitor '$i' (from array) does not exists...\n",
                    LOG_ERR;
                next;
            }
            if ( $mons{$i} eq '' ) {
                qlog "Nil monitor (from array) does not exists...\n", LOG_ERR;
                next;
            }

            $nodes{$i} = 1;
        }
        push @{ $new_req->{rest} }, keys(%nodes);
    } else {
        $to =~ s/\:.*$//;
        if ( $to eq '__all__' ) {
            push @{ $new_req->{rest} }, keys(%mons);
        } else {
            if ( !exists( $mons{$to} ) ) {
                qlog "Monitor '$to' does not exists...\n", LOG_ERR;
                return;
            }
            if ( $mons{$to} eq '' ) {
                qlog "Nil monitor does not exists...\n", LOG_ERR;
                next;
            }
            push @{ $new_req->{rest} }, $to;
        }
    }

    $new_req->{spp}       = $spp;
    $new_req->{epp}       = $epp;
    $new_req->{tpp}       = $tpp;
    $new_req->{hash}      = new_hash();
    $new_req->{tmout}     = $tmout;
    $new_req->{type}      = $what;
    $new_req->{args}      = $args;
    $new_req->{status}    = 'await';
    $new_req->{user_vars} = \%uv;

    if ( ref($spp) ne 'CODE' ) {
        qlog "Bad spp ($spp) "
            . ( caller(1) )[2] . "  "
            . ( caller(1) )[3]
            . "\n", LOG_ERR;
    }
    if ( ref($tpp) ne 'CODE' ) {
        qlog "Bad tpp ($tpp) "
            . ( caller(1) )[2] . "  "
            . ( caller(1) )[3]
            . "\n", LOG_ERR;
    }
    push @mon_req_q, $new_req;
    unless ( $_d_nolog_type{$what} ) {
        qlog "REQS[M]: " . scalar(@mon_req_q) . " [$new_req->{hash}] $what\n",
            LOG_DEBUG;
        qlog "REQS[M-UV]: ["
            . join( ':', %{ $new_req->{user_vars} } )
            . "]\n", LOG_DEBUG;
        qlog "ERQS[M-W]: [" . join( ':', @{ $new_req->{rest} } ) . "]\n",
            LOG_DEBUG;
    }
}    # new_req_to_mon
#####################################################################
#
# Actually send all messages to monitor(s)
#
# args: NONE
#
#####################################################################
sub flush_to_mons() {
    my ( $i, $j, $req, %snd, $k, $v, $e, $unsent, $pack );

    local $, = ';;';

    for $req (@mon_req_q) {
        if ( scalar( @{ $req->{rest} } ) < 1 ) {
            qlog "Invalid request to send to mon(s) (0 recipients)\n",
                LOG_WARN;
            next;
        }
        undef %snd;
        foreach $i ( @{ $req->{rest} } ) {
            unless ( $mons{$i}->{conn}->get_state eq 'ok' ) {   # node is not connected!
                qlog( "NODE $i is not connected. Skipping...\n", LOG_WARN )
                    if $debug{nc};
                my ( $ss, $se, $st ) =
                    ( $req->{spp}, $req->{epp}, $req->{tpp} );
                ( $req->{spp}, $req->{epp}, $req->{tpp} ) =
                    ( undef, undef, undef );
                my $req_save = Storable::dclone($req);
                ( $req->{spp}, $req->{epp}, $req->{tpp} ) = ( $ss, $se, $st );
                ( $req_save->{spp}, $req_save->{epp}, $req_save->{tpp} ) =
                    ( $ss, $se, $st );

                $req_save->{rest} = [$i];
                push @mons_delayed_sends, $req_save;
                next;
            }
            qlog( "==->$i $req->{type}($req->{hash})\n", LOG_DEBUG )
                unless ( $_d_nolog_type{ $req->{type} } );
            qlog(
                 "SENT: "
                 .join(
                       ';',
                       map( "$_:=$req->{args}->{$_}",
                            grep(!/^(nodes|env)/, keys( %{ $req->{args}})))
                      )
                 . "\n",
                LOG_DEBUG2 )
                unless ( $_d_nolog_type{ $req->{type} } );

            $pack = "\*main:$i:$req->{hash}\n$req->{type}\n";

            # create packet content
            while ( ( $k, $v ) = each( %{ $req->{args} } ) ) {
                $e = pack_value($v);
                qlog "Packed ($k) as '$e'\n" if $debug{pc};
                $pack .= "$k: $e\n";
            }
            $pack .= "end\n";
            $mons{$i}->{conn}->send( $pack );
        }

        #now we need to put a record in wait queue
        qlog(
            "A wait record with this id already exists! ("
                . join( ';', %{$req} ) . ")["
                . join( ';', $mons_wait{ $req->{hash} } ) . "]\n",
            LOG_ERR )
            if ( exists $mons_wait{ $req->{hash} } );
        {
            my ( $ss, $se, $st ) = ( $req->{spp}, $req->{epp}, $req->{tpp} );
            ( $req->{spp}, $req->{epp}, $req->{tpp} ) =
                ( undef, undef, undef );
            my $req_save = Storable::dclone($req);
            ( $req->{spp}, $req->{epp}, $req->{tpp} ) = ( $ss, $se, $st );
            ( $req_save->{spp}, $req_save->{epp}, $req_save->{tpp} ) =
                ( $ss, $se, $st );
            $req_save->{tmout} += $last_time;
            undef $req_save->{_to};
            @{ $req_save->{_to} } = @{ $req_save->{rest} };
            $mons_wait{ $req_save->{hash} } = $req_save;
            qlog "ADDED MONS HASH FOR AWAITING: $req->{hash}\n"
                unless ( $_d_nolog_type{ $req_save->{type} } );
        }
    }    # for each element in queue

    Cleo::Conn::allflush;

    @mon_req_q = ();    # zero the queue...
}    # flush_to_mons

#####################################################################
#
# Receive messages from monitors and dispatch them (call handlers)
#
# args: NONE
# ret:  NONE
#
#####################################################################
sub rcv_from_mon() {
    my ( $i, $j, $k, $ok, @mons_answ_q, $count, $entry, $unpacked );

    return unless ( defined $Mons_select );

    # get answers
    {
        my ( @ready, @outs, $from, $to, $hash, $tmp, $entry, $cur_h );

        @ready = $Mons_select->can_read(0.01);
    RCV_FROM_MON:
        foreach $cur_h (@ready) {
            $cur = Cleo::Conn::get_conn($cur_h);
            unless ( defined($cur) ) {
                qlog "RCV_FROM_MONS: Channel has no handle, connection is closing...\n",
                    LOG_WARN;
                $Mons_select->remove($cur_h);
                next;
            }
            for ( ;; ) {
                my %e = ();
                $entry = \%e;

                $hash = get_parsed_block_x( $cur, $entry );

                # Error/Nothing readed?
                next RCV_FROM_MON if ( ( $hash eq '-' ) or ( $hash eq '' ) );

                $from=$cur->get_peer;
                if ( $from ne $entry->{_from} ) {
                    qlog "Recorded $from, but written $entry->{_from}.\n",
                        LOG_ERR;
                    $entry->{_from}= $cur->get_peer;
                }
                qlog( "MESSAGE FROM NODE '$entry->{_from}'\n", LOG_DEBUG )
                    unless ( $_d_nolog_type{ $entry->{_type} } );
                if ( ( $entry->{_from} eq '' ) or ( $entry->{_to} eq '' ) ) {
                    qlog "Empty from or to! ($entry->{_from}/$entry->{_to})\n",
                        LOG_ERR;
                    next RCV_FROM_MON;
                }

                # unblock node
                if($mons{ $entry->{_from} }->{state} ne 'active'){
                    block_pe($entry->{_from}, 0, 0,
                             'Timed out',
                             'Not connected yet',
                             'Disconnected');
                }

                $mons{ $entry->{_from} }->{last_response}    = $last_time;
                $mons{ $entry->{_from} }->{fast_raise_count} = 0;
                $mons{ $entry->{_from} }->{state}            = 'active';

                if ( $entry->{_to} eq $cluster_name )
                {    #Yahoo! A message for me!
                    if (   !defined( $entry->{id} )
                        || !defined( $entry->{status} ) ) {
                        qlog "Invalid message from mon: id='$entry->{id}',"
                            . "status='$entry->{status}'\n", LOG_ERR;
                        next RCV_FROM_MON;
                    }
                    push @mons_answ_q, $entry;
                } else {

               #
               # It's for our parent may be???      FORWARD THE MESSAGE UPWARD
               #
                    qlog( "_Forward to ($entry->{_to})\n", LOG_DEBUG )
                        unless ( $_d_nolog_type{ $entry->{_type} } );
                    $down_ch{ $entry->{_to} }->send(
                        "\*_mon_$entry->{_from}:$entry->{_to}:$hash\n$entry->{_type}\n"
                    );
                    for $tmp ( keys( %{$entry} ) ) {
                        $down_ch{ $entry->{_to} }->send(
                            "$tmp: $entry->{$tmp}\n" );
                    }
                    $down_ch{ $entry->{_to} }->send( "end\n" );
                    next RCV_FROM_MON;
                }
            }    # foreach message
        }    # foreach mon
    }    # block

    foreach $i (@mons_answ_q) {
        $j     = $i->{_hash};
        $entry = Storable::thaw( Storable::freeze($i) );
        delete $entry->{_from};
        delete $entry->{_hash};
        delete $entry->{_to};
        delete $entry->{_type};
        foreach $tmp ( keys(%$entry) ) {

            #      next if($tmp eq 'success');
            undef $unpacked;
            unpack_value( \$unpacked, $entry->{$tmp} );
            $entry->{$tmp} = $unpacked;
        }

        qlog( "MON Processing0 $j $i->{success}\n", LOG_DEBUG2 )
            unless ( $_d_nolog_type{ $i->{_type} } );
        foreach my $tmpi ( keys( %{$entry} ) ) {
            qlog( "MM> $tmpi: $entry->{$tmpi}.\n", LOG_DEBUG2 )
                unless ( $_d_nolog_type{ $i->{_type} } );
        }

        unless ($j) {

            # this is NOT an answer. It's a message
            qlog( "MON_MESSAGE: $i->{_from},$i->{_type},$i->{status},$entry\n",
                LOG_DEBUG )
                unless ( $_d_nolog_type{ $i->{_type} } );
            mon_message_process( $i->{_type}, $i->{_from}, $i->{status},
                $entry );
            next;
        }
        qlog( "MON Processing2\n", LOG_DEBUG2 )
            unless ( $_d_nolog_type{ $i->{_type} } );
        if ( exists $mons_wait{$j} ) {
            qlog( "MON Processing3 $j\n", LOG_DEBUG2 )
                unless ( $_d_nolog_type{ $i->{_type} } );
            $ok = 0;

            # SUCC_RET appologise more than one answer from mon...
            if ( ( $mons_wait{$j}->{wait} & SUCC_WAIT ) != SUCC_RET ) {

                #test from whom we got the answer (do we await it?)

                qlog("WAIT: " . join( ':', @{ $mons_wait{$j}->{rest} } ) . ";\n",
                    LOG_DEBUG2 )
                    unless ( $_d_nolog_type{ $i->{_type} } );
                for ( $k = 0; $k <= $#{ $mons_wait{$j}->{rest} }; ++$k ) {
                    next unless ( defined $mons_wait{$j}->{rest}->[$k] );
                    if ( $mons_wait{$j}->{rest}->[$k] eq $i->{_from} ) {
                        $ok = 1;

                        #delete it from the list of wanted answers!
                        undef $mons_wait{$j}->{rest}->[$k];
                        last;
                    }
                }
                if ( !$ok
                    and ( ( $mons_wait{$j}->{wait} & SUCC_WAIT ) != SUCC_RET )
                    ) {
                    qlog "Got unexpected answer: " . join( ';', %$i ) . "\n",
                        LOG_ERR;
                    next;
                }
            }

            $mons_wait{$j}->{args}->{status} = $mons_wait{$j}->{status};

            #Try to call every_time_subroutine...
            qlog("DD> $mons_wait{$j}->{status}/ $mons_wait{$j}->{success}/"
                    . ref( $mons_wait{$j}->{epp} ) . "\n",
                LOG_DEBUG2 )
                unless ( $_d_nolog_type{ $i->{_type} } );
            my $uv;
            if (   ( $mons_wait{$j}->{status} ne 'done' )
                && ( ref( $mons_wait{$j}->{epp} ) eq 'CODE' ) ) {
                qlog( "MON CALL EPP [$i->{_type}]\n", LOG_DEBUG )
                    unless ( $_d_nolog_type{ $i->{_type} } );
                $uv = $mons_wait{$j}->{epp}->(
                    $j,
                    $i->{success},
                    $mons_wait{$j}->{args},
                    $mons_wait{$j}->{user_vars},
                    $i->{_from},
                    $entry );
                delete $mons_wait{$j}->{user_vars};
                $mons_wait{$j}->{user_vars} = $uv;
            }

            #Check the success condition and react, if needed
            if ( ( $mons_wait{$j}->{wait} & SUCC_WAIT ) == SUCC_RET ) {
                qlog(
                    "MON RET branch [$mons_wait{$j}->{status}][$uv->{success}]\n",
                    LOG_DEBUG )
                    unless ( $_d_nolog_type{ $i->{_type} } );
                $uv = $mons_wait{$j}->{spp}->(
                    $j,
                    $i->{success},
                    $mons_wait{$j}->{args},
                    $mons_wait{$j}->{user_vars},
                    $i->{_from},
                    $entry );
                delete $mons_wait{$j}->{user_vars};
                $mons_wait{$j}->{user_vars} = $uv;

                if (   ( $mons_wait{$j}->{status} ne 'done' )
                    && ( $uv->{success} ) ) {
                    $mons_wait{$j}->{success} = $i->{success};
                    @{ $mons_wait{$j}->{rest} } = ();
                    $mons_wait{$j}->{status} = 'done';
                }
            } elsif ( ( $mons_wait{$j}->{wait} & SUCC_WAIT ) == SUCC_FIRST ) {
                qlog( "MON FIRST branch [$mons_wait{$j}->{status}]\n",
                    LOG_DEBUG )
                    unless ( $_d_nolog_type{ $i->{_type} } );
                if ( $mons_wait{$j}->{status} eq 'await' )
                {    # no answers are gotten!
                    $mons_wait{$j}->{status}  = 'done';
                    $mons_wait{$j}->{success} = $i->{success};
                    qlog( "CALL SPP [$i->{_type}]\n", LOG_DEBUG )
                        unless ( $_d_nolog_type{ $i->{_type} } );
                    $mons_wait{$j}->{spp}->(
                        $j, $i->{success},
                        $mons_wait{$j}->{args}, $mons_wait{$j}->{user_vars},
                        $i->{_from},            $entry );
                    delete $mons_wait{$j}->{user_vars};
                    $mons_wait{$j}->{user_vars} = $uv;
                    @{ $mons_wait{$j}->{rest} } = ();
                }
            } elsif ( ( $mons_wait{$j}->{wait} & SUCC_WAIT ) == SUCC_ANY ) {
                qlog( "MON ANY branch [$mons_wait{$j}->{status}]\n",
                    LOG_DEBUG )
                    unless ( $_d_nolog_type{ $i->{_type} } );
                $mons_wait{$j}->{success} = $i->{success};
                unless ( $mons_wait{$j}->{status} eq 'done' )
                {    # still wait for...
                    qlog(
                        "DDD> succ= $i->{success} cond= $mons_wait{$j}->{cond}\n",
                        LOG_DEBUG )
                        unless ( $_d_nolog_type{ $i->{_type} } );
                    if (!(  $i->{success}
                            xor(( $mons_wait{$j}->{cond} & SUCC_COND ) ==
                                    SUCC_OK ) )
                        ) {

                        #^ success is equivalent to cond
                        $mons_wait{$j}->{status} = 'done';
                        qlog( "MON CALL SPP2 [$i->{_type}]\n", LOG_DEBUG )
                            unless ( $_d_nolog_type{ $i->{_type} } );
                        $mons_wait{$j}->{spp}->(
                            $mons_wait{$j}->{hash},
                            $i->{success},
                            $mons_wait{$j}->{args},
                            $mons_wait{$j}->{user_vars},
                            $i->{_from},
                            $entry );
                        delete $mons_wait{$j}->{user_vars};
                        $mons_wait{$j}->{user_vars} = $uv;
                    }
                    @{ $mons_wait{$j}->{rest} } = ();
                }
            } elsif ( ( $mons_wait{$j}->{wait} & SUCC_WAIT ) == SUCC_ALL ) {
                qlog( "MON ALL branch [$mons_wait{$j}->{cond}]\n", LOG_DEBUG )
                    unless ( $_d_nolog_type{ $i->{_type} } );
                if ( ( $mons_wait{$j}->{cond} & SUCC_COND ) == SUCC_OK ) {
                    $mons_wait{$j}->{success} &= $i->{success};
                } else {
                    $mons_wait{$j}->{success} |= $i->{success};
                }
            } else {    #Ooops...
                qlog
                    "Unknown wait-status (mon) [$mons_wait{$j}->{wait}][$mons_wait{$j}->{cond}] ("
                    . join( ';', %{$i} )
                    . ")\n", LOG_ERR;
            }

            #If all answers are gotten - finish the request!
            $count = 0;
            for ( $k = 0; $k < scalar( @{ $mons_wait{$j}->{rest} } ); ++$k ) {
                ++$count if defined $mons_wait{$j}->{rest}->[$k];
            }
            if ( $count == 0 ) {
                qlog( "MON DELETING REQUEST ENTRY ($j) $i->{_type}\n",
                    LOG_DEBUG )
                    unless ( $_d_nolog_type{ $i->{_type} } );
                if ( $mons_wait{$j}->{status} ne 'done' ) {
                    qlog(
                        "MON CALL SPP3 [$i->{_type}] [$mons_wait{$j}->{user_vars}->{channel}]\n",
                        LOG_DEBUG )
                        unless ( $_d_nolog_type{ $i->{_type} } );
                    $mons_wait{$j}->{spp}->(
                        $mons_wait{$j}->{hash}, $i->{success},
                        $mons_wait{$j}->{args}, $mons_wait{$j}->{user_vars},
                        $i->{_from},            $entry );
                    delete $mons_wait{$j}->{user_vars};
                    $mons_wait{$j}->{user_vars} = $uv;
                }
                delete $mons_wait{$j};
            }
        } else {

            #oops...
            qlog "Got message for unexistent mon hash $j ($i->{_type})\n",
                LOG_WARN;
        }
    }    # ~processing answers queue

    # check timed out requests
    foreach $i ( keys(%mons_wait) ) {
        if ( $mons_wait{$i}->{tmout} < $last_time ) {

            # timed out!
            $mons_wait{$i}->{args}->{status} = 'timed out';
            $mons_wait{$i}->{success} = 0;

            # call tmout subroutine...
            qlog( "MON CALL TPP [$mons_wait{$i}->{type}/$i]\n", LOG_DEBUG )
                unless ( $_d_nolog_type{ $mons_wait{$i}->{type} } );
            if ( ref( $mons_wait{$i}->{tpp} ) eq 'CODE' ) {
                $mons_wait{$i}->{tpp}->(
                    $i,
                    SUCC_FAIL,
                    $mons_wait{$i}->{args},
                    $mons_wait{$i}->{user_vars},
                    $mons_wait{$i}->{_to}->[0],
                    @{$mons_wait{$i}->{_to}} );
                delete $mons_wait{$i}->{user_vars};
            } else {
                qlog("MON NIL TPP entry [$mons_wait{$i}->{hash} $mons_wait{$i}->{type}]\n",
                    LOG_WARN )
                    unless ( $_d_nolog_type{ $mons_wait{$i}->{type} } );
            }
            qlog("MON DELETING REQUEST[M] ENTRY TIMED OUT ($mons_wait{$i}->{hash})\n",
                LOG_DEBUG )
                unless ( $_d_nolog_type{ $mons_wait{$i}->{type} } );

            # check timed out mons!
            for $j ( @{ $mons_wait{$i}->{_to} } ) {
                if ( $mons{$j}->{last_response} + $max_mon_timeout <
                    $last_time ) {

                    # whole monitor timed out!!!
                    qlog "MON TIMED OUT: $j (req $i, type $mons_wait{$i}->{type})\n",
                        LOG_DEBUG2;
                    on_mon_timed_out($j);
                }
            }
            delete $mons_wait{$i};
        }
    }

    # check for bad connections
    @ready = $Mons_select->has_exception(0.01);
    foreach $i (@ready) {
        $cur = Cleo::Conn::get_conn($i);
        unless ( defined($cur) ) {
#            qlog "RCV_FROM_MONS: Channel has no handle. Ignore.\n",
#                LOG_WARN;
            $Mons_select->remove($i);
            next;
        }
        my $name=$cur->get_peer;
        unless( exists ($mons{$name}) ) {
#            qlog "RCV_FROM_MONS: No monitor associated with handler ($name). Ignore.\n",
#                LOG_WARN;
            $Mons_select->remove($i);
            next;
        }
        # make actions on dead monitor
        $mons{ $name }->{state} = 'fail';
        on_mon_disconnect( $name );
    }

    @ready = ();
}    # rcv_from_mon

#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

#####################################################################
#
# 'Send' query to child(s) (actually only queue it, see flush_to_childs)
#
# args: what         - type
#       args         - % arguments
#       to           - @ or one name oe '_all_'
#       recurs       - recursive?
#       success_cond - success condition
#       success_subr - success subroutine
#       success_subr - every time subroutine
# non-required
#       timeout      - timeout
#       timeout_subr - timeout subroutine
#
#####################################################################
#
#  PUSH NEW REQUEST TO CHILD(S)
#
sub new_req_to_child( $$$$$$$;$$@ ) {
    my ( $what, $args, $to, $recurse, $succ, $spp, $epp,
         $tmout, $tpp, %uv ) = @_;

#type/arguments(%)/to_whom(@)/recurse/success_cond/
#sucess_subroutine/every_subroutine/timeout/timeout_subroutine/init_user_vars(%)

    my ( $i, $tmp );

    if ( @{ $clusters{$cluster_name}->{childs} } ) {
        qlog "REQ_TO_CHILD: $what, $to;\n", LOG_INFO;
    } else {
        unless ( ref($to) eq ''
            and ( $to ne '__all__' or $to eq $cluster_name ) ) {
            qlog "REQ_TO_CHILD: $what, $to; BUT I HAVEN'T CHILDS!\n",
                LOG_WARN;
            return;
        }
    }
    $tpp = \&def_timeout_child_proc unless ($tpp);
    $tmout = cleosupport::get_setting('child_req_timeout') unless ($tmout);

    my ( $new_req, $wt );

    $wt = $succ & SUCC_WAIT;

    if ( $wt == SUCC_ANY || $wt == SUCC_FIRST ) {
        $new_req->{success} = ( ( $succ & SUCC_COND ) == SUCC_OK ) ? 0 : 1;
    }
    $new_req->{cond} = $succ & SUCC_COND;
    $new_req->{wait} = $succ & SUCC_WAIT;

    if ( ref($to) eq 'ARRAY' ) {
        push @{ $new_req->{rest} }, @$to;
    } else {
        if ( $to eq '__all__' ) {
            push @{ $new_req->{rest} },
                @{ $clusters{$cluster_name}->{childs} };
        } elsif ( $to eq '__ALL__' ) {
            push @{ $new_req->{rest} }, @{ $child_aliases{$cluster_name} };

            #      push @{$new_req->{rest}}, $cluster_name;
        } else {
            push @{ $new_req->{rest} }, $to;
        }
    }

    $new_req->{spp}   = $spp;
    $new_req->{epp}   = $epp;
    $new_req->{tpp}   = $tpp;
    $new_req->{hash}  = new_hash();
    $new_req->{tmout} = $tmout;
    $new_req->{type}  = $what;
    $new_req->{args}  = Storable::dclone($args);
    qlog "NEW_REQ: " . join( ';', keys(%$args) ) . "\n", LOG_DEBUG;
    $new_req->{status}    = 'await';
    $new_req->{user_vars} = \%uv;

    #   foreach $i (keys(%{$new_req->{args}})){
    #     $new_req->{args}->{$i}=pack_value($new_req->{args}->{$i});
    #     qlog "Packed ($i) as '$new_req->{args}->{$i}'\n";
    #   }

    if ( ref($spp) ne 'CODE' ) {
        qlog "Bad spp ($spp) "
            . ( caller(1) )[2] . "  "
            . ( caller(1) )[3]
            . "\n", LOG_ERR;
    }
    if ( ref($epp) ne 'CODE' ) {
        qlog "Bad epp ($epp) "
            . ( caller(1) )[2] . "  "
            . ( caller(1) )[3]
            . "\n", LOG_ERR;
    }
    if ( ref($tpp) ne 'CODE' ) {
        qlog "Bad tpp ($tpp) "
            . ( caller(1) )[2] . "  "
            . ( caller(1) )[3]
            . "\n", LOG_ERR;
    }
    push @chld_req_q, $new_req;
    qlog "REQS[C]: "
        . scalar(@chld_req_q)
        . " [$new_req->{hash}:$new_req->{type}] to "
        . join( ';', @{ $new_req->{rest} } )
        . ";\n", LOG_DEBUG;
    qlog "UV keys:" . join( ':', %{ $new_req->{user_vars} } ) . "\n",
        LOG_DEBUG;
}    # new_req_to_child

#####################################################################
#
# Actually send all messages to childitor(s)
#
# args: NONE
#
#####################################################################
sub flush_to_childs() {
    my ( $i, $j, $req, %snd, $k, $v, $e, @rest );

    for $req (@chld_req_q) {
        if ( scalar( @{ $req->{rest} } ) < 1 ) {
            qlog "Invalid request to send to child(s) (0 recipients)\n",
                LOG_WARN;
            next;
        }
        undef %snd;
        qlog "SEND REQ: " . join( ';', @{ $req->{rest} } ) . "\n", LOG_DEBUG;
        for $j ( @{ $clusters{$cluster_name}->{childs} } ) {
            @rest = @{ $req->{rest} };
            for ( $i = 0; $i <= $#rest; ++$i ) {
                next unless $req->{rest}->[$i] ne '';
                for $k ( @{ $child_aliases{$j} } ) {
                    if ( $rest[$i] eq $k ) {
                        push @{ $snd{$j} }, $k;
                        undef $rest[$i];
                        last;
                    }
                }    # for each child's subcluster
            }    # for each requested target
        }    # fo each childs
        if ( !defined $snd{$cluster_name} ) {
            @rest = @{ $req->{rest} };
            for ( $i = 0; $i <= $#rest; ++$i ) {
                if ( $rest[$i] eq $cluster_name ) {
                    push @{ $snd{$cluster_name} }, $cluster_name;
                    last;
                }
            }
        }

        qlog "TO SEND: " . join( ';', keys(%snd) ) . "\n", LOG_DEBUG;

        #actually sending
        for $i ( keys(%snd) ) {    #for each child, through which we send
            my %r = %{ $req->{args} };
            if ( $i eq $cluster_name ) {
                foreach $k ( keys(%r) ) {
                    $e = pack_value( $r{$k} );
                    qlog( "Packed ($k) as '$e'\n", LOG_DEBUG ) if $debug{pc};
                    $r{$k} = $e;
                }
                $r{_from} = $cluster_name;
                $r{_to}   = $cluster_name;
                $r{_type} = $req->{type};
                $r{_hash} = $req->{hash};
                qlog "!==>$cluster_name $r{_type} ($r{_hash})\n", LOG_INFO;
                push @messages_to_self, \%r;
                qlog "SENT: "
                    . join( ';', map {"$_:=$r{$_}"} keys(%r) )
                    . "\n", LOG_DEBUG2;
            } else {

                #        qlog "Flushing '$req->{type}' to '$i'\n", LOG_INFO;
                qlog "===>$i $req->{type} ($req->{hash})\n", LOG_INFO;
                $down_ch{$i}->send(
                          "\*$cluster_name:"
                        . join( ',', @{ $snd{$i} } )
                        . ":$req->{hash}\n$req->{type}\n" );

                qlog("SENT: "
                    . join( ';', map {"$_:=$r{$_}"} keys(%r) )
                    . "\n", LOG_DEBUG2) if $debug{cs};
                while ( ( $k, $v ) = each(%r) ) {
                    $e = pack_value($v);
                    qlog( "Packed ($k) as '$e'\n", LOG_DEBUG ) if $debug{pc};
                    $down_ch{$i}->send( "$k:$e\n" );
                }
                $down_ch{$i}->send( "end\n" );
                qlog "Flushed to $i $req->{hash};$req->{type}!\n", LOG_DEBUG;
            }    # ~for each child through which we send
        }

        #now we need to put a record in wait queue
        qlog(
            "A wait record with this hash ($req->{hash}) already exists! ("
                . join( ';', %{$req} ) . ")["
                . join( ';', $childs_wait{ $req->{hash} } ) . "]\n",
            LOG_ERR )
            if ( exists $childs_wait{ $req->{hash} } );
        $req->{tmout} += $last_time;
        $childs_wait{ $req->{hash} } = $req;
    }    # for each element in queue

    Cleo::Conn::allflush;

    @chld_req_q = ();    # zero the queue...
}    # flush_to_chlds

#####################################################################
#
# Receive messages from childs and dispatch them (call handlers)
#
# args: NONE
# ret:  NONE
#
#####################################################################
sub rcv_from_childs() {
    my ( $i, $j, $k, $v, $cur, $cur_h, $ok, @childs_answ_q, $count, $entry,
        @x, %x, $unp, $msg_hash );

    unless( defined $down_ch_select or @answers_to_self ){
        select(undef,undef,undef,0.1);
        return;
    }
    $last_time = time;

    # get answers
    {
        my ( @ready, @outs, $from, $to, $hash, $tmp, $entry, @to_list );

        @ready = $down_ch_select->can_read(0.01);
    RCV_FROM_CHLD:
        foreach $cur_h (@ready) {
            for ( ;; ) {
                my %e;
                $entry = \%e;
                $cur   = Cleo::Conn::get_conn($cur_h);
                unless( defined $cur ){
                    qlog "Child channel is dead!\n", LOG_ERR;
                    $down_ch_select->remove($cur_h->fileno);
                    next;
                }
                $hash  = get_parsed_block_x( $cur, $entry );

                if ( ( $hash eq '-' ) or ( $hash eq '' ) ) {
                    next RCV_FROM_CHLD;
                }
                qlog
                    "MESSAGE FROM CHILD CLUSTER!($entry->{_from} -> $entry->{_to})\n",
                    LOG_INFO;

                @to_list = split( /\,/, $entry->{_to} );
                $to = 0;
                for ( $i = 0; $i < scalar(@to_list); ++$i ) {
                    if ( $to_list[$i] eq $cluster_name ) {
                        $to = 1;
                        splice( @to_list, $i, 1 );
                        last;
                    }
                }
                if ($to) {    #Yahoo! A message for me!
                    qlog "MES: " . join( ";", %$entry, "\n" ), LOG_DEBUG;
                    if ( !defined( $entry->{success} ) ) {
                        qlog
                            "Invalid message from child: hash='$entry->{_hash}',"
                            . "status='$entry->{success}'\n", LOG_ERR;
                        next RCV_FROM_CHLD;
                    }
                    push @childs_answ_q, $entry;

                    # Is forward needed?
                    if (@to_list) {
                        my %snd;
                        my @rest = @to_list;

                        for $j ( @{ $clusters{$cluster_name}->{childs} } ) {
                            for ( $i = 0; $i <= $#rest; ++$i ) {
                                next unless defined $rest[$i];
                                for $k ( @{ $child_aliases{$j} } ) {
                                    if ( $rest[$i] eq $k ) {
                                        push @{ $snd{$j} }, $k;
                                        undef $rest[$i];
                                        last;
                                    }
                                }    # for each child's subcluster
                            }    # for each requested target
                        }    # fo each childs

                        $from = $entry->{_from};
                        $to   = $entry->{_to};
                        $tmp  = $entry->{_type};
                        delete $entry->{_from};
                        delete $entry->{_to};
                        delete $entry->{_hash};
                        delete $entry->{_type};
                        foreach $i ( keys(%snd) ) {
                            $down_ch{$i}->send(
                                      "\*$from:"
                                    . join( ',', @{ $snd{$i} } )
                                    . ":$hash\n$tmp\n" );
                            while ( ( $k, $v ) = each(%$entry) ) {
                                $down_ch{$i}->send( "$k: $v\n" );
                            }
                            $down_ch{$i}->send( "end\n" );
                        }
                    }    # ok, we'he forwarded all down!
                } else {

               #
               # It's for our parent may be???      FORWARD THE MESSAGE UPWARD
               #
                    if ($is_master) {
                        qlog "Cannot forward up (to $to), I'M THE MASTER!\n",
                            LOG_ERR;
                        next RCV_FROM_CHLD;
                    }
                    qlog "_Forward to ($to)\n", LOG_DEBUG;
                    $up_ch->send(
                        "\*$entry->{_from}:$entry->{_to}:$hash\n$entry->{_type}\n"
                    );
                    for $tmp ( keys( %{$entry} ) ) {
                        $up_ch->send( "$tmp: $entry->{$tmp}\n" );
                    }
                    $up_ch->send( "end\n" );
                    next RCV_FROM_CHLD;
                }
            }    # for each received block
        }    # foreach child
    }    # block

    $unp = 0;
    foreach $i ( { '_hash' => '__internal__' }, @answers_to_self,
        @childs_answ_q ) {
        $hash = $i->{_hash};
        if ( !$unp && ( $hash eq '__internal__' ) ) {
            $unp = 1;
            next;
        }

        %$entry = ();
        %$entry = %$i;
        delete $entry->{_from};
        delete $entry->{_hash};
        delete $entry->{_to};
        delete $entry->{_type};

        foreach $tmp ( keys(%$entry) ) {
            next if ( $tmp eq 'success' );
            if ($unp) {
                qlog( "Unpacking: $tmp\n", LOG_DEBUG ) if $debug{pc};
                unpack_value( \$entry->{$tmp}, $i->{$tmp} );
            }
        }

        qlog "CHLD Processing0 $hash $i->{success} ($i->{_type},$i->{_from})\n",
              LOG_DEBUG2;
        if($debug{mc}){
            foreach my $tmpi ( keys( %{$entry} ) ) {
                qlog "CC> $tmpi: $entry->{$tmpi}.\n", LOG_DEBUG2;
            }
        }
        unless ($hash) {

            # this is NOT an answer. It's a message
            qlog "!!: $i->{_type},$i->{_from},$i->{status},$entry\n",
                LOG_DEBUG;
            child_message_process( $i->{_type}, $i->{_from}, $i->{status},
                $entry );
            next;
        }
#        qlog "CHLD Processing2 [" . join( ':', keys(%childs_wait) ) . "]\n",
#            LOG_DEBUG2;
        if ( exists $childs_wait{$hash} ) {
#            qlog "CHLD Processing3 $hash\n", LOG_DEBUG2;
            $ok = 0;

            # SUCC_RET appologise more than one answer from child...
            if ( ( $childs_wait{$hash}->{wait} & SUCC_WAIT ) != SUCC_RET ) {

                #test from whom we got the answer (do we await it?)
                for ( $k = 0; $k <= $#{ $childs_wait{$hash}->{rest} }; ++$k ) {
                    next unless ( $childs_wait{$hash}->{rest}->[$k] ne '' );
                    if ( $childs_wait{$hash}->{rest}->[$k] eq $i->{_from} ) {
                        $ok = 1;

                        #delete it from the list of wanted answers!
                        undef $childs_wait{$hash}->{rest}->[$k];
                        last;
                    }
                }
                unless ($ok) {
                    qlog "Got unexpected answer: " . join( ';', %$i ) . "\n",
                        LOG_ERR;
                    next;
                }
            }

            $childs_wait{$hash}->{args}->{status} = $childs_wait{$hash}->{status};

            #Try to call every_time_subroutine...

            my $uv;
            if (   ( $childs_wait{$hash}->{status} ne 'done' )
                && ( ref( $childs_wait{$hash}->{epp} ) eq 'CODE' ) ) {
                qlog "CHLD CALL EPP [$i->{_type}]\n", LOG_DEBUG;
                $uv = $childs_wait{$hash}->{epp}->(
                    $hash,
                    $i->{success},
                    $childs_wait{$hash}->{args},
                    $childs_wait{$hash}->{user_vars},
                    $i->{_from},
                    $entry );
                if ( ref($uv) ne 'HASH' ) {
                    qlog "User_vars returned are not hash! ($uv)\n", LOG_ERR;
                } else {
                    delete $childs_wait{$hash}->{user_vars};
                    $childs_wait{$hash}->{user_vars} = $uv;
                }
            }

            #Check the success condition and react, if needed
            if ( ( $childs_wait{$hash}->{wait} & SUCC_WAIT ) == SUCC_RET ) {
                qlog
                    "CHLD RET branch [$childs_wait{$hash}->{status}][$uv->{success}]\n",
                    LOG_DEBUG;
                if (   ( $childs_wait{$hash}->{status} ne 'done' )
                    && ( $uv->{success} ) ) {
                    $childs_wait{$hash}->{success} = $i->{success};
                    qlog "CHLD CALL SPP [$i->{_type}]\n", LOG_DEBUG;
                    $childs_wait{$hash}->{spp}->(
                        $hash,
                        $i->{success},
                        $childs_wait{$hash}->{args},
                        $childs_wait{$hash}->{user_vars},
                        $i->{_from},
                        $entry );

                    #          delete $childs_wait{$hash}->{user_vars};
                    #          $childs_wait{$hash}->{user_vars}=$uv;
                    @{ $childs_wait{$hash}->{rest} } = ();
                    $childs_wait{$hash}->{status} = 'done';
                }
            } elsif ( ( $childs_wait{$hash}->{wait} & SUCC_WAIT ) == SUCC_FIRST ){
                qlog "CHLD FIRST branch [$childs_wait{$hash}->{status}]\n",
                    LOG_DEBUG;
                if ( $childs_wait{$hash}->{status} eq 'await' )
                {    # no answers are gotten!
                    $childs_wait{$hash}->{status}  = 'done';
                    $childs_wait{$hash}->{success} = $i->{success};
                    qlog "CHLD CALL SPP [$i->{_type}]\n", LOG_DEBUG;
                    $childs_wait{$hash}->{spp}->(
                        $hash,
                        $i->{success},
                        $childs_wait{$hash}->{args},
                        $childs_wait{$hash}->{user_vars},
                        $i->{_from},
                        $entry );

                    #          delete $childs_wait{$hash}->{user_vars};
                    #          $childs_wait{$hash}->{user_vars}=$uv;
                    @{ $childs_wait{$hash}->{rest} } = ();
                }
            } elsif ( ( $childs_wait{$hash}->{wait} & SUCC_WAIT ) == SUCC_ANY ) {
                qlog "CHLD ANY branch [$childs_wait{$hash}->{status}]\n",
                    LOG_DEBUG;
                $childs_wait{$hash}->{success} = $i->{success};
                unless ( $childs_wait{$hash}->{status} eq 'done' )
                {    # still wait for...
                    qlog
                        "CHLD DDD> succ= $i->{success} cond= $childs_wait{$hash}->{cond}\n",
                        LOG_DEBUG;
                    if (!(  $i->{success}
                            xor(( $childs_wait{$hash}->{cond} & SUCC_COND ) ==
                                    SUCC_OK ) )
                        ) {

                        #^ success is equivalent to cond
                        $childs_wait{$hash}->{status} = 'done';
                        qlog "CHLD CALL SPP2 [$i->{_type}]\n", LOG_DEBUG;
                        $childs_wait{$hash}->{spp}->(
                            $hash,
                            $i->{success},
                            $childs_wait{$hash}->{args},
                            $childs_wait{$hash}->{user_vars},
                            $i->{_from},
                            $entry );

                        #            delete $childs_wait{$hash}->{user_vars};
                        #            $childs_wait{$hash}->{user_vars}=$uv;
                    }
                    @{ $childs_wait{$hash}->{rest} } = ();
                }
            } elsif ( ( $childs_wait{$hash}->{wait} & SUCC_WAIT ) == SUCC_ALL ) {
                qlog "CHLD ALL branch [$childs_wait{$hash}->{cond}]\n",
                    LOG_DEBUG;
                if ( ( $childs_wait{$hash}->{cond} & SUCC_COND ) == SUCC_OK ) {
                    $childs_wait{$hash}->{success} &= $i->{success};
                } else {
                    $childs_wait{$hash}->{success} |= $i->{success};
                }
            } else {    #Ooops...
                qlog
                    "CHLD: unknown wait-status [$childs_wait{$hash}->{wait}][$childs_wait{$hash}->{cond}] ("
                    . join( ';', %{$i} )
                    . ")\n", LOG_ERR;
            }

            #If all answers are gotten - finish the request!
            $count = 0;
            for( $k = 0;
                 $k < scalar( @{ $childs_wait{$hash}->{rest} } );
                 ++$k) {
                ++$count if $childs_wait{$hash}->{rest}->[$k] ne '';

            }
            if ( $count == 0 ) {
                qlog "CHLD DELETING REQUEST ENTRY ($hash) $i->{_type}\n",
                    LOG_DEBUG;
                if ( $childs_wait{$hash}->{status} ne 'done' ) {
                    qlog "CHLD CALL SPP3 [$i->{_type}]\n", LOG_DEBUG;
                    $childs_wait{$hash}->{spp}->(
                        $hash,
                        $i->{success},
                        $childs_wait{$hash}->{args},
                        $childs_wait{$hash}->{user_vars},
                        $i->{_from},
                        $entry );
                }
                delete $childs_wait{$hash};
            }
        } else {

            #oops...
            qlog "CHLD: Got message for unexistent child hash $hash\n", LOG_ERR;
        }
        }    # ~processing answers queue
    @answers_to_self = @childs_answ_q = ();

    # check timed out requests
    foreach $i ( keys(%childs_wait) ) {
        if ( $childs_wait{$i}->{tmout} < $last_time ) {

            # call tmout subroutine...
            if ( ref( $childs_wait{$i}->{tpp} ) eq 'CODE' ) {

                qlog "CHLD CALL TPP [$childs_wait{$i}->{type}/$i]\n", LOG_DEBUG;
                # timed out!
                $childs_wait{$i}->{args}->{status} = 'timed out';
                $childs_wait{$i}->{success} = 0;

                $childs_wait{$i}->{tpp}->(
                    $childs_wait{$i}->{hash},
                    SUCC_FAIL,
                    $childs_wait{$i}->{args},
                    $childs_wait{$i}->{user_vars},
                    undef, undef );
                delete $childs_wait{$i}->{user_vars};

                #        $childs_wait{$i}->{user_vars}=$uv;
            } else {
                qlog
                    "CHLD NIL TPP entry [$childs_wait{$i}->{hash} $childs_wait{$i}->{type}]\n",
                    LOG_DEBUG;
            }
            delete $childs_wait{$i};
        }
    }
}    # rcv_from_childs

#####################################################################
#
# Queues answer to parent.
# args: to     - to whom we answer
#       hash   - hash
#       type   - type of answer
#       succ   - success flag
#       params - % of parameters
#
# ret:  NONE
#
#####################################################################
sub answer_to_parent($$$$;@ ) {

    #
    my ( $to, $h, $type, $succ, %params ) = @_;
    my ( $e, %new, $i, $tmp );

    if ( $to eq '' ) {
        my $cal = ( caller(1) )[3];
        qlog "EMPTY TO! $cal\n", LOG_ERR;
        return;
    }
    qlog "ANSWER_TO_PARENT $to; $type; $h; "
        . ( caller(1) )[3] . ";"
        . ( caller(2) )[3]
        . "\n", LOG_DEBUG;

  #[".join(';',keys(%params))."][".join(';',values(%params))."]\n", LOG_DEBUG;
    $e = {
        'to'      => $to,
        'type'    => $type,
        'hash'    => $h,
        'success' => $succ };
    %new = ( %{$e}, %params );
    %{$e} = %new;
    foreach $i ( keys(%params) ) {
        next if $i eq 'to';
        $e->{$i} = pack_value( $e->{$i} );
        qlog( "Packed $i to '$e->{$i}'\n", LOG_DEBUG ) if $debug{pc};
    }
    push @for_parent, $e;
}    # answer_to_parent

#####################################################################
#
# Sends all queued answers to parent
# args: NONE
#
# ret:  NONE
#
#####################################################################
sub flush_to_parent() {
    my ( $to, $type, $hash, $i, $n, $cur );

    for $cur (@for_parent) {
        if ( $cur->{to} eq $cluster_name ) {
            $cur->{_from} = $cluster_name;
            $cur->{_to}   = $cur->{to};
            $cur->{_type} = $cur->{type};
            $cur->{_hash} = $cur->{hash};

            delete $cur->{to};
            delete $cur->{type};
            delete $cur->{hash};
            qlog "<==! $cluster_name $cur->{_type}($cur->{_hash})\n",
                LOG_INFO;
            qlog "SENT: "
                . join( ';', map {"$_:=$cur->{$_}"} keys(%$cur) )
                . "\n", LOG_DEBUG2;

            push @answers_to_self, $cur;
            next;
        }


        ( $to, $type, $hash ) = ( $cur->{to}, $cur->{type}, $cur->{hash} );

        delete $cur->{to};
        delete $cur->{type};
        delete $cur->{hash};

        if ( defined $up_ch ) {
            $up_ch->send( "\*$cluster_name:$to:$hash\n$type\n" );

            #      qlog "SENT:\*$cluster_name:$to:$hash [$type]\n", LOG_DEBUG;
            qlog "<=== $to $type($hash)\n", LOG_INFO;
            qlog ("SENT: "
                . join( ';', map {"$_:=$cur->{$_}"} keys(%$cur) )
                . "\n", LOG_DEBUG2) if $debug{cs};
            foreach $i ( keys( %{$cur} ) ) {

                $up_ch->send( "$i: $cur->{$i}\n" );
            }
            $up_ch->send( "end\n" );
        } else {
            qlog
                "I must to send a message to GOD! ($cur->{to})($cur->{type}) dropped.\n",
                LOG_ERR;
            return;
        }
    }
    @for_parent = ();
}    # flush_to_parent

#####################################################################
#
# Add handler of parent messages
# args: type     - type of requests
#       handler  - the subroutine
#
# ret:  NONE
#
#####################################################################
sub register_parent_rcv( $$ ) {
    my ( $type, $handler ) = @_;
    push @{ $parent_recievers{$type} }, $handler;
}    # register_parent_rcv

#####################################################################
#
# Remove handler of parent messages
# args: type     - type of requests
#       handler  - the subroutine
#
# ret:  NONE
#
#####################################################################
sub unregister_parent_rcv( $$ ) {
    my ( $type, $handler ) = @_;
    my $i;
    for ( $i = 0; $i <= scalar( @{ $parent_recievers{$type} } ); ++$i ) {
        if ( $parent_recievers{$type}[$i] eq $handler ) {
            splice( @{ $parent_recievers{$type} }, $i, 0 );
            last;
        }
    }
}    # unregister_parent_rcv

#####################################################################
#
# Receives messages from parent.
# args: NONE
#
# ret:  NONE
#
#####################################################################
sub rcv_from_parent() {
    my ( @outs, $from, $type, $tmp, $to, $hash, $i, $args, %p_args, @x, %x );
    my $unpacked;
    my %to;
    my @messages;

    unless ( ( defined($up_ch_select) )
            or ( scalar(@messages_to_self) > 0 ) ){
        select(undef,undef,undef,0.1);
        return;
    }
    if ( defined $up_ch_select && $up_ch_select->can_read(0.01) ) {
        for ( ;; ) {

            # Read the message block
            my %e;
            $args = \%e;
            $hash = get_parsed_block_x( $up_ch, $args );

            last if ( ( $hash eq '-' ) or ( $hash eq '' ) );
            push @messages, $args;
        }
    }

    for $args ( @messages_to_self, @messages ) {
        ( $from, $to, $type, $hash ) =
            ( $args->{_from}, $args->{_to}, $args->{_type}, $args->{_hash} );

        delete $args->{_from};
        delete $args->{_to};
        delete $args->{_hash};
        delete $args->{_type};

        qlog "The message from $from to $to ($type)\n", LOG_INFO;

        %to = ();
        map { $to{$_} = 1; } split( ',', $to );
        %p_args = %$args;
        if ( exists( $to{$cluster_name} ) ) {

            #Yahoo! A message for me!

            qlog "FOR me! (" . join( ",", keys(%to) ) . ")\n", LOG_DEBUG;
            foreach $tmp ( keys(%$args) ) {
                qlog( "Unpacking $tmp\n", LOG_DEBUG ) if $debug{pc};
                unpack_value( \$unpacked, $args->{$tmp} );
                $args->{$tmp} = $unpacked;
            }
            if ( ref( $parent_recievers{$type} ) eq 'ARRAY' ) {
                for (
                    $i = 0;
                    $i < scalar( @{ $parent_recievers{$type} } );
                    ++$i
                    ) {
                    qlog "checking '$type/$i' for code...\n", LOG_DEBUG;
                    if ( ref( $parent_recievers{$type}[$i] ) eq 'CODE' ) {
                        qlog "Yes! call it! ($type,$hash,$from)\n", LOG_DEBUG;
                        $parent_recievers{$type}[$i]
                            ->( $type, $hash, $from, $args );
                    } else {
                        qlog "No code for $type,$hash,$from. Its "
                            . ref( $parent_recievers{$type}[$i] )
                            . "\n", LOG_WARN;
                    }
                }
            } else {
                qlog "No handler for parent request '$type'\n", LOG_ERR;
            }
        }
        delete $to{$cluster_name};
        if (%to) {

            # Forward it down!
            my ( $ch, @dest, $grch, $t );
            qlog "_FORWARD down (" . join( ';', keys(%to) ) . ")\n",
                LOG_DEBUG;

            foreach $ch ( @{ $clusters{$cluster_name}->{childs} } ) {
                $grch = join( ' ', @{ $child_aliases{$ch} } );
                @dest = ();
                foreach $t ( keys(%to) ) {
                    qlog "testing $t in $grch\n", LOG_DEBUG;
                    if ( $grch =~ m/\b$t\b/ ) {
                        push @dest, $t;
                        ++$to{$t};
                    }
                }
                if ( $#dest >= 0 ) {
                    qlog "+++ '$grch <- $to'\n", LOG_DEBUG;
                    if ( $down_ch{$ch} ) {
                        $t = join( ",", @dest );
                        qlog "Forwarding to '$ch' for '$t'\n", LOG_DEBUG;
                        $down_ch{$ch}->send(
                            "*" . "$from:$t:$hash\n" );
                        $down_ch{$ch}->send( "$type\n" );
                        for $t ( keys(%p_args) ) {
                            qlog "Forwarding: $t [$p_args{$t}]\n", LOG_DEBUG;
                            $down_ch{$ch}->send(
                                "$t: $p_args{$t}\n" );
                        }
                        $down_ch{$ch}->send( "end\n" );

                        #                last;
                    }
                }
            }
            foreach $t ( keys(%to) ) {
                qlog( "No such subcluster to forward! '$t'\n", LOG_WARN )
                    if ( $to{$t} < 2 );
            }
        }
    }    # messages reading loop
    @messages_to_self = ();
    %p_args           = ();
}    # rcv_from_parent

sub kill_mons() {
    my ( $i, %e );
    new_req_to_mon( 'exit', \%e, '__all__', SUCC_ANY | SUCC_OK,
        \&nil_sub, undef, 1, \&nil_sub );
    flush_to_mons();
}

#####################################################################
#
# Gets the block from handle and returns a hash with arguments
#  In result hash '_from','_to','_hash','_type' are special
#
# args: handle
#       return_hash_ref   (\%ret)
# ret:  ''   - no more blocks
#       '-'  - an error occured
#       other- the hash of this block
#
#####################################################################
sub get_parsed_block_x( $$ ) {
    my ( $handle, $out ) = @_;

    my ( $o, $type, $from, $to, $tmp, $hash, $i );

    $o = get_block_x($handle);
#    qlog ">>>" . join( ';', @$o ) . "<<<\n" if $debug{aa} and defined $o;

    return '-' unless defined $o;
    return ''  unless ( scalar(@$o) != 0 );

    if ( scalar(@$o) == 1 ) {
        qlog "Strange end of message... [$#$o] Skipping.\n", LOG_ERR;
        qlog join( ";;", @$o ) . "\n", LOG_ERR;
        @$o = ();
        return '-';
    }
    chomp @$o;

    # Check it...
    $tmp = shift @$o;
    ( $from, $to, $hash ) = ( $tmp =~ /^\*([^:]+)\s*:([^:]+)\s*:(\S+)$/ );
    unless ( $from && $to ) {
        qlog "Strange message. No from or to. ($o->[0]) Skipping.\n", LOG_ERR;
        qlog join( ";;", @$o ) . "\n", LOG_ERR;
        @$o = ();
        return '-';
    }

    # Get the type
    $type = shift @$o;

    qlog( "Message from $from to $to <$type> ($hash)\n", LOG_DEBUG )
        unless ( $_d_nolog_type{$type} );
    foreach $i (@$o) {
        next unless ( $i =~ /^([^:]+)\s*:\s*(.*?)\s*$/ );
        if ( $1 eq '' ) {
            qlog( "Bad line: '$i'\n", LOG_WARN );
            next;
        }
        $out->{$1} = $2;
    }
    $out->{_from} = $from;
    $out->{_to}   = $to;
    $out->{_hash} = $hash;
    $out->{_type} = $type;
    @$o           = ();
    return $hash;
}    # get_parsed_block_x

sub def_timeout_child_proc() {
    qlog "TIMED OUT CHILD\n", LOG_INFO;
}

sub def_timeout_mon_proc() {
    qlog "TIMED OUT MON\n", LOG_INFO;
}

######################################################################
#
#
#
#   MONITOR HANDLERS
#
#
######################################################################
######################################################################
######################################################################
######################################################################
######################################################################

######################################################################
#
#  Head
#
#  Handler for 'attach' answer from monitor
#
######################################################################
sub mon_attach_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    qlog "Attach comleted! ($args->{status}) id=$args->{id}\n", LOG_INFO;
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'ping' answer from monitors
#
######################################################################
sub mon_ping_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    if ( $args->{status} eq 'timed out' ) {
        return;
    }

    #  $mons{$from}->{last_response}=$last_time;
    qlog( "!!! $from pong\n", LOG_DEBUG ) unless ( $_d_nolog_type{'ping'} );
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'run' answer from monitors (answer for 'run' request)
#
######################################################################
sub mon_run_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

#    qlog "ABC: 2\n", LOG_DEBUG;
    if ( defined( $mons{$from} ) ) {
        if ( $args->{status} eq 'timed out' ) {
            qlog "RUN TIMED OUT ($from,$args->{id})!!!\n", LOG_ERR;

       #!!!! TODO: send cancel to monitors, warning, send notify to task owner
            my %del_arg = (
                'id'       => $args->{id},
                'user'     => 0,
                'mask'     => '',
                'userlist' => '',
                'rmask'    => '',
                'force'    => 1 );
            new_req_to_child(
                'del_local',        \%del_arg,
                $args->{owner},     0,
                SUCC_ANY | SUCC_OK, \&nil_sub,
                \&every_nil_sub,    1,
                \&nil_sub );
        } else {
#            qlog "ABC1\n", LOG_DEBUG;
            if ($succ) {
                if ( $args->{owner} eq 'main' ) {
                    if ( !exists $childs_info{ $args->{id} } ) {
                        qlog "Rsh runned for already dead task. Kill it.\n",
                            LOG_WARN;
                        my %req = (
                            'id'    => $args->{id},
                            'owner' => $args->{owner} );
                        new_req_to_mon( 'kill', \%req, $from,
                            SUCC_ANY | SUCC_OK,
                            \&nil_sub, undef, 0, \&nil_sub );
                        return $user_v;
                    }
                }

                if ( $args->{is_rsh} ) {
                    $rsh_pids{"$args->{id}::$args->{owner}"}
                        ->{"$from::$ret_args->{pid}"} = $args->{pid};
                    qlog
                        "rsh $args->{id}::$args->{owner} runned on $from $ret_args->{pid} ($args->{pid})\n",
                        LOG_INFO;
                } else {
                    my %run_arg = ( 'id' => $args->{id} . 'node' => $from );
                    qlog "Run $args->{id} [$args->{owner}] succesfull\n",
                        LOG_INFO;
                    new_req_to_child(
                        'run',              \%run_arg,
                        $args->{owner},     0,
                        SUCC_ANY | SUCC_OK, \&nil_sub,
                        \&every_nil_sub,    1,
                        \&nil_sub );

                    #$childs_info{$args->{id}}->{timelimit}+=$last_time;
                    #$childs_info{$args->{id}}->{time}=$last_time;
                    #dump_queue();
                }
            } else {    # NOT successfully
                unless ( $args->{is_rsh} ) {
                    $childs_info{ $args->{id} }->{special} .= " run failed";
                    del_task( $args->{id}, '__internal__' );
                }
            }
        }

        #    $mons{$from}->{last_response}=$last_time;
    } else {
        unless ( $args->{status} eq 'timed out' ) {
            qlog "Unexpected RUNNED from $from\n", LOG_ERR;
        }
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'internal_info' answer from monitors
#
######################################################################
sub mon_every_int_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    my @tasks;
    my $i;

    qlog "internal data from $from\n", LOG_INFO;
    if ( $args->{status} ne 'timed out' ) {

        #    $mons{$from}->{last_response}=$last_time;

#        block_pe( $from, 0, 0, "Not connected yet" );
        # initial data gathering?
        if ( $run_fase > 0 ) {
            @tasks = split( /\#/, $ret_args->{val} );
            foreach $i (@tasks) {
                if ( $i =~ /id:(\d*)\sowner:(\S*)\sis_rsh:(\S*)\spid:(\d*)/ ) {
                    qlog
                        "MON::::::: $from; id=$1, owner=$2, is_rsh=$3, pid=$4\n",
                        LOG_DEBUG;
                    $__by_mons{$from}->{$2}->{$1} = $4;

                    #        $__rsh{$from}->{$4}->{id}     = $1;
                    #        $__rsh{$from}->{$4}->{owner}  = $2;
                    #        $__rsh{$from}->{$4}->{is_rsh} = $3;
                } elsif ( $i =~ /ver:\s*(\S+)/ ) {
                    qlog "mon_ver $from = $1\n", LOG_INFO;
                    $mons{$from}->{ver} = $1;
                } else {
                    qlog "Bad string in internal state of $from: '$i'\n",
                        LOG_WARN;
                    next;
                }

            }
        }
    }
    return $user_v;
}    # ~mon_every_int_handler

######################################################################
#
#  Head
#
#  Handler for 'internal_info' answer from monitors
#
######################################################################
sub mon_int_info_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;
    my ( $pid, $node, $q, $id, %by_own_copy, $i );

#  qlog "Finished collecting data from monitors! (".join(';',sort(keys(%__rsh))).")\n";
    if ( $run_fase > 0 ) {
        qlog "Finished collecting data from monitors!\n", LOG_INFO;
        foreach $q ( keys(%by_owner) ) {
            foreach $id ( keys( %{ $by_owner{$q} } ) ) {
                foreach $node ( keys( %{ $by_owner{$q}->{$id} } ) ) {
                    $by_own_copy{$q}->{$id}->{$node} =
                        $by_owner{$q}->{$id}->{$node};
                }
            }
        }

        foreach $node ( keys(%__by_mons) ) {
            foreach $q ( keys( %{ $__by_mons{$node} } ) ) {
                foreach $id ( keys( %{ $__by_mons{$node}->{$q} } ) ) {
                    if ( exists( $by_owner{$q}->{$id} ) ) {
                        if ( exists( $by_owner{$q}->{$id}->{$node} ) ) {
                            delete $by_own_copy{$q}->{$id}->{$node};
                            qlog "Monitor $node confirms task $id on $q.\n",
                                LOG_INFO;
                        }
                    } else {
                        qlog
                            "Warning! Monitor $node executes dead task ($id on $q). DELETING\n",
                            LOG_WARN;

#OLD!!!            my %req=('pid'=>$__by_mons{$node}->{$q}->{$id});
#OLD!!!            new_req_to_mon('kill_pid',\%req,$node,
#OLD!!!                           SUCC_ANY|SUCC_OK,\&nil_sub,undef,0,\&nil_sub);
                        my %req = ( 'id' => $id, 'owner' => $q );
                        new_req_to_mon( 'kill', \%req, $node,
                            SUCC_ANY | SUCC_OK,
                            \&nil_sub, undef, 0, \&nil_sub );

                    }
                }
            }
        }
        foreach $q ( keys(%by_own_copy) ) {
        MON_INT_H_LOOP:
            foreach $id ( keys( %{ $by_own_copy{$q} } ) ) {
                foreach $node ( keys( %{ $by_own_copy{$q}->{$id} } ) ) {
                    qlog "Task $id on $q is not running on $node. DELETING\n",
                        LOG_WARN;
                    new_req_to_child(
                        'del_local',
                        { 'id' => $id, 'user' => '__internal__' },
                        $q,
                        0,
                        SUCC_ALL | SUCC_OK,
                        \&chld_del_loc_handler,
                        \&chld_every_del_loc_handler,
                        get_setting('intra_timeout'),
                        \&chld_del_loc_handler );
                    last MON_INT_H_LOOP;
                }
            }
        }

        $run_fase = 0;
        $may_go   = 1;
        qlog "Start real work! version $VERSION ($VARIANT)\n", LOG_ALL;
        new_req_to_child(
            'start', {}, '__ALL__', 1,
            SUCC_ALL | SUCC_OK, \&nil_sub, \&every_nil_sub, 0,
            \&nil_sub );
        undef %__by_mons;
        undef %by_own_copy;

        #    undef %__tasks;
        #    undef %__rsh;
    } else {

        # monitor is just returned from down state
        # check if dead tasks are runned here...

        qlog "Got internal data from $from.\n", LOG_DEBUG;
        my @tasks = split( /\#/, $ret_args->{val} );
        my %mon_ids=();
        foreach $i (@tasks) {
            if ( $i =~ /id:(\d+)\sowner:(\S+)\sis_rsh:(\S+)\spid:(\d+)/ ) {
                next if(exists $mon_ids{"$1:$2"});
                $mon_ids{"$1:$2"}=1;
                qlog "INT_STATE $from: id=$1, owner=$2, is_rsh=$3, pid=$4\n",
                    LOG_DEBUG;
                new_req_to_child('test_id', { 'id' => $1 },
                                 $2,0,
                                 SUCC_ALL | SUCC_OK, \&chld_test_id1,
                                 \&every_nil_sub, get_setting('intra_timeout'),
                                 \&chld_test_id1, 'mon' => $from );

            } elsif ( $i =~ /ver:\s*(\S+)/ ) {
                #qlog "mon_ver $from = $1\n", LOG_INFO;
                #$mons{$from}->{ver} = $1;
            } else {
                qlog "Bad string in internal state of $from: '$i'\n",
                    LOG_WARN;
                next;
            }
        }
    }

    # remove "timed out" block
#    block_pe( $from, 0, 0, "Timed out", "Not connected yet" );

    return $user_v;
}    # ~mon_int_handler

######################################################################
#
#  Head
#
#  Handler for 'run' answer from monitors
#
######################################################################
sub mon_every_run_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    if ( $args->{status} ne 'timed out' ) {

        #    $mons{$from}->{last_response}=$last_time;
        if ( $succ == SUCC_OK ) {
            qlog ">>> $from runned!\n", LOG_DEBUG;
        } else {
            qlog ">>> $from run failed!\n", LOG_DEBUG;
        }
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'kill' answer from monitors
#
######################################################################
sub mon_every_kill_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    if ( $args->{status} ne 'timed out' ) {

        #    $mons{$from}->{last_response}=$last_time;
        qlog ">>> $from kill!\n", LOG_DEBUG;
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'kill' answer from monitors (answer for 'kill' request)
#
######################################################################
sub mon_kill_handler($$$$$$ ) {
    my ( $hash, $succ, $a, $user_v, $from, $ret_args ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args

#    qlog "ABC: 3\n", LOG_DEBUG;
    if ( $args->{status} eq 'timed out' ) {
        qlog
            "KILL TIMED OUT ($from)!!! Now kill this task ($args->{id}/$args->{owner}) anyway...\n",
            LOG_WARN;
    } else {
        if ( $succ == SUCC_OK ) {
            qlog "Kill $args->{id}/$args->{owner} succesfull\n", LOG_INFO;
        } else {
            qlog "Kill $args->{id}/$args->{owner} failed\n", LOG_INFO;
        }
    }

    if ( $args->{owner} eq cleosupport::get_setting('root_cluster_name') ) {
        push @dead, $args->{id};
    } else {
#        qlog "ABC2 '$args->{owner}'\n", LOG_DEBUG;
        $args->{success} = $succ;
        new_req_to_child(
            'del_mon_task',     $args,     $args->{owner},  0,
            SUCC_ANY | SUCC_OK, \&nil_sub, \&every_nil_sub, 1,
            \&nil_sub );
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'init_attach' answer from monitor
#
######################################################################
sub mon_init_attach_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $a, $user_v, $from, $ret_args ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args

    my @nodes;
    delete $args->{exe_mask};
    delete $args->{parent_mask};
    #delete $args->{user};

    qlog "Init_attach finished... id=$user_v->{id}\n", LOG_DEBUG2;
    if ( $args->{status} eq 'timed out' ) {
        qlog "WARNING! Some nodes timed out!\n", LOG_WARN;
    }
    $args->{id} = $user_v->{id};
#    qlog "UV: "
#        . join( ':', keys(%$user_v) ) . "#"
#        . join( ':', values(%$user_v) )
#        . "\n", LOG_DEBUG;
    $args->{tmout} = get_setting('attach_tmout');
    $args->{all}   = 1;
    if ( $user_v->{owner} eq cleosupport::get_setting('root_cluster_name') ) {
        if ( !defined $childs_info{ $user_v->{id} } ) {
            qlog
                "Init_attach for id=$user_v->{id} finished. But task is already dead. Skip it.\n",
                LOG_INFO;
            return $user_v;
        }

        $args->{owner} = $user_v->{owner};
        @nodes = split( /\,/, $user_v->{nodes} );

        if(cleosupport::execute_task( $childs_info{ $user_v->{id} })<0){
            #execution failed

            new_req_to_mon(
                'kill',
                $args,
                \@nodes,
                SUCC_ALL | SUCC_OK,
                \&main::mon_kill_handler,
                undef,
                cleosupport::get_setting('mon_timeout'),
                \&main::mon_kill_handler );
            return $user_v;
        }

        new_req_to_mon(
            'attach',                       $args,
            \@nodes,                        SUCC_ALL | SUCC_OK,
            \&mon_attach_handler,           undef,
            get_setting('mon_timeout'), \&mon_attach_handler );
    } else {
        new_req_to_child(
            'attach',              $args,
            $user_v->{owner},      0,
            SUCC_ANY | SUCC_OK,    \&chld_attach_handler,
            \&every_nil_sub,       get_setting('intra_timeout'),
            \&chld_attach_handler, 'nodes',
            $user_v->{nodes} );
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for notifys from monitors
#
######################################################################
sub mon_message_process($$$$ ) {
    my ( $what, $from, $status, $args ) = @_;

    my %answer;
    my $filter_alive = 1;

    if ( $what eq 'run_sh' ) {    # new_rshell
    FILTER_COMM:
        {
            my %args2 = %$args;
            $args2{is_rsh} = 1;

            filter_rsh( \%args2 );

            if ( $args2{rsh_host} eq '' ) {
                qlog "EMPTY HOST in rsh!!! [$args2{rsh_string}]\n", LOG_WARN;
            } else {
                qlog
                    "Node requested: $args2{rsh_host}; RUN: '$args2{com_line}'\n";

                # check if number of processors is not exhausted
                if ( $rsh_data{"$args2{id}::$args2{owner}"}->{"np_free"} < 0 )
                {
                    qlog
                        "EXTRA PROCESSOR IS REQUESTED BY $from for $args2{id}::$args2{owner}. Fail\n",
                        LOG_ERR;
                } else {

                    # check if this host is allowed
                    my $found = 0;
                    foreach my $node (
                        @{ $rsh_data{"$args2{id}::$args2{owner}"}->{nodes} } )
                    {
                        if ( $node eq $args2{rsh_host} ) {
                            $found = 1;
                            last;
                        }
                    }

                    if ($found) {

                        # host is allowed

                        qlog "REQUESTING3: $args2{com_line}\n", LOG_DEBUG;
                        main::new_req_to_mon(
                            'run',
                            \%args2,
                            $args2{rsh_host},
                            SUCC_ALL | SUCC_OK,
                            \&main::mon_run_handler,
                            undef,
                            cleosupport::get_setting('mon_timeout'),
                            \&main::mon_run_handler );
                        --$rsh_data{"$args2{id}::$args2{owner}"}->{"np_free"};
                    } else {
                        qlog
                            "BAD node requested by $from : $args2{rsh_host} for $args2{id}::$args2{owner}.\n",
                            LOG_ERR;
                        qlog "Allowed nodes are: "
                            . join(
                            ';',
                            @{  $rsh_data{"$args2{id}::$args2{owner}"}
                                    ->{nodes} } )
                            . "\n", LOG_ERR;
                    }
                }
            }
        }

        #!!! end OLD/NEW code
    }

    #
    #   FINISHED
    #
    elsif ( $what eq 'finished' ) {    # the task or rshell ended
            #     if (defined $childs_info{$args->{id}}) {
        if (1) {
            finished_from_mon_processor($args,$from);
        } else {
            if ( $args->{is_rsh} ne '' ) {

                #
                #  RSH FINISHED
                #
                my $pid =
                    $rsh_pids{"$args->{id}::$args->{owner}"}
                    ->{"$from::$args->{pid}"};
                qlog
                    ">Pseudo-rsh finished ($args->{id}::$args->{owner}) $pid\n",
                    LOG_INFO;
                qlog ">master node is "
                    . $rsh_pids{"$args->{id}::$args->{owner}"}->{master}
                    . "\n", LOG_DEBUG;
                my %req = (
                    'pid'       => $pid,
                    'wait_secs' => get_setting('wait_secs_to_kill_base_rsh')
                );

                # kill 'base' rshell process
                new_req_to_mon(
                    'kill_pid', \%req,
                    $rsh_pids{"$args->{id}::$args->{owner}"}->{master},
                    SUCC_ANY | SUCC_OK,
                    \&nil_sub, undef, 0, \&nil_sub );

                #and all others too...
                return;
            }
            if (1)
            { # or (defined $childs_info{$args->{id}} && !is_in_list($args->{id},\@dead))) {
                qlog
                    "FINished task $args->{id}::$args->{owner} on $from with code $args->{code}\n",
                    LOG_INFO;
                if (defined(
                        $rsh_pids{"$args->{id}::$args->{owner}"}->{master} )
                    ) {

                    #
                    #  Delete all 'bored' rshell processes...
                    #
                    qlog "Kill child rsh\n", LOG_DEBUG;
                    foreach my $i (
                        keys( %{ $rsh_pids{"$args->{id}::$args->{owner}"} } )
                        ) {
                        $i =~ /^\S+::\S+$/;
                        next if ( $1 eq '' );
                        my %req = (
                            'pid'       => $2,
                            'wait_secs' =>
                                get_setting('wait_secs_to_kill_base_rsh') );
                        new_req_to_mon( 'kill_pid', \%req, $1,
                            SUCC_ANY | SUCC_OK,
                            \&nil_sub, undef, 0, \&nil_sub );
                    }
                    delete $rsh_pids{"$args->{id}::$args->{owner}"};
                }
                qlog join( ';', %$args, "\n" ), LOG_DEBUG;
                $answer{id} = $args->{id};
                if ( $args->{owner} eq
                    cleosupport::get_setting('root_cluster_name') ) {

                    # our task is dead (one of its nodes)...
                    $childs_info{ $args->{id} }->{status} = $args->{code}
                        if exists $childs_info{ $args->{id} };
                    task_node_dead( $args->{id}, $from );
                    } else {
                    qlog "!!! ($args->{owner})\n", LOG_DEBUG;
                    $answer{id}   = $args->{id};
                    $answer{node} = $from;
                    $answer{code} = $args->{code};
                    new_req_to_child(
                        'finished',         \%answer,
                        $args->{owner},     0,
                        SUCC_ANY | SUCC_OK, \&nil_sub,
                        \&every_nil_sub,    0,
                        \&nil_sub );
                }
            } else {
                qlog
                    "Another finished from $from for $args->{id}::$args->{owner}\n",
                    LOG_DEBUG;
            }
        }
    } else {
        qlog "Unexpected message from $from ($what)\n", LOG_ERR;
    }
    return;
}    # ~mon_message_process

######################################################################
#
#
#   CHILDS ANSWERS HANDLERS
#
#
######################################################################
######################################################################
######################################################################
######################################################################
######################################################################

######################################################################
#
#  Head
#
#  Handler for 'test_id' child answer. For mon raise back procedure.
#
######################################################################
sub chld_test_id1($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $a, $user_v, $from, $ret_args ) = @_;

    if ( $a->{status} eq 'timed out' ) {
        qlog "test_id request for $a->{id} to $from timed out\n", LOG_ERR;
        return;
    }

    if ( $succ == SUCC_OK ) {
        qlog "test_id $from::$a->{id} -> yes.\n", LOG_DEBUG;
        return;
    } else {
        qlog "test_id $from::$a->{id} -> NO.\n", LOG_DEBUG;

        # delete this task on monitor!!!
        main::new_req_to_mon(
            'kill',
            { 'id' => $a->{id}, 'owner' => $from },
            $user_v->{mon},
            SUCC_ALL | SUCC_OK,
            \&mon_kill_handler,
            undef,
            cleosupport::get_setting('mon_timeout'),
            \&mon_kill_handler );
    }
}

######################################################################
#
#  Head
#
#  Handler for 'attach' pseudo-request from childs
#
######################################################################
sub chld_attach_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $a, $user_v, $from, $ret_args ) = @_;
    my $args  = Storable::thaw( Storable::freeze($a) );    # clone args
    my $nodes = $args->{nodes};
    my @nodes = split( /\,/, $user_v->{nodes} );

    if ( $args->{status} eq 'timed out' ) {
        qlog "Attach request to $from timed out\n", LOG_ERR;
        return;
    }

    qlog "Attach2 $args->{id}.\n", LOG_DEBUG2;
    $args->{lastowner} = $from;
    if ( $args->{owner} eq '' ) {
        $args->{owner} = $from;
    }
    $args->{all}   = 1;
    $args->{tmout} = get_setting('attach_tmout');

    new_req_to_mon(
        'attach', $args, \@nodes, SUCC_ALL | SUCC_OK,
        \&mon_attach_handler, undef, get_setting('mon_timeout'),
        \&mon_attach_handler );
}

######################################################################
#
#  Head
#
#  Handler for 'autoblock' answer from childs
#
######################################################################
sub chld_ablock_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    my $out;

    qlog "AUTOBLOCK: ($args->{status})\n", LOG_INFO;
    if ( $args->{queue} eq $cluster_name ) {
        $out =
            &cleosupport::autoblock( $args->{users}, $args->{val},
            $args->{username} );
        $out = substr( $out, 1 ) . "\n";
    } else {
        $out = $user_v->{answers}->{ $args->{queue} };
    }

    if ( $args->{status} eq 'timed out' ) {
        if ( $args->{queue} eq $cluster_name ) {
            $user_v->{channel}->send(
                "+ok\n$out\nFailed for some queues. May be they have troubles?\n"
            );
            $user_v->{channel}->disconnect;
        } else {
            qlog "AUTOBLOCK: Failed for childs\n", LOG_WARN;
            $user_v->{channel}->send(
                "-fail\nFailed for $args->{queue}. May be there are troubles?\n"
            );
            $user_v->{channel}->disconnect;
        }
    }    # ~timed out
    else {
        $out .= &glue_queues_replies( $args->{queue}, $user_v->{answers} );
        qlog "ABLOCK: OK!\n", LOG_INFO;
        $user_v->{channel}->send( "+ok\n$out\n" );
        $user_v->{channel}->disconnect;
    }
}
######################################################################
#
#  Head
#
#  Handler for every 'autoblock' answer from childs
#
######################################################################
sub chld_every_ablock_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    qlog "EVERY_AUTOBLOCK: $from ($args->{status})\n", LOG_INFO;
    if ( $succ == SUCC_OK ) {
        $user_v->{answers}->{$from} = substr( $ret_args->{data}, 1 ) . "\n";
    } else {
        $user_v->{answers}->{$from} =
            "Queue: $from\nFailed. Reason: $ret_args->{reason}\n";
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'view' answer from childs
#
######################################################################
sub chld_view_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    my $out;

    qlog "VIEW: ($args->{status})\n", LOG_INFO;
    if ( $args->{queue} eq $cluster_name ) {
        $out = get_task_list_w_flags( $args->{user}, $args->{flags} );
    } else {
        $out = $user_v->{answers}->{ $args->{queue} };
    }

    if ( $args->{status} eq 'timed out' ) {
        if ( $args->{queue} eq $cluster_name ) {
            $user_v->{channel}->send(
                      "+ok\n$out\n"
                    . "No info available about other queues. May be they have troubles?\n"
            );
            $user_v->{channel}->disconnect;
        } else {
            qlog "VIEW: Failed on childs\n", LOG_WARN;
            $user_v->{channel}->send(
                "-fail\nNo info available about $args->{queue}. May be there are troubles?\n"
            );
            $user_v->{channel}->disconnect;
        }
    }    # ~timed out
    else {
        $out .= &glue_queues_replies( $args->{queue}, $user_v->{answers} );
        qlog "VIEW: OK!($args->{queue})\n", LOG_INFO;
        $user_v->{channel}->send("+ok\n$out\n" );

        $user_v->{channel}->disconnect;
    }
}
######################################################################
#
#  Head
#
#  Handler for every 'view' answer from childs
#
######################################################################
sub chld_every_view_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    qlog "EVERY_VIEW: $from ($args->{status})\n", LOG_INFO;
    if ( $succ == SUCC_OK ) {
        $user_v->{answers}->{$from} = $ret_args->{data};

        #    qlog "EVERY_VIEW: '$ret_args->{data}'\n", LOG_DEBUG;
    } else {
        $user_v->{answers}->{$from} =
            "Queue: $from\nNo info available. Reason: $ret_args->{reason}\n";
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'mode' answer from childs
#
######################################################################
sub chld_mode_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    my $out;

    qlog "MODE: ($args->{status})[" . join( ':', %$user_v ) . "]\n", LOG_INFO;
    if ( $args->{queue} eq $cluster_name ) {
        $out =
            "Queue $cluster_name: "
            . &new_mode( $args->{user}, $args->{set}, $args->{clear} );
        qlog "OUT NOW: $out", LOG_DEBUG;
    }

    if ( $args->{status} eq 'timed out' ) {
        if ( $args->{queue} eq $cluster_name ) {
            $user_v->{channel}->send(
                      "+ok\n$out\n"
                    . "Not available mode of other queues. May be they have troubles?\n"
            );
            $user_v->{channel}->disconnect;
        } else {
            qlog "MODE: Failed on childs\n", LOG_WARN;
            $user_v->{channel}->send(
                "-fail\nMode failed for $args->{queue}. May be there are troubles?\n"
            );
            $user_v->{channel}->disconnect;
        }
    }    # ~timed out
    else {
        qlog "ANSWERS:" . join( ':', %{ $user_v->{answers} } ) . ";\n",
            LOG_DEBUG;
        foreach my $i ( keys( %{ $user_v->{answers} } ) ) {
            $out .= "Queue $i: $user_v->{answers}->{$i}";
            qlog "NEW OUT: $out", LOG_DEBUG;
        }
        qlog "MODE: OK!\n", LOG_INFO;
        $user_v->{channel}->send( "+ok\n$out\n" );
        $user_v->{channel}->disconnect;
    }
}
######################################################################
#
#  Head
#
#  Handler for every 'mode' answer from childs
#
######################################################################
sub chld_every_mode_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    qlog "EVERY_MODE: $from ($args->{status})\n", LOG_INFO;
    if ( $succ == SUCC_OK ) {
        $user_v->{answers}->{$from} = $ret_args->{data};
    } else {
        $user_v->{answers}->{$from} =
            "No mode info available. Reason: $ret_args->{reason}\n";
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'block_pe' answer from childs
#
######################################################################
sub chld_block_pe_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    my $out;

    #  $out=block_pe($args->{pe},$args->{val});
    qlog "BPE $args->{pe},$args->{val} [$out] ($args->{status})\n", LOG_INFO;

   #   send_to_channel($user_v->{channel},$out);
   #   if($args->{status} eq 'timed out'){
   #     send_to_channel($user_v->{channel},"Note: some queues timed out.\n");
   #   }
   #   kill_conn($user_v->{channel});
}

######################################################################
#
#  Head
#
#  Handler for 'block' answer from childs
#
######################################################################
sub chld_block_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    qlog "BLOCK: ($args->{status})\n", LOG_INFO;

    if ( $args->{status} eq 'timed out' ) {
        $user_v->{channel}->send(
            "-fail\nYour request timed out. May be you've mistyped queue name? Or we probably have internal troubles.\n"
        );
        $user_v->{channel}->disconnect;
    }    # ~timed out
    elsif ( $succ == SUCC_OK ) {
        $user_v->{channel}->send(
            "+ok\n" . unpack( 'u', $args->{reason} ) . "\n" );
        $user_v->{channel}->disconnect;
    } else {
        $user_v->{channel}->send(
            "-fail\n" . unpack( 'u', $args->{reason} ) . "\n" );
        $user_v->{channel}->disconnect;
    }
}

######################################################################
#
#  Head
#
#  Handler for 'priority' answer from childs
#
######################################################################
sub chld_pri_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    qlog "PRI: ($args->{status})\n", LOG_INFO;

    if ( $args->{status} eq 'timed out' ) {
        $user_v->{channel}->send(
            "-fail\nYour request timed out. May be you've mistyped queue name? Or we probably have internal troubles.\n"
        );
        $user_v->{channel}->disconnect;
    }    # ~timed out
    elsif ( $succ == SUCC_OK ) {
        $user_v->{channel}->send( "+ok\nDone.\n" );
        $user_v->{channel}->disconnect;
    } else {
        $user_v->{channel}->send( "-fail\n$args->{reason}\n" );
        $user_v->{channel}->disconnect;
    }
}

######################################################################
#
#  Head
#
#  Handler for 'attribute' answer from childs
#
######################################################################
sub chld_chattr_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    qlog "ATTR: ($args->{status})\n", LOG_INFO;

    if ( $args->{status} eq 'timed out' ) {
        $user_v->{channel}->send(
            "-fail\nYour request timed out. May be you've mistyped queue name? Or we probably have internal troubles.\n"
        );
        $user_v->{channel}->disconnect;
    }    # ~timed out
    elsif ( $succ == SUCC_OK ) {
        $user_v->{channel}->send( "+ok\n" );
        $user_v->{channel}->disconnect;
    } else {
        $user_v->{channel}->send( "-fail\n$args->{reason}\n" );
        $user_v->{channel}->disconnect;
    }
}

######################################################################
#
#  Head
#
#  Handler for 'init_attach' pseudo-request from childs
#
######################################################################
sub chld_init_attach_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $a, $user_v, $from, $ret_args ) = @_;
    my $args  = Storable::thaw( Storable::freeze($a) );    # clone args
    my $nodes = $args->{nodes};
    my @nodes = split( /\,/, $nodes );

    qlog "Init_attach $nodes;" . join( ':', %{$args} ) . ".\n", LOG_DEBUG;
    delete $args->{nodes};

    if ( $args->{parent_mask} eq '' ) {
        $args->{parent_mask} = '.*';
    }
    %$ret_args = ( 'owner', $from, 'nodes', $nodes );

    new_req_to_mon(
        'init_attach',                  $args,
        \@nodes,                        SUCC_ALL | SUCC_OK,
        \&mon_init_attach_handler,      undef,
        get_setting('mon_timeout'), \&mon_init_attach_handler,
        'owner',                        $from,
        'nodes',                        $nodes,
        'id',                           $args->{id},
        'tmout',                        6 );
}

######################################################################
#
#  Head
#
#  Handler for 'stop_task' pseudo-request from childs
#
######################################################################
sub chld_stop_task_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $a, $user_v, $from, $ret_args ) = @_;
    my $args  = Storable::thaw( Storable::freeze($a) );    # clone args
    my $nodes = $args->{nodes};
    my @nodes = split( /\,/, $nodes );

    qlog "Stop task on $nodes;" . join( ':', %{$args} ) . ".\n", LOG_INFO;
    delete $args->{nodes};

    %$ret_args = ( 'owner', $from, 'nodes', $nodes );

    new_req_to_mon(
        'stop_task',                    $args,
        \@nodes,                        SUCC_ALL | SUCC_OK,
        \&mon_stop_task_handler,        undef,
        get_setting('mon_timeout'), \&mon_stop_task_handler,
        'owner',                        $from,
        'nodes',                        $nodes,
        'id',                           $args->{id} );
}

######################################################################
#
#  Head
#
#  Handler for childs' notifys/requests
#
######################################################################
sub child_message_process( $$$$ ) {
    my ( $type, $from, $status, $e ) = @_;
    my $entry = Storable::thaw( Storable::freeze($e) );    # clone entry

    #
    #         RUN_VIA_MONS (child request)
    #
    if ( $type eq 'run_via_mons' ) {
        my ( %n, @nodes );
        my ( $i, $j, $n );

        qlog
            "$from requests $entry->{np} processors via mons (task $entry->{id})\n",
            LOG_DEBUG;

        foreach $i ( split( /\,/, $entry->{nodes} ) ) {
            ($n) = ( $i =~ /^([^:]+)/ );
            next if $n eq '';
            ++$n{$n};
        }
        @nodes = sort( keys(%n) );
        qlog "NODES: " . join( ';', @nodes ) . "\n", LOG_DEBUG;
        if (   $entry->{use_rsh_filter} eq ''
            or $entry->{use_rsh_filter} eq '0' ) {

            #
            #  NOT USING PSEUDO_RSHELLS
            #

            $rsh_data{"$entry->{id}::$entry->{owner}"}->{'master'} =
                $nodes[0];
            @{ $rsh_data{"$entry->{id}::$entry->{owner}"}->{'nodes'} } =
                @nodes;

            my $tmp = $entry->{com_line};
            foreach $i (@nodes) {
                for ( $j = 0; $j < $n{$i}; ++$j ) {
                    undef %subst_args if ( $entry->{second_run} eq '' );
                    $entry->{node}     = $i;
                    $entry->{com_line} = $tmp;
                    $entry->{n}        = $n{$i};
                    $entry->{nid}      = $j;
                    subst_task_prop( \$entry->{com_line}, $entry, 0, "" );
                    {
                        my %request = %$entry;
                        qlog "REQUESTING2($i): $request{com_line}\n",
                            LOG_DEBUG2;
                        main::new_req_to_mon(
                            'run',
                            \%request,
                            $i,
                            SUCC_ALL | SUCC_OK,
                            \&main::mon_run_handler,
                            undef,
                            cleosupport::get_setting('mon_timeout'),
                            \&main::mon_run_handler );
                    }
                }
            }
            } else {

            #
            #  USE PSEUDO_RSHELLS (Then run only on first node)
            #
            subst_task_prop( \$entry->{com_line}, $entry, 0, "" );
            main::new_req_to_mon(
                'run',
                $entry,
                $nodes[0],
                SUCC_ALL | SUCC_OK,
                \&main::mon_run_handler,
                undef,
                cleosupport::get_setting('mon_timeout'),
                \&main::mon_run_handler );

            $rsh_data{"$entry->{id}::$entry->{owner}"}->{"np_free"} =
                $entry->{np} - 1;
            $rsh_data{"$entry->{id}::$entry->{owner}"}->{"master"} =
                $nodes[0];
            @{ $rsh_data{"$entry->{id}::$entry->{owner}"}->{"nodes"} } =
                @nodes;
            qlog "ADD NODES for $entry->{id}::$entry->{owner}: "
                . join( ';', @nodes ) . "\n";

        }
        $rsh_pids{"$entry->{id}::$entry->{owner}"}->{master} = $nodes[0];
        qlog "Head node: $entry->{id}::$entry->{owner} =$nodes[0]\n",
            LOG_DEBUG;

        # ^^^^^^^  in BOTH cases!!!!!]

        $entry->{success} = SUCC_OK;
        new_req_to_child(
            $type,                 $entry,
            $from,                 0,
            SUCC_OK | SUCC_ANY,    \&main::nil_sub,
            \&main::every_nil_sub, 0,
            \&main::every_nil_sub );

        #
        #         DEL_MON_TASK (child request)
        #
    } elsif ( $type eq 'del_mon_task' ) {
        my ( %n, @nodes );
        my ( $i, $n );

        foreach $i ( split( ',', $entry->{mons} ) ) {
            ($n) = ( $i =~ /^([^:]+)/ );
            next if $n eq '';
            ++$n{$n};
        }
        @nodes = keys(%n);
        qlog "$from requests del on mons task $entry->{id} (nodes: "
            . join( ',', @nodes )
            . "/$entry->{mons};\n", LOG_DEBUG;

        $entry->{owner} = $from;
        main::new_req_to_mon(
            'kill',
            $entry,
            \@nodes,
            SUCC_ALL | SUCC_OK,
            \&main::mon_kill_handler,
            undef,
            cleosupport::get_setting('mon_timeout'),
            \&main::mon_kill_handler );

        sc_task_in( get_setting('wait_secs_to_kill_base_rsh') + 15,
            \&main::final_kill_mon_task, \@nodes, $entry->{owner},
            $entry->{id} );

        #
        #         INIT_ATTACH (child request)
        #
    } elsif ( $type eq 'init_attach' ) {

        #    qlog "2: ".join(':',%$entry)."\n";
        chld_init_attach_handler( undef, $status, $entry, undef, $from,
            undef );

        #
        #         STOP_TASK (child request)
        #
    } elsif ( $type eq 'stop_task' ) {
        chld_stop_task_handler( undef, $status, $entry, undef, $from, undef );

        #
        #         GOT (child request)
        #
    } elsif ( $type eq 'got' ) {
        chld_got_handler( undef, $status, $entry, undef, $from, undef );

        #
        #         CLEAN_TASK (child request)
        #
    } elsif ( $type eq 'clean_task' ) {
        chld_clean_task_handler( undef, $status, $entry, undef, $from,
            undef );

    } else {
        qlog "Unsupported message from child... '$type'\n", LOG_ERR;
    }
}    #~child_message_process

######################################################################
#
#  Head
#
#  Handler for 'got' answer from childs
#
######################################################################
sub chld_got_handler($$$$$$ ) {
    my ( undef, $succ, $args, undef, $from, undef ) = @_;

    my ( $i, $id, $our_id, @list, $e, $runflag );

    $id   = $args->{id};
    @list = split( /\,/, $args->{nodes} );

    $our_id = $wait_run{$from}->{$id};
    qlog "_Got for id=$id "
        . scalar(@list)
        . " nodes from $from ourid=$our_id; res=$reserved_shared\n", LOG_INFO;

    if ( exists( $ids{$our_id} ) ) {
        $e = $ids{$our_id};
    } else {
        delete $wait_run{$from}->{$id};
        qlog "Nodes for unknown task - $our_id ($id on $from) Delete it...\n",
            LOG_ERR;
        new_req_to_child(
            'del', { 'id' => $our_id },
            $from,                    0,
            SUCC_ALL | SUCC_OK,       \&chld_del_handler,
            \&chld_every_del_handler, get_setting('intra_timeout'),
            \&chld_del_handler );
        return;
    }
    if ( $e->{state} eq 'run' ) {
        delete $wait_run{$from}->{$id};
        qlog( "extra nodes... They arent needed.\n", LOG_INFO );
        new_req_to_child(
            'del', { 'id' => $our_id },
            $from,                    0,
            SUCC_ALL | SUCC_OK,       \&chld_del_handler,
            \&chld_every_del_handler, get_setting('intra_timeout'),
            \&chld_del_handler );
        return;
    }

    my @new = ();
    $runflag = 0;
    $may_go  = 1;
    qlog "_Using these nodes!\n", LOG_DEBUG;
    for my $node (@list) {
        if (   !defined( $e->{wait_for}->{$node} )
            or !defined( $e->{wait_for}->{$node}->{$from} ) ) {
            qlog "BAD answer - this node is not awaited ($node on $from)!\n",
                LOG_ERR;
            next;
        }
        delete $e->{wait_for}->{$node}->{$from};
        if ( scalar( %{ $e->{wait_for}->{$node} } ) == 0 ) {

            # all sublusters get this node for us!!!
            push @{ $e->{shared} }, $node;

            $pe{$node}->{ids}->{ $e->{id} } = 1;

            qlog "Got Shared now: " . join( ';', @{ $e->{shared} } ) . "\n",
                LOG_DEBUG;
            push @new, $node;
            if ( @{ $e->{shared} } + @{ $e->{own} } >= $e->{np} ) {
                $runflag = 1;
                qlog "GOT ALL NODES. ($e->{np})\n", LOG_INFO;
                my $alg =
                    cleosupport::get_setting( 'pe_select', $e->{user},
                    $e->{profile}, $cluster_name );
                if ( exists $shuffle_algorithms{$alg} ) {
                    qlog "PE_SELECT USE $alg\n", LOG_INFO;
                    $shuffle_algorithms{$alg}->( $e->{shared} );
                } else {
                    qlog "PE_SELECT USE EXTERN $alg\n", LOG_INFO;
                    &extern_shuffle( $alg, $e->{np}, $e->{shared} );

                    #qlog "RET= ".join(';',@$e->{shared})."\n";
                }
                last;
            }

            #^^^^ YES, we got ALL nodes!
        }
    }
    unless ($runflag) {
        my ( $i, $node, $j, $wait );
        while ( ( $i, $node ) = each( %{ $e->{wait_for} } ) ) {
            while ( ( $j, $wait ) = each(%$node) ) {
                qlog "ww $i $j\n", LOG_DEBUG2;
            }
        }
    }
    if ( ( $e->{lastowner} ne $cluster_name ) && ( scalar(@new) > 0 ) ) {

        # Tell master about gotten nodes
        qlog "TELL PARENT\n", LOG_DEBUG2;
        answer_to_parent( $e->{lastowner}, 0, 'got', SUCC_OK, 'id', $our_id,
            'nodes', join( ',', @new ) );
    }
    if ( $runflag and $e->{lastowner} eq $cluster_name ) {

        # run (or pre-run) the task !!!

        $e->{nodes} = join( ',', sort( @{ $e->{own} }, @{ $e->{shared} } ) );

        #now clear all nodes fron 'waiting'
        undef $e->{wait_for};

#     if(run_id($our_id)){
#       my %answ=('id'=>$id,'nodes'=>join(',',@{$e->{shared}}));
#       new_req_to_child('run_pre',\%answ,'__all__',1,SUCC_ALL|SUCC_OK,
#                        \&nil_sub,\&every_nil_sub,1,\&every_nil_sub);
#     }
#     else{
#       my %answ=('id'=>$id,'user'=>'__internal__','mask'=>'',
#                 'userlist'=>'','rmask'=>'','forcerd'=>1);
#       new_req_to_child('del_local',\%answ,'__all__',1,SUCC_ALL|SUCC_OK,
#                        \&nil_sub,\&every_nil_sub,1,\&every_nil_sub);
#       qlog "Failed run task '$e->{task}' for user $e->{user} ($our_id)\n", LOG_ERR;
#     }
        if ( run_id($our_id) < 0 ) {
            qlog "Failed run task '$e->{task_args}->[0]'".
                 " for user $e->{user} ($our_id)\n", LOG_ERR;
        }
    }
    qlog "_Got2 for id=$id "
        . scalar(@list)
        . " nodes from $from ourid=$our_id; res=$reserved_shared\n",
        LOG_DEBUG;
    $may_go   = 1;
    $q_change = 1;
    dump_queue();
}

######################################################################
#
#  Head
#
#  Handler for 'clean_task' answer from childs
#
######################################################################
sub chld_clean_task_handler($$$$$$ ) {
    my ( undef, $succ, $args, undef, $from, undef ) = @_;

    qlog "Cleaning...\n", LOG_DEBUG;
    if ( exists( $local_rshells{ "$from" . ":" . $args->{id} } ) ) {
        for my $i ( @{ $local_rshells{ "$from" . ":" . $args->{id} } } ) {
            kill_tree( 9, $i->{pid} );
            my %e;
            $e{owner} = $from;
            $e{id}    = $args->{id};
            new_req_to_mon(
                'kill',
                \%e,
                $i->{host},
                SUCC_ALL | SUCC_OK,
                \&nil_sub,
                undef,
                cleosupport::get_setting('mon_timeout'),
                \&nil_sub );
        }
        delete $local_rshells{ "$from" . ":" . $args->{id} };
    } else {
        qlog "No such rshell!!! ($from $args->{id})\n", LOG_WARN;
    }
}

######################################################################
#
#  Head
#
#  Handler for 'del_local' answer from childs
#
######################################################################
sub chld_del_loc_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    unless ( $user_v->{channel} ) {
        qlog "Del_local $args->{status}\n", LOG_INFO;
        return;
    }
    if ( $args->{status} eq 'timed out' ) {
        qlog "DEL_LOCAL TIMED OUT ($from)!!!\n", LOG_WARN;
        $user_v->{channel}->send(
            "-Internal error. Your request is timed out.\n" );
    } else {
        if ( $succ == SUCC_OK ) {
            $user_v->{channel}->send(
                "+ $user_v->{num} task(s) deleted\n" );
        } else {
            $user_v->{channel}->send( "- $ret_args->{reason}\n" );
        }
    }
    $user_v->{channel}->disconnect;
    $may_go = 1;
}

######################################################################
#
#  Head
#
#  Handler for 'del_local' answer from childs
#
######################################################################
sub chld_every_del_loc_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    if ( $succ == SUCC_OK ) {
        my $n;
        ($n) = ( $ret_args->{reason} =~ /Deleted\s+(\d+)\s+task/ );
        $user_v->{num} += $n;
        qlog "EVERY_DEL: $n\n", LOG_INFO;
    }
    return $user_v;
}

######################################################################
#
#  Child
#
#  Handler for 'del_local' request from parent
#
######################################################################
sub del_local_handler($$$$ ) {

    # for childs
    my ( $type, $hash, $from, $args ) = @_;
    my ( $status, $answer );

    ( $status, $answer ) = (
        del_task(
            $args->{id},       $args->{user},  $args->{mask},
            $args->{userlist}, $args->{rmask}, $args->{forced} )
    ) =~ /(.)(.*)/;
    answer_to_parent( $from, $hash, 'del_local',
        ( $status eq '+' ) ? SUCC_OK: SUCC_FAIL,
        'reason', $answer );
    dump_queue();
    $may_go = 1;
}

######################################################################
#
#  Head
#
#  Handler for 'del' answer from childs
#
######################################################################
sub chld_del_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    if ( $args->{status} eq 'timed out' ) {
        qlog "DEL TIMED OUT ($from)!!!\n", LOG_WARN;
    } else {
        if ( $succ == SUCC_OK ) {
            qlog "Del $args->{id} succeed on childs.\n", LOG_INFO;
        } else {
            qlog "Failed to delete $args->{id}.\n", LOG_WARN;
        }
    }
}

######################################################################
#
#  Head
#
#  Handler for 'del' answer from childs
#
######################################################################
sub chld_every_del_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for every 'internal_info' answer from childs
#
######################################################################
sub chld_every_int_info_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;
    my ( $i,    @j );

    qlog "INT_INFO FROM $from ($succ)\n", LOG_ALL;
    qlog "::: " . join( ';', %$ret_args, "\n" ), LOG_DEBUG;
    if ( $succ == SUCC_OK ) {
        foreach $i ( keys(%$ret_args) ) {
            next if ( $i eq 'success' );
            if ( $i !~ /^\d+$/ ) {
                qlog
                    "Invalid key while receiving int_info from $from: '$i'\n",
                    LOG_ERR;
                next;
            }
            @j = sort( split( /\,/, $ret_args->{$i} ) );
            qlog "CHLD::::::: $from: id=$i nodes: $ret_args->{$i};\n",
                LOG_INFO;
            foreach my $k (@j) {
                $by_owner{$from}->{$i}->{$k} = 1;
                qlog "> $i: $k.\n", LOG_DEBUG;
            }
        }
    }
    return $user_v;
}

######################################################################
#
#  Head
#
#  Handler for 'internal_info' answer from childs
#
######################################################################
sub chld_int_info_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    $run_fase = 3;
    qlog "All agents are internal info sent!\n", LOG_DEBUG;

    main::new_req_to_mon(
        'internal_info',
        {},
        '__all__',
        SUCC_ALL | SUCC_OK,
        \&main::mon_int_info_handler,
        \&main::mon_every_int_handler,
        cleosupport::get_setting('mon_timeout'),
        \&main::mon_every_int_handler );
}

######################################################################
#
#  Head
#
#  Handler for 'add' answer from childs
#
######################################################################
sub chld_every_add_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

#  qlog "Auch! add fake answer? (".join(';',%{$args}).")[".join(';',%{$ret_args})."]\n";

    if ( $succ == SUCC_OK ) {
        $wait_run{$from}->{ $ret_args->{id} } = $args->{id};
    }
    qlog
        "Added to $from $wait_run{$from}->{$ret_args->{id}} as $ret_args->{id} "
        . ( ( $succ == SUCC_OK ) ? "ok" : "fail" )
        . "\n", LOG_INFO;
    return $user_v;

    #  return $ret_arg;
}

######################################################################
#
#  Head
#
#  Handler for 'add' answer from childs
#
######################################################################
sub chld_add_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    if ( $args->{status} eq 'timed out' ) {
        qlog "ADD TIMED OUT ($from)!!!\n", LOG_WARN;
        return;
    }

    if ( $succ == SUCC_OK ) {
        $wait_run{$from}->{ $ret_args->{id} } = $args->{id};
        if ( $user_v->{channel} ) {
            qlog
                "Added finally to $from '$args->{id}' as '$ret_args->{id}' (answer to user)\n",
                LOG_INFO;
            $user_v->{channel}->send(
                "+Successfully added to queue $from (ID=$ret_args->{id})\n" );
            if ( $ret_args->{comment} ne '' ) {
                $user_v->{channel}->send( $ret_args->{comment}."\n" );
            }
            $user_v->{channel}->disconnect;
        } else {
            qlog
                "Added finally to $from '$wait_run{$from}->{$ret_args->{id}}' as '$ret_args->{id}'\n",
                LOG_INFO;
        }
    } else {
        if ( $user_v->{channel} ) {
            qlog
                "Add to $from failed ($ret_args->{reason}) (answer to user)\n",
                LOG_INFO;
             $user_v->{channel}->send(
                "-" . $ret_args->{reason} . "\n" );
            if ( $ret_args->{comment} ne '' ) {
                 $user_v->{channel}->send( $ret_args->{comment}."\n");
            }
            $user_v->{channel}->disconnect;
        } else {
            qlog "Add to $from failed ($ret_args->{reason})\n", LOG_INFO;
        }
    }
}

######################################################################
#
#  Head
#
#  Handler for 'get_io' answer from childs
#
######################################################################
sub chld_get_io_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( undef, $succ, $args, $user_v, undef, $ret_args ) = @_;

    qlog "GET_IO: ($args->{status}/$args->{queue}/$args->{id})\n", LOG_INFO;
    if ( $succ == SUCC_FAIL ) {
         $user_v->{channel}->send( "-fail\n$ret_args->{reason}\n" );
    } else {
         $user_v->{channel}->send(
            "+ok\nin=$ret_args->{in}\nout=$ret_args->{out}\n" );
    }
    $user_v->{channel}->disconnect;
}

######################################################################
#
#  Head
#
#  Handler for 'freeze' answer from childs
#
######################################################################
sub chld_freeze_handler($$$$$$ ) {

    # for parent (process answers from childs)
    my ( undef, $succ, $args, $user_v, undef, $ret_args ) = @_;

    if($args->{status} eq 'timed out'){
        $user_v->{channel}->send( "-fail\nTimed out.\n" );
    }
    else{
        qlog "FREEZE answer: ($args->{status}/$args->{queue}/$args->{id})\n", LOG_INFO;
        if ( $succ == SUCC_FAIL ) {
            $user_v->{channel}->send( "-fail\n$ret_args->{reason}\n" );
        }
        else {
            $user_v->{channel}->send("+ok\n" );
            my %e=(
                'id'    => $ret_args->{id},
                'owner' => $ret_args->{owner},
                'user'  => $ret_args->{user},
                'val'   => $ret_args->{val}?'STOP':'CONT'
                );
            new_req_to_mon(
                'signal',  \%e,
                $ret_args->{nodes},
                SUCC_ALL | SUCC_OK,
                undef,
                undef,
                0, undef );

        }
    }
    $user_v->{channel}->disconnect;
}

sub get_warnings() {
    my $ret;

    unless ( $mode & MODE_RUN_ALLOW ) {
        $ret = "Warning: Queue $cluster_name is BLOCKED for run new tasks\n";
        if ( $norun_reason ne '' ) {
            $ret .= " Reason: $norun_reason\n";
        }
    }
}

######################################################################
#
#
#
#   PARENT REQUESTS HANDLERS
#
#
######################################################################
######################################################################
######################################################################
######################################################################
######################################################################

######################################################################
#
#  Child
#
#  Handler for 'add' request from parent
#
######################################################################
sub add_handler($$$$ ) {

    # for childs
    my ( $type, $hash, $from, $args ) = @_;

    qlog "Add new task request\n", LOG_INFO;
    if ( $args->{lastowner} eq $cluster_name ) {
        unless ( $mode & MODE_QUEUE_ALLOW ) {
            qlog "Queueing is disabled.\n", LOG_WARN;
            answer_to_parent( $from, $hash, 'add', SUCC_FAIL, 'reason',
                "Queueing is disabled." );
            return;
        }
        if ($#queue > cleosupport::get_setting(
                'max_queue', $args->{user}, $args->{profile} )
            ) {
            qlog "Queue is full for $args->{user}.\n", LOG_WARN;
            answer_to_parent( $from, $hash, 'add', SUCC_FAIL, 'reason',
                "Queue is full for $args->{user}." );
            return;
        }
        my $s =
            cleosupport::get_setting( 'max_tasks', $args->{user},
            $args->{profile} );
        if ( defined $s ) {
            my $c = count_user_tasks( $args->{user} );
            if ( $c >= $s ) {
                qlog "Limit of tasks is reached for $args->{user} [$c;$s]\n",
                    LOG_WARN;
                answer_to_parent( $from, $hash, 'add', SUCC_FAIL, 'reason',
                    "Limit of tasks in queue is reached by $args->{user}." );
                return;
            }
        }
    }

    $may_go   = 1;
    $q_change = 1;

    if ( $args->{np} =~ s/^([+-])// ) {
        $args->{gummy} = 1;
    }
    $args->{status} = 0;
    $args->{state}  = 'queued';
    $args->{qtype}  = NATIVE_QUEUE;
    $args->{core}   = 0;
    $args->{signal} = 0;

    qlog
        "_Got add from $from ($args->{lastowner}) oldid=$args->{oldid}, ".
        "$args->{np} cpus '$args->{task_args}->[0]' ".
        "pri=$args->{priority}; res=$reserved_shared\n",
        LOG_DEBUG;
    if ( $args->{lastowner} ne $cluster_name ) {
        $args->{priority} =
            get_setting( 'def_priority', $args->{user} ) +
            get_setting('add_pri_on_chld');
    }
    my $newid = push_to_queue($args);

    if($newid<1){
        qlog "Cannot push to queue.\n", LOG_ERR;
           answer_to_parent( $from, $hash, 'add', SUCC_FAIL );
    }
    qlog "From parent ($args->{lastowner}:$args->{oldid}) ".
         "new ($newid): u=$args->{user} np=$args->{np} ".
         "g=$args->{gummy} c='".join("' '",@{$args->{task_args}}).
         "\n",  LOG_DEBUG;

    $extern_ids{ $args->{lastowner} }->{ $args->{oldid} } = $newid
        if ( $args->{oldid} );
    qlog( "ENV= " . join( ';', @{ $ids{$newid}{env} } ) . "\n", LOG_DEBUG2 )
        if $args->{env};

    if ( $args->{wait_for_run} ) {
        for my $x ( split( ',', $args->{wait_for_run} ) ) {
            $x =~ y/\0\n\r\t\ //d;
            $x =~ s/^$cluster_name\@//;
            push @{ $ids{$newid}{wait_for_run} }, $x;
        }
    }
    if ( $args->{wait_for_ok} ) {
        for my $x ( split( ',', $args->{wait_for_ok} ) ) {
            $x =~ y/\0\n\r\t\ //d;
            $x =~ s/^$cluster_name\@//;
            push @{ $ids{$newid}{wait_for_ok} }, $x;
        }
    }
    if ( $args->{wait_for_fail} ) {
        for my $x ( split( ',', $args->{wait_for_fail} ) ) {
            $x =~ y/\0\n\r\t\ //d;
            $x =~ s/^$cluster_name\@//;
            push @{ $ids{$newid}{wait_for_fail} }, $x;
        }
    }
    $args->{wait_cond_type} |= 'a';
    $ids{$newid}{wait_cond_type} = $args->{wait_cond_type};

    $ids{$newid}{uniqid} = "$cluster_name-$last_time-$newid";


    qlog "Added $args->{lastowner}/$args->{oldid} = $newid\n", LOG_INFO;
    slog "ADDED $newid; $args->{lastowner};$args->{oldid}; ".
         "$args->{user}; $args->{np}; ".
         join(' ',@{$args->{task_args}})."\n";
    answer_to_parent( $from, $hash, 'add', SUCC_OK, 'id', $newid );

    my $is_own = ( ( $args->{lastowner} eq $cluster_name ) ? 1 : 0 );
    sceduler_event(
                   'add',
                   {   id        => $newid,
                       user      => $args->{user},
                       np        => $args->{np},
                       timelimit => $args->{timelimit},
                       is_own    => $is_own
                   }
                  );

    dump_queue();
}

######################################################################
#
#  Child
#
#  Handler for 'internal_info' request from parent
#
######################################################################
sub int_info_handler($$$$ ) {

    # for childs
    my ( $type, $hash, $from, $args ) = @_;
    my ( $i, $j, %nodes, %lines );

    qlog "INT_INFO received.\n", LOG_ALL;
    foreach $i (@running) {
        %nodes = ();
        foreach $j ( split( /\,/, $i->{nodes} ) ) {
            $j =~ /^([^:]+)/ or next;
            ++$nodes{$1};
        }

        # lines - all NODES, which MUST execute this task (id=$i)
        $lines{ $i->{id} } = join( ',', keys(%nodes) );
        qlog "$i->{id}: $lines{$i->{id}}\n", LOG_DEBUG;
    }
    answer_to_parent( $from, $hash, 'internal_info', SUCC_OK, %lines );

    #                   'val',"id:$i->{id} nodes:".join(',',keys(%nodes)));
}

######################################################################
#
#  Child
#
#  Handler for 'test_id' request from parent
#
######################################################################
sub test_id_handler($$$$ ) {

    # for childs
    my ( $type, $hash, $from, $args ) = @_;

    qlog "TEST_ID $args->{id} received.\n", LOG_ALL;
    if ( exists $ids{ $args->{id} } ) {
        qlog "Task present.\n", LOG_ALL;
        answer_to_parent( $from, $hash, 'test_id', SUCC_OK, 'state',
            $ids{ $args->{id} }->{state} );
    } else {
        qlog "Task absent.\n", LOG_ALL;
        answer_to_parent( $from, $hash, 'test_id', SUCC_FAIL, 'state',
            'none' );
    }
}

######################################################################
#
#  Child
#
#  Handler for 'chattr' request from parent
#
######################################################################
sub chattr_handler($$$$ ) {

    # for childs
    my ( $type, $hash, $from, $args ) = @_;
    my $state;

    qlog "ATTR $args->{id} received.\n", LOG_DEBUG;
    if ( exists $ids{ $args->{id} } ) {
        $state =
            cleosupport::set_attribute( $args->{id}, $args->{attribute},
            $args->{val}, $args->{user} );
        answer_to_parent( $from, $hash, 'chattr',
            ( substr( $state, 0, 1 ) eq '+' ) ? SUCC_OK: SUCC_FAIL,
            'reason', $state );
    } else {
        qlog "Task absent.\n", LOG_ALL;
        answer_to_parent( $from, $hash, 'chattr', SUCC_FAIL, 'reason',
            '-No such task' );
    }
}

######################################################################
#
#  Child
#
#  Handler for 'del' request from parent
#
######################################################################
sub del_handler($$$$ ) {

    # for childs
    my ( $type, $hash, $from, $args ) = @_;
    my ( $status, $answer );

    my $id;
    $id = $extern_ids{$from}->{ $args->{id} }
        if exists $extern_ids{$from}->{ $args->{id} };

    unless ( defined $id ) {
        qlog "Del: No such extern id: $args->{id}\n", LOG_WARN;
        answer_to_parent( $from, $hash, 'del', SUCC_FAIL, 'reason',
            'No such task' );
        return;
    }
    $status = del_task( $id, '__internal__', '', '', '' );
    $status =~ /(.)(.*)/;
    ( $status, $answer ) = ( $1, $2 );
    qlog "del $status:$answer\n", LOG_DEBUG;
    if ( $status eq '+' ) {
        answer_to_parent( $from, $hash, 'del', SUCC_OK );
    } else {
        answer_to_parent( $from, $hash, 'del', SUCC_FAIL, 'reason', $answer );
    }
    dump_queue() if ( $status eq '+' );
}

######################################################################
#
#  Child
#
#  Handler for 'update_resrictions' pseudo-answer from parent
#
######################################################################
sub update_restrictions_handler($$$$ ) {

    # for childs
    load_restrictions( cleosupport::get_setting('time_restrict_file') );
    correct_time_restrictions(1);
}

######################################################################
#
#  Child
#
#  Handler for 'reload_conf' pseudoanswer from parent
#
######################################################################
sub reload_conf_handler($$$$ ) {

    # for childs
    stop_sceduler();
    load_conf_file();
    start_sceduler();
}

######################################################################
#
#  Child
#
#  Handler for 'reload_users' pseudo-answer from parent
#
######################################################################
sub reload_users_handler($$$$ ) {

    # for childs
    reload_users(1);
}

######################################################################
#
#  Child
#
#  Handler for 'reload_sced' pseudo-answer from parent
#
######################################################################
sub reload_sced_handler($$$$ ) {

    # for childs
    save_state();
    stop_sceduler();
    load_scedulers();
    start_sceduler();
}

######################################################################
#
#  Child
#
#  Handler for 'attach' pseudo-answer from parent
#
######################################################################
sub attach_handler($$$$ ) {

    # for childs
    my ( $type, $hash, $from, $args ) = @_;
    my ( $status, $answer );

    my $id = $args->{id};

    qlog "ATTACH: " . join( ':', %$args ) . ";\n", LOG_DEBUG;
    unless ( defined $childs_info{$id} ) {
        qlog "Attach: No such id: $id\n", LOG_ERR;
        answer_to_parent( $from, $hash, 'attach', SUCC_FAIL, 'reason',
            'No such task' );
        return;
    }
    &cleosupport::execute_task( $childs_info{$id} );
    answer_to_parent(
        $from, $hash, 'attach', SUCC_OK,
        'all'   => '1',
        'owner' => $cluster_name,
        'id'    => $id,
        'user'  => $childs_info{$id}->{user},
        'tmout' => get_setting('attach_tmout') );
}

######################################################################
#
#  Child
#
#  Handler for 'start' command from parent
#
######################################################################
sub start_handler($$$$ ) {

    # for child
    qlog "Start work!\n", LOG_ALL;
    reload_users(1);
    $run_fase = 0;
    $may_go   = 1;
}

######################################################################
#
#  Child
#
#  Handler for 'stop' command from parent
#
######################################################################
sub stop_handler($$$$ ) {

    # for childs
    $run_fase = 10;
}

######################################################################
#
#  Child
#
#  Handler for 'freeze' pseudo-answer from parent
#
######################################################################
sub freeze_handler($$$$ ) {

    # for childs
    my ( $type, $hash, $from, $args ) = @_;
    my ( $cpu, @nodes, $node );

    my $id = $args->{id};

    qlog "FREEZE: " . join( ':', %$args ) . ";\n", LOG_DEBUG;
    unless ( defined $childs_info{$id} ) {
        qlog "Freeze: No such id: $id\n", LOG_ERR;
        answer_to_parent( $from, $hash, 'freeze', SUCC_FAIL, 'reason',
            'No such task' );
        return;
    }

    # remember timelimit if freeze
    if($childs_info{$id}->{frozen}==0 and
       $args->{val}!=0){
        $childs_info{$id}->{frozen_timelimit}=
            $childs_info{$id}->{timelimit}-$last_time;
        $childs_info{$id}->{timelimit}=0;
    }
    #restore timelimit if unfreze
    elsif($childs_info{$id}->{frozen}!=0 and
       $args->{val}==0){
        $childs_info{$id}->{timelimit}=
            $childs_info{$id}->{frozen_timelimit}+$last_time;
    }

    #freeze/unfreeze
    $childs_info{$id}->{frozen}=$args->{val};

    # create nodes list
    foreach $cpu ( sort(@{$childs_info{$id}->{own}},
                        @{$childs_info{$id}->{shared}},
                        @{$childs_info{$id}->{extranodes}})){
        $cpu =~ /^(.*):(.*)$/;
        next if($1 eq $node);

        $node=$1;
        push @nodes, $node;
    }
    answer_to_parent(
        $from, $hash, 'freeze', SUCC_OK,
        'owner' => $cluster_name,
        'id'    => $id,
        'user'  => $childs_info{$id}->{user},
        'nodes' => \@nodes,
        'val'   => $args->{val} );
}

######################################################################
#
#  Child
#
#  Handler for 'view' request from parent
#
######################################################################
sub view_handler($$$$ ) {

    # On child. Handle view request

    my ( $type, $hash, $from, $args ) = @_;
    my $o;

    qlog "VIEW: $hash,$from '$args->{flags}'\n", LOG_INFO;

    #  $o = pack('u',get_task_list_w_flags($args->{user},$args->{flags}));
    #  $o =~ s/\n//g;
    answer_to_parent( $from, $hash, $type, SUCC_OK, 'data',
        get_task_list_w_flags( $args->{user}, $args->{flags} ) );
}

######################################################################
#
#  Child
#
#  Handler for 'autoblock' request from parent
#
######################################################################
sub ablock_handler($$$$ ) {

    # On child. Handle autoblock request

    my ( $type, $hash, $from, $args ) = @_;

    qlog "ABLOCK: $hash,$from '$args->{users}' by $args->{name}\n", LOG_INFO;
    answer_to_parent(
        $from, $hash, $type, SUCC_OK, 'data',
        &cleosupport::autoblock(
            $args->{users}, $args->{val}, $args->{username} ) );
}

######################################################################
#
#  Child
#
#  Handler for 'mode' request from parent
#
######################################################################
sub mode_handler($$$$ ) {
    my ( $type, $hash, $from, $args ) = @_;
    my $o;

    qlog "MODE_C: $hash,$from '$args->{flags}'\n", LOG_INFO;

    #  $o = pack('u',new_mode($args->{user},$args->{set},$args->{clear}));
    #  $o =~ s/\n//g;
    answer_to_parent( $from, $hash, $type, SUCC_OK, 'data',
        new_mode( $args->{user}, $args->{set}, $args->{clear} ) );
}

######################################################################
#
#  Child
#
#  Handler for 'run_via_mons' pseudo-request from parent (answer actually)
#
######################################################################
sub rvm_handler($$$$ ) {

    # On child. Handle 'answer' for request on run_via_mons

    my ( $type, $hash, $from, $args ) = @_;

#    qlog "ABC: $type,$hash,$from '$args->{id}'\n", LOG_DEBUG;

    if ( !exists( $ids{ $args->{id} } ) ) {
        qlog "Already dead. Skip.\n", LOG_DEBUG;
        return;
    }
    if ( $args->{success} eq SUCC_OK ) {
        qlog "Run $args->{id} via mons succesfull\n", LOG_INFO;

        #    move_to_queue($args->{id},RUNNING_QUEUE);
        if ( $ids{ $args->{id} }->{state} ne 'run' ) {
            qlog "MUST BE RUNNED ALREADY! State=$ids{$args->{id}}->{state}\n",
                LOG_ERR;
            remove_id( $args->{id} );
            push @running, $ids{ $args->{id} };
            $ids{ $args->{id} }->{state} = 'run';

            $childs_info{ $args->{id} }->{time} = $last_time;
            if ( $childs_info{ $args->{id} }->{timelimit} ) {
                $childs_info{ $args->{id} }->{timelimit} +=
                    $childs_info{ $args->{id} }->{time};
                qlog
                    "TIMELIMIT: $childs_info{$args->{id}}->{timelimit} ($childs_info{$args->{id}}->{time})\n",
                    LOG_DEBUG;
            } else {
                qlog "TIMELIMIT: UNLIMITED\n", LOG_DEBUG;
            }
        }
    } else {

        # simply delete it...
        $childs_info{ $args->{id} }->{status} = -1;
        push @dead, $args->{id};
    }

    dump_queue();
}

######################################################################
#
#  Child
#
#  Handler for 'block_pe' request from parent
#
######################################################################
sub block_pe_handler($$$$ ) {
    my ( $type, $hash, $from, $args ) = @_;

    my $ret;
    my $o;

    qlog
        "BLOCK_PE=$args->{val} $args->{pe} safe=$args->{safe} reasons=$args->{reason}\n",
        LOG_INFO;
    $ret =
        cleosupport::block_pe( $args->{pe}, $args->{val}, $args->{safe},
        $args->{reason} );
    $last_del = $last_time;

    #  $o=pack('u',$ret);
    #  $o =~ s/\n//g;
    if ( substr( $ret, 0, 1 ) eq '+' ) {
        answer_to_parent( $from, $hash, $type, SUCC_OK, 'data', $ret );
    } else {
        answer_to_parent( $from, $hash, $type, SUCC_FAIL, 'data', $ret );
    }
    qlog
        "_Exit block_pe from pe=$args->{pe} val=$args->{val} $args->{safe} ($args->{reason})\n",
        LOG_DEBUG;
    dump_queue();
}

######################################################################
#
#  Child
#
#  Handler for 'del_mon_task' pseudo-request from parent (answer actually)
#
######################################################################
sub dmt_handler($$$$ ) {

    # On child. Handle 'answer' for request on del_mon_task

    my ( $type, $hash, $from, $args ) = @_;

    qlog "DMT: $type,$hash,$from '$args->{id}'\n", LOG_DEBUG;
    if ( $args->{success} ) {
        qlog "Del mon task: $args->{id} succesfull\n", LOG_INFO;
    } else {
        if ( exists( $childs_info{ $args->{id} } ) ) {
            del_task( $args->{id}, '__internal__' );
            push @dead, $args->{id};
        }
    }
}

######################################################################
#
#  Child
#
#  Handler for 'finished' pseudo-request from parent (notify actually)
#
######################################################################
sub finished_handler($$$$ ) {

    # On child. Handle message of finishing task on monitor.

    my ( $type, $hash, $from, $args ) = @_;

    qlog "Task $args->{id}: node '$args->{node}' finished\n", LOG_INFO;
    task_node_dead( $args->{id}, $args->{node} );
    $childs_info{ $args->{id} }->{status}  = $args->{code};
    $childs_info{ $args->{id} }->{special} = $args->{special}
        if ( $args->{special} ne '' );
}

sub nil_sub() { }

sub every_nil_sub( $$$$ ) {
    return $_[3];
}

######################################################################
#
#  Child
#
#  Handler for 'run' pseudo-request from parent (notify actually)
#
######################################################################
sub run_handler($$$$ ) {

    # On child. Handle message of running task on monitor.

    my ( $type, $hash, $from, $args ) = @_;

    if ( $args->{success} ) {
        qlog "Task $args->{id}: node '$args->{node}' runned.\n", LOG_INFO;
    } else {
        qlog "Task $args->{id}: node '$args->{node}' run failed.\n", LOG_INFO;
        if ( exists( $childs_info{ $args->{id} } ) ) {
            del_task( $args->{id}, '__internal__', '', '', '', 0,
                'Run on node failed' );
            push @dead, $args->{id};
        }
    }
}

######################################################################
#
#  Child
#
#  Handler for 'debug' request from parent
#
######################################################################
sub debug_handler($$$$ ) {

    # On child.

    my ( $type, $hash, $from, $a ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args

    return unless candebug( $args->{user} );

    if ( $args->{recurse} > 0 ) {
        new_req_to_child(
            'debug',            $args,     '__all__',       1,
            SUCC_ALL | SUCC_OK, \&nil_sub, \&nil_every_sub, 0,
            \&nil_sub );
    }
    qlog "Debug: exec '$args->{command}'\n", LOG_ALL;
    eval "{no strict; sub qlog(\$;\$); $args->{command};}";
    qlog "Debug: done ($@)\n", LOG_ALL;
}

######################################################################
#
#  Child
#
#  Handler for 'priority' request from parent
#
######################################################################
sub pri_handler($$$$ ) {
    my ( $type, $hash, $from, $args ) = @_;
    my $old;

    if ( exists( $ids{ $args->{id} } ) ) {
        $old = $ids{ $args->{id} }->{priority};
    }

    my $out =
        &cleosupport::set_priority( $args->{id}, $args->{val},
        $args->{user} );

    $out =~ s/^(.)//;
    my $succ = $1;
    my $o;

    qlog "GOT: '$out',$succ;\b", LOG_DEBUG;
    if ( $succ eq '+' ) {
        sceduler_event(
            'priority',
            {   id        => $args->{id},
                user      => $args->{user},
                np        => $args->{np},
                timelimit => $args->{timelimit},
                is_own    => ( $args->{lastowner} eq $cluster_name ) ? 1 : 0,
                old_priority => $old,
                new_priority => $args->{val} } );
        answer_to_parent( $from, $hash, $type, SUCC_OK );
    } else {

        #    $o=pack('u',$out);
        #    $o =~ s/\n//g;
        answer_to_parent( $from, $hash, $type, SUCC_FAIL, 'reason', $out );
    }
}

######################################################################
#
#  Child
#
#  Handler for 'block' request from parent
#
######################################################################
sub block_handler($$$$ ) {
    my ( $type, $hash, $from, $args ) = @_;

    my $id;
    my @ids;
    my @answer;
    my $num    = 0;
    my $failed = 0;

    if ( $args->{origid} ) {
        push @ids, $extern_ids{$from}->{ $args->{origid} }
            if exists $extern_ids{$from}->{ $args->{origid} };
    } else {
        @ids = split( /,/, $args->{id} );
    }

    foreach $id (@ids) {
        my $out =
            &cleosupport::block_task( $id, $args->{val}, $args->{username},
            $args->{reason}, $args->{users}, $args->{mask}, );

        $out =~ s/^(.)//;
        my $succ = $1;

        qlog "BLOCK_TASK returns: '$out',$succ;\b", LOG_DEBUG;
        if ( $succ eq '+' ) {
            ++$num;
        } else {
            ++$failed;
            my $o = pack( 'u', "$id: $out;" );
            $o =~ s/\n//g;
            push @answer, $o;
        }
    }
    answer_to_parent(
        $from,
        $hash,
        $type,
        $num > 0 ? SUCC_OK: SUCC_FAIL,
        'reason',
        "$num tasks "
            . ( $args->{val} == 0 ? 'un' : '' )
            . "blocked, $failed failed.",
        @answer );
}

######################################################################
#
#  Child
#
#  Handler for 'run_pre' request from parent
#  Run prerunned task
#
######################################################################
sub run_pre_handler($$$$ ) {
    my ( $type, $hash, $from, $args ) = @_;

    my ( @nodes, $q, $p, $time, @oldshared, $id );

    $may_go   = 1;
    $q_change = 1;

    $id = $extern_ids{$from}->{ $args->{id} };
    qlog "Run_pre $args->{id} [our $id]. Nodes: '$args->{nodes}'\n", LOG_INFO;
    $q = get_entry($id);
    if ($q) {

#    qlog "_Got run_pre from $from $q->{np} proc '$q->{task}' res=$reserved_shared\n", LOG_DEBUG;
        if ( $q->{state} eq 'run' ) {
            qlog "Duplicated 'run_pre' request!\n", LOG_WARN;
            return;
        }
        qlog "Now-run: reserved: $reserved_shared; req_shared: "
            . scalar( @{ $q->{shared} } )
            . "\n", LOG_DEBUG;
        my $our = 0;

  # unmark all processors #BUG! restore 'max' value!!!!!!!!!!!!!!!!!!!!!!!!!!!
        qlog "hh1 id=$id res=$reserved_shared - $q->{reserved}\n", LOG_DEBUG;
        $reserved_shared -= $q->{reserved};
        $q->{reserved} = 0;
        $q->{time}     = $args->{time};
        for $p ( keys(%pe) ) {
            delete $pe{$p}->{ids}->{$id}     if exists $pe{$p};
            delete $own{$p}->{ids}->{$id}    if exists $own{$p};
            delete $shared{$p}->{ids}->{$id} if exists $shared{$p};
        }
        for $p ( @{ $q->{shared} } ) {
            $shared{$p}->{ids}->{$id} = $our = -1
                if ( $args->{nodes} =~ /\b$p\b/ );
        }
        for $p ( @{ $q->{own} } ) {
            $own{$p}->{ids}->{$id} = $our = -1
                if ( $args->{nodes} =~ /\b$p\b/ );
        }
        qlog "Now-run: now reserved: $reserved_shared\n", LOG_DEBUG;

        #    $q->{timelimit}+=$last_time;
        if ($our) {
            my @nodes = split( /\,/, $args->{nodes} );
            my %nodes_used;
            {
                local $, = ';;';
                qlog "Requested to run on nodes: @nodes\n", LOG_DEBUG;
            }
            @oldshared = @{ $q->{shared} };
            @{ $q->{own} }    = ();
            @{ $q->{shared} } = ();
            for my $p (@nodes) {
                if ( exists $own{$p} ) {
                    if ( exists( $nodes_used{$p} ) ) {
                        qlog "Node $p is already used\n", LOG_ERR;
                        next;
                    }
                    $nodes_used{$p} = 1;
                    push @{ $q->{own} }, $p;
                } elsif ( exists $shared{$p} ) {
                    if ( exists( $nodes_used{$p} ) ) {
                        qlog "Node $p is already used\n", LOG_ERR;
                        next;
                    }
                    $nodes_used{$p} = 1;
                    push @{ $q->{shared} }, $p;
                }
            }
            if ( @{ $q->{shared} } + @{ $q->{own} } ) {

                #        move_to_queue($id,RUNNING_QUEUE);
                remove_id($id);
                push @running, $ids{$id};
                $ids{$id}->{state} = 'run';

                #        $childs_info{$id}->{timelimit}+=$last_time;
                $childs_info{$id}->{time} = $last_time;
                if ( $childs_info{$id}->{timelimit} ) {
                    $childs_info{$id}->{timelimit} +=
                        $childs_info{$id}->{time};
                    qlog
                        "TIMELIMIT: $childs_info{$id}->{timelimit} ($childs_info{$id}->{time})\n",
                        LOG_DEBUG;
                } else {
                    qlog "TIMELIMIT: UNLIMITED\n", LOG_DEBUG;
                }

                # CHANGE NP TO REAL!!!!!!!!!!!
                $childs_info{$id}->{np} = @{ $q->{shared} } + @{ $q->{own} };

                slog "RUN2 $id; $q->{user}; $q->{np}; ".
                     join(' ',@{$q->{task_args}})."\n";
                qlog "RUNING foreign task - ($id/$args->{id}) on "
                    . join( ',', @{ $q->{own} } ) . ";;"
                    . join( ',', @{ $q->{shared} } )
                    . "\n", LOG_INFO;
                qlog "reservedshared: $reserved_shared\n", LOG_DEBUG;
                run_or_del( $q, \@oldshared );
            } else {
                del_from_queue($id);
                qlog
                    "No one our processor used! delete this task! ($id/$args->{id}) [$q->{lastowner}]\n",
                    LOG_INFO;
            }
        } else {
            qlog
                "No one our processor used... delete this task! ($id/$args->{id}) [$q->{lastowner}]\n",
                LOG_INFO;
            del_from_queue($id);
        }
        answer_to_parent( $from, $hash, 'run_pre', SUCC_OK );
        dump_queue();
    } else {
        answer_to_parent( $from, $hash, 'run_pre', SUCC_FAIL );
        qlog "Run_pre: No such entry ($args->{id} on $from)\n", LOG_ERR;
    }
}    # ~run_pre_handler

######################################################################
#
#  Child
#
#  Handler for 'get_io' request from parent
#  Returns input and output files for task
#
######################################################################
sub get_io_handler($$$$ ) {
    my ( $type, $hash, $from, $args ) = @_;

    my ( $q, $inp );

    $q = get_entry( $args->{id} );
    if ($q) {
        if ( $args->{user} ne $q->{user} ) {
            if ( !isadmin( $args->{user} ) ) {
                answer_to_parent( $from, $hash, 'get_io', SUCC_FAIL, 'reason',
                    'You have no permission to communicate with this task' );
                return;
            }
        }
        if ( $q->{state} ne 'run' ) {
            qlog "Finished task io parameters requested.\n", LOG_WARN;
            answer_to_parent( $from, $hash, 'get_io', SUCC_FAIL, 'reason',
                'Task is not running yet.' );
            return;
        }
        if ( defined( $q->{empty_input} ) ) {
            $inp = $q->{empty_input};
        } else {
            $inp = '';
        }
        answer_to_parent( $from, $hash, 'get_io', SUCC_OK, 'out',
            $q->{outfile}, 'in', $inp );
    }
    answer_to_parent( $from, $hash, 'get_io', SUCC_FAIL, 'reason',
        'No such task. Probably it is finished already.' );
}    # ~get_io_handler

######################################################################
#
#  END OF HANDLERS
#
#
######################################################################
######################################################################
######################################################################
######################################################################
######################################################################

######################################################################
#
#
#  Called, when task is dead to exec killscript, post_exec and write report
#
######################################################################
sub task_after_death($$ ) {
    my ( $theid, $entry ) = @_;
    my ( $username, $sec, $min, $hour, $text, $text2 );

    $username = $entry->{user};

    unless ( exists $entry->{id} ) {
        qlog "After death failed\n", LOG_ERR;
        return;
    }
    unlink "/tmp/cleo-launch.just-$cluster_name.$theid";  # cancel just_exec
    unlink
        "/tmp/cleo-launch.q_just-$cluster_name.$theid";   # cancel q_just_exec

    if ( $entry->{status} > 0 ) {
        $text =
            cleosupport::get_setting( 'q_fail_exec', $username,
            $entry->{profile} );
        if ( $text ne '' ) {
            $text2 =
                get_setting( 'use_exec_modules', $username,
                $entry->{profile} );
            if ( defined($text2) ) {
                foreach my $i (@$text2) {
                    do_exec_module( $i, 'ok', $entry );
                }
            }
            undef %subst_args;
            subst_task_prop( \$text, $entry, $entry->{time}, "" );
            qlog "run q_fail_exec: '$text'\n", LOG_INFO;
            launch( 0, "$text", '' );
        }
    } else {
        $text =
            cleosupport::get_setting( 'q_ok_exec', $username,
            $entry->{profile} );
        if ( $text ne '' ) {
            $text2 =
                get_setting( 'use_exec_modules', $username,
                $entry->{profile} );
            if ( defined($text2) ) {
                foreach my $i (@$text2) {
                    do_exec_module( $i, 'fail', $entry );
                }
            }
            undef %subst_args;
            subst_task_prop( \$text, $entry, $entry->{time}, "" );
            qlog "run q_ok_exec: '$text'\n", LOG_INFO;
            launch( 0, "$text", '' );
        }
    }

    #
    # exec kill script
    #
    $text =
        cleosupport::get_setting( 'kill_script', $username,
        $entry->{profile} );
    $text2 =
        cleosupport::get_setting( 'user_kill_script', $username,
        $entry->{profile} );
    qlog "KILLSCRIPT='$text' USER_KILLSCRIPT='$text2'\n", LOG_DEBUG;
    qlog( "!!! " . join( '#', %$entry, "\n" ), LOG_DEBUG )
        if ( $debug{'tsk'} );
    if ( $text ne '' ) {
        undef %subst_args;
        subst_task_prop( \$text, $entry, $entry->{time},
            "$hour hours $min minutes $sec seconds" );
        qlog "run killscript: '$text'\n", LOG_INFO;
        launch( 0, $text, '' );
    } elsif ( $entry->{run_via_mons} ) {
        qlog "Task, runned via mons finished!\n", LOG_INFO;
    } elsif ( $text2 eq '' ) {
        qlog "Killing task $entry->{id} by pid $entry->{pid}\n", LOG_INFO;
        if ( $entry->{pid} > 0 ) {
            if ( $entry->{final_kill} ) {
                kill_tree( 9, $entry->{pid} );
            } else {
                kill_tree( 15, $entry->{pid} );    #TERM
            }
        }
    }

    qlog "Kill rshells, if they were\n", LOG_DEBUG2;
    if ( exists( $entry->{rsh_was_used} ) ) {
        answer_to_parent( cleosupport::get_setting('root_cluster_name'),
            0, 'clean_task', SUCC_OK, 'id', $entry->{id} );
    }

    qlog
        "Was used by $username: $user_np_used{$username} ($entry->{np}+$entry->{npextra})\n",
        LOG_DEBUG;

    #  $user_np_used{$username}-=$entry->{np}+$entry->{npextra};
    #  $user_np_used{$username}=0 if $user_np_used{$username}<0;
    qlog "Will be used by $username NOW: "
        . ( $user_np_used{$username} - $entry->{np} - $entry->{npextra} )
        . "\n", LOG_DEBUG;
    unless ( $entry->{run_via_mons} ) {
        unless ( deldir( $entry->{temp_dir}, $entry->{user} ) ) {
            qlog "Cannot delete temp dir " . $entry->{temp_dir} . "\n",
                LOG_WARN;
        }
    }

    sub_exec(
        get_uid( $entry->{user} ),
        $usergid{ $entry->{user} },
        \&after_death_user_part, $theid, $entry, $text2 );

    #
    # report user about task end
    #
    #       if(exists($user_post_exec_write{$username}) || $post_exec_write){
    #         my $text;
    #         if(exists $user_post_exec_write{$username}){
    #           $text=$user_post_exec_write{$username};
    #         }
    #         else{
    #           $text=$post_exec_write;
    #         }
    $text =
        cleosupport::get_setting( 'post_exec_write', $username,
        $entry->{profile} );
    if ( $text ne '' ) {
        undef %subst_args;
        subst_task_prop( \$text, $entry, $entry->{time},
            "$hour hours $min minutes $sec seconds" );
        $text =~ s/\0//g;

        qlog "echo '$text' | /usr/bin/write $username &\n";
        open( WR, "|/usr/bin/write $username" );
        print WR "$text\n";
        close WR;
    }
    $text = get_setting( 'use_exec_modules', $username, $entry->{profile} );
    if ( defined($text) ) {
        foreach my $i (@$text) {
            do_exec_module( $i, 'post', $entry );
        }
    }
    $text =
        cleosupport::get_setting( 'q_post_exec', $username,
        $entry->{profile} );
    if ( $text ne '' ) {
        undef %subst_args;
        subst_task_prop( \$text, $entry, $entry->{time},
            "$hour hours $min minutes $sec seconds" );
        qlog "exec q_post: $text\n";
        launch( 0, "$text", '' );
    }

    qlog "Task '$entry->{task_args}->[0]'"
        . " for user $entry->{user}"
        . " on $entry->{np}"
        . " proc is finished (status $entry->{status}) "
        . ( $entry->{signal} ? "signalled by $entry->{signal}" : '' )
        . "\n", LOG_INFO;
    slog "END_TASK $theid; $entry->{user}; "
        . "$entry->{status}; $entry->{signal}; $hour:$min:$sec\n";
    slog "END_TASK_NODES $theid; $entry->{nodes}\n";
    actualize_cpu_blocks( split( /,/, $entry->{nodes} ) );

    sceduler_event(
        'event',
        {   type      => 'finish',
            id        => $entry->{id},
            user      => $entry->{user},
            signal    => $entry->{signal},
            status    => $entry->{status},
            np        => $entry->{np},
            npextra   => $entry->{npextra},
            special   => $entry->{special},
            core      => $entry->{core},
            start     => $entry->{time},
            worktime  => $last_time - $entry->{time},
            timelimit => $entry->{timelimit},
            timedout  => ( $entry->{special} eq 'Time limit exceeded' )
            ? 1
            : 0,
            nodes => $entry->{nodes} } );
}

sub after_death_user_part( $$$ ) {

    my ( $theid, $entry, $text2 ) = @_;
    my ( $text, $sec, $min, $hour, $yday );

    #  $>=$useruid{$entry->{user}};
    #  $)=$usergid{$entry->{user}};

    qlog
        "Creating report for id=$entry->{id} user=$entry->{user} ($useruid{$entry->{user}}), uid=$<, $>\n",
        LOG_INFO;

    my $REP = new IO::File;
    unless (
        $REP->open(
            $entry->{repfile}, O_WRONLY | O_CREAT | O_APPEND | O_LARGEFILE )
        ) {
        qlog "Cannot open $entry->{repfile} for writing report!\n", LOG_ERR;

        #    print "Open for $entry->{repfile} failed\n";
        $REP->open( "/dev/null", "w" );
    }

    my $end=scalar(@{$entry->{task_args}});
    $REP->print("Task     : $entry->{task_args}->[0]\n");
    $REP->print("Args     : ".join(' ',$entry->{task_args}->[1 .. $end])."\n");
    $REP->print("Nproc    : $entry->{np}\n");
    if($entry->{status} == 255){
        $REP->print("Exit code: unknown");
    }
    else{
        $REP->print("Exit code: $entry->{status}");
    }
    $REP->print(" (core dumped)")                 if ( $entry->{core} );
    $REP->print(" (killed by $entry->{signal})")  if ( $entry->{signal} );
    $REP->print("\nNote     : $entry->{special}") if ( $entry->{special} );
    $REP->print("\nOutput in: $entry->{outfile}\n");
    $REP->print("Work dir : $entry->{dir}\n");
    ( $sec, $min, $hour, undef, undef, undef, undef, $yday ) =
        gmtime( $last_time - $entry->{time} );
    $hour += 24 * $yday;
    $REP->print("Work time: $hour hours $min minutes $sec seconds\n");
    $REP->print( "Started  : " . localtime( $entry->{time} ) . "\n" );
    $REP->print("Nodes    : $entry->{nodes}\n\n");
    $REP->close();

    {
        local %ENV;
                # Create the environment
        if ( $entry->{env} ) {
            if ( ref( $entry->{env} ) eq 'ARRAY' ) {
                my @new_env;
                my $e;

                @new_env = @{ $entry->{env} };
                foreach $e (@new_env) {
                    $e =~ /(\S+)\s*\=(.*)/;
                    qlog( "ENV '$1' => '$2'\n", LOG_DEBUG )
                        if ( $debug{'env'} );
                    $ENV{$1} = $2 if ( $1 ne '' );
                }
            } else {
                qlog "Bad env :" . ref( $entry->{env} ) . "\n", LOG_ERR;
            }
        }

        $text =
            cleosupport::get_setting( 'user_post_exec', $entry->{user},
            $entry->{profile} );
        if ( $text ne '' ) {
                undef %subst_args;
            subst_task_prop( \$text, $entry, $entry->{time},
                "$hour hours $min minutes $sec seconds" );
            qlog "user exec post: $text\n";
            launch( 0, $text, '' );
        }
    };

    #
    # Exec users killscript
    #
    if ( $text2 ne '' ) {
        undef %subst_args;
        subst_task_prop( \$text2, $entry, $entry->{time},
            "$hour hours $min minutes $sec seconds" );
        qlog "run users killscript: '$text2'\n", LOG_INFO;
        launch( 0, $text2, '' );
    }
    if ( $entry->{status} > 0 ) {
        $text =
            cleosupport::get_setting( 'user_fail_exec', $entry->{user},
            $entry->{profile} );
        if ( $text ne '' ) {
            undef %subst_args;
            subst_task_prop( \$text, $entry, $entry->{time}, "" );
            qlog "run user_fail_exec: '$text'\n", LOG_INFO;
            launch( 0, "$text", '' );
        }
    } else {
        $text =
            cleosupport::get_setting( 'user_ok_exec', $entry->{user},
            $entry->{profile} );
        if ( $text ne '' ) {
            undef %subst_args;
            subst_task_prop( \$text, $entry, $entry->{time}, "" );
            qlog "run user_ok_exec: '$text'\n", LOG_INFO;
            launch( 0, "$text", "$cluster_name.uu-$theid" );
        }
    }

    #
    # delete conf file
    #
    if ( $entry->{use_file} && -f $entry->{use_file} ) {
        unlink $entry->{use_file};
        qlog "Deleted conf-file $entry->{use_file}\n", LOG_INFO;
    }
}

#
#
# Called when one of processes of task is dead
#
##########################################################
sub task_node_dead( $$ ) {
    my ( $id, $node ) = @_;
    my @foo;

    return if ( $id < 1 );
    unless ( exists( $childs_info{$id} ) ) {
        qlog "task_node_dead: No such task id: $id\n", LOG_ERR;
        return;
    }
    push @dead, $id;
    qlog "Completely dead $id\n", LOG_INFO;
}

#
#
# Gets number of tasks of user in queue (and running too)
#
##########################################################
sub count_user_tasks( $ ) {
    my $user = $_[0];

    my ( $q, $ret );

    foreach $q ( @running, @queue, @pending, @foreign ) {
        ++$ret if ( $q->{user} eq $user );
    }

    return $ret;
}

#
#
# Glues replies from a queues tree into right order
#
# args: queue     - head queue (it's answer is NOT glued!)
#       answers   - hash of queues' answers
#       delimiter - what glue with (optional)
# ret:  glued string
#
##########################################################
sub glue_queues_replies( $$;$ ) {
    my ( $queue, $answ, $delim ) = @_;
    my ( $cur,   $out,  $g );

    foreach $cur ( @{ $clusters{$queue}->{childs} } ) {
        if ( exists $answ->{$cur} ) {
            $out .= $delim if ( $out ne '' );
            $out .= $answ->{$cur};
        }
        $g = glue_queues_replies( $cur, $answ );
        if ( $g ne '' ) {
            $out .= $delim if ( $out ne '' );
            $out .= $g;
        }
    }
    return $out;
}

{
    my @rfq   = ();
    my %rfn   = ();
    my $count = 0;

    sub add_run_first_request( $ ) {
        push @rfq, $_[0];
        qlog ">>> req $_[0] $_[0]->{node} ($_[0]->{id} "
            . ( caller(1) )[2] . "/"
            . ( caller(1) )[3]
            . ")\n", LOG_DEBUG;
    }

    sub run_first_done( $ ) {
        qlog ">>> $_[0] run_finished "
            . ( caller(1) )[2] . "/"
            . ( caller(1) )[3]
            . ")\n", LOG_DEBUG;
        delete $rfn{ $_[0] };
    }

    sub try_to_send_run_first {
        my $i;
        ++$count;
        if ( $count > 60 ) {
            $count = 0;
            qlog ">>>! "
                . join( ';', keys(%rfn) ) . "<>"
                . join( ';', map { $_->{node}; } @rfq )
                . "\n", LOG_DEBUG;
        }
        for ( $i = 0; $i <= $#rfq; ++$i ) {
            next if ( !defined $rfq[$i] );
            next if ( exists $rfn{ $rfq[$i]->{node} } );
            main::new_req_to_mon(
                'run_first',                    $rfq[$i],
                $rfq[$i]->{node},               SUCC_ALL | SUCC_OK,
                \&mon_run_first_handler,        undef,
                get_setting('mon_timeout'), \&mon_run_first_handler );

            #cleosupport::get_setting('mon_run_timeout')*(20+$rfq[$i]->{np})
            $rfn{ $rfq[$i]->{node} } = 1;
            $rfq[$i]->{first_node} = $rfq[$i]->{node};
            qlog ">>> $rfq[$i]->{node} run_in_progress\n", LOG_DEBUG;
            splice( @rfq, $i, 1 );
            redo;
        }
    }
};

#
#  extracts from $_[0]->{rsh_string} hostname and command line (for new rsh)
#
sub filter_rsh( $ ) {
    my $args = $_[0];

    my $i;

    my @words = split( /\s+/, $args->{rsh_string} );

    qlog "RSH_STRING: " . join( ';', @words ) . "\n";

    $args->{rsh_host} = $words[0];

    for ( $i = 1; $i <= $#words; ++$i ) {
        if ( ( $words[$i] eq '-l' ) or ( $words[$i] eq '-k' ) ) {
            ++$i;
            next;
        } elsif ( ( $words[$i] eq '-K' )
            or ( $words[$i] eq '-d' )
            or ( $words[$i] eq '-n' ) ) {
            next;
        }
        last;
    }
    $args->{com_line} = join( ' ', @words[ $i .. $#words ] );
    qlog "RSH_STRING2: '$args->{com_line} ($i)'\n";
}

###########################################
#
#  Calls external sceduler
#
#  Args: sceduler name
#
#  Ret: 0 if success, 1 otherwise
###########################################
sub do_external_scedule( $ ) {
    my $sced = $_[0];
    my ( $ret, $n, $starttime );

    qlog "External sceduler '$sced'\n", LOG_DEBUG;

    $starttime=time;

    unless ( exists( $ext_sced{$sced} ) ) {
        qlog "Warning: external sceduler '$sced' does not exisis. Ignore.\n",
            LOG_WARN;
        return 1;
    }

    check_blocked_by_res();

    {
        my @free_sh;
        my @tasks;
        @free_own = ();
        count_free( \@free_own, \%own );
        count_free( \@free_sh,  \%shared );
        foreach my $i ( @pending, @queue ) {    #  @foreign
            next if ( $i->{state} eq 'prerun' );

            push @tasks,
                {
                id        => $i->{id},
                user      => $i->{user},
                np        => $i->{np},
                timelimit => $i->{timelimit},
                blocked   => (
                    defined $i->{blocks} ? scalar( @{ $i->{blocks} } ) : 0 ),
                is_own => ( ( $i->{owner} eq $cluster_name ) ? 1 : 0 ) };
            qlog "To sceduler - task $i->{id}\n", LOG_DEBUG2;
        }
        return unless (@tasks);

        $global_log_prefix =~ /Sced(\d)*/;
        $n = $1 + 1;
        local $global_log_prefix = "Sced${n}> ";
        no strict "refs";
        eval {
            alarm 5;
            $SIG{ALRM} = sub { die "sceduler\n"; };
            ${"CleoSceduler::${sced}::__cleo_mod_error"} = 0;
            qlog "nodes: " . join( ";", @free_own, @free_sh ) . "\n",
                LOG_DEBUG2;
            $ret =
                ( "CleoSceduler::${sced}" . "::do_scedule" )
                ->( \@tasks, $reserved_shared, @free_own, @free_sh );
            $ret += ${"CleoSceduler::${sced}::__cleo_mod_error"};
        };
        alarm 0;

        #$global_log_prefix =~ /Sced(\d)*/;
        #if($1 == 1){
        #  $global_log_prefix="";
        #}else{
        #  $n=$1-1;
        #  $global_log_prefix="Sced${n}>";
        #}
        if ($@) {
            qlog "Sceduler timed out.\n", LOG_WARN;
            $ret = 1;
        }
        if ($ret) {
            qlog "Sceduler has errors...\n", LOG_WARN;
            if ( ++$ext_sced{$sced} > get_setting('max_ext_sced_err') ) {
                qlog "Disable it!\n", LOG_ERR;
                stop_sceduler();
                delete $ext_sced{$sced};
            }
            return 1;
        }
    };
    qlog "Sceduler done.\n", LOG_DEBUG;
    return 0;
}

#
#  Calls sceduler alarm procedure with specified parameters
#
######################################################################
sub sceduler_event( $;$ ) {
    my $sced = get_setting('sceduler');
    return if ( $sced eq 'default' or $sced eq '' );
    return unless defined $ext_sced{$sced};

    my $ret;
    my $tmp = defined $_[1]->{type} ? $_[1]->{type} : '';
    qlog "Sceduler event '$_[0]($tmp)'.\n", LOG_DEBUG;
    {
        local $global_log_prefix = "Sced_event($_[0])> ";
        no strict "refs";
        eval {
            alarm 5;
            $SIG{ALRM} = sub { die "sceduler\n"; };
            ${"CleoSceduler::${sced}::__cleo_mod_error"} = 0;
            $tmp = ( $_[0] eq 'event' ) ? $_[1]->{type} : $_[0];
            $ret = ( "CleoSceduler::${sced}" . "::event" )->( $tmp, $_[1] );
            $ret += ${"CleoSceduler::${sced}::__cleo_mod_error"};
        };
        alarm 0;

        #$global_log_prefix="";
        if ($@) {
            qlog "Sceduler event timed out.\n", LOG_WARN;
            $ret = 1;
        }
        if ($ret) {
            qlog "Sceduler event has errors...\n", LOG_WARN;
            if ( ++$ext_sced{$sced} > get_setting('max_ext_sced_err') ) {
                qlog "Disable it!\n", LOG_ERR;
                stop_sceduler();
                delete $ext_sced{$sced};
            }
            return 1;
        }
    };
    qlog "Sceduler event done.\n", LOG_DEBUG;
}

#
#  Calls sceduler stop procedure
#
######################################################################
sub stop_sceduler() {
    my $sced = get_setting('sceduler');
    return if ( $sced eq 'default' or $sced eq '' );
    return unless defined $ext_sced{$sced};

    my $ret;
    qlog "Stop sceduler.\n", LOG_DEBUG;
    {
        my %info = (
            queue   => $cluster_name,
            version => $VERSION );
        local $global_log_prefix = "Sced_stop> ";
        no strict "refs";
        eval {
            alarm 5;
            $SIG{ALRM} = sub { die "sceduler\n"; };
            ${"CleoSceduler::${sced}::__cleo_mod_error"} = 0;
            $ret = ( "CleoSceduler::${sced}" . "::stop" )->( \%info );
            $ret += ${"CleoSceduler::${sced}::__cleo_mod_error"};
        };
        alarm 0;

        #$global_log_prefix="";
        if ($@) {
            qlog "Stop sceduler timed out.\n", LOG_WARN;
        }
    };
    qlog "Sceduler stopped.\n", LOG_DEBUG;
}

#
#  Calls sceduler start procedure
#
######################################################################
sub start_sceduler() {
    my $sced = get_setting('sceduler');
    return if ( $sced eq 'default' or $sced eq '' );
    return unless defined $ext_sced{$sced};

    my $ret;
    qlog "Start sceduler.\n", LOG_DEBUG;
    {
        my %info = (
            queue   => $cluster_name,
            version => $VERSION );
        local $global_log_prefix = "Sced_start> ";
        no strict "refs";
        eval {
            alarm 5;
            $SIG{ALRM} = sub { die "sceduler\n"; };
            ${"CleoSceduler::${sced}::__cleo_mod_error"} = 0;
            $ret = ( "CleoSceduler::${sced}" . "::start" )->( \%info );
            $ret += ${"CleoSceduler::${sced}::__cleo_mod_error"};
        };
        alarm 0;

        #$global_log_prefix="";
        if ($@) {
            qlog "Start sceduler timed out. Ignore.\n", LOG_WARN;
            ++$ret;
        }
    };
    if ($ret) {
        qlog "Sceduler start has errors...\n", LOG_ERR;
        qlog "Disable it!\n",                  LOG_ERR;
        stop_sceduler();
        delete $ext_sced{$sced};
        return;
    }
    $ext_sced{$sced} = 0;
    qlog "Sceduler started.\n", LOG_DEBUG;
}

#
#  checks, has this task a time restriction
#  if yes - returns 1
#
#################################################
sub check_time_restrictions( $ ) {
    my $q = $_[0];

    my $restricted = 0;
    my $i;

    foreach $i (@time_restrictions) {
        if (( $i->{timeb} > $i->{timee} ) ||    # restriction is in action now
            (   ( $i->{timeb} <= $last_time + $q->{timelimit} )
                &&                              # restriction will affect task
                ( $i->{timee} > $last_time )    # surely will
            )
            ) {
            qlog(
                "Fall into interval of restriction ("
                    . localtime( $i->{timeb} ) . "-"
                    . localtime( $i->{timee} ) . ")\n",
                LOG_DEBUG )
                if $debug{tr};
            if ( $i->{allow} > 0 )
            { # 'users' field MUST be non-empty - we force to allow them to run
                if ( $i->{users} =~ /\b$q->{user}\b/ ) {
                    qlog "Forced Allow for $q->{user}! ($i->{users})\n",
                        LOG_INFO;
                    $restricted = 0;
                    last;
                }
            } else {    # we DENY some users (or all of them) to run...
                if ( $i->{users} ne '' ) {    # list of users is given
                    if ( $i->{users} =~ /\b$q->{user}\b/ ) {
                        qlog "Deny for for $q->{user} ($i->{users})\n",
                            LOG_INFO;
                        $restricted = 1;
                    }
                } else {                      # deny to ALL
                    qlog "Deny all users to run ($q->{user})!\n", LOG_INFO;
                    $restricted = 1;
                }
            }
        }
    }
    qlog "Time restriction for $q->{id}: $restricted\n", LOG_INFO;
    return $restricted;
}

{
    my ( $year, $wday, $month, $mday, $i, $t, $newtime );

    #
    #  Updates actual times of restrictions rules
    #
    #  args: 1 - is it the first time after loading restrictions (opt)
    #
    ##########################################################
    sub correct_time_restrictions( ;$ ) {
        my $first_time = $_[0];

        return if ( $next_restriction_time > $last_time and !$first_time );

        $year = 0;
        $i    = 0;

        $next_restriction_time    = 0;
        $restriction_time_changed = 0;

        while ( $i < @time_restrictions ) {
            qlog "RESTRICT: begin="
                . localtime( $time_restrictions[$i]->{timeb} ) . " end="
                . localtime( $time_restrictions[$i]->{timee} )
                . "\n", LOG_INFO;
            unless ( $time_restrictions[$i]->{enabled} ) {
                splice( @time_restrictions, $i, 1 );
                qlog "RESTRICT: delete it.\n", LOG_INFO;
                next;
            }
            if ( $last_time > $time_restrictions[$i]->{timeb} ) {
                $time_restrictions[$i]->{timeb} =
                    next_time( $time_restrictions[$i]->{timeb_every} );
            }
            if ( $last_time > $time_restrictions[$i]->{timee} ) {
                $time_restrictions[$i]->{timee} =
                    next_time( $time_restrictions[$i]->{timee_every} );
            }

            #get minimal time in the future...
            if (( $time_restrictions[$i]->{timeb} >
                    $last_time )    # time in the future
                and ( $time_restrictions[$i]->{timeb} < $next_restriction_time
                    or $next_restriction_time == 0 )    # time is minimum
                ) {
                $next_restriction_time    = $time_restrictions[$i]->{timeb};
                $restriction_time_changed = 1;
            }
            if (( $time_restrictions[$i]->{timee} >
                    $last_time )                        # time in the future
                and ( $time_restrictions[$i]->{timee} < $next_restriction_time
                    or $next_restriction_time == 0 )    # time is minimum
                ) {
                $next_restriction_time    = $time_restrictions[$i]->{timee};
                $restriction_time_changed = 1;
            }
            ++$i;
        }
        qlog "RESTRICT:  next=" . localtime($next_restriction_time) . "\n",
            LOG_ALL;
    }    #~correct_time_restrictions

    #
    #  Computes next actual time for restriction
    #
    #######################################################
    sub next_time( $ ) {
        $t = $_[0];

        unless ($year) {
            ( undef, undef, undef, $mday, $month, $year, $wday ) =
                localtime($last_time);
        }
        unless ( $t =~ /(\d+):(\d+)\s+(\d+)(\s(\d+))?/ ) {
            qlog "BAD TIME RESTRICTION: $t\n", LOG_WARN;
            return 0;
        }
        if ( $4 > 0 ) {    # hh:mm day month
            my $ret = timelocal( 0, $2, $1, $3, $4 - 1, $year );
            return $ret;
        }

        # hh:mm day_of_week
        my $newwday = $3;
        my $ret = timelocal( 0, $2, $1, $mday, $month, $year );
        $ret += 86400 * ( $newwday - $wday );
        qlog "day of week given ($newwday). $ret (" . localtime($ret) . ")\n",
            LOG_DEBUG;
        if ( $last_time >= $ret ) {
            qlog "Next week\n", LOG_DEBUG;
            $ret += 7 * 86400;
        }
        qlog "Time is: $ret (" . localtime($ret) . ")\n", LOG_DEBUG;
        return $ret;
    }    #~next_time
};

#
#  Loads all time restrictions rules
#  It does NOT update next_restriction_time!!!
#
#  args: 1 - file name
#
###########################################################
sub load_restrictions( $ ) {
    my $cl;

    qlog "Loading restrictions: $_[0]\n", LOG_INFO;
    return 1 unless open( R, "<$_[0]" );

    @time_restrictions        = ();
    $restriction_time_changed = 1;
    while (<R>) {
        next if (/^\s*(\#.*)?$/);    # skip comments and empty lines

        unless (
            /^\s*(\S+:)?                  #1 cluster
            \s*(\d+)\s+                  #2 enabled
            (\d+)\s+                     #3 once
            (\d+)\s+                     #4 allow
            (\d+:\d+\s+\d+(\s+\d+)?)\s+  #5+6 time begin every xx:xx day [month]
            \-\s+
            (\d+:\d+\s+\d+(\s+\d+)?)     #7+8 time end every xx:xx day [month]
            (\s.*)                       #9 for users
            /x
            ) {
            qlog "Bad restriction line: $_\n", LOG_WARN;
        }
        $cl = $1;
        my %r = (
            enabled     => "$2",
            once        => "$3",
            allow       => "$4",
            timeb_every => "$5",
            timee_every => "$7",
            timeb       => 0,
            timee       => 0,
            users       => "$9" );
        $cl = ( substr( $cl, 0, -1 ) );
        next if ( ( $cl ne '' ) and ( $cl ne $cluster_name ) );

        chomp( $r{users} );
        push @time_restrictions, \%r;
        qlog
            "Loaded: allow=$r{allow} begin='$r{timeb_every}' end='$r{timee_every}' users=$r{users} ($1/$2/$3/$4/$5)\n",
            LOG_INFO;
    }
    close R;
    qlog "Done.(" . scalar(@time_restrictions) . " rules loaded)\n", LOG_INFO;
    return 0;
}    #~load_restrictions

#
#  tests all tasks dependencies for given task
#  args: task entry
#  ret : 0 if all deps acquired, 1 if not, 2 if dep is fatal.
#
###########################################################
sub test_dependencies( $ ) {
    my $qentry = $_[0];
    my ( $i, $j, $successfull_cond, $total_cond );

    $total_cond = 0;
    if ( defined $qentry->{wait_for_run} ) {
        $total_cond = scalar( @{ $qentry->{wait_for_run} } );
        foreach $i ( @{ $qentry->{wait_for_run} } ) {
            $j = find_runned($i);

            if ( $j >= 0 ) {    # found
                ++$successfull_cond;
            } else {
                if ( $qentry->{wait_cond_type} eq 'a' ) {    # 'and'
                    return 1;
                }
            }
        }
    }
    if ( defined $qentry->{wait_for_ok} ) {
        $total_cond += scalar( @{ $qentry->{wait_for_ok} } );
        foreach $i ( @{ $qentry->{wait_for_ok} } ) {
            $j = find_runned($i);
            qlog "Found runned (ok)=$j\n", LOG_DEBUG;

            if ( $j < 0 ) {                                  # not found
                next if ( $qentry->{wait_cond_type} ne 'a' );
            }

            qlog "Found runned code (ok)=$runned_list[$j]->{exitcode}\n",
                LOG_DEBUG;
            if ( $runned_list[$j]->{exitcode} < 0 ) {
                return 1 if ( $qentry->{wait_cond_type} eq 'a' );
            }
            if ( $runned_list[$j]->{exitcode} > 0 ) {
                return 2 if ( $qentry->{wait_cond_type} eq 'a' );
            }
            ++$successfull_cond;
        }
    }
    if ( defined $qentry->{wait_for_fail} ) {
        $total_cond += scalar( @{ $qentry->{wait_for_fail} } );
        foreach $i ( @{ $qentry->{wait_for_fail} } ) {
            $j = find_runned($i);
            qlog "Found runned (fail)=$j\n", LOG_DEBUG;

            if ( $j < 0 ) {    # not found
                return 1 if ( $qentry->{wait_cond_type} eq 'a' );
            }

            qlog "Found runned code (fail)=$runned_list[$j]->{exitcode}\n",
                LOG_DEBUG;
            if ( $runned_list[$j]->{exitcode} < 0 ) {
                return 1 if ( $qentry->{wait_cond_type} eq 'a' );
            }
            if ( $runned_list[$j]->{exitcode} == 0 ) {
                return 2 if ( $qentry->{wait_cond_type} eq 'a' );
            }
            ++$successfull_cond;
        }
    }
    if ( $total_cond == 0 ) {
        return 0;
    } elsif ( ( $qentry->{wait_cond_type} eq 'o' ) && $successfull_cond > 0 )
    {
        return 0;
    } elsif ( ( $qentry->{wait_cond_type} eq 'a' )
        && $successfull_cond == $total_cond ) {
        return 0;
    }
    return 1;
}

#
#  Gets opts like this: ('X=i',) (this means "option '-X 10' to variable $options{X}=10)
#  The scans command line for options till founds argument '--' or non-specified
#  option, or not '-' prefixed argument.
#  Specifications of options (what goes after 'X='):
#  i - integer
#  s - string
#  + - cumulative value (variable MUST be a list)
#  nothing - flag
#
sub GetOptsTillCan_hash {

    # \%hash,"arg1","arg2,...
    my $hash = shift @_;
    my @args = @_;
    my ( %args, $arg, $a_key, $a_value, $a, $next, %types );

    foreach $arg (@args) {
        $arg =~ /^(\S+)(\=)(.*)/ or next;
        $a_key         = $1;
        $a_value       = $args{$arg};
        $types{$a_key} = $3;

        delete $args{$arg};
        $args{$a_key} = $a_value;
    }

    while ( $next = shift @ARGV ) {

        #    print ">>$next<[$ARGV[0]]\n";
        last if ( substr( $next, 0, 1 ) ne '-' );
        last if ( $next eq '--' );
        $a = substr( $next, 1 );
        last unless ( exists $args{$a} );
        undef $next;
        if ( ( $types{$a} eq 'i' ) || ( $types{$a} eq 's' ) ) {
            $hash->{$a} = shift @ARGV;
        } elsif ( $types{$a} eq '' ) {
            $hash->{$a} = 1;
        } elsif ( $types{$a} eq '+' ) {
            push @{ $hash->{$a} }, shift @ARGV;
        }
    }
    unshift @ARGV, $next if ( defined $next );
}

#
#  Commit statistics entry for given entry
#
###########################################################
sub account_end( $ ) {
    my $q = $childs_info{ $_[0] };

    my $u = $q->{user};
    my $t;

    ++$acc_user_all{$u}->{ntasks};
    ++$acc_user{$u}->{ntasks};
    if ( $q->{status} == 0 ) {
        ++$acc_user_all{$u}->{ntasks_ok};
        ++$acc_user{$u}->{ntasks_ok};
    } else {
        ++$acc_user_all{$u}->{ntasks_fail};
        ++$acc_user{$u}->{ntasks_fail};
    }

    $acc_user_all{$u}->{npmax} = $q->{np}
        if ( !defined $acc_user_all{$u}->{npmax}
        or $acc_user_all{$u}->{npmax} < $q->{np} );
    $acc_user_all{$u}->{npmin} = $q->{np}
        if ( !defined $acc_user_all{$u}->{npmin}
        or $acc_user_all{$u}->{npmin} > $q->{np} );
    $acc_user{$u}->{npmax} = $q->{np}
        if ( !defined $acc_user{$u}->{npmax}
        or $acc_user{$u}->{npmax} < $q->{np} );
    $acc_user{$u}->{npmin} = $q->{np}
        if ( !defined $acc_user{$u}->{npmin}
        or $acc_user{$u}->{npmin} > $q->{np} );

    $t = $q->{endtime} - $q->{time};
    $acc_user_all{$u}->{time} += $t;
    $acc_user{$u}->{time}     += $t;
    $acc_user_all{$u}->{mintime} = $t
        if ( !defined $acc_user_all{$u}->{mintime}
        or $acc_user_all{$u}->{mintime} > $t );
    $acc_user{$u}->{mintime} = $t
        if ( !defined $acc_user{$u}->{mintime}
        or $acc_user_all{$u}->{mintime} > $t );
    $acc_user_all{$u}->{maxtime} = $t
        if ( !defined $acc_user_all{$u}->{maxtime}
        or $acc_user_all{$u}->{mintime} > $t );
    $acc_user{$u}->{maxtime} = $t
        if ( !defined $acc_user{$u}->{maxtime}
        or $acc_user{$u}->{maxtime} > $t );

    $t = $t * $q->{np};
    $acc_user_all{$u}->{sumtime} += $t;
    $acc_user{$u}->{sumtime}     += $t;
    $acc_user_all{$u}->{summintime} = $t
        if ( !defined $acc_user_all{$u}->{summintime}
        or $acc_user_all{$u}->{summintime} > $t );
    $acc_user{$u}->{summintime} = $t
        if ( !defined $acc_user{$u}->{summintime}
        or $acc_user{$u}->{summintime} > $t );
    $acc_user_all{$u}->{summaxtime} = $t
        if ( !defined $acc_user_all{$u}->{summaxtime}
        or $acc_user_all{$u}->{summaxtime} > $t );
    $acc_user{$u}->{summaxtime} = $t
        if ( !defined $acc_user{$u}->{summaxtime}
        or $acc_user{$u}->{summaxtime} > $t );

}

#
#  Open statistics entry for given entry
#
###########################################################
sub account_start( $ ) {

}

#
#  Resets daily accout statistics
#
###########################################################
sub account_reset_daily() {
    undef %acc_user;
}

#
#  Resets total accout statistics
#
###########################################################
sub account_reset() {
    undef %acc_user_all;
}

#
#  Saves account records to given file descriptor
#
###########################################################
sub account_save( $ ) {
    my $f = $_[0];
    my $i;

    foreach $i ( sort( keys(%acc_user) ) ) {
        print $f "$i ntasks acc_user{$i}->{ntasks}\n";
        print $f "$i ntasks acc_user_all{$i}->{ntasks}\n";
        print $f "$i ntasks_ok acc_user{$i}->{ntasks_ok}\n";
        print $f "$i ntasks_ok acc_user_all{$i}->{ntasks_ok}\n";
        print $f "$i ntasks_fail acc_user{$i}->{ntasks_fail}\n";
        print $f "$i ntasks_fail acc_user_all{$i}->{ntasks_fail}\n";
        print $f "$i npmax acc_user{$i}->{npmax}\n";
        print $f "$i npmax acc_user_all{$i}->{npmax}\n";
        print $f "$i npmin acc_user{$i}->{npmin}\n";
        print $f "$i npmin acc_user_all{$i}->{npmin}\n";
        print $f "$i time acc_user{$i}->{time}\n";
        print $f "$i time acc_user_all{$i}->{time}\n";
        print $f "$i mintime acc_user{$i}->{mintime}\n";
        print $f "$i mintime acc_user_all{$i}->{mintime}\n";
        print $f "$i maxtime acc_user{$i}->{maxtime}\n";
        print $f "$i maxtime acc_user_all{$i}->{maxtime}\n";
        print $f "$i sumtime acc_user{$i}->{sumtime}\n";
        print $f "$i sumtime acc_user_all{$i}->{sumtime}\n";
        print $f "$i summintime acc_user{$i}->{summintime}\n";
        print $f "$i summintime acc_user_all{$i}->{summintime}\n";
        print $f "$i summaxtime acc_user{$i}->{summaxtime}\n";
        print $f "$i summaxtime acc_user_all{$i}->{summaxtime}\n";
    }
}

#
#  Loads account records from given file descriptor
#
###########################################################
sub account_load( $ ) {
    my $f = $_[0];
    my $i;

    while (<$f>) {
        /^(\S+)\s(\S+)\s(.*)/;
        acc_user {$1}->{$2} = $3;
        <$f>;
        /^(\S+)\s(\S+)\s(.*)/;
        acc_user_all {$1}->{$2} = $3;
    }
}

#
#  Mark channel as dead.
#  Also check it for monitor belonging and mark this monitor as dead
#
###########################################################
#sub mark_channel_dead( $ ) {
#    for my $m ( keys(%mons) ) {
#        if ( defined $mons{$m}->{to} and ( $mons{$m}->{to} eq $_[0] ) ) {
#            $mons{$m}->{last_response} = 0;
#            undef $mons{$m}->{to};
#            $mons{$m}->{state} = 'fail';    # for on_mon_dead.
#            on_mon_disconnect($m);
#            last;
#        }
#    }
#    eval { kill_conn( $_[0] ); };
#}

#
#  Does processing for new user connection
#  all init and auth stages, then calls processor
#
#  Args: \%new_conn - new connection description
#          -> begin - time of accept
#             ch    - Cleo::Conn
#             state - state of processing (initially 1)
#
###########################################################
sub handle_user_connection( $ ) {

    my $conn = $_[0];
    my ($line,$tmp);

    if($conn->{ch}->get_state ne 'ok'){
        qlog "User conn: disconnected\n", LOG_INFO;
        undef $conn;
        return;
    }

    # timed out?
    if ( $conn->{begin} + get_setting('timeout') < $last_time ) {
        $conn->{ch}->send("-Identification timed out.\n");
        qlog "User conn: Timed out\n", LOG_INFO;
        $conn->{ch}->flush;
        undef $conn;
        return;
    }

    # first line processing
    if ( $conn->{state} == 1 ) {
        $line=get_line($conn->{ch});
        if($line eq '') {
            sc_task_in( 0, \&handle_user_connection, $conn );
            return;
        }

        qlog "User conn: Got '$line'\n", LOG_INFO;

        my ( $type, $pid, $user );
        unless( ( $type, $user, $pid ) =
            ( $line =~ /^(\w+):([-_0-9a-zA-Z.]+):(\w+):/ ) ) {
            qlog "User conn: Bad request header '$line'\n", LOG_WARN;
            $conn->{ch}->disconnect;
            undef $conn;
            return;
        }
        $conn->{user}  = $user;
        $conn->{type}  = $type;
        $conn->{pid}   = $pid;
        $conn->{state} = 3;
        $conn->{time}  = $last_time;
    }

    # authentication fase (init)
    if ( $conn->{state} == 3 ) {
        my $o = get_block_x( $conn->{ch} );

        if ( !( defined $o ) or ( $#$o < 0 ) ) {
            if ( $conn->{time} + get_setting('timeout') < $last_time ) {
                qlog "User conn: Request timed out ($conn->{type})\n",
                    LOG_WARN;
                $conn->{ch}->disconnect;
                undef $conn;
            } else {
                sc_task_in( 0, \&handle_user_connection, $conn );
            }
            return;
        }

        chomp @$o;
        {
            my %args;
            get_args_from_array( \%args, $o );
            $conn->{args} = \%args;
            qlog "BODY2: " . join( ';', keys( %{ $conn->{args} } ) ) . "\n",
                LOG_DEBUG2;
        }
        $conn->{test} = generate_string();
        $conn->{ch}->send("+auth:$conn->{test}\n");
        $conn->{ch}->flush;
        $conn->{state} = 4;
        qlog "User conn: Sending authorization\n", LOG_INFO;
        sc_task_in( 0, \&handle_user_connection, $conn );
        return;
    }

    # authentication fase (verification) and reaction
    if ( $conn->{state} == 4 ) {
        qlog "BODY3: " . join( ';', keys( %{ $conn->{args} } ) ) . "\n",
            LOG_DEBUG2;
        $line = get_line( $conn->{ch} );
        if( $line eq '' ) {
            sc_task_in( 0, \&handle_user_connection, $conn );
            return;
        }
        unless ( $line eq "+ok" ) {
            qlog "User conn: Bad auth answer: '$line'\n", LOG_WARN;
            $conn->{ch}->send("-Bad auth answer\n");
            $conn->{ch}->disconnect;
            undef $conn;
            return;
        }

        # verify
        unless ( $opts{x} ) {
            my ( $uid2, $argv02 ) =
                @{ get_user_argv0_by_pid( $conn->{pid} ) };
            if ( $uid2 == -1 or $argv02 != $conn->{test} ) {
                qlog "User conn: Auth failed\n", LOG_WARN;
                $conn->{ch}->send(
                    "-Auth failed! You are attempting to spoof. Don't do this!\n"
                );
                $conn->{ch}->disconnect;
                undef $conn;
                return;
            }
        }

        # OK! Now react
        qlog "User conn: authorizing done (type=$conn->{type})\n", LOG_INFO;
        $conn->{args}->{user} = $conn->{user};
        $conn->{args}->{queue} ||=
            cleosupport::get_setting( 'def_queue', $conn->{user},
            $conn->{args}->{profile} );
        delete $conn->{pid};
        delete $conn->{user};

        if (!is_in_list(
                $conn->{args}->{queue},
                \@{ $child_aliases{$cluster_name} } )
            ) {
            $conn->{ch}->send(
                "-Queue $conn->{args}->{queue} does not exists\n" );
            $conn->{ch}->disconnect;
            undef $conn;
            return;
        }
        qlog "BODY4: " . join( ';', keys( %{ $conn->{args} } ) ) . "\n",
            LOG_DEBUG2;

        #
        #  PROCESS COMMAND
        #
        if ( exists( $user_processors{ $conn->{type} } ) ) {
            $user_processors{ $conn->{type} }->( $conn->{ch}, $conn->{args} );
            undef $conn;
            return;
        }
        qlog "User conn: Command is not recognized ($conn->{type})\n",
            LOG_WARN;
        $conn->{ch}->send(
            "-Command is not recognized ($conn->{type})\n" );
        $conn->{ch}->disconnect;
        undef $conn;
        return;
    }
    qlog
        "Internal error: Unexpected state in user request processing: $conn->{state}\n";
    undef $conn;
}    # ~handle_user_connection

################################
################################
#
#  Processing ADD user request
#
################################
################################
sub user_add_processor( $$ ) {
    my ( $ch, $args ) = @_;

    my ( $tmout, $tmout_max, $adm, $tmpval, $tmpval2, $i );

    if ( $args->{command} eq '' ) {
        qlog "ADD: No command line given!\n", LOG_WARN;
        $ch->send("-No command line given!\n" );
        $ch->disconnect;
        return;
    }

    qlog "_ADD request $args->{queue}/$args->{command}/$args->{np}\n";
    slog "ADD request $args->{user}; $args->{queue}; $args->{np}; $args->{command}\n";

    load_user_conf( $args->{user} );

    $args->{path}     ||= $user_home{ $args->{user} };
    $args->{dir}      ||= $args->{path};
    $args->{temp_dir} ||=
        cleosupport::get_setting( 'temp_dir', $args->{user}, $args->{profile},
        $args->{queue} );
    $args->{outfile} ||=
        cleosupport::get_setting( 'outfile', $args->{user}, $args->{profile},
        $args->{queue} );
    $args->{repfile} ||=
        cleosupport::get_setting( 'repfile', $args->{user}, $args->{profile},
        $args->{queue} );
    $args->{one_rep} ||=
        cleosupport::get_setting( 'one_report', $args->{user},
        $args->{profile}, $args->{queue} );
    $args->{use_empty} ||=
        cleosupport::get_setting( 'use_empty', $args->{user},
        $args->{profile}, $args->{queue} );
    $args->{empty_input} ||=
        cleosupport::get_setting( 'empty_input', $args->{user},
        $args->{profile}, $args->{queue} );

    if ( $args->{env} ) {
        my @env = split( /\0/, unpack( 'u', $args->{env} ) );
        undef $args->{env};
        @{ $args->{env} } = @env;
    }
    $tmout =
        cleosupport::get_setting( 'default_time', $args->{user},
        $args->{profile}, $args->{queue} );
    $tmout_max =
        cleosupport::get_setting( 'max_time', $args->{user}, $args->{profile},
        $args->{queue} );

    $adm = 1 if ( isadmin( $args->{user}, $args->{queue} ) );

    qlog "TIMELIMIT0: $args->{timelimit} / $tmout_max / $adm\n", LOG_INFO;

    if ( defined $args->{timelimit} ) {
        if (    !$adm
            and ( $tmout_max > 0 )
            and ( $args->{timelimit} > $tmout_max ) ) {
            qlog "Timelimit is too high\n", LOG_INFO;
            $ch->send(
                "-Illegal timelimit specified ($args->{timelimit} secs). Allowed Maximum is $tmout_max\n"
            );
            $ch->disconnect;
            return;
        }

        #$args->{timelimit} = $tmout_max;
    } else {
        if ($adm) {
            $args->{timelimit} = $tmout;
        } else {
            $args->{timelimit} = min( $tmout, $tmout_max );
        }
    }

    qlog "MM $args->{queue}/$args->{path}/$args->{temp_dir}/$args->{outfile}/"
        . "$args->{repfile}/$args->{one_rep}/$args->{com_line};\n", LOG_DEBUG;
    qlog "Checking $args->{user} in $args->{queue} ("
        . join( ',', @{ $cluster_settings{ $args->{queue} }->{users} } )
        . ")("
        . join( ',', @{ $cluster_settings{ $args->{queue} }->{nousers} } )
        . ")\n", LOG_INFO;
    if ( scalar( @{ $cluster_settings{ $args->{queue} }->{nousers} } ) > 0 ) {
        if (is_in_list(
                $args->{user},
                \@{ $cluster_settings{ $args->{queue} }->{nousers} } )
            ) {
            $ch->send(
                "-You are not allowed to add tasks to queue $args->{queue}! (not valid user)\n"
            );
            $ch->disconnect;
            return;
        }
    }
    if ( scalar( @{ $global_settings{nousers} } ) > 0 ) {
        if ( is_in_list( $args->{user}, \@{ $global_settings{nousers} } ) ) {
            $ch->send("-You are not allowed to add tasks to queue $args->{queue}! (not valid user!)\n");
            $ch->disconnect;
            return;
        }
    }
    if ( scalar( @{ $cluster_settings{ $args->{queue} }->{users} } > 0 )
        && !$adm ) {
        unless (
            is_in_list(
                $args->{user},
                \@{ $cluster_settings{ $args->{queue} }->{users} } )
            ) {
            $ch->send(
                "-You are not allowed to add tasks to queue $args->{queue}! (not in list of users)\n"
            );
            $ch->disconnect;
            return;
        }
    }
    if ( scalar( @{ $global_settings{users} } > 0 ) && !$adm ) {
        if ( !is_in_list( $args->{user}, \@{ $global_settings{users} } ) ) {
            $ch->send(
                "-You are not allowed to add tasks to queue $args->{queue}! (not in list of users!)\n"
            );
            $ch->disconnect;
            return;
        }
    }

    $tmpval =
        cleosupport::get_setting( 'min_np', $args->{user}, $args->{profile},
        $args->{queue} );
    if ( !$adm && $args->{np} < $tmpval ) {
        $ch->send(
            "-Illegal number of processes requested ($args->{np}). Minimum $tmpval allowed\n"
        );
        $ch->disconnect;
        return;
    }
    $tmpval =
        cleosupport::get_setting( 'max_np', $args->{user}, $args->{profile},
        $args->{queue} );
    if ( !$adm && $args->{np} > $tmpval ) {
        $ch->send(
            "-Illegal number of processes requested ($args->{np}). Maximum $tmpval allowed\n"
        );
        $ch->disconnect;
        return;
    }
    $tmpval =
        cleosupport::get_setting( 'max_sum_np', $args->{user},
        $args->{profile}, $args->{queue} );
    if ( !$adm && $args->{np} > $tmpval ) {
        $ch->send(
            "-Illegal number of processes requested ($args->{np}). Maximum, can be used is $tmpval\n"
        );
        $ch->disconnect;
        return;
    }
    $tmpval =
        cleosupport::get_setting( 'priority', $args->{user}, $args->{profile},
        $args->{queue} );
    $tmpval2 =
        cleosupport::get_setting( 'def_priority', $args->{user},
        $args->{profile}, $args->{queue} );
    qlog "GET_PRI=$tmpval / $tmpval2 / $args->{priority}\n", LOG_DEBUG;
    $args->{priority} = $tmpval2 if ( $args->{priority} eq '' );

    if ( !$adm && $args->{priority} > $tmpval ) {
        $ch->send(
            "-Illegal priority specified ($args->{priority}). Maximum value is $tmpval\n"
        );
        $ch->disconnect;
        return;
    }

    my ( $b, $exe );
    if($args->{args0} ne ''){
        # new style client
        undef $args->{task_args};
        for (my $i = 0; ; ++$i){
            last unless defined $args->{"args$i"};
            push @{$args->{task_args}}, $args->{"args$i"};
            delete $args->{"args$i"};
        }
        undef $args->{command};
        undef $args->{task};
        $exe = $args->{task_args}->[0];
    }
    else{
        $args->{command} =~ tr/\|\>\<\&\0\n\r/::::/d;
        #$b = $args->{command} . "\0";
        #($exe) = ( $b =~ m{^\S*?([^/\0\s]+)\0|\s} );

        #$args->{task} = $args->{command};
        @{$args->{task_args}}=split(/\s+/,$args->{command});
        undef $args->{task};
        $exe = $args->{task_args}->[0];
    }
    $args->{np}           = $args->{np};
    $args->{npextra}      = 0;
    $args->{owner}        = $args->{queue};
    $args->{lastowner}    = $args->{queue};
    $args->{exe}          = $exe;
    $args->{gummy}        = 0;
    $args->{status}       = 0;
    $args->{state}        = 'queued';
    $args->{qtype}        = NATIVE_QUEUE;
    $args->{core}         = 0;
    $args->{signal}       = 0;
    $args->{own}          = '';
    $args->{shared}       = '';
    $args->{com_line}     = '';
    $args->{run_via_mons} =
        &cleosupport::get_setting( 'run_via_mons', $args->{user},
    $args->{profile}, $args->{queue} );
    $args->{rsh_filter} =
        &cleosupport::get_setting( 'rsh_filter', $args->{user},
    $args->{profile}, $args->{queue} );
    $args->{use_rsh_filter} =
        &cleosupport::get_setting( 'use_rsh_filter', $args->{user},
    $args->{profile}, $args->{queue} );
    $args->{file_mask} =
        &cleosupport::get_setting( 'file_mask', $args->{user},
    $args->{profile}, $args->{queue} );
    $args->{pe_select} ||=
        &cleosupport::get_setting( 'pe_select', $args->{user},
    $args->{profile}, $args->{queue} );
    $args->{occupy_full_node} ||= &cleosupport::get_setting(
        'occupy_full_node', $args->{user},
        $args->{profile},   $args->{queue} );

    my $a = Storable::thaw( Storable::freeze($args) );    # clone args

    new_req_to_child(
        'add',                    $a,
        $args->{queue},           0,
        SUCC_ALL | SUCC_OK,       \&chld_add_handler,
        \&chld_every_add_handler, get_setting('intra_timeout'),
        \&chld_add_handler,       'channel',
        $ch );

}    # ~user_add_processor

################################
################################
#
#  Processing DEL user request
#
################################
################################
sub user_del_processor( $$ ) {
    my ( $ch, $args ) = @_;

    #  $args->{id}       ||= 0;
    #$args->{myid}     ||= 0;
    $args->{recurs}   ||= 0;
    $args->{mask}     ||= '';
    $args->{rmask}    ||= '';
    $args->{userlist} ||= '';
    $args->{forced}   ||= 0;
    if ( $args->{id} !~ /^\d|all/ ) {
        qlog
            "Bad id in del request to $args->{queue} by $args->{user} ($args->{id})\n",
            LOG_WARN;
        return;
    }

    qlog "_DEL request $args->{queue} by $args->{user} id='$args->{id}' res=$reserved_shared\n",
        LOG_INFO;
    slog "DEL request $args->{user}; $args->{queue}; $args->{id}\n";
    if ( $args->{queue} eq $cluster_name ) {
        qlog "M:$args->{mask}:$args->{rmask}$args->{userlist};\n", LOG_DEBUG;
        $ch->send(del_task(
                $args->{id},       $args->{user},  $args->{mask},
                $args->{userlist}, $args->{rmask}, $args->{forced},
                $args->{reason} )
        );
        $last_del = $last_time;
        $ch->disconnect;
        dump_queue();
    } else {    # child cluster!
        my $a = Storable::thaw( Storable::freeze($args) );    # clone args
        new_req_to_child(
            'del_local',                  $a,
            $args->{queue},               $args->{recurs},
            SUCC_ALL | SUCC_OK,           \&chld_del_loc_handler,
            \&chld_every_del_loc_handler, get_setting('intra_timeout'),
            \&chld_del_loc_handler,
            'channel', $ch,
            'num',     0 );

    }
}    # ~user_del_processor

################################
################################
#
#  Processing VIEW user request
#
################################
################################
sub user_view_processor( $$ ) {
    my ( $ch, $args ) = @_;

    qlog
        "_VIEW request $args->{queue}/$args->{showsub} res=$reserved_shared\n",
        LOG_INFO;
    slog "VIEW request $args->{user}; $args->{queue}\n";
    unless ( isadmin( $args->{user}, $args->{queue} ) ) {
        if ( exists( $cluster_settings{ $args->{queue} }->{nousers} )
            and scalar( @{ $cluster_settings{ $args->{queue} }->{nousers} } )
            > 0 ) {
            if (is_in_list(
                    $args->{user},
                    \@{ $cluster_settings{ $args->{queue} }->{nousers} } )
                ) {
                $ch->send(
                    "-You are not allowed to view status of $args->{queue}! (not a valid user)\n"
                );
                $ch->disconnect;
                return;
            }
        }
        if ( scalar( @{ $global_settings{nousers} } ) > 0 ) {
            if (is_in_list( $args->{user}, \@{ $global_settings{nousers} } ) )
            {
                $ch->send(
                    "-You are not allowed to view status of $args->{queue}! (not a valid user!)\n"
                );
                $ch->disconnect;
                return;
            }
        }
        if (exists($cluster_settings{ $args->{queue} }->{users} ) and
            scalar(@{ $cluster_settings{$args->{queue}}->{users}}) > 0
            and !is_in_list(
                $args->{user},
                \@{ $cluster_settings{ $args->{queue} }->{users} } )
            ) {
            qlog "Users (local): "
                . join( ',',
                @{ $cluster_settings{ $args->{queue} }->{users} } )
                . ";\n", LOG_DEBUG2;
            $ch->send(
                "-You are not allowed to view status of $args->{queue}! (not in list of users)\n"
            );
            $ch->disconnect;
            return;
        }
        if ( scalar( @{ $global_settings{users} } ) > 0
            && !is_in_list( $args->{user}, \@{ $global_settings{users} } ) ) {
            qlog "Users: "
                . join( ',', @{ $global_settings{users} } )
                . ";\n", LOG_DEBUG2;
            $ch->send(
                "-You are not allowed to view status of $args->{queue}! (not in list of users!)\n"
            );
            $ch->disconnect;
            return;
        }
    }
    if ( $args->{flags} eq '' ) {
        if ( isadmin( $args->{user} ) ) {
            $args->{flags} = cleosupport::get_setting(
                'def_admview_flags', $args->{user},
                $args->{profile},    $args->{queue} );
        } else {
            $args->{flags} = cleosupport::get_setting(
                'def_view_flags', $args->{user},
                $args->{profile}, $args->{queue} );
        }
    }
    my ( $x, $h );
    my %new_args = (
        'showsub', 0,             'full',  $args->{full},
        'tech',    $args->{tech}, 'flags', $args->{flags},
        'user',    $args->{user}, 'queue', $args->{queue} );
    if ( $args->{queue} eq $cluster_name ) {
        if ( $args->{showsub} ) {
            new_req_to_child(
                'view',                    \%new_args,
                '__ALL__',                 1,
                SUCC_ALL | SUCC_OK,        \&chld_view_handler,
                \&chld_every_view_handler, get_setting('intra_timeout'),
                \&chld_view_handler,
                'channel', $ch );
        } else {
            $ch->send(
                "+ok\n"
                    . get_task_list_w_flags( $args->{user}, $args->{flags} )
            );
            $ch->disconnect;
        }
    } else {    # child cluster!
        new_req_to_child(
            'view',                    \%new_args,
            $args->{queue},            $args->{showsub},
            SUCC_ALL | SUCC_OK,        \&chld_view_handler,
            \&chld_every_view_handler, get_setting('intra_timeout'),
            \&chld_view_handler,
            'channel', $ch );
    }
}    # ~user_view_processor

################################
################################
#
#  Processing DEBUG user request
#
################################
################################
sub user_debug_processor( $$ ) {
    my ( $ch, $args ) = @_;

    qlog "_DEBUG request $args->{queue} by $args->{user}\n", LOG_INFO;
    if ( !candebug( $args->{user}, $args->{queue} ) ) {
        $ch->send( "-You cannot debug this queue!\n" );
    } else {
        if ( $args->{queue} eq $cluster_name ) {
            $ch->send( "+ok\n" );
            if ( $args->{recurse} > 0 ) {
                new_req_to_child(
                    'debug',            $args,
                    '__all__',          1,
                    SUCC_ALL | SUCC_OK, \&nil_sub,
                    \&nil_every_sub,    0,
                    \&nil_sub );
            }
            qlog "debug ($args->{command})\n";
            eval "{no strict; sub qlog(\$;\$); $args->{command};}";
            qlog "debug done ($@)\n";
        } else {    # child cluster!
            $ch->send( "+ok\n" );
            new_req_to_child(
                'debug',            $args,
                $args->{queue},     0,
                SUCC_ALL | SUCC_OK, \&nil_sub,
                \&nil_every_sub,    0,
                \&nil_sub );
        }
    }
    $ch->disconnect;
}    # ~user_debug_processor

################################
################################
#
#  Processing PRIORITY user request
#
################################
################################
sub user_priority_processor( $$ ) {
    my ( $ch, $a ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args

    my $tmp;

    $args->{id}  ||= 0;
    $args->{val} ||= 0;

    qlog "_PRI request $args->{queue} by $args->{user} id=$args->{id} $args->{val}\n",
        LOG_INFO;
    slog "PRI request $args->{user}; $args->{queue}; $args->{id}; $args->{val}\n";
    $tmp =
        cleosupport::get_setting( 'priority', $args->{user}, $args->{profile},
        $args->{queue} );    #!!! profile
    qlog "MAX_PRI=$tmp\n", LOG_DEBUG;

    if ( ( $tmp < $args->{val} )
        && !isadmin( $args->{user}, $args->{queue} ) ) {
        $ch->send(
            "-You cannot gain priority greater than $tmp!\n" );
        $ch->disconnect;
        return;
    }
    if ( $args->{queue} eq $cluster_name ) {
        $ch->send(
            &cleosupport::set_priority(
                $args->{id}, $args->{val}, $args->{user} ) );
        $ch->disconnect;
    } else {    # child cluster!
        new_req_to_child(
            'priority',         $args,
            $args->{queue},     0,
            SUCC_OK | SUCC_ANY, \&chld_pri_handler,
            \&every_nil_sub,    get_setting('intra_timeout'),
            \&chld_pri_handler,
            'channel', $ch );
    }
}    # ~user_priority_processor

################################
################################
#
#  Processing CHATTR user request
#
################################
################################
sub user_chattr_processor( $$ ) {
    my ( $ch, $a ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args

    my $tmp;

    $args->{id}  ||= 0;
    $args->{val} ||= 0;

    qlog "_CHATTR request $args->{queue} by $args->{user} id=$args->{id} attr=$args->{attribute} $args->{val}\n",
        LOG_INFO;
    slog "CHATTR request $args->{user}; $args->{queue}; $args->{id}; $args->{attribute}; $args->{val}\n";

    # child cluster?
    if ( $args->{queue} ne $cluster_name ) {
        new_req_to_child(
            'chattr',              $args,
            $args->{queue},        0,
            SUCC_OK | SUCC_ANY,    \&chld_chattr_handler,
            \&every_nil_sub,       get_setting('intra_timeout'),
            \&chld_chattr_handler,
            'channel', $ch );
    }

    # this cluster.
    else {
        # which attribute need to be changed?
        if ( $args->{attribute} eq 'timelimit' ) {
            $ch->send(&cleosupport::set_attribute(
                $args->{id},  $args->{attribute},
                $args->{val}, $args->{user} ) );
            $ch->disconnect;
        }
    }
}    # ~user_priority_processor

################################
################################
#
#  Processing AUTOBLOCK user request
#
################################
################################
sub user_autoblock_processor( $$ ) {
    my ( $ch, $a ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args

    $args->{val} ||= 0;

    qlog "_AUTOBLOCK request $args->{queue} by $args->{user} users=$args->{users} $args->{val}\n",
        LOG_INFO;
    slog "AUTOBLOCK request $args->{user}; $args->{queue}; $args->{users}; $args->{val}\n";

    $args->{username} = $args->{user};
    if ( $args->{queue} eq $cluster_name ) {
        if ( $args->{recurse} ) {
            new_req_to_child(
                'autoblock',                 $args,
                '__ALL__',                   1,
                SUCC_ALL | SUCC_OK,          \&chld_ablock_handler,
                \&chld_every_ablock_handler, get_setting('intra_timeout'),
                \&chld_ablock_handler,
                'channel', $ch );
        } else {
            my $o = &cleosupport::autoblock(
                $args->{users}, $args->{val},
                $args->{user},  $args->{recurs} );
            my $s = substr( $o, 0, 1 );
            $o = substr( $o, 1 );
            $ch->send( ( $s eq '+' ) ? "+ok\n$o\n" : "-fail\n$o\n" );
            $ch->disconnect;
        }
    } else {    # child cluster!
        new_req_to_child(
            'autoblock',                 $args,
            $args->{queue},              $args->{recurse},
            SUCC_ALL | SUCC_OK,          \&chld_ablock_handler,
            \&chld_every_ablock_handler, get_setting('intra_timeout'),
            \&chld_ablock_handler,
            'channel', $ch );
    }
}    # ~user_autoblock_processor

################################
################################
#
#  Processing BLOCK (task) user request
#
################################
################################
sub user_block_processor( $$ ) {
    my ( $ch, $a ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args
    my ( @answer, $line, $ok );

    $args->{id}  ||= 0;
    $args->{val} ||= 0;

    qlog "_BLOCK request $args->{queue} by $args->{user}($args->{username}) id=$args->{id} $args->{val} for $args->{reason}\n",
        LOG_INFO;

    unless ( isadmin( $args->{user}, $args->{queue} ) ) {
        $args->{username} = $args->{user};
        qlog "Reset to $args->{user} back\n", LOG_WARN;
    }
    $args->{username} = $args->{user} if ( $args->{username} eq '' );

    if ( $args->{reason} eq '' ) {
        $args->{reason} = 'wish';
    }

    if ( $args->{queue} eq $cluster_name ) {
        foreach my $id ( split( /,/, $args->{id} ) ) {
            slog "BLOCK request $args->{user}; $args->{queue}; $id; $args->{val}; $args->{reason}\n";
            $line =
                cleosupport::block_task( $id, $args->{val}, $args->{username},
                $args->{reason}, $args->{userlist}, $args->{mask} );
            chomp $line;
            $line =~ /^(.)(.*)/;
            $ok = 1 if ( $1 eq '+' );
            push @answer, "$id: $2";
        }
        $ch->send( ( $ok ? '+' : '-' ) . join( "\n", @answer, '' ) );
        $ch->disconnect;

    } else {    # child cluster!
        new_req_to_child(
            'block',              $args,
            $args->{queue},       0,
            SUCC_ALL | SUCC_OK,   \&chld_block_handler,
            \&every_nil_sub,      get_setting('intra_timeout'),
            \&chld_block_handler,
            'channel', $ch );
    }

}    # ~user_block_processor

################################
################################
#
#  Processing BLOCK_PE user request
#
################################
################################
sub user_block_pe_processor( $$ ) {
    my ( $ch, $args ) = @_;

    $args->{val}    ||= 0;
    $args->{recurs} ||= 0;
    $args->{id}     ||= '';

    qlog "_BLOCK_PE request $args->{queue} by $args->{user} pe=$args->{id} $args->{val} $args->{reason}\n",
        LOG_INFO;
    if ( isadmin( $args->{user} ) ) {
        my @answer;
        my ( @r, $line, $flag, $ok );
        $ok = 0;
        push @r, $args->{reason} if defined $args->{reason};
        foreach my $id ( split( /,/, $args->{id} ) ) {
            qlog "(UN)BLOCKING $id\n", LOG_DEBUG;
            slog "BLOCK_PE request $args->{user}; $id; $args->{val} $args->{reason}\n";

            $line = block_pe( $id, $args->{val}, $args->{safe}, @r );
            chomp $line;
            $line =~ /^(.)(.*)/;
            $ok = 1 if ( $1 eq '+' );
            push @answer, "$id: $2";
        }
        $ch->send( ( $ok ? '+' : '-' ) . join( "\n", @answer, '' ) );
        $ch->disconnect;
        qlog "ANSWER: " . join( ';', @answer, "\n" ), LOG_DEBUG;
        dump_queue();
    } else {
        qlog "Not authorized\n", LOG_ERR;
        $ch->send("-You are not authorized to (un)block processors...\n" );
        $ch->disconnect;
    }
}

################################
################################
#
#  Processing MODE user request
#
################################
################################
sub user_mode_processor( $$ ) {
    my ( $ch, $args ) = @_;

    my ( $m_set, $m_clear, $old, $flag ) = ( 0, 0, $mode, 0 );

    #flag - 0=nothing valid; 1=valid; 2=valid and already sent

    qlog "_MODE request $args->{queue}/$m_set/$m_clear\n", LOG_INFO;
    qlog "ARGS: " . join( ';', %$args ) . "\n", LOG_DEBUG2;
    slog "MODE request $args->{user}; $args->{queue}; $m_set; $m_clear\n";
    if ( $args->{mode_version} ) {

        # srv mode
        # PRINT VERSION
        #
        $ch->send( "+ok\n$VERSION ($VARIANT)\n" );
        $ch->disconnect;
        $flag = 2;
    }
    if ( $args->{mode_update_pid} ) {

        # srv mode
        # UPDATE PID FILE
        #
        if ( open( PID, ">$opts{i}" ) ) {
            print PID $$;
            close PID;
            $ch->send( "+ok\nUpdated pid file ($opts{i})\n" );
        } else {
            $ch->send( "-Cannot reopen '$opts{i}'\n$old\n" );
        }
        $ch->disconnect;
        $flag = 2;
    }
    if ( $args->{mode_conf_reload} or
         $args->{mode_reload_conf} ) {

        # srv mode
        # RELOAD CONFIG FILE
        #
        #reload all startup variables...
        #only port will be old (we'll not close old socket)

        $safe_reload = 0;
        set_default_values();
        qlog "> reload 1\n", LOG_DEBUG;
        load_conf_file();
        qlog "> reload 2\n", LOG_DEBUG;

        new_req_to_child(
            'reload_conf', {}, '__ALL__', 1,
            SUCC_ALL | SUCC_OK, \&nil_sub, \&every_nil_sub, 1,
            \&nil_sub );
        $ch->send( "+ok\n$old\n" );
        $ch->disconnect;
        $flag = 2;
    }
    if ( $args->{mode_update_users} ) {

        # srv mode
        # RELOAD USERS
        #
        reload_users(1);
        new_req_to_child(
            'reload_users', {}, '__ALL__', 1,
            SUCC_ALL | SUCC_OK, \&nil_sub, \&every_nil_sub, 1,
            \&nil_sub );
        qlog "> update_users\n", LOG_INFO;
        $ch->send( "+ok\n$old\n" );
        $ch->disconnect;
        $flag = 2;
    }
    if ( $args->{mode_reload_sced} ) {

        # srv mode
        # RELOAD SCEDULERS
        #
        new_req_to_child(
            'reload_sced', {}, '__ALL__', 1,
            SUCC_ALL | SUCC_OK, \&nil_sub, \&every_nil_sub, 1,
            \&nil_sub );
        qlog "> reload_sced\n", LOG_DEBUG;
        $ch->send( "+ok\n$old\n" );
        $ch->disconnect;
        $flag = 2;
    }
    if ( $args->{mode_update_restrict} ) {

        # srv mode
        # RELOAD RESTRICTIONS FILE
        #
        load_restrictions( cleosupport::get_setting('time_restrict_file') );
        correct_time_restrictions(1);
        new_req_to_child(
            'update_restrictions', {},
            '__ALL__',          1,
            SUCC_ALL | SUCC_OK, \&nil_sub,
            \&every_nil_sub,    1,
            \&nil_sub );
        qlog "> update_restrict\n", LOG_INFO;
        $ch->send( "+ok\nreloaded\n" );
        $ch->disconnect;
        $flag = 2;
    }
    if ( $args->{mode_norun} ) {

        # srv mode
        # DISALLOW RUN NEW TASKS
        #
        $m_clear = $m_clear | MODE_RUN_ALLOW;
        $flag    = 1;
    }
    if ( $args->{mode_run} ) {

        # srv mode
        # ALLOW RUN NEW TASKS
        #
        $m_set = $m_set | MODE_RUN_ALLOW;
        $flag  = 1;
    }
    if ( $args->{mode_qenable} ) {

        # srv mode
        # ALLOW QUEUEING
        #
        $m_set = $m_set | MODE_QUEUE_ALLOW;
        $flag  = 1;
    }
    if ( $args->{mode_qdisable} ) {

        # srv mode
        # DISALLOW QUEUEING
        #
        $m_clear = $m_clear | MODE_QUEUE_ALLOW;
        $flag    = 1;
    }

    if ( $args->{mode_recreate_logs} ) {

        # srv mode
        # REOPENS ALL LOG FILES
        #

        unless ( $cleosupport::STATUS->close() ) {
            $ch->send( "-Cannot close status file!!!\n" );
            $ch->disconnect;
            return;
        }
        unless (
            $cleosupport::STATUS->open(
                $report_file, O_WRONLY | O_CREAT | O_APPEND | O_LARGEFILE )
            ) {
            $ch->send( "-Cannot reopen status file!!!\n" );
            $ch->disconnect;
            return;
        }
        unless ( $cleosupport::SHORT_LOG->close() ) {
            $ch->send( "-Cannot close short status file!!!\n" );
            $ch->disconnect;
            return;
        }
        unless (
            $cleosupport::SHORT_LOG->open(
                $short_rep_file, O_WRONLY | O_CREAT | O_APPEND | O_LARGEFILE )
            ) {
            $ch->send( "-Cannot reopen short status file!!!\n" );
            $ch->disconnect;
            return;
        }
        $ch->send( "+ok\nLogs recreated.\n" );
        $ch->disconnect;
        $flag = 2;
    }
    if ( $args->{mode_view} ) {

        # srv mode
        # PRINT CURRENT MODE
        #
        $flag = 1;
    }
    $args->{queue} =~ s/\s//g;
    if ( $flag == 0 ) {
        $ch->send( "-Not valid command!\n" );
        $ch->disconnect;
    } elsif ( $flag == 1 ) {
        my %new_args = (
            'set',   $m_set,   'user',   $args->{user},
            'clear', $m_clear, 'recurs', $args->{recurs},
            'queue', $args->{queue} );
        if ( $args->{queue} eq $cluster_name ) {
            if ( $args->{recurs} ) {
                new_req_to_child(
                    'mode',                    \%new_args,
                    '__ALL__',                 $args->{recurs},
                    SUCC_ALL | SUCC_OK,        \&chld_mode_handler,
                    \&chld_every_mode_handler, get_setting('intra_timeout'),
                    \&chld_mode_handler,
                    'channel', $ch );
            } else {
                $ch->send( "+ok\n".&new_mode( $args->{user}, $m_set, $m_clear ) );
                $ch->disconnect;
            }
        } else {    # child cluster!
            new_req_to_child(
                'mode',                    \%new_args,
                $args->{queue},            $args->{recurs},
                SUCC_ALL | SUCC_OK,        \&chld_mode_handler,
                \&chld_every_mode_handler, get_setting('intra_timeout'),
                \&chld_mode_handler,
                'channel', $ch );
        }
    }
}    # ~user_mode_processor

################################
################################
#
#  Processing GET_IO user request
#
################################
################################
sub user_get_io_processor( $$ ) {
    my ( $ch, $a ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args

    qlog "_GET_IO request $args->{queue} by $args->{user} id=$args->{id}\n",
        LOG_INFO;
    slog "GET_IO request $args->{user}; $args->{queue}; $args->{id}\n";
    new_req_to_child(
        'get_io',              $args,
        $args->{queue},        0,
        SUCC_ALL | SUCC_OK,    \&chld_get_io_handler,
        \&chld_get_io_handler, get_setting('intra_timeout'),
        \&chld_get_io_handler,
        'channel', $ch );
}    # ~user_get_io_processor

################################
################################
#
#  Processing FREEZE user request
#
################################
################################
sub user_freeze_processor( $$ ) {
    my ( $ch, $a ) = @_;
    my $args = Storable::thaw( Storable::freeze($a) );    # clone args

    $args->{val} =~ tr/'"\\&()$%@#/_/;
    if($args->{id} < 1){
        $ch->send( "-fail\nBad task id '$args->{id}'\n" );
        $ch->disconnect;
    }
    if($args->{val} eq ''){
        $ch->send( "-fail\nYou must specify value (1/0)\n" );
        $ch->disconnect;
    }
    qlog "_FREEZE request $args->{queue} by $args->{user} id=$args->{id}; $args->{val}\n",
        LOG_INFO;
    slog "FREEZE request $args->{user}; $args->{queue}; $args->{id}; $args->{val}\n";
    new_req_to_child(
        'freeze',              $args,
        $args->{queue},        0,
        SUCC_ALL | SUCC_OK,    \&chld_freeze_handler,
        \&every_nil_sub, get_setting('intra_timeout'),
        \&chld_freeze_handler,
        'channel', $ch );
}    # ~user_freeze_processor

###################################################
###################################################
###################################################

#
#  Called periodically to ping mons
#
#  Args: mon - monitor name
#
#########################################
sub mons_pinger( $ ) {
    my %args = ( 'value' => 0 );

    qlog "MONS_PINGER ($_[0])\n", LOG_DEBUG2 if ( $debug{nc} );

    # may be disconnected?
    return if ( $mons{ $_[0] }->{state} eq 'dead' );

    if ( $mons{ $_[0] }->{conn}->get_state eq 'dead' ){
        qlog "Mon connection is dead... Try reconnect $_[0] now!\n",
            LOG_ERR;
        on_mon_disconnect($_[0]);
        $mons{$_[0]}->{state}='dead';
        sc_task_in( 0, \&mons_connecter, $_[0] );
        return;
    }

    # Do the ping!!!
    qlog "MONS_PINGER PING $_[0]\n", LOG_DEBUG2 if ( $debug{nc} );
    new_req_to_mon(
        'ping', \%args, $_[0], SUCC_ALL | SUCC_OK,
        \&mon_ping_handler, undef, get_setting('mon_timeout'),
        \&mon_ping_handler );

    # next ping scedule...
    sc_task_in(
        $mon_ping_interval + int( rand( get_setting('mon_rnd_ping') ) ),
        \&mons_pinger, $_[0] );
}

#
#  Called if mon is disconnected. Tries to connect it
#
#  Args: mon - monitor name
#
#########################################
sub mons_connecter( $ ) {

    # may be already connected or connecting?
    return if ( $mons{ $_[0] }->{state} ne 'dead' );
    return if ( $mons{ $_[0] }->{conn}->get_state eq 'ok' );

    $mons{ $_[0]}->{conn_start}=$last_time;
    if($mons{ $_[0] }->{conn}->connect == 0){
        if($mons{ $_[0] }->{conn}->get_state eq 'ok'){
            #conected!
            $mons{ $_[0] }->{state} = 'just_conn';
            $mons{ $_[0]}->{conn_start}=0;

            # scedule pinger
            sc_task_in(
                $mon_ping_interval+int(rand(get_setting('mon_rnd_ping'))),
                \&mons_pinger, $_[0] );

            # do some actions...
            on_mon_raise_back( $_[0] );
        }
    }
    else{
        # Cannot connect at all. Let's try later...
        sc_task_in( get_setting('mon_connect_interval'),
                    \&mons_connecter, $_[0]);
    }

    # check if connected...
    sc_task_in( 1, \&mons_connecter2, $_[0]);
}

#
#  Called if mon is disconnected. Check is connection was successfull.
#
#  Args: mon - monitor name
#
#########################################
sub mons_connecter2( $ ) {

    # may be already connected?
    if ( $mons{ $_[0] }->{state} ne 'dead' ){
        return;
    }

    # Check if connection is established
    $mons{$_[0]}->{conn}->connect;
    if($mons{$_[0]}->{conn}->get_state eq 'ok'){
        $mons{ $_[0] }->{state} = 'just_conn';
        $mons{$_[0]}->{conn_start}=0;

        # do delayed sends...
        $mons{$_[0]}->{conn}->flush;
        # scedule pinger
        sc_task_in(
            $mon_ping_interval + int( rand( get_setting('mon_rnd_ping') ) ),
            \&mons_pinger, $_[0] );

        # do some actions...
        on_mon_raise_back( $_[0] );
    }
    else{    # Not connected
        #
        # Start
        # .--------------------.[pause mon_conn_interval]\
        #  ^  conn. every 2 sec.                         /
        #  \---------------------------------------------

        # make another pause?
        if($mons{$_[0]}->{conn_start}+get_setting('mon_connect_timeout')>
           $last_time){

            #timed out
            my $int=get_setting('mon_connect_interval')-
                    get_setting('mon_connect_timeout');
            $int=1 if $int <1;

            $mons{$_[0]}->{conn}->disconnect;
            sc_task_in( $int, \&mons_connecter, $_[0] );
        }
        else{
            # try next connection...
            sc_task_in( 2, \&mons_connecter2, $_[0] );
        }
    }
}

#
#  Called if monitor does not answer too long
#
#  Args: mon - monitor name
#
#########################################
sub on_mon_timed_out( $ ) {
    my $i = $_[0];
    my $mon;

    return
        if( ( $mons{$i}->{state} eq 'fail' )
            or ( $mons{$i}->{state} eq 'dead' ) );

    qlog( "Timed out node $i\n", LOG_WARN );    # if $mons{$i}->{from};

    # make extern action
    my $text = cleosupport::get_setting( 'mon_fail_exec', '', '' );
    if ( $text ne '' ) {
        undef %subst_args;
        $subst_args{node} = $i;
        subst_task_prop( \$text, undef, 0, "" );
        qlog "exec monfail: $text\n", LOG_INFO;
        launch( 0, $text, "$cluster_name-$i-fail" );
    }

    $mons{$i}->{state} = 'fail';

    # check "fast raise"
    if( $last_time-$mons{$_[0]}->{last_fail} >
        get_setting('mon_fail_interval')){

        # one fast raise detected
        if(++$mons{ $_[0] }->{fast_raise_count}>
            get_setting('mon_fast_raise_count') ) {
            qlog "Monitor $_[0] raises too silently. Block it.\n", LOG_WARN;
            on_mon_dead( $i, 'Node is suspended' );
        }
        else{
            # reset fast raise counter
            $mons{ $_[0] }->{fast_raise_count}=0;
        }
        $mons{$_[0]}->{last_fail}=$last_time;
    }else {
        # scedule monitor blocking
        $mons{$i}->{block_task} =
            sc_task_in( get_setting('mon_block_delay')*
                        get_setting('mon_fail_interval'),
                        \&on_mon_dead, $i );
    }
}    # ~on_mon_timed_out

#
#  Called if monitor disconnected
#
#  Args: mon - monitor name
#
#########################################
sub on_mon_disconnect( $ ) {
    my $i = $_[0];
    my $mon;

    return
        if ( ( $mons{$i}->{state} eq 'fail' )
        or ( $mons{$i}->{state} eq 'dead' ) );

    qlog( "Disconnected node $i\n", LOG_WARN );

    # make extern action
    my $text = cleosupport::get_setting( 'mon_fail_exec', '', '' );
    if ( $text ne '' ) {
        undef %subst_args;
        $subst_args{node} = $i;
        subst_task_prop( \$text, undef, 0, "" );
        qlog "exec monfail: $text\n", LOG_INFO;
        launch( 0, $text, "$cluster_name-$i-fail" );
    }

    block_pe($i,NO_DEL_TASKS,0,'Disconnected');

    $mons{$i}->{state} = 'fail';

    # check "fast raise"
    if ( ++$mons{ $_[0] }->{fast_raise_count} >
        get_setting('mon_fast_raise_count') ) {
        qlog "Monitor $_[0] raises too silently. Block it.\n", LOG_WARN;
        on_mon_dead( $i, 'Node is suspended' );
    } else {

        # scedule monitor blocking
        $mons{$i}->{block_task} =
            sc_task_in( get_setting('mon_block_delay')*
                        get_setting('mon_fail_interval'),
                        \&on_mon_dead, $i );
    }
}    # ~on_mon_disconnect

#
#  Called if monitor closed connection or timed out after timeout
#
#  State MUST be 'fail' if called directly.
#
#  Args: mon - monitor name
#        reason - optional reason of blocking (Default is 'Timed out')
#
#########################################
sub on_mon_dead( $;$ ) {
    my $i = $_[0];

    # check if node status was changed...
    return if ( $mons{$i}->{state} ne 'fail' );

    qlog "Dead node $i\n", LOG_WARN if $mons{$i}->{from};

    # make extern action
    my $text = cleosupport::get_setting( 'mon_dead_exec', '', '' );
    if ( $text ne '' ) {
        undef %subst_args;
        $subst_args{node} = $i;
        subst_task_prop( \$text, undef, 0, "" );
        qlog "exec mondead: $text\n", LOG_INFO;
        launch( 0, $text, "$cluster_name-$i-dead" );
    }

    # block this node
    if ( $_[1] ne '' ) {
        block_pe( $i, 1, 0, $_[1] );
    } else {
        block_pe( $i, 1, 0, "Timed out" );
    }
    if ( $mons{$i}->{block_task} ne '') {
        sc_task_del( $mons{$i}->{block_task} );
    }
    $mons{$i}->{state} = 'dead';

    # scedule reconneting
    sc_task_in( get_setting('mon_connect_interval'), \&mons_connecter, $i );
}    # ~on_mon_dead

#
#  Called if monitor is returned from DOWN (dead) state
#
#  Args: mon - monitor name
#
#########################################
sub on_mon_raise_back( $ ) {
    my ( $i ) = @_;

    if ( defined $Mons_select ) {
        $Mons_select->add($mons{$i}->{conn}->get_h);
    } else {
        $Mons_select = new IO::Select->new($mons{$i}->{conn}->get_h);
    }

    # unblock it or cancel blocking
    qlog "Connected to node '$i'. Wait for response.\n", LOG_INFO;
    if ( $mons{$i}->{block_task} ne '') {
        sc_task_del( $mons{$i}->{block_task} );
    }
    delete $mons{$i}->{block_task};

    # do some actions
    my $text = cleosupport::get_setting( 'mon_back_exec', '', '' );
    if ( $text ne '' ) {
        undef %subst_args;
        $subst_args{node} = $i;
        subst_task_prop( \$text, undef, 0, "" );
        qlog "exec monback: $text\n", LOG_INFO;
        launch( 0, "$text", '' );
    }

    $may_go = 1;

    # send first request
    my $line =
          "\*main:$i:"
        . new_hash()
        . "\ninit\nauth: "
        . pack_value('none') . "\n";
    foreach my $mon_str (keys(%mon_vars)){
        my $value = get_setting($mon_str);
        $line .= "$mon_vars{$mon_str}: ".
            pack_value($value)."\n" if($value ne '');
    }

    $line .= 'port: ' . pack_value($mon_port) . "\nend\n";
    $mons{$i}->{conn}->send($line);
    $mons{$i}->{conn}->flush;
    sc_task_in( 0, \&_send_int_info_to_mon, $i );
}    # ~ on_mon_raise_back

#
#  the task to send 'internal_info' request to monitor
#
#  Arg: monitor name
#
###################################################
sub _send_int_info_to_mon( $ ) {

    new_req_to_mon(
        'internal_info', {},
        $_[0], SUCC_ALL | SUCC_OK,
        \&mon_int_info_handler,
        \&nil_sub,
        cleosupport::get_setting('mon_timeout'),
        \&nil_sub );

}

#########################################
#########################################
#########################################

#
#  Called if mon raises too fast
#
#  Args: mon - monitor name
#
#########################################
sub mon_fast_raise_old( $ ) {
    $mons{ $_[0] }->{fast_raise_count} = 0;
    qlog "MON $_[0] too fast raises!\n", LOG_WARN;
    block_pe( $_[0], 1, 0, 'Node is suspended' );
    my $text = get_setting( 'mon_fast_raise_exec', '', '' );
    if ( $text ne '' ) {
        undef %subst_args;
        $subst_args{node} = $_[0];
        subst_task_prop( \$text, undef, 0, "" );
        qlog "exec mon_fast_raise: $text\n", LOG_INFO;
        launch( 0, $text, "$cluster_name-$_[0]-fast_raise" );
    }

    sc_task_in(
        $mon_ping_interval + int( rand( get_setting('mon_rnd_ping') ) ),
        \&mon_fast_raise_cancel, $_[0] );
    return;
}

#
#  Checks if monitor is good (not rases fast)
#
#  Args: mon - monitor name
#
#########################################
sub mon_fast_raise_cancel_old( $ ) {

    # do the check
    for my $i ( keys( %{ $blocked_pe_reasons{ $_[0] } } ) ) {
        return if ( $i eq 'Node is suspended' );
    }

    # Ok, monitor is unblocked!
    $mons{ $_[0] }->{fast_raise_count} = 0;
    qlog "MON $_[0] is not raised by admin mind... Switch to connecter!\n",
        LOG_WARN;

    sc_task_in(
        $mon_ping_interval + int( rand( get_setting('mon_rnd_ping') ) ),
        \&mons_connecter, $_[0] );
    return;
}

#
#  Called periodically to clean up data
#
#  Args: none
#
#########################################
sub cleanup_data( ) {

    my $rsh_tmout = get_setting('wait_secs_to_kill_base_rsh') + 60;

    # clean %rsh_data
    foreach my $i ( keys(%rsh_data) ) {
        if ( exists $rsh_data{$i}->{killed} ) {
            if ( $rsh_data{$i}->{killed} + $rsh_tmout < $last_time ) {
                delete $rsh_data{$i};
            }
        }
    }

    sc_task_in( $cleanup_interval, \&cleanup_data );
}

#
#  Called to be shure, that task on mon is killed
#
#  Args: list of monitors, owner, id
#
#########################################
sub final_kill_mon_task( $$$ ) {
    my %answer;

    qlog "Killing final $_[2] from $_[1]\n", LOG_DEBUG;

    # is this task alive?
    if ( exists $rsh_data{"$_[2]::$_[1]"} ) {

        # test if request is already sent
        if ( !defined $rsh_data{"$_[2]::$_[1]"}->{killed} ) {

            # kill all rshells

            my %req = (
                'owner'     => $_[1],
                'id'        => $_[2],
                'wait_secs' => get_setting('wait_secs_to_kill_base_rsh') );

            # kill all rshell process and master
            new_req_to_mon(
                'kill', \%req,
                \@{ $rsh_data{"$_[2]::$_[1]"}->{nodes} },
                SUCC_ANY | SUCC_OK,
                \&nil_sub, undef, 0, \&nil_sub );

            # mark request as sent
            $rsh_data{"$_[2]::$_[1]"}->{killed} = $last_time;

            $answer{id} = $_[2];
            if ( $_[1] eq cleosupport::get_setting('root_cluster_name') ) {

                # our task is dead (one of its nodes)...
                $childs_info{ $_[2] }->{status} = 255;
                $childs_info{ $_[2] }->{special} .=
                    " No real exit code available - probably node is down.";

                task_node_dead( $_[2], $from );
            } else {
                $answer{id}      = $_[2];
                $answer{node}    = $from;
                $answer{code}    = 255;
                $answer{special} =
                    " No real exit code available - probably node is down.";
                new_req_to_child(
                    'finished',         \%answer,
                    $_[1],              0,
                    SUCC_ANY | SUCC_OK, \&nil_sub,
                    \&every_nil_sub,    0,
                    \&nil_sub );
            }
        } else {
            qlog "Task is killng already\n", LOG_DEBUG;
        }
    } else {
        qlog "No info about this task\n", LOG_DEBUG;
    }
}

#
#  Called if 'finished' message comes from mon
#
#  Args: ret_args, node
#
#########################################
sub finished_from_mon_processor( $$ ) {
    my $args = $_[0];
    my %answer;

    if ( exists $rsh_data{"$args->{id}::$args->{owner}"} ) {

        # test if request is already sent
        if ( defined $rsh_data{"$args->{id}::$args->{owner}"}->{killed} ) {
            qlog "$args->{id}::$args->{owner} is already killed. Ignore\n",
                LOG_DEBUG;
            return;
        }

        # kill all rshells

        qlog "Pseudo-rsh finished ($args->{id}::$args->{owner})\n", LOG_INFO;
        qlog "master node is "
            . $rsh_data{"$args->{id}::$args->{owner}"}->{master}
            . "\n", LOG_DEBUG;
        my %req = (
            'owner'     => $args->{owner},
            'id'        => $args->{id},
            'wait_secs' => get_setting('wait_secs_to_kill_base_rsh') );

        # kill all rshell process and master
        new_req_to_mon(
            'kill',
            \%req,
            \@{ $rsh_data{"$args->{id}::$args->{owner}"}->{nodes} },
            SUCC_ANY | SUCC_OK,
            \&mon_kill_handler,
            undef,
            5,
            \&mon_kill_handler );

        $answer{id}   = $args->{id};
        $answer{node} = $from;
        $answer{code} = $args->{code};
        new_req_to_child(
            'finished',         \%answer,  $args->{owner},  0,
            SUCC_ANY | SUCC_OK, \&nil_sub, \&every_nil_sub, 0,
            \&nil_sub );

        # mark request as sent
        $rsh_data{"$args->{id}::$args->{owner}"}->{killed} = $last_time;
    } else {
        qlog "$args->{id}::$args->{owner} is already finished. Ignore\n",
            LOG_DEBUG;
        # send data to child to be shure...
        $answer{id}   = $args->{id};
        $answer{node} = $from;
        $answer{code} = $args->{code};
        new_req_to_child(
            'finished',         \%answer,  $args->{owner},  0,
            SUCC_ANY | SUCC_OK, \&nil_sub, \&every_nil_sub, 0,
            \&nil_sub );
    }
}

#
#  Read data from IPC message queues
#
#
#sub check_msgqueues(){

#    my ($message,$type,$buf);
#    if(msgrcv($exec_queue,$buf,MAX_QMSG,1,IPC_NOWAIT)==1){
#        ($type,$message)=unpack("l! a*",$buf);

#        # new message readed
#        unless($message =~ m/([^:]+):([^:]+)(:(.*))?/){
#            qlog "Bad message  from exec module... \"$message\"\n", LOG_WARN;
#        }
#        # message parsed
#        else{
#            if($2 eq 'restart'){
#                #!!!!!!!!!  this is workaround now
#                del_task($1,'__internal__','','','',1,'pre-start failed');
#            }
#            elsif($2 eq 'cancel'){
#                del_task($1,'__internal__','','','',1,'pre-start failed');
#            }
#            elsif($2 eq 'block'){
#                #block_task($1,1,'__internal__',$3);
#                del_task($1,'__internal__','','','',1,'pre-start failed');
#            }
#        }
#    }
#}
__END__
#
#  Called if monitor is failed to down state
#
#  Args: mon - monitor name
#
#########################################
sub on_mon_timed_out_old( $ ) {
    my $i = $_[0];
    my $mon;

    qlog "Timed out node $i\n", LOG_WARN if $mons{$i}->{from};
    if ( defined $mons{$i}->{to} ) {
        if ( defined $Mons_select ) {
            $Mons_select->remove( h_by_channel( $mons{$i}->{to} ) );
        }
        kill_conn( $mons{$i}->{to} );
        undef $mons{$i}->{to};
    }
    if ( defined $mons{$i}->{from} ) {
        if ( defined $Mons_select ) {
            $Mons_select->remove( h_by_channel( $mons{$i}->{from} ) );
        }
        kill_conn( $mons{$i}->{from} );
        undef $mons{$i}->{from};
    }
    eval {
        $mon = IO::Socket::INET->new(
            PeerAddr => $i,
            PeerPort => $mons{$i}->{port},
            Proto    => 'tcp',
            Timeout  => 1 );
    };
    if ($mon) {
        if ( $mons{$i}->{time_connected} <
            $last_time - get_setting('mon_fast_raise_interval') ) {
            $mons{$i}->{fast_raise_count} = 0;
        }
        if ( ++$mons{$i}->{fast_raise_count} >
            get_setting('mon_fast_raise_count') ) {
            on_mon_raise_back( $i, $mon );
            mon_fast_raise($i);
        }
    } else {
        $mons{$i}->{block_task} = sc_task_in( get_setting('mon_block_delay'),
            \&block_pe, $i, 1, 0, "Timed out" );
        my $text = cleosupport::get_setting( 'mon_fail_exec', '', '' );
        if ( $text ne '' ) {
            undef %subst_args;
            $subst_args{node} = $i;
            subst_task_prop( \$text, undef, 0, "" );
            qlog "exec monfail: $text\n", LOG_INFO;
            launch( 0, $text, "$cluster_name-$i-fail" );
        }
        return;
    }
}    # ~on_mon_timed_out

#
#  Called if monitor is returned from down state
#
#  Args: mon - monitor name
#        con - new socket to monitor (IO::Socket::INET)
#
#########################################
sub on_mon_raise_back_old( $$ ) {
    my ( $i, $mon ) = @_;

    kill_conn( $mons{$i}->{to} ) if defined $mons{$i}->{to};
    delete $mons{$i}->{to};

    $mons{$i}->{to} = create_conn($mon);
    $mon_by_conn{ $mons{$i}->{to} } = $i;
    qlog
        "Connected to node '$i:$mons{$i}->{port}'. Wait for response. ($mons{$i}->{to})\n",
        LOG_WARN;
    if ( $mons{$i}->{block_task} ) {
        sc_task_del( $mons{$i}->{block_task} );
    } else {
        delete $mons{$i}->{block_task};
        block_pe( $i, 0, 0, "Timed out" );
    }

    if ( $mons{ $_[0] }->{was_connected} ) {
        my $text = cleosupport::get_setting( 'mon_back_exec', '', '' );
        if ( $text ne '' ) {
            undef %subst_args;
            $subst_args{node} = $i;
            subst_task_prop( \$text, undef, 0, "" );
            qlog "exec monback: $text\n", LOG_INFO;
            launch( 0, "$text", '' );
        }
    } else {
        $mons{ $_[0] }->{was_connected} = 1;
    }
    $may_go = 1;

    #  push @connected_mons,$i;
    if ( defined $Mons_select ) {
        $Mons_select->add($mon);
    } else {
        $Mons_select = new IO::Select->new($mon);
    }
    my $line =
          "\*main:$i:"
        . new_hash()
        . "\ninit\nauth: "
        . pack_value('none') . "\n";
    my $rsh_c = get_setting('mon_rsh_command');
    $line .= 'rsh_command: ' . pack_value($rsh_c) . "\n" if ( $rsh_c ne '' );
    $rsh_c = get_setting('hard_kill_delay');
    $line .= 'hard_kill_delay: ' . pack_value($rsh_c) . "\n"
        if ( $rsh_c ne '' );
    $line .= 'port: ' . pack_value($mon_port) . "\nend\n";
    send_to_channel( $mons{$i}->{to}, $line );

}    # ~ on_mon_raise_back

#
#  Called periodically to ping mons
#
#  Args: mon - monitor name
#
#########################################
sub mons_pinger_old( $ ) {
    my %args = ( 'value' => 0 );

    qlog "MONS_PINGER ($_[0])\n", LOG_DEBUG2 if ( $debug{nc} );

    if ( $mons{ $_[0] }->{fast_raise_count} >
        get_setting('mon_fast_raise_count') ) {
        mon_fast_raise( $_[0] );
        return;
    }
    if (   !defined( $mons{ $_[0] }->{to} )
        or !defined( $mons{ $_[0] }->{from} ) ) {
        qlog "Try reconnect $_[0] now!\n", LOG_WARN;
        sc_task_in( 0, \&mons_connecter, $_[0] );
        return;
    }
    if ( $mons{ $_[0] }->{last_response} + $mon_ping_interval < $last_time ) {
        qlog "MONS_PINGER PING $_[0]\n", LOG_DEBUG2 if ( $debug{nc} );
        new_req_to_mon(
            'ping', \%args, $_[0], SUCC_ALL | SUCC_OK,
            \&mon_ping_handler, undef, get_setting('mon_timeout'),
            \&mon_ping_handler );
    }
    sc_task_in(
        $mon_ping_interval + int( rand( get_setting('mon_rnd_ping') ) ),
        \&mons_pinger, $_[0] );
}

#
#  Called if mon is disconnected. Tries to connect it
#
#  Args: mon - monitor name
#
#########################################
sub mons_connecter_old( $ ) {
    if ( ++$mons{ $_[0] }->{fast_raise_count} >
        get_setting('mon_fast_raise_count') ) {
        qlog "Monitor $_[0] already connected. Raises too fast.\n", LOG_ERR;
        mon_fast_raise( $_[0] );
        return;
    }
    if (    defined( $mons{ $_[0] }->{to} )
        and defined( $mons{ $_[0] }->{from} ) ) {
        qlog "Monitor $_[0] already connected. Switching to pinger\n",
            LOG_ERR;
        sc_task_in( int( rand( get_setting('mon_rnd_ping') ) ),
            \&mons_pinger, $_[0] );
        return;
    }

    if ( defined $mons{ $_[0] }->{to} ) {
        if ( defined $Mons_select ) {
            $Mons_select->remove( h_by_channel( $mons{ $_[0] }->{to} ) );
        }
        kill_conn( $mons{ $_[0] }->{to} );
        undef $mons{ $_[0] }->{to};
    }
    if ( defined $mons{ $_[0] }->{from} ) {
        if ( defined $Mons_select ) {
            $Mons_select->remove( h_by_channel( $mons{ $_[0] }->{from} ) );
        }
        kill_conn( $mons{ $_[0] }->{from} );
        undef $mons{ $_[0] }->{from};
    }

    my $mon;
    eval {
        $mon = IO::Socket::INET->new(
            PeerAddr => $_[0],
            PeerPort => $mons{ $_[0] }->{port},
            Proto    => 'tcp',
            Timeout  => 1 );
    };
    if ($mon) {
        on_mon_raise_back( $_[0], $mon );
        qlog "Monitor $_[0] connected. Switching to pinger\n", LOG_WARN;
        sc_task_in( int( rand( get_setting('mon_rnd_ping') ) ),
            \&mons_pinger, $_[0] );
        return;
    }
    sc_task_in(
        $mon_ping_interval + int( rand( get_setting('mon_rnd_ping') ) ),
        \&mons_connecter, $_[0] );
}

#
#  Called if 'finished' message comes from mon
#
#  Args: ret_args hash
#
#########################################
sub finished_from_mon_processor( $ ){
  my $args=$_[0];

  my $pid=$rsh_pids{"$args->{id}::$args->{owner}"}->{"$from::$args->{pid}"};

      if ($args->{is_rsh} ne '') {
        #
        #  RSH FINISHED
        #
        my $pid=$rsh_pids{"$args->{id}::$args->{owner}"}->{"$from::$args->{pid}"};
        qlog "Pseudo-rsh finished ($args->{id}::$args->{owner}::$pid)\n", LOG_INFO;
        qlog "master node is ".$rsh_pids{"$args->{id}::$args->{owner}"}->{master}."\n", LOG_DEBUG;
        my %req=('pid'=>$pid,'wait_secs'=>get_setting('wait_secs_to_kill_base_rsh'));
        # kill 'base' rshell process
        new_req_to_mon('kill_pid',\%req,$rsh_pids{"$args->{id}::$args->{owner}"}->{master},
                       SUCC_ANY|SUCC_OK,\&nil_sub,undef,0,\&nil_sub);
        #and all others too...
        return;
      }
      if (defined $rsh_pids{"$args->{id}::$args->{owner}"}) {
        qlog "FINished task $args->{id}::$args->{owner} on $from with code $args->{code}\n", LOG_INFO;
        if (defined($rsh_pids{"$args->{id}::$args->{owner}"}->{master})) {
          #
          #  Delete all 'bored' rshell processes...
          #
          qlog "Kill child rsh\n", LOG_DEBUG;
          foreach my $i (keys(%{$rsh_pids{"$args->{id}::$args->{owner}"}})) {
            $i =~ /^\S+::\S+$/;
            next if($1 eq '');
            my %req=('pid'=>$2,'wait_secs'=>get_setting('wait_secs_to_kill_base_rsh'));
            new_req_to_mon('kill_pid',\%req,$1,
                           SUCC_ANY|SUCC_OK,\&nil_sub,undef,0,\&nil_sub);
          }
          delete $rsh_pids{"$args->{id}::$args->{owner}"};
        }
        qlog join(';',%$args,"\n"), LOG_DEBUG;
        $answer{id}=$args->{id};
        if ($args->{owner} eq cleosupport::get_setting('root_cluster_name')) {
          # our task is dead (one of its nodes)...
          $childs_info{$args->{id}}->{status}=$args->{code};
          task_node_dead($args->{id},$from);
        } else {
          qlog "!!! ($args->{owner})\n", LOG_DEBUG;
          $answer{id}=$args->{id};
          $answer{node}=$from;
          $answer{code}=$args->{code};
          new_req_to_child('finished',\%answer,$args->{owner},0,SUCC_ANY|SUCC_OK,
                           \&nil_sub,\&every_nil_sub,0,\&nil_sub);
        }























{
  my %stat_ids;
  my %read_blocks;
  my %failed_blocks;

  sub task_stat_2();

  #
  #  init statistics on task start
  #
  #
  #############################################
  sub init_task_stat( $ ){
    my $id=$_[0];
    my ($req, $i);

    unless($stat_conn){
      $stat_conn=conect_to_stat();
    }
    return unless($stat_conn);

    $req=new_count2();
    send_to_channel($stat_conn,"Req $req AddParam\n");
    for $i (split(/\,/,$childs_info{$id}->{nodes})){
      send_to_channel($stat_conn,"$i cpu swap disk_io\n");
    }
    send_to_channel($stat_conn,"__end\n");

    $stat_ids{$req}=$id;
    undef $read_blocks{$req};
    sc_task_in(1,\task_stat_2);
  }

  sub task_stat_2(){
    my ($id,$req);
    my ($i,$key,$newid,$node);
    my @words;

    unless($stat_conn){
      $stat_conn=conect_to_stat();
    }
    unless($stat_conn){
      undef $childs_info{$id}->{stat};
      return;
    }
    for(;;){
      my @b=get_block($stat_conn,0.2);
      last unless(@b);
      $i = shift @b;
      if ($i =~ /^Ans\s+(\S+)/) {
        $req=$1;
        for $i (@b) {
          @words = split(/\s+/, $i);
          $node=shift(@words);
          while (@words) {
            $newid=shift(@words);
            $key=shift(@words);
            if ($key eq '' or $newid eq '') {
              qlog "Bad line from stat program: $i\n", LOG_ERR;
              last;
            }
            $read_blocks{$req}->{$node}->{$key}=$newid;
          }
          if (!exists($read_blocks{$req}->{$node}->{cpu}) or
              !exists($read_blocks{$req}->{$node}->{swap}) or
              !exists($read_blocks{$req}->{$node}->{disk_io})) {
            qlog "Stat program did not register some parameters for $id ($node): $i\n", LOG_ERR;
            undef $read_blocks{$req};
            undef $childs_info{$stat_ids{$req}}->{stat};
            undef $stat_ids{$req};
            return;
          }
        }
      } else {
        qlog "Bad answer from stat program ($i)\n", LOG_ERR;
      }
    }

    # test for new read blocks!
    for $i (keys(%read_blocks)){
      if(exists($stat_ids{$i})){
        $id=$stat_ids{$i};
        if(exists($childs_info{$id})){
          $childs_info{$id}->{stat}=$read_blocks{$i};
        }
        else{
          qlog "childs info for $id does not exists\n", LOG_DEBUG;
        }
      }
      else{
        qlog "stat ids for $i does not exists\n", LOG_DEBUG;
      }
      delete $read_blocks{$i};
      delete $stat_ids{$i};
    }

    if(keys(%stat_ids)){
      sc_task_in(1,\task_stat_2);
    }
  }

  #
  #  summarize statistics on task end
  #
  #  arg: task id
  #
  #############################################
  sub finish_task_stat( $ ){
    my $id=$_[0];

    if(exists($childs_info{$id})){

    }
  }
}
