regular expression consecutive numbers or letters

Discussion in 'Perl Misc' started by mchesak, Nov 1, 2006.

  1. mchesak

    mchesak Guest

    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
     
    mchesak, Nov 1, 2006
    #1
    1. Advertisements

  2. mchesak

    David Squire Guest

    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
     
    David Squire, Nov 1, 2006
    #2
    1. Advertisements

  3. mchesak

    mchesak Guest

    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.
     
    mchesak, Nov 1, 2006
    #3
  4. mchesak

    David Squire Guest

    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.
    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
     
    David Squire, Nov 1, 2006
    #4
  5. mchesak

    Scott Bryce Guest

    If I understood the spec correctly, '1234' is not OK, '1235' is OK. But
    is 'qwert' OK? Or 'asdf'?
     
    Scott Bryce, Nov 1, 2006
    #5
  6. mchesak

    mchesak Guest

    How simple and elegant, thanks for the lesson in Perl.
     
    mchesak, Nov 1, 2006
    #6
  7. mchesak

    David Squire Guest

    .... 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::password. It does all you want and more.


    DS
     
    David Squire, Nov 1, 2006
    #7
  8. mchesak

    Ted Zlatanov Guest

    On 1 Nov 2006, wrote:

    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.
    Good advice. Unfortunately few people have read these.

    Ted
     
    Ted Zlatanov, Nov 1, 2006
    #8
  9. mchesak

    mchesak Guest

    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
     
    mchesak, Nov 1, 2006
    #9
  10. [A complimentary Cc of this posting was sent to
    Mirco Wahab
    #!/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, Nov 1, 2006
    #10
  11. [A complimentary Cc of this posting was NOT [per weedlist] sent to
    Ilya Zakharevich
    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, Nov 1, 2006
    #11
  12. [A complimentary Cc of this posting was NOT [per weedlist] sent to
    Ilya Zakharevich
    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__
     
    Ilya Zakharevich, Nov 1, 2006
    #12
  13. mchesak

    Dr.Ruud Guest

    Ilya Zakharevich schreef:
    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
     
    Dr.Ruud, Nov 2, 2006
    #13
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.