Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Regular expression to check for qwerty sequence in a password

by bradcathey (Prior)
on Oct 09, 2016 at 13:29 UTC ( #1173584=perlquestion: print w/replies, xml ) Need Help??

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

Testing for sequences in a password, like "wert" or "asdf". Only sequences with at least 3 characters can match. So far I have:

my $password ="asdf"; if ($password =~ /(?=^asdfghjkl{3,}$)/) { print 'no sequences allowed!'; } else { print "password is okay"; }

Not sure what I'm missing.

—Brad
"The important work of moving the world forward does not wait to be done by perfect men." George Eliot

UPDATE:
Because TMTOWTDI I decided the solution to my problem did not have to be a regexp, but could be a simple string search:

my $password ="asdf"; if (index("qwertyuiopasdfghjklzxcvbnm",lc($password)) > -1) { ... }

This, of course, doesn't work with "asdfasdf" so still not a full solution.

Replies are listed 'Best First'.
Re: Regular expression to check for qwerty sequence in a password
by tybalt89 (Prior) 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"; }

      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

        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.

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,

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

      Why loop when you can make regex loop for you :)

      #!/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"; }
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 :-}

    Cheers,

    JohnGG

      Thanks for all the work. I know the feeling of working on something like this. You did help me see some other password issues that would make them less secure. I will noodle this further.

      —Brad
      "The important work of moving the world forward does not wait to be done by perfect men." George Eliot

        Here's a re-factored script that also now caters for the "qwerty" keyboard sequences you wanted to check for in your OP. The script uses Term::ANSIColor to highlight the non-compliant parts of each password.

        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.

        Cheers,

        JohnGG

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

      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
        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:  <%-{-{-{-<

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1173584]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (2)
As of 2021-10-19 19:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (77 votes). Check out past polls.

    Notices?