Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Greetings, keepers of knowledge.

I'm putting together a password checking script for Asterisk voicemail; one of the things I want to disallow is the use of a password that's got too many consecutive digits. "1234" being the classic example, but also "298761" or "4562".

PHP is my usual language, but it's not available, so I went with Perl, since I used it many years ago, and the two share a lot of common syntax. The code I have works, but I feel like there should be a better way, that doesn't take so many lines of code to go through every digit twice.

    my $password = $2;
    my $limit = 3; # want to reject 4568 but not 4578

    my $counter = 0;
    my $i = 0;
    my @digits = split(//, $password);
    my $pwlength = @digits;

    for ($i = 0; $i < $pwlength - 1; $i++) {
        if ($digits[$i] + 1 == $digits[$i + 1]) {
            $counter += 1;
        } else {
            $counter = 0;
        }
        if ($counter >= $limit) {
            exit 1;
        }
    }

    $counter = 0;
    for ($i = 0; $i < $pwlength - 1; $i++) {
        if ($digits[$i] - 1 == $digits[$i + 1]) {
            $counter += 1;
        } else {
            $counter = 0;
        }
        if ($counter >= $limit) {
            exit 1;
        }
    }

[download]

Replies are listed 'Best First'.
Re: Check a string for consecutive digits
by AnomalousMonk (Archbishop) on Nov 26, 2015 at 06:24 UTC

    Another way, and configurable, but uses Perl 5.10 regex extensions: 

    c:\@Work\Perl\monks>perl -wMstrict -le
"use 5.010;
 ;;
 my $too_many_consec = qr{
   (?(?{ index('0123456789', $^N) < 0 && index('9876543210', $^N) < 0 
+}) (*FAIL))
   }xms;
 ;;
 my $min = 4;
 for my $s (qw(
   123 321  2123 2321  1232 3212 21232 23212
   1234 4321  21234 34321  12343 43212  212343 343212
   12345 54321  212345 454321  123454 543212  2123454 4543212
   )) {
   printf qq{'$s' -> };
   print $s =~ m{ (\d{$min,10}) $too_many_consec }xms
         ? qq{too many consec: '$1'}
         : 'consec free'
         ;
   }
"
'123' -> consec free
'321' -> consec free
'2123' -> consec free
'2321' -> consec free
'1232' -> consec free
'3212' -> consec free
'21232' -> consec free
'23212' -> consec free
'1234' -> too many consec: '1234'
'4321' -> too many consec: '4321'
'21234' -> too many consec: '1234'
'34321' -> too many consec: '4321'
'12343' -> too many consec: '1234'
'43212' -> too many consec: '4321'
'212343' -> too many consec: '1234'
'343212' -> too many consec: '4321'
'12345' -> too many consec: '12345'
'54321' -> too many consec: '54321'
'212345' -> too many consec: '12345'
'454321' -> too many consec: '54321'
'123454' -> too many consec: '12345'
'543212' -> too many consec: '54321'
'2123454' -> too many consec: '12345'
'4543212' -> too many consec: '54321'

    [download]
    Extended Patterns used are  (?(condition)yes-pattern|no-pattern) and  (*FAIL) (see Special Backtracking Control Verbs).

    Updates:

    1. Actually, the upper limit of 10 in
          m{ (\d{$min,10}) $too_many_consec }xms
      is not needed, and this works just as well written as
          m{ (\d{$min,}) $too_many_consec }xms
      instead. The unneeded upper limit might even be regarded as a potential future pitfall: what if you extend this approach to alphabetic consecutive runs and forget to change the limit?
    2. Another afterthought: The regex object  $too_many_consec is misnamed. The "too many" function is fulfilled by the lower limit  $min of the counted quantifier; the regex following the capture group only tests for (and fails in the absence of) consecutivity in the capture, and so should be named something like  $consecutive instead.

    Give a man a fish:  <%-{-{-{-<

[reply]
[d/l]
[select]
Re: Check a string for consecutive digits
by johngg (Canon) on Nov 25, 2015 at 23:16 UTC

    You could use match-time pattern interpolation.

    $ perl -Mstrict -Mwarnings -E '
say m{(?x) ( \d ) (??{ ( $1 + 1 ) . ( $1 + 2 ) . ( $1 + 3 ) }) }
   ? qq{$_ - Match}
   : qq{$_ - No match}
   for qw{ abc ab12c 2345 234y 01234 };'
abc - No match
ab12c - No match
2345 - Match
234y - No match
01234 - Match
$

    [download]

    I hope this is helpful.

    Cheers,

    JohnGG

[reply]
[d/l]

      Thanks for that, it looked like complete gibberish 20 minutes ago but after some searching I have a handle on most of it now.

      I've reduced it down to this:

      exit 1 if $password =~ /(?x) ( \d ) (??{ ( $1 + 1 ) . ( $1 + 2 ) . ( $1 + 3 ) })/

      Can this be easily adapted to allow an arbitrary number of consecutive digits? In my current code, the limit is configurable.

[reply]

        Sorry for the slow reply, $work rather got in the way. Yes, it can be adapted quite easily:-

        use strict;
use warnings;

use 5.014;
use re qw{ eval };

my $max = shift || 3;

my $ascPatt  =
   q{(?x) ( \d ) (??{ join q{}, map { $1 + $_ } 1 .. $max }) };
my $descPatt =
   q{(?x) ( \d ) (??{ join q{}, map { $1 - $_ } 1 .. $max }) };

my @passwords = qw{
   1234 1243 4321 298761 4562 4568 4578 123 12 1
   01234 01243 04321 0298761 04562 04568 04578 0123 012 01
   a1234 1a234 12a34 123a4 1234a
   a1b2c3 a12b34c56 a1b2c3d a12b34c56d
   a123b45c6 a12b345c6 a123b45c6d a12b345c6d
   1a2 1ab2 12ab34 12abc34def 12abc34def567
   abc ab12c 2345 234y 01234 2356
   };

say
   qq{$_ - },
   checkConsec( $_ )
   ? q{too many consecutive digits}
   : q{pass}
   for @passwords;


sub checkConsec
{
    my $pw = shift;
    return 1 if $pw =~ m{$ascPatt};
    return 1 if $pw =~ m{$descPatt};
    return 0;
}

        [download]

        Three runs, the first using the default of no more than three consecutive digits, then four and two.

        Read more... (3 kB)

        I hope this is helpful.

        Cheers,

        JohnGG

[reply]
[d/l]
[select]
Re: Check a string for consecutive digits
by CountZero (Bishop) on Nov 26, 2015 at 08:43 UTC
    Actually, such artificial restrictions enormously reduce the key-space and really make it a few magnitudes easier to break the passwords by brute force attacks.

    The only "good" restriction is to force the users to use a long password, say 15 or 20 characters at least. Not only is it safer, usually it makes it easier to remember it too and avoids automatically the "1234" type of passwords.

    CountZero

    A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

    My blog: Imperial Deltronics
[reply]
Re: Check a string for consecutive digits
by kcott (Archbishop) on Nov 26, 2015 at 06:50 UTC

    All posts at the time of writing, including the OP, seem to assume that passwords only contain digits; at least, that's all that's being tested. I see nothing at Asterisk Voicemail (or pages that links to) to indicate this restriction. Accordingly, 'a12b543c', for instance, would be valid (as a standard password) but invalid (under your consecutive digits special rules).

    In the test script below, sequential digits are pulled from the whole password; canonicalised into ascending order (e.g. 'a12b543c' would produce the two sequences, '12' and '345', for checking); tested for consecutiveness; and rejected immediately any check fails. 

    #!/usr/bin/env perl -l

use strict;
use warnings;

my @passwords = qw{
    1234 1243 4321 298761 4562 4568 4578 123 12 1
    01234 01243 04321 0298761 04562 04568 04578 0123 012 01
    a1234 1a234 12a34 123a4 1234a
    a1b2c3 a12b34c56 a1b2c3d a12b34c56d
    a123b45c6 a12b345c6 a123b45c6d a12b345c6d
    1a2 1ab2 12ab34 12abc34def 12abc34def567
};
push @passwords, map { scalar reverse } @passwords;
my $too_many = 3;
check($_, $too_many) for @passwords;

sub check {
    my ($pw, $too_many) = @_;

    if ($too_many > length $pw) {
        pw_ok($pw);
        return;
    }

    for my $pw_digit_str (split /\D+/, $pw) {
        my $pw_digit_str_len = length $pw_digit_str;
        next if $too_many > $pw_digit_str_len;

        OFFSET:
        for my $offset (0 .. $pw_digit_str_len - $too_many) {
            my $digits = substr $pw_digit_str, $offset, $too_many;
            my $rev_digits = scalar reverse $digits;
            my @ints = split //, $digits < $rev_digits ? $digits : $re
+v_digits;
            my $test_int = $ints[0];
            for (@ints) {
                if ($test_int != $_) {
                    next OFFSET;
                }
                ++$test_int;
            }
            pw_nok($pw);
            return;
        }
    }
    pw_ok($pw);
}

sub pw_ok  { print "Accept: $_[0]" }
sub pw_nok { print "Reject: $_[0]" }

    [download]

    This generates 76 tests (I did note a couple of duplicates). The output is in the spoiler, below. 

    Reject: 1234
Accept: 1243
Reject: 4321
Reject: 298761
Reject: 4562
Reject: 4568
Accept: 4578
Reject: 123
Accept: 12
Accept: 1
Reject: 01234
Reject: 01243
Reject: 04321
Reject: 0298761
Reject: 04562
Reject: 04568
Accept: 04578
Reject: 0123
Reject: 012
Accept: 01
Reject: a1234
Reject: 1a234
Accept: 12a34
Reject: 123a4
Reject: 1234a
Accept: a1b2c3
Accept: a12b34c56
Accept: a1b2c3d
Accept: a12b34c56d
Reject: a123b45c6
Reject: a12b345c6
Reject: a123b45c6d
Reject: a12b345c6d
Accept: 1a2
Accept: 1ab2
Accept: 12ab34
Accept: 12abc34def
Reject: 12abc34def567
Reject: 4321
Accept: 3421
Reject: 1234
Reject: 167892
Reject: 2654
Reject: 8654
Accept: 8754
Reject: 321
Accept: 21
Accept: 1
Reject: 43210
Reject: 34210
Reject: 12340
Reject: 1678920
Reject: 26540
Reject: 86540
Accept: 87540
Reject: 3210
Reject: 210
Accept: 10
Reject: 4321a
Reject: 432a1
Accept: 43a21
Reject: 4a321
Reject: a4321
Accept: 3c2b1a
Accept: 65c43b21a
Accept: d3c2b1a
Accept: d65c43b21a
Reject: 6c54b321a
Reject: 6c543b21a
Reject: d6c54b321a
Reject: d6c543b21a
Accept: 2a1
Accept: 2ba1
Accept: 43ba21
Accept: fed43cba21
Reject: 765fed43cba21

    [download]

    I've covered many edge cases. Don't assume I've caught them all.

    — Ken

[reply]
[d/l]
[select]
      All posts at the time of writing, including the OP, seem to assume that passwords only contain digits; at least, that's all that's being tested.

      The code above produces the same output as yours with your test set and suitable modification to the print statement and  $min set to 3.

      Give a man a fish:  <%-{-{-{-<

[reply]
[d/l]
[select]

        OK, that's good.

        FWIW, you hadn't posted when I started to write my response but, clearly, you did post before I did.

        "All posts at the time of writing" did not include your post; however, I can see that isn't obvious.

        My apologies for any unintended confusion.

        — Ken

[reply]
      All posts at the time of writing, including the OP, seem to assume that passwords only contain digits; at least, that's all that's being tested.
      That's not true, only the OP's method assumes that. All others work with any passwords.
[reply]
        "That's not true, ..."

        It appears I missed the test data: 

        qw{ abc ab12c 2345 234y 01234 }

        [download]

        from johngg's post.

        I've rechecked and I'm pretty sure that's the only one with test data not containing only digits.

        "All others work with any passwords."

        While that maybe true, I've no idea why you thought it was important to state it. I made no reference to what code did or didn't work. I did comment on test data.

        — Ken

[reply]
[d/l]
      Thanks for the reply and the code. This is a password that's sent over the phone, so has to be entered with the phone keypad. I'll grant you that A, B, C, and D are all valid DTMF "digits" but I've yet to sell a phone that can produce them!
[reply]
Re: Check a string for consecutive digits
by Anonymous Monk on Nov 26, 2015 at 00:00 UTC
    Another variant... 
    use strict;
use warnings;

my @strings =
  ( '10203040', '1234', '298761', '4562', '856423', );

my @regexes = (
    make_regex( '0123456789', 3 ),
    make_regex( '9876543210', 3 ),
);

for my $string (@strings) {
    print "Bad string => $string\n"
      if grep { $string =~ $_ } @regexes;
}

sub make_regex {
    my ( $str, $len ) = @_;

    my @splits = map { substr( $str, $_, $len ) }
      0 .. length($str) - $len;
    my $rx = join '|', map quotemeta, @splits;

    return qr/$rx/;
}

    [download]
[reply]
[d/l]

      This another variant that uses qr// to check for the 'or' / '|' of all three digit sequences. I just boil it down to one regex here.

      use strict;
use warnings;

my $dig3_regex_str = join '|',
    map { ($_, scalar reverse $_) } # 012 and 210
        map { join '', $_ .. $_+ 2 } 0..7;  # 012, 123, ...

my $dig3_regex = qr/$dig3_regex_str/;

# Test samples taken from other monks postings ...
my @strings =
  ( '10203040', '1234', '298761', '4562', '856423', 'a12b543c');

for my $string (@strings) {
    print "Bad string => $string\n"
      if $string =~ $dig3_regex;
}

      [download]
      Ron
[reply]
[d/l]

        Your more neat (IMHO) variant is easily made configurable and, like Re: Check a string for consecutive digits, uses no 5.10 regex extensions: 

        use constant MIN => 4;
my $delta = MIN-1;
;;
my ($too_many_consec) =
  map  qr{ $_ }xms,
  join ' | ',
  map  { $_, scalar reverse $_ }
  map  { join '', $_ .. $_+$delta } 0 .. (9-$delta)
  ;
...

        [download]

        Give a man a fish:  <%-{-{-{-<

[reply]
[d/l]
[select]
Re: Check a string for consecutive digits
by Anonymous Monk on Nov 25, 2015 at 22:42 UTC
    Of course, ($digits$i - 1 == $digits$i + 1) should be ($digits[$i] - 1 == $digits[$i + 1]). They give you that preview button for a reason, don't they?
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom