#!/usr/bin/perl

# Copyright © 2006, 2007, 2008, 2009, 2010, 2011
#   Łukasz Indeka <lukaszindeka@o2.pl>,
#   Piotr Lewandowski <piotr.lewandowski@gmail.com>,
#   Jakub Wilk <jwilk@jwilk.net>.
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License, version 2, as published
# by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, see <http://www.gnu.org/licenses>.
#
# Linking mbank-cli statically or dynamically with other modules is making a
# combined work based on mbank-cli. Thus, the terms and conditions of the GNU
# General Public License cover the whole combination.
#
# In addition, as a special exception, the copyright holders of mbank-cli give
# you permission to combine mbank-cli with the OpenSSL library (or modified
# versions of this library, with unchanged license). You may copy and
# distribute such a system following the terms of the GNU GPL for mbank-cli
# and the licenses of the OpenSSL library, provided that you include the
# source code of that other code when and as the GNU GPL requires distribution
# of source code.
#
# Note that people who make modified versions of mbank-cli are not obligated
# to grant this special exception for their modified versions; it is their
# choice whether to do so. The GNU General Public License gives permission to
# release a modified version without this exception; this exception also makes
# it possible to release a modified version which carries forward this
# exception.

use strict;
use warnings;
no encoding;

use Carp ();
use Crypt::SSLeay ();
use Digest ();
use Encode ();
use File::Basename qw(dirname);
use Getopt::Long qw(:config gnu_compat permute no_getopt_compat no_ignore_case);
use HTML::Entities ();
use HTML::Form ();
use HTTP::Cookies ();
use HTTP::Request::Common qw(GET POST);
use I18N::Langinfo qw(langinfo CODESET);
use LWP::UserAgent ();
use POSIX qw(mktime strftime);
use Text::ParseWords ();

use constant
{
  EXIT_OK => 0,
  EXIT_USER_ERROR => 1,
  EXIT_HTTP_ERROR => 2,
  EXIT_API_ERROR => 3,
  WEB_CODESET => 'ISO-8859-2',
  FAKE_DOMAIN => 'mbank-cli.invalid',
  GPG_EXECUTABLE => '/usr/bin/gpg'
};

chdir dirname($0) or die "Can't change working directory: $!";

my $mbank_host = undef; # use set_country() to define
my $mbank = undef; # use set_country() to define
my $cookie_jar_file = './cookie-jar.txt';
my $config_file = './mbank-cli.conf';

sub set_country($)
{
  my ($cc) = @_;
  $cc = lc $cc;
  $cc =~ m/^[a-z][a-z]$/ or
    user_error("Invalid country code: $cc");
  $mbank_host = $cc eq 'pl'
  ? 'www.mbank.com.pl'
  : "$cc.mbank.eu";
  $mbank = "https://$mbank_host";
}

set_country('pl');

# Strings that differ across countries:
my %messages = (
  account_rename => qr{Zmiana&nbsp;nazwy&nbsp;rachunku},
  account_rename_confirm => qr{Zatwierd\xbc},
  account_rename_successful => qr{Operacja wykonana poprawnie},
  bad_date => qr{Nieprawid\xB3owa data lub data poza dopuszczalnym zakresem},
  future_none => qr{Brak planowanych operacji},
  history_details => qr{Zobacz szczeg\xf3\xb3y operacji},
  history_previous => qr{Poprzednie&nbsp;operacje},
  history_show => qr{Zobacz[^"]*operacje[^"]*},
  invalid_session_key => qr{Alarm bezpiecze\xf1stwa[.] Nieprawid\xb3owy lub niewa\xbfny klucz sesji[.]},
  login_error => qr{B\xb3\xb1d logowania},
  logout => qr{mBank - wylogowanie},
  menu_savings => qr{Oszcz\xeadno\xb6ci},
  menu_term_deposits => qr{mLokaty},
  menu_funds => qr{Fundusze inwestycyjne},
  menu_investments => qr{Inwestycje},
  notices => qr{Wiadomo\xb6(\xe6|ci)},
  select_this_account => qr{Wybierz ten rachunek},
  system_error => qr{B\xb3\xb1d systemu},
);

$::locale_codeset = langinfo(CODESET);
%::fallback_map = (
  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 show_help()
{
  print STDERR <<EOF ;
Usage:
  mbank-cli [list]
  mbank-cli history [--range <start-date> <end-date> | --from <start-date> [--to <end-date>] ] {<account> | -M <account>... | -A}
  mbank-cli future {<account> | -M <account>... | -A}
  mbank-cli withholdings {<account> | -M <account>... | -A}
  mbank-cli funds
  mbank-cli deposits
  mbank-cli notices
  mbank-cli rename <account> <new-name>
  mbank-cli logout
  mbank-cli void

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

sub encoding_fallback($)
{
  (local $_) = @_;
  return $::fallback_map{$_} if exists $::fallback_map{$_};
  return sprintf "<U+%04X>", $_;
}

sub widen_string($;$)
{
  (local $_, my $codeset) = @_;
  $codeset //= $::locale_codeset;
  return Encode::decode($codeset, $_);
}

sub localize_html_string($;$)
{
  (local $_, my $codeset) = @_;
  $codeset //= WEB_CODESET;
  $_ = widen_string $_, $codeset;
  $_ = HTML::Entities::decode_entities $_;
  return Encode::encode($::locale_codeset, $_, \&encoding_fallback);
}

sub lwp_init()
{
  my $ca_dir = $ENV{HTTPS_CA_DIR};
  $ca_dir //= '/etc/ssl/certs/';
  map { delete $ENV{$_}; } grep(/^HTTPS_/, keys %ENV);
  $ENV{'HTTPS_VERSION'} = 3;
  $ENV{'HTTPS_DEBUG'} = 0;
  $ENV{'HTTPS_CA_DIR'} = $ca_dir;
  umask(umask() | 077);
  my $ua = new LWP::UserAgent(
    agent => 'Mozilla/5.0',
    cookie_jar => HTTP::Cookies->new(file => $cookie_jar_file, autosave => 1, ignore_discard => 1),
    requests_redirectable => ['GET', 'POST'],
    protocols_allowed => ['https'],
    timeout => 30
  );
  return $ua;
}

my $ua;

my $verbose = 0;
my $debug_directory = undef;

sub write_log($)
{
  local ($_) = @_;
  return unless defined $debug_directory;
  my $logfile = "$debug_directory/log";
  open(LOG, '>>', $logfile)
    or die "Can't create $logfile: $!";
  print LOG "$_\n";
  close(LOG)
    or die "Can't close $logfile: $!";
}

sub debug($)
{
  local ($_) = @_;
  write_log $_;
  print STDERR "$_\n" if $verbose;
}

sub user_error($)
{
  local ($_) = @_;
  write_log $_;
  print STDERR "$_\n";
  exit EXIT_USER_ERROR;
}

sub api_error($)
{
  local ($_) = @_;
  $_ = sprintf 'Oops, API error! [%s]', $_;
  write_log $_;
  Carp::cluck $_;
  exit EXIT_API_ERROR;
}

sub http_error($)
{
  my ($request) = @_;
  $_ = sprintf 'HTTP error while processing request <%s %s>', $request->method, $request->uri;
  if ($@)
  {
    my $extra_message = $@;
    $extra_message =~ s/^/| /gm;
    $_ = "$_\n$extra_message";
  }
  write_log $_;
  Carp::cluck $_;
  exit EXIT_HTTP_ERROR;
}

sub check_for_error($)
{
  local ($_) = @_;
  return $1 if m{
    <div[ ]id="errorView"[ ]class="[^"]+">
    \s* <h3> \s* (.*?) \s* </h3> \s*
  }x;
  return '';
}

sub download($)
{
  my ($request) = @_;
  # LWP does not check if hostname matches CN, we need to check that manually.
  my $subject_regex = qr(/CN=\Q$mbank_host\E$);
  $request->header('If-SSL-Cert-Subject' => $subject_regex);
  debug sprintf('Download <%s %s>', $request->method, $request->uri);
  my $response = $ua->request($request);
  http_error $request unless $response->is_success;
  my $content = $response->content;
  $content =~ s/\r//g;
  my $error = check_for_error($content);
  my $filename = $request->uri;
  $filename =~ s{^\w+://.*?/}{};
  $filename =~ s/[?].*//;
  $filename =~ s/[^[:alnum:].]/_/g;
  $filename =~ s/(?:[.]\w+)?$/.html/;
  $filename = 'index.html' if $filename eq '.html';
  if (defined $debug_directory)
  {
    my $debugfile = "$debug_directory/$filename";
    open(LOG, '>', "$debugfile")
      or die "Can't create $debugfile: $!";
    print LOG $content;
    close(LOG)
      or die "Can't close $debugfile: $!";
  }
  return { response => $response, content => $content, error => $error };
}

sub preread_config()
{
  BEGIN
  {
    our $digest_module;
    eval { $digest_module = Digest->new('SHA-256'); };
    eval { $digest_module = Digest->new('SHA-1'); } if $@;
    $digest_module = Digest->new('MD5') if $@;
  }
  user_error "Can't open the config file: $!" unless open CONFIG, '<', $config_file;
  my $prev_digest = '';
  $main::digest_module->new();
  my $header = '';
  read CONFIG, $header, 28;
  my $need_decrypt = $header eq "-----BEGIN PGP MESSAGE-----\n" || $header =~ /^\x85\x02/;
  $main::digest_module->add($header);
  $main::digest_module->addfile(*CONFIG);
  close CONFIG or die "Can't close config file: $!";
  my $digest = $main::digest_module->b64digest();
  $ua->cookie_jar->scan(
    sub
    {
      my ($version, $key, $val, $path, $domain) = @_;
      $prev_digest = $val if $domain eq FAKE_DOMAIN and $path eq '/config/' and $key eq 'sha1';
      # for compatibily reasons, key is named 'sha1' rather than 'digest'
    }
  );
  if ($digest ne $prev_digest)
  {
    debug 'Your personality has just changed';
    $ua->cookie_jar->clear();
  }
  $ua->cookie_jar->set_cookie(0, 'sha1', $digest, '/config/', FAKE_DOMAIN, undef, undef, undef, 1 << 25, undef);
  return $need_decrypt;
}

sub read_config_file($)
{
  my ($fp) = @_;
  my %result = ();
  my $error;
  local $_;
  while (<$fp>)
  {
    next if /^(?:#|\s*)$/;
    if (/^\s*([\w-]+)\s+(.*\S)\s*$/)
    {
      my $key = lc $1;
      my ($value) = Text::ParseWords::parse_line('^$', 0, $2);
      $result{$key} = $value;
    }
    elsif (not defined $error)
    {
      $error = $.;
    }
  }
  if (defined $error)
  {
    user_error("Can't parse the config file (line $.)");
  }
  return %result;
}

sub read_config($)
{
  my ($need_decrypt) = @_;
  user_error "Can't open the config file: $!" unless open STDIN, '<', $config_file;
  my $fp;
  if ($need_decrypt)
  {
    open GPG, '-|', GPG_EXECUTABLE, '--decrypt' or die "Can't invoke gpg: $!";
    $fp = \*GPG;
  }
  else
  {
    $fp = \*STDIN;
  }
  my %config = read_config_file($fp);
  close GPG or user_error q(Can't read the config file) if $need_decrypt;
  close STDIN or die "Can't close pipe: $!";
  my $login = $config{'login'};
  user_error('No login name provided') unless defined $login;
  user_error("Invalid login name '$login'") unless $login =~ /^\d+$/;
  my $password = $config{'password'};
  user_error('No password provided') unless defined $password;
  user_error("Invalid password '$password'") unless length($password) > 0;
  return ($login, $password)
}

sub do_logout()
{
  debug 'Logging out...';
  $ua->protocols_allowed(['http', 'https']);
  my $have_cookies = 0;
  $ua->cookie_jar->scan(
    sub
    {
      my ($version, $key, $val, $path, $domain) = @_;
      $have_cookies = 1 unless $domain eq FAKE_DOMAIN;
    }
  );
  user_error 'You are not logged in' unless $have_cookies;
  my $web_logout = download GET("$mbank/logout.aspx");
  $ua->cookie_jar->clear();
  debug 'Cookies have been wiped out';
  if (check_session_expiry($web_logout))
  {
    debug 'Probably you have been already logged out'
  }
  else
  {
    $web_logout->{content} =~ m(<title>$messages{logout}</title>) or api_error('logout-failed');
  }
}

sub do_login($$)
{
  debug 'Logging in...';
  my ($web_in, $need_decrypt) = @_;
  my @forms = HTML::Form->parse($web_in->{response});
  $#forms == 0 or api_error('login-form');
  my ($form) = @forms;
  my $in_login = $form->find_input('customer', 'text');
  my $in_passw = $form->find_input('password', 'password');
  api_error('login-field') unless defined $in_login;
  api_error('password-field') unless defined $in_passw;
  api_error('login-button') unless $web_in->{content} =~ m{<button id="confirm" onclick="([^"]+)" class="button">};
  my $onclick = $1;
  my ($login, $passw) = read_config($need_decrypt);
  $in_login->value($login);
  $in_passw->value($passw);
  my $web_out = download onclick_to_req($form, $onclick);
  user_error 'Login error: incorrect login/password' if $web_out->{error} =~ m(^$messages{login_error}$);
  api_error('login-error ' . $web_out->{error}) if $web_out->{error} ne '';
  return $web_out;
}

sub parse_amount($)
{
  local ($_) = @_;
  s/(\s|\xa0)//g;
  my $number_re = qr{(-?)(\d+),(\d{2})};
  m{^$number_re$} or m{>$number_re<} or return undef;
  my $amount = int($2) + int($3) / 100.0;
  $amount = -$amount if $1;
  return $amount;
}

sub onclick_to_req($$)
{
  my ($form, $onclick) = @_;
  $onclick =~ m{^doSubmit[(]'/?(\w+[.]aspx)?','','(?:POST)?',(?:'([^']*?)'|null),.*?,(?:\w+|'(.*?)')[)];} or
    $onclick =~ m{^return OperationHistoryExport[(]export_oper_history_check, '/?\w+[.]aspx', '/?(\w+[.]aspx)'[)]} or
    api_error('onclick');
  $form->action("$mbank/$1") if defined $1;
  $form->value('__PARAMETERS', $2) if defined $2;
  my $js = $3;
  if (defined $js and $js eq 'var dt\\; dt = new Date(\\)\\; document.MainForm.localDT.value = dt.toLocaleString(\\)\\;')
  {
    my $date = strftime('%a %b %d %H:%M:%S %Y', localtime());
    $form->value('localDT', $date);
  }
  return $form->click();
}

sub do_operations($$)
{
  my ($web, $name) = @_;

  return if $web->{content} =~ m{<p class="message">Brak operacji [^<]*</p>};
  if ($web->{content} =~ m{<p class="message">$messages{bad_date}</p>})
  {
    user_error "Invalid date range"
  }

  WEB_LOOP: while (1)
  {
    $web->{content} =~ m{
      <div[ ]id="account_operations"[ ]class="grid">
      (.*?)
      </div>
    }sx or api_error('history-table');
    my $content = $1;
    while ($content =~ m{<li(?:[ ]class="alternate")?>(.*?)</li>}go)
    {
      my $line = $1;
      $line =~ m(
        <p[ ]class="Date">
        <span[ ]id="\w+"> (\d{2})-(\d{2})-(\d{4}) </span>
        <span[ ]id="\w+"> (\d{2})-(\d{2})-(\d{4}) </span>
        </p>
        <p[ ]class="CheckBox">
        (?: <span[ ]class="checkBox"><input[ ]id="\w+" [^>]*></span> | &nbsp; )
        </p>
        <p[ ]class="OperationDescription">
        <a[ ]id="\w+"[ ]title="$messages{history_details}"[ ][^>]*> ( (?:[^<]+|<wbr(?:[ ]/)?>)+ ) </a>
        ( (?: <span> (?:[^<]+|<wbr(?:[ ]/)?>)+ </span> )* )
        (?: <span[ ]class="FilterType"> [^>]* </span> )?
        </p>
        <p[ ]class="Amount"><span[ ]id="\w+"[^>]*> ( [0-9, -]+ ) ( [A-Z]+ ) </span></p>
        <p[ ]class="Amount"><span[ ]id="\w+"[^>]*> ( [0-9, -]+ ) ( [A-Z]+ ) </span></p>
      )x or api_error('history-table-item');
      my $date1 = "$3-$2-$1";
      my $date2 = "$6-$5-$4";
      my $amount = parse_amount($9);
      defined $amount or api_error('history-table-amount');
      my $amount_c = $10;
      my $balance = parse_amount($11);
      defined $balance or api_error('history-table-balance');
      my $balance_c = $12;
      my $details = "$7\t$8";
      $details =~ s{</span><span>}{\t}g;
      $details =~ s{<[^>]*>}{}g;
      $details =~ s{&shy;}{}g;
      $details = localize_html_string($details);
      $details =~ s/ +/ /g;
      $details =~ s/ +$/ /g;
      print "$name\t" if defined $name;
      printf "%s\t%s\t%8.2f %s\t%8.2f %s\t%s\n", $date1, $date2, $amount, $amount_c, $balance, $balance_c, $details;
    }
    if ($content =~ m{<button id="PrevPage" onclick="([^"]+)" class="button">$messages{history_previous}</button>})
    {
      my $onclick = $1;
      my @forms = HTML::Form->parse($web->{response});
      $#forms == 0 or api_error('history-table-button');
      my ($form) = @forms;
      foreach my $input ($form->inputs)
      {
        $input->disabled(1) if defined $input->name and $input->name =~ '^lastdays_\w+$';
      }
      my $prev_req = onclick_to_req($form, $onclick);
      $web = download $prev_req;
      next WEB_LOOP;
    }
    last WEB_LOOP;
  }
}

sub correct_date($)
{
  local ($_) = @_;
  return undef unless defined $_;
  my $time;
  return $_ if $_ eq 'now';
  if (m/(\d{4})-(\d{2})-(\d{2})/)
  {
    $time = mktime 0, 0, 0, $3, $2-1, $1-1900;
    @_ = localtime $time;
    return $_ if
      $3 == $_[3] and
      $2 == $_[4] + 1 and
      $1 == $_[5] + 1900 and
      $1 >= 1900;
  }
  debug "Invalid date: $_";
  return undef;
}

sub ground_date($$)
{
  my ($date, $now) = @_;
  $date = $now if $date eq 'now';
  $date =~ m/^(\d{4})-(\d\d)-(\d\d)$/ or die;
  return ($1, $2, $3);
}

sub check_session_expiry($)
{
  my ($web) = @_;
  return 1
    if ($web->{error} =~ m{^$messages{system_error}$} and
    $web->{content} =~ m{
      <p[ ]class="message">
      $messages{invalid_session_key}
      </p>
    }x);
}

my ($opt_from, $opt_to);
my $opt_range = undef;
my $opt_multiple_accounts = 0;
GetOptions(
  'verbose' => \$verbose,
  'debug=s' => \$debug_directory,
  'config=s' => \$config_file,
  'cookie-jar=s' => \$cookie_jar_file,
  'from=s' => sub
    {
      shift;
      $opt_from = correct_date shift;
      $opt_range = 0;
    },
  'to=s' => sub
    {
      shift;
      $opt_to = correct_date shift;
      $opt_range = 0;
    },
  'range=s{2}' => sub
    {
      shift;
      if (($opt_range || 0) == 0)
      {
        $opt_from = correct_date shift;
        $opt_to = undef;
        $opt_range = 1;
      }
      else
      {
        $opt_to = correct_date shift;
        $opt_range = 0;
      }
    },
  'M|multiple-accounts' => sub
    {
      $opt_multiple_accounts = 1;
    },
  'A|all-accounts' => sub
    {
      $opt_multiple_accounts = 99;
    },
  'h|help' => \&show_help,
) or exit EXIT_USER_ERROR;

$ua = lwp_init();

my $need_decrypt_config = preread_config();

my $action = shift @ARGV;
$action //= 'list';
my $selected_accounts;
my $new_account_name;

debug "Action: $action";

exit EXIT_OK if $action eq 'void';

if ($action eq 'logout')
{
  do_logout();
  exit EXIT_OK;
}
elsif (grep $action eq $_, qw(history future withholdings))
{
  $opt_multiple_accounts++ if $opt_multiple_accounts == 0 and $#ARGV > 0;
  if ($opt_multiple_accounts > 1)
  {
    $selected_accounts = qr(^);
  }
  else
  {
    user_error 'No account selected' if $#ARGV < 0;
    @_ = map { widen_string $_ } @ARGV;
    @_ = map quotemeta, @_;
    $_ = join '|', @_;
    s/\\\*/.*/g;
    $selected_accounts = qr/^($_)$/;
  }
  if ($action eq 'history')
  {
    if (defined $opt_range)
    {
      $opt_to = correct_date 'now' if defined $opt_from and not defined $opt_to;
      user_error 'No or invalid time range selected' unless defined $opt_from and defined $opt_to and ($opt_to ge $opt_from);
      debug "Using time range $opt_from ... $opt_to";
    }
    else
    {
      debug 'Using default time range';
    }
  }
}
elsif ($action eq 'rename')
{
  user_error 'No account selected' if $#ARGV < 0;
  user_error 'No new account name provided' if $#ARGV < 1;
  $_ = widen_string shift;
  $_ = quotemeta $_;
  s/\\\*/.*/g;
  $selected_accounts = qr/^$_$/;
  $_ = widen_string shift;
  user_error 'Invalid new account name' if not defined $_;
  $new_account_name = $_;
}
elsif (grep $action eq $_, qw(list funds deposits notices))
{ }
else
{
  user_error 'Invalid action';
}

my $need_login = 1;
my $web_accounts_list;

$ua->cookie_jar->scan(
  sub
  {
    my ($version, $key, $val, $path, $domain) = @_;
    $need_login = 0 if $domain eq FAKE_DOMAIN and $path eq '/login-options/';
  }
);
if (!$need_login)
{
  debug 'Trying to reuse previous session';
  $web_accounts_list = download GET("$mbank/accounts_list.aspx");
  if (check_session_expiry($web_accounts_list))
  {
    debug 'Invalid or expired session key';
    $need_login = 1;
  }
  elsif ($web_accounts_list->{error} ne '')
  {
    api_error('pre-login ' . $web_accounts_list->{error});
  }
}

if ($need_login)
{
  debug 'A new session will be created';
  $need_login = 1;
  my $web_login = download GET("$mbank/");
  my $web_frames = do_login($web_login, $need_decrypt_config);
  $ua->cookie_jar->set_cookie(0, 'dummy', '', '/login-options/', FAKE_DOMAIN, undef, undef, undef, 604800, undef);
  $web_accounts_list = download GET("$mbank/accounts_list.aspx");
}

my @accounts_list_forms = HTML::Form->parse($web_accounts_list->{response});
$#accounts_list_forms == 0 or api_error('account-list');
my ($accounts_list_form) = @accounts_list_forms;

if ($action eq 'funds')
{
  $web_accounts_list->{content} =~ m{<a[ ]onclick="([^"]*)" [^>]+?>$messages{menu_investments}} or api_error('funds-link-1');
  my $web_investments_list = download onclick_to_req($accounts_list_form, $1);
  $web_investments_list->{content} =~ m{<a[ ]onclick="([^"]*)" [^>]+?>$messages{menu_funds}} or api_error('funds-link-2');
  my $web_funds_list = download onclick_to_req($accounts_list_form, $1);
  my $fund_re = qr{<a.*?onclick="doSubmit\('/if_fund_details[.]aspx',[^>]+?>([^<]+?)<.*?>([0-9 ,]+) ([A-Z]+)</span>};
  while ($web_funds_list->{content} =~ m{$fund_re}go)
  {
    my $name = localize_html_string $1;
    my $amount = parse_amount $2;
    defined $amount or api_error('funds-amount');
    my $currency = $3;
    printf "%s\t%8.2f %s\n", $name, $amount, $currency;
  }
  exit;
}

if ($action eq 'deposits')
{
  $web_accounts_list->{content} =~ m{<a[ ]onclick="([^"]*)" [^>]+?>$messages{menu_savings}} or api_error('savings-link');
  my $web_deposits_types = download onclick_to_req($accounts_list_form, $1);
  $web_deposits_types->{content} =~ m{<a[ ]onclick="([^"]*)" [^>]+?>$messages{menu_term_deposits}} or api_error('term-deposits-link');
  my $web_deposits_list = download onclick_to_req($accounts_list_form, $1);
  my $deposit_re = qr{<a.*?onclick="doSubmit\('/termdeposit_details[.]aspx',[^>]+?>([^<]+?)<.*?<p class="Date"><span[^>]+?>(\d\d\d\d)-(\d\d)-(\d\d)</span><span>(\d\d\d\d)-(\d\d)-(\d\d)</span>.*?<p class="DepositLength"><span[^>]+?>([^<]+?)</span>.*?<p class="Percent"><span[^>]+?>([0-9,]+)[^<]+?</span>.*?<p class="DepositStatus"><span[^>]+?>([^<]*?)</span>.*?<p class="Amount"><span[^>]+?>([0-9 ,]+) ([A-Z]+)</span>};
  while ($web_deposits_list->{content} =~ m{$deposit_re}go)
  {
    my $name = localize_html_string $1;
    my $establishment_date = "$2-$3-$4";
    my $maturity_date = "$5-$6-$7";
    my $length = localize_html_string $8;
    my $interest = parse_amount $9;
    defined $interest or api_error('term-deposits-interest');
    my $status = $10;
    my $amount = parse_amount $11;
    defined $amount or api_error('term-deposits-amount');
    my $currency = $12;
    printf "%s\t%s\t%s\t%s\t%8.2f%%\t%s\t%8.2f %s\n", $name, $establishment_date, $maturity_date, $length, $interest, $status, $amount, $currency;
  }
  exit;
}

if ($action eq 'notices')
{
  $web_accounts_list->{content} =~ m{<a[ ]onclick="([^"]*)" [^>]+?>$messages{notices}} or api_error('notices-link');
  my $web_notices_list = download onclick_to_req($accounts_list_form, $1);
  my $notice_re = qr{<li(|[ ]class="[^"]+?")><p class="Date"><span[^>]+?>(\d\d)-(\d\d)-(\d\d\d\d)</span>.*?<a.*?onclick="doSubmit\('/(?:customer|account)_notice_details[.]aspx',[^>]+?>([^<]+)</a>};
  while ($web_notices_list->{content} =~ m{$notice_re}go)
  {
    my $new = '';
    $new = 'N' if index($1, 'selected') > -1;
    my $date = "$4-$3-$2";
    my $subject = localize_html_string $5;
    printf "%s\t%s\t%s\n", $new, $date, $subject;
  }
  exit;
}

my $accounts_re = qr{.*<div id="AccountsGrid" class="grid">(.*?)</div>.*}s;
$web_accounts_list->{content} =~ s/$accounts_re/$1/ or api_error('accounts-list');

$accounts_re = qr(
<p[ ]class="Account">
<a[ ]id="\w+"[ ]title="$messages{select_this_account}"[ ]onclick="([^"]*)" [^>]*?>
(?:
  (.+?) [ ] (\d\d[ ]\d\d\d\d[ ]\d\d\d\d[ ]\d\d\d\d[ ]\d\d\d\d[ ]\d\d\d\d[ ]\d\d\d\d) |
  Konto [ ] MOBILE
)
</a>
</p>
<p[ ]class="Amount">
(?:
  <a[ ]id="\w+"[ ]title="$messages{history_show}" [^>]*? onclick="([^"]*)" [^>]*?>
  (-?[0-9 ,]+) [ ] ([A-Z]+)
  </a>
|
  <span> [0-9]+ [ ] MIN </span>
)
</p>
<p[ ]class="Amount">
(?:
  <span[ ]id="\w+"[^>]*>
  (-?[0-9 ,]+) [ ] ([A-Z]+)
  </span>
)?
</p>
)x;
$web_accounts_list->{content} =~ m{$accounts_re} or api_error('accounts-list-item');

my $n_matches = 0;
while ($web_accounts_list->{content} =~ m{<li(?:[ ]class="alternate")?>(.*?)</li>}go)
{
  my $line = $1;
  $line =~ m{$accounts_re}go or api_error('accounts-list-item');
  next unless defined $3;
  my $account_details_req = onclick_to_req($accounts_list_form, $1);
  my $name = localize_html_string $2;
  my $no = $3;
  my $operations_req = onclick_to_req($accounts_list_form, $4);
  my $balance = parse_amount $5;
  defined $balance or api_error('accounts-list-balance');
  my $balance_c = $6;
  my $resources = parse_amount $7;
  defined $resources or api_error('accounts-list-resources');
  my $resources_c = $8;
  next if defined $selected_accounts and widen_string($name) !~ m/$selected_accounts/;
  $n_matches++;
  if ($action eq 'list')
  {
    printf "%s\t%32s\t%8.2f %s\t%8.2f %s\n", $name, $no, $balance, $balance_c, $resources, $resources_c;
  }
  elsif ($action eq 'history')
  {
    my $web_operations = download $operations_req;
    my @forms = HTML::Form->parse($web_operations->{response});
    $#forms == 0 or api_error('history-form');
    my ($form) = @forms;
    if (defined $opt_range)
    {
      api_error('history-date') unless $web_operations->{content} =~ m{DateValidator[(]theform[.]daterange_from_day, '19010101', '(\d{4})(\d\d)(\d\d)', '', ''[)]};
      my $now = "$1-$2-$3";
      my ($y, $m, $d) = ground_date($opt_from, $now);
      $form->value('daterange_from_day', $d);
      $form->value('daterange_from_month', $m);
      $form->value('daterange_from_year', $y);
      ($y, $m, $d) = ground_date($opt_to, $now);
      $form->value('daterange_to_day', $d);
      $form->value('daterange_to_month', $m);
      $form->value('daterange_to_year', $y);
      $form->value('rangepanel_group', 'daterange_radio');
    }
    foreach my $input ($form->inputs)
    {
      $input->disabled(1) if defined $input->name and $input->name =~ '^lastdays_(days|period)|ctl[0-9]+$';
    }
    api_error('history-button') unless $web_operations->{content} =~ m{<button id="Submit" onclick="([^"]+)" class="button">};
    my $onclick = $1;
    $web_operations = download onclick_to_req($form, $onclick);
    do_operations($web_operations, $opt_multiple_accounts ? $name : undef);
  }
  elsif ($action eq 'future')
  {
    my $web_operations = download $operations_req;
    next if not $web_operations->{content} =~ m{<a onclick="doSubmit\('/future_operation_list[.]aspx'};
    my $web_future_operations = download POST("$mbank/future_operation_list.aspx");
    my $content = $web_future_operations->{content};
    next if $content =~ m{<p class="message">$messages{future_none}</p>};
    $content =~ m{<div id="future_operation_list" class="grid">(.*)</div>}s or api_error('future-table');
    $content = $1;
    while ($content =~ m{<li(?:[ ]class="alternate")?>(.*?)</li>}go)
    {
      my $line = $1;
      $line =~ m{
        <p[ ]class="Date">
        <span[ ]id="\w+"> (\d{4}-\d\d-\d\d) </span>
        </p>
        <p[ ]class="Customer">
        <a[ ]id="\w+"[ ]title="[^"]+?"[ ]onclick="[^"]+?" [^>]+?> ([^>]+?) </a>
        </p>
        <p[ ]class="OperationDescription">
        <span[ ]id="\w+"> ([^>]+?) </span>
        </p>
        <p[ ]class="Amount">
        <span[ ]id="\w+"> ([0-9, ]+) [ ] ([A-Z]+) </span>
        </p>
        <p[ ]class="OperationStatus">
        <span[ ]id="\w+"> ([^>]+?) </span>
        </p>
      }x or api_error('future-item');
      my $date = $1;
      my $receiver = localize_html_string $2;
      my $title = localize_html_string $3;
      $title =~ y/\xa0/ /;
      my $amount = parse_amount $4;
      defined $amount or api_error('future-amount');
      my $currency = $5;
      my $status = localize_html_string $6;
      printf "$name\t", $name if $opt_multiple_accounts;
      printf "%s\t%s\t%s\t%8.2f %s\t%s\n", $date, $receiver, $title, $amount, $currency, $status;
    }
  }
  elsif ($action eq 'withholdings')
  {
    my $web_operations = download $operations_req;
    next if not $web_operations->{content} =~ m{<a onclick="doSubmit\('/witholdings_list.aspx'};
    my $web_withholdings = download POST("$mbank/witholdings_list.aspx");
    my $withholding_re = qr{
      <span[ ]id="\w+"> (\d\d)-(\d\d)-(\d{4}) </span>   .*?
      <span[ ]id="\w+"> (\d\d)-(\d\d)-(\d{4}) </span>   .*?
      <span[ ]id="\w+"> ([0-9, ]+) \s+ ([A-Z]+) </span>   .*?
      <span[ ]id="\w+"> ([^>]+?) </span>
    }x;
    while ($web_withholdings->{content} =~ m{$withholding_re}go)
    {
      my $reg_date = "$3-$2-$1";
      my $fin_date = "$6-$5-$4";
      my $amount = parse_amount $7;
      defined $amount or api_error('withholdings-amount');
      my $currency = $8;
      my $title = localize_html_string $9;
      printf "$name\t", $name if $opt_multiple_accounts;
      printf "%s\t%s\t%8.2f %s\t%s\n", $reg_date, $fin_date, $amount, $currency, $title;
    }
  }
  elsif ($action eq 'rename')
  {
    my $web_contract = download $account_details_req;
    my @forms = HTML::Form->parse($web_contract->{response}, charset => WEB_CODESET);
    $#forms == 0 or api_error('rename-form');
    my ($form) = @forms;
    $web_contract->{content} =~ m{
      <button[ ]onclick="([^"]*)"[ ]class="button">
      $messages{account_rename}
      </button>
    }x or api_error('rename-button');
    my $web_rename = download onclick_to_req($form, $1);
    @forms = HTML::Form->parse($web_rename->{response});
    $#forms == 0 or api_error('rename-submit');
    ($form) = @forms;
    $form->value('tbVarPartAccName', $new_account_name);
    $web_rename->{content} =~ m{
      <button[ ]id="(Confirm)"[ ]onclick="([^"]*)"[ ]class="button">
      $messages{account_rename_confirm}
      </button>
    }x or api_error('rename-confirm');
    my ($submit, $onclick) = ($1, $2);
    $form->value($submit, undef);
    $web_rename = download onclick_to_req($form, $onclick);
    $web_rename->{content} =~ m{<p class="message">$messages{account_rename_successful}</p>} or api_error 'RenameAfter';
  }
}

if ($n_matches == 0)
{
  user_error('No such account name');
}

# vim:ts=2 sw=2 et fenc=utf-8