#!/usr/bin/perl

=head1 NAME

=encoding utf8

direct-spec - проверка соответствия спецификациям (на необходимые доступы, готовность к обработке нагрузки и тд)

=head1 DESCRIPTION

  -h, --help
    справка

  -l, --list
    ничего не проверять, только показать список проверок, попадающих под условия
    Формат краткий, удобный для человека

  --list-yaml
    ничего не проверять, только вывести прореженные писок проверок, попадающих под условия
    Формат -- yaml, как в исходном конфиге

  -n, --name-like
    условие на имя проверки, регвыр

  -q, --quiet
    не показывать проверки, которые прошли успешно

  --rw
    разрешить пишущие проверки (по умолчанию только читающие)
    
  --juggler
    отправить результаты проверки в juggler (не совмещается вместе с host)
    
  --host
    делать проверки от имени этого хоста (не совмещается вместе с juggler)
    
  --service
    название сервиса проверки для juggler, обязательно, если указан --juggler

  --status-file
    писать статус всех проверок в формате monrun в заданный файл

  --log-results
    логировать результаты проверок. Логи складываются в /var/log/yandex/direct-access-check, по файлу на небольшой период времени

  --conductor-cache-dir
    директория с кэшем содержимого кондукторных групп. Если не передана, то кэшироваться ничего не будет

=head1 EXAMPLE

    Список проверок, применимых к текущей машине:
    direct-spec etc/direct_checks.*.yaml --list

    Список проверок, применимых к другой машине:
    direct-spec etc/direct_checks.yaml --host ppcsoap01f.yandex.ru --list

    Выполнить read-only проверки и показать на STDOUT полный отчет:
    direct-spec etc/direct_checks.yaml 

    Выполнить read-only проверки и показать на STDOUT только зафейленные:
    direct-spec etc/direct_checks.yaml -q

    Выполнить read-only проверки и отправить результат в juggler:
    direct-spec etc/direct_checks.yaml

    Выполнить все проверки (включая пишущие) и отправить результат в juggler:
    direct-spec etc/direct_checks.yaml --rw --juggler

    Безопасные (read-only) проверки от имени другого хоста:
    direct-spec etc/direct-access-check/direct_checks.yaml --host ppcdev3.yandex.ru
   
=head1 FUNCTIONS    

=cut

use strict;
use warnings;

use Getopt::Long;
use Data::Dumper;
use IO::Socket::IP;
use YAML;
use Try::Tiny;
use File::Slurp;
use POSIX qw/strftime/;
use JSON;
use Path::Tiny;

use Yandex::Conductor;
use Yandex::JugglerQueue;

use utf8;
use open ":std" => ":utf8";

use feature 'state';

my $TIMEOUT = 3;

my $own_host;

my $juggler_description = '';

our $LOG_RESULTS;
our $LOG_DIR_PREFIX = '/var/log/yandex/direct-spec';
our $LOG_DIR;

our $CONDUCTOR_GROUPS_CACHE_DIR;
our $CONDUCTOR_GROUP_CACHE_TTL = 3600; # секунд

our %SKIP_TARGET;

run() unless caller();

sub run
{
    my $opt = parse_options();

    if ( $opt->{host} ){
        $own_host = $opt->{host};
    } else {
        $own_host = `hostname -f`;
        chomp($own_host);
    }
 
    my @rules_to_check;
    die "no configs to check\n" unless $ARGV[0];
    while (my $conf = shift @ARGV) {
        try {
            die "$conf is not readable" unless -r $conf;
    
            my $rules = YAML::LoadFile($conf);
            normalize_rules($rules);
            $rules = filter_rules($rules, $opt);
            push @rules_to_check, @$rules;
        } catch {
            s/\$.*//s;
            warn "skipping config $conf: $_";
        };
    }

    if ( $opt->{action} eq "list" ){
        list_checks(\@rules_to_check);
    } elsif ( $opt->{action} eq "list_yaml" ){
        list_checks(\@rules_to_check, format => 'yaml');
    } elsif ( $opt->{action} eq "check" ){
        do_checks(\@rules_to_check, $opt);
    } else {
        die "unknown action $opt->{action}, stop";
    }

    exit 0;
}

=head2 list_checks

    Печатает список проверок

=cut

sub list_checks
{
    my ( $rules, %O ) = @_;
    $O{format} //= '';
    if ( $O{format} eq 'yaml' ){
        print YAML::Dump($rules);
    } elsif( $O{format} ){
        die "unknown format '$O{format}', stop.";
    } else {
        for my $rule (@$rules){
            my $RO = $rule->{read_only} ? "ro" : "RW";
            print "$RO $rule->{name}"."\n";
        }
    }

    return '';
}


=head2 do_checks

    Выполняет проверки и печатает результаты (в соответствии с настройками подробности вывода)

=cut

sub do_checks
{
    my ( $rules_to_check, $opt ) = @_;
    
    $juggler_description = '';
 
    for my $rule (@$rules_to_check){
        
        my $errors = check_single_rule($rule);
        report_ok( $rule, quiet => $opt->{quiet} ) if $errors == 0;
        if (!($errors == 0 && $opt->{quiet})) {
            print ("-" x 50 ."\n");
        }
        last if $opt->{stop_on_error} && $errors != 0;
    }

    return if ! @$rules_to_check;

    if ($juggler_description eq '') {
        juggler_ok(service => $opt->{service}) if $opt->{juggler};
        write_file($opt->{status_file}, '0;OK') if $opt->{status_file};
    } else {
        juggler_crit(service => $opt->{service}, description => $juggler_description) if $opt->{juggler};
        write_file($opt->{status_file}, "2;CRIT $juggler_description") if $opt->{status_file};
    }
}


=head2 host_matches_rule

    Проверяет, есть ли наш хост в списке хостов и групп из поля applicable

=cut

sub host_matches_rule
{
    my ($rule, $conductor_groups) = @_;
    my @hosts;
    
    for my $h (@{$rule->{applicable}}) {
        if ($h =~ m!conductor/(.*)!) {
            my $group = $1;
            if (!exists $conductor_groups->{$group}) {
                try {
                    $conductor_groups->{$group} = get_conductor_hosts_cached($group);
                } catch {
                    report_problem($rule, "can't expand group $group");
                };
            }

            push @hosts, @{$conductor_groups->{$group}};
        } elsif ($h eq 'ANY') {
            return 1;
        } else {
            push @hosts, $h;
        }
    }
    
    for my $host (@hosts) {
        if ($own_host eq $host || $own_host eq 'ANY') {
            return 1;
        }
    }
    return 0;
}


=head2 check_single_rule

    Выполняет одну проверку, возвращает результат, ничего не печатает

=cut

sub check_single_rule
{
    my ($rule, %opt) = @_;

    if ( $rule->{check_method} eq "connect" ) {
        my $err = 0;
        my @targets;
        for my $t ( @{$rule->{target}} ){
            if($t =~ m!conductor/([^:]+):([0-9]+)!){
                my ($group, $port) = ($1, $2);
                try {
                    push @targets, map {"$_:$port"} @{get_conductor_hosts_cached($group)};
                } catch {
                    $err++;
                    report_problem($rule, "can't expand group $group");
                };
            } else {
                push @targets, $t;
            }
        }
        for my $target ( @targets ){
            next if ($SKIP_TARGET{$target});

            die "can't parse target $target, stop" unless $target =~ /^([^:\s]+):([0-9]+)$/;
            my ($host, $port) = ($1, $2);
            my ($sock, $sock_err);
            my $tries = $rule->{tries} || 1;
            my $time_ok;
            
            for my $try  (1..$tries) {
                $time_ok = eval {
                    local $SIG{ALRM} = sub { die "alarm\n" };
                    alarm $TIMEOUT;
                    $sock = IO::Socket::IP->new(
                        PeerHost => $host,
                        PeerPort => $port,
                        Type     => SOCK_STREAM,
                    );
                    $sock_err = $@ unless $sock;
                    alarm 0;
                    1;
                };
                undef $sock;
                
                last if $time_ok && !$sock_err;
                sleep 1;
            }
            
            unless ($time_ok){
                report_problem($rule, "timed out $target");
                $err++;
            }
            if ($sock_err) {
                report_problem($rule, "cannot construct socket / $sock_err");
                $err++;
            }
            #push @err, "$target Cannot construct socket - $sock_err" if $sock_err;
        }
        return $err;
    } elsif ( $rule->{check_method} eq "exec" ){
        my @commands = ref $rule->{command} eq "ARRAY" ? @{$rule->{command}} : $rule->{command};
        my $tries = $rule->{tries} || 1;
        my $err = 0;
        for my $command (@commands) {
            my $ok;
            my ($status, $stdout);
            
            for my $try (1..$tries) {
                my $pid;
                $ok = eval {
                    local $SIG{ALRM} = sub { die "alarm\n" };
                    alarm $TIMEOUT;
                    $pid = fork;
                    if ($pid == 0) {
                        exec $command;
                    } else {
                        waitpid($pid, 0);
                        $status = $? >> 8;
                    }
                    alarm 0;
                };
                
                if ($@ && $@ eq "alarm\n") {
                    system("pkill -P $pid");
                    kill (15, $pid);
                }
                
                last if $ok && $status == 0;
                sleep 1;
            }
            
            if (!$ok){
                report_problem($rule, "timed out / $command");
                $err++;
            } elsif ( $status != 0 ){
                report_problem($rule, "exit code $status / $command");
                $err++;
            }
        }
        return $err;
    } elsif ( 0 ){
    } else {
        local ($Data::Dumper::Terse, $Data::Dumper::Quotekeys, $Data::Dumper::Sortkeys) = (1, 0, 1);
        die "unknown check_method in rule:\n".Dumper($rule).", stop";
    }

    return 0;
}

sub log_result
{
    my ($rule, $result, @extra) = @_;
    state $log_fh;
    state $log_file_name;
    state $log_dir_created;

    my $log_period = 1800;  # секунд

    my $now = time();
    my @log_start_time = localtime($now - $now%$log_period);
    my @log_end_time   = localtime($now - $now%$log_period + $log_period);
    my $current_log_name = $LOG_DIR . sprintf("%s-%s", strftime("%Y%m%d_%H%M", @log_start_time), strftime("%Y%m%d_%H%M", @log_end_time));

    if (!$log_dir_created) {
        path($LOG_DIR)->mkpath;
        $log_dir_created = 1;
    }
    if (($log_file_name // '') ne $current_log_name) {
        if ($log_fh) {
            close $log_fh or warn "error closing '$log_file_name': $!";
        }
        $log_file_name = $current_log_name;
        open $log_fh, '>>', $log_file_name or die "can't open log file '$log_file_name': $!";
    }

    # предполагается, что два процесса с одним --service не пишут в лог одновременно
    print $log_fh strftime("%Y-%m-%d %H:%M:%S", localtime($now)) . ' ' . to_json([$rule, $result, @extra]) . "\n";
}

sub get_skipped_targets
{
    my ($rule) = @_;
    my @targets = ref $rule->{target} eq 'ARRAY' ? @{ $rule->{target} } : ($rule->{target} // ());
    my @skipped_targets = grep {$SKIP_TARGET{$_}} @targets;
    return @skipped_targets;
}

=head2 report_ok

    Сообщает об успешно пройденной проверке: в соответствии с настройками подробности вывода печатает сообшение либо ничего не делает

=cut

sub report_ok
{
    my ($rule, %O) = @_;

    my @skipped_targets = get_skipped_targets($rule);
    my $skipped_targets_str = join(', ', @skipped_targets);

    if ($LOG_RESULTS) {
        my @extra;
        if (@skipped_targets) {
            @extra = "skipped targets: $skipped_targets_str";
        }
        log_result($rule->{name}, "ok", @extra);
    }
    return if $O{quiet};
    print "ok $rule->{name}" . (@skipped_targets ? " (skipped targets: $skipped_targets_str)" : "") . "\n";
    return;
}


=head2 report_problem

    Печатает сообщение о неyспешной проверке

=cut

sub report_problem
{
    my ($rule, $errors) = @_;
    $errors = [$errors] unless ref $errors;

    my @skipped_targets = get_skipped_targets($rule);
    my $skipped_targets_str = join(', ', @skipped_targets);
    
    if ($LOG_RESULTS) {
        my @extra;
        if (@skipped_targets) {
            @extra = "skipped targets: $skipped_targets_str";
        }
        log_result($rule->{name}, $errors, @extra);
    }
    $juggler_description .= join "", map {"failed $rule->{name}: $_ \n" } @$errors;
    print join "", map {"failed $rule->{name}: $_\n" } @$errors;
    if (@skipped_targets) {
        print "(skipped targets: $skipped_targets_str)\n";
    }
}


=head2 filter_one_rule

    Проверяет одно правило на соответствие фильтру.
    Возвращает 1 -- соответствует, 0 -- не соответствует

=cut

sub filter_one_rule
{
    my ($opt, $rule, $conductor_groups) = @_;

    return 0 if !$opt->{include_rw_checks} && !$rule->{read_only};
    return 0 if $opt->{name_like} && $rule->{name} !~ /$opt->{name_like}/;
    return 0 if !host_matches_rule($rule, $conductor_groups);

    return 1;
}

=head2 filter_rules

    получает ссылку на массив правил, и настройки фильтрации,
    возвращает ссылку на массив тех правил, которые соответствуют условиям

=cut

sub filter_rules
{
    my ($rules, $opt) = @_;
    my %conductor_groups;

    return [ grep { filter_one_rule($opt, $_, \%conductor_groups) } @$rules ];
}


=head2 normalize_rules

    Нормализует проверки: приписывает автоматические имена безымянным, превращает поле target в ссылку на массив и т.п.

=cut

sub normalize_rules
{
    my ($rules) = @_;

    for my $rule (@$rules){
        $rule->{comment} ||= '';
        if ( !$rule->{check_method} ){
            die "unknown check_method in rule:\n".Dumper($rule).", stop";
        }
        if (!$rule->{applicable}) {
            die "no applicable groups:\n".Dumper($rule).",stop";
        }
        $rule->{applicable} = [$rule->{applicable}] unless ref $rule->{applicable};
        
        if ( $rule->{check_method} eq "connect" ){
            $rule->{target} = [$rule->{target}] unless ref $rule->{target};
            $rule->{read_only} = 1;
            unless ( $rule->{name} ){
                $rule->{name} = "connect $rule->{target}->[0]". (scalar(@{$rule->{target}}) > 1 ? " et. al." : "");
            }
        }
        if ( $rule->{check_method} eq "exec" ){
            $rule->{name} ||= "exec $rule->{command}";
        }
    }
}


=head2 get_conductor_hosts_cached

    Кэшированный запрос хостов для кондукторной группы
    Обёртка над conductor_groups2hosts, но в отличие от неё, отдаёт хосты для только одной группы

=cut

sub get_conductor_hosts_cached($) {
    my ($group) = @_;
    my @hosts;
    my $cache_file_path;
    $cache_file_path = $CONDUCTOR_GROUPS_CACHE_DIR . '/' . $group if $CONDUCTOR_GROUPS_CACHE_DIR;
    if ($cache_file_path) {
        my $cache_mtime = (stat $cache_file_path)[9];
        if ($cache_mtime && time() - $cache_mtime < $CONDUCTOR_GROUP_CACHE_TTL) {
            open my $cache_fh, '<', $cache_file_path;
            # здесь бы хотя бы предупреждение писать, если не открылся, но stderr тоже перенаправляется в лог, и direct-spec-log-handler может этого не пережить. Стоит исправить
            if ($cache_fh) {
                for my $line (<$cache_fh>) {
                    chomp(my $host = $line);
                    push @hosts, $host;
                }
            }
        }
    }
    if (!@hosts) {
        # если пустая группа, не кэшируем, чтобы не закэшировать пустоту по ошибке
        @hosts = @{ conductor_groups2hosts([$group]) };
        if ($cache_file_path) {
            open my $cache_fh, '>', $cache_file_path;
            if ($cache_fh) {
                print $cache_fh join("\n", @hosts);
            }
        }
    }
    return \@hosts;
}

sub parse_options
{
    my %O = (
        include_rw_checks => 0,
        quiet => 0,
        status_file => '',
    );

    GetOptions(
        'h|help'      => sub { system("podselect -section DESCRIPTION -section EXAMPLE $0 | pod2text"); exit 0; },
        'l|list'         => \$O{list},
        'list-yaml'      => \$O{list_yaml},
        'n|name-like=s'  => \$O{name_like},
        'service=s' => \$O{service},
        'q|quiet'    => \$O{quiet},
        'rw'              => \$O{include_rw_checks},
        'juggler'    => \$O{juggler},
        'host=s'     => \$O{host},
        'status-file=s'     => \$O{status_file},
        'log-results' => \$LOG_RESULTS,
        'conductor-cache-dir=s' => \$CONDUCTOR_GROUPS_CACHE_DIR,
        'skip-targets-file=s' => \$O{skip_targets_file},
    ) or die "can't parse options";
 
    die "Error: host and juggler are not compatible" if $O{host} && $O{juggler};
    die "Error: --service not specified" if $O{juggler} && !$O{service};
 
    if ( $O{list} ){
        $O{action} = "list";
    } elsif ( $O{list_yaml} ){
        $O{action} = "list_yaml";
    } else {
        $O{action} = "check";
    }
    delete $O{list};

    if ($LOG_RESULTS) {
        $LOG_DIR = "$LOG_DIR_PREFIX/$O{service}/";
    }

    if ($O{skip_targets_file}) {
        open my $fh, '<', $O{skip_targets_file} or warn "ignoring --skip-targets-file, because could not open file $O{skip_targets_file}: $!";
        my $now = strftime("%Y-%m-%d %H:%M:%S", localtime(time()));
        if ($fh) {
            while (my $line = <$fh>) {
                next if $line =~ /^\s*#/;
                next if $line =~ /^\s*$/;
                my ($expire_date, $expire_time, $target) = $line =~ /^([0-9]{4}-[0-9]{2}-[0-9]{2})\s+([0-9]{2}:[0-9]{2})\s*(.*)$/;
                next unless $target && $expire_date && $expire_time;    # warning?
                $SKIP_TARGET{$target} = $now le "$expire_date $expire_time";
            }
        }
    }

    return \%O;
}


