Koha-community
/
Koha
13
5
Fork 0
Code Issues Releases Wiki Activity
Browse Source

Big LDAP changes, module test for Context.pm, still more yet to come. 

Signed-off-by: Chris Cormack <crc@liblime.com>
Signed-off-by: Joshua Ferraro <jmf@liblime.com>
3.0.x
Joe Atzberger 17 years ago
committed by Joshua Ferraro
parent
60f37d1aff
commit
d88ecc0751
5 changed files with 204 additions and 156 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 108
      C4/Auth_with_ldap.pm
  2. 149
      C4/Members.pm
  3. 48
      C4/Utils.pm
  4. 12
      t/Auth_with_ldap.t
  5. 43
      t/Context.t

108
C4/Auth_with_ldap.pm
View File

@ -21,18 +21,17 @@ use strict;
use Digest::MD5 qw(md5_base64);
use C4::Context;
use C4::Members qw(AddMember );
use C4::Members qw(AddMember changepassword);
use C4::Utils qw( :all );
use Net::LDAP;
use Net::LDAP::Filter;
# use Net::LDAP qw(:all);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
BEGIN {
require Exporter;
$VERSION = 3.01; # set the version for version checking
our $debug = $ENV{DEBUG} || 0;
$debug = $ENV{DEBUG} || 0;
@ISA = qw(Exporter C4::Auth);
@EXPORT = qw( checkauth );
}
@ -128,37 +127,27 @@ C4::Auth - Authenticates Koha users
# ~ then gets the LDAP entry
# ~ and calls the memberadd if necessary
use vars qw(%mapping @ldaphosts $base $ldapname $ldappassword);
%mapping = (
firstname => 'givenName',
surname => 'sn',
address => 'postalAddress',
city => 'l',
zipcode => 'postalCode',
branchcode => 'branch',
emailaddress => 'mail',
categorycode => 'employeeType',
phone => 'telephoneNumber',
);
my $prefhost;
if ($prefhost = C4::Context->preference('ldapserver')) { # assignment, not comparison
warn "Using preference from ldapserver: $prefhost";
(@ldaphosts) = split /\|/,$prefhost; # Potentially multiple LDAP hosts!
$base = C4::Context->preference('ldapinfos') || ''; # probably will fail w/o base
} else {
(@ldaphosts) = (qw(localhost)); # Potentially multiple LDAP hosts!
$base = "dc=metavore,dc=com"; # But only 1 base.
sub ldapserver_error ($) {
return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
}
$ldapname = "cn=Manager,$base"; # Your LDAP user. EDIT THIS LINE.
$ldappassword = 'metavore'; # Your LDAP user's password. EDIT THIS LINE.
use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
my $context = C4::Context->new() or die 'C4::Context->new failed';
my $ldap = $context->{server}->{ldapserver} or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname');
my $base = $ldap->{base} or die ldapserver_error('base');
$ldapname = $ldap->{user} or die ldapserver_error('user');
$ldappassword = $ldap->{pass} or die ldapserver_error('pass');
our %mapping = %{$ldap->{mapping}} or die ldapserver_error('mapping');
my @mapkeys = keys %mapping;
print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n";
@mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n";
my %config = (
anonymous => ($ldapname and $ldappassword) ? 0 : 1,
replicate => 1, # add from LDAP to Koha database for new user
update => 1, # update from LDAP to Koha database for existing user
replicate => $ldap->{replicate} || 1, # add from LDAP to Koha database for new user
update => $ldap->{update} || 1, # update from LDAP to Koha database for existing user
);
sub description ($) {
@ -175,7 +164,7 @@ sub checkauth {
{
return 2; # Koha superuser account
}
my $db = Net::LDAP->new(\@ldaphosts);
my $db = Net::LDAP->new([$prefhost]);
#$debug and $db->debug(5);
my $filter = Net::LDAP::Filter->new("uid=$userid") or die "Failed to create new Net::LDAP::Filter";
my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
@ -211,34 +200,55 @@ sub checkauth {
if (exists_local($userid)) {
($config{update} ) and &update_local($userid,$password,%borrower);
} else {
($config{replicate}) and AddMember(%borrower);
($config{replicate}) and warn "Replicating!!" and AddMember(%borrower);
}
return 1;
}
# Pass LDAP entry object and local cardnumber (userid).
# Returns borrower hash.
# Edit %mapping so $memberhash{'xxx'} fits your ldap structure.
# Edit KOHA_CONF so $memberhash{'xxx'} fits your ldap structure.
# Ensure that mandatory fields are correctly filled!
#
sub ldap_entry_2_hash ($$) {
my $userldapentry = shift;
my %borrower = ( cardnumber => shift );
my %memberhash;
my $x = $userldapentry->{asn}{attributes} or return undef;
print "keys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n";
print $userldapentry->dump();
foreach (keys %$userldapentry) {
print "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
hashdump("LDAP key: ",$userldapentry->{$_});
}
warn "->{asn}->{attributes} : " . $userldapentry->{asn}->{attributes} ;
my $x = $userldapentry->{asn}->{attributes} or return undef;
my $key;
foreach my $k (@$x) {
foreach my $k2 ( keys %$k ) {
if ($k2 eq 'type') {
$key = $$k{$k2};
} else {
$memberhash{$key} .= map {$_ . " "} @$k{$k2};
}
}
# asn (HASH)
# LDAP key: ->{attributes} = ARRAY w/ 17 members.
# LDAP key: ->{attributes}->{HASH(0x9234290)} = HASH w/ 2 keys.
# LDAP key: ->{attributes}->{HASH(0x9234290)}->{type} = cn
# LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals} = ARRAY w/ 3 members.
# LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{ sss} = sss
# LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{ Steve Smith} = Steve Smith
# LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{Steve S. Smith} = Steve S. Smith
# $x $anon
# LDAP key: ->{attributes}->{HASH(0x9234490)} = HASH w/ 2 keys.
# LDAP key: ->{attributes}->{HASH(0x9234490)}->{type} = o
# LDAP key: ->{attributes}->{HASH(0x9234490)}->{vals} = ARRAY w/ 1 members.
# LDAP key: ->{attributes}->{HASH(0x9234490)}->{vals}->{metavore} = metavore
# $x=([ cn=>['sss','Steve Smith','Steve S. Smith'], sss, o=>['metavore'], ])
# . . . . .
foreach my $anon (@$x) {
$key = $anon->{type} or next;
$memberhash{$key} = join " ", @{$anon->{vals}};
}
foreach my $key (%mapping) {
my $data = $memberhash{$mapping{$key}};
defined $data or $data = ' ';
foreach my $key (keys %mapping) {
my $data = $memberhash{$mapping{$key}->{is}};
unless (defined $data) {
$data = $mapping{$key}->{content} || ''; # default or failsafe ''
}
$borrower{$key} = ($data ne '') ? $data : ' ' ;
}
$borrower{initials} = $memberhash{initials} ||
@ -262,15 +272,15 @@ sub update_local($$%) {
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("
UPDATE borrowers
SET firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=?
SET firstname=?,surname=?,initials=?,address=?,city=?,phone=?, categorycode=?,branchcode=?,email=?,sort1=?
WHERE cardnumber=?
");
$sth->execute(
$borrower{firstname}, $borrower{surname},
$borrower{initials}, $borrower{streetaddress},
$borrower{initials}, $borrower{address},
$borrower{city}, $borrower{phone},
$borrower{categorycode}, $borrower{branchcode},
$borrower{emailaddress}, $borrower{sort1},
$borrower{email}, $borrower{sort1},
$userid
);

149
C4/Members.pm
View File

@ -602,8 +602,8 @@ Modify borrower's data
sub ModMember {
my (%data) = @_;
my $dbh = C4::Context->dbh;
$data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} ) if ($data{'dateofbirth'} );
$data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} ) if ($data{'dateexpiry'} );
$data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth' } ) if ($data{'dateofbirth' } );
$data{'dateexpiry'} = format_date_in_iso( $data{ 'dateexpiry' } ) if ($data{ 'dateexpiry' } );
$data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} ) if ($data{'dateenrolled'} );
my $qborrower=$dbh->prepare("SHOW columns from borrowers");
$qborrower->execute;
@ -673,103 +673,58 @@ sub AddMember {
$data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
$data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'});
$data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} );
# This query should be rewritten to use "?" at execute.
my $query =
"insert into borrowers set cardnumber="
. $dbh->quote( $data{'cardnumber'} )
. ",surname="
. $dbh->quote( $data{'surname'} )
. ",firstname="
. $dbh->quote( $data{'firstname'} )
. ",title="
. $dbh->quote( $data{'title'} )
. ",othernames="
. $dbh->quote( $data{'othernames'} )
. ",initials="
. $dbh->quote( $data{'initials'} )
. ",streetnumber="
. $dbh->quote( $data{'streetnumber'} )
. ",streettype="
. $dbh->quote( $data{'streettype'} )
. ",address="
. $dbh->quote( $data{'address'} )
. ",address2="
. $dbh->quote( $data{'address2'} )
. ",zipcode="
. $dbh->quote( $data{'zipcode'} )
. ",city="
. $dbh->quote( $data{'city'} )
. ",phone="
. $dbh->quote( $data{'phone'} )
. ",email="
. $dbh->quote( $data{'email'} )
. ",mobile="
. $dbh->quote( $data{'mobile'} )
. ",phonepro="
. $dbh->quote( $data{'phonepro'} )
. ",opacnote="
. $dbh->quote( $data{'opacnote'} )
. ",guarantorid="
. $dbh->quote( $data{'guarantorid'} )
. ",dateofbirth="
. $dbh->quote( $data{'dateofbirth'} )
. ",branchcode="
. $dbh->quote( $data{'branchcode'} )
. ",categorycode="
. $dbh->quote( $data{'categorycode'} )
. ",dateenrolled="
. $dbh->quote( $data{'dateenrolled'} )
. ",contactname="
. $dbh->quote( $data{'contactname'} )
. ",borrowernotes="
. $dbh->quote( $data{'borrowernotes'} )
. ",dateexpiry="
. $dbh->quote( $data{'dateexpiry'} )
. ",contactnote="
. $dbh->quote( $data{'contactnote'} )
. ",B_address="
. $dbh->quote( $data{'B_address'} )
. ",B_zipcode="
. $dbh->quote( $data{'B_zipcode'} )
. ",B_city="
. $dbh->quote( $data{'B_city'} )
. ",B_phone="
. $dbh->quote( $data{'B_phone'} )
. ",B_email="
. $dbh->quote( $data{'B_email'} )
. ",password="
. $dbh->quote( $data{'password'} )
. ",userid="
. $dbh->quote( $data{'userid'} )
. ",sort1="
. $dbh->quote( $data{'sort1'} )
. ",sort2="
. $dbh->quote( $data{'sort2'} )
. ",contacttitle="
. $dbh->quote( $data{'contacttitle'} )
. ",emailpro="
. $dbh->quote( $data{'emailpro'} )
. ",contactfirstname="
. $dbh->quote( $data{'contactfirstname'} ) . ",sex="
. $dbh->quote( $data{'sex'} ) . ",fax="
. $dbh->quote( $data{'fax'} )
. ",relationship="
. $dbh->quote( $data{'relationship'} )
. ",B_streetnumber="
. $dbh->quote( $data{'B_streetnumber'} )
. ",B_streettype="
. $dbh->quote( $data{'B_streettype'} )
. ",gonenoaddress="
. $dbh->quote( $data{'gonenoaddress'} )
. ",lost="
. $dbh->quote( $data{'lost'} )
. ",debarred="
. $dbh->quote( $data{'debarred'} )
. ",ethnicity="
. $dbh->quote( $data{'ethnicity'} )
. ",ethnotes="
. $dbh->quote( $data{'ethnotes'} );
"insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} )
. ",surname=" . $dbh->quote( $data{'surname'} )
. ",firstname=" . $dbh->quote( $data{'firstname'} )
. ",title=" . $dbh->quote( $data{'title'} )
. ",othernames=" . $dbh->quote( $data{'othernames'} )
. ",initials=" . $dbh->quote( $data{'initials'} )
. ",streetnumber=". $dbh->quote( $data{'streetnumber'} )
. ",streettype=" . $dbh->quote( $data{'streettype'} )
. ",address=" . $dbh->quote( $data{'address'} )
. ",address2=" . $dbh->quote( $data{'address2'} )
. ",zipcode=" . $dbh->quote( $data{'zipcode'} )
. ",city=" . $dbh->quote( $data{'city'} )
. ",phone=" . $dbh->quote( $data{'phone'} )
. ",email=" . $dbh->quote( $data{'email'} )
. ",mobile=" . $dbh->quote( $data{'mobile'} )
. ",phonepro=" . $dbh->quote( $data{'phonepro'} )
. ",opacnote=" . $dbh->quote( $data{'opacnote'} )
. ",guarantorid=" . $dbh->quote( $data{'guarantorid'} )
. ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} )
. ",branchcode=" . $dbh->quote( $data{'branchcode'} )
. ",categorycode=" . $dbh->quote( $data{'categorycode'} )
. ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} )
. ",contactname=" . $dbh->quote( $data{'contactname'} )
. ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} )
. ",dateexpiry=" . $dbh->quote( $data{'dateexpiry'} )
. ",contactnote=" . $dbh->quote( $data{'contactnote'} )
. ",B_address=" . $dbh->quote( $data{'B_address'} )
. ",B_zipcode=" . $dbh->quote( $data{'B_zipcode'} )
. ",B_city=" . $dbh->quote( $data{'B_city'} )
. ",B_phone=" . $dbh->quote( $data{'B_phone'} )
. ",B_email=" . $dbh->quote( $data{'B_email'} )
. ",password=" . $dbh->quote( $data{'password'} )
. ",userid=" . $dbh->quote( $data{'userid'} )
. ",sort1=" . $dbh->quote( $data{'sort1'} )
. ",sort2=" . $dbh->quote( $data{'sort2'} )
. ",contacttitle=" . $dbh->quote( $data{'contacttitle'} )
. ",emailpro=" . $dbh->quote( $data{'emailpro'} )
. ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} )
. ",sex=" . $dbh->quote( $data{'sex'} )
. ",fax=" . $dbh->quote( $data{'fax'} )
. ",relationship=" . $dbh->quote( $data{'relationship'} )
. ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} )
. ",B_streettype=" . $dbh->quote( $data{'B_streettype'} )
. ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} )
. ",lost=" . $dbh->quote( $data{'lost'} )
. ",debarred=" . $dbh->quote( $data{'debarred'} )
. ",ethnicity=" . $dbh->quote( $data{'ethnicity'} )
. ",ethnotes=" . $dbh->quote( $data{'ethnotes'} );
my $sth = $dbh->prepare($query);
print "Executing SQL: $query";
$sth->execute;
$sth->finish;
$data{'borrowernumber'} = $dbh->{'mysql_insertid'};

48
C4/Utils.pm
View File

@ -0,0 +1,48 @@
package C4::Utils;
# Useful code I didn't feel like duplicating all over the place.
#
use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
BEGIN {
require Exporter;
$VERSION = 1.00; # set the version for version checking
$debug = $ENV{DEBUG} || 0;
@ISA = qw(Exporter);
@EXPORT_OK = qw(&maxwidth &hashdump);
%EXPORT_TAGS = ( all => [qw(&maxwidth &hashdump)], );
}
sub maxwidth (@) {
(@_) or return 0;
return (sort {$a <=> $b} map {length} @_)[-1];
}
sub hashdump ($$) {
my $pre = shift;
my $val = shift;
if (ref($val) =~ /HASH/) {
print "$pre = HASH w/ " . scalar(keys %$val) . " keys.\n";
my $w2 = maxwidth(keys %$val);
foreach (sort keys %$val) {
&hashdump($pre . '->{' . sprintf('%' . $w2 .'s', $_) . '}', $val->{$_});
}
print "\n";
} elsif (ref($val) =~ /ARRAY/) {
print "$pre = ARRAY w/ " . scalar(@$val) . " members.\n";
my $w2 = maxwidth(@$val);
foreach (@$val) {
&hashdump($pre . '->{' . sprintf('%' . $w2 .'s', $_) . '}', $_);
}
print "\n";
} else {
print "$pre = $val\n";
}
}
1;
__END__

12
t/Auth_with_ldap.t
View File

@ -5,11 +5,11 @@ use strict;
use warnings;
use Test::More;
use vars qw(%cases $dbh $config $ldap);
use vars qw(%cases $dbh $config $context $ldap);
BEGIN {
%cases = (
# users from example3.ldif
# users from t/LDAP/example3.ldif
sss => 'password1',
jts => 'password1',
rch => 'password2',
@ -27,11 +27,11 @@ sub do_checkauth (;$$) {
return ($ret = checkauth($dbh,$user,$pass), sprintf("(%s,%s) returns '%s'",$user,$pass,$ret));
}
ok($dbh = C4::Context->dbh(), "Getting dbh from C4::Context");
ok($config = C4::Context->config(), "Getting config (hashref) from C4::Context");
ok($ldap = $config->{ldap}, "Getting LDAP info from config");
ok($context= C4::Context->new(), "Getting new C4::Context object");
ok($dbh = C4::Context->dbh(), "Getting dbh from C4::Context");
ok($dbh = $context->dbh(), "Getting dbh from \$context object");
diag("The basis of Authenticaiton is that we don't auth everybody.");
diag("The basis of Authentication is that we don't auth everybody.");
diag("Let's make sure we reject on bad calls.");
my $ret;
ok(!($ret = checkauth($dbh)), "should reject ( no arguments) returns '$ret'");

43
t/Context.t
View File

@ -1,14 +1,49 @@
#!/usr/bin/perl
#
# This Koha test module is a stub!
# Add more tests here!!!
use strict;
use warnings;
use Test::More tests => 1;
use Test::More tests => 91;
use vars qw($debug $koha $dbh $config $ret);
BEGIN {
use_ok('C4::Context');
$debug = $ENV{DEBUG} || 0;
diag("Note: The overall number of tests may vary by configuration.");
diag("First we need to check your environmental variables");
for (qw(KOHA_CONF PERL5LIB)) {
ok($ret = $ENV{$_}, "ENV{$_} = $ret");
}
use_ok('C4::Context');
use_ok('C4::Utils', qw/ :all /);
}
ok($koha = C4::Context->new, 'C4::Context->new');
ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');
ok($ret = C4::Context->KOHAVERSION, ' (function) KOHAVERSION = ' . ($ret||''));
ok($ret = $koha->KOHAVERSION, ' $koha->KOHAVERSION = ' . ($ret||''));
my @keys = keys %$koha;
diag("Number of keys in \%\$koha: " . scalar @keys);
our $width = 0;
if (ok(@keys)) {
$width = maxwidth(@keys);
$debug and diag "widest key is $width";
}
foreach (sort @keys) {
ok(exists $koha->{$_},
'$koha->{' . sprintf('%' . $width . 's', $_) . '} exists '
. ((defined $koha->{$_}) ? "and is defined." : "but is not defined.")
);
}
diag "Examining defined key values.";
foreach (grep {defined $koha->{$_}} sort @keys) {
print "\n";
hashdump('$koha->{' . sprintf('%' . $width . 's', $_) . '}', $koha->{$_});
}
ok($config = $koha->{config}, 'Getting $koha->{config} ');
# diag("Examining configuration.");
diag("Note: The overall number of tests may vary by configuration. Disregard the projected number.");
1;
__END__

Write Preview
Loading…
Cancel
Save