Attached is a potential fix for this. Note that is also renames the
error method for fetching the password policy error to be called
pp_error. This is because there is already an error method in the
Control base class which has a different purpose.
A diff can also be seen at
http://git.goingon.net/?p=perl-ldap.git;a=commitdiff;h=1db4bbb61f5f68a3a7ff178e58818db62e94c398
Graham.
# Copyright (c) 2008 Chris Ridd <[EMAIL PROTECTED]>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
package Net::LDAP::Control::PasswordPolicy;
use vars qw(@ISA $VERSION);
use Net::LDAP::Control;
@ISA = qw(Net::LDAP::Control);
$VERSION = "0.02";
use Net::LDAP::ASN qw(ppControlResponse);
use strict;
sub init {
my($self) = @_;
delete $self->{asn};
unless (exists $self->{value}) {
$self->{asn} = \my %asn;
if (defined($self->{time_before_expiration})) {
$asn{warning}{timeBeforeExpiration} = defined($self->{time_before_expiration});
}
elsif (defined($self->{grace_authentications_remaining})) {
$asn{warning}{graceAuthNsRemaining} = $self->{time_before_expiration};
}
if (defined($self->{pp_error})) {
$asn{error} = $self->{pp_error};
}
}
$self;
}
sub time_before_expiration {
my $self = shift;
$self->{asn} ||= $ppControlResponse->decode($self->{value});
if (@_) {
delete $self->{value};
my $time = shift;
if (defined $time) {
$self->{asn}{warning} = { timeBeforeExpiration => $time };
}
elsif (my $warning = $self->{asn}{warning}) {
if (exists $warning->{timeBeforeExpiration}) {
delete $self->{asn}{warning};
}
}
return $time;
}
my $warning = $self->{asn}{warning};
$warning && $warning->{timeBeforeExpiration};
}
sub grace_authentications_remaining {
my $self = shift;
$self->{asn} ||= $ppControlResponse->decode($self->{value});
if (@_) {
delete $self->{value};
my $remaining = shift;
if (defined $remaining) {
$self->{asn}{warning} = { graceAuthNsRemaining => $remaining };
}
elsif (my $warning = $self->{asn}{warning}) {
if (exists $warning->{graceAuthNsRemaining}) {
delete $self->{asn}{warning};
}
}
return $remaining;
}
my $warning = $self->{asn}{warning};
$warning && $warning->{graceAuthNsRemaining};
}
sub pp_error {
my $self = shift;
$self->{asn} ||= $ppControlResponse->decode($self->{value});
if (@_) {
delete $self->{value};
return $self->{asn}{error} = shift;
}
$self->{asn}{error};
}
sub value {
my $self = shift;
exists $self->{value}
? $self->{value}
: $self->{value} = $ppControlResponse->encode($self->{asn});
}
1;
__END__
=head1 NAME
Net::LDAP::Control::PasswordPolicy - LDAPv3 Password Policy control object
=head1 SYNOPSIS
use Net::LDAP;
use Net::LDAP::Control::PasswordPolicy;
use Net::LDAP::Constant qw( LDAP_CONTROL_PASSWORDPOLICY );
$ldap = Net::LDAP->new( "ldap.example.com" );
$pp = Net::LDAP::Control::PasswordPolicy->new;
$mesg = $ldap->bind( "cn=Bob Smith,dc=example,dc=com",
password => "secret",
control => [ $pp ] );
# Get password policy reponse
my($resp) = $mesg->control( LDAP_CONTROL_PASSWORDPOLICY );
if (defined($resp)) {
my $v = $resp->pp_error;
print "Password policy error $v\n" if defined $v;
$v = $resp->time_before_expiration;
print "Password expires in $v second(s)\n" if defined $v;
}
=head1 DESCRIPTION
C<Net::LDAP::Control::PasswordPolicy> provides an interface for the
creation and manipulation of objects that represent
C<PasswordPolicyRequest>s and C<PasswordPolicyResponse>s as described by
draft-behera-password-policy-09.
This control can be passed to most operations, including the bind.
=head1 CONSTRUCTOR ARGUMENTS
There are no constructor arguments other than those provided by
L<Net::LDAP::Control>.
=head1 METHODS
=over 4
=item time_before_expiration
If defined, this is an integer value holding the time left in seconds
before the account's password will expire.
=item grace_authentications_remaining
If defined, this is an integer value holding the number of
authentication requests allowed before the account is locked.
=item pp_error
If defined, this contains a more detailed error code for the account.
See L<Net::LDAP::Constant> for definitions of each.
Values can include:
=over 4
=item LDAP_PP_PASSWORD_EXPIRED
=item LDAP_PP_ACCOUNT_LOCKED
=item LDAP_PP_CHANGE_AFTER_RESET
=item LDAP_PP_PASSWORD_MOD_NOT_ALLOWED
=item LDAP_PP_MUST_SUPPLY_OLD_PASSWORD
=item LDAP_PP_INSUFFICIENT_PASSWORD_QUALITY
=item LDAP_PP_PASSWORD_TOO_SHORT
=item LDAP_PP_PASSWORD_TOO_YOUNG
=item LDAP_PP_PASSWORD_IN_HISTORY
=back
=back
=head1 SEE ALSO
L<Net::LDAP>,
L<Net::LDAP::Control>,
L<Net::LDAP::Constant>,
draft-behera-ldap-password-policy-09.txt
=head1 AUTHOR
Chris Ridd E<lt>[EMAIL PROTECTED]<gt>
Please report any bugs, or post any suggestions, to the perl-ldap
mailing list E<lt>[EMAIL PROTECTED]<gt>
=head1 COPYRIGHT
Copyright (c) 2008 Chris Ridd. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.
=cut
On Sep 1, 2008, at 11:05 AM, Clément OUDOT wrote:
Hello,
I'm using the PP control to retrieve warning (time to expiration and
authn
remaining). But it seems the dedicated functions
time_before_expiration()
and grace_authentications_remaining() are not wroking.
I run this:
-----------------------
print "Time before expiration:".$resp->time_before_expiration."\n";
print "Time before
expiration:".$resp->{asn}->{warning}->{timeBeforeExpiration}."\n";
------------------------
And the result is:
------------------------
Time before expiration:
Time before expiration:1249
------------------------
So the control is well formed (I can check it with Data::Dumper),
but I
can read the value only by browing the HASH and with the dedicated
function.
I use perl-ldap 0.36 on Linux CentOS 5.2.
Any idea?
Clément OUDOT.
