From b12de37f9480c68b1c8b033da18c3cc0d0ebc8f0 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>
Signed-off-by: Mike Rylander <mrylander@gmail.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