From d045034424de0ec2f08ad11f7046f20979275662 Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Wed, 31 Oct 2012 13:38:24 -0700 Subject: [PATCH] SFTP transport and encryption --- MANIFEST | 1 + TD_EFT.pm | 59 +++++++++++++++++++++++++- TD_EFT/Transport.pm | 116 ++++++++++++++++++++++++++++++++++++++++++++++++++++ t/boilerplate.t | 56 ------------------------- 4 files changed, 174 insertions(+), 58 deletions(-) create mode 100644 TD_EFT/Transport.pm delete mode 100644 t/boilerplate.t diff --git a/MANIFEST b/MANIFEST index 16de07f..cca2337 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,5 +1,6 @@ Changes TD_EFT.pm +TD_EFT/Transport.pm Makefile.PL MANIFEST This list of files README diff --git a/TD_EFT.pm b/TD_EFT.pm index c33ad93..494f216 100644 --- a/TD_EFT.pm +++ b/TD_EFT.pm @@ -31,6 +31,14 @@ my $processor = Business::BatchPayment->processor('TD_EFT', return_branch => '10202', # 0004 + 5-digit branch number return_account => '00124598951', # 11 digits cpa_code => '120', + # optional, for SFTP file transport + host => '192.168.100.1', + login => 'mylogin', + password => 'mypassword', + # optional, for encryption + encrypt_cmd => 'compx ASCII DE3', + decrypt_cmd => 'decompx', + encrypt_key => '/path/to/encrypt.key', ); my $result = $processor->submit(@items); @@ -58,6 +66,32 @@ to use for returned payments. =back +=head2 TRANSPORT ATTRIBUTES + +These need to be specified only if you're using the SFTP transport. + +=over 4 + +=item host - SFTP hostname + +=item login - SFTP username + +=item password - SFTP password + +=item encrypt_cmd - Command to use to encrypt/compress batches before +sending. This will be called, somewhat awkwardly, with the name of the +output file inserted as the first argument, and the name of the input +file (the plaintext) passed on standard input. If empty, batches will +be sent as plaintext. + +=item descrypt_cmd - Command to decrypt/decompress downloaded batches. + +=item encrypt_key - File to copy into the working directory before +running encrypt/decrypt commands. COMPX requires the encryption key +to be supplied like this. + +=back + =cut use DateTime; @@ -81,6 +115,13 @@ has 'datacentre' => ( required => 1, ); +has [ qw( login password host encrypt_cmd encrypt_key decrypt_cmd ) ] => +( + is => 'rw', + isa => 'Str', + required => 0, +); # only required for the default transport + sub BUILD { my $self = shift; # should be a parametric string type or something @@ -93,6 +134,21 @@ sub BUILD { unless length($self->return_branch) == 9; } +sub default_transport { + my $self = shift; + Business::BatchPayment->create('TD_EFT::Transport' => + login => $self->login, + password => $self->password, + host => $self->host, + put_path => 'APXBA807/', + debug => $self->debug, + encrypt_cmd => $self->encrypt_cmd, + decrypt_cmd => $self->decrypt_cmd, + encrypt_key => $self->encrypt_key, + ); +} + + before format_request => sub { my ($self, $batch) = @_; #shazam! @@ -372,11 +428,10 @@ use Moose::Role; use List::Util qw(sum); has [qw( create_date fcn )] => ( is => 'rw', isa => 'Str' ); +# XXX use the "totals" method instead has [qw( row total_payment total_credit count_payment count_credit )] => ( is => 'rw', isa => 'Int', default => 0 ); -=back - =head1 AUTHOR Mark Wells, C<< >> diff --git a/TD_EFT/Transport.pm b/TD_EFT/Transport.pm new file mode 100644 index 0000000..7292e9f --- /dev/null +++ b/TD_EFT/Transport.pm @@ -0,0 +1,116 @@ +package Business::BatchPayment::TD_EFT::Transport; + +use File::Temp qw(tempdir); +use File::Slurp qw( read_file write_file ); +use File::Copy; +use IPC::Run qw(run); +use Moose; +extends 'Business::BatchPayment::Transport::SFTP'; + +=head1 ATTRIBUTES + +=over 4 + +=item encrypt_cmd + +Path to the encrypt command, including any options. The name of the +file to encrypt will be passed on standard input, and the name of the +destination file will be inserted after the first (whitespace-separated) +word of the command. This is in deference to compx/Comm-Press/TDClient +conventions. + +=item decrypt_cmd + +Path to the decrypt command, as above. + +=item encrypt_key + +Path to the encryption key. This will be copied to the temp directory +before running encrypt/decrypt commands. + +=cut + +has [ qw( encrypt_cmd encrypt_key decrypt_cmd ) ] => ( + is => 'rw', + isa => 'Maybe[Str]', + required => 0, +); + +sub upload { + my $self = shift; + my $path = $self->put_path; + + my $content = shift; + + # get the batch ID of the content + # (questionable--on the one hand, upload isn't supposed to concern + # itself with the contents of the batch, but on the other hand it + # needs to know what to name the file.) + my $id = substr($content, 20, 4); + + my $tmpdir = tempdir( CLEANUP => 1 ); + chdir($tmpdir); + my $filename = 'update' . $id; + warn "Writing temp file to $tmpdir/$filename\n" if $self->debug; + write_file("$tmpdir/$filename", $content); + if ( $self->encrypt_cmd ) { + warn "Encrypting temp file.\n" if $self->debug; + if ( $self->encrypt_key ) { + copy($self->encrypt_key, "$tmpdir/encrypt.key") + or die "Failed to read encryption key: $!\n"; + } + my @cmd = split(/\s+/, $self->encrypt_cmd); + # insert output file name into command line + splice(@cmd, 1, 0, "$filename.cmp"); + # run(COMMMAND, STDIN, STDOUT) + run(\@cmd, \$filename) or die "Failed to encrypt temp file: $!\n"; + $filename = "$filename.cmp"; + } + warn "Uploading file to $path/$filename\n" if $self->debug; + $self->sftp->setcwd($path); + $self->sftp->put("$tmpdir/$filename", $filename); + chdir('/'); +} + +sub download { + my $self = shift; + my $path = $self->get_path; + + my @batches; + my $tmpdir = tempdir( CLEANUP => 1 ); + chdir($tmpdir); + warn "Fetching list of return files from $path\n" if $self->debug; + $self->sftp->setcwd($path); + my $files = $self->sftp->ls('.', wanted => qr/^APXQA807/, names_only => 1); + if ( !@$files ) { + warn "No files found.\n" if $self->debug; + } + if ( $self->encrypt_key ) { + copy($self->encrypt_key, "$tmpdir/encrypt.key") + or die "Failed to read encryption key: $!\n"; + } + FILE: foreach my $filename (@$files) { + warn "Retrieving file $filename\n" if $self->debug; + $self->sftp->get($filename, "$tmpdir/$filename"); + if ( $self->sftp->error ) { + warn "failed to download $filename: ".$self->sftp->error; + next FILE; + } + $filename = "$tmpdir/$filename"; + if ( $self->decrypt_cmd ) { + my @cmd = split(/\s+/, $self->decrypt_cmd); + splice(@cmd, 1, 0, "$filename.txt"); + if ( !run(\@cmd, \$filename) ) { + warn "Failed to decrypt file: $!\n"; + next FILE; + } + } + push @batches, read_file($filename); + } + chdir('/'); + @batches; +} + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/t/boilerplate.t b/t/boilerplate.t deleted file mode 100644 index 7110c6e..0000000 --- a/t/boilerplate.t +++ /dev/null @@ -1,56 +0,0 @@ -#!perl -T - -use 5.006; -use strict; -use warnings; -use Test::More tests => 3; - -sub not_in_file_ok { - my ($filename, %regex) = @_; - open( my $fh, '<', $filename ) - or die "couldn't open $filename for reading: $!"; - - my %violated; - - while (my $line = <$fh>) { - while (my ($desc, $regex) = each %regex) { - if ($line =~ $regex) { - push @{$violated{$desc}||=[]}, $.; - } - } - } - - if (%violated) { - fail("$filename contains boilerplate text"); - diag "$_ appears on lines @{$violated{$_}}" for keys %violated; - } else { - pass("$filename contains no boilerplate text"); - } -} - -sub module_boilerplate_ok { - my ($module) = @_; - not_in_file_ok($module => - 'the great new $MODULENAME' => qr/ - The great new /, - 'boilerplate description' => qr/Quick summary of what the module/, - 'stub function definition' => qr/function[12]/, - ); -} - -TODO: { - local $TODO = "Need to replace the boilerplate text"; - - not_in_file_ok(README => - "The README is used..." => qr/The README is used/, - "'version information here'" => qr/to provide version information/, - ); - - not_in_file_ok(Changes => - "placeholder date/time" => qr(Date/time) - ); - - module_boilerplate_ok('lib/Business/BatchPayment/TD_EFT.pm'); - - -} - -- 2.11.0