#!/usr/bin/perl
#
#  This is part of Cleo batch system project.
#  (C) Sergey Zhumatiy (serg@parallel.ru) 1999-2010
#
#
# 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.30;
    eval "use lib '.';
    use lib '/usr/libexec/cleo';
    use cleovars $VERSION;
    use cleosupport $VERSION;";
    die $@ if ($@);
}
$VARIANT = 'c';

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 %parent_reqests);

# @mons_to_ping

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

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

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

# check for O_LARGEFILE and define it if not defined
eval { local $SIG{__DIE__} = sub{return;}; &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_sched_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_schedule($\@\@\@ );
sub def_timeout_child_proc();
sub def_timeout_mon_proc();
sub do_external_schedule( $ );
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_check( $ );
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 scheduler_event( $;$ );
sub send_to_parent( $ );
sub start_scheduler();
sub stop_scheduler();
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( $$ );

sub check_timed_out_mon($);

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',
    'mon_attach_tmout'            => 'attach_tmout',
    'mon_smart_port'              => 'smart_port',
    'mon_global_rsh_command'      => 'global_rsh_command',
    'mon_init_conn_timeout'       => 'init_conn_timeout',
    'mon_hard_kill_after_head'    => 'hard_kill_after_head',
    'mon_suexec_gid'              => 'suexec_gid',
    'mon_debug_pc'                => 'debug_pc',
    'mon_last_ran_check_interval' => 'last_ran_check_interval',
    'mon_log_kills'               => 'log_kills',
    'mon_dead_cleanup_time'       => 'dead_cleanup_time',
    'mon_filter_users'            => 'filter_users',
    'mon_pids_update_interval'    => 'pids_update_interval' );

$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"
. "             -d      foreground mode - no daemonize\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;

$schedule_proc         = 'default';
$pending_schedule_proc = 'default';
$foreign_schedule_proc = 'default';

$schedule{default}         = \&default_schedule;
$pending_schedule{default} = \&default_schedule;  #\&default_pending_schedule;
$foreign_schedule{default} = \&default_schedule;  #\&default_foreign_schedule;

#
#  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', 'd=',
    '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';
$my_name      = `uname -n`;
daemonize() unless($opts{d});

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 "Own cpus: "
. scalar( keys(%own) )
. " Shared cpus: "
. 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 rusles 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_DEBUG2;
    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_DEBUG2;
}

$reserved_shared = 0;
$safe_reload     = 1;

my @save_scheds;
my $save_sched = $global_settings{scheduler};
push @save_scheds, @{ $global_settings{schedulers} };

&load_state($cluster_name);
&calc_vars();
&fix_prerun();

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{scheduler} |= $save_sched;
push @{ $global_settings{schedulers} }, @save_scheds;

my $use_mons=get_setting('use_monitors');
if($use_mons>0){
    foreach my $i ( keys(%pe) ) {
        $blocked_pe_reasons{$i}->{'Not connected yet'} = 1;
        delete $blocked_pe_reasons{$i}->{'Timed out'};
        delete $blocked_pe_reasons{$i}->{'Node is suspended'};
        delete $blocked_pe_reasons{$i}->{'Disconnected'};
        $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_schedulers();
$sched_alarm = 0;
start_scheduler();

####################################################
#
#
#  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_sched',        \&reload_sched_handler );
register_parent_rcv( 'reopen_logs',         \&reopen_logs_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 or $run_fase == 3 ) {

                    # get info from all children and monitors
                    qlog "Fase 0!\n", LOG_INFO;

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

                    # Send Start work signal!!!!

                    $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 ( $sched_alarm > 0 and $last_time >= $sched_alarm ) {
                $sched_alarm = 0;
                scheduler_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;
                flush_mails();
            }

            check_all_mod_timers();

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

            #check_msgqueues();

            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 del_from_mons_select($){
    $Mons_select->remove($_[0]);
}

sub del_from_rsh_select($){
    $RSH_select->remove($_[0]);
}

sub del_from_down_select($){
    $down_ch_select->remove($_[0]);
}

sub del_from_up_select($){
    $up_ch_select->remove($_[0]);
}

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

    if ($check_running) {

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

        # Check for correctness of all running childs...
        qlog( "Checking running...\n", LOG_DEBUG )
        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} >= MAX_CLEO_ID );

        }
    }
    $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;
        }
        if($childs_info{$theid}->{substate} eq 'restarting'){

        	# was cleaned already?
        	next if($childs_info{$theid}->{cleaned});
        	$childs_info{$theid}->{cleaned}=1;
        }
        if ( $log_level >= LOG_DEBUG2 ) {
            qlog "_DEAD: $theid; CHILDS_INFOS2: "
            . join( ';', keys(%childs_info) )
            . "\n", LOG_DEBUG2;
        }
        qlog "DEADS: " . join( ';', @dead ) . "\n", LOG_INFO;

        $may_go   = 1;
        $q_change = 1;
        slog "END_TASK0 $childs_info{$theid}->{uniqid}\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 ''
            and get_setting('use_monitors')>0)
        {
        	qlog "del_mon_task3\n", LOG_DEBUG;
        	if ( $childs_info{$theid}->{owner} eq
        		cleosupport::get_setting('root_cluster_name') )
        	{
        		my @nodes = cpulist2nodes( $childs_info{$theid}->{nodes} );

        		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_DEBUG;
        }

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

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

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

        	#we must report
        	if ( $log_level >= LOG_DEBUG2 ) {
        		qlog ":: " . join( ";", %{ $childs_info{$theid} } ) . "\n",
        		LOG_DEBUG2;
        	}
        	task_after_death( $theid, $childs_info{$theid} );
        	$resurected=1 if $childs_info{$theid}->{state} eq 'queued';
        }    # ~ 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);

        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};

        unless($resurected){
        	del_from_queue($theid) unless $resurected;
        	qlog "Erased: $theid\n", LOG_INFO;
        }
        $dump_flag=1;
    }  # @dead processing

    #########################################################
    #
    #       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_flag=1;
        correct_time_restrictions();
        qlog "queue changed...\n", LOG_DEBUG;
        $q_change = 0;
        $may_go   = 1;
    }

    if($dump_flag!=0){
        dump_queue();
        $dump_flag=0;
    }

    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;

            # check prerunned tasks first...
            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 scheduler!
        #

        # unblock previous unsuccesfull attempts...
        block_task('all', 0, '__scheduler__', 'Unsuccesfull run');

        my $sched = get_setting('scheduler');
        if (    ( $sched eq 'default' )
            or ( do_external_schedule($sched) ) ) {

        #
        # do traditional schedule mode...
        #
        my @list;
        push @list,
        [ \@foreign,     $foreign_schedule_proc,
        FOREIGN_QUEUE, \%foreign_schedule ];

        #      push @list,[\@pending,$pending_schedule_proc,PENDING_QUEUE,\%pending_schedule];
        push @list, [ \@queue, $schedule_proc, NATIVE_QUEUE, \%schedule ];

        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 schedule (zero!)\n", LOG_DEBUG;
                    last;
                }
                qlog join( ',', keys(%ids) ) . "\n", LOG_DEBUG2;

                #        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 "Selected ID=$id [$ids{$id}->{gummy}]\n", LOG_INFO;
                    $ids{$id}->{seen} = 1;
                    if(try_to_run( $ids{$id}, $ids{$id}->{gummy} )){
                        #unsuccesfull attempt
                        block_task($id, 1, '__scheduler__', 'Unsuccesfull run');
                    }
                    $q_change = 1;
                }
                if ($status) {
                    last;
                }
            }

            #      qlog "Foreign length=".scalar(@foreign)." Queue0 length=".scalar(@queue)."\n";
        }
            }# do_scheduler...

            # update info about estimated execution time
            my @free_own;
            my @free_sh;
            count_free( \@free_own, \%own );       #
            count_free( \@free_sh,  \%shared );    # NOT RATIONAL!
            calculate_estimated(scalar(@free_own)+scalar(@free_sh));

    } # ~may_go
    #############################################################################
    ##    ALL NEW TASKS ARE RAN
    ##############################################################################
    $may_go = ( $not_infinite ? 0 : 1 );

    # CHECK TIMED OUT TASKS !!!!!
    if ( $check_time < $last_time ) {
        if ( $log_level >= LOG_DEBUG2 ) {
            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 and $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 and $child->{timelimit}<$last_time) {
            	next if($child->{substate} eq 'deleting' or $child->{substate} eq 'restarting');
            	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

#
#  request nodes for cpus for task
#  Args:
#          task entry
#
#  retunrs:  0 if succeed
#            1 if try to run task twice
sub req_subcluster_to_run( $ ) {
    my $q_entry = $_[0];

    return 1 if ( $q_entry->{state} eq 'prerun' );

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

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

    # 2) mark shared nodes...
    my (@free_sh);
    count_free( \@free_sh, \%shared );    # NOT RATIONAL!
    qlog "TRY_TO_RUN(REQ): reserved $reserved_shared\n", LOG_DEBUG;
    unless ( $q_entry->{reserved} ) {
        $q_entry->{reserved} = min( $q_entry->{np}, keys(%shared) );
        qlog "RESERVING $q_entry->{reserved} for $q_entry->{id}\n", LOG_DEBUG;

        #!!!r $reserved_shared += $q_entry->{reserved};
        qlog "TRY_TO_RUN(REQ): reserved now $reserved_shared\n", LOG_DEBUG;
    }
    foreach my $p ( keys(%shared) ) {
        foreach my $tmp ( @{ $pe{$p}->{level1} } ) {
            $q_entry->{wait_for}->{$p}->{$tmp} = 1;
        }
    }
    return 0;
}

#
#  Try to run task
#  Args:   task entry
#          gummyflag       [opt]
#          nodes list ref. [opt]
#
#  retunrs:  0 if succeed
#            1 if try to run task twice
sub try_to_run($;$$ ) {

    #
    #  We must have all nodes (may be including not reserved shared...)
    #

    my ( $q_entry, $gummy, $cpus_list ) = @_;
    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;

    # check if it is NOT OWN task
    if ( $q_entry->{is_own} == 0 ) {

        #
        # take ALL free cpus to task.
        # create free own cpus list
        #
        foreach my $cpu ( keys(%own) ) {
            next if ( $own{$cpu}->{blocked} );

            if ( scalar( %{ $own{$cpu}->{ids} } ) < 2 * $own{$cpu}->{max} ) {
                push @new, $cpu;
                $pe{$cpu}->{ids}->{$id} = -1;
            }
        }
        qlog "Sending got (ALL free own) "
        . scalar(@new)
        . " to $q_entry->{lastowner}\n", LOG_DEBUG;

        answer_to_parent( $q_entry->{lastowner}, 0, 'got', SUCC_OK, 'id',
            $q_entry->{id}, 'nodes', join( ',', @new ) );

        # request more cpus and mark task as prerun
        req_subcluster_to_run($q_entry);
        return 0;
    }

    # is nodes list given to us?
    if ( ref($cpus_list) eq 'ARRAY' and scalar(@$cpus_list)>0 ) {
        my ( $cpu, $n );

        # add cpus.
        foreach $cpu (@$cpus_list) {
            if ( exists( $own{$cpu} ) ) {
                push @{ $q_entry->{own} }, $cpu;
                push @new, $cpu;
                $pe{$cpu}->{ids}->{$id} = -1;
                last if ( --$np < 1 );
            } else {
                qlog "Scheduler requests for run not own cpu, so ask children: $cpu (".
                    join(',',@$cpus_list).").\n",
                LOG_ERR;
                last;
            }
        }
    }

    # nodes list is not given. Try to create...
    elsif (@free_own) {
        my %nodes_used;
        my $cpu;

        qlog "FREE_OWN: " . join( ' ', sort(@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 ( $alg eq 'scheduler' ) {
            my @free_cpus;
            my @out_cpus;
            push @free_cpus, @free_own;

            # try to get cpus list from scheduler via special call...
            @out_cpus =
            do_external_schedule_cpus_select(
                get_setting( 'scheduler', $q_entry->{user},
                    $q_entry->{profile}, $cluster_name
                    ),
                $id,
                \@free_cpus );
            if ( @out_cpus > 0 ) {

                # block task if required...
                if ( $out_cpus[0] =~ m/^!(.*)/ ) {
                    block_task( $id, 1, '__internal__', $1 );
                    return 0;
                }

                # OK, we have got cpus list!
                foreach $cpu (@out_cpus) {
                    if ( exists( $own{$cpu} ) ) {
                        push @{ $q_entry->{own} }, $cpu;
                        push @new, $cpu;
                        $pe{$cpu}->{ids}->{$id} = -1;
                        last if ( --$np < 1 );
                    } else {
                        qlog
                        "Error! Scheduler requests selector not own cpu: $cpu.\n",
                        LOG_ERR;
                    }
                }
            } else {

                # Task does NOT fits...
                # Cpu selector cannot create cpu list.

                qlog "Warning! Scheduler cannot create cpulist for $id\n",
                LOG_DEBUG;
                return 1;

                #!!!!!!!!!!!
                #TODO scheduling + cpu_selection
                #
                #  This is NOT correct for case if there are some shared nodes...
                #  BUT! If shared nodes cannot help, there would be deadlock.
                #
                #  It is needed to improve scheduler/etc for this case
                #
            }
        } else {

            # Try to create cpu list by self...
            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;
            }

            # cpus are shuffled. Now get first NP cpus.
            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_DEBUG;
        }
    }
    qlog "Needed now (native): $np\n", LOG_INFO;

    # is more nodes needed?
    if ( $np > 0 ) {

        # to call scheduler one more time
        $may_go   = 1;
        $q_change = 1;

        # request more cpus and mark task as prerun
        return req_subcluster_to_run($q_entry);
    } else {

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

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 = 'aftertime attribute restriction';
            if ( cleosupport::test_block( $i->{id}, \$u, \$r ) ) {
                if ( $i->{attrs}->{aftertime}<=$last_time ) {
                    block_task( $i->{id}, 0, $u, $r );
                }
            }
            $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 ) {
                #                    my $real_np=$i->{np}+scalar(@{$i->{extranodes}});
                #                    if ( cleosupport::check_cpuh( $i->{user} ) >= #+
                #                         ( $real_np* $i->{timelimit} / 3600 ) ){ #<= $tmp ) {
                #                        block_task( $i->{id}, 0, $u, $r );
                #                    }
                #                } else {
                #                    block_task( $i->{id}, 0, $u, $r );
                #                }
                $tmp = cleosupport::check_cpuh( $i->{user} );
                if ( $tmp < 0 ) {

                    # infinite
                    block_task( $i->{id}, 0, $u, $r );
                } else {

                    # fits?
                    my $real_np = $i->{np} + scalar( @{ $i->{extranodes} } );
                    if ( $real_np * ( $i->{timelimit} - $i->{time} ) / 3600 <=
                        $tmp ) {
                    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   SCHEDULE
#
######################################################################

sub default_schedule($\@\@\@ ) {

    #  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 "SCHEDULE ($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 "Block $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);
            if( ref $q_entry->{extranodes} ne 'ARRAY'){
                undef $q_entry->{extranodes};
                @{$q_entry->{extranodes}}=();
            }
            my $real_np = $q_entry->{np} + scalar( @{ $q_entry->{extranodes} } );

            #qlog "MAX_SUM_NP=$tmp (used $user_np_used{$user})\n", LOG_INFO;
            if (     ( $tmp > 0 )
                and ( $q_entry->{timelimit} * $real_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 "RUN_OR_DEL: @{$q->{shared}} / @$sh\n", LOG_DEBUG;
    for $p ( @{ $q->{shared} }, @{ $q->{extranodes} } ) {
        for $t ( @{ $pe{$p}->{level1} } ) {
            $r{$t} = 1;
            delete $d{$t};
        }
    }
    qlog "RUN_OR_DEL: $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} }, @{ $q->{extranodes} } )
            );
        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 get_setting('scheduler_timeout');
                    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 5;
            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 listen sockets (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           = ();

    my %nodes_shared;
    my $p;

    RECRT_LST_LOOP:
    foreach $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};
                    $nodes_shared{$c_child}->{$p} = 1;

                    #                    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;
    }
    if ( $log_level >= LOG_DEBUG2 ) {
        foreach $p ( keys %nodes_shared ) {
            qlog "Nodes shared with $p:"
            . join( ',', sort( keys( %{ $nodes_shared{$p} } ) ) )
            . "\n", LOG_DEBUG2;
        }
        foreach $p ( keys %own ) {
            qlog "Own nodes:" . join( ',', sort( keys(%own) ) ) . "\n",
            LOG_DEBUG2;
        }
    }
}

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 socket\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 );
    }
    $rsh->add_close_hook(\&del_from_rsh_select);

    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;
                    $RSH_select->remove($cur_h);
                    $cur->disconnect;
                    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
#
#######################################################################

################################################################################
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_DEBUG ) 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_DEBUG2;
            qlog "REQS[M-UV]: ["
            . join( ':', %{ $new_req->{user_vars} } )
            . "]\n", LOG_DEBUG;
            qlog "ERQS[M-W]: [" . join( ':', @{ $new_req->{rest} } ) . "]\n",
            LOG_DEBUG2;
        }
}    # new_req_to_mon



sub new_req_to_mon_new( $$$$$$;$$@ ) {
    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) {

        # forward request to master
        my $new_args=Storable::Thaw(Storable::Freeze($args));
        my $hash=new_hash();
        $new_args->{__to}=$to;
        $new_args->{__tmout}=$tmout;
        $new_args->{__type}=$what;
        $new_args->{__hash}=$hash;

        $parent_reqests{$hash}->{succ}=$succ;
        $parent_reqests{$hash}->{spp}=$spp;
        $parent_reqests{$hash}->{tpp}=$tpp;
        $parent_reqests{$hash}->{epp}=$epp;

        $parent_reqests{$hash}->{uv}=Storable::Thaw(Storable::Freeze(%uv));
        answer_to_parent(
            get_setting('root_cluster_name'),
            undef,
            'mon_request',
            SUCC_OK,
            $new_args);

        return;
    }

    qlog( "REQ_TO_MON: $what, "
        . ( ref($to) eq 'ARRAY' ? join( ',', @$to ) : $to ) . ";\n",
        LOG_DEBUG ) 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_DEBUG2;
            qlog "REQS[M-UV]: ["
            . join( ':', %{ $new_req->{user_vars} } )
            . "]\n", LOG_DEBUG;
            qlog "ERQS[M-W]: [" . join( ':', @{ $new_req->{rest} } ) . "]\n",
            LOG_DEBUG2;
        }
}    # 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", LOG_INFO)
                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, $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_ERR;
                $Mons_select->remove($cur_h);
                $cur_h->close();
                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';
                $mons{ $entry->{_from} }->{timed_out}        = 0;

                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 {
                    #
                    # FORWARD THE MESSAGE DOWN
                    #
                    #     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} } ) {
            	check_timed_out_mon($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;
        $cur->disconnect();
        $Mons_select->remove($i);

        # make actions on dead monitor
        #$mons{$name}->{state} = 'fail';
        on_mon_disconnect($name);
    }

    @ready = ();
}    # rcv_from_mon


#
#  Check if the monitor is timed out and block it if needed
#
#  Args: mon   - monitor name
#
#
sub check_timed_out_mon($){
	my ($mon)=@_;

	return if $mons{$mon}->{timed_out};

	my $alive=max($mons{$mon}->{last_response},$mons{$mon}->{last_alive});
	if($alive>0){
		if($alive+$max_mon_timeout<$last_time){

			# whole monitor timed out!!!
			qlog "MON TIMED OUT: $mon\n", LOG_DEBUG2;
			on_mon_timed_out($mon);
			$mons{$mon}->{last_response}=0;
			$mons{$mon}->{timed_out}=1;
		}
	}
	elsif($mons{$mon}->{last_connect}>0){
		if($mons{$mon}->{last_connect}+$max_mon_timeout<$last_time){
			# whole monitor timed out!!!
			qlog "MON TIMED OUT WITHOUT RESPONSE: $mon\n", LOG_DEBUG2;
			on_mon_timed_out($mon);
			$mons{$mon}->{last_connect}=0;
			$mons{$mon}->{timed_out}=1;
		}
	}

}


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

#####################################################################
#
# '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_DEBUG2;
}    # 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_DEBUG2;
        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;
                }
            }
        }

        if ( $log_level >= LOG_DEBUG2 ) {
            qlog "TO SEND: " . join( ';', keys(%snd) ) . "\n", LOG_DEBUG2;
        }

        #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;
                if ( $log_level >= LOG_DEBUG2 ) {
                    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.01 );
        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_DEBUG;

                @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!
                    if ( $log_level >= LOG_DEBUG2 ) {
                        qlog "MES: " . join( ";", %$entry, "\n" ), LOG_DEBUG2;
                    }
                    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_DEBUG2 ) 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_DEBUG;
            if ( $log_level >= LOG_DEBUG2 ) {
                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_DEBUG;
            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 monitors)
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    if ( $succ == SUCC_OK ) {
        qlog
        "Attach comleted! ($args->{status}) id=$args->{id}:$args->{owner}\n",
        LOG_INFO;
    } else {
        qlog
        "Attach FAILED! ($args->{status}) id=$args->{id}:$args->{owner}\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 != 0 ) {
            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 != 0 ) {
            qlog "Kill $args->{id}/$args->{owner} succesfull\n", LOG_INFO;
        } else {
            qlog "Kill $args->{id}/$args->{owner} failed\n", LOG_INFO;
        }
    }

    if(exists($childs_info{$args->{id}})){
    	if($childs_info{$args->{id}}->{state} eq 'run'){
    		if ( $args->{owner} eq cleosupport::get_setting('root_cluster_name') ) {
        		push @dead, $args->{id};
        	}
        } else {
        	$args->{success} = ( $succ ? SUCC_OK : SUCC_FAIL );
        	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 = cpulist2nodes( $user_v->{nodes} );

    #    my @nodes = split( /\,/, $user_v->{nodes} );
    delete $args->{exe_mask};
    delete $args->{parent_mask};

    #delete $args->{user};

    qlog "Init_attach finished... id=$user_v->{id} owner=$user_v->{owner}\n",
    LOG_DEBUG2;
    $args->{id}    = $user_v->{id};
    $args->{tmout} = get_setting('attach_tmout');
    $args->{all}   = 1;

    if ( $args->{status} eq 'timed out' ) {
        qlog "Some nodes timed out! id=$user_v->{id} owner=$user_v->{owner}\n",
        LOG_ERR;
        if($user_v->{owner} eq cleosupport::get_setting('root_cluster_name')){

            # kill pre-attached task
            new_req_to_mon( 'cancel_attach',
                $args,
                \@nodes,
                SUCC_ALL | SUCC_OK,
                undef,
                undef);

            # rerun task
            #rerun_task( $args->{id},
            #    get_setting( 'rerun_delay', $user_v->{user},
            #        '',            $user_v->{owner} ),
            #    'init nodes timed out' );
            if(exists($childs_info{$args->{id}})){
            	$childs_info{$args->{id}}->{restart}=1;
            }
            del_or_restart_task($args->{id}, "Some nodes were failed during startup.");
        } 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;
    }

    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 = cpulist2nodes( $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 = cpulist2nodes( $args->{nodes} );
    my $nodes = join( ',', sort(@nodes) );

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

    if(get_setting('use_monitors')>0){
        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',
            get_setting( 'attach_timeout', $args->{user},
                $args->{profile} ) );
    }
    else{
        # not using monitors
        qlog "Attach not needed.\n", LOG_DEBUG;
        cleosupport::execute_task( $childs_info{ $args->{id} } );
    }
}

######################################################################
#
#  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 = cpulist2nodes( $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);
                {
                    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);
                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, \&nil_sub,
                \&every_nil_sub,    0,
                \&every_nil_sub );

            #
            #         DEL_MON_TASK (child request)
            #
    } elsif ( $type eq 'del_mon_task' ) {

        my @nodes = cpulist2nodes( $entry->{mons} );

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

        #
        #  Forward request to monitor
        #
    } elsif ( $type eq 'mon_request' ) {
        #!        my %uv=(from=>$from, hash=>$hash, type=>$args->{__type});
        #!        new_req_to_mon($args->{__type}, $entry, $args->{__to},
        #!            SUCC_ANY|SUCC_OK,
        #!            \&chld_forward_handler,
        #!            \&chld_forward_handler,
        #!            $args->{__tmout},
        #!            \&chld_forward_handler,
        #!            );

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

#
#  Get answer from monitor and forward it to child
#
sub chld_forward_handler($$$$$$ ) {
    my ( $hash, $succ, $args, $user_v, $from, $ret_args ) = @_;

    if ( defined( $mons{$from} ) ) {
        $ret_args->{__hash}=$user_v->{hash};
        $ret_args->{__type}=$user_v->{type};
        $ret_args->{__succ}=$succ;
        new_req_to_child( 'mon_request',
            $ret_args,
            $user_v->{from},     0,
            SUCC_ANY | SUCC_OK, \&nil_sub,
            \&every_nil_sub,    1,
            \&nil_sub );
    } else {
        unless ( $args->{status} eq 'timed out' ) {
            qlog "Unwanted forward answer ($user_v->{type}/$from)\n", LOG_DEBUG;
        }
    }
    return $user_v;
}

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

    my ( $i,       $child_id, $our_id, @list,     $e,
        $runflag, $cpu,      $np,     @use_cpus, @free_cpus );

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

    $our_id = $wait_run{$from}->{$child_id};
    qlog "_Got for id=$child_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}->{$our_id};    #????
        qlog
        "Nodes for unknown task - $our_id ($child_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}->{$our_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 subclusters get this node for us!!!
                push @new, $node;
            }
    }

    # Now check if theese nodes (@new) fits
    if ( @new > 0 ) {

        if ( $log_level >= LOG_DEBUG2 ) {
            qlog "Got Shared now: "
            . join( ';', sort( @{ $e->{shared} }, @new ) ) . "\n",
            LOG_DEBUG2;
        }

        # reset pre-allocated own cpus
        $e->{own} = [];
        foreach my $cpu ( keys(%own) ) {
            next if ( $own{$cpu}->{blocked} );
            delete $own{$cpu}->{ids}->{$our_id};
        }

        # prepare information
        @free_own = ();
        count_free( \@free_own, \%own );

        $np = $e->{np};

        # Is it enough?
        if ( @new + @free_own >= $np ) {
            $runflag = 1;
            qlog "GOT ALL CPUS. ($e->{np})\n", LOG_INFO;
            my $alg = cleosupport::get_setting( 'pe_select', $e->{user},
                $e->{profile}, $cluster_name );

            push @free_cpus, @free_own, @new;

            # call scheduler to get cpu list
            if ( $alg eq 'scheduler' ) {
                my @out_cpus;

                # try to get cpus list from scheduler via special call...
                @out_cpus =
                do_external_schedule_cpus_select(
                    get_setting( 'scheduler',   $e->{user},
                        $e->{profile}, $cluster_name
                        ),
                    $our_id,
                    \@free_cpus );
                if ( @out_cpus > 0 ) {

                    # block task if required...
                    if ( $out_cpus[0] =~ m/^!(.*)/ ) {
                        block_task( $our_id, 1, '__internal__', $1 );
                        return 0;
                    }

                    # OK, we have got cpus list!
                    foreach $cpu (@out_cpus) {
                        if (    exists( $own{$cpu} )
                            or exists( $shared{$cpu} ) ) {

                        #push @{$e->{own}}, $cpu;
                        #! @use_cpus will be pushed into
                        #! own/shared later (runflag=1)
                        push @use_cpus, $cpu;
                        $pe{$cpu}->{ids}->{$our_id} = -1;
                        last if ( --$np < 1 );
                            } else {
                                qlog
                                "Error! Scheduler requests selector not existent cpu: $cpu.\n",
                                LOG_ERR;
                            }
                    }
                }
            } else {

                # Try to create cpu list by self...
                if ( exists $shuffle_algorithms{$alg} ) {
                    qlog "PE_SELECT USE $alg\n", LOG_DEBUG;
                    $shuffle_algorithms{$alg}->( \@free_cpus );
                } else {
                    qlog "PE_SELECT USE the EXTERN $alg\n", LOG_DEBUG;
                    &extern_shuffle( $alg, $np, \@free_cpus );
                    qlog "USE: " . join( ';', @free_cpus ) . "\n", LOG_DEBUG;
                }

                my %nodes_used;

                # cpus are shuffled. Now get first NP cpus.
                while ( $np > 0 ) {
                    $tmp = shift(@free_cpus) or last;
                    if ( exists $nodes_used{$tmp} ) {
                        qlog "SHUFFLE: Node $tmp is already used!\n",
                        LOG_WARN;
                        next;
                    }
                    $nodes_used{$tmp} = 1;

                    #push @{ $e->{own} }, $tmp;
                    push @use_cpus, $tmp;
                    $pe{$tmp}->{ids}->{$our_id} = -1;
                    --$np unless ( $e->{gummy} );
                }
                qlog "USED: " . join( ',', sort(@use_cpus) ) . "\n", LOG_INFO;
            }
            if ( $np > 0 and !$e->{gummy} ) {

                # not all cpus fit...
                qlog "Not all cpus fit. Try next time.\n", LOG_WARN;
                $runflag = 0;
            }
        }    # ~enough cpus?

        # OK! @use_cpus contains all neede cpus!

        if ($runflag) {
            foreach $tmp (@use_cpus) {

                # mark cpu as occupied
                $pe{$tmp}->{ids}->{ $e->{id} } = 1;

                # push it to task info
                if ( exists( $own{$tmp} ) ) {
                    push @{ $e->{own} }, $tmp;
                } else {
                    push @{ $e->{shared} }, $tmp;
                }
            }
        }
    }    # ~ @new>0
    else {

        # no new cpus!
        qlog "No new cpus.\n", LOG_DEBUG;
        return;
    }

    unless ($runflag) {
        my ( $i, $node, $j, $wait, $str );
        while ( ( $i, $node ) = each( %{ $e->{wait_for} } ) ) {
            while ( ( $j, $wait ) = each(%$node) ) {
                $str .= "$i/$j ";
            }
        }
        qlog "Still wait: $str\n", LOG_DEBUG2;
    }
    if ( ( $e->{lastowner} ne $cluster_name ) and ( scalar(@new) > 0 ) ) {

        # Tell master about gotten nodes
        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) < 0 ) {
            qlog "Failed run task '$e->{task_args}->[0]'"
            . " for user $e->{user} ($our_id)\n", LOG_ERR;
        }
    }
    qlog "_Got2 for id=$our_id "
    . scalar(@list)
    . " cpus from $from child_id=$child_id; res=$reserved_shared\n",
    LOG_DEBUG;
    $may_go   = 1;
    $q_change = 1;
    $dump_flag=1;
}

######################################################################
#
#  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_flag=1;
            $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' );

            #            my %cpus;
            #            map { $cpus{$_} = 1 } map { /^([^:]+)/; $1; }
            #                (split(/,/, $ret_args->{nodes}));
            #            my @nodes=keys(%cpus)
            my @nodes = cpulist2nodes( $ret_args->{nodes} );
            new_req_to_mon(
                'signal', \%e, \@nodes,    #$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 'mon_request' pseudo-request from parent (answer actually)
#
######################################################################
sub mon_request_handler($$$$ ) {

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

    if ( exists($parent_reqests{$hash}) ) {
        if($args->{__}){
        } else {
            qlog "Nonexistent answer from mon received ($args->{__from}/$args->{__type})\n", LOG_DEBUG;
        }
    }
}
######################################################################
#
#  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,
            'reason', 'Queue is full');
        return;
    }
    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} );
    if ( $log_level >= LOG_DEBUG2 ) {
        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";

    do_all_exec_modules('add',$ids{$newid},$ids{$newid}->{user});
    if($exec_mod_cancel ne ''){
        # module cancels task adding...
        qlog "Module cancels adding task $args->{lastowner}/$args->{oldid}: ${exec_mod_cancel}.\n", LOG_ERR;
        answer_to_parent( $from, $hash, 'add', SUCC_FAIL,
            'reason', $exec_mod_cancel);
        # delete task
        delete $ids{$newid};
        return;
    }

    qlog "Added $args->{lastowner}/$args->{oldid} = $ids{$newid}{uniqid}\n", LOG_INFO;
    slog "ADDED $ids{$newid}->{uniqid}; $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 );
    scheduler_event( 'add',
        {  id        => $newid,
            user      => $args->{user},
            np        => $args->{np},
            timelimit => $args->{timelimit},
        is_own    => $is_own } );

    $dump_flag=1;
}

######################################################################
#
#  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} } ) {
        do_all_exec_modules('attr', $ids{ $args->{id} }, $args->{user},
            $args->{attribute}, $args->{val});
        if($exec_mod_cancel ne ''){
            qlog("Module cancels chattr $args->{id} $args->{attribute}=".
                "$args->{val} by $args->{user} ($exec_mod_cancel)\n");
            answer_to_parent( $from, $hash, 'chattr', SUCC_FAIL, 'reason',
                $exec_mod_cancel );
            return;
        }
        $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;
    }

    do_all_exec_modules('del', $ids{$id}, $args->{user});

    $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_flag=1 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_scheduler();
    load_conf_file();
    start_scheduler();
}

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

    # for childs
    reopen_logs();
    main::new_req_to_child( 'reopen_logs', {},
        '__all__',          1,
        SUCC_ALL | SUCC_OK, \&nil_sub,
        \&every_nil_sub,    1,
        \&nil_sub );

}

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

    # for childs
    reload_users(1);
}

######################################################################
#
#  Child
#
#  Handler for 'reload_sched' pseudo-answer from parent
#
######################################################################
sub reload_sched_handler($$$$ ) {

    # for childs
    save_state();
    stop_scheduler();
    load_schedulers();
    start_scheduler();
    $q_change=1;
}

######################################################################
#
#  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};

    if ( $log_level >= LOG_DEBUG2 ) {
        qlog "ATTACH: " . join( ':', %$args ) . ";\n", LOG_DEBUG2;
    }
    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;
    }

    if ( $args->{status} eq 'timed out' ) {
        qlog "INIT_ATTACH: timed out $id\n", LOG_DEBUG;
        answer_to_parent( cleosupport::get_setting('root_cluster_name'),
            0,'del_mon_task', SUCC_OK,
            'id', $id,
            'mons', $childs_info{$id}->{nodes} );
        #        rerun_task( $id,
        #            get_setting( 'rerun_delay', $childs_info{$id}->{user} ),
        #            'attach on nodes timed out' );
        $childs_info{$id}->{restart}=1;
        del_or_restart_task($id, "Timed out nodes during task start.");
        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}}->{orig_timelimit} =
                	$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 {
    	if(exists $childs_info{ $args->{id} }){
    		del_or_restart_task($args->{id}, "Failed to control task on nodes");

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

    $dump_flag=1;
}

######################################################################
#
#  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_flag=1;
}

######################################################################
#
#  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} } ) ) {
        	if($childs_info{$args->{id}}->{state} eq 'run'){
        		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 ) = @_;

    if ( exists $childs_info{ $args->{id} } ) {
        qlog
        "Task $args->{id}: node '$args->{node}' ($args->{code}) 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 '' );
    }
}

######################################################################
#
#  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} } ) ) {
        	if($childs_info{$args->{id}}->{state} eq 'run'){
        		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};
    }

    do_all_exec_modules('attr', $ids{$args->{id}}, $args->{user},
        'priority', $args->{val});
    if($exec_mod_cancel ne ''){
        # any module cancels attr change...
        answer_to_parent( $from, $hash, $type, SUCC_FAIL, 'reason', $exec_mod_cancel );
        return;
    }

    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 '+' ) {
        scheduler_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;
            $q_change = 1;

            do_all_exec_modules('block', $ids{$id}, $args->{user}, $args->{val},
                $args->{reason});
        } 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;

        #!!!r $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};
        }

        # reset cpus list for task...
        $q->{shared} = [];
        $q->{own}    = [];

        # recreate cpu lists for task
        for $p ( keys(%shared) ) {
            if ( $args->{nodes} =~ /\b$p\b/ ) {
                $shared{$p}->{ids}->{$id} = $our = -1;
                push @{ $q->{shared} }, $p;
            }
        }
        for $p ( keys(%own) ) {
            if ( $args->{nodes} =~ /\b$p\b/ ) {
                $own{$p}->{ids}->{$id} = $our = -1;
                push @{ $q->{own} }, $p;
            }
        }
        qlog "Now-run: now reserved: $reserved_shared\n", LOG_DEBUG;

        #    $q->{timelimit}+=$last_time;
        if ( $our != 0 ) {
            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}->{orig_timelimit} =
                		$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 $childs_info{$id}->{uniqid}; $q->{user}; $q->{np}; "
                . join( ' ', @{ $q->{task_args} } ) . "\n";
                qlog "RUNING foreign task - ($childs_info{$id}->{uniqid}/$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_flag=1;
    } 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, $yday, $text, $text2, $worktime, $subject );

    $username = $entry->{user};

    unless ( exists $entry->{id} ) {
        qlog "After death failed\n", LOG_ERR;
        return;
    }

    ( $sec, $min, $hour, undef, undef, undef, undef, $yday ) =
    	gmtime( $last_time - $entry->{time} );
    $hour+=3600*$yday;
    $worktime=sprintf('%02d:%02d:%02d',$hour,$min,$sec);

    # read status from file, if empty-cleo was used
    if ( $entry->{use_empty} ne '' ) {
        if ( open( PIDFILE, "<$entry->{pidfile}" ) ) {
            my $line;
            while ( $line = <PIDFILE> ) {
                if ( $line =~ /CODE=(\d+)/ ) {
                    qlog "Got exit code from empty: $1\n", LOG_DEBUG;
                    $entry->{status}=$1;
                    last;
                }
            }
            close(PIDFILE);
            unlink($entry->{pidfile});
        }
    }
    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 ) {
        do_all_exec_modules('ok', $entry, $username);

        $text = cleosupport::get_setting( 'q_fail_exec', $username,
            $entry->{profile} );
        if ( $text ne '' ) {
            undef %subst_args;
            $subst_args{time}=$worktime;
            subst_task_prop( \$text, $entry);
            qlog "run q_fail_exec: '$text'\n", LOG_INFO;
            launch( 0, "$text", '' );
        }
    }
    else {
        do_all_exec_modules('fail', $entry, $username);

        $text = cleosupport::get_setting( 'q_ok_exec', $username,
            $entry->{profile} );
        if ( $text ne '' ) {
            undef %subst_args;
            $subst_args{time}=$worktime;
            subst_task_prop( \$text, $entry);
            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 '' ) {
    	%subst_args=('time'=>$worktime,
    		'work_time'=>"$hour hours $min minutes $sec seconds");
        subst_task_prop( \$text, $entry);
        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 );

    # mail to user, if it is required
    if($entry->{attrs}->{mailopts} =~ /a|e/){
    	if($entry->{attrs}->{mailopts} =~ /a/){
    		$subject=cleosupport::get_setting( 'post_abort_subj', $username,
    			$entry->{profile} );
    		$text = cleosupport::get_setting( 'post_abort_text', $username,
    			$entry->{profile} );
    	}
    	else{
    		$subject=cleosupport::get_setting( 'post_exec_subj', $username,
    			$entry->{profile} );
    		$text = cleosupport::get_setting( 'post_exec_text', $username,
    			$entry->{profile} );
    	}
    	%subst_args=('time'=>$worktime,
    		'work_time'=>"$hour hours $min minutes $sec seconds");
    	subst_task_prop( \$subject, $entry);
    	%subst_args=('time'=>$worktime,
    		'work_time'=>"$hour hours $min minutes $sec seconds");
        subst_task_prop( \$text, $entry);

    	if($entry->{attrs}->{maillist} eq ''){
    		send_mail($username,$subject,$text);
    	}
    	else{
    		foreach my $addr (split(/,/,$entry->{attrs}->{maillist})){
    			send_mail($addr,$subject,$text);
    		}
    	}
    }

    $text = cleosupport::get_setting( 'post_exec_write', $username,
        $entry->{profile} );
    if ( $text ne '' ) {
    	%subst_args=('time'=>$worktime,
    		         'work_time'=>"$hour hours $min minutes $sec seconds");
        subst_task_prop( \$text, $entry);
        $text =~ s/\0//g;

        qlog "echo '$text' | /usr/bin/write $username &\n";
        open( WR, "|/usr/bin/write $username" );
        print WR "$text\n";
        close WR;
    }
    do_all_exec_modules( 'post', $entry, $username );

    $text = cleosupport::get_setting( 'q_post_exec', $username,
        $entry->{profile} );
    if ( $text ne '' ) {
    	%subst_args=('time'=>$worktime,
    		         'work_time'=>"$hour hours $min minutes $sec seconds");
    	subst_task_prop( \$text, $entry);
        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 $entry->{uniqid}; $entry->{user}; "
    . "$entry->{status}; $entry->{signal}; $worktime\n";
    slog "END_TASK_NODES $entry->{uniqid}; $entry->{nodes}\n";
    actualize_cpu_blocks( split( /,/, $entry->{nodes} ) );

    scheduler_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} } );

    if($entry->{substate} eq 'restarting'){
    	resurect_task($entry->{id});
    }
}

sub after_death_user_part( $$$ ) {

    my ( $theid, $entry, $text2 ) = @_;
    my ( $text, $sec, $min, $hour, $yday, $worktime );
    ( $sec, $min, $hour, undef, undef, undef, undef, $yday ) =
    	gmtime( $last_time - $entry->{time} );
    $hour+=3600*$yday;
    $worktime=sprintf('%02d:%02d:%02d',$hour,$min,$sec);

    #  $>=$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");

    my $ext_rep_file=get_setting('extern_report_file');
    if( $ext_rep_file ne ''){
        local %subst_args=();#'path' => $ext_rep_file);
        subst_task_prop(\$ext_rep_file,$entry);
        $REP->print( "Report  : ",$ext_rep_file,"\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 '' ) {
        	%subst_args=('time'=>$worktime,
        		'work_time'=>"$hour hours $min minutes $sec seconds");
            subst_task_prop( \$text, $entry);
            qlog "user exec post: $text\n", LOG_INFO;
            launch( 0, $text, '' );
        }

        # user epilogue script?
        if ( $entry->{epilogue} ne '' ) {
            qlog "user exec epilogue: $entry->{epilogue}\n", LOG_INFO;
            launch( 0, $text, '' );
        }
        #
        # Exec users killscript
        #
        if ( $text2 ne '' ) {
        	%subst_args=('time'=>$worktime,
        		'work_time'=>"$hour hours $min minutes $sec seconds");
            subst_task_prop( \$text2, $entry);
            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);
                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);
                qlog "run user_ok_exec: '$text'\n", LOG_INFO;
                launch( 0, "$text", "$cluster_name.uu-$theid" );
            }
        }

    };

    #
    # delete conf file
    #
    my $conf_file = get_setting( 'use_file',
        $entry->{user}, $entry->{profile} );
    undef %subst_args;
    subst_task_prop( \$conf_file, $entry);

    if ( ( $conf_file ne '' ) and ( -f $conf_file ) ) {
        if ( unlink $conf_file ) {
            qlog "Deleted conf-file $conf_file\n", LOG_INFO;
        } else {
            qlog "Cannot delete conf-file $conf_file\n", LOG_WARN;
        }
    }
}

#
#
# 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;
            if ( $log_level >= LOG_DEBUG2 ) {
                qlog ">>>! "
                . join( ';', keys(%rfn) ) . "<>"
                . join( ';', map { $_->{node}; } @rfq )
                . "\n", LOG_DEBUG2;
            }
        }
        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 scheduler
#
#  Args: scheduler name
#
#  Ret: 0 if success, 1 otherwise
###########################################
sub do_external_schedule( $ ) {
    my $sched = $_[0];
    my $res;
    my $iter;
    my $q_change_save=$q_change;

    for($iter=MAX_SCHED_ITERATIONS; $iter>0; --$iter){
        $res=do_external_schedule_once($sched);
        #        qlog "Iterations left: $iter\n";

        # error? no queue change?
        if($res!=0 or $q_change==0){
            #            qlog "Change: $q_change; res=$res\n";
            $q_change=$q_change_save;
            return $res;
        }
        $q_change=0;
    }
    $q_change=$q_change_save;
    #    qlog "No iterations left\n";
    return 0;
}

###########################################
#
#  Calls once external scheduler
#
#  Args: scheduler name
#  Ret: 0 if success, 1 otherwise
###########################################
sub do_external_schedule_once( $ ) {
    my $sched = $_[0];
    my ( $ret, $n, $starttime );

    qlog "Do external scheduler '$sched'\n", LOG_DEBUG;

    $starttime = time;

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

    check_blocked_by_res();

    {
        my @free_sh;
        my @tasks;
        @free_own = ();

        # prepare information
        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 scheduler - task $i->{id}\n", LOG_DEBUG2;
        }

        # is it nessesary at all
        return 1 unless (@tasks);

        $global_log_prefix =~ /Sched(\d)*/;
        $n = $1 + 1;
        local $global_log_prefix = "Sched${n}> ";
        no strict "refs";
        eval {
            alarm get_setting('scheduler_timeout');
            local $SIG{ALRM} = sub { die "scheduler\n"; };

            # Clear errors
            ${"CleoScheduler::${sched}::__cleo_mod_error"} = 0;
            if ( $log_level >= LOG_DEBUG2 ) {
                qlog "nodes: "
                . join( ";", @free_own, @free_sh ) . "\n",
                LOG_DEBUG2;
            }

            #!!!r
            #!!!r2 $reserved_shared = count_reserved_own();
            $reserved_shared = 0;

            # DO the call!
            $ret =
            ( "CleoScheduler::${sched}" . "::do_schedule" )
            ->( \@tasks, $reserved_shared, @free_own, @free_sh );
            $ret += ${"CleoScheduler::${sched}::__cleo_mod_error"};
        };
        alarm 0;

        #$global_log_prefix =~ /Sched(\d)*/;
        #if($1 == 1){
        #  $global_log_prefix="";
        #}else{
        #  $n=$1-1;
        #  $global_log_prefix="Sched${n}>";
        #}
        if ($@) {
            qlog "Scheduler timed out.\n", LOG_WARN;
            $ret = 1;
        }
        if ($ret) {
            qlog "Scheduler has errors...\n", LOG_WARN;
            if ( ++$ext_sched{$sched} > get_setting('max_ext_sched_err') ) {
                qlog "Disable it!\n", LOG_ERR;
                stop_scheduler();
                delete $ext_sched{$sched};
            }
            return 1;
        }
    };
    qlog "Scheduler done.\n", LOG_DEBUG;
    return 0;
}

###########################################
#
#  Calls external scheduler for task cpus
#
#  Args: scheduler name, task id, free cpus
#
#  Ret: cpus list on success, undef otherwise.
###########################################
sub do_external_schedule_cpus_select( $$$ ) {
    my ( $sched, $id, $cpus ) = @_;
    my ( $ret, $n, $starttime, @out_cpus );

    qlog "External scheduler '$sched' select cpus, task id = $id\n",
    LOG_DEBUG;

    $starttime = time;

    unless ( exists( $ext_sched{$sched} ) ) {
        qlog
        "Warning: external scheduler '$sched' does not exisis. Ignore.\n",
        LOG_WARN;
        return undef;
    }

    {
        $global_log_prefix =~ /Sched(\d)*/;
        $n = $1 + 1;
        local $global_log_prefix = "Sched${n}> ";
        no strict "refs";
        eval {
            alarm get_setting('scheduler_timeout');
            local $SIG{ALRM} = sub { die "scheduler\n"; };

            # Clear errors
            ${"CleoScheduler::${sched}::__cleo_mod_error"} = 0;

            # DO the call!
            $ret =
            ("CleoScheduler::${sched}::select_cpus")
            ->( $id, $cpus, \@out_cpus );
            $ret += ${"CleoScheduler::${sched}::__cleo_mod_error"};
        };
        alarm 0;

        if ($@) {
            qlog "Scheduler cpus_select timed out.\n", LOG_WARN;
            $ret = 1;
        }
        if ($ret) {
            qlog "Scheduler has errors...\n", LOG_WARN;
            if ( ++$ext_sched{$sched} > get_setting('max_ext_sched_err') ) {
                qlog "Disable it!\n", LOG_ERR;
                stop_scheduler();
                delete $ext_sched{$sched};
            }
            return undef;
        }
    };
    qlog "Scheduler select_cpus done.\n", LOG_DEBUG;
    return @out_cpus;
}

#
#  Calls scheduler alarm procedure with specified parameters
#
######################################################################
sub scheduler_event( $;$ ) {
    my $sched = get_setting('scheduler');
    return if ( ( $sched eq 'default' ) or ( $sched eq '' ) );
    return unless defined $ext_sched{$sched};

    my $ret;
    my $tmp = defined $_[1]->{type} ? $_[1]->{type} : '';
    qlog "Scheduler event '$_[0]($tmp)'.\n", LOG_DEBUG;
    {
        local $global_log_prefix = "Sched_event($_[0])> ";
        no strict "refs";
        eval {
            alarm get_setting('scheduler_timeout');
            local $SIG{ALRM} = sub { die "scheduler\n"; };
            ${"CleoScheduler::${sched}::__cleo_mod_error"} = 0;
            $tmp = ( $_[0] eq 'event' ) ? $_[1]->{type} : $_[0];
            $ret = ( "CleoScheduler::${sched}" . "::event" )->( $tmp, $_[1] );
            $ret += ${"CleoScheduler::${sched}::__cleo_mod_error"};
        };
        alarm 0;

        #$global_log_prefix="";
        if ($@) {
            qlog "Scheduler event timed out.\n", LOG_WARN;
            $ret = 1;
        }
        if ($ret) {
            qlog "Scheduler event has errors...\n", LOG_WARN;
            if ( ++$ext_sched{$sched} > get_setting('max_ext_sched_err') ) {
                qlog "Disable it!\n", LOG_ERR;
                stop_scheduler();
                delete $ext_sched{$sched};
            }
            return 1;
        }
    };
    qlog "Scheduler event done.\n", LOG_DEBUG;
}

#
#  Calls scheduler stop procedure
#
######################################################################
sub stop_scheduler() {
    my $sched = get_setting('scheduler');
    return if ( $sched eq 'default' or $sched eq '' );
    return unless defined $ext_sched{$sched};

    my $ret;
    qlog "Stop scheduler.\n", LOG_DEBUG;
    {
        my %info = ( queue   => $cluster_name,
            version => $VERSION );
        local $global_log_prefix = "Sched_stop> ";
        no strict "refs";
        eval {
            alarm get_setting('scheduler_timeout');
            local $SIG{ALRM} = sub { die "scheduler\n"; };
            ${"CleoScheduler::${sched}::__cleo_mod_error"} = 0;
            $ret = ( "CleoScheduler::${sched}" . "::stop" )->( \%info );
            $ret += ${"CleoScheduler::${sched}::__cleo_mod_error"};
        };
        alarm 0;

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

#
#  Calls scheduler start procedure
#
######################################################################
sub start_scheduler() {
    my $sched = get_setting('scheduler');
    return if ( $sched eq 'default' or $sched eq '' );
    return unless defined $ext_sched{$sched};

    my $ret;
    qlog "Start scheduler.\n", LOG_DEBUG;
    {
        my %info = ( queue   => $cluster_name,
            version => $VERSION );
        local $global_log_prefix = "Sched_start> ";
        no strict "refs";
        eval {
            alarm get_setting('scheduler_timeout');
            local $SIG{ALRM} = sub { die "scheduler\n"; };
            ${"CleoScheduler::${sched}::__cleo_mod_error"} = 0;
            $ret = ( "CleoScheduler::${sched}" . "::start" )->( \%info );
            $ret += ${"CleoScheduler::${sched}::__cleo_mod_error"};
        };
        alarm 0;

        #$global_log_prefix="";
        if ($@) {
            qlog "Start scheduler timed out. Ignore.\n", LOG_WARN;
            ++$ret;
        }
    };
    if ($ret) {
        qlog "Scheduler start has errors...\n", LOG_ERR;
        qlog "Disable it!\n",                   LOG_ERR;
        stop_scheduler();
        delete $ext_sched{$sched};
        return;
    }
    $ext_sched{$sched} = 0;
    qlog "Scheduler 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} )
            or                              # restriction is in action now
            (  ( $i->{timeb} <= $last_time + $q->{timelimit} )
                and                              # 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 - 1/0 is it the first time after loading restrictions (opt)
    #        2 - ref next restriction rule date (for main queue only!)
    #
    ##########################################################
    sub correct_time_restrictions( ;$$ ) {
        my $first_time     = $_[0];
        my $next_rule_date = $_[1];

        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;
        if ( ref($next_rule_date) == 'SCALAR' ) {
            if ( $next_restriction_time != 0 ) {
                $$next_rule_date = localtime($next_restriction_time);
            }
        }
    }    #~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 ( ref($qentry->{wait_for_run}) eq 'ARRAY' ) {
        $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 ( ref($qentry->{wait_for_ok}) eq 'ARRAY' ) {
        $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 ( ref($qentry->{wait_for_fail}) eq 'ARRAY' ) {
        $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;
            if ( $log_level >= LOG_DEBUG2 ) {
                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 ) {
        if ( $log_level >= LOG_DEBUG2 ) {
            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;
            }
            if ( $log_level >= LOG_DEBUG2 ) {
                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", LOG_INFO;
    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;
    }

    if ( $args->{attributes} ne '' ) {
        my %attrs = split( /#/, $args->{attributes} );

        %{ $args->{attrs} } = %attrs;
        my @attrs_list = keys(%attrs);
        @attrs_list = map {"$_ => $args->{attrs}->{$_}"} @attrs_list;
        if ( $log_level >= LOG_DEBUG ) {
            qlog 'ATTRS: ' . join( ',', @attrs_list ) . "\n", LOG_DEBUG;
        }
        delete $args->{attributes};
    }

    $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} );
    if ( $log_level >= LOG_DEBUG ) {
        qlog "PROFILE: $args->{profile}, OUTFILE: $args->{outfile}\n", LOG_DEBUG;
    }

    $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_DEBUG2;

    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( 'max_cpuh',       $args->{user},
            $args->{profile}, $args->{queue} );
        my $cpuh=$args->{np}*$args->{timelimit}/3600;
        if ( !$adm and $tmpval>0 and $cpuh > $tmpval ) {
            $ch->send(
                "-Too much cpu-hours requested ($cpuh). Maximum, $tmpval can be used\n"
                );
            $ch->disconnect;
            return;
        }
        $tmpval = get_setting( 'priority',       $args->{user},
            $args->{profile}, $args->{queue} );
        $tmpval2 = 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}' "
    . "mask=$args->{mask}/$args->{rmask}' users='$args->{userlist}' 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_DEBUG2;
        $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_flag=1;
    } 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";
        }
        $q_change = 1 if $ok;
        $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_flag=1;
    } 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;
    if ( $log_level >= LOG_DEBUG2 ) {
        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( sprintf( "+ok\n%4.2f (%s)\n", $VERSION, $VARIANT ) );
        $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_sched} ) {

            # srv mode
            # RELOAD SCHEDULERS
            #
            new_req_to_child( 'reload_sched', {},
                '__ALL__',          1,
                SUCC_ALL | SUCC_OK, \&nil_sub,
                \&every_nil_sub,    1,
                \&nil_sub );
            qlog "> reload_sched\n", LOG_DEBUG;
            $ch->send("+ok\n$old\n");
            $ch->disconnect;
            $flag = 2;
        }
        if ( $args->{mode_update_restrict} ) {

            # srv mode
            # RELOAD RESTRICTIONS FILE
            #
            my $next_time = 'not set';
            load_restrictions( cleosupport::get_setting('time_restrict_file') );
            correct_time_restrictions( 1, \$next_time );
            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\nNext restricion: $next_time\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
            #

            $ch->send( reopen_logs() );
            $ch->disconnect;
            main::new_req_to_child( 'reopen_logs', {},
                '__all__',          1,
                SUCC_ALL | SUCC_OK, \&nil_sub,
                \&every_nil_sub,    1,
                \&nil_sub );
            $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] );
        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 schedule...
    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' and
        $mons{ $_[0] }->{state} ne 'fail');
    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;
            $mons{ $_[0] }->{last_connect} = $last_time;

            # schedule 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_timed_out_mon($_[0]);
    }

    # check if connected...
    sc_task_in( 1, \&mons_connecter2, $_[0] );
}

#
#  Called if mon is disconnected. Check if 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;
        $mons{ $_[0] }->{last_connect} = $last_time;

        # do delayed sends...
        $mons{ $_[0] }->{conn}->flush;

        # schedule 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;

        # Not removing from Mons_select because
        # it is not added ret...
        $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 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 );

    if($mons{$i}->{last_response}>0){
    	$mons{$i}->{last_alive}=$mons{$i}->{last_response};
        # 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);
            qlog "exec monfail: $text\n", LOG_INFO;
            launch( 0, $text, "$cluster_name-$i-fail" );
        }
        # send email
        my $text = cleosupport::get_setting( 'mon_fail_mail', '', '' );
        if ( $text ne '' ) {
            my ($subj,$mail);
            $text =~ m/(.*)\n(.*)/m;
            ($subj,$mail)=($1,$2);

            undef %subst_args;
            $subst_args{node} = $i;
            subst_task_prop( \$mail, undef);
            send_mail('', $subj, $mail );
        }
    }

    block_pe( $i, NO_DEL_TASKS, 0, 'Disconnected' );

    $mons{$i}->{state} = 'fail';

    mon_cancel_all_messages($i);

    mon_fast_raise_check($i);

    $mons{$i}->{last_response}=0;
    $mons{$i}->{last_connect} =0;

    sc_task_in( 0, \&mons_connecter, $i );

    #    # 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 {
    #
    #        # schedule 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

#
#  Cancels all messages to this monitor
#
############################################
sub mon_cancel_all_messages($){
    my $mon=$_[0];
    my ($req, $to, @new_rest, $i);

    # delete this monitor from new requests
    foreach $req (@mon_req_q){
        @new_rest=();
        foreach $to (@{$req->{rest}}){
            if($to ne $mon){
                push @new_rest, $to;
            }
        }
        @{$req->{rest}}=@new_rest;
    }

    # cancel current requests
    for $i (keys(%mons_wait)){
        @new_rest=();
        foreach $to (@{$mons_wait{$i}->{_to}}){
            if($to ne $mon){
                push @new_rest, $to;
            }
        }
        @{$mons_wait{$i}->{_to}}=@new_rest;

        # delete request if this mon was last
        if ( @new_rest==0 ) {

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

            # call tmout subroutine...
            qlog( "MON CALL TPP (cancel) [$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 (cancel) [$mons_wait{$i}->{hash} $mons_wait{$i}->{type}]\n",
                    LOG_WARN
                    ) unless ( $_d_nolog_type{ $mons_wait{$i}->{type} } );
            }
            delete $mons_wait{$i};
        }
    }
}

#
#  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' );
    return if ( $mons{$i}->{state} eq 'dead' );

    qlog( "Timed out node $i\n", LOG_WARN );

    # force reconnection
    $Mons_select->remove($mons{$i}->{conn}->get_h);
    $mons{$i}->{conn}->disconnect;
    # soft block node
    block_pe($i, 1, 0, 'Timed out');

    if($mons{$i}->{last_response}>0){
        # 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);
            qlog "exec monfail: $text\n", LOG_INFO;
            launch( 0, $text, "$cluster_name-$i-fail" );
        }
        # send email
        my $text = cleosupport::get_setting( 'mon_fail_exec', '', '' );
        if ( $text ne '' ) {
            my ($subj,$mail);
            $text =~ m/(.*)\n(.*)/m;
            ($subj,$mail)=($1,$2);

            undef %subst_args;
            $subst_args{node} = $i;
            subst_task_prop( \$mail, undef);
            send_mail('', $subj, $mail );
        }
    }
    $mons{$i}->{state} = 'dead'; #! Important for reconnect!

    mon_fast_raise_check($i);
    sc_task_in( 0, \&mons_connecter, $i );

}    # ~on_mon_timed_out

#
#  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')
#
#########################################

# !!!!!!!!!!!!! not used
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);
        qlog "exec mondead: $text\n", LOG_INFO;
        launch( 0, $text, "$cluster_name-$i-dead" );
    }

    # send email
    my $text = cleosupport::get_setting( 'mon_dead_mail', '', '' );
    if ( $text ne '' ) {
        my ($subj,$mail);
        $text =~ m/(.*)\n(.*)/m;
        ($subj,$mail)=($1,$2);

        undef %subst_args;
        $subst_args{node} = $i;
        subst_task_prop( \$mail, undef);
        send_mail('', $subj, $mail );
    }

    # block this node
    if ( $_[1] ne '' ) {
        block_pe( $i, NO_DEL_TASKS, 1, $_[1] );
    } else {
        block_pe( $i, NO_DEL_TASKS, 1, "Timed out" );
    }
    if ( $mons{$i}->{block_task} ne '' ) {
        sc_task_del( $mons{$i}->{block_task} );
    }
    $mons{$i}->{state} = 'dead';
    # schedule 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 = $_[0];

    if ( defined $Mons_select ) {
        $Mons_select->add( $mons{$i}->{conn}->get_h );
    } else {
        $Mons_select = new IO::Select->new( $mons{$i}->{conn}->get_h );
    }
    $mons{$i}->{conn}->add_close_hook(\&del_from_mons_select);

    # 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);
        qlog "exec monback: $text\n", LOG_INFO;
        launch( 0, "$text", '' );
    }

    # send email
    my $text = cleosupport::get_setting( 'mon_back_mail', '', '' );
    if ( $text ne '' ) {
        my ($subj,$mail);
        $text =~ m/(.*)\n(.*)/m;
        ($subj,$mail)=($1,$2);

        undef %subst_args;
        $subst_args{node} = $i;
        subst_task_prop( \$mail, undef);
        send_mail('', $subj, $mail );
    }
    $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);
        if ( $value ne '' ) {
            $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 fails
#  Check for too many fails after reconnection,
#    blocks node and cancels reconnections if anomaly is detected.
#
#  Args: mon - monitor name
#
#########################################
sub mon_fast_raise_check( $ ) {
    return if(not exists($mons{$_[0]}));
    return if($mons{ $_[0] }->{state} eq 'dead');


    #    if($last_time-$mons{$_[0]}->{last_fail}<get_setting('mon_fail_interval')) {
    if($mons{$_[0]}->{last_response}==0){
        # no answers were received, but timeout or disconnect was happened
        # => fast raise detected...

        if(++$mons{ $_[0] }->{fast_raise_count}>get_setting('mon_fast_raise_count')){
            # too many times

            qlog "Monitor $_[0] raises too fast. Block it.\n", LOG_WARN;
            block_pe( $_[0], NO_DEL_TASKS, 0, 'Node is suspended' );
            $mons{ $_[0] }->{state}='dead';

            # execute action
            my $text = get_setting( 'mon_fast_raise_exec', '', '' );
            if ( $text ne '' ) {
                undef %subst_args;
                $subst_args{node} = $_[0];
                subst_task_prop( \$text, undef);
                qlog "exec mon_fast_raise: $text\n", LOG_INFO;
                launch( 0, $text, "$cluster_name-$_[0]-fast_raise" );
            }
            # send email
            my $text = get_setting( 'mon_fast_raise_mail', '', '' );
            if ( $text ne '' ) {
                my ($subj,$mail);
                $text =~ m/(.*?)\n(.*)/m;
                ($subj,$mail)=($1,$2);

                undef %subst_args;
                $subst_args{node} = $_[0];
                subst_task_prop( \$mail, undef);
                send_mail('', $subj, $mail );
            }
        }
    } else {
        # not so fast
        # reset fast raise counter
        $mons{$_[0]}->{fast_raise_count} = 0;
    }
    #    $mons{$_[0]}->{last_fail} = $last_time;
    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 );
    }
}
__END__
#
#  Called when new monitor is connected
#
#  Args: Monitor name
#
#################################################
sub new_mon_connection( $ ) {

    my $mon = $_[0];

    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{$mon}->{conn}->add_close_hook(\&del_from_mons_select);

    #    --$mons_connecting;
    qlog "Connected agent '$mon'.\n", LOG_INFO;
}

# {
#   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;
#   }
# }
