#!/usr/bin/perl -w

# $Id$

=head1 NAME

	dpkg-monitor - система отслеживания изменений в усановленных пакетах

=head1 DESCRIPTION

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

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

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

    Конфиги должны быть в формате YAML, имя конфига не должно содержать точек.
    Пример:
    ---
    email: ppc-admin@yandex-team.ru
    email_from: ppc-admin@yandex-team.ru
    packages_prefixes: 'yandex-direct'
    packages: 'libwww-perl'
    main_packages: 'yandex-direct'

    расшифровка:
    на email отправляются нотификации о изменениях в пакетах, которые начинаются с packages_prefixes
    или содержатся в списке packages. В заголоке письма будет информация о состоянии паветов main_packages.

    кроме email, можно указывать транспорт http:
    ---
    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'
    packages_prefixes: 'yandex-direct'
    packages: 'libwww-perl'
    main_packages: 'yandex-direct'

    на указанный url будет отправлена форма вида "(имя пакета)=(установленная версия|<none>)"
    (если пакет удален, в соотв. поле отправляется строка '<none>')

    если транспорт не указан -- по умолчанию предполагается email

=cut

use strict;
use YAML;
use File::Slurp;
use List::Util qw/min/;
use List::MoreUtils qw/after zip/;
use Sys::Hostname;  
use Getopt::Long;
use Pid::File::Flock qw/:auto/;
use Data::Dumper;

use Yandex::HTTP qw/http_parallel_request/;
use Yandex::SendMail;

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

# чтобы уметь отличать старые хеши (имя пакета => данные о пакете), 
# в новые хеши добавляем специальный ключ-маркер
my $KEY_TO_IDENTIFY_NEW_FORMAT = 'very_long_key_to_identify_status_format_with_metadata';

my $CONF_DIR = '/etc/dpkg-monitor.d';
my $STATUS_DIR = '/var/spool/dpkg-monitor/status';
my $PID_FILE = '/var/run/dpkg-monitor.pid';

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

my $starttime = time;

# проверяем, что dpkg не запущен
my $dpkg_lock_inode = (stat "/var/lib/dpkg/lock")[1];
exit if grep {[split /\s+/]->[5] =~ /:$dpkg_lock_inode$/} read_file("/proc/locks");

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 $dpkg_status_time = (stat("/var/lib/dpkg/status"))[9];
if( @status_times && $dpkg_status_time < 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 $dpkg_text = `dpkg -l`;
die "Can't start dpkg: $!" if $?;
my %new_status_data =
    map {$_->{name} => $_}
    # пропускаем неустановленные пакеты
    grep {$_->{status} !~ /^[pur]/}
    # парсим строчку
    map { {zip @{[qw/status name version desc/]}, @{[split /\s+/, $_, 4]}}; }
    after {/^\+\+\+/}
    split /\n/,
    $dpkg_text;

my %new_status = (
    metadata => {
        hostname => hostname(),
        version => 2,
    },
    $KEY_TO_IDENTIFY_NEW_FORMAT => 1,
    data => \%new_status_data,
);

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

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);
    }
    # собираем регулярку, отделяющую интересующие нас ключи
    my @re;
    if ($conf->{packages}) {
        push @re, map {s/\s//g; "\Q$_\E"} split /,/, $conf->{packages};
    }
    if ($conf->{packages_prefixes}) {
        push @re, map {s/\s//g; "\Q$_\E.*"} split /,/, $conf->{packages_prefixes};
    }
    my $re = @re ? join("|", @re) : '.*';

    my @re_ignore;
    if ($conf->{packages_prefixes_ignore}) {
        push @re_ignore, map {s/\s//g; "\Q$_\E.*"} split /,/, $conf->{packages_prefixes_ignore};
    }
    my $re_ignore = @re_ignore ? join("|", @re_ignore) : '';

    my %new = map {$_ => $new_status{data}->{$_}} grep {/^($re)$/ && (!$re_ignore || ! /^($re_ignore)/)} keys %{$new_status{data}};

    $conf->{transport} ||= 'email';
    $conf->{transport} = [$conf->{transport}] unless ref $conf->{transport} eq 'ARRAY';
    
    for my $transport ( @{$conf->{transport}} ){
        next if $fail{$transport};
        
        my %old;
        my $hostname_status = {};
        if ( !exists $old_status{$transport}->{$KEY_TO_IDENTIFY_NEW_FORMAT} || 
            ($old_status{$transport}->{metadata}->{version} || '') != $new_status{metadata}->{version} ||
            ($old_status{$transport}->{metadata}->{hostname} || '') ne $new_status{metadata}->{hostname}
        ) {
            # если раньше у хоста было другое имя, или сменился формат хранения статуса -- переотправляем данные обо всех пакетах
            # (делаем вид, что раньше ничего установлено не было)
            %old = ();
            $hostname_status->{hostname_changed} = 1;
            $hostname_status->{old_hostname} = $old_status{$transport}->{metadata}->{hostname} || '*UNKNOWN*';
            $hostname_status->{new_hostname} = $new_status{metadata}->{hostname};
        } else {
            %old = map {$_ => $old_status{$transport}->{data}->{$_}} grep {/^($re)$/ && (!$re_ignore || ! /^($re_ignore)/)} keys %{$old_status{$transport}->{data}||{}};
        }

        eval{
            if ( $transport eq 'email' ){
                email_diff( new => \%new, old => \%old, dpkg_text => $dpkg_text, re => $re, conf => $conf, hostname_status => $hostname_status);
            } elsif( $transport eq 'http' ){
                post_diff(new => \%new, old => \%old, conf => $conf, hostname_status => $hostname_status);
            }
        };
        if ($@){
            $fail{$transport} = 1;
            print STDERR $@;
        }
    }
}
closedir($c_dh) || die "Can't close dir $CONF_DIR: $!";

# записываем файлы
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, 'binmode' => ':utf8' }, Dump(\%new_status));
        utime $starttime, $starttime, $file;
    }
}

exit; 

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

    # сравниваем версии
    my @msg;
    if ($O{hostname_status}->{hostname_changed}){
        die "old or new hostnames missed" unless $O{hostname_status}->{old_hostname} && $O{hostname_status}->{new_hostname};
        push @msg, "сменилось имя хоста: $O{hostname_status}->{old_hostname} --> $O{hostname_status}->{new_hostname}";
    }
    push @msg, map {"удалился пакет $_"} sort grep {!exists $new{$_}} keys %old;
    push @msg, map {"установился пакет $_, версия $new{$_}->{version}"} sort grep {!exists $old{$_}} keys %new;
    push @msg, map {"обновился пакет $_: $old{$_}->{version} -> $new{$_}->{version}"} sort grep {exists $new{$_} && $old{$_}->{version} ne $new{$_}->{version}} keys %old;
    if (@msg) {
        if ($O{conf}->{email}) {
            # отсылаем письмо, если нужно
            my $text = join "\n", "Произошли следующие изменения:", map {"  $_"} @msg;

            $text .= "\n\nТекущее состояние:\n".join("\n", grep {/^\S+\s+($O{re})\s+/} split /\n/, $O{dpkg_text});
            $text .= "\n\n-- \ndpkg-monitor\n";

            my $main_packages_text = $O{conf}->{main_packages}
                ? join(', ', map {s/\s//g; "$_=$new{$_}->{version}"} grep {$new{$_}} split /,/, $O{conf}->{main_packages})
                : '';
            my $title = $O{conf}->{title} ? " ($O{conf}->{title})" : ""; 
            my $subj = "Software update on ".hostname().($main_packages_text ? ": $main_packages_text" : '').$title;

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

    return;
}


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

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

    return if ! keys %to_post;
    chomp($to_post{_hostname_for_versionica} = `hostname -f`);

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

    my $resp = http_parallel_request(POST => {1 => {url => $url, body => \%to_post}}, timeout => 200, headers => { 'Content-Type' => 'application/x-www-form-urlencoded' });
    $resp = $resp->{1};
    die "web versionica response code: $resp->{headers}->{Status}\nreason: $resp->{headers}->{Reason}\n" if $resp->{headers}->{Status} != 200;

    if ($O{hostname_status}->{hostname_changed}){
        die "old or new hostnames missed" unless $O{hostname_status}->{old_hostname} && $O{hostname_status}->{new_hostname};

        (my $names_url = $url) =~ s!/update$!/incrementalupdate/names?old_hostname=$O{hostname_status}->{old_hostname}&new_hostname=$O{hostname_status}->{new_hostname}!;
        $resp = http_parallel_request(GET => {1 => {url => $names_url}}, timeout => 200);
        $resp = $resp->{1};
        die "web versionica response code: $resp->{headers}->{Status}\nreason: $resp->{headers}->{Reason}\n" if $resp->{headers}->{Status} != 200;
    }

    return;
}


sub validate_conf {
    my $conf = shift;
    my @err;
    if ( grep {$_ eq 'email'} @{$conf->{transport} || []} && !defined $conf->{email} ) {
        push @err, "Not defined email";
    }
    if ( grep {$_ eq 'http'} @{$conf->{transport} || []} && !defined $conf->{url} ) {
        push @err, "Not defined url";
    }
    if (my @unknown = sort grep {!/^(email|email_from|packages|packages_prefixes|packages_prefixes_ignore|main_packages|transport|title|url)$/} keys %$conf) {
        push @err, "Unknown keys: ".join(',', @unknown);
    }
    return @err;
}
