perl + Irregular Expression (VALID IP + ADD Valid Rule)

the following syntax is part of perl script with Irregular Expression as we see the target of the following syntax is to get VAL开发者_如何学CID IP address as 123.33.44.5 or 255.255.0.0 etc

but how to change the following syntax if I want to valid also the IP:

for example:

  124.33.*.* 

(I want to valid also the * character as valid number 1-255)

example of valid IP's

*.1.23.4

123.2.*.*

*.*.*.*

*.*.198.20

example of not valid IP's

 123.**.23.3

 289.2.2.2

 21.*.*.1000

" *.*.*.**"

my orig code:

my $octet = qr/[01]?\d\d?|2[0-4]\d|25[0-5]/; 

my $ip = qr/ \b 
         (?!0+\.0+\.0+\.0+\b) 
         $octet(?:\.$octet){3} 
         \b 
       /x;

You have 2 problems:

1. Need to add "*" to octet definition.

2. Much worse - "*" matches word boundary (\w). So you should instead use explicit character class for ip-boundary: [^\d*]

   my $octet = qr/[01]?\d\d?|2[0-4]\d|25[0-5]|[*]/; 
   my $ip = qr/\b0+\.0+\.0+\.0+\b|(?:[^\d*]|^)$octet(?:[.]$octet){3}([^\d*]|$)/x;
   
   foreach $str (@ip_list) { 
       print "$str - ";
       print "NO " if $str !~ $ip;
       print "match\n";
   }
   

OUTPUT:

1.1.1.1 - match
123.1.*.* - match
1.*.3.4 - match
*.192.2.2 - match
23.*.3.3 - match
*.1.23.4 - match
123.2.*.* - match
*.*.*.* - match
*.*.198.20 - match

123.**.23.3 - NO match
289.2.2.2 - NO match
21.*.*.1000 - NO match
*.*.*.** - NO match

11.12.13.14 - match
1.*.3.4 - match
1.*.3.* - match
0.00.0.0 - match

Why do you need to do this? you should instead use proper CIDR notation, e.g. 124.33/16, and then you can use standard Net::IP::* modules to handle the IP ranges.

#!/usr/bin/perl

use strict;
use warnings;

sub is_ip_with_wildcards {
    my ($ip) = @_;
    my @octets = split / [.] /xms, $ip;    
    return 4 == grep { $_ eq q{*} || m/ \A [0-9]+ \z /xms && $_ < 256 } @octets;
}

while( defined( my $line = <> ) ) {
    if( my @ips = grep { is_ip_with_wildcard( $_ ) } split q{ }, $line ) {
        print 'found IPs: ', join(q{, }, @ips), "\n";
    }
}

They are called regular expressions (not Irregular Expressions).

If you want a specific prefix, you could just say

my $octet = qr/[1-9][0-9]?|1[0-9][0-9]|2[0-4][0-9]|25[0-5]/
my $ip = qr/\b124[.]33[.]$octet[.]$octet\b/;

A warning about your regex though, as of Perl 5.8 \d no longer matches just [0-9]. Instead it matches and Unicode digit character, so the string "①.①.①.①" will match as will "᠐.᠐.᠐.᠐" (which is even worse, since that is 0.0.0.0 in Mongolian). Always use [0-9] instead of \d unless you want such matches.

Is this what you are looking for?

#!/usr/bin/perl

use strict;
use warnings;

sub wildcard_to_regex {
    my $wildcard = shift;
    my @octets   = split /[.]/, $wildcard;

    for my $octet (@octets) {
        next unless $octet eq "*";
        $octet = qr/[1-9][0-9]?|1[0-9][0-9]|2[0-4][0-9]/;
    }

    my $regex = '\b' . join("[.]", @octets) . '\b';
    return qr/$regex/;
}

for my $wildcard (qw/8.8.8.8 *.*.*.0 1.1.1.* 1.1.*.1/) {
    my $regex = wildcard_to_regex($wildcard);

    print "$wildcard\n";
    for my $test (qw/1.1.1.0 1.1.1.1 1.1.2.1/) {
        print "\t$test ",
            $test =~ $regex ? "matched" : "didn't match", "\n";
    }
}

It prints

8.8.8.8
        1.1.1.0 didn't match
        1.1.1.1 didn't match
        1.1.2.1 didn't match
*.*.*.0
        1.1.1.0 matched
        1.1.1.1 didn't match
        1.1.2.1 didn't match
1.1.1.*
        1.1.1.0 didn't match
        1.1.1.1 matched
        1.1.2.1 didn't match
1.1.*.1
        1.1.1.0 didn't match
        1.1.1.1 matched
        1.1.2.1 matched

This should be obvious, but subclass Net::IP. Here I subclass it to SillyIP, and wrap the set function. In real life I'd probably subclass this to Net::IP::SillyIP though.

package SillyIP;
use Moose;

extends 'Net::IP';

around 'set' => sub {
  my ( $orig , $self, $ip, @args ) = @_;

  die "invalid IP" if $ip =~ /\*{2}|\s/;

  if ( $ip =~ /\.\*/ ) {
    my $count = ( $ip =~ s/(\.\*)+$/.0/g );
    $ip .= '/' . (abs(4- $count)*8);
  }

  $self->$orig( $ip, @args );

};

1;

package main;

use Test::More tests => 5;

eval { SillyIP->new('10.**.1.1') };
ok ( $@, 'Fail to accept **' );

eval { SillyIP->new(' 10.0.1.1 ') };
ok ( $@, 'Fail to accept spaces in ip' );

is ( SillyIP->new('10.*.*.*')->ip, SillyIP->new('10/8')->ip, '8 bit network' );
is ( SillyIP->new('192.168.*.*')->ip, SillyIP->new('192.168/16')->ip, '16 bit network' );
is ( SillyIP->new('192.168.1.*')->ip, SillyIP->new('192.168.1/24')->ip, '24 bit network' );

This will provide 90% of what you're asking. It doesn't however accept * as a range for digit. This is because ipv4 addresses aren't decimal. They're actually just a 32bit data structures, which can be displayed as a.b.c.d so long as {a,b,c,d} is in range of 1-255 (8 bits). This means that asking *.1.2.3, to represent 1.2.3.4, and 2.2.3.4, but not 1.2.3.5 has no technical merit whatsoever. There is no reason to ever need this. But you could accomplish it with a quick binary algorithm.