#!/usr/bin/perl

# Copyright © 2006-2021 Jakub Wilk <jwilk@jwilk.net>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the “Software”), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

# cwd in @INC is harmful:
# https://www.nntp.perl.org/group/perl.perl5.porters/2010/08/msg162729.html
no lib '.';

use v5.14;

use strict;
use warnings (
    NONFATAL => qw(all),
    FATAL => qw(numeric)
);
use charnames ':full';
use re '/a';
no encoding;

BEGIN { $::loading_modules = 1; }  ## no critic (PackageVars)

END {
    if ($::loading_modules) {  ## no critic (PackageVars)
        exit(-1);
    }
}

# core modules:
use Carp ();
use Encode ();
use English qw(-no_match_vars);
use File::Basename qw(dirname);
use File::Path ();
use FindBin ();
use Getopt::Long qw(:config gnu_compat permute no_getopt_compat no_ignore_case);
use Module::Loaded ();
use POSIX ();
use Symbol ();
use Term::ReadLine ();
use Text::ParseWords ();
use Time::Piece ();
use Time::Seconds ();
use re qw(is_regexp regexp_pattern);

# JSON:
BEGIN {
    eval {
        require JSON;
    } or do {
        require JSON::PP;
        # poor man's reimplementation of the JSON module:
        *JSON::decode_json = \&JSON::PP::decode_json;
        *JSON::encode_json = \&JSON::PP::encode_json;
        *JSON::is_bool = \&JSON::PP::is_bool;
        *JSON::false = \&JSON::PP::false;
        *JSON::true = \&JSON::PP::true;
        *JSON::new = sub {
            my ($cls, @args) = @_;
            return JSON::PP->new(@args);
        };
        *JSON::new;  # silence "used only once" warning
    }
}

# Work-around for HTTP::Cookies not catching write errors:
# https://bugs.debian.org/750850
BEGIN {
    *CORE::GLOBAL::close = sub(;*) {
        if (not @_) {
            return CORE::close();
        }
        my ($fh) = @_;
        $fh = Symbol::qualify_to_ref($fh, caller);
        my ($module) = caller;
        if (($module eq 'HTTP::Cookies') and not defined(wantarray)) {
            return (
                CORE::close($fh)
                or die $ERRNO  ## no critic (Carping)
            );
        } else {
            return CORE::close($fh);
        }
    };
}

# 3rd-party modules:
use Encode::Locale ();
use HTML::Form ();
use HTML::TreeBuilder 5 ();
use HTTP::Cookies ();
use HTTP::Message 5.802 ();
use HTTP::Request::Common qw(GET POST);
use IO::Socket::SSL 1.81 ();
use LWP::UserAgent 6 ();
use LWP::Protocol::https ();
use Net::HTTPS ();  # must be loaded after IO::Socket::SSL
use Net::SSLeay 1.43 ();
use URI::Escape qw(uri_escape_utf8);

BEGIN { $::loading_modules = 0; }  ## no critic (PackageVars)

# ==========================
# logging and error handling
# ==========================

my $opt_verbose = 0;
my $opt_debug_dir = undef;
my $opt_debug_interactive = 0;
my $bugtracker = 'https://github.com/jwilk/mbank-cli/issues';
my $bugreport_url_tmpl = "$bugtracker/%d";
my $bugreport_request = "Please file a bug at <$bugtracker>.";

sub write_log
{
    my ($message) = @_;
    defined($opt_debug_dir) or return;
    my $path = "$opt_debug_dir/log";
    open(my $log, '>>', $path)
        or os_error("$path: $ERRNO");
    say {$log} $message;
    close($log)
        or os_error("$path: $ERRNO");
    return;
}

sub debug
{
    my ($message) = @_;
    $message = "* $message";
    write_log($message);
    if ($opt_verbose) {
        say {*STDERR} $message;
    }
    return;
}

sub user_error
{
    my ($message) = @_;
    if (defined($message)) {
        write_log($message);
        say {*STDERR} "mbank-cli: $message";
    }
    exit(1);
}

sub config_error
{
    my ($config, $message) = @_;
    my $config_path;
    if (ref $config) {
        $config_path = $config->{__path__};
    } else {
        $config_path = $config;
    }
    $message = "$config_path: $message";
    return user_error($message);
}

sub server_error
{
    my ($message) = @_;
    if (defined($message)) {
        write_log($message);
        say {*STDERR} "mbank-cli: $message";
    }
    exit(2);
}

sub http_error
{
    my ($request, $response) = @_;
    my $message = sprintf(
        'HTTP error %d while processing request <%s %s>',
        $response->code,
        $request->method,
        $request->uri
    );
    my $client_warning = $response->header('Client-Warning') // '';
    if (($response->code == 500) and ($client_warning eq 'Internal response')) {
        my $extra = $response->content;
        $extra =~ s/\n+$//;
        $extra =~ s/\n+/\n/g;
        if ($extra !~ /[(]/ and $IO::Socket::SSL::SSL_ERROR) {
            # If IO::Socket::IP is installed, LWP produces unhelpful error
            # messages for certificate verification failures:
            # https://bugs.debian.org/746686
            # As a work-around, append $IO::Socket::SSL::SSL_ERROR to the error
            # message.
            $extra .= "\n$IO::Socket::SSL::SSL_ERROR";
        }
        $extra =~ s/\n+$//;
        $extra =~ s/^/| /gm;
        $message .= "\n$extra\n";
    }
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    return server_error();
}

sub http_decoding_error
{
    my ($request) = @_;
    my $message = sprintf(
        'HTTP decoding error while processing request <%s %s>',
        $request->method,
        $request->uri,
    );
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    return server_error();
}

sub scraping_error
{
    my ($message) = @_;
    my $file = __FILE__;
    $message =~ s/ at \Q$file\E line \d+[.]\n+//;
    $message = "Scraping error: $message";
    write_log($message);
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    say {*STDERR} $bugreport_request;
    exit(3);
}

sub quote
{
    my ($x) = @_;
    if (is_regexp($x)) {
        my ($pattern, $flags) = regexp_pattern($x);
        $pattern =~ s{(\\.)|/}{ $1 // "\\/" }sge;
        return "/$pattern/$flags";
    } else {
        state $json_encoder = JSON->new->ascii->allow_nonref;
        return $json_encoder->encode($x);
    }
}

=begin comment

match(TEXT, qr/REGEXP/, context => CONTEXT) -> TEXT
match(TEXT, TEXT, context => CONTEXT) -> TEXT

=cut

sub match
{
    my ($text, $pattern, %options) = @_;
    kwargs(\%options, context => \my $context);
    if (ref($pattern) eq '') {
        $pattern = qr/\Q$pattern\E/;
    }
    is_regexp($pattern)
        or internal_error('match(): invalid argument', 1);
    defined($text) and ref($text) eq ''
        or do {
            my $qtext = quote($text);
            scraping_error("$context: $qtext is not a string");
        };
    $text =~ m/\A(?:$pattern)\z/
        or do {
            my $qtext = quote($text);
            my $qpattern = quote($pattern);
            my $message = "$qtext does not match $qpattern";
            if ($qpattern eq '/(*FAIL)/') {
                $message =~ s/\s+\S+$//;
            }
            scraping_error("$context: $message");
        };
    return $text;
}

sub no_match
{
    my ($text, %options) = @_;
    return match($text, qr/(*FAIL)/, %options);
}

=begin comment

check_type(LIST, [], context => CONTEXT) => LIST
check_type(HASH, {}, context => CONTEXT) => HASH

=cut

sub check_type
{
    my ($obj, $type, %options) = @_;
    kwargs(\%options,
        context => \my $context,
    );
    $type = ref($type);
    my %atypes = (
        HASH => 'an object',
        ARRAY => 'an array',
    );
    my $atype = $atypes{$type}
        // internal_error('check_type(): unknown type', 1);
    ref($obj) eq $type
        or scraping_error("$context: not $atype");
    return $obj;
}

=begin comment

unpack_list(ARRAY_OF_REFS, ARRAY, context => CONTEXT)

=cut

sub unpack_list
{
    my ($dst, $src, %options) = @_;
    kwargs(\%options, context => \my $context);
    ref($dst) eq 'ARRAY'
        or internal_error('unpack_list(): invalid argument', 1);
    my @dst = @{$dst};
    ref($src) eq 'ARRAY'
        or scraping_error("$context: not an array");
    my @src = @{$src};
    my $n = scalar(@dst);
    my $m = scalar(@src);
    my $s = $n == 1 ? '' : 's';
    $n == $m
        or scraping_error("$context: expected $n element$s, got $m");
    for my $i (0..$n-1) {
        my $var = pop @dst;
        my $val = pop @src;
        defined($var)
            or next;
        if (ref($var) eq '') {
            internal_error('unpack_list(): invalid argument', 1);
        }
        ${$var} = $val;
    }
    return;
}

sub os_error
{
    my ($message) = @_;
    my $file = __FILE__;
    $message =~ s/ at \Q$file\E line \d+[.]\n+//;
    my $caller_name = (caller(1))[3] // '';
    if ($caller_name eq 'main::write_log') {
        # avoid infinite recursion
    } else {
        write_log($message);
    }
    local $Carp::CarpLevel = 1;
    Carp::cluck($message);
    exit(4);
}

sub internal_error
{
    my ($message, $level) = @_;
    $level //= 0;
    $message = "Internal error: $message";
    write_log($message);
    local $Carp::CarpLevel = $level + 1;
    Carp::cluck($message);
    say {*STDERR} $bugreport_request;
    exit(-1);
}

sub known_bug
{
    my ($bugno, $message) = @_;
    my $url = sprintf($bugreport_url_tmpl, $bugno);
    $message .= "; see <$url>";
    write_log($message);
    say {*STDERR} "mbank-cli: $message";
    exit(-1);
}

=begin comment

kwargs(HASHREF, NAME1 => \$VAR1, NAME2 => [\$VAR2, DEFAULT2], ...)

=cut

sub kwargs
{
    my ($kwargs, %args) = @_;
    ref($kwargs) eq 'HASH'
        or internal_error('kwargs(): invalid argument', 1);
    my $caller = (caller(1))[3];
    $caller =~ s/^main:://;
    while (my ($name, $var) = each %args) {
        ref($name) eq ''
            or internal_error('kwargs(): invalid argument', 1);
        my $value;
        my $has_default = 0;
        if (ref($var) eq 'ARRAY') {
            scalar @{$var} == 2
                or internal_error('kwargs(): invalid argument', 1);
            ($var, $value) = @{$var};
            $has_default = 1;
        }
        ref($var) eq 'SCALAR' and not defined(${$var})
            or internal_error('kwargs(): invalid argument', 1);
        if (exists $kwargs->{$name}) {
            $value = delete $kwargs->{$name};
        } else {
            $has_default or
                internal_error("$caller(): missing keyword argument: $name", 1);
        }
        ${$var} = $value;
    }
    if (%{$kwargs}) {
        local $LIST_SEPARATOR = ', ';
        my @names = sort(keys(%{$kwargs}));
        my $s = 's' x (scalar @names > 1);
        my $message = "$caller(): invalid keyword argument$s: @names";
        internal_error($message, 1);
    }
    return;
}

# ====================
# internationalization
# ====================

my %_encoding_fallback = (
    0x104 => 'A', 0x105 => 'a', # letter A with ogonek
    0x0C1 => 'A', 0x0E1 => 'a', # letter A with acute
    0x0C4 => 'A', 0x0E4 => 'a', # letter A with diaeresis
    0x106 => 'C', 0x107 => 'c', # letter C with acute
    0x10C => 'C', 0x10D => 'c', # letter C with caron
    0x10E => 'D', 0x10F => 'd', # letter D with caron
    0x118 => 'E', 0x119 => 'e', # letter E with ogonek
    0x0C9 => 'E', 0x0E9 => 'e', # letter E with acute
    0x11A => 'E', 0x11B => 'e', # letter E with caron
    0x0CD => 'I', 0x0ED => 'i', # letter I with acute
    0x141 => 'L', 0x142 => 'l', # letter L with stroke
    0x139 => 'L', 0x13A => 'l', # letter L with acute
    0x13D => 'L', 0x13E => 'l', # letter L with caron
    0x143 => 'N', 0x144 => 'n', # letter N with acute
    0x147 => 'N', 0x148 => 'n', # letter N with caron
    0x0D3 => 'O', 0x0F3 => 'o', # letter O with acute
    0x0D4 => 'O', 0x0F4 => 'o', # letter O with circumflex
    0x154 => 'R', 0x155 => 'r', # letter R with acute
    0x158 => 'R', 0x159 => 'r', # letter R with caron
    0x15A => 'S', 0x15B => 's', # letter S with acute
    0x160 => 'S', 0x161 => 's', # letter S with caron
    0x164 => 'T', 0x165 => 't', # letter T with caron
    0x0DA => 'U', 0x0FA => 'u', # letter U with acute
    0x16E => 'U', 0x16F => 'u', # letter U with ring above
    0x0DD => 'Y', 0x0FD => 'y', # letter Y with acute
    0x179 => 'Z', 0x17A => 'z', # letter Z with acute
    0x17B => 'Z', 0x17C => 'z', # letter Z with dot above
    0x17D => 'Z', 0x17E => 'z', # letter Z with caron
);

sub _encoding_fallback
{
    my ($u) = @_;
    return
        $_encoding_fallback{$u}
        // sprintf('<U+%04X>', $u);
}

sub bytes_to_unicode
{
    my ($u, $encoding) = @_;
    $encoding //= 'locale';
    return Encode::decode($encoding, $u);
}

sub unicode_to_bytes
{
    my ($s, $encoding) = @_;
    $encoding //= 'locale';
    return Encode::encode($encoding, $s, \&_encoding_fallback);
}

my %country_to_language = (
    cz => 'cs',  # Czech Republic => Czech
    pl => 'pl',  # Poland => Polish
    sk => 'sk',  # Slovakia => Slovak
);

my %language_to_country = reverse(%country_to_language);

my %locale_aliases = (
    'polish' => 'pl',
    'czech' => 'cs',
    'slovak' => 'sk',
);

my @known_countries = sort(keys(%country_to_language));

sub guess_country
{
    my %cc = ();
    my $locales = POSIX::setlocale(POSIX::LC_ALL);
    my @locales;
    if ($locales =~ m/=/) {
        @locales = $locales =~ m/(?:^|;)LC_[A-Z_]+=([^;\s]+)/g;  ## no critic (EnumeratedClasses)
    } else {
        @locales = ($locales);
    }
    for my $locale (@locales) {
        $locale = $locale_aliases{$locale} // ${locale};
        my $lang = $locale =~ s/_.*//r;
        my $cc = $language_to_country{$lang};
        if (defined($cc)) {
            $cc{$cc} = 1;
        }
    }
    my @cc = keys(%cc);
    if (scalar(@cc) == 1) {
        my ($cc) = @cc;
        return $cc;
    }
    return;
}

# ====================
# HTTP client identity
# ====================

# Extracted from Tor Browser 8.5.5 (based on Firefox 60 ESR):

# » navigator.userAgent
my $browser_user_agent = 'Mozilla/5.0 (X11; Linux x86_64; rv:60.0) Gecko/20100101 Firefox/60.0';

# » Ebre.Behaviour.GetCurrentDfp().then(console.log) && null
my $browser_dfp = 'eJzjEuXi8cnMK61QqLAwizczEWIO9fOWYBBS4/jFLnCVReIXu8JVFo1f7AZXWayEDHIS81KKkxMLUnULijJzE4sqpVi4mFLzlEQ4GKAaFRi0QAwDBgsGLVsG4kEDhogVg8ORci82DgYBBgmGIGY/fUcwESXExe6bX5WZk5MoBGMkMRR5rmDi2MDEsYOJ4wATxwkmiQtMDDeYGgQeMAm8AFIfmB4w/mDiaGBuEOhg5pjALDCDmWMBcwPTCmbGDcyMO5gZDzDbn2BuULgAxADACDj4';

# =========
# HTTP, TLS
# =========

my $ua = undef;

my $http_read_size_hint = 1 << 20;  # 1 MiB
my $http_timeout = 30;

sub http_init
{
    my %options = @_;
    kwargs(\%options,
        cookie_jar => \my $cookie_jar_path,
        ca => \my $ca_path,
    );
    if ($Net::HTTPS::SSL_SOCKET_CLASS ne 'IO::Socket::SSL') {
        # This should not happen, but better safe than sorry.
        # We absolutely do not want Net::SSL (from the Crypt-SSLeay
        # distribution) as the TLS backend.
        internal_error("\$Net::HTTPS::SSL_SOCKET_CLASS == $Net::HTTPS::SSL_SOCKET_CLASS")
    };
    for my $key (grep { m/^HTTPS_/ } keys(%ENV)) {
        # HTTPS_CA_DIR and HTTPS_CA_FILE environment variables may disable or
        # cripple certificate validation:
        # https://bugs.debian.org/746579
        # https://bugs.debian.org/788698
        delete $ENV{$key};
    }
    my @ssl_options = (
        SSL_version => 'SSLv23:!SSLv2:!SSLv3',
        SSL_cipher_list => 'HIGH:!aNULL:!eNULL',
        SSL_ca_file => $ca_path,
        SSL_ca_path => undef,
            # If SSL_ca_path is not set explicitly to undef,
            # IO::Socket::SSL::set_args_filter_hack('use_defaults') fails to
            # correctly restore SSL_ca_* settings:
            # https://bugs.debian.org/750642
        SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER,
        SSL_verifycn_scheme => {
            check_cn => 0,
            wildcards_in_alt => 0,
            wildcards_in_cn => 0,
            ip_in_cn => 0,
        },
    );
    my @cookie_jar_options = (
        ignore_discard => 1,
        hide_cookie2 => 1,
        parse_head => 0,
    );
    if ($cookie_jar_path ne '/dev/null') {
        # TODO: implement auto-logout if cookie jar is /dev/null
        push(@cookie_jar_options,
            file => $cookie_jar_path,
            autosave => 0,
        );
    };
    my $cookie_jar = HTTP::Cookies->new(@cookie_jar_options);
    my $ua = LWP::UserAgent->new(  ## no critic (ReusedNames)
        agent => $browser_user_agent,
        cookie_jar => $cookie_jar,
        protocols_allowed => ['https'],
        timeout => $http_timeout,
        keep_alive => 1,
    );
    if ($IO::Socket::SSL::VERSION >= 1.969) {
        # LWP::protocol::https (>= 6.0) stomps on SSL_verifycn_scheme, and
        # possibly also other settings: https://bugs.debian.org/747225
        IO::Socket::SSL::set_defaults(@ssl_options);
        IO::Socket::SSL::set_args_filter_hack('use_defaults');
        # TODO: Work around the bug also for earlier versions of
        # IO::Socket::SSL, which don't support set_args_filter_hack().
    }
    $ua->ssl_opts(
        @ssl_options,
    );
    $ua->default_header(
        'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
        'Accept-Encoding' => 'gzip, deflate',
        'Accept-Language' => 'en-US,en;q=0.5',
    );
    return $ua;
}

sub download
{
    my ($request, %options) = @_;
    kwargs(\%options,
        ignore_errors => [\my $ignore_errors, 0],
        redact => [\my $redact, undef],
    );
    my $message = sprintf(
        '%s %s',
        $request->method,
        $request->uri
    );
    if ($opt_debug_interactive) {
        print {*STDERR} $request->dump(maxlength => 0);
        my $term = term_new();
        my $ok = $term->readline('Proceed? ', 'y') // '';
        if ($ok ne 'y') {
            user_error('aborted by user');
        }
    }
    debug($message);
    my $response = $ua->request($request, undef, $http_read_size_hint);
    $response->decode()
        // http_decoding_error($request);
    my $content = $response->content;
    $content =~ s/\r//g;
    if (defined($opt_debug_dir)) {
        my $is_json = $response->headers->content_type() eq 'application/json';
        my $default_ext = $is_json ? 'json' : 'html';
        my $path = $request->uri;
        $path =~ s{^\w+://.*?/}{};
        $path =~ s/[?].*//;
        $path =~ s/[^[:alnum:].]/_/g;
        $path =~ s/(?:[.]\w+)?$/.$default_ext/;
        if ($path eq '.html') {
            $path = 'index.html';
        }
        $path = "$opt_debug_dir/$path";
        open(my $fh, '>', "$path")
            or os_error("$path: $ERRNO");
        print {$fh} $content;
        close($fh)
            or os_error("$path: $ERRNO");
        my $rpath = "${path}.request";
        open($fh, '>', $rpath)
            or os_error("$rpath: $ERRNO");
        my $request_dump = $request->dump(maxlength => 0);
        if (defined($redact)) {
            $request_dump =~ s/$redact/<redacted>/;
        }
        print {$fh} $request_dump;
        close($fh)
            or os_error("$rpath: $ERRNO");
        $rpath = "${path}.headers";
        open($fh, '>', $rpath)
            or os_error("$rpath: $ERRNO");
        my $response_dump = $response->dump(maxlength => 1);
        $response_dump =~ s/\n\n.*\z//s;
        print {$fh} $response_dump;
        close($fh)
            or os_error("$rpath: $ERRNO");
    }
    if (not $response->is_success and not $ignore_errors) {
        http_error($request, $response);
    }
    $content = $response->decoded_content()
        // http_decoding_error($request);
    my $url = $response->request->uri;
    return {
        response => $response,
        content => $content,
        url => $url,
    };
}

sub simple_download
{
    my ($request) = @_;
    my $message = sprintf(
        'simple %s %s',
        $request->method,
        $request->uri
    );
    debug($message);
    my $response = $ua->simple_request($request, undef, $http_read_size_hint);
    if ($response->is_error) {
        http_error($request, $response);
    }
    $response->decode()
        // http_decoding_error($request);
    return $response;
}

sub _get_openssl_version
{
    my $version_info = Net::SSLeay::SSLeay_version();
    my ($version) = $version_info =~ m/\AOpenSSL (\S+)/
        or return;
    return $version;
}

my $openssl_version = _get_openssl_version();

sub _get_openssl_dir
{
    defined($openssl_version)
        or return;
    my $SSLEAY_DIR;
    if ($openssl_version =~ m/\A(?:0[.]|1[.]0[.])/) {
        # OpenSSL << 1.1
        $SSLEAY_DIR = 5;
    } else {
        # OpenSSL >= 1.1
        $SSLEAY_DIR = 4;
    }
    my $openssl_info = Net::SSLeay::SSLeay_version($SSLEAY_DIR);
    my ($openssl_dir) = $openssl_info =~ m/\AOPENSSLDIR: "(.*)"\Z/;
    return $openssl_dir;
}

my $openssl_dir = _get_openssl_dir();

sub get_default_ca_path
{
    return '/etc/certs/ca-certificates.crt';
}

# ===========================
# configuration file handling
# ===========================

my $global_config = undef;

my @gpg_cmdline =
    Text::ParseWords::shellwords($ENV{MBANK_CLI_GPG} // 'gpg') or
    user_error('cannot parse $MBANK_CLI_GPG');  ## no critic (InterpolationOfMetachars)

$ENV{GPG_TTY} //= POSIX::ttyname(POSIX::STDIN_FILENO);

sub read_config
{
    my ($path) = @_;
    open(my $fh, '<', $path)
        or os_error("$path: $ERRNO");
    my $config = _read_config($fh, $path);
    close($fh)
        or os_error("$path: $ERRNO");
    return $config;
}

sub _read_config
{
    my ($fh, $path) = @_;
    my $pgp = undef;
    my $config = {
        __pgp__ => [],
        __path__ => $path,
    };
    while (<$fh>) {
        chomp;
        if (defined($pgp)) {
            $pgp .= "$_\n";
            if ($_ eq '-----END PGP MESSAGE-----') {
                push(@{$config->{__pgp__}}, $pgp);
                $pgp = undef;
            }
        } elsif ($_ eq '-----BEGIN PGP MESSAGE-----') {
            $pgp = "$_\n";
        } elsif (m/^(?:#|\s*$)/) {
            next;
        } elsif (m/^\s*([\w-]+)\s+(.*\S)\s*$/) {
            my ($key, $value) = ($1, $2);
            $key = lc($key);
            ($value) = Text::ParseWords::parse_line('^$', 0, $value);
            $config->{$key} = $value;
        } else {
            config_error($path, "syntax error: $_");
        }
    }
    return $config;
}

sub _decrypt_config
{
    my ($config) = @_;
    my $pgp_chunks = $config->{__pgp__};
    $config->{__pgp__} = [];
    scalar(@{$pgp_chunks}) > 0 or return;
    eval {
        require IPC::Run;
    } // user_error('IPC::Run is required to decrypt the configuration file');
    for my $encrypted_data (@{$pgp_chunks}) {
        my $decrypted_data;
        eval {
            IPC::Run::run(
                [@gpg_cmdline, '-d'],
                '<', \$encrypted_data,
                '>', \$decrypted_data,
            ) or os_error("@gpg_cmdline -d failed");
        } // do {
            os_error($EVAL_ERROR);
        };
        my @decrypted_data = split(/\n/, $decrypted_data);
        for (@decrypted_data) {
            if (m/^(?:#|\s*)$/) {
                next;
            } elsif (m/^\s*([\w-]+)\s+(.*\S)\s*$/) {
                my ($key, $value) = ($1, $2);
                $key = lc($key);
                ($value) = Text::ParseWords::parse_line('^$', 0, $value);
                $config->{$key} = $value;
            } else {
                config_error($config, "syntax error in encrypted part: $_");
            }
        }
    }
    return $config;
}

sub get_config_var
{
    my ($config, $var, $default) = @_;
    if (exists($config->{$var}) or defined($default)) {
        if (ref($default)) {
            $default = ${$default};
        }
        return $config->{$var} // $default;
    }
    _decrypt_config($config);
    return $config->{$var};
}

# ===========================
# misc parsing and formatting
# ===========================

my $account_number_re = qr{
  \d{2}(?:[ ]\d{4}){6}  # Polish IBAN (without the country code)
| CZ\d{2}(?:[ ]\d{4}){5}  # Czech IBAN: https://www.cnb.cz/en/payments/iban/iban-international-bank-account-number-basic-information/
| SK\d{2}(?:[ ]\d{4}){5}  # Slovak IBAN: https://www.nbs.sk/en/payment-systems/iban/iban-slovak-republic
| (?:\d{1,6}-)?\d{2,10}/\d{4}  # Slovak national format: https://www.nbs.sk/en/payment-systems/iban/iban-slovak-republic
}x;

sub format_amount
{
    my ($s, %options) = @_;
    kwargs(\%options,
        fp => [\my $fp, 0],
        plus => [\my $use_plus, 0],
        currency => [\my $currency, undef],
    );
    if ($fp) {
        if (not defined($currency)) {
            internal_error('floating-point number, but no currency');
        }
        $s = format_number('%.2f', $s);
    }
    my $sign_re;
    $s =~ s/(\s|\xA0)+(?=\d)//g;
    if ($use_plus) {
        $sign_re = qr/[+-]?/;
    } else {
        $sign_re = qr/-?/;
    }
    my $amount_re = qr/($sign_re\d+[.,]\d{2})/;
    my $currency_re;
    if (defined $currency) {
        $currency =~ m/\A[A-Z]{3}\z/  ## no critic (EnumeratedClasses)
            or return;
        $currency_re = qr//;
    } else {
        $currency_re = qr/\s+([A-Z]{3})/;  ## no critic (EnumeratedClasses)
    }
    my ($amount, $parsed_currency) = ($s =~ m/\A$amount_re$currency_re\z/)
        or return;
    $amount =~ y/,/./;
    $currency //= $parsed_currency;
    return sprintf('%10s %s', $amount, $currency);
}

sub format_money
{
    my ($number, $currency, %options) = @_;
    kwargs(\%options,
        context => \my $context
    );
    match($number, qr/-?\d+(?:[.,]\d+)?/, context => "$context.number");
    $number =~ tr/,/./;
    match($currency, qr/[A-Z]{3}/, context => "$context.currency");  ## no critic (EnumeratedClasses)
    my $s = eval {
        sprintf('%10.2f %s', $number, $currency);
    } // do {
        my $qnumber = quote($number);
        my $qcurrency = quote($currency);
        scraping_error("$context: $qnumber, $qcurrency");
    };
    return $s;
}

sub format_number
{
    my ($format, $n) = @_;
    my $s;
    eval {
        $s = sprintf($format, $n);
    } // return;
    return $s;
}

sub wildcards_to_regexp
{
    my (@wildcards) = @_;
    my $re = join('|',
        map { quotemeta } @wildcards
    );
    $re =~ s/\\[*]/.*/g;
    $re = qr{^(?i:($re))$};
    return $re;
}

# =============
# date and time
# =============

=begin comment

timestamp_to_date(TIMESTAMP, [time_must_be => 0])

    >>> timestamp_to_date('2006-07-30T14:47:03')
    '2006-07-30'

    >>> timestamp_to_date('2006-02-30T14:47:03')
    undef

    >>> timestamp_to_date('2006-07-30T14:47:03', time_must_be => 0)
    undef

    >>> timestamp_to_date('2006-07-30T00:00:00', time_must_be => 0)
    '2006-07-30'

=cut

sub timestamp_to_date
{
    my ($timestamp, %options) = @_;
    kwargs(\%options,
        time_must_be => [\my $time_must_be, undef],
    );
    my $time_re = qr/\A/;
    if (defined($time_must_be)) {
        if ($time_must_be == 0) {
            $time_re = qr/\A[0:.]+\z/;
        } else {
            internal_error('invalid time_must_be');
        }
    }
    my ($date, $time) = ($timestamp =~ m/\A(\d\d\d\d-\d\d-\d\d)T(\d\d:\d\d:\d\d(?:[.]\d+)?)\z/)
        or return;
    $time =~ $time_re
        or return;
    my $pdate;
    eval {
        $pdate = Time::Piece->strptime($date, '%Y-%m-%d')->ymd;
    } or return;
    $date eq $pdate
        or return;
    return $date;
}

=begin comment

parse_dmy_date(MONTH_DAY_YEAR_DATE, context => CONTEXT)

    >>> parse_dmy_date('30-07-2006', context => 'foo')
    '2006-07-30'

    >>> parse_dmy_date('30.07.2006', context => 'foo')
    '2006-07-30'

    >>> parse_dmy_date('30.02.2006', context => 'foo')
    Scraping error: foo: "30.02.2006" is not a valid day-month-year date

=cut

sub parse_dmy_date
{
    my ($orig_date, %options) = @_;
    kwargs(\%options, context => \my $context);
    my $date;
    if (ref($orig_date) eq '') {
        $date = _parse_dmy_date($orig_date);
    }
    if (not defined($date)) {
        my $qdate = quote($orig_date);
        scraping_error("$context: $qdate is not a valid day-month-year date");
    }
    return $date;
}

sub _parse_dmy_date
{
    my ($date) = @_;
    my ($d, undef, $m, $y) = ($date =~ m/\A(\d\d)([.-])(\d\d)\2(\d\d\d\d)\z/)
        or return;
    $date = "$y-$m-$d";
    my $pdate;
    eval {
        $pdate = Time::Piece->strptime($date, '%Y-%m-%d')->ymd;
    } or return;
    $date eq $pdate
        or return;
    return $date;
}

sub shift_date
{
    my ($date, $offset) = @_;
    my $new_date = _shift_date($date, $offset);
    if (not defined($new_date)) {
        internal_error("shift_date(): could not shift $date by $offset days");
    }
    return $new_date;
}

sub _shift_date
{
    my ($date, $offset) = @_;
    my $tp;
    eval {
        $tp = Time::Piece->strptime($date, '%Y-%m-%d');
    } or return;
    $tp += $offset * Time::Seconds::ONE_DAY;
    $date = $tp->ymd;
    $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
        or return;
    return $date;
}

# ============
# HTML parsing
# ============

# TreeBuilder needs some nudging to understand newfangled HTML 5 tags
# https://github.com/kentfredric/HTML-Tree/pull/3
$HTML::TreeBuilder::isBodyElement{header} = 1;  ## no critic (PackageVars)

sub html_new
{
    my ($s) = @_;
    return HTML::TreeBuilder->new_from_content($s);
}

sub html_class_regexp
{
    my ($class) = @_;
    return qr/(?:\A|\s)\Q$class\E(?:\s|\z)/;
}

sub has_html_class
{
    my ($element, $class) = @_;
    my $element_class = $element->attr('class') // '';
    return $element_class =~ html_class_regexp($class);
}

=begin comment

html_find([ATTR => VALUE, ...] [class => CLASSES,] [n => N, context => CONTEXT,]) -> (ELEM_1, ..., ELEM_N)

In scalar context, n = 1 by default.

=cut

sub html_find
{
    my ($root_elt, %options) = @_;
    my @anames = qw(id name type);
    my %attrs = ();
    for my $aname (@anames) {
        my $avalue = delete $options{$aname};
        if (defined($avalue)) {
            $attrs{$aname} = $avalue;
        }
    }
    kwargs(\%options,
        tag => [\my $tag, undef],
        class => [\my $classes, []],
        n => [\my $n, undef],
        context => [\my $context, undef],
    );
    my @classes;
    if (ref($classes) eq 'ARRAY') {
        @classes = @{$classes};
    } elsif (ref($classes) eq '') {
        @classes = split(' ', $classes);
    } else {
        internal_error('html_find(): invalid argument', 1);
    }
    my @result = $root_elt->look_down(sub {
        my ($elt) = @_;
        for my $class (@classes) {
            has_html_class($elt, $class)
                or return 0;
        }
        if (defined($tag)) {
            ($elt->tag() eq $tag)
                or return 0;
        }
        for my $aname (keys %attrs) {
            ($elt->attr($aname) // '') eq $attrs{$aname}
                or return 0;
        }
        return 1;
    });
    if (not wantarray) {
        $n //= 1;
    }
    if (defined($n)) {
        defined($context)
            or internal_error('html_find(): missing keyword argument: context', 1);
        unpack_list([(undef) x $n], [@result], context => $context);
    }
    if (wantarray) {
        return @result;
    } else {
        my ($result) = @result;
        return $result;
    }
}

# ====
# JSON
# ====

sub encode_json
{
    goto &JSON::encode_json
}

=begin comment

decode_json(JSON_OBJECT, context => CONTEXT) -> hash ref
decode_json(JSON_ARRAY, type => [], context => CONTEXT) -> array ref

=cut

sub decode_json
{
    my ($json, %options) = @_;
    kwargs(\%options,
        context => \my $context,
        type => [\my $type, {}],
    );
    my $obj = eval {
        JSON::decode_json($json);
    } // do {
        scraping_error("$context: $EVAL_ERROR");
    };
    return check_type($obj, $type, context => $context);
}

sub json_content
{
    my ($obj) = @_;
    wantarray
        or internal_error('json_content() called in non-array context', 1);
    return (
        'Content' => encode_json($obj),
        'Content-Type' => 'application/json; charset=UTF-8',
    );
}

# =====
# UUIDs
# =====

sub parse_uuid
{
    my ($s) = @_;
    $s =~ m/\A[\dA-Fa-f]{8}(?:-[\dA-Fa-f]{4}){3}-[\dA-Fa-f]{12}\z/
        or return;
    return $s;
}

sub gen_uuid
{
    my $path = '/proc/sys/kernel/random/uuid';
    if (open(my $fh, '<', $path)) {
        my $uuid = <$fh>
            // os_error("$path: $ERRNO");
        close($fh)
            or os_error("$path: $ERRNO");
        chomp $uuid;
        parse_uuid($uuid)
            or os_error("$path: invalid UUID");
        return $uuid;
    }
    eval {
        require UUID::Tiny;
    } // user_error('UUID::Tiny is required for generating UUID');
    return UUID::Tiny::create_uuid_as_string(UUID::Tiny::UUID_RANDOM())
}

# ================
# terminal support
# ================

sub term_new
{
    my %options = @_;
    kwargs(\%options,
        readpasswd => [\my $readpasswd, 0],
    );
    state $term = Term::ReadLine->new('mbank-cli');
    if ($readpasswd) {
        if ($OSNAME eq 'MSWin32') {
            # We normally require Term::ReadLine::Gnu, so that it's possible to
            # ask for password without displaying it on the screen. But this
            # module is difficult to port to Windows. Oh well.
        } elsif (not defined($term->Attribs->{shadow_redisplay})) {
            debug("Term::ReadLine = $Term::ReadLine::ISA[0]");
            user_error('Term::ReadLine::Gnu is required for password prompt');
        }
    }
    return $term;
}

sub term_readpasswd
{
    my ($term, $prompt) = @_;
    local $term->Attribs->{redisplay_function} =  ## no critic (LocalVars)
        $term->Attribs->{shadow_redisplay};
    return $term->readline($prompt);
}

# =======================
# command implementations
# =======================

my $mbank_host = undef;
my $root_url = undef;
my $base_url = undef;
my $csite_url = undef;

my @header_xhr = (
    'X-Requested-With' => 'XMLHttpRequest',
);

my @header_accept_json = (
    'Accept' => 'application/json, text/javascript, */*; q=0.01',
);

sub _extract_login_menu
{
    my ($html) = @_;
    my %menu = ();
    my $load_menu;
    $load_menu = sub {
        my ($item) = @_;
        my $key = match($item->{'UniqueIdentifier'}, qr/\S+/, context => 'login.menu.key');
        my $url = $item->{'FullUrl'};
        defined($url) or next;
        match($url, qr{/\S+}, context => 'login.menu.url');
        my $children = $item->{'Children'};
        ref $children eq 'ARRAY'
            or scraping_error('login.menu.children: not an array');
        for my $subitem (@{$children}) {
            $load_menu->($subitem);
        }
        $menu{$key} = $url;
    };
    for my $e_script (html_find($html, tag => 'script')) {
        my @content = $e_script->content_list;
        scalar(@content) == 1
            or next;
        my ($content) = @content;
        if (ref $content) {
            next;
        }
        my ($json) = ($content =~ m/^\s*Ebre[.]Venezia[.]MenuItems\s*=\s*(\[.+\]);\s+$/m)
            or next;
        $json = Encode::encode('UTF-8', $json);
        $json = decode_json($json, type => [], context => 'login.menu.json');
        for my $item (@{$json}) {
            $load_menu->($item);
        }
        last;
    }
    (keys %menu > 0)
        or scraping_error('login.menu.missing');
    return %menu;
}

sub _extract_login_profiles
{
    my ($html) = @_;
    my %profiles = (
        personal => [],
        business => [],
    );
    for my $e_script (html_find($html, tag => 'script')) {
        my @content = $e_script->content_list;
        scalar(@content) == 1
            or next;
        my ($content) = @content;
        if (ref $content) {
            next;
        }
        my ($js) = ($content =~ m/^\s*Ebre[.]Venezia[.]ProfileData\s*=\s*([{].+[}]);\s*$/m)
            or next;
        $js = unicode_to_bytes($js, 'UTF-8');
        my $json = decode_json($js, context => 'login.profiles.json');
        while (my ($key, $value) = each %{$json}) {
            if ($key eq 'iProfiles') {
                $key = 'personal';
            } elsif ($key eq 'fProfiles') {
                $key = 'business';
            } else {
                no_match($key, context => 'login.profiles.key');
            }
            my @js_profiles = @{$value->{profiles}};
            for my $js_profile (@js_profiles) {
                my $code = $js_profile->{profileCode}
                    // scraping_error('login.profiles.profile-code');
                push(@{$profiles{$key}}, $code);
            }
            if ($key eq 'business') {
                my $n = 0;
                for my $js_profile (@js_profiles) {
                    my $name = $js_profile->{firmName}
                        // scraping_error('login.profiles.company-name');
                    my $code = $js_profile->{profileCode};
                    push(@{$profiles{$name}}, $code);
                    $n += 1;
                }
                if ($n > 1) {
                    delete $profiles{$key};
                }
            }
        }
        last;
    }
    return %profiles;
}

sub _get_tabid
{
    my $tabid;
    $ua->cookie_jar->scan(
        sub {
            my ($version, $key, $value, $path, $domain) = @_;
            if (($domain eq $mbank_host) and ($key eq 'mBank_tabId')) {
                $tabid = $value;
            }
        }
    );
    defined($tabid)
        or scraping_error('login.tabid');
    parse_uuid($tabid)
        or scraping_error("login.tabid: $tabid");
    return $tabid;
}

sub _ask_for_sms_password
{
    my ($date, $n, $try) = @_;
    my ($y, $m, $d) = split /-/, $date;
    my $cfg = $global_config;
    my $inbox = get_config_var($cfg, 'smsinbox');
    if (defined $inbox) {
        $inbox = expand_tilde($inbox);
        $inbox =~ s{[^/]\K/+\z}{};  # strip trailing slash
        $inbox .= '/';
        stat $inbox or os_error("$inbox: $ERRNO");
        eval {
            require Filesys::Notify::Simple;
        } // user_error('Filesys::Notify::Simple is required to read SMS messages');
        if ($try == 0) {
            return;
        } elsif ($try > 1) {
            internal_error('SMS retrieval failed?');
        }
        my $watcher = Filesys::Notify::Simple->new([$inbox]);
        debug('waiting for SMS password');
        while (1) {
            my $passwd;
            $watcher->wait(sub {
                for my $event (@_) {
                    local $INPUT_RECORD_SEPARATOR = undef;
                    my $path = $event->{path};
                    open(my $fh, '<', $path) or do {
                        if ($ERRNO{ENOENT}) {
                            next;
                        } else {
                            os_error("$path: $ERRNO");
                        }
                    };
                    my $text = <$fh>;
                    close($fh) or os_error("$path: $ERRNO");
                    # FIXME: this only works for Polish
                    ($passwd) = $text =~ m{! Operacja nr $n z dn[.] $d-$m-$y\b.*\bhaslo: (\d{8}) mBank\b};
                    if (defined($passwd)) {
                        last;
                    }
                }
            });
            if (defined($passwd)) {
                return $passwd
            }
        }
    } elsif (-t STDIN) {
        if ($try == 0) {
            return;
        }
        my $term = term_new();
        while (1) {
            my $passwd = $term->readline("SMS password ($y-$m-$d, #$n): ") // '';
            if ($passwd =~ m/\A\d{8}\z/) {
                return $passwd;
            }
        };
    } else {
        user_error('unable to ask for SMS password');
    }
    return;
}

sub _do_2fa  ## no critic (ExcessComplexity)
{
    my ($device_to_add) = @_;
    my $tabid = _get_tabid();
    my @headers_xhr = (
        @header_xhr,
        'X-Tab-Id' => $tabid,
    );
    my $request = GET(
        "$root_url/api/app/setup/data",
        @headers_xhr,
        'Accept' => '*/*',
        'Referer' => "$root_url/authorization",
    );
    my $doc = download($request);
    my $data = decode_json($doc->{content}, context => 'login.app-setup');
    my $csrf_token = $data->{antiForgeryToken} // '';
    $csrf_token =~ m{\A[\w/+=]{20,}\z}
        or scraping_error("login.app-setup.csrf-token: $csrf_token");
    push @headers_xhr, (
        'X-Request-Verification-Token' => $csrf_token,
    );
    my @header_origin = (
        'Origin' => $root_url,
    );
    my @headers_api_auth = (
        @headers_xhr,
        @header_origin,
        'Accept' => '*/*',
        'data-type' => 'json',
    );
    $request = POST(
        "$base_url/Sca/GetScaAuthorizationData",
        @headers_xhr,
        @header_origin,
        'Accept' => '*/*',
        'Referer' => "$root_url/authorization",
    );
    $doc = download($request);
    $data = decode_json($doc->{content}, context => 'login.sca');
    my $sca_auth_id = $data->{ScaAuthorizationId} // '';
    $sca_auth_id =~ m{\A[\w+/=]+\z}
        or scraping_error("login.sca.auth-id: $sca_auth_id");
    my $trusted_add_allowed = $data->{TrustedDeviceAddingAllowed};
    defined($trusted_add_allowed)
        or scraping_error('login.sca.trusted-add');
    my $auth_type;
    my $auth_data = {
        'ScaAuthorizationId' => $sca_auth_id,
    };
    my $cfg = $global_config;
    my $dfp = get_config_var($cfg, 'dfp') // $browser_dfp;
    if (defined($device_to_add)) {
        $trusted_add_allowed
            or user_error('adding trusted device not allowed');
        $request = GET(
            "$root_url/api/sca/TrustedDevices/IsPossibleToAddNextDevice",
            @headers_xhr,
            'Accept' => '*/*',
            'Referer' => "$root_url/authorization/unknownDevice",
        );
        $doc = download($request);
        $data = decode_json($doc->{content}, context => 'login.2fa.next-dev');
        my $is_valid = $data->{isValid} // '';
        JSON::is_bool($is_valid) and $is_valid
            or scraping_error("login.2fa.next-dev.invalid: $is_valid");
        while (1) {
            my $query = 'deviceName=' . uri_escape_utf8($device_to_add);
            $request = GET(
                "$root_url/api/sca/TrustedDevices?$query",
                @headers_xhr,
                'Accept' => '*/*',
                'Referer' => "$root_url/authorization/secureDevice/set",
            );
            $doc = download($request);
            $data = decode_json($doc->{content}, context => 'login.2fa.trusted-dev');
            $is_valid = $data->{isValid} // '';
            JSON::is_bool($is_valid)
                or scraping_error("login.2fa.trusted-dev.invalid: $is_valid");
            if ($is_valid) {
                last;
            } else {
                say {*STDERR} 'Device name has been rejected. Try another one.';
                my $term = term_new();
                my $name = '';
                until (length($name) > 1) {  ## no critic (Until)
                    $name = $term->readline('Device name: ', unicode_to_bytes($device_to_add)) // '';
                    $name = bytes_to_unicode($name);
                }
                $device_to_add = $name;
            }
        }
        $auth_type = 'trusteddevice';
        $auth_data = {
            %{$auth_data},
            'DfpData' => $dfp,
            'DeviceName' => $device_to_add,
            'IsTheOnlyDeviceUser' => JSON::true,
        };
        push @headers_api_auth, (
            'Referer' => "$root_url/authorization/secureDevice/confirm",
        );
    } else {
        debug('adding trusted device allowed: ' . ($trusted_add_allowed ? 'yes' : 'no'));
        $auth_type = 'disposable';
        push @headers_api_auth, (
            'Referer' => "$root_url/authorization/onetime/set",
        );
    }
    $request = POST(
        "$root_url/api/auth/initprepare",
        @headers_api_auth,
        json_content({
            'Url' => "sca/authorization/$auth_type",
            'Method' => 'POST',
            'Data' => $auth_data,
        })
    );
    $doc = download($request);
    $data = decode_json($doc->{content}, context => 'login.2fa.init');
    my $error_code = $data->{ErrorCode} // '?';
    $error_code eq ''
        or scraping_error("login.2fa.init.error: $error_code");
    my $auth_mode = $data->{AuthMode} // '';
    my $operation_date = $data->{OperationDate} // '';
    $operation_date = timestamp_to_date($operation_date)
        // scraping_error("login.2fa.init.operation-date: $operation_date");
    my $operation_no = $data->{OperationNumber} // '';
    $operation_no =~ m/\A\d+\z/
        or scraping_error("login.2fa.init.operation-no: $operation_no");
    if ($auth_mode eq 'NAM') {
        say {*STDERR} "Waiting for confirmation of operation no $operation_no from $operation_date in the mobile app...";
        my $tran_id = $data->{TranId} // '';
        parse_uuid($tran_id)
            or scraping_error("login.2fa.init.tran-id: $tran_id");
        while (1) {
            $request = POST(
                "$root_url/api/auth/status",
                @headers_api_auth,
                json_content({
                    'TranId' => $tran_id
                })
            );
            $doc = download($request);
            $data = decode_json($doc->{content}, context => 'login.2fa.status');
            $error_code = $data->{ErrorCode};
            defined($error_code)
                or scraping_error('login.2fa.status.error');
            $error_code eq ''
                or scraping_error("login.2fa.status.error: $error_code");
            my $status = $data->{Status} // '';
            debug("2FA mobile auth: $status");
            if ($status eq 'Prepared' or $status eq 'PreAuthorized') {
                sleep(1)
                    or os_error("sleep(): $ERRNO");
            } elsif ($status eq 'Authorized') {
                last;
            } elsif ($status eq 'Canceled') {
                user_error('login failed: rejected mobile authentication request');
            } elsif ($status eq 'TimeOut') {
                user_error('login failed: mobile authentication request timed out');
            } else {
                scraping_error("login.2fa.status.status: $status")
            }
        }
        $request = POST(
            "$root_url/api/auth/execute",
            @headers_api_auth,
            json_content({})
        );
        $doc = download($request, ignore_errors => 1);
        $data = decode_json($doc->{content}, context => 'login.2fa.exec');
        $error_code = $data->{error};
        if (defined($error_code)) {
            scraping_error("login.2fa.exec.error: $error_code")
        } else {
            $error_code = $data->{ErrorCode};
            defined($error_code)
                or scraping_error('login.2fa.exec.error');
            $error_code eq ''
                or scraping_error("login.2fa.exec.error: $error_code");
        }
    } elsif ($auth_mode eq 'SMS') {
        for (my $try = 1; ; $try++) {  ## no critic (CStyleForLoop)
            my $sms_password = _ask_for_sms_password($operation_date, $operation_no, $try);
            $request = POST(
                "$root_url/api/auth/execute",
                @headers_api_auth,
                json_content({
                    'Auth' => $sms_password
                })
            );
            $doc = download($request, ignore_errors => 1);
            $data = decode_json($doc->{content}, context => 'login.2fa.exec');
            $error_code = $data->{error};
            if (defined($error_code)) {
                if ($error_code eq 'QGE0193' or $error_code eq 'QGE0200') {
                    say {*STDERR} 'Incorrect SMS password';
                    next;
                } else {
                    scraping_error("login.2fa.exec.error: $error_code")
                }
            } else {
                $error_code = $data->{ErrorCode};
                defined($error_code)
                    or scraping_error('login.2fa.exec.error');
                $error_code eq ''
                    or scraping_error("login.2fa.exec.error: $error_code");
                last;
            }
        }
    } else {
        scraping_error("login.2fa.init.auth-mode: $auth_mode");
    }
    if (defined($device_to_add)) {
        $request = POST(
            "$base_url/Sca/FinalizeTrustedDeviceAuthorization",
            @headers_xhr,
            @header_origin,
            'Accept' => 'application/json, text/plain, */*',
            json_content({
                'ScaAuthorizationId' => $sca_auth_id,
                'currentDfp' => $dfp,
                'deviceName' => $device_to_add,
            })
        );
    } else {
        $request = POST(
            "$base_url/Sca/FinalizeAuthorization",
            @headers_xhr,
            @header_origin,
            'Accept' => 'application/json, text/plain, */*',
            json_content({
                'ScaAuthorizationId' => $sca_auth_id
            })
        );
    }
    $doc = download($request);
    return;
}

sub do_login
{
    my %options = @_;
    kwargs(\%options,
        probe => [\my $probe, 0],
        register_device => [\my $register_device, undef],
    );
    my $request = GET($base_url);
    my $doc = download($request);
    if ($doc->{url} =~ m{/Login$}) {
        if ($probe) {
            debug('not logged in');
            return;
        }
        debug('logging in...');
        my ($seed) = ($doc->{content} =~ m/\b(?:app|entrypoint)[.]initialize[(]'([\w=-]+)'[,)]/)
            or scraping_error('login.seed');
        my $login_url = $doc->{url};
        my $cfg = $global_config;
        my $login = get_config_var($cfg, 'login')
            // config_error($cfg, 'missing login');
        my $password;
        my $password_manager = get_config_var($cfg, 'passwordmanager');
        if (defined($password_manager)) {
            eval {
                require IPC::Run;
            } // user_error('IPC::Run is required to retrieve password');
            eval {
                IPC::Run::run(
                    ['sh', '-c', $password_manager],
                    '>', \$password
                ) or os_error('password manager failed');
            } // do {
                os_error($EVAL_ERROR);
            };
            $password =~ s/\n.*//s;
        } else {
            $password = get_config_var($cfg, 'password');
            if (not defined($password)) {
                if (-t STDIN) {
                    my $term = term_new(readpasswd => 1);
                    $password = term_readpasswd($term, 'Password: ');
                    $password //= '';
                } else {
                    config_error($cfg, 'missing password');
                }
            }
        }
        length($password) > 0
            or user_error('login failed: empty password');
        if (defined(get_config_var($cfg, 'smsinbox'))) {
            # Make sure the SMSInbox feature is configured properly before we
            # try to log in:
            _ask_for_sms_password('2006-07-30', 1, 0);
        }
        my $dfp = get_config_var($cfg, 'dfp') // $browser_dfp;
        my $dfp_data = {
            dfp => $dfp,
            scaOperationId => gen_uuid(),
            errorMessage => undef,
        };
        $request = POST(
            "$base_url/LoginMain/Account/JsonLogin",
            @header_xhr,
            @header_accept_json,
            'Referer' => $login_url,
            json_content({
                UserName => $login,
                Password => $password,
                Seed => $seed,
                Scenario => 'Default',
                UWAdditionalParams => {InOut => undef, ReturnAddress => undef, Source => undef},
                Lang => '',
                HrefHasHash => JSON::false,
                DfpData => $dfp_data,
            }),
        );
        $doc = download($request, redact => qr/"Password"\s*:\s*\K"(?:[^\\"]|\\.)*"/);
        my $login_json = decode_json($doc->{content}, context => 'login.json');
        if (not $login_json->{successful}) {
            my $message = $login_json->{errorMessageTitle} // '';
            $message =~ s/\s*$//;
            if ($message eq '') {
                $message = $login_json->{errorMessageBody} // 'unknown error';
                $message =~ s{(?:<br\s*/>|\s)+}{ }g;
            }
            $message = unicode_to_bytes($message);
            user_error("login failed: $message");
        }
        my $redirect_url = match($login_json->{redirectUrl}, qr/\S+/, context => 'login.redirect-url');
        if ($redirect_url eq '/dashboard') {
            # yay, no 2FA
            if (defined($register_device)) {
                user_error('device already registered');
            }
        } elsif ($redirect_url eq '/authorization') {
            _do_2fa($register_device);
        } else {
            no_match($redirect_url, context => 'login.redirect-url');
        }
        $request = GET($base_url);
        $doc = download($request);
    }
    my $tabid = _get_tabid();
    my $html = html_new($doc->{content});
    my ($e_tech_break) = html_find($html,
        tag => 'header',
        class => 'tech-break',
        context => 'login.tech-break'
    );
    if (defined($e_tech_break)) {
        server_error('service is temporarily unavailable');
    }
    my $e_meta = html_find($html,
        tag => 'meta',
        name => '__AjaxRequestVerificationToken',
        context => 'login.csrf-token',
    );
    my $csrf_token = match($e_meta->attr('content'), qr{[\w/+=]{20,}}, context => 'login.csrf-token');
    my %menu = _extract_login_menu($html);
    my %profiles = _extract_login_profiles($html);
    debug('logged in');
    return {
        headers => [
            'Referer' => $doc->{url},
            'X-Tab-Id' => $tabid,
            'X-Request-Verification-Token' => $csrf_token,
            @header_xhr,
        ],
        menu => \%menu,
        profiles => \%profiles,
        url => $doc->{url},
    };
}

sub do_register_device
{
    my %options = @_;
    kwargs(\%options,
        args => \my $args,
    );
    my @args = @{$args};
    scalar(@args) <= 1
        or user_error('regsiter-device: too many arguments');
    my ($name) = @args;
    $name //= 'CLI';
    $name = bytes_to_unicode($name);
    { # Sanity check: fully functional cookie jar is needed for this command
        my $uuid = gen_uuid();
        my $cookie_jar_path = $ua->cookie_jar->{file} // '/dev/null';
        $ua->cookie_jar->set_cookie(0, 'UUID', $uuid, '/cookie-jar', 'mbank-cli.test', undef, undef, undef, 60);
        eval {
            $ua->cookie_jar->save();
            1;
        } // os_error("$cookie_jar_path: $ERRNO");
        $ua->cookie_jar->set_cookie(0, 'UUID', $uuid, '/cookie-jar', 'mbank-cli.test', undef, undef, undef, -1);
        open (my $fh, '<', $cookie_jar_path)
            or os_error("$cookie_jar_path: $ERRNO");
        my $found = grep { /\b\Q$uuid\E\b/ } <$fh>;
        close($fh)
            or os_error("$cookie_jar_path: $ERRNO");
        if (not $found) {
            user_error("$cookie_jar_path: unwritable cookie file");
        }
    }
    do_logout(maybe => 1);
    do_login(register_device => $name);
    return;
}

sub do_list
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        quiet => [\my $quiet, 0],
    );
    my $request = POST(
        "$base_url/MyDesktop/Desktop/GetAccountsList",
        @{$login_info->{headers}},
        @header_accept_json,
        json_content({})
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'list.json');
    my @accounts = @{$json->{accountDetailsList}};
    my @result;
    for my $account (@accounts) {
        my $name = match($account->{ProductName}, qr/.+/, context => 'list.product-name');
        my $subtitle = $account->{SubTitle} // '';
        if ($subtitle ne '') {
            $name .= " - $subtitle";
        }
        my $number = match($account->{AccountNumber}, $account_number_re, context => 'list.account-number');
        push(@result, {
            name => $name,
            number => $number,
        });
        next if $quiet;
        my $currency = $account->{Currency};
        my $balance = format_money($account->{Balance}, $currency, context => 'list.balance');
        my $available = format_money($account->{AvailableBalance}, $currency, context => 'list.available');
        $name = unicode_to_bytes($name);
        print("$name\t$number\t$balance\t$available\n");
    }
    return [@result];
}

sub select_accounts
{
    my ($account_info, @selection) = @_;
    my $regexp = wildcards_to_regexp(
        map { bytes_to_unicode $_ } @selection
    );
    my %result = ();
    for my $account (@{$account_info}) {
        my $name = $account->{name};
        my $number = $account->{number};
        if ($name =~ $regexp) {
            debug("selected account: $number");
            $result{$number} = $name;
        } else {
            debug("deselected account: $number");
        }
    }
    return %result;
}

sub _clean_history_form
{
    my ($form, %options) = @_;
    kwargs(\%options,
        params => [\my $parameters, undef],
        reset => [\my $reset, 0],
    );
    for my $input ($form->inputs) {
        my $name = $input->name // '';
        if ($name =~ m/\Alastdays_\w+\z/) {
            $input->disabled(1);
        }
        if ($reset and $name !~ m/\A__/) {
            $input->disabled(1);
        }
    }
    if (defined($parameters)) {
        my $input = $form->find_input('__PARAMETERS')
            // scraping_error('history.form.params');
        $input->readonly
            or scraping_error('history.form.params.ro');
        $input->readonly(0);
        $input->value($parameters);
        $input->readonly(1);
    }
    return;
}

sub _prepare_history
{
    my ($login_info) = @_;
    my $module = 'account_oper_list';
    my $frameset_url = "frames.aspx?module=$module";
    my $menu_url = $login_info->{menu}->{hosthistory} // '';
    $menu_url eq "/csite/$frameset_url"  # sanity check
        or scraping_error("history.menu: $menu_url");
    my $request = GET(
        "$csite_url/$frameset_url",
        'Referer' => $login_info->{url},
    );
    my $doc = download($request);
    my $html = html_new($doc->{content});
    my $e_frame = html_find($html, tag => 'frame', name => 'MainFrame', context => 'history.frame');
    my $frame_url = $e_frame->attr('src') // '';
    $frame_url =~ s/\A\s+|\s+\z//g;
    $frame_url eq "$module.aspx"  # sanity check
        or scraping_error("history.frame.url: $frame_url");
    $request = GET(
        "$csite_url/$frame_url",
        'Referer' => $doc->{url},
    );
    $doc = download($request);
    return $doc;
}

sub do_history
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        accounts => \my $account_info,
        selection => \my $selection,
        display_name => \my $display_name,
        display_id => \my $display_id,
        start_date => [\my $start_date, undef],
        end_date => [\my $end_date, undef],
        export => [\my $export, undef],
    );
    my $doc = _prepare_history($login_info);
    my %selected_accounts = select_accounts($account_info, @{$selection})
        or user_error('history: no matching accounts');
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    if (defined($export)) {
        if (scalar(keys(%selected_accounts)) != 1) {
            user_error('history: exactly one account required for --export');
        }
    }
    for my $number (sort keys %selected_accounts) {
        $doc = _do_history_account(
            document => $doc,
            number => $number,
            name => $selected_accounts{$number},
            display_name => $display_name,
            display_id => $display_id,
            start_date => $start_date,
            end_date => $end_date,
            export => $export,
        );
        defined($doc)
            or internal_error('missing document');
    }
    return;
}

sub _switch_history_account
{
    my %options = @_;
    kwargs(\%options,
        document => \my $doc,
        number => \my $number,
    );
    my $parameters = undef;
    my $html = html_new($doc->{content});
    my $e_account_menu = html_find($html, id => 'MenuAccountsCombo', context => 'history.account-menu');
    my @e_accounts = $e_account_menu->content_list();
    for my $e_account (@e_accounts) {
        my $o_name = $e_account->as_trimmed_text();
        my ($o_number) = ($o_name =~ m/- ($account_number_re)\z/)
            or scraping_error("history.account.number: $o_name");
        if ($number eq $o_number) {
            if ($e_account->attr('selected')) {
                $parameters = ''
            } else {
                $parameters = $e_account->attr('value');
            }
            last;
        }
    }
    defined($parameters)
        or scraping_error("history.account.phantom: $number");
    if (length($parameters) > 0) {
        my @forms = HTML::Form->parse(
            $doc->{response},
            strict => 1,
        );
        unpack_list([\my $form], [@forms], context => 'history.form');
        _clean_history_form($form, params => $parameters);
        $doc = download($form->click());
    }
    return $doc;
}

sub _do_history_account
{
    my %options = @_;
    kwargs(\%options,
        document => \my $doc,
        name => \my $name,
        number => \my $number,
        start_date => [\my $start_date, undef],
        end_date => [\my $end_date, undef],
        export => [\my $export, undef],
        display_name => \my $display_name,
        display_id => \my $display_id,
    );
    $doc = _switch_history_account(
        document => $doc,
        number => $number,
    );
    my @forms = HTML::Form->parse(
        $doc->{response},
        strict => 1,
    );
    unpack_list([\my $form], [@forms], context => 'history.form');
    if (defined($start_date) or defined($end_date)) {
        my $min_date = '1901-01-01';
        my $get_limit = sub {
            my ($var) = @_;
            my $min_date_nh = $min_date;
            $min_date_nh =~ s/-//g;
            my $regexp_template =
                "DateValidator(theform.daterange_${var}_day, '$min_date_nh', '<YYYY><MM><DD>', '', '')";
            # Replace <YYYYY> with (\d\d\d\d), <MM> with (\d\d), and so on;
            # treat everything else literally:
            my $regexp = "\\b\Q$regexp_template\E";
            $regexp =~ s/\\<([YMD]+)\\>/'(' . ('\d' x length($1)) . ')'/eg;
            my @limit = ($doc->{content} =~ $regexp)
                or return;
            return join('-', @limit);
        };
        my $set_date = sub {
            my ($var, $date) = @_;
            $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
                or internal_error("invalid date: $date");
            my ($y, $m, $d) = split(m/-/, $date);
            $m =~ s/\A0//;
            $d =~ s/\A0//;
            $form->value("daterange_${var}_day", $d);
            $form->value("daterange_${var}_month", $m);
            $form->value("daterange_${var}_year", $y);
            $form->value('rangepanel_group', 'daterange_radio');
            return;
        };
        my $now = my $start_limit = $get_limit->('from')
            // scraping_error('history.limit.start');
        my $end_limit = $get_limit->('to')
            // scraping_error('history.limit.end');
        # start date:
        $start_date //= $now;
        $min_date le $start_date
            or user_error('--from date too far in the past');
        $start_date le $start_limit
            or user_error('--from date in the future');
        $set_date->('from', $start_date);
        # end date:
        $end_date //= $now;
        $min_date le $end_date
            or user_error('--to date too far in the past');
        $end_date le $end_limit
            or user_error('--to date too far in the future');
        $start_date le $end_date
            or user_error('--to date before --from date');
        $set_date->('to', $end_date);
    }
    my $html = html_new($doc->{content});
    my $e_submit = html_find($html, tag => 'button', id => 'Submit', context => 'history.submit');
    my $onclick = $e_submit->attr('onclick') // '';
    my $default_module = 'account_oper_list';
    my $export_module = 'printout_oper_list';
    $onclick eq "return OperationHistoryExport(export_oper_history_check, '/csite/$export_module.aspx', '/csite/$default_module.aspx')"
        or scraping_error("history.submit.onclick: $onclick");
    my $i_export = $form->find_input('export_oper_history_check')
        // scraping_error('history.form.export');
    if (defined($export)) {
        $i_export->check();
        my $i_export_format = $form->find_input('export_oper_history_format')
            // scraping_error('history.form.export-format');
        $i_export_format->value($export);
        $form->action("$csite_url/$export_module.aspx");
    } else {
        $i_export->value(undef);
        $form->action("$csite_url/$default_module.aspx");
    }
    _clean_history_form($form);
    if (defined($export)) {
        my $response = simple_download($form->click());
        # FIXME: The whole file is loaded into memory.
        # Instead, we should read and write it in chunks.
        print {*STDOUT} $response->content;
        return 1;
    }
    $doc = download($form->click());
    PAGE: while (1) {
        $html = html_new($doc->{content});
        _do_history_page(
            html => $html,
            name => $name,
            display_name => $display_name,
            display_id => $display_id,
        );
        my ($e_prevpage) = html_find($html, tag => 'button', id => 'PrevPage');
        if (defined($e_prevpage)) {
            $onclick = $e_prevpage->attr('onclick') // '';
            my $url = $doc->{response}->base;
            $url =~ s{\A.*?(?=/csite/)}{};
            my $regexp_template =
                "doSubmit('$url','','POST','<params>',true,false,true,null);";
            # Replace <params> with ([^']*); treat everything else literally:
            my $regexp = "\\A\Q$regexp_template\E";
            $regexp =~ s/\\<params\\>/([^']*)/g;
            $regexp !~ m/</
                or internal_error("unexpected character in regexp: $regexp");
            my ($parameters) = ($onclick =~ $regexp)
                or scraping_error("history.prev.onclick: $onclick");
            @forms = HTML::Form->parse(
                $doc->{response},
                strict => 1,
            );
            unpack_list([\$form], [@forms], context => 'history.prev.form');
            _clean_history_form($form, params => $parameters);
            $doc = download($form->click());
            next PAGE;
        } else {
            last PAGE;
        }
    }
    return $doc;
}

sub _do_history_page {
    my %options = @_;
    kwargs(\%options,
        html => \my $html,
        name => \my $name,
        display_name => \my $display_name,
        display_id => \my $display_id,
    );
    $name = unicode_to_bytes($name);
    my @e_op_descs = html_find($html, class => 'OperationDescription');
    if (not @e_op_descs) {
        html_find($html, id => 'account_operations_NoData', n => 1, context => 'history.empty');
        return;
    }
    for my $e_op_desc (@e_op_descs) {
        my $e_op = $e_op_desc->parent;
        $e_op->tag eq 'li'
            or scraping_error('history.table');
        if (has_html_class($e_op, 'header')) {
            next;
        }
        # operation id:
        my $id = '';
        my @e_checkbox = html_find($e_op, tag => 'input', type => 'checkbox');
        if (@e_checkbox) {
            unpack_list([\my $e_checkbox], [@e_checkbox], context => 'history.checkbox.1');
            my $checkbox_id = $e_checkbox->attr('id') // '';
            ($id) = $checkbox_id =~ qr/\Aaccount_operations_grid_ctl\d+_MCheckBox_\d+_\d+_(\d+)\z/
                or scraping_error("history.checkbox.id: $checkbox_id");
        }
        # dates:
        my $e_dates = html_find($e_op, class => 'Date', context => 'history.date.1');
        my @e_dates = html_find($e_dates, tag => 'span', n => 2, context => 'history.date.2');
        my @dates = ();
        for my $e_date (@e_dates) {
            my $date = parse_dmy_date($e_date->as_trimmed_text(), context => 'history.date');
            push(@dates, $date);
        }
        # amounts:
        my @e_amounts = html_find($e_op, class => 'Amount', n => 2, context => 'history.amount');
        my @amounts;
        for my $e_amount (@e_amounts) {
            my $amount = $e_amount->as_trimmed_text();
            $amount = format_amount($amount)
                // scraping_error("history.amount: $amount");
            push(@amounts, $amount);
        }
        # details:
        my @e_details = $e_op_desc->content_list();
        my $n_details = scalar(@e_details);
        $n_details >= 3
            or scraping_error("history.details#: expected >= 3 instances, got $n_details");
        my @details;
        for my $e_detail (@e_details) {
            if (has_html_class($e_detail, 'FilterType')) {
                next;
            }
            my $detail = $e_detail->as_trimmed_text();
            $detail =~ s/\N{SOFT HYPHEN}//g;
            $detail = unicode_to_bytes($detail);
            push(@details, $detail);
        }
        # print:
        {
            local $LIST_SEPARATOR = "\t";
            if ($display_name) {
                print("$name\t");
            }
            if ($display_id) {
                print("$id\t");
            }
            print("@dates\t@amounts\t@details\n");
        }
    }
    return;
}

sub _prepare_blocked
{
    my ($login_info) = @_;
    my $doc = _prepare_history($login_info);
    my $html = html_new($doc->{content});
    my $module = 'witholdings_list';
    my $url = "/csite/$module.aspx";
    $html->look_down(
        _tag => 'a',
        onclick => qr/\A\QdoSubmit('$url','','POST','',false,true,false,null);\E/,
    )
        or scraping_error('blocked.module');
    my @forms = HTML::Form->parse(
        $doc->{response},
        strict => 1,
    );
    unpack_list([\my $form], \@forms, context => 'blocked.form');
    _clean_history_form($form,
        params => '',
        reset => 1
    );
    $form->action("$csite_url/$module.aspx");
    $doc = download($form->click);
    return $doc;
}

sub do_blocked
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        accounts => \my $account_info,
        selection => \my $selection,
        display_name => \my $display_name,
    );
    my $doc = _prepare_blocked($login_info);
    my %selected_accounts = select_accounts($account_info, @{$selection})
        or user_error('blocked: no matching accounts');
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    for my $number (sort keys %selected_accounts) {
        $doc = _do_blocked_account(
            document => $doc,
            number => $number,
            name => $selected_accounts{$number},
            display_name => $display_name,
        );
        defined($doc)
            or internal_error('missing document');
    }
    return;
}

sub _do_blocked_account
{
    my %options = @_;
    kwargs(\%options,
        document => \my $doc,
        name => \my $name,
        number => \my $number,
        display_name => \my $display_name,
    );
    $doc = _switch_history_account(
        document => $doc,
        number => $number,
    );
    my $html = html_new($doc->{content});
    my ($nothing_blocked) = html_find($html, tag => 'div', id => 'witholdingsListHoldings_NoData');
    if ($nothing_blocked) {
        return $doc;
    }
    my $e_blocked = html_find($html, tag => 'div', id => 'witholdingsListHoldings', context => 'blocked.table');
    my @e_ops = html_find($e_blocked, tag => 'li');
    @e_ops
        or scraping_error('blocked.table.items');
    for my $e_op (@e_ops) {
        if (has_html_class($e_op, 'header')) {
            next;
        }
        # dates:
        my @e_dates = html_find($e_op, class => 'Date', n => 2, context => 'blocked.date');
        my @dates = ();
        for my $e_date (@e_dates) {
            my $date = $e_date->as_trimmed_text();
            $date = parse_dmy_date($date, context => 'blocked.date');
            push(@dates, $date);
        }
        # amount:
        my $e_amount = html_find($e_op, class => 'Amount', context => 'blocked.amount');
        my $amount = $e_amount->as_trimmed_text();
        $amount = format_amount($amount)
            // scraping_error("blocked.amount: $amount");
        # description:
        my $e_description = html_find($e_op, class => 'WitholdingDescription', context => 'blocked.description');
        my $description = $e_description->as_trimmed_text();
        # type:
        my $e_type = html_find($e_op, class => 'WitholdingType', context => 'blocked.type');
        my $type = $e_type->as_trimmed_text();
        # print:
        {
            local $LIST_SEPARATOR = "\t";
            if ($display_name) {
                print("$name\t");
            }
            print("@dates\t$amount\t$description\t$type\n");
        }
    }
    return $doc;
}

sub do_future
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        accounts => \my $account_info,
        selection => \my $selection,
        display_name => \my $display_name,
    );
    my $request = POST(
        "$base_url/FutureOperations/Calendar/OPER_GetFutureTransfers",
        @{$login_info->{headers}},
        @header_accept_json,
        json_content({getFilter => JSON::true})
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'future.json');
    my %selected_accounts = select_accounts($account_info, @{$selection})
        or user_error('future: no matching accounts');
    $display_name ||=
        (scalar(keys(%selected_accounts)) > 1);
    my $transfer_info = $json->{transferInfos}
        // scraping_error('future.transfer');
    for my $transfer (@{$transfer_info}) {
        my $number = match($transfer->{accountNumber}, $account_number_re, context => 'future.transfer.account-number');
        my $name = $selected_accounts{$number};
        defined($name) or next;
        if ($display_name) {
            print("$name\t");
        }
        my $timestamp = $transfer->{date} // '';
        my $date = timestamp_to_date($timestamp, time_must_be => 0)
            // scraping_error("future.transfer.date: $timestamp");
        my $recipient = match($transfer->{benef}, qr/.+/, context => 'future.transfer.recipient');
        for my $key (qw(benefAddress benefCity)) {
            my $recipient_loc = $transfer->{$key} // '';
            if (length($recipient_loc) > 0) {
                $recipient .= "; $recipient_loc";
            }
        }
        my $description = match($transfer->{description}, qr/.+/, context => 'future.transfer.description');
        $description = unicode_to_bytes($description);
        my $amount = format_money($transfer->{amount}, $transfer->{currency}, context => 'future.transfer.amount');
        my $type = match($transfer->{transferType}, qr/\w+/, context => 'future.transfer.type');
        print("$date\t$recipient\t$description\t$amount\t$type\n");
    }
    return;
}

sub do_deposits
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
    );
    my $request = POST(
        "$base_url/Savings/Deposits/getDepositsList",
        @{$login_info->{headers}},
        @header_accept_json,
        'Content-Type' => 'application/json',
        'Content' => '',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'deposits.json');
    $json = $json->{properties}
        // scraping_error('deposits.properties');
    $json->{footer}->{isListComplete}
        or scraping_error('deposits.incomplete');
    my $deposits = $json->{deposits};
    for my $deposit (@{$deposits}) {
        my $title = match($deposit->{title}, qr/.+/, context => 'deposits.title');
        $title = unicode_to_bytes($title);
        my $type = match($deposit->{type}, qr/.+/, context => 'deposits.type');
        $type = unicode_to_bytes($type);
        my $end_date = $deposit->{endDate} // '';
        $end_date = timestamp_to_date($end_date, time_must_be => 0)
            // scraping_error("deposits.end-date: $end_date");
        my $length = match($deposit->{depositLength}, qr/\d+/, context => 'deposits.length');
        my $start_date = shift_date($end_date, -$length);
        my $duration = match($deposit->{period}, qr/.+/, context => 'deposits.duration');
        $duration = unicode_to_bytes($duration);
        my $interest = $deposit->{interestRate} // '';
        $interest = format_number('%.2f', $interest)
            // scraping_error("deposits.interest: $interest");
        my $amount = $deposit->{startValue} // '';
        my $currency = $deposit->{currency} // '';
        $amount = format_amount($amount, fp => 1, currency => $currency)
            // scraping_error("deposits.amount: $amount $currency");
        # FIXME: the pre-1.0 interface had also “status”
        print("$title\t$type\t$start_date\t$end_date\t$duration\t$interest%\t$amount\n");
    }
    return;
}

sub do_cards
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
    );
    my $request = POST(
        "$base_url/Cards/Cards/IndexData",
        @{$login_info->{headers}},
        'Accept' => 'text/html, */*; q=0.01',
        'Content' => '',
    );
    my $doc = download($request);
    my $html = html_new($doc->{content});
    my @e_cards = html_find($html, class => 'card-properties');
    for my $e_card (@e_cards) {
        my $e_name = html_find($e_card, class => 'card-name', context => 'cards.name');
        my $name = $e_name->as_trimmed_text();
        my $e_number = html_find($e_card, class => 'card-number', context => 'cards.number');
        my $number = $e_number->as_trimmed_text();
        my $e_owner = html_find($e_card, class => 'card-owner', context => 'cards.owner');
        my $owner = $e_owner->as_trimmed_text();
        my $e_amount = html_find($e_card, class => 'card-amount', context => 'cards.amount');
        my $amount = $e_amount->as_trimmed_text();
        $amount = format_amount($amount)
            or scraping_error("cards.amount: $amount");
        print("$name\t$number\t$owner\t$amount\n");
    }
    return;
}

sub do_funds
{
    my %options = @_;
    _do_funds(%options, 'type' => 'Normal');
    return;
}

sub do_pension
{
    my %options = @_;
    _do_funds(%options, 'type' => 'ike');
    return;
}

sub _do_funds
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        type => \my $type,
    );
    my $request = POST(
        "$base_url/InvestmentFunds/Dashboard/Dashboard",
        @{$login_info->{headers}},
        'Accept' => 'text/html, */*; q=0.01',
        'Content' => ['type' => $type]
    );
    my $doc = download($request);
    my $html = html_new($doc->{content});
    my @e_funds = html_find($html, class => 'investment-properties');
    for my $e_fund (@e_funds) {
        if (has_html_class($e_fund->parent, 'bestFunds')) {
            next;
        }
        if (has_html_class($e_fund, 'wallet-properties')) {
            next;
        }
        my $e_name = html_find($e_fund, class => 'investment-name-group', context => 'funds.name');
        my $name = $e_name->as_trimmed_text();
        $name = unicode_to_bytes($name);
        my $e_amounts = html_find($e_fund, class => 'investment-actual', context => 'funds.amount');
        my @e_amounts = html_find($e_amounts, tag => 'span');
        my $n_amounts = scalar(@e_amounts);
        ($n_amounts == 1) or ($n_amounts == 2)
            or scraping_error("funds.amount#: expected 1 or 2 instances, got $n_amounts");
        my ($e_current_amount, $e_planned_amount) = @e_amounts;
        my $current_amount_raw = $e_current_amount->as_trimmed_text();
        my $current_amount = format_amount($current_amount_raw)
            or scraping_error("funds.amount.current: $current_amount_raw");
        my $planned_amount = undef;
        if (defined($e_planned_amount)) {
            has_html_class($e_planned_amount, 'gray')
                or scraping_error('funds.amount.planned.gray');
            $planned_amount = $e_planned_amount->as_trimmed_text();
            $planned_amount = format_amount($planned_amount, plus => 1)
                or scraping_error("funds.amount.planned: $planned_amount");
        }
        my $line = "$name\t$current_amount";
        if (defined($planned_amount)) {
            $line .= "\t$planned_amount";
        }
        print("$line\n");
    }
    return;
}

sub do_notices
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
    );
    my $request = POST(
        "$base_url/Adv/AdvPlaceholder/GetUpdates",
        @{$login_info->{headers}},
        @header_accept_json,
        json_content({
            placeholderIdList => undef,
            timestamp => -1
        })
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'notices.json');
    my $elements = $json->{Elements}
        // scraping_error('notices.elements');
    for my $element (@{$elements}) {
        my $template_path = $element->{TemplatePath}
            // scraping_error('notices.template-path');
        my $message = $element->{Message}
            // scraping_error('notices.message');
        my $is_hidden = $message->{IsHidden}
            // scraping_error('notices.is-hidden');
        my $is_visible = (
            $template_path =~ m{/MessageBox/|/TopAdmin/}
            and not $is_hidden
        );
        $is_visible or next;
        my $is_read = $message->{IsRead}
            // scraping_error('notices.is-read');
        my $new_flag = $is_read ? '' : 'N';
        my $timestamp = $message->{StartDate};
        my $date = timestamp_to_date($timestamp)
            // scraping_error("notices.date: $timestamp");
        my $title = $message->{Title}
            // scraping_error('notices.title');
        $title = unicode_to_bytes($title);
        print("$new_flag\t$date\t$title\n");
    }
    return;
}

sub do_activate_profile
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
        args => \my $args,
    );
    my @args = @{$args};
    scalar(@args) > 0
        or user_error('activate-profile: no profile selected');
    scalar(@args) <= 1
        or user_error('activate-profile: too many arguments');
    my ($name) = @args;
    $name = bytes_to_unicode($name);
    my %profiles = %{$login_info->{profiles}};
    my $sortkey = sub {
        my ($key) = @_;
        my %map = (
            personal => "\000",
            business => "\001",
        );
        return $map{$key} // $key;
    };
    if (not exists($profiles{$name})) {
        my $profiles = join(', or ',
            map { "\"$_\"" }
            sort { $sortkey->($a) cmp $sortkey->($b) }
            keys(%profiles)
        );
        $profiles = unicode_to_bytes($profiles);
        user_error("activate-profile: invalid profile name (should be $profiles)");
    }
    my @codes = @{$profiles{$name}};
    if (scalar @codes == 0) {
        user_error("activate-profile: $name profile not available");
    } elsif (scalar @codes > 1) {
        internal_error('activate-profile: ambiguous profile name');
    };
    my ($code) = @codes;
    if ($code eq 'T') {
        # ‘I’ (“individual profile”) is a superset of ‘T’ (“own products”),
        # so let's use the latter:
        $code = 'I';
    }
    debug("activating profile $code...");
    my $request = POST(
        "$base_url/LoginMain/Account/JsonActivateProfile",
        @{$login_info->{headers}},
        'Accept' => '*/*',
        'Content' => ['profileCode' => $code],
    );
    my $doc = download($request);
    # It's tempting to do decode_json() here, but actually,
    # despite the Content-Type, the response is not valid JSON.
    # Yay...
    _do_lazy_logout(login => $login_info);
    return;
}

sub _do_lazy_logout
{
    my %options = @_;
    kwargs(\%options,
        login => \my $login_info,
    );
    my $request = POST(
        "$base_url/LoginMain/Account/LazyLogout",
        @{$login_info->{headers}},
        @header_accept_json,
        'Content' => '',
        'Content-Type' => 'application/json',
    );
    my $doc = download($request);
    my $json = decode_json($doc->{content}, context => 'logout.json');
    $json->{lazy}
        or scraping_error('logout.lazy');
    return;
}

sub do_logout
{
    my %options = @_;
    kwargs(\%options,
        maybe => [\my $maybe, 0],
    );
    my $login_info = do_login(probe => 1);
    if (not defined($login_info)) {
        $ua->cookie_jar->clear_temporary_cookies();
        debug('temporary cookies have been wiped out');
        if ($maybe) {
            return;
        } else {
            user_error('logout: the user was not logged in')
        }
    } else {
        debug('logging out...');
        _do_lazy_logout(login => $login_info);
        my $request = GET(
            "$base_url/LoginMain/Account/Logout",
            'Referer' => $login_info->{url},
        );
        my $response = simple_download($request);
        $response->is_redirect
            or scraping_error('logout.redirect');
        debug('successful logout');
    }
    $ua->cookie_jar->clear_temporary_cookies();
    debug('temporary cookies have been wiped out');
    return;
}

sub do_debug_noop
{
    # Nothing to do!
}

sub do_debug_https_get
{
    my %options = @_;
    kwargs(\%options,
        args => \my $urls,
    );
    my @urls = @{$urls};
    if (not @urls) {
        push(@urls, $base_url);
    }
    for my $url (@urls) {
        my $request = GET($url);
        my $doc = simple_download($request);
        print($doc->content());
    }
    return;
}

sub do_debug_sms_password
{
    my %options = @_;
    kwargs(\%options,
        args => \my $args,
    );
    my ($date, $n, $tries) = @{$args};
    $date //= '';
    my ($y, $m, $d) = $date =~ m/\A(\d\d\d\d)-(\d\d)-(\d\d)\z/
        or user_error("SMS date not in the YYYY-MM-DD format: $date");
    eval {
        Time::Piece->strptime($date, '%Y-%m-%d');
    } or user_error("invalid SMS date: $date");
    $n //= '';
    eval {
        $n >= 1;
    } or user_error("invalid SMS number: $n");
    $tries //= '1';
    eval {
        $tries >= 0;
    } or user_error("invalid number of tries: $tries");
    _ask_for_sms_password($date, $n, 0);
    for my $try (1..$tries) {
        say "(try #$try)";
        say _ask_for_sms_password($date, $n, $try);
    }
    return;
}

sub _make_config_line
{
    my ($key, $value) = @_;
    my $escaped_value = $value;
    if ($value !~ m{\A[/\w.~-]+\z}) {
        $value =~ s/["\\]/\\$1/;
        $value = qq("$value");
    }
    return "$key $value\n";
}

sub _configure_overwrite
{
    my ($term, $config_path) = @_;
    if (-e $config_path) {
        my $overwrite = '';
        until ($overwrite =~ m/\A[yYnN]\z/) {  ## no critic (Until)
            $overwrite = $term->readline(
                unexpand_tilde($config_path) . ' already exists. Overwrite (y/n)? '
            );
            $overwrite //= '';
        }
        if ($overwrite =~ m/[nN]/) {
            user_error();
        }
    }
    return;
}

sub _configure_country
{
    my ($term) = @_;
    my $guessed_cc = guess_country() // '';
    my $cc = '';
    until (exists($country_to_language{$cc})) {  ## no critic (Until)
        my $countries = join(', or ', map { uc } @known_countries);
        $cc = $term->readline("Country ($countries): ", uc($guessed_cc));
        $cc = lc($cc // '');
    }
    return $cc;
}

sub _configure_login
{
    my ($term) = @_;
    my $login = '';
    until (length($login) > 0) {  ## no critic (Until)
        $login = $term->readline('Login: ');
        $login //= '';
    }
    return $login;
}

sub _configure_password
{
    my ($term) = @_;
    my $password = '';
    until (length($password) > 0) {  ## no critic (Until)
        $password = term_readpasswd($term, 'Password: ');
        $password //= '';
    }
    my $use_gpg = '';
    until ($use_gpg =~ m/\A[yYnN]\z/) {  ## no critic (Until)
        $use_gpg = $term->readline('Encrypt password with GnuPG (y/n)? ', 'y');
        $use_gpg //= '';
    }
    $use_gpg = ($use_gpg =~ m/[yY]/);
    my $encrypted_password;
    ENCRYPT: while ($use_gpg) {
        my $password_line = _make_config_line('Password', $password);
        eval {
            require IPC::Run;
            my $secret_keys;
            IPC::Run::run(
                [@gpg_cmdline, qw(--batch --list-secret-keys)],
                '>', \$secret_keys,
            );
            if (not scalar($secret_keys)) {
                die(  ## no critic (Carping)
                    "No secret keys in the GnuPG keyring.\n" .
                    "Use \"@gpg_cmdline --gen-key\" to generate a key pair."
                );
            }
            IPC::Run::run(
                [@gpg_cmdline, qw(--armor --encrypt --default-recipient-self)],
                '<', \$password_line,
                '>', \$encrypted_password,
            )
        } or do {
            if ($EVAL_ERROR) {
                my $message = $EVAL_ERROR;
                my $file = __FILE__;
                $message =~ s/ at \Q$file\E line \d+[.]\n+//;
                say {*STDERR} $message;
            }
            my $retry = '';
            until ($retry =~ m/\A[yYnN]\z/) {  ## no critic (Until)
                $retry = $term->readline('GnuPG encryption failed. Retry (y/n)? ');
                $retry //= '';
            }
            if ($retry =~ m/[yY]/) {
                next ENCRYPT;
            } else {
                user_error();
            }
        };
        last ENCRYPT;
    }
    return ($password, $encrypted_password);
}

sub _configure_cookie_jar
{
    my ($term, $login, $default_cookie_jar_path) = @_;
    my $sanitized_login = $login =~ s/\W/_/rg;
    my $xdg_data_home = xdg_data_home();
    my $cookie_home = unexpand_tilde($xdg_data_home) . '/mbank-cli';
    $default_cookie_jar_path //= "$cookie_home/$sanitized_login.cookies";
    my $cookie_jar_path = '';
    until (length($cookie_jar_path) > 1) {  ## no critic (Until)
        $cookie_jar_path = $term->readline(
            'Session cookie store: ',
            $default_cookie_jar_path
        );
        $cookie_jar_path //= '';
    }
    return $cookie_jar_path;
}

sub do_configure
{
    my %options = @_;
    kwargs(\%options,
        config_path => \my $config_path,
        cookie_jar_path => [\my $cookie_jar_path, undef],
    );
    my $term = term_new(readpasswd => 1);
    _configure_overwrite($term, $config_path);
    my $cc = _configure_country($term);
    my $login = _configure_login($term);
    my ($password, $encrypted_password) = _configure_password($term);
    $cookie_jar_path = _configure_cookie_jar($term, $login, $cookie_jar_path);
    my $cookie_dir = dirname(expand_tilde($cookie_jar_path));
    if (not -d $cookie_dir) {
        eval {
            File::Path::make_path($cookie_dir);
        } // os_error($EVAL_ERROR);
        print(
            'Created directory for session cookie store: ',
            unexpand_tilde($cookie_dir),
            "\n"
        );
    }
    my $config_dir = dirname($config_path);
    eval {
        File::Path::make_path($config_dir);
    } // os_error($EVAL_ERROR);
    open(my $fh, '>', "$config_path.new")  ## no critic (BriefOpen)
        or os_error("$config_path.new: $ERRNO");
    print {$fh} _make_config_line('CookieJar', $cookie_jar_path);
    print {$fh} _make_config_line('Country', uc($cc));
    print {$fh} _make_config_line('Login', $login);
    if ($encrypted_password) {
        print {$fh} "# Password (encrypted):\n";
        print {$fh} $encrypted_password;
    } else {
        print {$fh} _make_config_line('Password', $password);
    }
    close($fh)
        or os_error("$config_path.new: $ERRNO");
    if (rename($config_path, "$config_path.bak")) {
        print(
            'Backup copy: ',
            unexpand_tilde("$config_path.bak"),
            "\n"
        );
    } elsif ($ERRNO{ENOENT}) {
        # okay
    } else {
        os_error("$config_path: $ERRNO");
    };
    rename("$config_path.new", $config_path)
        or os_error("$config_path: $ERRNO");
    print(
        'Created configuration file: ',
        unexpand_tilde($config_path),
        "\n"
    );
    return;
}

# ============================================
# filesystem; XDG Base Directory Specification
# ============================================

sub expand_tilde
{
    my ($path) = @_;
    $path =~ s{\A(~[^/]*)}{($_) = glob($1); $_}e;
    return $path;
}

sub unexpand_tilde
{
    my ($path) = @_;
    my ($HOME) = <~>;
    $path =~ s{\A\Q$HOME\E/}{~/};
    return $path;
}

sub _xdg_home
{
    my ($key, $default) = @_;
    my $home = $ENV{"XDG_${key}_HOME"} // '';
    if ($home !~ m{\A/}) {
        # “All paths […] must be absolute.
        # If an implementation encounters a relative path […]
        # it should consider the path invalid and ignore it.
        my ($HOME) = <~>;
        $home = "$HOME/$default";
    }
    $home =~ s{[^/]\K/+\z}{};  # strip trailing slashes
    return $home;
}

sub xdg_config_home
{
    return _xdg_home('CONFIG', '.config');
}

sub xdg_data_home
{
    return _xdg_home('DATA', '.local/share');
}

# ============
# main program
# ============

our $VERSION = '2.2.4';

umask(
    umask() | oct('077')
);

my $xdg_config_home = xdg_config_home();
my $opt_config = "$xdg_config_home/mbank-cli/config";
my $opt_cookie_jar = undef;
my $opt_start_date = undef;
my $opt_end_date = undef;
my $opt_with_id = 0;
my $opt_all = 0;
my $opt_multi = 0;
my $opt_export = undef;

sub show_help
{
    print <<'EOF' ;
Usage:
  mbank-cli [list]
  mbank-cli history [--from <start-date> [--to <end-date>]] [--with-id] [--export <format>] {<account> | -M <account>... | -A}
  mbank-cli future {<account> | -M <account>... | -A}
  mbank-cli blocked {<account> | -M <account>... | -A}
  mbank-cli deposits
  mbank-cli funds
  mbank-cli pension
  mbank-cli cards
  mbank-cli notices
  mbank-cli logout
  mbank-cli activate-profile {personal | business | <company-name>}
  mbank-cli register-device [<device-name>]
  mbank-cli configure

Common options:
  --verbose
  --debug <debug-directory>
  --config <config-file>
  --cookie-jar <cookie-jar-file>
  --help
EOF
    exit();
}

sub show_version
{
    say "mbank-cli $VERSION";
    say "+ Perl $PERL_VERSION";
    for my $module (qw(LWP::UserAgent LWP::Protocol::https IO::Socket::SSL Net::SSLeay)) {
        Module::Loaded::is_loaded($module)
            // internal_error("$module not loaded");
        my $version = $module->VERSION // '(no version information)';
        say("+ $module $version");
    }
    if (defined $openssl_version) {
        say("  * OpenSSL $openssl_version");
    }
    exit();
}

sub check_user_date
{
    my ($option, $date) = @_;
    $date =~ m/\A\d\d\d\d-\d\d-\d\d\z/
        or user_error("--$option date not in the YYYY-MM-DD format: $date");
    eval {
        Time::Piece->strptime($date, '%Y-%m-%d');
    } or user_error("invalid --$option date: $date");
    return $date;
}

sub check_export_format
{
    my ($option, $format) = @_;
    $format = uc($format);
    my @valid_formats = qw(CSV HTML PDF);
    if (not grep { $format eq $_ } @valid_formats) {  ## no critic (BooleanGrep)
        local $LIST_SEPARATOR = ', ';
        user_error("--$option format not in {@valid_formats}")
    }
    return $format;
}

sub initialize
{
    if (not -e $opt_config) {
        user_error(
            "missing configuration file: $opt_config\n" .
            'Run "mbank-cli configure" or create the configuration file manually.'
        );
    }
    my $cfg = $global_config = read_config($opt_config);
    my $cookie_jar_path;
    if (defined($opt_cookie_jar)) {
        $cookie_jar_path = $opt_cookie_jar;
    } else {
        $cookie_jar_path = get_config_var($cfg, 'cookiejar')
            // config_error($cfg, 'missing cookiejar');
        $cookie_jar_path = expand_tilde($cookie_jar_path);
    }
    debug("cookiejar = $cookie_jar_path");
    my $ca_path = get_config_var($cfg, 'cafile', \undef);
    if (defined($ca_path)) {
        $ca_path = expand_tilde($ca_path);
    } else {
        $ca_path = get_default_ca_path(
            'DigiCert High Assurance EV Root CA',
            # openssl x509 -subject_hash -noout
            '244b5494',
            # openssl x509 -subject_hash_old -noout
            '81b9768f',
        );
    }
    if (not -r $ca_path) {
        os_error("$ca_path: $ERRNO");
    }
    debug("cafile = $ca_path");
    my $tld = get_config_var($cfg, 'country')
        // config_error($cfg, 'missing country');
    $tld = lc $tld;
    my $lang = $country_to_language{$tld};
    if (not defined($lang)) {
        local $LIST_SEPARATOR = ', ';
        my $known_countries = "{@known_countries}";
        config_error($cfg, "unknown country \U$tld\E, not in \U$known_countries\E");
    }
    $mbank_host = "online.mbank.$tld";
    $root_url = "https://$mbank_host";
    $base_url = "https://$mbank_host/$lang";
    $csite_url = "https://$mbank_host/csite";
    $ua = http_init(
        cookie_jar => $cookie_jar_path,
        ca => $ca_path,
    );
    return;
}

sub parse_args
{
    local $SIG{__WARN__} = sub {
        my ($message) = @_;
        $message = lcfirst($message);
        $message =~ s/\n+\z//;
        user_error($message);
    };
    my $debug_dir;
    GetOptions(
        'verbose' => \$opt_verbose,
        'debug=s' => \$debug_dir,
        'debug-interactive' => \$opt_debug_interactive,
        'config=s' => \$opt_config,
        'cookie-jar=s' => \$opt_cookie_jar,
        'from=s' => sub {
            my ($option, $date) = @_;
            $opt_start_date = check_user_date($option, $date);
        },
        'to=s' => sub {
            my ($option, $date) = @_;
            $opt_end_date = check_user_date($option, $date);
        },
        'with-id' => \$opt_with_id,
        'export=s' => sub {
            my ($option, $format) = @_;
            $opt_export = check_export_format($option, $format);
        },
        'M|multiple-accounts' => \$opt_multi,
        'A|all-accounts' => \$opt_all,
        'h|help' => \&show_help,
        'version' => \&show_version,
    ) or user_error();
    if (defined($debug_dir)) {
        if ($debug_dir =~ /\A-/) {
            user_error("suspicious directory name for --debug: $debug_dir");
        }
        if (not -d $debug_dir) {
            eval {
                File::Path::make_path($debug_dir);
            } // os_error($EVAL_ERROR);
        }
    }
    $opt_debug_dir = $debug_dir;
    if (defined($opt_export) and -t STDOUT) {
        user_error('export data cannot be written to a terminal; please redirect stdout to a file');
    }
    return @ARGV;
}

sub main
{
    my ($command_name, @args) = parse_args();
    $command_name //= 'list';
    debug("selected command: $command_name");

    my %commands = (
        'debug-noop' => {},
        'debug-https-get' => { args => 1 },
        'debug-sms-password' => { args => 1 },
        'list' => {},
        'history' => { accounts => 1, dates => 1, ids => 1, export => 1 },
        'future' => { accounts => 1 },
        'blocked' => { accounts => 1 },
        'deposits' => {},
        'cards' => {},
        'funds' => {},
        'pension' => {},
        'notices' => {},
        'logout' => { login => 0 },
        'register-device' => { login => 0, args => 1 },
        'activate-profile' => { args => 1 },
        'configure' => { login => 0, config => 0 },
    );

    my $command_info = $commands{$command_name};
    if (not defined $command_info) {
        user_error("$command_name: invalid command");
    }
    my $command;
    {
        no strict 'refs';  ## no critic (NoStrict)
        my $sub_name = "do_$command_name";
        $sub_name =~ y/-/_/;
        $command = *{$sub_name};
    }
    my $need_login = $command_info->{login} // 1;
    my @cmd_options;
    if ($command_name =~ m/^debug-/) {
        $need_login = 0;
    }
    if ($command_info->{config} // 1) {
        initialize();
    } else {
        push(@cmd_options,
            config_path => $opt_config,
            cookie_jar_path => $opt_cookie_jar,
        );
    }
    if ($command_info->{todo} ) {
        user_error("$command_name: command not implemented");
    }
    if ($command_info->{accounts}) {
        my @selection = @args;
        if ($opt_all) {
            @selection = '*';
        }
        if (scalar(@selection) < 1) {
            user_error("$command_name: no account selected");
        }
        push(@cmd_options,
            selection => [@selection],
            display_name => $opt_all || $opt_multi,
        );
    }
    if ($command_info->{args}) {
        push(@cmd_options,
            args => [@args],
        );
    }
    if ($need_login) {
        my $login_info = do_login();
        push(@cmd_options, login => $login_info);
        if ($command_info->{accounts}) {
            my $account_info = do_list(
                login => $login_info,
                quiet => 1,
            );
            push(@cmd_options, accounts => $account_info);
        }
    }
    if ($command_info->{dates}) {
        push(@cmd_options,
            start_date => $opt_start_date,
            end_date => $opt_end_date,
        );
    }
    if ($command_info->{ids}) {
        push(@cmd_options,
            display_id => $opt_with_id,
        );
    }
    if ($command_info->{export}) {
        push(@cmd_options, export => $opt_export);
    }
    $command->(@cmd_options);
    return;
}

if (not defined(caller)) {
    main()
}

END {
    # catch write errors:
    local $ERRNO = 0;
    close(STDOUT) or os_error("stdout: $ERRNO");
    close(STDERR) or os_error("stderr: $ERRNO");
}

END {
    # save cookies:
    if (defined($ua)) {
        my $cookie_jar_path = $ua->cookie_jar->{file};
        eval {
            $ua->cookie_jar->save();
            1;
        } // os_error("$cookie_jar_path: $ERRNO");
    }
}

1;

# vim:ts=4 sts=4 sw=4 et
