X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/0b2ca0abb53db0d372bcc51e8093abb30f2aeea6..03c526b3b946d62f95ce78420552d62b39e03bed:/SL/Auth/PasswordPolicy.pm

diff --git a/SL/Auth/PasswordPolicy.pm b/SL/Auth/PasswordPolicy.pm
new file mode 100644
index 000000000..866e49c1e
--- /dev/null
+++ b/SL/Auth/PasswordPolicy.pm
@@ -0,0 +1,168 @@
+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