[open-ils-commits] SPAM: r8644 - in branches/rel_1_2/Open-ILS:
examples/apache src/perlmods/OpenILS/WWW
svn at svn.open-ils.org
svn at svn.open-ils.org
Tue Feb 5 15:02:57 EST 2008
Author: miker
Date: 2008-02-05 14:34:36 -0500 (Tue, 05 Feb 2008)
New Revision: 8644
Added:
branches/rel_1_2/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm
branches/rel_1_2/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm
Modified:
branches/rel_1_2/Open-ILS/examples/apache/eg_vhost.conf
branches/rel_1_2/Open-ILS/examples/apache/startup.pl
Log:
adding exporter, new-style auth proxy, and requisite config
Modified: branches/rel_1_2/Open-ILS/examples/apache/eg_vhost.conf
===================================================================
--- branches/rel_1_2/Open-ILS/examples/apache/eg_vhost.conf 2008-02-05 19:28:43 UTC (rev 8643)
+++ branches/rel_1_2/Open-ILS/examples/apache/eg_vhost.conf 2008-02-05 19:34:36 UTC (rev 8644)
@@ -174,6 +174,20 @@
# ----------------------------------------------------------------------------------
+# 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/>
Modified: branches/rel_1_2/Open-ILS/examples/apache/startup.pl
===================================================================
--- branches/rel_1_2/Open-ILS/examples/apache/startup.pl 2008-02-05 19:28:43 UTC (rev 8643)
+++ branches/rel_1_2/Open-ILS/examples/apache/startup.pl 2008-02-05 19:34:36 UTC (rev 8644)
@@ -3,6 +3,8 @@
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
Added: branches/rel_1_2/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm
===================================================================
--- branches/rel_1_2/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm (rev 0)
+++ branches/rel_1_2/Open-ILS/src/perlmods/OpenILS/WWW/Exporter.pm 2008-02-05 19:34:36 UTC (rev 8644)
@@ -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;
Added: branches/rel_1_2/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm
===================================================================
--- branches/rel_1_2/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm (rev 0)
+++ branches/rel_1_2/Open-ILS/src/perlmods/OpenILS/WWW/Proxy.pm 2008-02-05 19:34:36 UTC (rev 8644)
@@ -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>
+
More information about the open-ils-commits
mailing list