From d88ecc075157029eeddedc992f05bb68f3ac6dd8 Mon Sep 17 00:00:00 2001 From: Joe Atzberger Date: Thu, 29 Nov 2007 17:43:05 -0600 Subject: [PATCH] Big LDAP changes, module test for Context.pm, still more yet to come. Signed-off-by: Chris Cormack Signed-off-by: Joshua Ferraro --- C4/Auth_with_ldap.pm | 108 +++++++++++++++++-------------- C4/Members.pm | 149 +++++++++++++++---------------------------- C4/Utils.pm | 48 ++++++++++++++ t/Auth_with_ldap.t | 12 ++-- t/Context.t | 43 +++++++++++-- 5 files changed, 204 insertions(+), 156 deletions(-) create mode 100644 C4/Utils.pm diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index cc812a724d..42f1c71d80 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -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 ); diff --git a/C4/Members.pm b/C4/Members.pm index f52530b81a..b69b08a985 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -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'}; diff --git a/C4/Utils.pm b/C4/Utils.pm new file mode 100644 index 0000000000..ad38397ed5 --- /dev/null +++ b/C4/Utils.pm @@ -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__ diff --git a/t/Auth_with_ldap.t b/t/Auth_with_ldap.t index 2a4cfc72c2..92278d5507 100755 --- a/t/Auth_with_ldap.t +++ b/t/Auth_with_ldap.t @@ -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'"); diff --git a/t/Context.t b/t/Context.t index 6390b733ef..31b0684349 100755 --- a/t/Context.t +++ b/t/Context.t @@ -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__ + -- 2.20.1