This is what went out from these two nodes. It is a routine that, given a username and his password and personal information (name, surname, city), checks for:

I am considering about making a module out of it. In the meanwhile, just take this snippet :-)

#!/usr/bin/perl
#
# call this file passcheck.pl in order to test it with the
# test script

use strict ;
use warnings ;

sub passcheck {
  my ($username,$password,$name,$surname,$city) = @_ ;

  my ($minlen,$maxlen,$maxfreq) = (5,8,.5) ;
  my $plen                      = length $password ;
  # Check length
  {
    return "password is too short" if $plen < $minlen ;
    return "password is too long"  if $plen > $maxlen ;
  }

  # Password contains alphas, digits and non-alpha-digits
  {
    local $_ = $password ;
    return "Password must contain alphanumeric characters, digits and 
+symbols"
      unless /[a-z]/i and /\d/ and /[^a-z0-9]/i ;
  }

  # Check repetitions
  {
    my @chars = split //,$password ;
    my %unique ;
    my $maxcount = $maxfreq * $plen ;
    foreach my $char (@chars) { $unique{$char}++ } ;
    while (my ($char,$count) = each %unique) {
      # Too much repetitions if $count/$plen > $maxfreq; but we could
      # also write $count > $maxfreq * $plen, and since we precomputed
      # $maxcount = $maxfreq * $plen, we are working on simple
      # constants (faster than doing $count/$plen at each iteration).
      return "Too many repetions of char $char"
        if $count > $maxcount ;
    }
  }

  # rotations of the password don't match it
  {
    foreach my $rot (rotations($password)) {
      return "Password matches itself after some left rotation"
        if $rot eq $password ;
    }
  }

  # Check password against username, name, surname and city All but
  # username could be composed, like "Alan Louis", or "Di Cioccio" or
  # "Los Angeles", so we have to treat each chunk separately.  But we
  # should also check for passwords like "alanlouis", or "dicioccio"
  # or "losangeles". So we must add them, too.
  {
    # Prepare password rotations; check reverse password and reverse
    # password rotations, too

    my $pclean                    = lc $password ;
    $pclean =~ s/[^a-z]//g ;
    my $rpclean = reverse $pclean ;
    my @prots = ($pclean, rotations($pclean),
                 $rpclean,rotations($rpclean)) ;

    # Prepare personal information to match @prots against
    ($name,$surname,$city) = map lc,($name,$surname,$city)  ;
    my @chunks = split(/\s+/,lc(join(" ",$name,$surname,$city))) ;
    foreach ($name,$surname,$city) {
      if (/\s/) {
        s/\s// ;
        push @chunks,$_ ;
      }
    }
    push @chunks,lc $username ;

    my $idx ;
    foreach my $chunk (@chunks) {
      my $chunklen = length $chunk ;
      foreach my $rot (@prots) {
        # note that length $rot is $plen
        $idx = $chunklen >= $plen?
          index $chunk,$rot:
          index $rot,$chunk;
        return "password matches personal data after some left rotatio
+n [$rot,$chunk]"
          unless $idx == -1 ;
      }
    }
  }


  return "password ok" ;
}

sub rotations {
  my $string = shift ;
  my $n      = length $string ;
  my @result ;

  # note: $i < $n, since the n-th permutation is the password again
  for (my $i = 1 ; $i < $n ; $i++) {
    $string = chop($string).$string ;
    push @result,$string ;
  }
  return @result ;
}

1 ;

[download]

Replies are listed 'Best First'.
Re: Basic password checking
by Abigail-II (Bishop) on Jul 30, 2003 at 12:42 UTC
    So, if passwords have to be at least 6 characters, and at most 15, you reject a1@a1@, but accept a1@a1@b. However, you accept a1@a1@ba1@a1@, but reject a1@a1@ba1@a1@b.

    Passwords can go from 'accepted' to 'rejected' by adding characters. And worse, it will be rejected because it repeats part of itself - but the part alone will be accepted.

    IMO, if you want to do something with the repeatedness, you should only test the first N characters, where N is minimum amount of characters allowed.

    Abigail

[reply]
      you accept a1@a1@ba1@a1@, but reject a1@a1@ba1@a1@b

      Yes, unfortunately

      IMO, if you want to do something with the repeatedness, you should only test the first N characters, where N is minimum amount of characters allowed.

      I don't agree. In fact, if you use ba1@a1@a1@a1@b you are stuck again with the same problem: the password is full of similar characters, but... acceptable. To make things work better you could check all N-wide windows of the password for repetitions (that is, for N=6, ba1@a1, a1@a1@, 1@a1@a...). So if password is M > N long, you should check the M-N N-wide sections of the passwords, or, better and safer, the first N characters of each of the M rotations of the password itself...

      Would it be computationally affordable? Should check...

      Ciao!
      --bronto

      The very nature of Perl to be like natural language--inconsistant and full of dwim and special cases--makes it impossible to know it all without simply memorizing the documentation (which is not complete or totally correct anyway).
      --John M. Dlugosz
[reply]
[d/l]
        I don't agree. In fact, if you use ba1@a1@a1@a1@b you are stuck again with the same problem: the password is full of similar characters, but... acceptable.

        Yes, and? Because you already accept passwords with only N characters, you shouldn't reject a password of N + k characters because there's repetition in the final k characters. If it's ok for the final k characters to not be there, they can't make it easier to guess the password if they are there.

        If ba1@a1 doesn't contain too much repetition, and hence is save, then ba1@a1@a1@a1@b should be save too. I mean, it doesn't get easier to break in your house if you add a lock on your door, even if that lock uses the same key as one of your other locks? It may not contribute much, but it doesn't make it go from save to unsave.

        Abigail

[reply]
Basic password checking: the test
by bronto (Priest) on Jul 30, 2003 at 12:29 UTC

    ...and here is the test:

    #!/usr/bin/perl

use Test::More qw(no_plan) ;

my ($username,@userinfo) =
  (qw(bronto Marco Marongiu),'San Gavino') ;

my $good = 'c0m&c@z%' ;
my @passwords = ('shrt',       # too short
                 'waytoolong', # too long
                 'pitbull',    # doesn't contain digits/symbols
                 '!@#$%^&',    # doesn't contain digits/alphas
                 '12345678',   # doesn't contain symbols/alphas
                 'pitbul1',    # doesn't contain symbols
                 'pitbull@',   # doesn't contain digits
                 '!@#$1234',   # doesn't contain alphas
                 'manyyyyy',   # too many y's
                 't1c&t1c&',   # password matches itself after rotatio
+ns
                 'nto1bro%',   # stripped rot. password matches userna
+me
                 'oc$ra1m;',   # stripped reversed password matches na
+me
                 "comar1\$",   # stripped rot. password matches name
                 'ma0$ron',    # stripped rot. password matches surnam
+e
                 'sang@v1n',   # stripped rot. password matches city
                 '!gavian0',   # stripped rot. password and city match
) ;

my $ok = "password ok" ;

require './passcheck.pl' ;

is($ok,passcheck($username,$good,@userinfo),"$good is good") ;

foreach (@passwords) {
  my $check = passcheck($username,$_,@userinfo) ;
  isnt($ok,$check,"$_: $check") ;
}

    [download]

    Ciao!
    --bronto

    The very nature of Perl to be like natural language--inconsistant and full of dwim and special cases--makes it impossible to know it all without simply memorizing the documentation (which is not complete or totally correct anyway).
    --John M. Dlugosz
[reply]
[d/l]

Back to Cool Uses for Perl