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

Question

hi all

the following syntax is part of perl script with Irregular Expression as we see the target of the following syntax is to get VALID 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;

Answer 1

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

Answer 2

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

Answer 3

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.

Answer 4

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.

Answer 5

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