X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FAuth_with_ldap.pm;h=f13dbdcf8e870fd4a91c25f405f0aadba65a959c;hb=ad7d3e5099bf97ede706d496e33d817a618d74e3;hp=cc05550ca38fadd9dbcbd1e2dbea7f99384a99a1;hpb=5dd44a8f088c5c8537d0e0046a34d57655f2b7fd;p=koha-ffzg.git diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index cc05550ca3..f13dbdcf8e 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -18,26 +18,22 @@ package C4::Auth_with_ldap; # along with Koha; if not, see . use Modern::Perl; -use Carp; +use Carp qw( croak ); -use C4::Debug; use C4::Context; -use C4::Members::Attributes; -use C4::Members::AttributeTypes; use C4::Members::Messaging; -use C4::Auth qw(checkpw_internal); +use C4::Auth qw( checkpw_internal ); +use C4::Letters qw( GetPreparedLetter EnqueueLetter SendQueuedMessages ); use Koha::Patrons; -use Koha::AuthUtils qw(hash_password); -use List::MoreUtils qw( any ); +use Koha::AuthUtils qw( hash_password ); use Net::LDAP; use Net::LDAP::Filter; -use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug); - +our (@ISA, @EXPORT_OK); BEGIN { require Exporter; @ISA = qw(Exporter); - @EXPORT = qw( checkpw_ldap ); + @EXPORT_OK = qw( checkpw_ldap ); } # Redefine checkpw_ldap: @@ -52,17 +48,20 @@ sub ldapserver_error { } use vars qw($mapping @ldaphosts $base $ldapname $ldappassword); -my $context = C4::Context->new() or die 'C4::Context->new failed'; my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF}; +# since Bug 28278 we need to skip id in which generates additional hash level +if ( exists $ldap->{ldapserver} ) { + $ldap = $ldap->{ldapserver} or die ldapserver_error('id="ldapserver"'); +} my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname'); my $base = $ldap->{base} or die ldapserver_error('base'); $ldapname = $ldap->{user} ; $ldappassword = $ldap->{pass} ; our %mapping = %{$ldap->{mapping}}; # FIXME dpavlin -- don't die because of || (); from 6eaf8511c70eb82d797c941ef528f4310a15e9f9 my @mapkeys = keys %mapping; -$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n"; +#warn "Got ", scalar(@mapkeys), " ldap mapkeys ( total ): ", join ' ', @mapkeys, "\n"; @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys; -$debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n"; +#warn "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n"; my %categorycode_conversions; my $default_categorycode; @@ -76,7 +75,8 @@ if(defined $ldap->{categorycode_mapping}) { my %config = ( anonymous => defined ($ldap->{anonymous_bind}) ? $ldap->{anonymous_bind} : 1, replicate => defined($ldap->{replicate}) ? $ldap->{replicate} : 1, # add from LDAP to Koha database for new user - update => defined($ldap->{update} ) ? $ldap->{update} : 1, # update from LDAP to Koha database for existing user + welcome => defined($ldap->{welcome}) ? $ldap->{welcome} : 0, # send welcome notice when patron is added via replicate + update => defined($ldap->{update}) ? $ldap->{update} : 1, # update from LDAP to Koha database for existing user ); sub description { @@ -111,7 +111,7 @@ sub search_method { } sub checkpw_ldap { - my ($dbh, $userid, $password) = @_; + my ($userid, $password) = @_; my @hosts = split(',', $prefhost); my $db = Net::LDAP->new(\@hosts); unless ( $db ) { @@ -119,7 +119,6 @@ sub checkpw_ldap { return 0; } - #$debug and $db->debug(5); my $userldapentry; # first, LDAP authentication @@ -208,7 +207,7 @@ sub checkpw_ldap { if (( $borrowernumber and $config{update} ) or (!$borrowernumber and $config{replicate}) ) { %borrower = ldap_entry_2_hash($userldapentry,$userid); - $debug and print STDERR "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n"; + #warn "checkpw_ldap received \%borrower w/ " . keys(%borrower), " keys: ", join(' ', keys %borrower), "\n"; } if ($borrowernumber) { @@ -228,13 +227,51 @@ sub checkpw_ldap { )->store; die "Insert of new patron failed" unless $patron; $borrowernumber = $patron->borrowernumber; - C4::Members::Messaging::SetMessagingPreferencesFromDefaults( { borrowernumber => $borrowernumber, categorycode => $borrower{'categorycode'} } ); + C4::Members::Messaging::SetMessagingPreferencesFromDefaults( + { + borrowernumber => $borrowernumber, + categorycode => $borrower{'categorycode'} + } + ); + + # Send welcome email if enabled + if ( $config{welcome} ) { + my $emailaddr = $patron->notice_email_address; + + # if we manage to find a valid email address, send notice + if ($emailaddr) { + my $letter = C4::Letters::GetPreparedLetter( + module => 'members', + letter_code => 'WELCOME', + branchcode => $patron->branchcode, + lang => $patron->lang || 'default', + tables => { + 'branches' => $patron->branchcode, + 'borrowers' => $patron->borrowernumber, + }, + want_librarian => 1, + ) or return; + + my $message_id = C4::Letters::EnqueueLetter( + { + letter => $letter, + borrowernumber => $patron->id, + to_address => $emailaddr, + message_transport_type => 'email' + } + ); + + C4::Letters::SendQueuedMessages( { message_id => $message_id } ); + } + } } else { return 0; # B2, D2 } if (C4::Context->preference('ExtendedPatronAttributes') && $borrowernumber && ($config{update} ||$config{replicate})) { - foreach my $attribute_type ( C4::Members::AttributeTypes::GetAttributeTypes() ) { - my $code = $attribute_type->{code}; + my $library_id = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef; + my $attribute_types = Koha::Patron::Attribute::Types->search_with_library_limits({}, {}, $library_id); + while ( my $attribute_type = $attribute_types->next ) { + my $code = $attribute_type->code; unless (exists($borrower{$code}) && $borrower{$code} !~ m/^\s*$/ ) { next; } @@ -242,7 +279,7 @@ sub checkpw_ldap { if ( $patron ) { # Should not be needed, but we are in C4::Auth LDAP... eval { my $attribute = Koha::Patron::Attribute->new({code => $code, attribute => $borrower{$code}}); - $patron->extended_attributes([$attribute]); + $patron->extended_attributes([$attribute->unblessed]); }; if ($@) { # FIXME Test if Koha::Exceptions::Patron::Attribute::NonRepeatable warn "ERROR_extended_unique_id_failed $code $borrower{$code}"; @@ -263,21 +300,18 @@ sub ldap_entry_2_hash { my %borrower = ( cardnumber => shift ); my %memberhash; $userldapentry->exists('uid'); # This is bad, but required! By side-effect, this initializes the attrs hash. - if ($debug) { - foreach (keys %$userldapentry) { - print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n"; - } - } + #foreach (keys %$userldapentry) { + # print STDERR "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n"; + #} my $x = $userldapentry->{attrs} or return; foreach (keys %$x) { $memberhash{$_} = join ' ', @{$x->{$_}}; - $debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n"; + #warn sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n"; } - $debug and print STDERR "Finsihed \%memberhash has ", scalar(keys %memberhash), " keys\n", - "Referencing \%mapping with ", scalar(keys %mapping), " keys\n"; + #warn "Finished \%memberhash has ", scalar(keys %memberhash), " keys\n", "Referencing \%mapping with ", scalar(keys %mapping), " keys\n"; foreach my $key (keys %mapping) { my $data = $memberhash{ lc($mapping{$key}->{is}) }; # Net::LDAP returns all names in lowercase - $debug and printf STDERR "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data; + #warn "mapping %20s ==> %-20s (%s)\n", $key, $mapping{$key}->{is}, $data; unless (defined $data) { $data = $mapping{$key}->{content} || undef; } @@ -302,7 +336,7 @@ sub ldap_entry_2_hash { $sth->execute( uc($borrower{'categorycode'}) ); unless ( my $row = $sth->fetchrow_hashref ) { my $default = $mapping{'categorycode'}->{content}; - $debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid}; + #warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid}; $borrower{'categorycode'} = $default } @@ -316,12 +350,12 @@ sub exists_local { my $sth = $dbh->prepare("$select WHERE userid=?"); # was cardnumber=? $sth->execute($arg); - $debug and printf STDERR "Userid '$arg' exists_local? %s\n", $sth->rows; + #warn "Userid '$arg' exists_local? %s\n", $sth->rows; ($sth->rows == 1) and return $sth->fetchrow; $sth = $dbh->prepare("$select WHERE cardnumber=?"); $sth->execute($arg); - $debug and printf STDERR "Cardnumber '$arg' exists_local? %s\n", $sth->rows; + #warn "Cardnumber '$arg' exists_local? %s\n", $sth->rows; ($sth->rows == 1) and return $sth->fetchrow; return 0; } @@ -356,10 +390,10 @@ sub _do_changepassword { } my $digest = hash_password($password); - $debug and print STDERR "changing local password for borrowernumber=$borrowerid to '$digest'\n"; + #warn "changing local password for borrowernumber=$borrowerid to '$digest'\n"; Koha::Patrons->find($borrowerid)->set_password({ password => $password, skip_validation => 1 }); - my ($ok, $cardnum) = checkpw_internal(C4::Context->dbh, $userid, $password); + my ($ok, $cardnum) = checkpw_internal($userid, $password); return $cardnum if $ok; warn "Password mismatch after update to borrowernumber=$borrowerid"; @@ -375,10 +409,12 @@ sub update_local { # skip extended patron attributes in 'borrowers' attribute update my @keys = keys %$borrower; if (C4::Context->preference('ExtendedPatronAttributes')) { - foreach my $attribute_type ( C4::Members::AttributeTypes::GetAttributeTypes() ) { - my $code = $attribute_type->{code}; + my $library_id = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef; + my $attribute_types = Koha::Patron::Attribute::Types->search_with_library_limits({}, {}, $library_id); + while ( my $attribute_type = $attribute_types->next ) { + my $code = $attribute_type->code; @keys = grep { $_ ne $code } @keys; - $debug and printf STDERR "ignoring extended patron attribute '%s' in update_local()\n", $code; + #warn "ignoring extended patron attribute '%s' in update_local()\n", $code; } } @@ -387,11 +423,8 @@ sub update_local { join(',', map {"$_=?"} @keys) . "\nWHERE borrowernumber=? "; my $sth = $dbh->prepare($query); - if ($debug) { - print STDERR $query, "\n", - join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys; - print STDERR "\nuserid = $userid\n"; - } + #warn $query, "\n", join "\n", map {"$_ = '" . $borrower->{$_} . "'"} @keys; + #warn "\nuserid = $userid\n"; $sth->execute( ((map {$borrower->{$_}} @keys), $borrowerid) ); @@ -513,6 +546,7 @@ Example XML stanza for LDAP configuration in KOHA_CONF. cn=Manager,dc=metavore,dc=com metavore 1 + 1 1 0