Re: Regular expression to check for qwerty sequence in a password
by tybalt89 (Monsignor) on Oct 09, 2016 at 13:44 UTC
|
#!/usr/bin/perl -l
# http://perlmonks.org/?node_id=1173584
use strict;
use warnings;
my $password ="asdf";
my $sequences = "qwertyuiop\nasdfghjkl\nzxcvbnm";
if( "$password\0$sequences" =~ /(.{3}).*\0.*\1/s )
{
print 'no sequences allowed!';
}
else
{
print "password is okay";
}
| [reply] [Watch: Dir/Any] [d/l] |
|
Interesting. Of course, it works, but I'm not sure what is happening with the:
"$password\0$sequences"
and the subsequent:
\0
in the regex. I've not see this before and am curious. Thoughts?
—Brad "The important work of moving the world forward does not wait to be done by perfect men." George Eliot
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
I use the \0 as a marker or separator between the two sections of the string'
Then I match for a three letter sequence that occurs before the marker,
some characters, the marker, some characters, and finally the exact three
letter sequence that was matched on the left of the marker. If the regex can match,
then there is a three letter sequence in the password that matches exactly
three keyboard letters in a row.
| [reply] [Watch: Dir/Any] |
Re: Regular expression to check for qwerty sequence in a password
by Athanasius (Archbishop) on Oct 09, 2016 at 15:08 UTC
|
Hello bradcathey,
I think tybalt89’s ingenious solution will be hard to beat for simplicity and brevity. But in the spirit of TMTOWTDI, here’s an approach that employs a useful technique presented by BrowserUk here and discussed by me here:
use strict;
use warnings;
my @seqs = qw( qwertyuiop asdfghjkl zxcvbnm );
for my $pwd (qw( asdf aaabbbccc zXcaaabbb aaYUIOPabbb ))
{
print "$pwd: ", validate_password($pwd, @seqs) ?
'password ok' : 'no sequences allowed!', "\n";
}
sub validate_password
{
my ($password, @sequences) = @_;
my $ok = 1;
my @seqs;
push @seqs, $_ =~ /(?=(.{3}))/g for @sequences;
for (@seqs)
{
$ok = 0 && last if $password =~ /$_/i;
}
return $ok;
}
Output:
1:05 >perl 1706_SoPW.pl
asdf: no sequences allowed!
aaabbbccc: password ok
zXcaaabbb: no sequences allowed!
aaYUIOPabbb: no sequences allowed!
1:06 >
Hope this is of interest,
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
#!/usr/bin/perl -l
# http://perlmonks.org/?node_id=1173584
use strict;
use warnings;
my $sequences = "qwertyuiop asdfghjkl zxcvbnm";
my @threes;
push @threes, $1 while $sequences =~ /(?=(\w{3}))/g;
my $invalid = do { local $" = '|'; qr/@threes/ };
my $password ="asdf";
if( $password =~ $invalid )
{
print 'no sequences allowed!';
}
else
{
print "password is okay";
}
| [reply] [Watch: Dir/Any] [d/l] |
Re: Regular expression to check for qwerty sequence in a password
by johngg (Canon) on Oct 09, 2016 at 22:23 UTC
|
I posted a couple of replies in this thread then, just out of interest, continued to work on adding functionality. It may be overkill for what you want but you could pick out any bits that are useful.
use strict;
use warnings;
use 5.014;
use re qw{ eval };
my $max = shift || 3;
# Create pattern for consecutive ascending and descending digits.
#
my $ascDigPatt =
q{(?x) ( ( \d ) (??{ join q{}, map { $2 + $_ } 1 .. $max }) ) };
my $descDigPatt =
q{(?x) ( ( \d ) (??{ join q{}, map { $2 - $_ } 1 .. $max }) ) };
# Create pattern for consecutive ascending letters.
#
my $ucAscEnd = chr( ord( q{Z} ) - $max );
my $lcAscEnd = chr( ord( q{z} ) - $max );
my $ascLtrPatt = join q{ },
q{(?x)},
qq{( ( [A-${ucAscEnd}a-${lcAscEnd}] )},
q{(??{ join q{}, map { chr( ord( $2 ) + $_ ) } 1 .. $max }) ) };
# Create pattern for consecutive descending letters.
#
my $ucDescStart = chr( ord( q{A} ) + $max );
my $lcDescStart = chr( ord( q{a} ) + $max );
my $descLtrPatt = join q{ },
q{(?x)},
qq{( ( [${ucDescStart}-Z${lcDescStart}-z] )},
q{(??{ join q{}, map { chr( ord( $2 ) - $_ ) } 1 .. $max }) ) };
my $kbdTopRow = q{qwertyuiop};
my $kbdMiddleRow = q{asdfghjkl};
my $kbdBottomRow = q{zxcvbnm};
# Create passwords to test.
#
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 012345 2356 3457
abcd XWVU bcd1e ZYX
ZYXW kjyihgfs
abcd
def
PQRST
YXWV
bcde bcdf stu stuc stuv wxyz
hgfe lkjh edbca dhfe
};
foreach my $pw ( @passwords )
{
print qq{$pw - };
my $err = checkConsec( $pw );
say
$err
? $err
: q{pass};
}
sub checkConsec
{
my $pw = shift;
return qq{too many consecutive ascending digits - $1}
if $pw =~ m{$ascDigPatt};
return qq{too many consecutive descending digits - $1}
if $pw =~ m{$descDigPatt};
return qq{too many consecutive ascending letters - $1}
if $pw =~ m{$ascLtrPatt};
return qq{too many consecutive descending letters - $1}
if $pw =~ m{$descLtrPatt};
return 0;
}
I didn't post it at the time but hope it might be helpful now.
Update: Looking at the code again, it seems that I hadn't got around to implementing the "qwerty" part of the problem yet :-}
| [reply] [Watch: Dir/Any] [d/l] |
|
| [reply] [Watch: Dir/Any] [d/l] |
|
use strict;
use warnings;
use Term::ANSIColor qw{ :constants };
use feature qw{ say };
use re qw{ eval };
my $maxAllowed = shift || 3;
# Create pattern for consecutive ascending and descending digits.
#
my $rxAscDig =
qr{(?x) ( ( \d ) (??{ join q{}, map { $2 + $_ } 1 .. $maxAllowed })
+ ) };
my $rxDescDig =
qr{(?x) ( ( \d ) (??{ join q{}, map { $2 - $_ } 1 .. $maxAllowed })
+ ) };
# Create pattern for consecutive ascending letters.
#
my $ucAscEnd = chr( ord( q{Z} ) - $maxAllowed );
my $ascLtrPatt = join q{ },
qq{( ( [A-${ucAscEnd}] )},
q{(??{ join q{}, map { chr( ord( $2 ) + $_ ) } 1 .. $maxAllowed })
+ ) };
my $rxAscLtr = qr{(?xi) $ascLtrPatt };
# Create pattern for consecutive descending letters.
#
my $ucDescStart = chr( ord( q{A} ) + $maxAllowed );
my $descLtrPatt = join q{ },
qq{( ( [${ucDescStart}-Z] )},
q{(??{ join q{}, map { chr( ord( $2 ) - $_ ) } 1 .. $maxAllowed })
+ ) };
my $rxDescLtr = qr{(?xi) $descLtrPatt };
# Create pattern for left to tight and right to left keyboard sequence
+s.
#
my @kbdLtrRows = qw{
QWERTYUIOP
ASDFGHJKL
ZXCVBNM
};
my @kbdLtrPatts = do {
my $bad = $maxAllowed + 1;
my @patts;
foreach my $row ( @kbdLtrRows, map { scalar reverse } @kbdLtrRows )
{
push @patts, $1 while $row =~ m{(?=(.{$bad}))}g;
}
@patts;
};
my $rxKbdLtr = do {
local $" = q{|};
qr{(?xi) ( @kbdLtrPatts ) };
};
# Create passwords to test.
#
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 012345 2356 3457
abcd XWVU bcd1e ZYX
ZYXW kjyihGfs
abcd aNbvcd3456
def
PQRST
PQrST
YXWV
zYXwv
bcde bcdf stu stuc stuv wxyz
hgfe lkjh edbca dhfe
gertys
fgh8d
hnbvcer
};
foreach my $pwd ( @passwords )
{
testPwd( $pwd );
}
sub appendError
{
my( $rsMsg, $text, $marked ) = @_;
${ $rsMsg } .= qq{\n Too many consecutive $text - $marked};
}
sub testPwd
{
my $pwd = shift;
my $msg = qq{Password: $pwd};
my $err = 0;
if ( $pwd =~ m{$rxKbdLtr} )
{
$err ++;
my $marked = $pwd =~ s{$rxKbdLtr}{ BOLD RED . $1 . RESET }er;
appendError( \ $msg, q{adjacent letter keys}, $marked );
}
if ( $pwd =~ m{$rxAscDig} )
{
$err ++;
my $marked = $pwd =~ s{$rxAscDig}{ BOLD RED . $1 . RESET }er;
appendError( \ $msg, q{consecutive ascending digits}, $marked
+);
}
if ( $pwd =~ m{$rxDescDig} )
{
$err ++;
my $marked = $pwd =~ s{$rxDescDig}{ BOLD RED . $1 . RESET }er;
appendError( \ $msg, q{consecutive descending digits}, $marked
+ );
}
if ( $pwd =~ m{$rxAscLtr} )
{
$err ++;
my $marked = $pwd =~ s{$rxAscLtr}{ BOLD RED . $1 . RESET }er;
appendError( \ $msg, q{consecutive ascending letters}, $marked
+ );
}
if ( $pwd =~ m{$rxDescLtr} )
{
$err ++;
my $marked = $pwd =~ s{$rxDescLtr}{ BOLD RED . $1 . RESET }er;
appendError( \ $msg, q{consecutive descending letters}, $marke
+d );
}
$msg .= qq{\n Passed tests} unless $err;
say $msg;
}
I hope this is useful.
| [reply] [Watch: Dir/Any] [d/l] |
Re: Regular expression to check for qwerty sequence in a password
by shadowsong (Pilgrim) on Oct 09, 2016 at 17:02 UTC
|
Hi brad,
You may want to be a bit more specific in your definition of sequences. From what you've said it isn't clear what you mean. for e.g. would the sequence fdsa be acceptable? What about Asdf or asDf?
Either way; if I were to divine what you're trying to accomplish, i.e. to match a string of at least three chars that does NOT contain a multi-char sequence like "asd" or "wer" - I would tweak your if conditional and reg exp to something like this:
if (length($password) > 2 && ($password =~ m/(?:^(?!(asd)|(wer)))/))
Cheers, Shadowsong | [reply] [Watch: Dir/Any] [d/l] [select] |
|
Shadowsong
Sorry for the confusion. I'm trying to test passwords made by just rolling all four fingers on the keyboard, hitting immediately adjacent letters, e.g., "asdf." They must be next to each other: so "asdg" wouldn't match. Case is not necessarily a consideration. Does that help?
I have been a little surprised in reading the replies to see there is no one magical regex.
—Brad "The important work of moving the world forward does not wait to be done by perfect men." George Eliot
| [reply] [Watch: Dir/Any] [d/l] |
|
I have been a little surprised in reading the replies to see there is no one magical regex.
tybalt89's single regex given here not sufficiently magical?!? You're a hard monk to please!
... passwords made by ... hitting immediately adjacent letters, e.g., "asdf." They must be next to each other: so "asdg" wouldn't match.
tybalt89's regex can easily be modified so that 'asd' 'wert' 'vbnm' etc. are rejected and 'asdx' 'xasd' 'xasdx' etc. accepted. This is left as a penitential exercise for a very demanding monk.
Give a man a fish: <%-{-{-{-<
| [reply] [Watch: Dir/Any] [d/l] [select] |