This patch has some of the problems described at
http://bugs.koha.org/cgi-bin/bugzilla3/show_bug.cgi?id=4256
especially destroying of ExtendedPatronAttributes without update turned
on. It's also too large, since Net::LDAP would like like charm if only
ldap directory is supplied as ldaps://ldap.example.com instead of just
hostname.
This let me to beleve that it's a simple diff between ByWaterSolutions
version of Auth_with_ldap.pm and latest community edition, without any
of fixes included in bug mentioned above.
On Thu, May 13, 2010 at 05:02:43PM +0000, Ian Walls wrote:
> ---
> C4/Auth_with_ldap.pm | 136
> ++++++++++++++++++++++++++----------------
> Makefile.PL | 1 +
> about.pl | 1 +
> install_misc/debian.packages | 1 +
> 4 files changed, 87 insertions(+), 52 deletions(-)
>
> diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm
> index b25697c..3b4d3ad 100644
> --- a/C4/Auth_with_ldap.pm
> +++ b/C4/Auth_with_ldap.pm
> @@ -18,7 +18,7 @@ package C4::Auth_with_ldap;
> # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
>
> use strict;
> -#use warnings; FIXME - Bug 2505
> +# use warnings; almost?
> use Digest::MD5 qw(md5_base64);
>
> use C4::Debug;
> @@ -58,7 +58,7 @@ 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
> +our %mapping = %{$ldap->{mapping}} or die ldapserver_error('mapping');
> my @mapkeys = keys %mapping;
> $debug and print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys ( total
> ): ", join ' ', @mapkeys, "\n";
> @mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
> @@ -80,68 +80,101 @@ sub description ($) {
> sub search_method {
> my $db = shift or return;
> my $userid = shift or return;
> - my $uid_field = $mapping{userid}->{is} or die ldapserver_error("mapping
> for 'userid'");
> - my $filter = Net::LDAP::Filter->new("$uid_field=$userid") or die
> "Failed to create new Net::LDAP::Filter";
> - my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname,
> password=>$ldappassword);
> - if ($res->code) { # connection refused
> - warn "LDAP bind failed as ldapuser " . ($ldapname || '[ANONYMOUS]')
> . ": " . description($res);
> - return 0;
> - }
> - my $search = $db->search(
> + my $uid_field = $mapping{userid}->{is} or die
> ldapserver_error("mapping for 'userid'");
> + my $filter = Net::LDAP::Filter->new("$uid_field=$userid") or die
> "Failed to create new Net::LDAP::Filter";
> +
> + my $search = $db->search(
> base => $base,
> - filter => $filter,
> - # attrs => ['*'],
> - ) or die "LDAP search failed to return object.";
> - my $count = $search->count;
> - if ($search->code > 0) {
> - warn sprintf("LDAP Auth rejected : %s gets %d hits\n",
> $filter->as_string, $count) . description($search);
> - return 0;
> - }
> - if ($count != 1) {
> - warn sprintf("LDAP Auth rejected : %s gets %d hits\n",
> $filter->as_string, $count);
> - return 0;
> - }
> + filter => $filter,
> + # attrs => ['*'],
> + ) or die "LDAP search failed to return object.";
> + my $count = $search->count;
> + if ($search->code > 0) {
> + warn sprintf("LDAP Auth rejected : %s gets %d hits\n",
> $filter->as_string, $count) . description($search);
> + return 0;
> + }
> + if ($count != 1) {
> + warn sprintf("LDAP Auth rejected : %s gets %d hits\n",
> $filter->as_string, $count);
> + return 0;
> + }
> return $search;
> }
>
> -sub checkpw_ldap {
> - my ($dbh, $userid, $password) = @_;
> - my @hosts = split(',', $prefhost);
> - my $db = Net::LDAP->new(\...@hosts);
> - #$debug and $db->debug(5);
> - my $userldapentry;
> - if ( $ldap->{auth_by_bind} ) {
> - my $principal_name = $ldap->{principal_name};
> - if ($principal_name and $principal_name =~ /\%/) {
> +sub bind_to_ldap {
> + my $db = shift;
> + my $userid = shift;
> + my $password = shift;
> + my $res; #error code capture
> +
> + # if auth_by_bind, bind by the supplied userid and password
> + if ($ldap->{auth_by_bind} ) {
> + my $principal_name = $ldap->{principal_name};
> + if ($principal_name and $principal_name =~ /\%/) {
> $principal_name = sprintf($principal_name,$userid);
> - } else {
> + } else {
> $principal_name = $userid;
> - }
> - my $res = $db->bind( $principal_name, password => $password );
> - if ( $res->code ) {
> - $debug and warn "LDAP bind failed as kohauser $principal_name:
> ". description($res);
> + }
> + $res = $db->bind( $principal_name, password => $password );
> + if ($res->code ) { # connection refused
> + warn "LDAP bind failed as kohauser $principal_name: ".
> description($res);
> return 0;
> }
> + # otherwise, if no ldap user or password, do an anonymous bind
> + } elsif ($config{anonymous}) {
> + $res = $db->bind;
> + if ($res->code) { # connection refused
> + warn "LDAP bind failed as ANONYMOUS: " . description($res);
> + return 0;
> + }
> + # otherwise, bind by the userid supplied in checkpw_ldap (normally)
> + } else {
> + $res = $db->bind($ldapname, password => $ldappassword);
> + if ($res->code) { # connection refused
> + warn "LDAP bind failed as ldapuser $ldapname: " .
> description($res);
> + return 0;
> + }
> + }
> + #return the now bound $db
> + return $db;
> +}
>
> - # FIXME dpavlin -- we really need $userldapentry leater on even if
> using auth_by_bind!
> - my $search = search_method($db, $userid) or return 0; # warnings are
> in the sub
> - $userldapentry = $search->shift_entry;
> -
> - } else {
> - my $search = search_method($db, $userid) or return 0; # warnings
> are in the sub
> - $userldapentry = $search->shift_entry;
> - my $cmpmesg = $db->compare( $userldapentry,
> attr=>'userpassword', value => $password );
> - if ($cmpmesg->code != 6) {
> - warn "LDAP Auth rejected : invalid password for user
> '$userid'. " . description($cmpmesg);
> - return 0;
> - }
> - }
> +sub checkpw_ldap {
> + my ($dbh, $userid, $password) = @_;
> + my @hosts = split(',', $prefhost);
> + my $db = Net::LDAP->new(\...@hosts) or die "$@";
> +
> + # start TLS connection if configured. Uses TLS default settings only
> + if ($ldap->{tls}) {
> + my $tls_msg = $db->start_tls();
> + if ($tls_msg->code) { # TLS error
> + warn "TLS connection rejected: " . description($tls_msg);
> + return 0;
> + }
> + }
> +
> + # Bind to the ldap in the appropriate manner
> + $db = bind_to_ldap($db, $userid, $password);
> +
> + # search for the userid
> + my $search = search_method($db, $userid) or return 0; # warnings are
> in the sub
>
> + # dump the ldap information into userldapentry for processing
> + my $userldapentry = $search->shift_entry;
> +
> + # if we didn't bind to the userid supplied, we need to do a
> password compare
> + unless ($ldap->{auth_by_bind}) {
> + my $cmpmesg = $db->compare( $userldapentry, attr=>'userpassword',
> value => $password );
> + if ($cmpmesg->code != 6) {
> + warn "LDAP Auth rejected : invalid password for user
> '$userid'. " . description($cmpmesg);
> + return 0;
> + }
> + }
> +
> # To get here, LDAP has accepted our user's login attempt.
> # But we still have work to do. See perldoc below for detailed
> breakdown.
>
> my (%borrower);
> - my ($borrowernumber,$cardnumber,$local_userid,$savedpw) =
> exists_local($userid);
> + my ($borrowernumber,$cardnumber,$local_userid,$savedpw) =
> exists_local($userid);
>
> if (( $borrowernumber and $config{update} ) or
> (!$borrowernumber and $config{replicate}) ) {
> @@ -155,7 +188,6 @@ sub checkpw_ldap {
> ($cardnumber eq $c2) or warn "update_local returned cardnumber
> '$c2' instead of '$cardnumber'";
> } else { # C1, D1
> # maybe update just the password?
> - return(1, $cardnumber); # FIXME dpavlin -- don't destroy
> ExtendedPatronAttributes
> }
> } elsif ($config{replicate}) { # A2, C2
> $borrowernumber = AddMember(%borrower) or die "AddMember failed";
> @@ -166,7 +198,6 @@ sub checkpw_ldap {
> my @types = C4::Members::AttributeTypes::GetAttributeTypes();
> my @attributes = grep{my $key=$_; any{$_ eq $k...@types;} keys
> %borrower;
> my $extended_patron_attributes =
> map{{code=>$_,value=>$borrower{$_...@attributes;
> - my $extended_patron_attributes = [] unless
> $extended_patron_attributes;
> my @errors;
> #Check before add
> for (my $i; $i< scalar(@$extended_patron_attributes)-1;$i++) {
> @@ -385,6 +416,7 @@ Example XML stanza for LDAP configuration in KOHA_CONF.
> password comparison, e.g., to use
> Active Directory -->
> <principal_name>%...@my_domain.com</principal_name>
> <!-- optional, for auth_by_bind: a printf
> format to make userPrincipalName from koha userid -->
> + <tls>0</tls> <!-- set to 1 to use Transport Layer Security
> (TLS) -->
> <mapping> <!-- match koha SQL field names to your LDAP
> record field names -->
> <firstname is="givenname" ></firstname>
> <surname is="sn" ></surname>
> diff --git a/Makefile.PL b/Makefile.PL
> index c88d5ea..e4f6897 100644
> --- a/Makefile.PL
> +++ b/Makefile.PL
> @@ -570,6 +570,7 @@ WriteMakefile(
> 'HTTP::OAI' => 3.20,
> 'HTTP::Request::Common' => 1.26,
> 'IPC::Cmd' => 0.46,
> + 'IO::Socket::SSL' => 1.33,
> 'JSON' => 2.07, #
> Needed by admin/item_circulation_alerts.pl
> 'LWP::Simple' => 1.41,
> 'LWP::UserAgent' => 2.033,
> diff --git a/about.pl b/about.pl
> index 04a9675..ecdfdc2 100755
> --- a/about.pl
> +++ b/about.pl
> @@ -94,6 +94,7 @@ HTTP::OAI
> HTTP::Request::Common
> HTML::Scrubber
> IPC::Cmd
> +IO::Socket::SSL
> JSON
> LWP::Simple
> LWP::UserAgent
> diff --git a/install_misc/debian.packages b/install_misc/debian.packages
> index 11dfeb4..23a1af6 100644
> --- a/install_misc/debian.packages
> +++ b/install_misc/debian.packages
> @@ -39,6 +39,7 @@ libidzebra-2.0-mod-grs-xml install
> libidzebra-2.0-mod-text install
> libidzebra-2.0-modules install
> libimage-magick-perl install
> +libio-socket-ssl-perl install
> libjson-perl install
> liblingua-ispell-perl install
> liblingua-stem-perl install
> --
> 1.5.6.5
>
> _______________________________________________
> Koha-patches mailing list
> Koha-patches@lists.koha.org
> http://lists.koha.org/mailman/listinfo/koha-patches
--
Dobrica Pavlinusic 2share!2flame dpav...@rot13.org
Unix addict. Internet consultant. http://www.rot13.org/~dpavlin
_______________________________________________
Koha-patches mailing list
Koha-patches@lists.koha.org
http://lists.koha.org/mailman/listinfo/koha-patches
