#!/usr/bin/env perl

# $Id$

=head1 NAME

=encoding utf8

dpkg-monitor-simple - мониторинг версий установленных пакетов

=head1 DESCRIPTION

    Регулярно запускается, определяет, были ли изменения в установленных пакетах, и отправляет всё в Версионику, если были.

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

    --conf-file — путь к конфигу, по умолчанию /etc/dpkg-monitor-simple.d/simple.conf
    --lock-file — путь к лок-файлу, по умолчанию /var/run/dpkg-monitor-simple.lock
    --status-file — путь к файлу для сохранения промежуточных состояний, по умолчанию /var/spool/dpkg-monitor-simple/status/http.yaml
    
    --testing — вместо отправки вывести отправляемую форму на экран,
        в конфиге можно задать опции dpkg_lock_file, dpkg_l_cmd (по умолчанию "dpkg-query -l"), dpkg_status_file

    Конфиг — в формате YAML — фактически должен содержать только url:
    ---
    url: 'https://direct-dev.yandex-team.ru/versionica/v3/fullupdate/p:Project/g:packages'

    на указанный url будет отправлена форма вида "(имя пакета)=(установленная версия)&(имя пакета)=(установленная версия)..."

=cut

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

use Fcntl qw(:flock);
use Getopt::Long;
use YAML;

my $CONF_FILE = '/etc/dpkg-monitor-simple.d/simple.conf';
my $STATUS_FILE = "/var/spool/dpkg-monitor-simple/status/http.yaml";
my $LOCK_FILE = '/var/run/dpkg-monitor-simple.lock';
my $TEST_MODE = 0;
my $dpkg_l_cmd = 'dpkg-query -l';
my $dpkg_lock_file = "/var/lib/dpkg/lock";
my $dpkg_status_file = "/var/lib/dpkg/status";


run() unless caller();


sub run
{
    GetOptions(
        "help"          => sub {system("podselect -section NAME -section DESCRIPTION $0 | pod2text"); exit 0;},
        "lock-file=s"   => \$LOCK_FILE,
        "status-file=s" => \$STATUS_FILE,
        "conf-file=s"   => \$CONF_FILE,
        "testing"       => \$TEST_MODE,
    ) || die "Error occured";

    my $starttime = time;

    if ($TEST_MODE) {
        my $conf = YAML::LoadFile($CONF_FILE);
        $dpkg_l_cmd = $conf->{dpkg_l_cmd} if $conf->{dpkg_l_cmd};
        $dpkg_lock_file = $conf->{dpkg_lock_file} if $conf->{dpkg_lock_file};
        $dpkg_status_file = $conf->{dpkg_status_file} if $conf->{dpkg_status_file};
    }

    my $l = my_flock($LOCK_FILE);
    check_for_dpkg_lock();

    my $status_time = (stat($STATUS_FILE))[9];

    # быстрая проверка по времени модификации файлов
    my $dpkg_status_time = (stat($dpkg_status_file))[9];
    if ($status_time && $dpkg_status_time < $status_time) {
        exit 0;
    }
    # получаем текушие версии пакетов
    my $dpkg_l_text = `$dpkg_l_cmd`;
    die "Can't perform $dpkg_l_cmd: $!" if $?;
    my $new_status_data = parse_dpkg_l($dpkg_l_text);

    my $conf = YAML::LoadFile($CONF_FILE);
    if (my @errors = validate_conf($conf)) {
        die "Error in $CONF_FILE: ".join(', ', @errors);
    }

    post_status(new => $new_status_data, conf => $conf);

    # записываем файл
    my $fh_status;
    utime ($starttime, $starttime, $STATUS_FILE)
        || (open($fh_status, ">>", $STATUS_FILE) && close $fh_status)
        || die "Cannot open status file $STATUS_FILE";

    my_unlock($l);
    exit;
}


sub post_status
{
    my %O = @_;
    my %new = %{$O{new}};
    my %to_post = map {$_ => $new{$_}->{version}} grep {$_} keys %new;
    return unless %to_post;
    chomp($to_post{_hostname_for_versionica} = `hostname -f`);

    my $url = $O{conf}->{url} or die "no url in conffile";

    my $fh_curl;
    if ($TEST_MODE) {
        # для отладки и тестирования
        $fh_curl = *STDOUT;
    } else {
        # продакшен-режим
        open($fh_curl, "| curl -f -s -k -m 120 --connect-timeout 2 --http1.0 -XPOST -d \@- $url") or die "can't fork: $!";
    }

    local $SIG{PIPE} = sub {die "curl pipe broke"};
    print $fh_curl join "&", map {"$_=$to_post{$_}"} sort keys %to_post;
    close($fh_curl) or die "http request failed: $! / $?";

    return;
}


sub validate_conf {
    my $conf = shift;
    my @err;
    if (!defined $conf->{url}) {
        push @err, "Not defined url";
    }
    my @known_keys = qw/url/;
    if ($TEST_MODE) {
        push @known_keys, qw/dpkg_lock_file dpkg_l_cmd dpkg_status_file/;
    }
    my $known_keys = join "|", @known_keys;
    if (my @unknown = sort grep {!/^($known_keys)$/} keys %$conf) {
        push @err, "Unknown keys: ".join(',', @unknown);
    }
    return @err;
}


sub my_flock
{
    my ($lock_file) = @_;
    open(my $fh, ">", $lock_file) or die "Cannot open lock file $lock_file, stop";
    flock($fh, LOCK_EX | LOCK_NB) or die "Cannot lock $lock_file, stop";
    return $fh;
}


sub my_unlock
{
    my ($fh) = @_;
    flock($fh, LOCK_UN) or die "Cannot unlock";
}


sub parse_dpkg_l
{
    my ($dpkg_text) = @_;

    my %new_status_data =
        map {$_->{name} => $_}
        # пропускаем неустановленные пакеты
        grep {$_->{status} !~ /^[pur]/}
        # парсим строчку
        map { { my_zip([qw/status name version/], [split /\s+/, $_, 4]) }; }
        my_after(sub {/^\+\+\+/},
        split /\n/,
        $dpkg_text);

    return \%new_status_data;
}


sub my_zip
{
    my ($keys, $values) = @_;
    return map { ($keys->[$_], $values->[$_]) } 0 .. scalar @$keys - 1;
}


# copy-paste из List::MoreUtils
sub my_after (&@) {
    my $test = shift;
    my $started;
    my $lag;
    grep $started ||= do {
        my $x = $lag;
        $lag = $test->();
        $x
    }, @_;
}


sub check_for_dpkg_lock
{
    # проверяем, что dpkg не запущен
    my $dpkg_lock_inode = (stat $dpkg_lock_file)[1];
    open(my $fh, "<", "/proc/locks");
    while (<$fh>) {
        exit if [split /\s+/]->[5] =~ /:$dpkg_lock_inode$/;
    }
}
