Check a string for consecutive digits

[Anonymous Monk]

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;
        }
    }

[AnomalousMonk]

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'

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.

[johngg]

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
$

I hope this is helpful.

[Anonymous Monk]

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.

[johngg]

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;
}

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.

[CountZero]

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.

[kcott]

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]" }

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

<Reveal this spoiler or all in this thread>

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

[AnomalousMonk]

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.

[kcott]

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.

[Anonymous Monk]

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.

[kcott]

"That's not true, ..."

It appears I missed the test data:

qw{ abc ab12c 2345 234y 01234 }

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.

[Anonymous Monk]

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!

[Anonymous Monk]

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/;
}

[mr_ron]

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;
}

[AnomalousMonk]

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)
  ;
...

[Anonymous Monk]

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?