#!/usr/bin/perl -w

# $Id$

=head1 NAME

	dbconfig-monitor -- отслеживание изменений в Direct-style конфиге коннектов к БД

=head1 DESCRIPTION

    Регулярно запускается, читает файлы с конфигами из директории /etc/dbconfig-monitor.d/,
    определяет, что изменилось в конфигурации коннектов и отправляет нотификации на емейлы, 
    указанные в конфигаx.

    возможные опции:
    help - вывести справку

    conf-dir - директория с конфигами
    pid-file - путь к пид-файлу
    status-file - путь к файлу для сохранения промежуточных состояний

    Конфиги должны быть в формате YAML, имя конфига не должно содержать точек.
    Пример:
    ---
    transport:
      - email
      - http
    email: ppc-admin@yandex-team.ru
    email_from: ppc-admin@yandex-team.ru
    url: 'http://direct-dev.yandex-team.ru/versionica/update/db'
    target: /var/www/ppc.yandex.ru/etc/db-config.yaml
    title: Direct

    если транспорт не указан -- по умолчанию предполагается email
    email -- отсылка письма-уведомления, 
    http -- отправка формы в Версионику. В отличие от dpkg-monitor'а отправляются всегда все ключи и значения.

    
    ./dbconfig-monitor --pid-file=pid --status-dir status --conf-dir dbconfig-monitor.d

=cut

use strict;
use YAML;
use JSON;
use File::Slurp;
use List::Util qw/min max/;
use Sys::Hostname;  
use Getopt::Long;
use Pid::File::Flock qw/:auto/;
use Net::INET6Glue::INET_is_INET6;
use LWP::UserAgent;
use Data::Dumper;

use Yandex::SendMail;

use DBConfigExplorer;

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

my $CONF_DIR = '/etc/dbconfig-monitor.d';
my $STATUS_DIR = '/var/spool/dbconfig-monitor/status';

run() unless caller();

sub run
{
    GetOptions(
        "help" => sub {system("podselect -section NAME -section DESCRIPTION $0 | pod2text-utf8 >&2"); exit 0;},
        "status-dir=s" => \$STATUS_DIR,
        "conf-dir=s" => \$CONF_DIR,
    ) || die "Error occured";

    my $starttime = time;

    my @status_files;
    my @status_times;
    opendir(my $s_dh, $STATUS_DIR) || die "Can't open dir $STATUS_DIR: $!";
    for my $file (sort grep {m/\.yml$/} readdir($s_dh)) {
        push @status_files, $file;
        push @status_times, (stat("$STATUS_DIR/$file"))[9];
    }
    closedir($s_dh) || die "Can't close dir $STATUS_DIR: $!";

    my @confs;
    opendir(my $c_dh, $CONF_DIR) || die "Can't open dir $CONF_DIR: $!";
    for my $file (sort grep {!/\./} readdir($c_dh)) {
        my $conf = YAML::LoadFile("$CONF_DIR/$file");
        if (my @errors = validate_conf($conf)) {
            die "Error in $CONF_DIR/$file: ".join(', ', @errors);
        }
        push @confs, $conf;
    }
    closedir($c_dh) || die "Can't close dir $CONF_DIR: $!";

    exit if !@confs;

    my @dbconf_times;
    for my $conf ( @confs ){
        push @dbconf_times, (stat($conf->{target}))[9];
    }
    # если исполняемся из файла -- добавляем время модификации программы к конфигам
    # мотивация: если скрипт поменялся, то стоит переотправить все
    if ( -f $0 ){
        push @dbconf_times, (stat($0))[9];
    }

    # быстрая проверка по времени модификации файлов 
    if( @status_times && max(@dbconf_times) < min(@status_times) ){
        exit;
    }

    # читаем старые (обработанные) версии конфигов
    # считаем, что статусные файлы называются по именам транспортов (email.yml, http.yml)
    my %old_status;
    for my $file (@status_files){
        (my $transport = $file) =~ s/\.yml$//;
        $old_status{$transport} = YAML::LoadFile("$STATUS_DIR/$file");
    }

    # получаем текушие версии конфигов
    my %new_status;
    my %new_text;
    for my $conf (@confs){
        $new_text{$conf->{target}} = read_file($conf->{target});
        my $db_config = load_config($conf->{target});
        hide_secrets_in_config($db_config);
        $new_status{$conf->{target}} = $db_config;
    }

    # были ли ошибки в отсылке данных по каждому из транспортов
    my %fail;

    for my $conf (@confs) {
        $conf->{transport} ||= 'email';
        $conf->{transport} = [$conf->{transport}] unless ref $conf->{transport} eq 'ARRAY';

        for my $transport ( @{$conf->{transport}} ){
            next if $fail{$transport};
            my $old = DBConfigExplorer::list_properties($old_status{$transport}->{$conf->{target}});
            my $new = DBConfigExplorer::list_properties($new_status{$conf->{target}});
            eval{
                if ( $transport eq 'email' ){
                    email_diff( new => $new, old => $old, new_text => $new_text{$conf->{target}}, conf => $conf);
                } elsif( $transport eq 'http' ){
                    post_dbconf(new => $new, old => $old, conf => $conf);
                }
            };
            if ($@){
                $fail{$transport} = 1;
                print STDERR $@;
            }
        }
    }

    # записываем файлы
    for my $transport ( qw/email http/ ){ # TODO список транспортов хорошо бы хранить отдельно, и использовать и в проверке, и в отсылке, и при записи
        next if $fail{$transport};
        if (Dump(\%new_status) ne Dump($old_status{$transport})) {
            my $file = "$STATUS_DIR/$transport.yml";
            write_file($file, {atomic => 1}, Dump(\%new_status));
            utime $starttime, $starttime, $file;
        }
    }

    exit; 
}


sub email_diff
{
    my %O = @_;
    my %new = %{$O{new} || {}};
    my %old = %{$O{old} || {}};

    # сравниваем версии
    my @msg;
    push @msg, map {"- $_"} sort grep {!exists $new{$_}} keys %old;
    push @msg, map {"+ $_ = $new{$_}"} sort grep {!exists $old{$_}} keys %new;
    push @msg, map {"~ $_: $old{$_} -> $new{$_}"} sort grep {exists $new{$_} && $old{$_} ne $new{$_}} keys %old;
    if (@msg) {
        if ($O{conf}->{email}) {
            my $host = hostname();
            # отсылаем письмо, если нужно
            my $text = join "\n", 
                "$host: обновлена конфигурация соединений с БД.",
                "Произошли следующие изменения:", 
                map {"  $_"} @msg;

            $text .= "\n\nТекущее состояние:\n$O{new_text}";
            $text .= "\n\n-- \ndbconfig-monitor\n";

            my $title = $O{conf}->{title} ? " ($O{conf}->{title})" : ""; 
            my $subj = "Dbconfig update on $host$title";

            local $Yandex::SendMail::FROM_FIELDS_FOR_ALERTS = $O{conf}->{email_from} || $O{conf}->{email};
            send_alert($text, $subj, $O{conf}->{email});
            #print STDERR "$subj\n\n$text\n";
        } else {
            die "Unknown report method: email is not defined!";
        }
    }

    return;
}


sub post_dbconf 
{
    my %O = @_;
    my %new = %{$O{new}};
    my %old = %{$O{old}};

    # отправляем изменения
    my %changes =
        map { $_ => $new{$_} }
        grep { !exists $old{$_} || $old{$_} ne $new{$_} }
        keys %new;
    $changes{$_} = '<none>' for sort grep {!exists $new{$_}} keys %old;

    return if ! keys %changes;

    my $url = $O{conf}->{url} or die "url isn't defined for 'http' transport";

    my $ua = LWP::UserAgent->new(timeout => 20);
    my $resp = $ua->post($url, \%new);

    die "web versionica response code: ".$resp->code."\n" if $resp->code != 200;

    return;
}


sub validate_conf 
{
    my $conf = shift;
    my @err;
    if (!defined $conf->{target}) {
        push @err, "Not defined target file to monitor";
    }
    if (my @unknown = sort grep {!/^(email|email_from|target|transport|title|url)$/} keys %$conf) {
        push @err, "Unknown keys: ".join(',', @unknown);
    }
    return @err;
}


sub load_config
{
    my $file = shift;
    if ($file =~ /\.ya?ml$/) {
        return YAML::LoadFile($file);
    } elsif ($file =~ /\.json$/) {
        return JSON::from_json(scalar read_file($file));
    } else {
        die "Unknown file format: '$file'";
    }
}

=head2

    in-place заменяет содержимое секретных полей (пока только pass) на заглушку

=cut
sub hide_secrets_in_config
{
    # можно бы и скопировать @_ в переменные, но оставляем аналогично force_number_recursive
    if (ref $_[0] eq ""){
        # скаляр -- ничего не делать
    } elsif ( ref $_[0] eq 'ARRAY' ){
        hide_secrets_in_config($_) for @{$_[0]};
    } elsif ( ref $_[0] eq 'HASH' ) {
        for my $k (keys %{$_[0]}){
            if ($k eq "pass" && ref $_[0]->{$k} eq ""){
                $_[0]->{$k} = "<hidden>";
            } elsif ($k eq "pass" && ref $_[0]->{$k} ne "" ){
                # если пароль задан структурой -- ничего не делаем, предполагаем, что это {file => "/что/то/там"}
            } else {
                hide_secrets_in_config( $_[0]->{$k} );
            }
        }
    }

    return $_[0];
}

