regular expression consecutive numbers or letters

[mchesak]

I need password validation routine. The password cannot contain 4
consecutive numbers or letters, for example '1234' or 'abcd' would be
invalid. No four consecutive numbers or letters are allowed to be
part of the password.

5678 is invalid
mnop is invalid

Thanks

 

[David Squire]

I need password validation routine.

So write one.

This is not a "free code" group. People here will be happy to help you
to improve your code, but not to write it from scratch.


DS

 

[mchesak]

So write one.

This is not a "free code" group. People here will be happy to help you
to improve your code, but not to write it from scratch.


DS

If I knew how I would. I am not even sure where to start. This seems
to be a common password validation issue and maybe some one has already
done it. I could hack a barbaric routine to do this but I was hoping
was something more elegant soultion. If some one would point me in the
right direction that would be helpfull, something your comments are not.

 

[David Squire]

If I knew how I would. I am not even sure where to start. This seems
to be a common password validation issue and maybe some one has already
done it. I could hack a barbaric routine to do this but I was hoping
was something more elegant soultion. If some one would point me in the
right direction that would be helpfull,

Have you gone to CPAN and searched for "password"? There is a module
there that does exactly what you want. Please search the standard Perl
resources before asking here.

something your comments are not.

Not true. If you want to get help here, you need to learn how the group
works. See the posting guidelines that are regularly posted here, and
also available at
http://www.augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html


DS

 

[Scott Bryce]

my $no1 = '1234';
my $no2 = 'abcd';
my $ok1 = '1a2b';
my $ok2 = 'c2d4';

If I understood the spec correctly, '1234' is not OK, '1235' is OK. But
is 'qwert' OK? Or 'asdf'?

 

[mchesak]

Thus spoke (e-mail address removed) (on 2006-11-01 18:35):

If I knew how I would. I am not even sure where to start.

Start with a simple description of your
specification and refine it while you
try to understand it ...


use strict;
use warnings;

my $no1 = '1234';
my $no2 = 'abcd';
my $ok1 = '1a2b';
my $ok2 = 'c2d4';

my $rgx = qr/[0-9]{4}|[A-z]{4}/;

print "ok: $no1\n" if $no1 !~ /$rgx/;
print "ok: $no2\n" if $no2 !~ /$rgx/;
print "ok: $ok1\n" if $ok1 !~ /$rgx/;
print "ok: $ok2\n" if $ok2 !~ /$rgx/;
...


Now add a check to ensure the password is *more*
than 4 characters ...

Regards

Mirco

How simple and elegant, thanks for the lesson in Perl.

 

[David Squire]

Mirco Wahab wrote:

Start with a simple description of your
specification and refine it while you
try to understand it ...


use strict;
use warnings;

my $no1 = '1234';
my $no2 = 'abcd';
my $ok1 = '1a2b';
my $ok2 = 'c2d4';

my $rgx = qr/[0-9]{4}|[A-z]{4}/;

print "ok: $no1\n" if $no1 !~ /$rgx/;
print "ok: $no2\n" if $no2 !~ /$rgx/;
print "ok: $ok1\n" if $ok1 !~ /$rgx/;
print "ok: $ok2\n" if $ok2 !~ /$rgx/;
...


Now add a check to ensure the password is *more*
than 4 characters ...

How simple and elegant, thanks for the lesson in Perl.

.... except that it doesn't meet your spec., as made clear by this version:

----

#!/usr/bin/perl

use strict;
use warnings;


my $rgx = qr/[0-9]{4}|[A-z]{4}/;

while (<DATA>) {
chomp;
print "$_: ";
if (/$rgx/) {
print "bad\n";
}
else {
print "good\n";
}
}

__DATA__
1234
abcd
1235
1a2b
c2d4
abqk

----

Ouput:

1234: bad
abcd: bad
1235: bad
1a2b: good
c2d4: good
abqk: bad

----

Both '1235' and 'abqk' should be 'good' according to your spec.

Go to CPAN and check out Data:assword. It does all you want and more.


DS

 

[Ted Zlatanov]

On 1 Nov 2006, (e-mail address removed) wrote:

Have you gone to CPAN and searched for "password"? There is a module
there that does exactly what you want. Please search the standard Perl
resources before asking here.

Come on, that's just rude. Obviously the OP doesn't know much about
Perl. If you had pointed him to CPAN instead of giving the *bad*
advice to write his own routine, everyone would have been happy.

The posting guidelines don't say you have to write code before asking
a question. If I'm wrong, please tell me what I've missed in the
guidelines.

Not true. If you want to get help here, you need to learn how the group
works. See the posting guidelines that are regularly posted here, and
also available at
http://www.augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html

Good advice. Unfortunately few people have read these.

Ted

 

[mchesak]

Thus spoke (e-mail address removed) (on 2006-11-01 19:17):

Sorry for misunderstanding your question.
Now that should work as intended:

use strict;
use warnings;

my @wordlist = qw' 1234 abcd 1a2b c2d4 ';

my $rgx = qr/. (??{ '(?:'
. chr( 1+ord($&))
. chr( 2+ord($&))
. chr( 3+ord($&))
. ')'
})/x;

for (@wordlist) { print "bad: $_\n" if /$rgx/ }


at least for 'ascii-like' stuff, but one xould start
from here ...

Regards

Mirco

That is pretty slick, I spent some time reviewing this and adding
comments, I hope they are correct. Thanks.

my $rgx = qr/. # Matches any single character except a newline

(??{ # Dynamic regex, return value used as regex
'(?:' # group subexpression without capture
. chr( 1+ord($&)) # convert to character( 1 + ascii value of
character)
. chr( 2+ord($&))
. chr( 3+ord($&))
. ')'
})/x; # extended regular expression

 

[Ilya Zakharevich]

[A complimentary Cc of this posting was sent to
Mirco Wahab

Thus spoke (e-mail address removed) (on 2006-11-01 19:17):

Sorry for misunderstanding your question.
Now that should work as intended:

use strict;
use warnings;

my @wordlist = qw' 1234 abcd 1a2b c2d4 ';

my $rgx = qr/. (??{ '(?:'
. chr( 1+ord($&))
. chr( 2+ord($&))
. chr( 3+ord($&))
. ')'
})/x;

for (@wordlist) { print "bad: $_\n" if /$rgx/ }

#!/usr/bin/perl -w
# These strings are assumed to not overlap; otherwise different logic is needed
my @prohibited = (['01234567890', 4]); # Add more elements if needed
my $rx = '';
my $set = '';
for my $proh (@prohibited) {
my ($prohibited, $len) = @$proh;
for my $pos (0..length($prohibited) - $len) {
my $ch = quotemeta substr $prohibited, $pos, 1;
my $ss = quotemeta substr $prohibited, $pos + 1, $len - 1;
$rx .= "| $ch (?! $ss ) ";
$set .= $ch;
}
}
$set = quotemeta $set;
$rx = qr( ^ (?: [^$set] $rx )* $ )ix;
print $rx;

print "Correct1" if 'a12454890x' =~ $rx;
print "Correct2" unless 'a123454890x' =~ $rx;
__END__

 

[Ilya Zakharevich]

[A complimentary Cc of this posting was NOT [per weedlist] sent to
Ilya Zakharevich

# These strings are assumed to not overlap; otherwise different logic is needed
my @prohibited = (['01234567890', 4]); # Add more elements if needed

Better version:

#!/usr/bin/perl -w
use strict;

# These strings may overlap:
my @prohibited = (['01234567890', 4]); # Add more elements if needed
my %tails;
for my $proh (@prohibited) {
my ($prohibited, $len) = @$proh;
for my $pos (0..length($prohibited) - $len) {
my $ch = quotemeta substr $prohibited, $pos, 1;
my $ss = quotemeta substr $prohibited, $pos + 1, $len - 1;
push @{$tails{$ch}}, $ss;
}
}
my $set = join '', keys %tails;
my %rtails;
$rtails{$_} = join ' | ', @{$tails{$_}} for keys %tails;
my $rx = join ' | ', map " $_ (?! $rtails{$_} )", keys %rtails;
$rx = qr( ^ (?: [^$set] | $rx )* $ )ix;
print $rx;

print "Correct1" if 'a12454890x' =~ $rx;
print "Correct2" unless 'a123454890x' =~ $rx;
__END__

Yours,
Ilya

 

[Ilya Zakharevich]

[A complimentary Cc of this posting was NOT [per weedlist] sent to
Ilya Zakharevich

# These strings may overlap:
my @prohibited = (['01234567890', 4]); # Add more elements if needed

Same, with a little bit more test patterns:

#!/usr/bin/perl -wl
use strict;

# These strings may overlap:
my @prohibited = (['01234567890', 4],
['31415926', 4],); # Add more elements if needed
my %tails;
for my $proh (@prohibited) {
my ($prohibited, $len) = @$proh;
for my $pos (0..length($prohibited) - $len) {
my $ch = quotemeta substr $prohibited, $pos, 1;
my $ss = quotemeta substr $prohibited, $pos + 1, $len - 1;
push @{$tails{$ch}}, $ss;
}
}
my $set = join '', keys %tails;
my %rtails;
$rtails{$_} = join ' | ', @{$tails{$_}} for keys %tails;
my $rx = join ' | ', map " $_ (?! $rtails{$_} )", keys %rtails;
$rx = qr( ^ (?: [^$set] | $rx )* $ )ix;
print $rx;

print "Correct1" if 'a12454890x' =~ $rx;
print "Correct2" unless 'a123454890x' =~ $rx;
__END__

 

[Dr.Ruud]

Ilya Zakharevich schreef:

# These strings may overlap:
my @prohibited = (['01234567890', 4],
['31415926', 4],); # Add more elements if needed

Like ['~!@#$%^&*()_+', 4],
['`1234567890-=', 4],
['QWERTYUIOP{}|', 4],
['qwertyuiop[]\\', 4],
['ASDFGHJKL:"', 4],
["asdfghjkl;'", 4],
['ZXCVBNM<>?', 4],
['zxcvbnm,./', 4],
etc.
And of course a check on the reversed too.

For a while I used passwords that are shapes on my keyboard, like
'4rfghy65'. So another check would be that the password doesn't contain
longish strings of neighbours on the keyboard.

I now like to create passwords from sentences with is/and/or and
numerics and stress capitalization:
Et5/A=aNd Every 25th of April is a Nice day