view release on metacpan or  search on metacpan

OCV.pm  view on Meta::CPAN

package OCV;

# Ingenico Online Credit Verification Server interface
######################################################################
# 
# UNSW Online Payment System (OPS) Server
#  (c) 1999/2000 University of NSW
# 
# Written by Benjamin Low <ben@snrc.uow.edu.au>
#
#
# OVERVIEW OF THE OCV "PROTOCOL"
#
#  The OCV 'protocol' is generally a command-response message exchange, 
# initiated by the client.  That is, a request message is sent to the
# server and the server returns an appropriate response message, after
# some delay.
#
#  An exception to the command-response sequence is for certain message
# types where a "polled mode" is available. When in "polled mode" the
# server does not send a response and the client must poll the server to
# ascertain the transaction status. Note that this "polled mode" does not
# mean the socket is non-blocking, just the application (i.e. "polled mode"
# simply determines whether the client should expect a response). Whenever
# a response is expected, this client waits for the response up to a
# given timeout period before returning an error to the application. When
# such an error occurs, the communications channel is in an undefined state 
# and should be reset (see the OCV::reset method).
#
#  The OCV 'protocol' is stateless, that is all messages contain
# sufficient information to fully determine the request. Thus you may
# connect and disconnect to the OCV server at will. For a given client
# (account), some of the required information will be constant (e.g.
# account number, client id). This module is intended to be used as one
# OCV object instance per client/acount: it "wraps" the protocol such
# that the client ID, account number (and transaction ID as required) are
# automatically supplied for each request and the application only need 
# supply the 'per-transaction' date (e.g. card details, amount).
#
#  The OCV protocol is STREAM based (i.e. TCP/IP). Thus this client 
# conceivably may not send nor receive messages atomically - messages 
# may be fragmented across reads (and writes). At present, this is not 
# accounted for, and will result in an error.
# TODO There is some guarantee regarding minimum block sizes, around 8k
# as I recall. I need to check this. The implications are that under
# high load (when buffers back up), we may start getting incomplete
# messages.
#
# Future Work:
#  - determine message fragmentation issue
#  - split out networking into a separate object, so objects for 
#    multiple clients/accounts can share connections to the server
#
# THIS OCV MODULE
# 
#  This module provides an object-oriented means of transacting with the
# OCV server. An 'OCV' object is used to converse with the server, it
# provides a method corresponding to each of the OCV message types.
# Transaction results (RESPONSEs) are returned as OCV::Message objects.
# The OCV::Message object is simply a blessed array reference, so you can
# use it as you would a simple array ref (e.g. $m->[3] to get the fourth
# element).  However, the OCV::Message object provides by-name access to
# its contents so you can say $m->Result without concerning yourself with
# which array element is the Result field.
#
# [There is a small performance penalty for using the OCV::Message
# interface - benchmarking a simplified version of the ::Message object
# shows it takes approx. ~60-70% longer than using a plain array
# (reference) (a bit over half of that seems to be in the method call to 
# the constructor). There may also be a memory usage penalty, but I've
# no easy way of checking that... Given that we're talking on the order
# of milliseconds (and perhaps bytes/kb), I've chosen to ignore this
# overhead - internally, all messages are contained in OCV::Message
# objects.]
#
#  Transaction messages (i.e. purchase, refund, etc - those messages 
# involving the bank) carry all required information in the message. In 
# particular, each Transaction message contains the Account number to use, 
# which in turn maps within the OCV to a given Merchant ID. This module 
# is designed to have one OCV object instance for each 'client', and thus 
# the Account number and Client ID are required in the constructor and 
# automatically supplied with each message. (They can be overridden per
# request if required).
#
#  BTW, most of the terminology used herein is based on that contained in 
# the OCV Developer's Specification. Personally, I find some of the terms 
# less than clear, however for the sake of consistancy I have followed the 
# spec, attempting to clarify any ambiguities in my own terms.
#
# LOGGING
#
#  An log of each 'transaction' message exchange with the OCV server is 
# written to a file given in the object constructor ("TxnLog" parameter). 
# The fields in this log are separated by a configurable character, the 
# default is ',' (warning: there is no 'safe' character guaranteed to not be 
# contained in an OCV message, so keep an eye out for "extra" fields :-).
# In addition to this transaction log, there is a server debug log ("DebugLog").
# The debug log is used to dump pretty well all the 'raw' data sent and
# receieved to/from the OCV server, plus other odds and sods. Debugging is
# turned off and on via the 'debug' constructor argument and debug() method, 
# and is off by default. NOTE that the debug flag also controls general 
# program debugging via carp (to recap, the debug log is for OCV interactions, 
# STDERR (via carp) is used for general program debugging).
#
#  The logreopen() method will reopen the log file/s, which you might
# want to do in response to a signal (also see reset()).
#
#  WARNING: when debugging is turned on sensitive data could potentially 
# be disclosed (e.g. card data within a purchase transaction message). 
# To prevent such data being logged, the logdebug message filters it's 

OCV.pm  view on Meta::CPAN

	$self->logdebug('Closing connection');

	$@ = "no IO object", return undef
		unless $self->{'io'};

	$self->{'sel'}->remove($self->{'io'});	# remove handle from IO::Select

	$@ = "could not close connection: $!", return undef
		unless $self->{'io'}->close();

	$self->{'disconnected'} = 1;

	return 1;
}

sub ping
# try and confirm the server connection is alive
{
	my $self = shift;

	$@ = "not connected", return undef unless $self->{'io'}->connected;

	# there isn't an OCV 'noop' command, use a simple stats request
	# - result should be a statistics array, or error
	return ($self->statistics(SubCode => STATS_PERMANENT));
}

sub DESTROY
{
	my $self = shift;
	# sometimes the IO and other 'sub-objects' seem to have been cleaned up
	# TODO - figure out why
	#warn "$self = \n", 
	#	map {my $s = $self->{$_} || '-'; $s =~ s/[\x00-\x1f\x7f-\xff]/?/g; 
	#	"\t$_ => $s\n"} keys %{$self};
	{
	local $^W = 0;	# ignore IO::Socket warnings
	$self->disconnect(@_) if (!$self->{'disconnected'} and 
		$self->{'io'} and $self->{'io'}->connected);
	}
}

sub open  { shift->   connect(@_); }
sub close { shift->disconnect(@_); }

sub flush
# try and resynchronise the connection by dumping all pending input
# - probably better to close and (re-)open (see reset method)
{
	my $self = shift;
	my $buf;
	while ($self->{'sel'}->can_read(0) and $self->{'io'}->sysread($buf, 8192))
	{
		$self->logdebug("flush: discarding [$buf]");
	}
	"\000";	# true, but "silent" (mainly for the ocv command line util)
}

sub _send
# assumes data is not fragmented
{
	my $self = shift;

	$@ = "send: not connected", return undef unless $self->{'io'}->connected;

	$@ = "send: timeout", return undef 
		unless $self->{'sel'}->can_write($self->{'timeout'});

	# see logdebug() re. logging of sensitive data
	$self->logdebug(sprintf("send:     %3d [%s]", length($_[0]), $_[0]));

	my $r;
	eval
	{
		local $SIG{__WARN__} = 'IGNORE';
		local $SIG{ALRM} = sub { die "timeout\n" };
		alarm ($self->{'timeout'});
		$r = $self->{'io'}->syswrite($_[0], length($_[0]));
		alarm (0);
	};
	chomp ($@), $@ = "send: syswrite: $@", return undef if $@;


	$@ = "send: error: $!", return undef unless defined($r);

	return $r;
}

sub _recv
# arguments (buf, len): reads len bytes into buf
# assumes data is not fragmented - i.e. if we ask for N bytes, we get N bytes,
# or an error
# - I don't do a dual-read (i.e. read header, extract message length, read
#   the rest of the message). I couldn't see the point: once the message
#   exchange sequence is messed up, I can no longer trust it.
{
	my $self = shift;

	$@ = "recv: not connected", return undef unless $self->{'io'}->connected;

	$@ = "recv: timeout", return undef 
		unless $self->{'sel'}->can_read($self->{'timeout'});

	my $r;
	eval
	{
		# why do I always feel queasy when it comes to signals under perl :-)
		local $SIG{__WARN__} = 'IGNORE';
		local $SIG{ALRM} = sub { die "timeout\n" };
		alarm ($self->{'timeout'});
		$r = $self->{'io'}->sysread($_[0], $_[1]);
		alarm (0);
	};
	chomp ($@), $@ = "recv: sysread: $@", return undef if $@;

	$self->logdebug(sprintf("recv: %3d/%3d [%s]", length($_[0]), $_[1], 
		$_[0]));

	$@ = "recv: error: $!", return undef unless defined($r);

	# if I listened for something, it's because I was expecting something
	# - fail on EOF
	#$@ = "recv: end of file", return undef unless length($_[0]);
	$@ = "recv: end of file", return undef unless $r;

	$@ = "recv: short read: wanted [$_[1]], got [$r]", return undef 
		unless $r == $_[1];

	return $r;
}

sub _message
# send a message, and receive a response if required
# - returns the message response as an OCV::Message object
# - if the Request(Response) message is undef, no data is sent (received)
#   - this is useful for "partial" messages (see totals() for example)
#   - if no response is required, simply returns true on success
# - consistancy check: if $check is != 0, the ClientID of the recieved 
#   message is compared against the args ->{ClientID} and any mismatch
#   flagged as an error
#   - the default is to check all tx/rx sequences, but not to check
#     if we're just receiving (i.e. partial receives)
# - returns undef on error
{
	my ($self, $args, $mtx, $mrx, $check) = @_;
	# consistancy check: nothing to check if we're just receiving
	$check = defined($mtx) unless defined $check;

	$@ = "unknown Request message [$mtx]", return undef
		if (defined($mtx) and not exists $Requests{$mtx});
	$@ = "unknown Response message [$mrx]", return undef