From 7b3904176b9d0dada9d8d8daebf21a8abab4c72d Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 31 Jan 2013 20:21:05 -0800 Subject: [PATCH] initial version --- CardFortress.pm | 108 ++++++++++++++++++++++++++++++++++++++++---------------- Changes | 4 +-- 2 files changed, 79 insertions(+), 33 deletions(-) diff --git a/CardFortress.pm b/CardFortress.pm index 3690f1c..33b7ee1 100644 --- a/CardFortress.pm +++ b/CardFortress.pm @@ -99,13 +99,12 @@ sub format_request { # things that get encoded in the batch: $batch->gateway($self->gateway); $batch->gateway_opts($self->gateway_opts); - $self->serialize($batch); # that's all folks + $batch; } sub parse_response { my $self = shift; my $input = shift; - my $batch = $self->deserialize($input); } package Business::BatchPayment::CardFortress::Batch; @@ -130,14 +129,18 @@ extends 'Business::BatchPayment::Transport::HTTPS'; with 'Business::BatchPayment::TestMode'; use File::Slurp; +use Data::Dumper; +use Try::Tiny; use MIME::Base64; use Crypt::OpenSSL::RSA; +local $Data::Dumper::Useqq = 1; # because encryption keys will be unprintable + has '+host' => ( default => sub { my $self = shift; - $self->test_mode ? 'gw.cardfortress.com' - : 'test.cardfortress.com' + $self->test_mode ? 'test.cardfortress.com' + : 'gw.cardfortress.com' }, lazy => 1, ); @@ -146,49 +149,93 @@ has ['login', 'password', 'private_key'] => (isa => 'Str', is => 'rw'); has 'serializer' => ( handles => [qw(serialize deserialize)] ); +sub https_post { + # simplify this a little + my ($self, $path, $args) = @_; + warn "Sending to $path\n" if $self->debug; + $args ||= {}; + warn Dumper($args)."\n\n" if $self->debug >= 2; + $args = { + content => $self->serialize($args), + login => $self->login, + password => $self->password + }; + my ($page, $response, %reply_headers) = Net::HTTPS::Any::https_post( + host => $self->host, + port => $self->port, + path => $path, + args => $args, + debug => 0, + ); + die "Bad response from server: $response\n" if $response !~ /^200/; + warn "$response\n" if $self->debug; + my ($result, $error); + try { + $result = $self->deserialize($page); + } catch { + # Storable error messages are useless. + $error = "Bad data from server:\n$page\n"; + }; + warn Dumper($result)."\n\n" if $self->debug >= 2; + $error ||= $result->{error} if ref $result eq 'HASH'; + die "$error\n" if $error; + + $result; +}; + sub upload { my ($self, $content) = @_; warn "Sending batch...\n" if $self->debug; - my ($page, $response, %reply_headers) = - $self->https_post('/batch/submit', { - login => $self->login, - password => $self->password, - content => $content, - }); - $page = $self->deserialize($page); - die $page->{error} if $page->{error}; - my $batchid = $page->{batchid}; + my $result = $self->https_post('/batch/submit', $content); + die $result->{error} if $result->{error}; + my $batch_id = $result->{batch_id}; my $private_key = read_file($self->private_key) or die "No private key available"; my $rsa = Crypt::OpenSSL::RSA->new_private_key($private_key); my %answers; - foreach my $item (@{ $page->{items} }) { + foreach my $item (@{ $result->{items} }) { if ( $item->{error} ) { # We have no reliable way to report an error in a specific transaction # at this stage. The server will send the error in the reply batch. # For now do nothing. } elsif ( $item->{challenge} ) { my $challenge = $item->{challenge}; - $answers{ $item->{tid} } = $rsa->decrypt( decode_base64($challenge) ); - } else { - # newly created card--doesn't have a challenge, so do nothing + $answers{ $item->{tid} } = $rsa->decrypt($challenge); } } # post the response warn "Answering cryptographic challenge...\n" if $self->debug; - my $answer_content = - $self->serialize({ batchid => $batchid, answers => \%answers }); - ($page, $response, %reply_headers) = - $self->https_post('/batch/run', { - login => $self->login, - password => $self->password, - content => $answer_content, - }); - $page = $self->deserialize($page); - die $page->{error} if $page->{error}; - return; + $self->https_post('/batch/run', { batch_id => $batch_id, answers => \%answers}); +} + +sub download { + my $self = shift; + warn "Fetching batch index...\n" if $self->debug; + my $result = $self->https_post('/batch/status'); + + my @batches_in_transit; + foreach (@{ $result->{batches} }) { + if ( $_->{status} eq 'received' ) { + push @batches_in_transit, $_->{batch_id}; + } + } + return if scalar(@batches_in_transit) == 0; + $result = $self->https_post('/batch/receive', + { batch_id => \@batches_in_transit }); + # this shouldn't contain errors, since the server just told us + # that the batches exist... + foreach (@$result) { + if ( $_->{error} ) { + die "Error receiving batch: ".$_->{error}."\n"; + } + } +# $self->https_post('/batch/close', { +# login => $self->login, +# password => $self->password, +# batch_id => \@batches_in_transit, + @$result; } =head1 AUTHOR @@ -201,7 +248,8 @@ You can find documentation for this module with the perldoc command. perldoc Business::BatchPayment::CardFortress -Commercial support is available from Freeside Internet Services, Inc. +For information about the CardFortress system, contact Freeside Internet +Services, Inc. L @@ -209,7 +257,7 @@ L =head1 LICENSE AND COPYRIGHT -Copyright 2012 Mark Wells. +Copyright 2013 Mark Wells. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published diff --git a/Changes b/Changes index 8e4fd70..803e94d 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,3 @@ Revision history for Business-BatchPayment-CardFortress -0.01 Date/time - First version, released on an unsuspecting world. - +0.01 unreleased -- 2.11.0