From a1e2db00e4a97f33c9f06858660ef7c3944951d5 Mon Sep 17 00:00:00 2001
From: miker <miker@dcc99617-32d9-48b4-a31d-7c20da2025e4>
Date: Tue, 5 Feb 2008 19:34:36 +0000
Subject: [PATCH] adding exporter, new-style auth proxy, and requisite config

git-svn-id: svn://svn.open-ils.org/ILS/branches/rel_1_2@8644 dcc99617-32d9-48b4-a31d-7c20da2025e4
---
 Open-ILS/examples/apache/eg_vhost.conf        |  14 ++
 Open-ILS/examples/apache/startup.pl           |   2 +
 Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm | 342 ++++++++++++++++++++++++++
 Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm    | 181 ++++++++++++++
 4 files changed, 539 insertions(+)
 create mode 100644 Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm
 create mode 100644 Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm

diff --git a/Open-ILS/examples/apache/eg_vhost.conf b/Open-ILS/examples/apache/eg_vhost.conf
index 0a428cbf26..7c42acedf8 100644
--- a/Open-ILS/examples/apache/eg_vhost.conf
+++ b/Open-ILS/examples/apache/eg_vhost.conf
@@ -174,6 +174,20 @@ OSRFGatewayConfig /openils/conf/opensrf_core.xml
 
 	
 # ----------------------------------------------------------------------------------
+# Exporter lives here
+# ----------------------------------------------------------------------------------
+<Location /exporter>
+    SetHandler perl-script
+    PerlSetVar OILSProxyTitle "Exporter Login"
+    PerlSetVar OILSProxyDescription "Please log in to export records"
+    PerlSetVar OILSProxyPermissions "STAFF_LOGIN"
+    PerlHandler OpenILS::WWW::Proxy OpenILS::WWW::Exporter
+    Options +ExecCGI
+    PerlSendHeader On
+    allow from all
+</Location>
+
+# ----------------------------------------------------------------------------------
 # Reporting output lives here
 # ----------------------------------------------------------------------------------
 <Location /reporter/>
diff --git a/Open-ILS/examples/apache/startup.pl b/Open-ILS/examples/apache/startup.pl
index 1f730e84a8..43dace1219 100644
--- a/Open-ILS/examples/apache/startup.pl
+++ b/Open-ILS/examples/apache/startup.pl
@@ -3,6 +3,8 @@ use lib qw( /openils/lib/perl5 );
 use OpenILS::WWW::SuperCat qw( /openils/conf/opensrf_core.xml );
 use OpenILS::WWW::AddedContent qw( /openils/conf/opensrf_core.xml );
 use OpenILS::Reporter::Proxy ('/openils/conf/opensrf_core.xml');
+use OpenILS::WWW::Proxy ('/openils/conf/opensrf_core.xml');
+use OpenILS::WWW::Exporter ('/openils/conf/opensrf_core.xml');
 
 
 # - Uncoment the following 2 lines to make use of the IP redirection code
diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm
new file mode 100644
index 0000000000..d02d4ff623
--- /dev/null
+++ b/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm
@@ -0,0 +1,342 @@
+package OpenILS::WWW::Exporter;
+use strict;
+use warnings;
+use bytes;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(OK REDIRECT DECLINED NOT_FOUND :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use APR::Table;
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil;
+use CGI;
+use Data::Dumper;
+use Text::CSV;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::Utils qw/:datetime/;
+use OpenSRF::Utils::Cache;
+use OpenSRF::System;
+use OpenSRF::AppSession;
+use XML::LibXML;
+use XML::LibXSLT;
+
+use Encode;
+use Unicode::Normalize;
+use OpenILS::Utils::Fieldmapper;
+use OpenSRF::Utils::Logger qw/$logger/;
+
+use MARC::Record;
+use MARC::File::XML;
+
+use UNIVERSAL::require;
+
+our @formats = qw/USMARC UNIMARC XML BRE/;
+
+# set the bootstrap config and template include directory when
+# this module is loaded
+my $bootstrap;
+
+sub import {
+        my $self = shift;
+        $bootstrap = shift;
+}
+
+
+sub child_init {
+        OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+}
+
+sub handler {
+	my $r = shift;
+	my $cgi = new CGI;
+
+	# find some IDs ...
+	my @records;
+
+	@records = map { $_ ? ($_) : () } $cgi->param('id');
+
+	if (!@records) { # try for a file
+		my $file = $cgi->param('idfile');
+		if ($file) {
+			my $col = $cgi->param('idcolumn') || 0;
+			my $csv = new Text::CSV;
+
+			while (<$file>) {
+				chomp;
+				$csv->parse($_);
+				my @data = $csv->fields;
+				my $id = $data[$col];
+				$id =~ s/\D+//o;
+				next unless ($id);
+				push @records, $id;
+			}
+		}
+	}
+
+	if (!@records) { # try pathinfo
+		my $path_rec = $cgi->path_info();
+		if ($path_rec) {
+			@records = map { $_ ? ($_) : () } split '/', $path_rec;
+		}
+	}
+
+	my $ses = OpenSRF::AppSession->create('open-ils.cstore');
+
+	# still no records ...
+	my $container = $cgi->param('containerid');
+	if ($container) {
+		my $authid = $cgi->cookie('ses') || $cgi->param('ses');
+		my $auth = verify_login($authid);
+		if (!$auth) {
+			return 403;
+		}
+		my $recs = $ses->request( 'open-ils.cstore.direct.container.biblio_record_entry_bucket_item.search.atomic', { bucket => $container } )->gather(1);
+		@records = map { ($_->target_biblio_record_entry) } @$recs;
+	}
+
+	return show_template($r) unless (@records);
+
+	my $type = $cgi->param('rectype') || 'biblio';
+	if ($type ne 'biblio' && $type ne 'authority') {
+		return 400;
+	}
+
+	my $tcn_v = 'tcn_value';
+	my $tcn_s = 'tcn_source';
+
+	if ($type eq 'authority') {
+		$tcn_v = 'arn_value';
+		$tcn_s = 'arn_source';
+	}
+
+	my $holdings = $cgi->param('holdings') if ($type eq 'biblio');
+	my $location = $cgi->param('location') || 'gaaagpl'; # just because...
+
+	my $format = $cgi->param('format') || 'USMARC';
+	$format = uc($format);
+
+	my $encoding = $cgi->param('encoding') || 'UTF-8';
+	$encoding = uc($encoding);
+
+	my $filename = $cgi->param('filename') || "export.$type.$encoding.$format";
+
+	binmode(STDOUT, ':raw') if ($encoding ne 'UTF-8');
+	binmode(STDOUT, ':utf8') if ($encoding eq 'UTF-8');
+
+	if (!grep { uc($format) eq $_ } @formats) {
+		return 400;
+	}
+
+	if ($format ne 'XML') {
+		my $ftype = 'MARC::File::' . $format;
+		$ftype->require;
+	}
+
+
+	$r->headers_out->set("Content-Disposition" => "inline; filename=$filename");
+
+	if (uc($format) eq 'XML') {
+		$r->content_type('application/xml');
+	} else {
+		$r->content_type('application/octet-stream');
+	}
+
+	$r->print( <<"	HEADER" ) if (uc($format) eq 'XML');
+<?xml version="1.0" encoding="$encoding"?>
+<collection xmlns='http://www.loc.gov/MARC21/slim'>
+	HEADER
+
+	my %orgs;
+	my %shelves;
+
+	my $flesh = {};
+	if ($holdings) {
+
+		my $req = $ses->request( 'open-ils.cstore.direct.actor.org_unit.search', { id => { '!=' => undef } } );
+
+    		while (my $o = $req->recv) {
+        		next if ($req->failed);
+        		$o = $o->content;
+        		last unless ($o);
+	    		$orgs{$o->id} = $o;
+    		}
+    		$req->finish;
+
+		$req = $ses->request( 'open-ils.cstore.direct.asset.copy_location.search', { id => { '!=' => undef } } );
+
+    		while (my $s = $req->recv) {
+        		next if ($req->failed);
+        		$s = $s->content;
+        		last unless ($s);
+	    		$shelves{$s->id} = $s;
+    		}
+    		$req->finish;
+
+    		$flesh = { flesh => 2, flesh_fields => { bre => [ 'call_numbers' ], acn => [ 'copies' ] } };
+	}
+
+	for my $i ( @records ) {
+    		my $bib;
+    		try {
+        		local $SIG{ALRM} = sub { die "TIMEOUT\n" };
+        		alarm(1);
+	    		$bib = $ses->request( "open-ils.cstore.direct.$type.record_entry.retrieve", $i, $flesh )->gather(1);
+        		alarm(0);
+    		} otherwise {
+        		warn "\n!!!!!! Timed out trying to read record $i\n";
+    		};
+    		alarm(0);
+
+		next unless $bib;
+
+    		if (uc($format) eq 'BRE') {
+        		$r->print( OpenSRF::Utils::JSON->perl2JSON($bib) );
+        		next;
+    		}
+
+		try {
+
+			my $req = MARC::Record->new_from_xml( $bib->marc, $encoding, $format );
+			$req->delete_field( $_ ) for ($req->field(901));
+
+			$req->append_fields(
+				MARC::Field->new(
+					901, '', '', 
+					a => $bib->$tcn_v,
+					b => $bib->$tcn_s,
+					c => $bib->id
+				)
+			);
+
+
+			if ($holdings) {
+        			my $cn_list = $bib->call_numbers;
+        			if ($cn_list && @$cn_list) {
+
+            				my $cp_list = [ map { @{ $_->copies } } @$cn_list ];
+            				if ($cp_list && @$cp_list) {
+
+	            				my %cn_map;
+	            				push @{$cn_map{$_->call_number}}, $_ for (@$cp_list);
+		                        
+	            				for my $cn ( @$cn_list ) {
+	                				my $cn_map_list = $cn_map{$cn->id};
+	
+	                				for my $cp ( @$cn_map_list ) {
+		                        
+								$req->append_fields(
+									MARC::Field->new(
+										852, '4', '', 
+										a => $location,
+										b => $orgs{$cn->owning_lib}->shortname,
+										b => $orgs{$cp->circ_lib}->shortname,
+										c => $shelves{$cp->location}->name,
+										j => $cn->label,
+										($cp->circ_modifier ? ( g => $cp->circ_modifier ) : ()),
+										p => $cp->barcode,
+										($cp->price ? ( y => $cp->price ) : ()),
+										($cp->copy_number ? ( t => $cp->copy_number ) : ()),
+										($cp->ref eq 't' ? ( x => 'reference' ) : ()),
+										($cp->holdable eq 'f' ? ( x => 'unholdable' ) : ()),
+										($cp->circulate eq 'f' ? ( x => 'noncirculating' ) : ()),
+										($cp->opac_visible eq 'f' ? ( x => 'hidden' ) : ()),
+									)
+								);
+
+							}
+						}
+					}
+        			}
+			}
+
+			if (uc($format) eq 'XML') {
+				my $x = $req->as_xml_record;
+				$x =~ s/^<\?xml version="1.0" encoding="UTF-8"\?>//o;
+				$r->print($x);
+			} elsif (uc($format) eq 'UNIMARC') {
+				$r->print($req->as_unimarc);
+			} elsif (uc($format) eq 'USMARC') {
+				$r->print($req->as_usmarc);
+			}
+
+            $r->rflush();
+
+		} otherwise {
+			my $e = shift;
+			warn "\n$e\n";
+		};
+
+	}
+
+	$r->print("</collection>\n") if ($format eq 'XML');
+
+	return Apache2::Const::OK;
+
+}
+
+sub verify_login {
+        my $auth_token = shift;
+        return undef unless $auth_token;
+
+        my $user = OpenSRF::AppSession
+                ->create("open-ils.auth")
+                ->request( "open-ils.auth.session.retrieve", $auth_token )
+                ->gather(1);
+
+        if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+                return undef;
+        }
+
+        return $user if ref($user);
+        return undef;
+}
+
+sub show_template {
+	my $r = shift;
+
+	$r->content_type('text/html');
+	$r->print(<<HTML);
+
+<html>
+	<head>
+		<title>Record Export</title>
+	</head>
+	<body>
+		<form method="POST" enctype="multipart/form-data">
+			Use field number <input type="text" size="2" maxlength="2" name="idcolumn" value="0"/> (starting from 0)
+			from CSV file <input type="file" name="idfile"/>
+			<br/><br/> <b>or</b> <br/><br/>
+			Record ID <input type="text" size="12" maxlength="12" name="id"/>
+			<br/><br/> Record Type:
+			<select name="rectype">
+				<option value="biblio">Bibliographic Records</option>
+				<option value="authority">Authority Records</option>
+			</select>
+			<br/> Record Fromat:
+			<select name="format">
+				<option value="USMARC">MARC21</option>
+				<option value="UNIMARC">UNIMARC</option>
+				<option value="XML">MARC XML</option>
+				<option value="BRE">Evergreen BRE</option>
+			</select>
+			<br/> Record Encoding:
+			<select name="encoding">
+				<option value="UTF-8">UTF-8</option>
+				<option value="MARC8">MARC8</option>
+			</select>
+			<br/> Include holdings in Bibliographic Records:
+			<input type="checkbox" name="holdings" value="1">
+			<br/><br/><input type="submit" value="Retrieve Records"/>
+		</form>
+	</body>
+</html>
+
+HTML
+
+	return Apache2::Const::OK;
+}
+
+1;
diff --git a/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm b/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm
new file mode 100644
index 0000000000..c2a79e4f3b
--- /dev/null
+++ b/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm
@@ -0,0 +1,181 @@
+package OpenILS::WWW::Proxy;
+use strict; use warnings;
+
+use Apache2::Log;
+use Apache2::Const -compile => qw(REDIRECT FORBIDDEN OK NOT_FOUND DECLINED :log);
+use APR::Const    -compile => qw(:error SUCCESS);
+use CGI;
+use Data::Dumper;
+use Digest::MD5 qw/md5_hex/;
+
+use OpenSRF::EX qw(:try);
+use OpenSRF::System;
+
+
+# set the bootstrap config and template include directory when 
+# this module is loaded
+my $bootstrap;
+
+sub import {
+	my $self = shift;
+	$bootstrap = shift;
+}
+
+
+sub child_init {
+	OpenSRF::System->bootstrap_client( config_file => $bootstrap );
+}
+
+sub handler {
+	my $apache = shift;
+
+	my $proxyhtml = $apache->dir_config('OILSProxyHTML');
+	my $title = $apache->dir_config('OILSProxyTitle');
+	my $desc = $apache->dir_config('OILSProxyDescription');
+	my $ltype = $apache->dir_config('OILSProxyLoginType');
+	my $perms = [ split ' ', $apache->dir_config('OILSProxyPermissions') ];
+
+	return Apache2::Const::NOT_FOUND unless ($title || $proxyhtml);
+	return Apache2::Const::NOT_FOUND unless (@$perms);
+
+	my $cgi = new CGI;
+	my $auth_ses = $cgi->cookie('ses') || $cgi->param('ses');
+	my $ws_ou = $cgi->cookie('ws_ou') || $cgi->param('ws_ou');
+
+	my $url = $cgi->url;
+
+	# push everyone to the secure site
+	if ($url =~ /^http:/o) {
+		$url =~ s/^http:/https:/o;
+		print "Location: $url\n\n";
+		return Apache2::Const::OK;
+	}
+
+	if (!$auth_ses) {
+		my $u = $cgi->param('user');
+		my $p = $cgi->param('passwd');
+
+		if (!$u) {
+
+			print $cgi->header(-type=>'text/html', -expires=>'-1d');
+			if (!$proxyhtml) {
+				$proxyhtml = join '', <DATA>;
+				$proxyhtml =~ s/TITLE/$title/gso;
+				$proxyhtml =~ s/DESCRIPTION/$desc/gso;
+			} else {
+				# XXX template toolkit??
+			}
+
+			print $proxyhtml;
+			return Apache2::Const::OK;
+		}
+
+		$auth_ses = oils_login($u, $p, $ltype);
+		if ($auth_ses) {
+			print $cgi->redirect(
+				-uri=>$url,
+				-cookie=>$cgi->cookie(
+					-name=>'ses',
+					-value=>$auth_ses,
+					-path=>'/',-expires=>'+1h'
+				)
+			);
+			return Apache2::Const::REDIRECT;
+		}
+	}
+
+	my $user = verify_login($auth_ses);
+	return Apache2::Const::FORBIDDEN unless ($user);
+
+	$ws_ou ||= $user->home_ou;
+
+	warn "Checking perms " . join(',', @$perms) . " for user " . $user->id . " at location $ws_ou\n";
+
+	my $failures = OpenSRF::AppSession
+		->create('open-ils.actor')
+		->request('open-ils.actor.user.perm.check', $auth_ses, $user->id, $ws_ou, $perms)
+		->gather(1);
+
+	return Apache2::Const::FORBIDDEN if (@$failures > 0);
+
+	# they're good, let 'em through
+	return Apache2::Const::DECLINED;
+}
+
+# returns the user object if the session is valid, 0 otherwise
+sub verify_login {
+	my $auth_token = shift;
+	return undef unless $auth_token;
+
+	my $user = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( "open-ils.auth.session.retrieve", $auth_token )
+		->gather(1);
+
+	if (ref($user) eq 'HASH' && $user->{ilsevent} == 1001) {
+		return undef;
+	}
+
+	return $user if ref($user);
+	return undef;
+}
+
+sub oils_login {
+        my( $username, $password, $type ) = @_;
+
+        $type |= "staff";
+	my $nametype = 'username';
+	$nametype = 'barcode' if ($username =~ /^\d+$/o);
+
+        my $seed = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( 'open-ils.auth.authenticate.init', $username )
+		->gather(1);
+
+        return undef unless $seed;
+
+        my $response = OpenSRF::AppSession
+		->create("open-ils.auth")
+		->request( 'open-ils.auth.authenticate.complete',
+			{ $nametype => $username,
+			  password => md5_hex($seed . md5_hex($password)),
+			  type => $type })
+		->gather(1);
+
+        return undef unless $response;
+
+        return $response->{payload}->{authtoken};
+}
+
+
+
+1;
+
+__DATA__
+<html>
+	<head>
+		<title>TITLE</title>
+	</head>
+	<body>
+		<br/><br/><br/>
+		<center>
+		<form method='POST'>
+			<table style='border-collapse: collapse; border: 1px solid black;'>
+				<tr>
+					<th colspan='2' align='center'><u>DESCRIPTION</u></th>
+				</tr>
+				<tr>
+					<th align="right">Username or barcode:</th>
+					<td><input type="text" name="user"/></td>
+				</tr>
+				<tr>
+					<th align="right">Password:</th>
+					<td><input type="password" name="passwd"/></td>
+				</tr>
+			</table>
+			<input type="submit" value="Log in"/>
+		</form>
+		</center>
+	</body>
+</html>
+
-- 
2.11.0