- added password weakness display feature in interactive

- adduserdrake
  o now use password weakness display

5 files changed, 58 insertions, 2 deletions

diff --git a/perl-install/NEWS b/perl-install/NEWS
index c795a1836..20165b364 100644
--- a/perl-install/NEWS
+++ b/perl-install/NEWS
@@ -1,3 +1,6 @@
+- adduserdrake
+  o now use password weakness display
+- added password weakness display feature in interactive
 - handle new drivers: 
   o sound: snd_ctxfi
 - draksound
diff --git a/perl-install/any.pm b/perl-install/any.pm
index 472db55c7..595c2af9e 100644
--- a/perl-install/any.pm
+++ b/perl-install/any.pm
@@ -822,7 +822,7 @@ sub ask_user_and_root {
 
           { label => N("Login name"), val => \$u->{name}, list => \@suggested_names, alignment => 'right',
             not_edit => 0, validate => $validate_name },
-          { label => N("Password"),val => \$u->{password}, hidden => 1, alignment => 'right',
+          { label => N("Password"),val => \$u->{password}, hidden => 1, alignment => 'right', weakness_check => 1,
 	    validate => sub { authentication::check_given_password($in, $u, $security > 3 ? 6 : 0) } },
           { label => N("Password (again)"), val => \$u->{password2}, hidden => 1, alignment => 'right' },
           { label => N("Shell"), val => \$u->{shell}, list => [ shells() ], advanced => 1 },
diff --git a/perl-install/authentication.pm b/perl-install/authentication.pm
index fba1b7290..34cb12e9d 100644
--- a/perl-install/authentication.pm
+++ b/perl-install/authentication.pm
@@ -967,4 +967,35 @@ sub configure_nss_ldap {
                 );
         }
  }
+
+ sub compute_password_weakness {
+
+   my ($password) = @_;
+   my $score = 0;
+   my $len = length($password);
+
+   return 0 if $len == 0;
+
+   $score = $len < 5 ? 3 :
+   $len > 4 && $len < 8 ? 6 :
+   $len > 7 && $len < 16 ? 12 : 18;
+
+   $score += 1 if $password =~ /[a-z]/;
+   $score += 5 if $password =~ /[A-Z]/;
+   $score += 5 if $password =~ /\d+/;
+   $score += 5 if $password =~ /(.*[0-9].*[0-9].*[0-9])/;
+   $score += 5 if $password =~ /.[!@#$%^&*?_~,]/;
+   $score += 5 if $password =~ /(.*[!@#$%^&*?_~,].*[!@#$%^&*?_~,])/;
+   $score += 2 if $password =~ /([a-z].*[A-Z])|([A-Z].*[a-z])/;
+   $score += 2 if $password =~ /([a-zA-Z])/ && $password =~ /([0-9])/;
+   $score += 2 if $password =~ /([a-z].*[A-Z])|([A-Z].*[a-z])/;
+   $score += 2 if $password =~ /([a-zA-Z0-9].*[!@#$%^&*?_~])|([!@#$%^&*?_~,].*[a-zA-Z0-9])/;
+
+   my $level = $score < 16 ? 1 :
+   $score > 15 && $score < 25 ? 2 :
+   $score > 24 && $score < 35 ? 3 :
+   $score > 34 && $score < 45 ? 4 : 5;
+
+   return $level;
+ }
 1;
diff --git a/perl-install/install/NEWS b/perl-install/install/NEWS
index 17b986428..5af874d02 100644
--- a/perl-install/install/NEWS
+++ b/perl-install/install/NEWS
@@ -1,3 +1,6 @@
+- adduserdrake
+  o now use password weakness display
+- added password weakness display feature in interactive
 - handle new drivers: 
   o sound: snd_ctxfi
 - set virtio/xen block modules in a section actually offered
diff --git a/perl-install/interactive/gtk.pm b/perl-install/interactive/gtk.pm
index 4a93934e1..e6ad4aaff 100644
--- a/perl-install/interactive/gtk.pm
+++ b/perl-install/interactive/gtk.pm
@@ -545,7 +545,14 @@ sub create_widget {
 	    };
 	} else {
 	    $w = Gtk2::Entry->new;
-	    $w->signal_connect(changed => $onchange->(sub { $w->get_text }));
+	    $w->signal_connect(changed => $onchange->(sub { 
+	       if ($e->{weakness_check}) {
+		 require authentication;
+		 my $password_weakness = authentication::compute_password_weakness($w->get_text);
+		 $w->modify_base('GTK_STATE_NORMAL', get_weakness_color($password_weakness));
+	       }
+	       $w->get_text;
+	      }));
 	    $w->signal_connect(focus_in_event => sub { $w->select_region(0, -1) });
 	    $w->signal_connect(focus_out_event => sub { $w->select_region(0, 0) });
 	    $set = sub { $w->set_text($_[0]) if $_[0] ne $w->get_text };
@@ -958,4 +965,16 @@ sub kill {
     @tempory::objects = ();
 }
 
+sub get_weakness_color {
+    my ($password_weakness) = @_;
+    my %weakness_color = (
+        1 => '#fd3434', 
+        2 => '#fd6c34',
+        3 => '#f7871a',
+        4 => '#2ae000', 
+        5 => '#30ff00');
+    my $weakness_color = $weakness_color{$password_weakness} || '#ffffff';
+    Gtk2::Gdk::Color->parse($weakness_color);
+}
+
 1;