From 9bdf4be6c52eeea9abca8390b14a98f04abf4bdf Mon Sep 17 00:00:00 2001
From: Bill Erickson <berick@esilibrary.com>
Date: Thu, 12 Jan 2012 16:36:16 -0500
Subject: [PATCH] Perl libs for OpenSRF ingress tracking

Ingress is a free-form text value which represents the entry point for
the client into the opensrf network.  The value is passed within opensrf
messages, similar to "locale".  Clients should specify the ingress
before any opensrf communication occurs.

OpenSRF::AppSession->ingress($ingress);

Stock values include the following:

opensrf (default)
srfsh
translator-v1
gateway-v1

Signed-off-by: Bill Erickson <berick@esilibrary.com>
---
 src/perl/lib/OpenSRF/AppSession.pm               |  9 +++++++++
 src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm | 21 ++++++++++++++++++++-
 src/perl/lib/OpenSRF/Transport.pm                |  2 ++
 3 files changed, 31 insertions(+), 1 deletion(-)

diff --git a/src/perl/lib/OpenSRF/AppSession.pm b/src/perl/lib/OpenSRF/AppSession.pm
index c8ee269..d19085f 100644
--- a/src/perl/lib/OpenSRF/AppSession.pm
+++ b/src/perl/lib/OpenSRF/AppSession.pm
@@ -22,6 +22,13 @@ our %EXPORT_TAGS = ( state => [ qw/CONNECTING INIT_CONNECTED CONNECTED DISCONNEC
 
 my $logger = "OpenSRF::Utils::Logger";
 my $_last_locale = 'en-US';
+our $current_ingress = 'opensrf';
+
+sub ingress {
+    my ($class, $ingress) = @_;
+    $current_ingress = $ingress if $ingress;
+    return $current_ingress;
+}
 
 our %_CACHE;
 our @_RESEND_QUEUE;
@@ -499,6 +506,8 @@ sub send {
 
         my $locale = $self->session_locale;
 		$msg->sender_locale($locale) if ($locale);
+
+		$msg->sender_ingress($current_ingress);
 	
 		push @doc, $msg;
 
diff --git a/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm b/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
index 44eafc2..54c5963 100644
--- a/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
+++ b/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
@@ -102,6 +102,24 @@ sub sender_locale {
 	return $self->{locale};
 }
 
+=head2 OpenSRF::DomainObject::oilsMessage->sender_ingress( [$ingress] );
+
+=over 4
+
+Sets or gets the current message ingress.  Useful for telling the
+server how you entered the opensrf network.
+
+=back
+
+=cut
+
+sub sender_ingress {
+	my $self = shift;
+	my $val = shift;
+	$self->{ingress} = $val if $val;
+	return $self->{ingress};
+}
+
 =head2 OpenSRF::DomainObject::oilsMessage->threadTrace( [$new_threadTrace] );
 
 =over 4
@@ -180,10 +198,11 @@ sub handler {
 
 	my $mtype = $self->type;
 	my $locale = $self->sender_locale || '';
+	my $ingress = $self->sender_ingress || '';
 	my $api_level = $self->api_level || 1;
 	my $tT = $self->threadTrace;
 
-    $log->debug("Message locale is $locale", DEBUG);
+    $log->debug("Message locale is $locale; ingress = $ingress", DEBUG);
 
 	$session->last_message_type($mtype);
 	$session->last_message_api_level($api_level);
diff --git a/src/perl/lib/OpenSRF/Transport.pm b/src/perl/lib/OpenSRF/Transport.pm
index cfb7ba9..c295acd 100644
--- a/src/perl/lib/OpenSRF/Transport.pm
+++ b/src/perl/lib/OpenSRF/Transport.pm
@@ -153,6 +153,8 @@ sub handler {
 
 		next unless (	$msg && UNIVERSAL::isa($msg => 'OpenSRF::DomainObject::oilsMessage'));
 
+		OpenSRF::AppSession->ingress($msg->sender_ingress);
+
 		if( $app_session->endpoint == $app_session->SERVER() ) {
 
 			try {  
-- 
2.11.0