#!/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]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.