From d86090f49d54d85240297db6f24a2fcd1501ebcb Mon Sep 17 00:00:00 2001 From: Thomas Berezansky Date: Fri, 6 Nov 2015 11:36:31 -0500 Subject: [PATCH] Standalone "Log into remote Evergreen" perl module Intended for use in implementing auth modules for outside projects Signed-off-by: Thomas Berezansky --- Evergreen/Auth.pm | 228 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ test.pl | 17 ++++ 2 files changed, 245 insertions(+) create mode 100644 Evergreen/Auth.pm create mode 100755 test.pl diff --git a/Evergreen/Auth.pm b/Evergreen/Auth.pm new file mode 100644 index 000000000..b32b37426 --- /dev/null +++ b/Evergreen/Auth.pm @@ -0,0 +1,228 @@ +package Evergreen::Auth; + +use strict; +use warnings; + +use JSON; +use LWP::UserAgent; +use Digest::MD5 qw(md5_hex); +use XML::LibXML; + +my $ua = LWP::UserAgent->new( + ssl_opts => { SSL_verify_mode => 'SSL_VERIFY_NONE'} # TODO: REMOVE THIS FOR PRODUCTION MODE (my dev machine doesn't trust itself) +); + +my %idl_fields; +my %server_prefs; + +sub fieldmap { + my $server = shift; + my $object = shift; + return [ map { fieldmap($server, $_) } @$object ] if ref($object) eq 'ARRAY'; + return $object if ref($object) ne 'HASH'; + return $object unless defined $idl_fields{$server}{$object->{__c}}; + my @idl = @{$idl_fields{$server}{$object->{__c}}}; + my $newobject = {}; + for (my $i=0; $i<=$#idl;$i++) { + $newobject->{$idl[$i]} = fieldmap($server, $object->{__p}->[$i]); + } + return $newobject; +} + +sub fetch_idl { + my $server = shift; + my $req = HTTP::Request->new(GET => "https://$server/reports/fm_IDL.xml?class=aou&class=au&class=ausp&class=csp&class=pgt"); + my $res = $ua->request($req); + if ($res->is_success) { + # IDL fetch has content. But is it XML? + my $parser = XML::LibXML->new(recover => 2); + my $xmldoc = $parser->parse_string($res->content); + return 0 unless $xmldoc and $xmldoc->documentElement->nodeName eq 'IDL'; + my $rootnode = $xmldoc->documentElement; + my @classnodes = $rootnode->findnodes('idl:class'); + foreach my $classnode (@classnodes) { + my $classname = $classnode->getAttribute('id'); + my @fields = $classnode->findnodes('idl:fields/idl:field'); + $idl_fields{$server}{$classname} = [ map { $_->getAttribute('name') } @fields ]; + } + return 1; + } + return 0; +} + +sub build_osrf_class { + my $class = shift; + my $payload = shift; + my $hash = { + __c => $class, + __p => $payload + }; +} + +sub build_osrf_message { + my $method = shift; + my $message = build_osrf_class('osrfMessage', { + threadTrace => 0, + type => 'REQUEST', + locale => 'en-US', + payload => build_osrf_class('osrfMethod', { + method => $method, + params => shift + }) + }); +} + +sub build_request { + my $server = shift; + my $service = shift; + my $message = encode_json(shift); + return HTTP::Request->new( + 'POST', + "https://$server/osrf-http-translator", + [ + 'content-type' => 'application/x-www-form-urlencoded', + 'X-OpenSRF-service' => $service + ], + "osrf-msg=[$message]" + ); +} + +sub get_result { + my $content = shift; + my $returnerrors = shift; + my $osrfres = eval { decode_json($content) }; + return undef unless $osrfres and ref($osrfres) eq 'ARRAY' and ref($osrfres->[0]) eq 'HASH'; + my $message = $osrfres->[0]; + return undef unless $message->{__c} eq 'osrfMessage'; + my $result = $message->{__p}->{payload}; + return undef unless $result->{__c} eq 'osrfResult'; + return undef unless $result->{__p}->{statusCode} == 200; + my $resultc = $result->{__p}->{content}; + if (ref($resultc) eq 'HASH') { + return undef if ($resultc->{ilsevent} and not $returnerrors); + return $resultc if ($resultc->{ilsevent}); + $resultc = $resultc->{payload} if (defined($resultc->{ilsevent}) and defined($resultc->{payload})); + } + return $resultc; +} + +sub fetch_prefs { + my $server = shift; + my $org_unit = shift || 1; + $server_prefs{$server}{$org_unit}{fetched} = 0; + + # First Up, Auth Proxy Usage + # This is allowed to fail silently! + my $proxymessage = build_osrf_message('open-ils.auth_proxy.enabled',[]); + my $req = build_request($server, 'open-ils.auth_proxy', $proxymessage); + my $res = $ua->request($req); + # Assume we don't first + $server_prefs{$server}{proxy} = 0; + if ($res->is_success) { + my $result = get_result($res->content); + if (defined $result) { + $server_prefs{$server}{proxy} = int($result); + } + } + + # Next Up, Barcode Regex + # If this fails outright we have an issue + my $barcodemessage = build_osrf_message('open-ils.actor.ou_setting.ancestor_default',[$org_unit, 'opac.barcode_regex']); + $req = build_request($server, 'open-ils.actor', $barcodemessage); + $res = $ua->request($req); + # Assume starts with digits + $server_prefs{$server}{$org_unit}{barcode_regex} = '^\d'; + if ($res->is_success) { + my $result = get_result($res->content); + if (defined $result) { + $server_prefs{$server}{$org_unit}{barcode_regex} = $result; + } + } else { + return 0; + } + + $server_prefs{$server}{$org_unit}{fetched} = 1; + return 1; +} + +sub do_login { + my $server = shift; + my $username = shift; + my $password = shift; + my $org_unit = shift || 1; + my $workstation = shift; + + fetch_prefs($server, $org_unit) unless $server_prefs{$server}{$org_unit}{fetched}; + + my $params = { + type => 'opac', + org => 1, + agent => 'remotelogin', + }; + if ($username =~ $server_prefs{$server}{$org_unit}{barcode_regex}) { + $params->{barcode} = $username; + } else { + $params->{username} = $username; + } + + if ($server_prefs{$server}{proxy}) { + $params->{password} = $password; + my $proxylogin = build_osrf_message('open-ils.auth_proxy.login', [$params]); + my $req = build_request($server, 'open-ils.auth_proxy', $proxylogin); + my $res = $ua->request($req); + if ($res->is_success) { + return get_result($res->content, 1); + } + } else { + my $authinit = build_osrf_message('open-ils.auth.authenticate.init', [$username]); + my $req = build_request($server, 'open-ils.auth', $authinit); + my $res = $ua->request($req); + if ($res->is_success) { + my $seed = get_result($res->content); + $params->{password} = md5_hex($seed . md5_hex($password)); + my $authcomplete = build_osrf_message('open-ils.auth.authenticate.complete', [$params]); + $req = build_request($server, 'open-ils.auth', $authcomplete); + $res = $ua->request($req); + if ($res->is_success) { + return get_result($res->content, 1); + } + } + } +} + +sub fetch_user { + my $server = shift; + my $authinfo = shift; + my $advanced = shift; + + # Base info, session retrieval + my $sessionr = build_osrf_message('open-ils.auth.session.retrieve', [$authinfo->{authtoken}]); + my $req = build_request($server, 'open-ils.auth', $sessionr); + my $res = $ua->request($req); + if ($res->is_success) { + my $user = fieldmap($server, get_result($res->content)); + if ($advanced) { + my $fleshuser = build_osrf_message('open-ils.actor.user.fleshed.retrieve', [$authinfo->{authtoken}, $user->{id}, ['profile','home_ou','standing_penalties']]); + $req = build_request($server, 'open-ils.actor', $fleshuser); + $res = $ua->request($req); + if ($res->is_success) { + $user = fieldmap($server, get_result($res->content)); + } + } + return $user; + } + return undef; +} + +sub fetch_group_tree { + my $server = shift; + my $msg = build_osrf_message('open-ils.actor.groups.tree.retrieve', []); + my $req = build_request($server, 'open-ils.actor', $msg); + my $res = $ua->request($req); + if ($res->is_success) { + return fieldmap($server, get_result($res->content)); + } + return undef; +} + +1; diff --git a/test.pl b/test.pl new file mode 100755 index 000000000..aec973098 --- /dev/null +++ b/test.pl @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Data::Dumper; +use Evergreen::Auth; + +my $server = 'localhost'; + +Evergreen::Auth::fetch_idl($server); +my $authinfo = Evergreen::Auth::do_login($server,"admin","evergreen"); +if ($authinfo->{ilsevent}) { + die "AUTH FAILED!\n"; +} +print Dumper(Evergreen::Auth::fetch_user($server,$authinfo,1)); +print Dumper(Evergreen::Auth::fetch_group_tree($server)); -- 2.11.0