view release on metacpan or  search on metacpan

lib/Finance/Bank/Postbank_de/APIv1.pm  view on Meta::CPAN

Finance::Bank::Postbank_de::APIv1 - Postbank connection

=head1 SYNOPSIS

    my $api = Finance::Bank::Postbank_de::APIv1->new();
    $api->configure_ua();
    my $postbank = $api->login( 'Petra.Pfiffig', '11111' );

=cut

has diagnostics => (
    is => 'ro',
    default => undef,
);

has logger => (
    is => 'rw',
    default => undef,
);

has ua => (
    is => 'ro',
    default => sub( $self ) {
        my $ua = WWW::Mechanize->new(
            autocheck  => 0,
            keep_alive => 1,
            cookie_jar => HTTP::CookieJar::LWP->new(),
        );

        if( $self->diagnostics ) {
            require LWP::ConsoleLogger::Easy;
            my $logger = LWP::ConsoleLogger::Easy::debug_ua( $ua );
            $logger->dump_content(0);
            $logger->dump_text(0);
            $self->logger($logger);
        };
        $ua
    }
);

has config => (
    is => 'rw',
);

has certificate_subject => (
    is => 'ro',
    default => sub {
        +{
                                    #/jurisdictionC=DE/jurisdictionST=Nordrhein-Westfalen/jurisdictionL=Bonn/businessCategory=Private Organization/serialNumber=HRB6793/C=DE/postalCode=53113/ST=Nordrhein-Westfalen/L=Bonn/street=Friedrich Ebert Allee 1...
            #meine_postbank_de => qr{^/(?:\Q1.3.6.1.4.1.311.60.2.1.3\E|jurisdictionC|jurisdictionCountryName)=DE/(?:\Q1.3.6.1.4.1.311.60.2.1.2\E|jurisdictionST|jurisdictionStateOrProvinceName)=Nordrhein-Westfalen/(?:\Q1.3.6.1.4.1.311.60.2.1.1\E|juris...
            api_public_postbank_de => qr{^/(?:\Q2.5.4.15\E|businessCategory)=Private Organization/(?:\Q1.3.6.1.4.1.311.60.2.1.3\E|jurisdictionC|jurisdictionCountryName)=DE/(?:\Q1.3.6.1.4.1.311.60.2.1.2\E|jurisdictionST|jurisdictionStateOrProvinceName...
        },
    },
);

sub diagnoseCertificateError( $self, $error=$@ ) {
    my( $found, $re ) = ($error =~ m#'(.+?)' !~ /\Q(?^:\E(.+?)/ at #)
        or die "$error"; # reraise
    warn $found;
    warn $re;
    my @found_parts = split m!/!, $found;
    my @re_parts = split m!/!, $re;

    for my $i (0..$#re_parts ) {
        if( $found_parts[ $i ] =~ $re_parts[ $i ]) {
            warn "'$found_parts[ $i ]' =~ /$re_parts[ $i ]/, OK\n";
        } else {
            warn "'$found_parts[ $i ]' !~ /$re_parts[ $i ]/, not OK\n";
        };
    };
    die "Certificate mismatch";
}

sub fetch_config( $self ) {
    # Do an initial fetch to set up cookies
    my $ua = $self->ua;
    $self->configure_ua_ssl;
    #my $re = join "|", values %{ $self->certificate_subject };
    #$ua->add_header(
    #    "If-SSL-Cert-Subject" => qr/$re/,
    #);
    eval {
        $ua->get('https://meine.postbank.de');
        $ua->get('https://meine.postbank.de/configuration.json');
    };
    if( my $err = $@ ) {
        $self->diagnoseCertificateError( "$@ ");
    };
    my $config = decode_json( $ua->content );
    if( ! exists $config->{ 'iob5-base' }) {
        require Data::Dumper;
        croak "Invalid config retrieved: " . Data::Dumper::Dumper($config);
    };
    $self->config( $config );
    $config
}

sub configure_ua_ssl( $self, $ua=$self->ua ) {
    # OpenSSL 1.0.1 doesn't properly scan the certificate chain as supplied
    # by Mozilla::CA, so we only verify the certificate directly there:
    my @verify;

    if( IO::Socket::SSL->VERSION <= 1.990 ) {
        # No OCSP support
        @verify = ();
    } elsif( Net::SSLeay::SSLeay() <= 0x100010bf ) { # 1.0.1k
        @verify = (
            SSL_fingerprint => 'sha256$99043D1F58197BDDFAEA3F914A8693588B067D7DC85BF532D7B773A9ED98F915',
            SSL_ocsp_mode => IO::Socket::SSL::SSL_OCSP_NO_STAPLE(),
        );
    } else {
        # We need no special additional options to verify the certificate chain
        @verify = (
            SSL_ocsp_mode => IO::Socket::SSL::SSL_OCSP_FULL_CHAIN(),
        );
    };
    $ua->ssl_opts(
        SSL_ca_file => Mozilla::CA::SSL_ca_file(),
        SSL_verify_mode => SSL_VERIFY_PEER(),
        @verify,
        #SSL_verify_callback => sub {
            #use Data::Dumper;