Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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


In reply to Re^3: Regular expression to check for qwerty sequence in a password by johngg
in thread Regular expression to check for qwerty sequence in a password by bradcathey

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (6)
As of 2024-03-28 22:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found