projekt kivitendo

package SL::Auth::PasswordPolicy;

use strict;

use parent qw(Rose::Object);

use constant OK                   =>  0;

use constant TOO_SHORT            =>  1;

use constant TOO_LONG             =>  2;

use constant MISSING_LOWERCASE    =>  4;

use constant MISSING_UPPERCASE    =>  8;

use constant MISSING_DIGIT        => 16;

use constant MISSING_SPECIAL_CHAR => 32;

use constant INVALID_CHAR         => 64;

use Rose::Object::MakeMethods::Generic

(

 'scalar --get_set_init' => 'config',

);

sub verify {

  my ($self, $password) = @_;

  my $cfg = $self->config;

  return OK() unless $cfg && %{ $cfg };

  my $result = OK();

  $result |= TOO_SHORT()            if $cfg->{min_length}                && (length($password) < $cfg->{min_length});

  $result |= TOO_LONG()             if $cfg->{max_length}                && (length($password) > $cfg->{max_length});

  $result |= MISSING_LOWERCASE()    if $cfg->{require_lowercase}         && $password !~ m/[a-z]/;

  $result |= MISSING_UPPERCASE()    if $cfg->{require_uppercase}         && $password !~ m/[A-Z]/;

  $result |= MISSING_DIGIT()        if $cfg->{require_digit}             && $password !~ m/[0-9]/;

  $result |= MISSING_SPECIAL_CHAR() if $cfg->{require_special_character} && $password !~ $cfg->{special_characters_re};

  $result |= INVALID_CHAR()         if $cfg->{invalid_characters_re}     && $password =~ $cfg->{invalid_characters_re};

  return $result;

}

sub errors {

  my ($self, $result) = @_;

  my @errors;

  push @errors, $::locale->text('The password is too short (minimum length: #1).', $self->config->{min_length}) if $result & TOO_SHORT();

  push @errors, $::locale->text('The password is too long (maximum length: #1).',  $self->config->{max_length}) if $result & TOO_LONG();

  push @errors, $::locale->text('A lower-case character is required.')                                          if $result & MISSING_LOWERCASE();

  push @errors, $::locale->text('An upper-case character is required.')                                         if $result & MISSING_UPPERCASE();

  push @errors, $::locale->text('A digit is required.')                                                         if $result & MISSING_DIGIT();

  if ($result & MISSING_SPECIAL_CHAR()) {

    my $char_list = join ' ', sort split(m//, $self->config->{special_characters});

    push @errors, $::locale->text('A special character is required (valid characters: #1).', $char_list);

  }

  if (($result & INVALID_CHAR())) {

    my $char_list = join ' ', sort split(m//, $self->config->{ $self->config->{invalid_characters} ? 'invalid_characters' : 'valid_characters' });

    push @errors, $::locale->text('An invalid character was used (invalid characters: #1).', $char_list) if $self->config->{invalid_characters};

    push @errors, $::locale->text('An invalid character was used (valid characters: #1).',   $char_list) if $self->config->{valid_characters};

  }

  return @errors;

}

sub init_config {

  my ($self) = @_;

  my %cfg = %{ $::emmvee_conf{password_policy} || {} };

  $cfg{valid_characters}      =~ s/[ \n\r]//g if $cfg{valid_characters};

  $cfg{invalid_characters}    =~ s/[ \n\r]//g if $cfg{invalid_characters};

  $cfg{invalid_characters_re} =  '[^' . quotemeta($cfg{valid_characters})   . ']' if $cfg{valid_characters};

  $cfg{invalid_characters_re} =  '['  . quotemeta($cfg{invalid_characters}) . ']' if $cfg{invalid_characters};

  $cfg{special_characters}    =  '!@#$%^&*()_+=[]{}<>\'"|\\,;.:?-';

  $cfg{special_characters_re} =  '[' . quotemeta($cfg{special_characters}) . ']';

  print $cfg{special_characters_re}, "\n";

  map { $cfg{"require_${_}"} = $cfg{"require_${_}"} =~ m/^(?:1|true|t|yes|y)$/i } qw(lowercase uppercase digit special_char);

  $self->config(\%cfg);

}

1;

__END__

=pod

=encoding utf8

=head1 NAME

SL::Auth::PasswordPolicy - Verify a given password against the policy

set in the configuration file

=head1 SYNOPSIS

 my $verifier = SL::Auth::PasswordPolicy->new;

 my $result   = $verifier->verify($password);

 if ($result != SL::Auth::PasswordPolicy->OK()) {

   print "Errors: " . join(' ', $verifier->errors($result)) . "\n";

 }

=head1 CONSTANTS

=over 4

=item C<OK>

Password is OK.

=item C<TOO_SHORT>

The password is too short.

=item C<TOO_LONG>

The password is too long.

=item C<MISSING_LOWERCASE>

The password is missing a lower-case character.

=item C<MISSING_UPPERCASE>

The password is missing an upper-case character.

=item C<MISSING_DIGIT>

The password is missing a digit.

=item C<MISSING_SPECIAL_CHAR>

The password is missing a special character. Special characters are

the following: ! " # $ % & ' ( ) * + , - . : ; E<lt> = E<gt> ? @ [ \ ]

^ _ { | }

=item C<INVALID_CHAR>

The password contains an invalid character.

=back

=head1 FUNCTIONS

=over 4

=item C<verify $password>

Checks whether or not the password matches the policy. Returns C<OK()>

if it does and an error code otherwise (binary or'ed of the error

constants).

=item C<errors $code>

Returns an array of human-readable strings describing the issues set

in C<$code> which should be the result of L</verify>.

=back

=head1 BUGS

Nothing here yet.

=head1 AUTHOR

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>

=cut

# Settings used when the user changes his/her password. All options

# default to no restriction if unset.

[password_policy]

# Minimum length in number of characters.

min_length =

# Maximum length in number of characters.

max_length =

# Require a lowe-case character?

require_lowercase =

# Require an upper-case character?

require_uppercase =

# Require a digit?

require_digit =

# Require a special char? Special chars are the following:

# ! " # $ % & ' ( ) * + , - . : ; < = > ? @ [ \ ] ^ _ { | }

require_special_character =

# Optional list of valid characters. Spaces are ignored. If set then

# the password must only consist of these characters.

valid_characters =

# Optional list of invalid characters. Spaces are ignored.

invalid_characters =

# Whether or not to check the policy if the password is set from the

# user administration.

disable_policy_for_admin =

  'A digit is required.'        => 'Eine Ziffer ist vorgeschrieben.',

  'A lower-case character is required.' => 'Ein Kleinbuchstabe ist vorgeschrieben.',

  'A special character is required (valid characters: #1).' => 'Ein Sonderzeichen ist vorgeschrieben (gültige Zeichen: #1).',

  'An invalid character was used (invalid characters: #1).' => 'Ein ungültiges Zeichen wurde benutzt (ungültige Zeichen: #1).',

  'An invalid character was used (valid characters: #1).' => 'Ein ungültiges Zeichen wurde benutzt (gültige Zeichen: #1).',

  'An upper-case character is required.' => 'Ein Großbuchstabe ist vorgeschrieben.',

  'The password is too long (maximum length: #1).' => 'Das Passwort ist zu lang (maximale Länge: #1).',

  'The password is too short (minimum length: #1).' => 'Das Password ist zu kurz (minimale Länge: #1).',

my @progdirs     = ( "$basedir/SL/Controller", "$basedir/SL/Template/Plugin", "$basedir/SL/Auth" );