#!/usr/bin/perl -w
#######################################################################
#
# A Perl script for accessing the web site of Bank HaPoalim
# (https://www.bankpoalim.co.il).
#
#######################################################################
#
# Copyright (C) 2001 Dan Kenigsberg (danken@cs.technion.ac.il)
# License: GNU GPL *with the following exception*
#   GPL Exception: This script may not be used to access the Poalim site against
#   their will. If that bank decides to prohibit mechanized access to its site,
#   you must stop using this script and its derivatives, no matter how silly it
#   sounds to you.
# Attention: Accessing your bank account is dangerous. You must never do it
#   from an untrusted computer, such as a university or company
#   system. Always remember that doing so is at least as bad as giving your bank
#   password to your system administrator. According to the bank rules you may
#   be liable to everything that is done with your password, including the
#   transferring of your meager salary to the account of Shari Arison.
#   ##!! Of course, NO WARRENTY is granted !!##
# Special thanks: to Nadav Har'el and his sendsms script.
#
# Version 0.2.1 [1/5/2003]
#
#######################################################################
#
# Installation instructions:
# 1. You would probably have to install the following perl libraries:
#      Crypt-SSLeay-0.35, HTML-Tree-3.11,
#    and probably few others that came with my RH72 Linux distribution.
#    (the version numbers are the ones I have - later versions should be ok)
#    Get them from www.cpan.org, if you don't have them.
#    Change the "BEGIN" line below to list the directory where you installed
#    these libraries (or remove that line altogether if you installed them
#    in the system's official Perl directory, or if you prefer setting the
#    evironment variable PERLLIB appropriately).
#
# 2. You most certainly have to know your Poalim userid (zx123456), id (the one
#    you get when you are born), and password. Set $USERID and $ID accordingly,
#    or use the -u, -i and -p command-line parameters.
#
#######################################################################
#
# Versions history:
# 0.1beta - Initial version
# 0.1beta2 - Some tables in the site changed places.
# 0.2 - warn when needs to change passwd.
# 0.2.1 - few updates
#
$DEBUG=0;

use Getopt::Std;

# process command line options:

my %opts;

if(!getopts('u:i:p:lL', \%opts) || $#ARGV+1 != 0){
        print STDERR "Usage: $0 [-u userid] [-i id] [-p password] [-l(ast only)] [-L(atin last)]\n";
        exit 1;
}

#######################################################################
### User-specific information
#DON'T FORGET TO CONFIGURE THIS! (see instructions above)
my ($USERID, $PASSWORD, $ID);
#$ID='';
#$USERID='';
#######################################################################
$USERID = $opts{u} if exists($opts{u});
$ID = $opts{i} if exists($opts{i});
if (!exists($opts{p}) && !exists($ENV{PASSWORD})) {
  print "Password: ";
  system("stty -echo");
  $PASSWORD = <STDIN>;
  chomp $PASSWORD;
  system("stty echo");
  print "\n";
} else {
  $PASSWORD = $ENV{PASSWORD};
  $PASSWORD = $opts{p} if exists($opts{p});
}

my $p = new Poalim;
$p->connect($USERID, $PASSWORD, $ID) or die "cannot connect.\n";
print "connected...\n" if $DEBUG;
print "first frame received\n" if ($p->get_first_frame() && $DEBUG);

if (exists($opts{l})) {
  print "*passwd* " if $p->{chng_passwd};
  print $p->get_last_trans(), "\n";
  exit 0;
} 

# transliterate
if (exists($opts{L})) {
  $_ = $p->get_last_trans();
  tr/אבגדהוזחטיךכלםמןנסעףפץצקרשת/abgdhvzx\@ykklmmnns&ppccqr\$t/;
  print "*passwd* " if $p->{chng_passwd};
  print $_, "\n";
  exit 0;
} 

#recent transactions
print $p->get_poalim_table("Last60Transactions", '0.1.0.5.2.1.0.0'), "\n";
#split stocks
print $p->get_poalim_table("SplitStock", '0.1.0.5.1.3.0.1'), "\n";
#deposit balance
#print $p->get_poalim_table("DepositBalance", '0.1.0.5.1.3.0.3'), "\n";
#detailed portfolio
print $p->get_poalim_table("ShiaruchStocks&PerutTik", '0.1.0.5.1.3.0.4'), "\n";
#credit card
print $p->get_poalim_table("CurrCCNewSummary", '0.1.0.5.1.3.0.3' ), "\n";

#detailed info for the specified niar erekh
#$p->get_niar('');
print 'Last login: ', $p->{lastlogin}, "\n";
#######################################################################
# tables that I still don't know their address:
#PrevCCSummary RikuzItrotKolel DebitInst RikuzHacnasat ChekimLemishmeretItrot
#Pery ForeignDeposits SavingsPlan KupotGimel BusinessResultsInSellStocks
#HistoryStocks Position LastForeign MatachTran ForeignDeposits MatachPikadon
#ForeignLoan AvgXchgRates RatesMitztalbim LatestExchangeRates
#######################################################################
{
  package Poalim;

  use LWP::UserAgent;
  use URI::Escape;
  use HTTP::Cookies;
  use HTML::TreeBuilder;

  sub new {
    my $p = {};
    $p->{connected}=0;
    $p->{ua} = new LWP::UserAgent;
    $p->{ua}->agent("NyhMessegila/1.0");

    return bless $p; 
  }

  sub connect {
    my ($self, $uid, $passwd, $id) = @_;
    my $req = new HTTP::Request POST => 
    	"https://www.bankpoalim.co.il:443/cgi-bin/poalwwwc";
    $req->content_type('application/x-www-form-urlencoded');
    $req->content("userid=".uri_escape($uid, '^A-Za-z0-9')."&".
    	      "inputSend=".uri_escape("כניסה לחשבונך", '^A-Za-z0-9')."&".
    	      "password=".uri_escape($passwd, '^A-Za-z0-9')."&".
    	      "id=".uri_escape($id)."&".
    	      "language=HE"."&".
    	      "reqName=performLogon"."&"
                  );
    $req->header('Accept' => 'text/html');
    my $res = $self->{ua}->request($req);

    $self->{cookie_jar} = HTTP::Cookies->new;
    $self->{cookie_jar}->extract_cookies($res);
    
    #print "GGG relocation in\n";
    #print $res->content, "\n";
    #print $res->as_string, "\n";

    die "Install https support before using this script\n" if ($res->as_string =~ m/Protocol scheme 'https' is not supported/);

    # TODO: check if everything is fine, I should receive a 302 "error"
    # relocation message
    if ($res =~ m/\.היוגש השקוהש המסיסה/) {
      print STDERR "Wrong password.";
      return 0;
    }
    if ($res->content() =~ m/ינמז ןפואב תורישל םכתשיג המסחנ/) {
      print STDERR "You are temporarily blocked from the service\n";
      return 0;
    }
    # we should be relocated to https://www.bankpoalim.co.il/cgi-bin/poalwwwc?
    #   reqName=MainFrameSet&language=HE
    if (!$res->headers->header('Location') || 
         $res->headers->header('Location') !~
                    m/https:\/\/www\.bankpoalim\.co\.il\/cgi-bin/) {
      print STDERR "Login failed\n";
      return 0;
    }
    $self->{connected}=1;
    $self->{lastlogin}=0;
    $self->{chng_passwd}=0;
    return 1;
  }

  sub disconnect {
    my $self = shift;

    my $req = new HTTP::Request GET => 
		"https://www.bankpoalim.co.il/cgi-bin/poalwwwc?".
		"token=1&language=HE&reqName=Logoff";
    $req->content_type('application/x-www-form-urlencoded');
    $req->header('Accept' => 'text/html');
    $self->{cookie_jar}->add_cookie_header($req);
    $res = $self->{ua}->request($req);
    print "disconnecting...\n" if $main::DEBUG;
    $self->{connected}=0;
  }

  sub DESTROY {
    $_[0]->disconnect() if $_[0]->{connected};
  }

  sub get_last_trans {
    my $self = shift;
    my (@rows, @cols);
    @rows = split "\n", $self->get_poalim_table("Last60Transactions", 
						'0.1.0.5.2.1.0.0');
    @cols = split "\t", $rows[$#rows];
 
    # TODO: when $cols[1] or $cols[2] is empty it is really 0xA0. Why is that?
    # how can this be averted?
    my $amm;
    if ($cols[1] =~ m/\d/) {$amm = $cols[1]} else {$amm='-'.$cols[2]}
    return $cols[0].": ".$amm.': '.$cols[3].': '.$cols[5];
  }

  sub get_poalim_table {
    my ($self, $transaction, $address) = @_;
    my $param;
    ($transaction, $param) = split "&", $transaction;
    $param = "" if !defined($param);
    return $self->get_table("https://www.bankpoalim.co.il/cgi-bin/poalwwwc?".
    	"&reqName=action&language=HE&transactionId=$transaction&".
    	"subMenuName=&menuParam=$param&usm=yes", $address);
  }

  sub get_table {
    my ($self, $url, $address) = @_;

    $req = new HTTP::Request GET => $url;
    $req->content_type('application/x-www-form-urlencoded');
    $req->header('Accept' => 'text/html');
    $self->{cookie_jar}->add_cookie_header($req);
    $res = $self->{ua}->request($req);

    # TODO: check if $res->is_success
    my $tree = HTML::TreeBuilder->new();
    $tree->parse($res->content);
    $tree->eof;
    
    # if no adress is given, dump the tree (very usefull for debug).
    if (!$address) {
      $tree->dump;
      return "no address";
    }

    # if this is the first query, extract last login date
    if (!$self->{lastlogin}) {
      my $lastlog_addr = '0.1.0.9.1.0.0.0.0';
      my $tmp = $tree->address($lastlog_addr.'.3');
      if (!$tmp) {
        $lastlog_addr = '0.1.0.5.1.0.0.0.0';
        $tmp = $tree->address($lastlog_addr.'.3');
      }
      if (!$tmp) {
	print "failed to read last login time\n" if $main::DEBUG;
      } else {
        my $d = $tmp->as_text();
        my $t = $tree->address($lastlog_addr.'.1')->as_text();
        $self->{lastlogin} = $d.'.'.$t;
      }
    }

    my $transtable = $tree->address($address);
    if (!$transtable) {
      print STDERR "Cannot find address $address in url $url\n";
      $tree->dump if $main::DEBUG;
    }
    
    my ($row, $td, @tds, @rows);
    @rows = ();
    foreach $row ($transtable->content_list()) {
      @tds = ();
      foreach $td ($row->content_list()) {
        push @tds, $td->as_text()
      }
                                 # remove deeper references to tables
#      @tds = grep {! ref} @tds; # no need for that now
      push @rows, (join "\t", @tds);
    }
    return (join "\n", @rows);
  }
  
  sub get_niar {
    my ($self, $niar) = @_;

    $req = new HTTP::Request GET => "https://www.bankpoalim.co.il/cgi-bin/poalwwwc?transactionId=InfoNiar&reqName=action&numberNiar=$niar";
    $req->content_type('application/x-www-form-urlencoded');
    $req->header('Accept' => 'text/html');
    $self->{cookie_jar}->add_cookie_header($req);
    $res = $self->{ua}->request($req);
    
    #print "GGG ", $req->as_string(), "GGG\n";
    #my $tree = HTML::TreeBuilder->new();
    #$tree->parse($res->content);
    #$tree->eof;
    #    $tree->dump;
    # TODO avoid using lynx - do the dump myself.
    open(LYNX, "| lynx -stdin -force_html -dump -assume_charset=ISO-8859-8 -display_charset=ISO-8859-8") or die "Cannot execute lynx";
    print LYNX $res->content();
#    print STDERR $res->content();
    close(LYNX)
  }

  sub get_first_frame {
    my ($self) = @_;

    $req = new HTTP::Request GET => "https://www.bankpoalim.co.il/cgi-bin/".
                  "poalwwwc?reqName=MainFrameSet&language=HE";
    $req->content_type('application/x-www-form-urlencoded');
    $req->header('Accept' => 'text/html');
    $self->{cookie_jar}->add_cookie_header($req);
    $res = $self->{ua}->request($req);

# dealing with "רשפאה לככ םדקומ ךתמסיס תא ףלחה"
    if ($res->as_string =~ m/תעכ ךתמסיס תא ףילחהל ךנוצרב םאה/) {
      print STDERR "should change password.\n";
      $self->{chng_passwd}=1;
    }
    return 1;
  }
}