#!/usr/bin/perl -w

=head1 NAME
    
    nginx_update_geo_conf.pl

=head1 SYNOPSIS

    nginx_update_geo_conf --config=<config_file>
    nginx_update_geo_conf  --init=<nginx_init_script> --output-directory=<nginx_conf_dir> --variable <var_name>=<ranges_file> ...
    nginx_update_geo_conf  --init=<nginx_init_script> --output-directory=<nginx_conf_dir> --variable <var_name>=networks:<networks_file> ...
    nginx_update_geo_conf  -i <nginx_init_script> -o <nginx_conf_dir> -v <var_name>=<ranges_file> -v <var_name>=cbb:<cbb_flag> ...

=head1 DESCRIPTION

    Обновление конфигурации nginx, отвечаюшей за выставление переменных по ip
    Опции:
        -h, --help
            показать этот текст и завершиться
        -c, --config <config_file>
            считать параметры из конфига
        -v, --variable <var_name>=<ranges>
            сделать гео-конфиг, определяющий переменную $geo_<var_name>
            ranges может быть либо полным путём до файла, либо cbb:<flag>
            для загркзки таблицы из cbb
        -i, --init <nginx_init_script>
            путь к инит скрипту для перезагрузки nginx
            может повторяться несколько раз, перезагружаются только существующие скрипты
        -n, --nginx <nginx_bin>
            путь к бинарнику nginx для проверки конфигов
            по умолчанию: /usr/sbin/nginx
        -o, --output-directory <dir>
            обязательный параметр
            директория, в которой будут создаваться конфиги geo_<var_name>.conf
        -s, --sleep 10
            при запуске подождать N секунд перед началом работы (чтобы, в случае поминутных 
            запусков забирать самые свежие данные)

=head1 INTERNALS

=cut

use strict;
use warnings;

use Fcntl ':flock';
use Path::Tiny;
use Getopt::Long;
use Data::Dumper;
use Net::IP;

use Yandex::TVM2;

use Fatal qw/open close rename flock unlink utime/;

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

umask 022;

my %VARIABLES;
my @INIT;
my $OUTPUT_DIR;
my $NGINX = '/usr/sbin/nginx';
my $SLEEP = 0;
my %OPTS = (
    "help" => \&usage,
    "config=s" => sub {read_config($_[1])},
    "variable=s%" => \%VARIABLES,
    "init=s" => \@INIT,
    "nginx=s" => \$NGINX,
    "sleep=i" => \$SLEEP,
    "output-directory=s" => \$OUTPUT_DIR,
    );
GetOptions(%OPTS) or die "Getopt error";

my $is_testing = (path('/etc/yandex/environment.type')->slurp !~ /^(production|prestable)\s*$/);
my $is_sandbox = -f '/etc/yandex/environment.direct_sandbox';

my $CBB_URL = $is_testing ? 'http://cbb-test.yandex.net' : 'https://cbb-ext.yandex-team.ru';
my $CBB_TVM_ID = $is_testing ? '2002238' : '2000300';

my $tvm_app_name = 'direct-scripts' . ($is_sandbox ? '-sandbox' : '') . ($is_testing ? '-test' : '');
$Yandex::TVM2::APP_ID = {
    'direct-scripts' => '2000389',
    'direct-scripts-sandbox' => '2000922',
    'direct-scripts-test' => '2000767',
    'direct-scripts-sandbox-test' => '2000928',
    # У direct-web* не должно быть доступа в cbb, здесь они для отладки сценария "cbb не пускает кого не нужно"
    'direct-web-test' => '2000771',
    'direct-web' => '2000769',
}->{$tvm_app_name};
$Yandex::TVM2::SECRET_PATH = "/etc/direct-tokens/tvm2_${tvm_app_name}";

# проверяем полноту конфигурации
if (!defined $OUTPUT_DIR) {
    die "Output directory is not defined";
} elsif (!-d $OUTPUT_DIR) {
    die "Output directory is not directory: '$OUTPUT_DIR'!";
} elsif (my @bad_names = grep {!/^[a-z0-9_]+$/} keys %VARIABLES) {
    die "Incorrect variable name: ".join(', ', @bad_names);
}

# открываем временный файл
open(my $out_lock, "+>>", "$OUTPUT_DIR/lock");
flock($out_lock, LOCK_EX | LOCK_NB);

if ($SLEEP > 0) {
    sleep $SLEEP;
}

my $updated_files = 0;
for my $var_name (sort keys %VARIABLES) {
    my $out_file = path("$OUTPUT_DIR/geo_$var_name.conf");
    eval {
        my $src = Ranges::Source->new($VARIABLES{$var_name});
        my $src_mtime = $src->mtime();
        
        # проверяем, нужно ли файл пересоздавать
        if ($out_file->exists && $out_file->stat->mtime == $src_mtime) {
            return;
        }
        
        # конвертируем диапазоны
        $src->init();
        my $out_fh = path("$out_file.tmp")->openw;
        print($out_fh "geo  \$geo_$var_name  {\n") || die "Can't print: $!";
        # ranges в nginx глючит, поэтому преобразуем всё в сети (parse_next_record возвращает уже их)
        while(my ($prefixes, $val) = $src->parse_next_record()) {
            for my $prefix (@$prefixes){
                print($out_fh "\t$prefix\t$val;\n") || die "Can't print: $!";
            }
        }
        print($out_fh "}\n") || die "Can't print: $!";
        close($out_fh);
        $src->deinit();
        utime($src_mtime, $src_mtime, "$out_file.tmp");

        # проверяем конфиг
        check_geo_conf("$out_file.tmp");
        rename("$out_file.tmp", $out_file);
        $updated_files++;
    };
    if ($@ && !($out_file->exists && time - $out_file->stat->mtime >= 3600)) {
        warn $@;
    }
}

close($out_lock);
unlink("$OUTPUT_DIR/lock");

# перепускаем nginx, если что-то изменилось
if ($updated_files && @INIT) {
    for my $init (grep {-f} @INIT) {
        my $test_result = `$init configtest 2>&1`;
        if ($?) {
            print "$init configtest failed:\n$test_result";
        } else {
            system("$init reload >/dev/null") && die "Can't reload server: $!";
        }
    }
}

# проверяем один geo_config
sub check_geo_conf {
    my $conf_file = shift;
    my $file = Path::Tiny->tempfile(UNLINK => 1);
    my ($log_file) = Path::Tiny->tempfile(UNLINK => 1);
    my ($pid_file) = Path::Tiny->tempfile(UNLINK => 1);
    path($file)->spew("error_log $log_file; pid $pid_file; events { worker_connections 1024; } http { include ".path($conf_file)->absolute."; }");
    my $test_result = `$NGINX -t -c $file 2>&1`;
    if ($?) {
        die "Configtest for $conf_file failed:\n$test_result";
    }
}


#####################################################
# Subs

sub read_config {
    my ($CONFIG) = @_;
    local @ARGV =
        map {s/^([^=]+?)\s*=\s*/$1=/; s/^/--/; $_} # удаляем пробелы вокруг первого знака "=", добавляем --
        grep {!/^$/ && !/^#/} # пропускаем пустые строки и комментарии
        map {s/^\s+|\s+$//g; $_} # обрезаем начальные/конечные пробелы
        path($CONFIG)->lines;
    GetOptions(%OPTS) or die "Getopt error for config $CONFIG";
}

sub usage {
    system("podselect -section SYNOPSIS -section DESCRIPTION $0 | pod2text-utf8 >&2");
    exit(1);
}

package Ranges::Source;

=head2 Ranges::Source

    Базовый класс для источника регионов.
    Доступные функции:
        mtime
        init
        parse_next_record
        deinit

=cut

use strict;
use warnings;

sub new {
    shift;
    if ($_[0] && $_[0] =~ m!^cbb:(\d+)!) {
        return Ranges::Source::Cbb->new($1);
    } elsif ($_[0] && $_[0] =~ m!^networks:(.+)!) {
        return Ranges::Source::NetworksFile->new($1);
    } elsif ($_[0] && $_[0] =~ m!^/!) {
        return Ranges::Source::File->new($_[0]);
    } else {
        die "Incorrect source: '$_[0]'";
    }
}

1;

package Ranges::Source::File;

=head2 Ranges::Source::File

    работа со списком регионов, заданных в файле в стиле IPREG:
    123123123 234234234234 231

=cut

use strict;
use warnings;
use Fatal qw/open close/;
use Socket;
use base qw/Ranges::Source/;

sub _ntoa {
    my $ip = shift;
    die "Incorrect ip: '$ip'" if $ip < 0 || $ip > 2**32-1;
    return inet_ntoa(pack("N", $ip));
}

sub new {
    shift;
    bless {file => $_[0]};
}

sub mtime {
    my $self = shift;
    return [stat $self->{file}]->[9];
}

sub init {
    my $self = shift;
    open($self->{fh}, "<", $self->{file});
}

sub parse_next_record {
    my $self = shift;
    my $fd = $self->{fh};
    my $line = <$fd>;
    return () if !defined $line;
    my ($from, $to, $val) = $line =~ /^(\d+)\s+(\d+)\s+([a-z0-9]+)\s*$/ or die "Incorrect line '$line'";
    ($from, $to) = (_ntoa($from), _ntoa($to));
     my $ip = new Net::IP("$from - $to");
     return ([$ip->find_prefixes], $val);
}

sub deinit {
    my $self = shift;
    close($self->{fh});
}

1;

package Ranges::Source::NetworksFile;

=head2 Ranges::Source::NetworksFile

    работа со списком сетей, заданных в файле в стиле internal_networks:
    12.12.12.12 # super
    11.11.11.0/24

    # XXX

=cut

use strict;
use warnings;
use Fatal qw/open close/;
use Socket;
use base qw/Ranges::Source/;

sub new {
    shift;
    bless {file => $_[0]};
}

sub mtime {
    my $self = shift;
    return [stat $self->{file}]->[9];
}

sub init {
    my $self = shift;
    open($self->{fh}, "<", $self->{file});
}

sub parse_next_record {
    my $self = shift;
    my $fh = $self->{fh};

    while (my $line = <$fh>) {
        $line =~ s/#.*$//;
        $line =~ s/\s+//g;
        next if !$line;
        if ($line =~ /^ ( ( \d{1,3} (?:\.\d{1,3}){3} ) (?: \/ (\d+) )? ) $/x || $line =~ /^ ( ([0-9a-f:]+) (?: \/ (\d+) )? ) $/x) {
            # запись похожа на ipv4 или ipv6 -префикс 
            return ( [$1], 1 );
        } else {
            print STDERR "ERROR in parse $self->{file}: \"$line\"\n";
        }
    }
    return ();
}

sub deinit {
    my $self = shift;
    close($self->{fh});
}

sub _ntoa {
    my $ip = shift;
    die "Incorrect ip: '$ip'" if $ip < 0 || $ip > 2**32-1;
    return inet_ntoa(pack("N", $ip));
}

sub _aton {
    my $ip = shift;
    return unpack("N", inet_aton($ip));
}

1;

package Ranges::Source::Cbb;

=head2 Ranges::Source::Cbb

    работа со списком регионов, заданных в cbb

=cut

use strict;
use warnings;
use LWP::UserAgent;
use Net::INET6Glue::INET_is_INET6;
use Net::IP qw/ip_is_ipv4/;
use base qw/Ranges::Source/;

sub _http_get {
    my $url = shift;
    my %opt = @_;
    my $h = HTTP::Headers->new;
    if ($opt{tvm_ticket}) {
        $h->header('X-Ya-Service-Ticket' => $opt{tvm_ticket});
    }
    my $resp;
    for my $t (0,0,2) {
        sleep $t if $t;
        $resp = LWP::UserAgent->new(timeout => 3, default_headers => $h)->get($url);
        if ($resp->is_success()) {
            return $resp->content();
        }
    }
    die $resp->status_line;
}

sub new {
    shift;
    bless {flag => $_[0]};
}

sub mtime {
    my $self = shift;
    my $mtime = _http_get("$CBB_URL/cgi-bin/check_flag.pl?flag=".$self->{flag}, tvm_ticket => Yandex::TVM2::get_ticket($CBB_TVM_ID));
    $mtime =~ s/\s//g;
    if ($mtime =~ /^\d+$/) {
        return $mtime;
    } else {
        die "Can't get cbb:$self->{flag} mtime";
    }
}

sub init {
    my $self = shift;
    $self->{lines} = [map { "$_; $self->{flag}" } split /\n/, _http_get("$CBB_URL/cgi-bin/get_range.pl?with_format=range_src,range_dst&flag=".$self->{flag}, tvm_ticket => Yandex::TVM2::get_ticket($CBB_TVM_ID))];
    $self->{idx} = 0;
}

sub parse_next_record {
    my $self = shift;
    return () if $self->{idx} >= scalar(@{$self->{lines}});
    my $line = $self->{lines}->[$self->{idx}++];
    if ($line =~ /^([\.\d]+); \s+ ([\.\d]+); \s+ (\d+);?\s*$/x) {
        my ($from, $to, $val) = ($1, $2, $3);
        die "Incorrect line: '$line'" unless ip_is_ipv4($from) && ip_is_ipv4($to);
        my $ip = new Net::IP("$from - $to");
        return ([$ip->find_prefixes], $val);
    }
    die "Incorrect line: '$line'";
}

sub deinit {
    my $self = shift;
    delete $self->{lines}, $self->{idx};
}

1;
