1# Net::CIDR 2# 3# Copyright 2001-2021 Sam Varshavchik. 4# 5# with contributions from David Cantrell. 6# 7# This program is free software; you can redistribute it 8# and/or modify it under the same terms as Perl itself. 9 10package Net::CIDR; 11 12require 5.000; 13#use strict; 14#use warnings; 15 16require Exporter; 17# use AutoLoader qw(AUTOLOAD); 18use Carp; 19 20@ISA = qw(Exporter); 21 22# Items to export into callers namespace by default. Note: do not export 23# names by default without a very good reason. Use EXPORT_OK instead. 24# Do not simply export all your public functions/methods/constants. 25 26# This allows declaration use Net::CIDR ':all'; 27# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK 28# will save memory. 29%EXPORT_TAGS = ( 'all' => [ qw( range2cidr 30 cidr2range 31 cidr2octets 32 cidradd 33 cidrlookup 34 cidrvalidate 35 addr2cidr 36 addrandmask2cidr 37 ) ] ); 38 39@EXPORT_OK = ( qw( range2cidr 40 cidr2range 41 cidr2octets 42 cidradd 43 cidrlookup 44 cidrvalidate 45 addr2cidr 46 addrandmask2cidr 47 )); 48 49@EXPORT = qw( 50 51); 52 53$VERSION = "0.21"; 54 551; 56 57 58=pod 59 60=head1 NAME 61 62Net::CIDR - Manipulate IPv4/IPv6 netblocks in CIDR notation 63 64=head1 SYNOPSIS 65 66 use Net::CIDR; 67 68 use Net::CIDR ':all'; 69 70 my $var; 71 72 if ($var = Net::CIDR::cidrvalidate($var)) 73 { 74 // ... do something 75 } 76 77 print join("\n", 78 Net::CIDR::range2cidr("192.168.0.0-192.168.255.255", 79 "10.0.0.0-10.3.255.255")) 80 . "\n"; 81 # 82 # Output from above: 83 # 84 # 192.168.0.0/16 85 # 10.0.0.0/14 86 87 print join("\n", 88 Net::CIDR::range2cidr( 89 "dead:beef::-dead:beef:ffff:ffff:ffff:ffff:ffff:ffff")) 90 . "\n"; 91 92 # 93 # Output from above: 94 # 95 # dead:beef::/32 96 97 print join("\n", 98 Net::CIDR::range2cidr("192.168.1.0-192.168.2.255")) 99 . "\n"; 100 # 101 # Output from above: 102 # 103 # 192.168.1.0/24 104 # 192.168.2.0/24 105 106 print join("\n", Net::CIDR::cidr2range("192.168.0.0/16")) . "\n"; 107 # 108 # Output from above: 109 # 110 # 192.168.0.0-192.168.255.255 111 112 print join("\n", Net::CIDR::cidr2range("dead::beef::/46")) . "\n"; 113 # 114 # Output from above: 115 # 116 # dead:beef::-dead:beef:3:ffff:ffff:ffff:ffff:ffff 117 118 @list=("192.168.0.0/24"); 119 @list=Net::CIDR::cidradd("192.168.1.0-192.168.1.255", @list); 120 121 print join("\n", @list) . "\n"; 122 # 123 # Output from above: 124 # 125 # 192.168.0.0/23 126 127 print join("\n", Net::CIDR::cidr2octets("192.168.0.0/22")) . "\n"; 128 # 129 # Output from above: 130 # 131 # 192.168.0 132 # 192.168.1 133 # 192.168.2 134 # 192.168.3 135 136 print join("\n", Net::CIDR::cidr2octets("dead::beef::/46")) . "\n"; 137 # 138 # Output from above: 139 # 140 # dead:beef:0000 141 # dead:beef:0001 142 # dead:beef:0002 143 # dead:beef:0003 144 145 @list=("192.168.0.0/24"); 146 print Net::CIDR::cidrlookup("192.168.0.12", @list); 147 # 148 # Output from above: 149 # 150 # 1 151 152 @list = Net::CIDR::addr2cidr("192.168.0.31"); 153 print join("\n", @list); 154 # 155 # Output from above: 156 # 157 # 192.168.0.31/32 158 # 192.168.0.30/31 159 # 192.168.0.28/30 160 # 192.168.0.24/29 161 # 192.168.0.16/28 162 # 192.168.0.0/27 163 # 192.168.0.0/26 164 # 192.168.0.0/25 165 # 192.168.0.0/24 166 # 192.168.0.0/23 167 # [and so on] 168 169 print Net::CIDR::addrandmask2cidr("195.149.50.61", "255.255.255.248")."\n"; 170 # 171 # Output from above: 172 # 173 # 195.149.50.56/29 174 175=head1 DESCRIPTION 176 177The Net::CIDR package contains functions that manipulate lists of IP 178netblocks expressed in CIDR notation. 179The Net::CIDR functions handle both IPv4 and IPv6 addresses. 180 181The cidrvalidate() function, described below, checks that its argument 182is a single, valid IP address or a CIDR. The remaining functions 183expect that 184their parameters consist of validated IPs or CIDRs. See cidrvalidate() 185and BUGS, below, for more information. 186 187=head2 @cidr_list=Net::CIDR::range2cidr(@range_list); 188 189Each element in the @range_list is a string "start-finish", where 190"start" is the first IP address and "finish" is the last IP address. 191range2cidr() converts each range into an equivalent CIDR netblock. 192It returns a list of netblocks except in the case where it is given 193only one parameter and is called in scalar context. 194 195For example: 196 197 @a=Net::CIDR::range2cidr("192.168.0.0-192.168.255.255"); 198 199The result is a one-element array, with $a[0] being "192.168.0.0/16". 200range2cidr() processes each "start-finish" element in @range_list separately. 201But if invoked like so: 202 203 $a=Net::CIDR::range2cidr("192.168.0.0-192.168.255.255"); 204 205The result is a scalar "192.168.0.0/16". 206 207Where each element cannot be expressed as a single CIDR netblock 208range2cidr() will generate as many CIDR netblocks as are necessary to cover 209the full range of IP addresses. Example: 210 211 @a=Net::CIDR::range2cidr("192.168.1.0-192.168.2.255"); 212 213The result is a two element array: ("192.168.1.0/24","192.168.2.0/24"); 214 215 @a=Net::CIDR::range2cidr( 216 "d08c:43::-d08c:43:ffff:ffff:ffff:ffff:ffff:ffff"); 217 218The result is an one element array: ("d08c:43::/32") that reflects this 219IPv6 netblock in CIDR notation. 220 221range2cidr() does not merge adjacent or overlapping netblocks in 222@range_list. 223 224=head2 @range_list=Net::CIDR::cidr2range(@cidr_list); 225 226The cidr2range() functions converts a netblock list in CIDR notation 227to a list of "start-finish" IP address ranges: 228 229 @a=Net::CIDR::cidr2range("10.0.0.0/14", "192.168.0.0/24"); 230 231The result is a two-element array: 232("10.0.0.0-10.3.255.255", "192.168.0.0-192.168.0.255"). 233 234 @a=Net::CIDR::cidr2range("d08c:43::/32"); 235 236The result is a one-element array: 237("d08c:43::-d08c:43:ffff:ffff:ffff:ffff:ffff:ffff"). 238 239cidr2range() does not merge adjacent or overlapping netblocks in 240@cidr_list. 241 242=head2 @netblock_list = Net::CIDR::addr2cidr($address); 243 244The addr2cidr function takes an IP address and returns a list of all 245the CIDR netblocks it might belong to: 246 247 @a=Net::CIDR::addr2cidr('192.168.0.31'); 248 249The result is a thirtythree-element array: 250('192.168.0.31/32', '192.168.0.30/31', '192.168.0.28/30', '192.168.0.24/29', 251 [and so on]) 252consisting of all the possible subnets containing this address from 2530.0.0.0/0 to address/32. 254 255Any addresses supplied to addr2cidr after the first will be ignored. 256It works similarly for IPv6 addresses, returning a list of one hundred 257and twenty nine elements. 258 259=head2 $cidr=Net::CIDR::addrandmask2cidr($address, $netmask); 260 261The addrandmask2cidr function takes an IP address and a netmask, and 262returns the CIDR range whose size fits the netmask and which contains 263the address. It is an error to supply one parameter in IPv4-ish 264format and the other in IPv6-ish format, and it is an error to supply 265a netmask which does not consist solely of 1 bits followed by 0 bits. 266For example, '255.255.248.192' is an invalid netmask, as is 267'255.255.255.32' because both contain 0 bits in between 1 bits. 268 269Technically speaking both of those *are* valid netmasks, but a) you'd 270have to be insane to use them, and b) there's no corresponding CIDR 271range. 272 273=cut 274 275# CIDR to start-finish 276 277sub cidr2range { 278 my @cidr=@_; 279 280 my @r; 281 282 while ($#cidr >= 0) 283 { 284 my $cidr=shift @cidr; 285 286 $cidr =~ s/\s//g; 287 288 unless ($cidr =~ /(.*)\/(.*)/) 289 { 290 push @r, $cidr; 291 next; 292 } 293 294 my ($ip, $pfix)=($1, $2); 295 296 my $isipv6; 297 298 my @ips=_iptoipa($ip); 299 300 $isipv6=shift @ips; 301 302 croak "$pfix, as in '$cidr', does not make sense" 303 unless $pfix >= 0 && $pfix <= ($#ips+1) * 8 && $pfix =~ /^[0-9]+$/; 304 305 my @rr=_cidr2iprange($pfix, @ips); 306 307 while ($#rr >= 0) 308 { 309 my $a=shift @rr; 310 my $b=shift @rr; 311 312 $a =~ s/\.$//; 313 $b =~ s/\.$//; 314 315 if ($isipv6) 316 { 317 $a=_ipv4to6($a); 318 $b=_ipv4to6($b); 319 } 320 321 push @r, "$a-$b"; 322 } 323 } 324 325 return @r; 326} 327 328# 329# If the input is an IPv6-formatted address, convert it to an IPv4 decimal 330# format, since the other functions know how to deal with it. The hexadecimal 331# IPv6 address is represented in dotted-decimal form, like IPv4. 332# 333 334sub _ipv6to4 { 335 my $ipv6=shift; 336 337 return (undef, $ipv6) unless $ipv6 =~ /:/; 338 339 croak "Syntax error: $ipv6" 340 unless $ipv6 =~ /^[a-fA-F0-9:\.]+$/; 341 342 my $ip4_suffix=""; 343 344 ($ipv6, $ip4_suffix)=($1, $2) 345 if $ipv6 =~ /^(.*:)([0-9]+\.[0-9\.]+)$/; 346 347 $ipv6 =~ s/([a-fA-F0-9]+)/_h62d($1)/ge; 348 349 my $ipv6_suffix=""; 350 351 if ($ipv6 =~ /(.*)::(.*)/) 352 { 353 ($ipv6, $ipv6_suffix)=($1, $2); 354 $ipv6_suffix .= ".$ip4_suffix"; 355 } 356 else 357 { 358 $ipv6 .= ".$ip4_suffix"; 359 } 360 361 my @p=grep (/./, split (/[^0-9]+/, $ipv6)); 362 363 my @s=grep (/./, split (/[^0-9]+/, $ipv6_suffix)); 364 365 push @p, 0 while $#p + $#s < 14; 366 367 my $n=join(".", @p, @s); 368 369# return (undef, $1) 370# if $n =~ /^0\.0\.0\.0\.0\.0\.0\.0\.0\.0\.255\.255\.(.*)$/; 371 372 return (1, $n); 373} 374 375# Let's go the other way around 376 377sub _ipv4to6 { 378 my @octets=split(/[^0-9]+/, shift); 379 380 croak "Internal error in _ipv4to6" 381 unless $#octets == 15; 382 383 my @dummy=@octets; 384 385 return ("::ffff:" . join(".", $octets[12], $octets[13], $octets[14], $octets[15])) 386 if join(".", splice(@dummy, 0, 12)) eq "0.0.0.0.0.0.0.0.0.0.255.255"; 387 388 my @words; 389 390 my $i; 391 392 for ($i=0; $i < 8; $i++) 393 { 394 $words[$i]=sprintf("%x", $octets[$i*2] * 256 + $octets[$i*2+1]); 395 } 396 397 my $ind= -1; 398 my $indlen= -1; 399 400 for ($i=0; $i < 8; $i++) 401 { 402 next unless $words[$i] eq "0"; 403 404 my $j; 405 406 for ($j=$i; $j < 8; $j++) 407 { 408 last if $words[$j] ne "0"; 409 } 410 411 if ($j - $i > $indlen) 412 { 413 $indlen= $j-$i; 414 $ind=$i; 415 $i=$j-1; 416 } 417 } 418 419 return "::" if $indlen == 8; 420 421 return join(":", @words) if $ind < 0; 422 423 my @s=splice (@words, $ind+$indlen); 424 425 return join(":", splice (@words, 0, $ind)) . "::" 426 . join(":", @s); 427} 428 429# An IP address to an octet list. 430 431# Returns a list. First element, flag: true if it was an IPv6 flag. Remaining 432# values are octets. 433 434sub _iptoipa { 435 my $iparg=shift; 436 437 my $isipv6; 438 my $ip; 439 440 ($isipv6, $ip)=_ipv6to4($iparg); 441 442 my @ips= split (/\.+/, $ip); 443 444 grep { 445 croak "$_, in $iparg, is not a byte" unless $_ >= 0 && $_ <= 255 && $_ =~ /^[0-9]+$/; 446 } @ips; 447 448 return ($isipv6, @ips); 449} 450 451sub _h62d { 452 my $h=shift; 453 454 $h=hex("0x$h"); 455 456 return ( int($h / 256) . "." . ($h % 256)); 457} 458 459sub _cidr2iprange { 460 my @ips=@_; 461 my $pfix=shift @ips; 462 463 if ($pfix == 0) 464 { 465 grep { $_=0 } @ips; 466 467 my @ips2=@ips; 468 469 grep { $_=255 } @ips2; 470 471 return ( join(".", @ips), join(".", @ips2)); 472 } 473 474 if ($pfix >= 8) 475 { 476 my $octet=shift @ips; 477 478 @ips=_cidr2iprange($pfix - 8, @ips); 479 480 grep { $_="$octet.$_"; } @ips; 481 return @ips; 482 } 483 484 my $octet=shift @ips; 485 486 grep { $_=0 } @ips; 487 488 my @ips2=@ips; 489 490 grep { $_=255 } @ips2; 491 492 my @r= _cidr2range8(($octet, $pfix)); 493 494 $r[0] = join (".", ($r[0], @ips)); 495 $r[1] = join (".", ($r[1], @ips2)); 496 497 return @r; 498} 499 500# 501# ADDRESS to list of CIDR netblocks 502# 503 504sub addr2cidr { 505 my @ips=_iptoipa(shift); 506 507 my $isipv6=shift @ips; 508 509 my $nbits; 510 511 if ($isipv6) 512 { 513 croak "An IPv6 address is 16 bytes long" unless $#ips == 15; 514 $nbits=128; 515 } 516 else 517 { 518 croak "An IPv4 address is 4 bytes long" unless $#ips == 3; 519 $nbits=32; 520 } 521 522 my @blocks; 523 524 foreach my $bits (reverse 0..$nbits) 525 { 526 my @ipcpy=@ips; 527 528 my $n=$bits; 529 530 while ($n < $nbits) 531 { 532 @ipcpy[$n / 8] &= (0xFF00 >> ($n % 8)); 533 534 $n += 8; 535 536 $n &= 0xF8; 537 } 538 539 my $s=join(".", @ipcpy); 540 541 push @blocks, ($isipv6 ? _ipv4to6($s):$s) . "/$bits"; 542 } 543 return @blocks; 544} 545 546# Address and netmask to CIDR 547 548sub addrandmask2cidr { 549 my $address = shift; 550 my($a_isIPv6) = _ipv6to4($address); 551 my($n_isIPv6, $netmask) = _ipv6to4(shift); 552 die("Both address and netmask must be the same type") 553 if( defined($a_isIPv6) && defined($n_isIPv6) && $a_isIPv6 != $n_isIPv6); 554 my $bitsInNetmask = 0; 555 my $previousNMoctet = 255; 556 foreach my $octet (split/\./, $netmask) { 557 die("Invalid netmask") if($previousNMoctet != 255 && $octet != 0); 558 $previousNMoctet = $octet; 559 $bitsInNetmask += 560 ($octet == 255) ? 8 : 561 ($octet == 254) ? 7 : 562 ($octet == 252) ? 6 : 563 ($octet == 248) ? 5 : 564 ($octet == 240) ? 4 : 565 ($octet == 224) ? 3 : 566 ($octet == 192) ? 2 : 567 ($octet == 128) ? 1 : 568 ($octet == 0) ? 0 : 569 die("Invalid netmask"); 570 } 571 return (grep { /\/$bitsInNetmask$/ } addr2cidr($address))[0]; 572} 573 574# 575# START-FINISH to CIDR list 576# 577 578sub range2cidr { 579 my @r=@_; 580 581 my $i; 582 583 my @c; 584 585 for ($i=0; $i <= $#r; $i++) 586 { 587 $r[$i] =~ s/\s//g; 588 589 if ($r[$i] =~ /\//) 590 { 591 push @c, $r[$i]; 592 next; 593 } 594 595 $r[$i]="$r[$i]-$r[$i]" unless $r[$i] =~ /(.*)-(.*)/; 596 597 $r[$i] =~ /(.*)-(.*)/; 598 599 my ($a,$b)=($1,$2); 600 601 my $isipv6_1; 602 my $isipv6_2; 603 604 ($isipv6_1, $a)=_ipv6to4($a); 605 ($isipv6_2, $b)=_ipv6to4($b); 606 607 if ($isipv6_1 || $isipv6_2) 608 { 609 croak "Invalid netblock range: $r[$i]" 610 unless $isipv6_1 && $isipv6_2; 611 } 612 613 my @a=split(/\.+/, $a); 614 my @b=split(/\.+/, $b); 615 616 croak unless $#a == $#b; 617 618 my @cc=_range2cidr(\@a, \@b); 619 620 while ($#cc >= 0) 621 { 622 $a=shift @cc; 623 $b=shift @cc; 624 625 $a=_ipv4to6($a) if $isipv6_1; 626 627 push @c, "$a/$b"; 628 } 629 } 630 return @c unless(1==@r && 1==@c && !wantarray()); 631 return $c[0]; 632} 633 634sub _range2cidr { 635 my $a=shift; 636 my $b=shift; 637 638 my @a=@$a; 639 my @b=@$b; 640 641 $a=shift @a; 642 $b=shift @b; 643 644 return _range2cidr8($a, $b) if $#a < 0; # Least significant octet pair. 645 646 croak "Bad starting address\n" unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/; 647 croak "Bad ending address\n" unless $b >= 0 && $b <= 255 && $b =~ /^[0-9]+$/ && $b >= $a; 648 649 my @c; 650 651 if ($a == $b) # Same start/end octet 652 { 653 my @cc= _range2cidr(\@a, \@b); 654 655 while ($#cc >= 0) 656 { 657 my $c=shift @cc; 658 659 push @c, "$a.$c"; 660 661 $c=shift @cc; 662 push @c, $c+8; 663 } 664 return @c; 665 } 666 667 my $start0=1; 668 my $end255=1; 669 670 grep { $start0=0 unless $_ == 0; } @a; 671 grep { $end255=0 unless $_ == 255; } @b; 672 673 if ( ! $start0 ) 674 { 675 my @bcopy=@b; 676 677 grep { $_=255 } @bcopy; 678 679 my @cc= _range2cidr(\@a, \@bcopy); 680 681 while ($#cc >= 0) 682 { 683 my $c=shift @cc; 684 685 push @c, "$a.$c"; 686 687 $c=shift @cc; 688 push @c, $c + 8; 689 } 690 691 ++$a; 692 } 693 694 if ( ! $end255 ) 695 { 696 my @acopy=@a; 697 698 grep { $_=0 } @acopy; 699 700 my @cc= _range2cidr(\@acopy, \@b); 701 702 while ($#cc >= 0) 703 { 704 my $c=shift @cc; 705 706 push @c, "$b.$c"; 707 708 $c=shift @cc; 709 push @c, $c + 8; 710 } 711 712 --$b; 713 } 714 715 if ($a <= $b) 716 { 717 grep { $_=0 } @a; 718 719 my $pfix=join(".", @a); 720 721 my @cc= _range2cidr8($a, $b); 722 723 while ($#cc >= 0) 724 { 725 my $c=shift @cc; 726 727 push @c, "$c.$pfix"; 728 729 $c=shift @cc; 730 push @c, $c; 731 } 732 } 733 return @c; 734} 735 736sub _range2cidr8 { 737 738 my @c; 739 740 my @r=@_; 741 742 while ($#r >= 0) 743 { 744 my $a=shift @r; 745 my $b=shift @r; 746 747 croak "Bad starting address\n" unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/; 748 croak "Bad ending address\n" unless $b >= 0 && $b <= 255 && $b =~ /^[0-9]+$/ && $b >= $a; 749 750 ++$b; 751 752 while ($a < $b) 753 { 754 my $i=0; 755 my $n=1; 756 757 while ( ($n & $a) == 0) 758 { 759 ++$i; 760 $n <<= 1; 761 last if $i >= 8; 762 } 763 764 while ($i && $n + $a > $b) 765 { 766 --$i; 767 $n >>= 1; 768 } 769 770 push @c, $a; 771 push @c, 8-$i; 772 773 $a += $n; 774 } 775 } 776 777 return @c; 778} 779 780sub _cidr2range8 { 781 782 my @c=@_; 783 784 my @r; 785 786 while ($#c >= 0) 787 { 788 my $a=shift @c; 789 my $b=shift @c; 790 791 croak "Bad starting address" unless $a >= 0 && $a <= 255 && $a =~ /^[0-9]+$/; 792 croak "Bad ending address" unless $b >= 0 && $b <= 8 && $b =~ /^[0-9]+$/; 793 794 my $n= 1 << (8-$b); 795 796 $a &= ($n-1) ^ 255; 797 798 push @r, $a; 799 push @r, $a + ($n-1); 800 } 801 return @r; 802} 803 804sub _ipcmp { 805 my $aa=shift; 806 my $bb=shift; 807 808 my $isipv6_1; 809 my $isipv6_2; 810 811 ($isipv6_1, $aa)=_ipv6to4($aa); 812 ($isipv6_2, $bb)=_ipv6to4($bb); 813 814 my @a=split (/\./, $aa); 815 my @b=split (/\./, $bb); 816 817 unshift @a, (0,0,0,0,0,0,0,0,0,0,255,255) 818 unless $isipv6_1; 819 820 unshift @b, (0,0,0,0,0,0,0,0,0,0,255,255) 821 unless $isipv6_2; 822 823 croak "Different number of octets in IP addresses" unless $#a == $#b; 824 825 while ($#a >= 0 && $a[0] == $b[0]) 826 { 827 shift @a; 828 shift @b; 829 } 830 831 return 0 if $#a < 0; 832 833 return $a[0] <=> $b[0]; 834} 835 836 837=pod 838 839=head2 @octet_list=Net::CIDR::cidr2octets(@cidr_list); 840 841cidr2octets() takes @cidr_list and returns a list of leading octets 842representing those netblocks. Example: 843 844 @octet_list=Net::CIDR::cidr2octets("10.0.0.0/14", "192.168.0.0/24"); 845 846The result is the following five-element array: 847("10.0", "10.1", "10.2", "10.3", "192.168.0"). 848 849For IPv6 addresses, the hexadecimal words in the resulting list are 850zero-padded: 851 852 @octet_list=Net::CIDR::cidr2octets("::dead:beef:0:0/110"); 853 854The result is a four-element array: 855("0000:0000:0000:0000:dead:beef:0000", 856"0000:0000:0000:0000:dead:beef:0001", 857"0000:0000:0000:0000:dead:beef:0002", 858"0000:0000:0000:0000:dead:beef:0003"). 859Prefixes of IPv6 CIDR blocks should be even multiples of 16 bits, otherwise 860they can potentially expand out to a 32,768-element array, each! 861 862=cut 863 864sub cidr2octets { 865 my @cidr=@_; 866 867 my @r; 868 869 while ($#cidr >= 0) 870 { 871 my $cidr=shift @cidr; 872 873 $cidr =~ s/\s//g; 874 875 croak "CIDR doesn't look like a CIDR\n" unless ($cidr =~ /(.*)\/(.*)/); 876 877 my ($ip, $pfix)=($1, $2); 878 879 my $isipv6; 880 881 my @ips=_iptoipa($ip); 882 883 $isipv6=shift @ips; 884 885 croak "$pfix, as in '$cidr', does not make sense" 886 unless $pfix >= 0 && $pfix <= ($#ips+1) * 8 && $pfix =~ /^[0-9]+$/; 887 888 my $i; 889 890 for ($i=0; $i <= $#ips; $i++) 891 { 892 last if $pfix - $i * 8 < 8; 893 } 894 895 my @msb=splice @ips, 0, $i; 896 897 my $bitsleft= $pfix - $i * 8; 898 899 if ($#ips < 0 || $bitsleft == 0) 900 { 901 if ($pfix == 0 && $bitsleft == 0) 902 { 903 foreach (0..255) 904 { 905 my @n=($_); 906 907 if ($isipv6) 908 { 909 _push_ipv6_octets(\@r, \@n); 910 } 911 else 912 { 913 push @r, $n[0]; 914 } 915 } 916 } 917 elsif ($isipv6) 918 { 919 _push_ipv6_octets(\@r, \@msb); 920 } 921 else 922 { 923 push @r, join(".", @msb); 924 } 925 next; 926 } 927 928 my @rr=_cidr2range8(($ips[0], $bitsleft)); 929 930 while ($#rr >= 0) 931 { 932 my $a=shift @rr; 933 my $b=shift @rr; 934 935 grep { 936 if ($isipv6) 937 { 938 push @msb, $_; 939 _push_ipv6_octets(\@r, \@msb); 940 pop @msb; 941 } 942 else 943 { 944 push @r, join(".", (@msb, $_)); 945 } 946 } ($a .. $b); 947 } 948 } 949 950 return @r; 951} 952 953sub _push_ipv6_octets { 954 my $ary_ref=shift; 955 my $octets=shift; 956 957 if ( ($#{$octets} % 2) == 0) # Odd number of octets 958 { 959 foreach (0 .. 255) 960 { 961 push @$octets, $_; 962 _push_ipv6_octets($ary_ref, $octets); 963 pop @$octets; 964 } 965 return; 966 } 967 968 my $i; 969 my $s=""; 970 971 for ($i=0; $i <= $#{$octets}; $i += 2) 972 { 973 $s .= ":" if $s ne ""; 974 $s .= sprintf("%02x%02x", $$octets[$i], $$octets[$i+1]); 975 } 976 push @$ary_ref, $s; 977} 978 979=pod 980 981=head2 @cidr_list=Net::CIDR::cidradd($block, @cidr_list); 982 983The cidradd() functions allows a CIDR list to be built one CIDR netblock 984at a time, merging adjacent and overlapping ranges. 985$block is a single netblock, expressed as either "start-finish", or 986"address/prefix". 987Example: 988 989 @cidr_list=Net::CIDR::range2cidr("192.168.0.0-192.168.0.255"); 990 @cidr_list=Net::CIDR::cidradd("10.0.0.0/8", @cidr_list); 991 @cidr_list=Net::CIDR::cidradd("192.168.1.0-192.168.1.255", @cidr_list); 992 993The result is a two-element array: ("10.0.0.0/8", "192.168.0.0/23"). 994IPv6 addresses are handled in an analogous fashion. 995 996=cut 997 998sub cidradd { 999 my @cidr=@_; 1000 1001 my $ip=shift @cidr; 1002 1003 $ip="$ip-$ip" unless $ip =~ /[-\/]/; 1004 1005 unshift @cidr, $ip; 1006 1007 @cidr=cidr2range(@cidr); 1008 1009 my @a; 1010 my @b; 1011 1012 grep { 1013 croak "This doesn't look like start-end\n" unless /(.*)-(.*)/; 1014 push @a, $1; 1015 push @b, $2; 1016 } @cidr; 1017 1018 my $lo=shift @a; 1019 my $hi=shift @b; 1020 1021 my $i; 1022 1023 for ($i=0; $i <= $#a; $i++) 1024 { 1025 last if _ipcmp($lo, $hi) > 0; 1026 1027 next if _ipcmp($b[$i], $lo) < 0; 1028 next if _ipcmp($hi, $a[$i]) < 0; 1029 1030 if (_ipcmp($a[$i],$lo) <= 0 && _ipcmp($hi, $b[$i]) <= 0) 1031 { 1032 $lo=_add1($hi); 1033 last; 1034 } 1035 1036 if (_ipcmp($a[$i],$lo) <= 0) 1037 { 1038 $lo=_add1($b[$i]); 1039 next; 1040 } 1041 1042 if (_ipcmp($hi, $b[$i]) <= 0) 1043 { 1044 $hi=_sub1($a[$i]); 1045 next; 1046 } 1047 1048 $a[$i]=undef; 1049 $b[$i]=undef; 1050 } 1051 1052 unless ((! defined $lo) || (! defined $hi) || _ipcmp($lo, $hi) > 0) 1053 { 1054 push @a, $lo; 1055 push @b, $hi; 1056 } 1057 1058 @cidr=(); 1059 1060 @a=grep ( (defined $_), @a); 1061 @b=grep ( (defined $_), @b); 1062 1063 for ($i=0; $i <= $#a; $i++) 1064 { 1065 push @cidr, "$a[$i]-$b[$i]"; 1066 } 1067 1068 @cidr=sort { 1069 $a =~ /(.*)-/; 1070 1071 my $c=$1; 1072 1073 $b =~ /(.*)-/; 1074 1075 my $d=$1; 1076 1077 my $e=_ipcmp($c, $d); 1078 return $e; 1079 } @cidr; 1080 1081 $i=0; 1082 1083 while ($i < $#cidr) 1084 { 1085 $cidr[$i] =~ /(.*)-(.*)/; 1086 1087 my ($k, $l)=($1, $2); 1088 1089 $cidr[$i+1] =~ /(.*)-(.*)/; 1090 1091 my ($m, $n)=($1, $2); 1092 1093 if (_ipcmp( _add1($l), $m) == 0) 1094 { 1095 splice @cidr, $i, 2, "$k-$n"; 1096 next; 1097 } 1098 ++$i; 1099 } 1100 1101 return range2cidr(@cidr); 1102} 1103 1104 1105sub _add1 { 1106 my $n=shift; 1107 1108 my $isipv6; 1109 1110 ($isipv6, $n)=_ipv6to4($n); 1111 1112 my @ip=split(/\./, $n); 1113 1114 my $i=$#ip; 1115 1116 while ($i >= 0) 1117 { 1118 last if ++$ip[$i] < 256; 1119 $ip[$i]=0; 1120 --$i; 1121 } 1122 1123 return undef if $i < 0; 1124 1125 $i=join(".", @ip); 1126 $i=_ipv4to6($i) if $isipv6; 1127 return $i; 1128 1129} 1130 1131sub _sub1 { 1132 my $n=shift; 1133 1134 my $isipv6; 1135 1136 ($isipv6, $n)=_ipv6to4($n); 1137 1138 my @ip=split(/\./, $n); 1139 1140 my $i=$#ip; 1141 1142 while ($i >= 0) 1143 { 1144 last if --$ip[$i] >= 0; 1145 $ip[$i]=255; 1146 --$i; 1147 } 1148 1149 return undef if $i < 0; 1150 1151 $i=join(".", @ip); 1152 $i=_ipv4to6($i) if $isipv6; 1153 return $i; 1154} 1155 1156=pod 1157 1158=head2 $found=Net::CIDR::cidrlookup($ip, @cidr_list); 1159 1160Search for $ip in @cidr_list. $ip can be a single IP address, or a 1161netblock in CIDR or start-finish notation. 1162lookup() returns 1 if $ip overlaps any netblock in @cidr_list, 0 if not. 1163 1164=cut 1165 1166sub cidrlookup { 1167 my @cidr=@_; 1168 1169 my $ip=shift @cidr; 1170 1171 $ip="$ip-$ip" unless $ip =~ /[-\/]/; 1172 1173 unshift @cidr, $ip; 1174 1175 @cidr=cidr2range(@cidr); 1176 1177 my @a; 1178 my @b; 1179 1180 grep { 1181 croak "This doesn't look like start-end\n" unless /(.*)-(.*)/; 1182 push @a, $1; 1183 push @b, $2; 1184 } @cidr; 1185 1186 my $lo=shift @a; 1187 my $hi=shift @b; 1188 1189 my $i; 1190 1191 for ($i=0; $i <= $#a; $i++) 1192 { 1193 next if _ipcmp($b[$i], $lo) < 0; 1194 next if _ipcmp($hi, $a[$i]) < 0; 1195 return 1; 1196 } 1197 1198 return 0; 1199} 1200 1201=pod 1202 1203=head2 $ip=Net::CIDR::cidrvalidate($ip); 1204 1205Validate whether $ip is a valid IPv4 or IPv6 address, or a CIDR. 1206Returns its argument or undef. 1207Spaces are removed, and IPv6 hexadecimal address are converted to lowercase. 1208 1209$ip with less than four octets gets filled out with additional octets, and 1210the modified value gets returned. This turns "192.168/16" into a proper 1211"192.168.0.0/16". 1212 1213If $ip contains a "/", it must be a valid CIDR, otherwise it must be a valid 1214IPv4 or an IPv6 address. 1215 1216A technically invalid CIDR, such as "192.168.0.1/24" fails validation, returning 1217undef. 1218 1219=cut 1220 1221sub cidrvalidate { 1222 my $v=shift; 1223 1224 $v =~ s/\s//g; 1225 1226 $v=lc($v); 1227 1228 my $suffix; 1229 1230 ($v, $suffix)=($1, $2) if $v =~ m@(.*)/(.*)@; 1231 1232 if (defined $suffix) 1233 { 1234 return undef unless $suffix =~ /^\d+$/ && 1235 ($suffix eq "0" || $suffix =~ /^[123456789]/); 1236 } 1237 1238 if ($v =~ /^([0-9\.]+)$/ || $v =~ /^::ffff:([0-9\.]+)$/ || 1239 $v =~ /^:([0-9\.]+)$/) 1240 { 1241 my $n=$1; 1242 1243 return undef if $n =~ /^\./ || $n =~ /\.$/ || $n =~ /\.\./; 1244 1245 my @o= split(/\./, $n); 1246 1247 while ($#o < 3) 1248 { 1249 push @o, "0"; 1250 } 1251 1252 $n=join(".", @o); 1253 1254 return undef if $#o != 3; 1255 1256 foreach (@o) 1257 { 1258 return undef if /^0./; 1259 return undef if $_ < 0 || $_ > 255; 1260 } 1261 1262 if ($v =~ /^::ffff/) 1263 { 1264 $suffix=128 unless defined $suffix; 1265 1266 return undef if $suffix < 128-32; 1267 1268 $suffix -= 128-32; 1269 } 1270 else 1271 { 1272 $suffix=32 unless defined $suffix; 1273 } 1274 1275 foreach (addr2cidr($n)) 1276 { 1277 return $_ if $_ eq "$n/$suffix"; 1278 } 1279 return undef; 1280 } 1281 1282 return undef unless $v =~ /^[0-9a-f:]+$/; 1283 1284 return undef if $v =~ /:::/ || $v =~ /^:[^:]/ || $v =~ /[^:]:$/ 1285 || $v =~ /::.*::/; 1286 1287 my @o=grep (/./, split(/:/, $v)); 1288 1289 return undef if ($#o >= 8 || ($#o<7 && $v !~ /::/)); 1290 1291 foreach (@o) 1292 { 1293 return undef if length ($_) > 4; 1294 } 1295 1296 $suffix=128 unless defined $suffix; 1297 1298 $v =~ s/([0-9A-Fa-f]+)/_triml0($1)/ge; 1299 1300 foreach (addr2cidr($v)) 1301 { 1302 return $_ if $_ eq "$v/$suffix"; 1303 } 1304 return undef; 1305} 1306 1307sub _triml0 { 1308 my ($a) = @_; 1309 1310 $a =~ s/^0+//g; 1311 $a = "0" if $a eq ''; 1312 return $a 1313} 1314 1315=pod 1316 1317=head1 BUGS 1318 1319Garbage in, garbage out. 1320Always use cidrvalidate() before doing anything with untrusted input. 1321Otherwise, 1322"slightly" invalid input will work (extraneous whitespace 1323is generally OK), 1324but the functions will croak if you're totally off the wall. 1325 1326=head1 AUTHOR 1327 1328Sam Varshavchik <sam@email-scan.com> 1329 1330With some contributions from David Cantrell <david@cantrell.org.uk> 1331 1332=cut 1333 1334__END__ 1335