1# Copyright (c) 1999 - 2002 RIPE NCC 2# 3# All Rights Reserved 4# 5# Permission to use, copy, modify, and distribute this software and its 6# documentation for any purpose and without fee is hereby granted, 7# provided that the above copyright notice appear in all copies and that 8# both that copyright notice and this permission notice appear in 9# supporting documentation, and that the name of the author not be 10# used in advertising or publicity pertaining to distribution of the 11# software without specific, written prior permission. 12# 13# THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 14# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL 15# AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY 16# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN 17# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 18# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 19 20#------------------------------------------------------------------------------ 21# Module Header 22# Filename : IP.pm 23# Purpose : Provide functions to manipulate IPv4/v6 addresses 24# Author : Manuel Valente <manuel.valente@gmail.com> 25# Date : 19991124 26# Description : 27# Language Version : Perl 5 28# OSs Tested : BSDI 3.1 - Linux 29# Command Line : ipcount 30# Input Files : 31# Output Files : 32# External Programs : Math::BigInt.pm 33# Problems : 34# To Do : 35# Comments : Based on ipv4pack.pm (Monica) and iplib.pm (Lee) 36# Math::BigInt is only loaded if int functions are used 37# $Id: IP.pm,v 1.23 2003/02/18 16:13:01 manuel Exp $ 38#------------------------------------------------------------------------------ 39 40package Net::IP; 41 42use strict; 43use Math::BigInt; 44 45# Global Variables definition 46use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $ERROR $ERRNO 47 %IPv4ranges %IPv6ranges $useBigInt 48 $IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL); 49 50$VERSION = '1.26'; 51 52require Exporter; 53 54@ISA = qw(Exporter); 55 56# Functions and variables exported in all cases 57@EXPORT = qw(&Error &Errno 58 $IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL 59); 60 61# Functions exported on demand (with :PROC) 62@EXPORT_OK = qw(&Error &Errno &ip_iptobin &ip_bintoip &ip_bintoint &ip_inttobin 63 &ip_get_version &ip_is_ipv4 &ip_is_ipv6 &ip_expand_address &ip_get_mask 64 &ip_last_address_bin &ip_splitprefix &ip_prefix_to_range 65 &ip_is_valid_mask &ip_bincomp &ip_binadd &ip_get_prefix_length 66 &ip_range_to_prefix &ip_compress_address &ip_is_overlap 67 &ip_get_embedded_ipv4 &ip_aggregate &ip_iptype &ip_check_prefix 68 &ip_reverse &ip_normalize &ip_normal_range &ip_iplengths 69 $IP_NO_OVERLAP $IP_PARTIAL_OVERLAP $IP_A_IN_B_OVERLAP $IP_B_IN_A_OVERLAP $IP_IDENTICAL 70); 71 72%EXPORT_TAGS = (PROC => [@EXPORT_OK],); 73 74# Definition of the Ranges for IPv4 IPs 75%IPv4ranges = ( 76 '00000000' => 'PRIVATE', # 0/8 77 '00001010' => 'PRIVATE', # 10/8 78 '0110010001' => 'SHARED', # 100.64/10 79 '01111111' => 'LOOPBACK', # 127.0/8 80 '1010100111111110' => 'LINK-LOCAL', # 169.254/16 81 '101011000001' => 'PRIVATE', # 172.16/12 82 '110000000000000000000000' => 'RESERVED', # 192.0.0/24 83 '110000000000000000000010' => 'TEST-NET', # 192.0.2/24 84 '110000000101100001100011' => '6TO4-RELAY', # 192.88.99.0/24 85 '1100000010101000' => 'PRIVATE', # 192.168/16 86 '110001100001001' => 'RESERVED', # 198.18/15 87 '110001100011001101100100' => 'TEST-NET', # 198.51.100/24 88 '110010110000000001110001' => 'TEST-NET', # 203.0.113/24 89 '1110' => 'MULTICAST', # 224/4 90 '1111' => 'RESERVED', # 240/4 91 '11111111111111111111111111111111' => 'BROADCAST', # 255.255.255.255/32 92); 93 94# Definition of the Ranges for Ipv6 IPs 95%IPv6ranges = ( 96 '00000000' => 'RESERVED', # ::/8 97 ('0' x 128) => 'UNSPECIFIED', # ::/128 98 ('0' x 127) . '1' => 'LOOPBACK', # ::1/128 99 ('0' x 80) . ('1' x 16) => 'IPV4MAP', # ::FFFF:0:0/96 100 '00000001' => 'RESERVED', # 0100::/8 101 '0000000100000000' . ('0' x 48) => 'DISCARD', # 0100::/64 102 '0000001' => 'RESERVED', # 0200::/7 103 '000001' => 'RESERVED', # 0400::/6 104 '00001' => 'RESERVED', # 0800::/5 105 '0001' => 'RESERVED', # 1000::/4 106 '001' => 'GLOBAL-UNICAST', # 2000::/3 107 '0010000000000001' . ('0' x 16) => 'TEREDO', # 2001::/32 108 '00100000000000010000000000000010' . ('0' x 16) => 'BMWG', # 2001:0002::/48 109 '00100000000000010000110110111000' => 'DOCUMENTATION', # 2001:DB8::/32 110 '0010000000000001000000000001' => 'ORCHID', # 2001:10::/28 111 '0010000000000010' => '6TO4', # 2002::/16 112 '010' => 'RESERVED', # 4000::/3 113 '011' => 'RESERVED', # 6000::/3 114 '100' => 'RESERVED', # 8000::/3 115 '101' => 'RESERVED', # A000::/3 116 '110' => 'RESERVED', # C000::/3 117 '1110' => 'RESERVED', # E000::/4 118 '11110' => 'RESERVED', # F000::/5 119 '111110' => 'RESERVED', # F800::/6 120 '1111110' => 'UNIQUE-LOCAL-UNICAST', # FC00::/7 121 '111111100' => 'RESERVED', # FE00::/9 122 '1111111010' => 'LINK-LOCAL-UNICAST', # FE80::/10 123 '1111111011' => 'RESERVED', # FEC0::/10 124 '11111111' => 'MULTICAST', # FF00::/8 125); 126 127# Overlap constants 128$IP_NO_OVERLAP = 0; 129$IP_PARTIAL_OVERLAP = 1; 130$IP_A_IN_B_OVERLAP = -1; 131$IP_B_IN_A_OVERLAP = -2; 132$IP_IDENTICAL = -3; 133 134# ---------------------------------------------------------- 135# OVERLOADING 136 137use overload ( 138 '+' => 'ip_add_num', 139 'bool' => sub { @_ }, 140); 141 142#------------------------------------------------------------------------------ 143# Subroutine ip_num_add 144# Purpose : Add an integer to an IP 145# Params : Number to add 146# Returns : New object or undef 147# Note : Used by overloading - returns undef when 148# the end of the range is reached 149 150sub ip_add_num { 151 my $self = shift; 152 153 my ($value) = @_; 154 155 my $ip = $self->intip + $value; 156 157 my $last = $self->last_int; 158 159 # Reached the end of the range ? 160 if ($ip > $self->last_int) { 161 return; 162 } 163 164 my $newb = ip_inttobin($ip, $self->version); 165 $newb = ip_bintoip($newb, $self->version); 166 167 my $newe = ip_inttobin($last, $self->version); 168 $newe = ip_bintoip($newe, $self->version); 169 170 my $new = new Net::IP("$newb - $newe"); 171 172 return ($new); 173} 174 175# ----------------------------------------------------------------------------- 176 177#------------------------------------------------------------------------------ 178# Subroutine new 179# Purpose : Create an instance of an IP object 180# Params : Class, IP prefix, IP version 181# Returns : Object reference or undef 182# Note : New just allocates a new object - set() does all the work 183sub new { 184 my ($class, $data, $ipversion) = (@_); 185 186 # Allocate new object 187 my $self = {}; 188 189 bless($self, $class); 190 191 # Pass everything to set() 192 unless ($self->set($data, $ipversion)) { 193 return; 194 } 195 196 return $self; 197} 198 199#------------------------------------------------------------------------------ 200# Subroutine set 201# Purpose : Set the IP for an IP object 202# Params : Data, IP type 203# Returns : 1 (success) or undef (failure) 204sub set { 205 my $self = shift; 206 207 my ($data, $ipversion) = @_; 208 209 # Normalize data as received - this should return 2 IPs 210 my ($begin, $end) = ip_normalize($data, $ipversion) or do { 211 $self->{error} = $ERROR; 212 $self->{errno} = $ERRNO; 213 return; 214 }; 215 216 # Those variables are set when the object methods are called 217 # We need to reset everything 218 for ( 219 qw(ipversion errno prefixlen binmask reverse_ip last_ip iptype 220 binip error ip intformat hexformat mask last_bin last_int prefix is_prefix) 221 ) 222 { 223 delete($self->{$_}); 224 } 225 226 # Determine IP version for this object 227 return unless ($self->{ipversion} = $ipversion || ip_get_version($begin)); 228 229 # Set begin IP address 230 $self->{ip} = $begin; 231 232 # Set Binary IP address 233 return 234 unless ($self->{binip} = ip_iptobin($self->ip(), $self->version())); 235 236 $self->{is_prefix} = 0; 237 238 # Set end IP address 239 # If single IP: begin and end IPs are identical 240 $end ||= $begin; 241 $self->{last_ip} = $end; 242 243 # Try to determine the IP version 244 my $ver = ip_get_version($end) || return; 245 246 # Check if begin and end addresses have the same version 247 if ($ver != $self->version()) { 248 $ERRNO = 201; 249 $ERROR = 250 "Begin and End addresses have different IP versions - $begin - $end"; 251 $self->{errno} = $ERRNO; 252 $self->{error} = $ERROR; 253 return; 254 } 255 256 # Get last binary address 257 return 258 unless ($self->{last_bin} = 259 ip_iptobin($self->last_ip(), $self->version())); 260 261 # Check that End IP >= Begin IP 262 unless (ip_bincomp($self->binip(), 'le', $self->last_bin())) { 263 $ERRNO = 202; 264 $ERROR = "Begin address is greater than End address $begin - $end"; 265 $self->{errno} = $ERRNO; 266 $self->{error} = $ERROR; 267 return; 268 } 269 270 # Find all prefixes (eg:/24) in the current range 271 my @prefixes = $self->find_prefixes() or return; 272 273 # If there is only one prefix: 274 if (scalar(@prefixes) == 1) { 275 276 # Get length of prefix 277 return 278 unless ((undef, $self->{prefixlen}) = ip_splitprefix($prefixes[0])); 279 280 # Set prefix boolean var 281 # This value is 1 if the IP range only contains a single /nn prefix 282 $self->{is_prefix} = 1; 283 } 284 285 # If the range is a single prefix: 286 if ($self->{is_prefix}) { 287 288 # Set mask property 289 $self->{binmask} = ip_get_mask($self->prefixlen(), $self->version()); 290 291 # Check that the mask is valid 292 unless ( 293 ip_check_prefix( 294 $self->binip(), $self->prefixlen(), $self->version() 295 ) 296 ) 297 { 298 $self->{error} = $ERROR; 299 $self->{errno} = $ERRNO; 300 return; 301 } 302 } 303 304 return ($self); 305} 306 307sub print { 308 my $self = shift; 309 310 if ($self->{is_prefix}) { 311 return ($self->short() . '/' . $self->prefixlen()); 312 } 313 else { 314 return (sprintf("%s - %s", $self->ip(), $self->last_ip())); 315 } 316} 317 318#------------------------------------------------------------------------------ 319# Subroutine error 320# Purpose : Return the current error message 321# Returns : Error string 322sub error { 323 my $self = shift; 324 return $self->{error}; 325} 326 327#------------------------------------------------------------------------------ 328# Subroutine errno 329# Purpose : Return the current error number 330# Returns : Error number 331sub errno { 332 my $self = shift; 333 return $self->{errno}; 334} 335 336#------------------------------------------------------------------------------ 337# Subroutine binip 338# Purpose : Return the IP as a binary string 339# Returns : binary string 340sub binip { 341 my $self = shift; 342 return $self->{binip}; 343} 344 345#------------------------------------------------------------------------------ 346# Subroutine prefixlen 347# Purpose : Get the IP prefix length 348# Returns : prefix length 349sub prefixlen { 350 my $self = shift; 351 return $self->{prefixlen}; 352} 353 354#------------------------------------------------------------------------------ 355# Subroutine version 356# Purpose : Return the IP version 357# Returns : IP version 358sub version { 359 my $self = shift; 360 return $self->{ipversion}; 361} 362 363#------------------------------------------------------------------------------ 364# Subroutine version 365# Purpose : Return the IP in quad format 366# Returns : IP string 367sub ip { 368 my $self = shift; 369 return $self->{ip}; 370} 371 372#------------------------------------------------------------------------------ 373# Subroutine is_prefix 374# Purpose : Check if range of IPs is a prefix 375# Returns : boolean 376sub is_prefix { 377 my $self = shift; 378 return $self->{is_prefix}; 379} 380 381#------------------------------------------------------------------------------ 382# Subroutine binmask 383# Purpose : Return the binary mask of an IP prefix 384# Returns : Binary mask (as string) 385sub binmask { 386 my $self = shift; 387 return $self->{binmask}; 388} 389 390#------------------------------------------------------------------------------ 391# Subroutine size 392# Purpose : Return the number of addresses contained in an IP object 393# Returns : Number of addresses 394sub size { 395 my $self = shift; 396 397 my $size = new Math::BigInt($self->last_int); 398 $size->badd(1); 399 400 $size->bsub($self->intip); 401} 402 403# All the following functions work the same way: the method is just a frontend 404# to the real function. When the real function is called, the output is cached 405# so that next time the same function is called,the frontend function directly 406# returns the result. 407 408#------------------------------------------------------------------------------ 409# Subroutine intip 410# Purpose : Return the IP in integer format 411# Returns : Integer 412sub intip { 413 my $self = shift; 414 415 return ($self->{intformat}) if defined($self->{intformat}); 416 417 my $int = ip_bintoint($self->binip()); 418 419 if (!$int) { 420 $self->{error} = $ERROR; 421 $self->{errno} = $ERRNO; 422 return; 423 } 424 425 $self->{intformat} = $int; 426 427 return ($int); 428} 429 430#------------------------------------------------------------------------------ 431# Subroutine hexip 432# Purpose : Return the IP in hex format 433# Returns : hex string 434sub hexip { 435 my $self = shift; 436 return $self->{'hexformat'} if(defined($self->{'hexformat'})); 437 $self->{'hexformat'} = $self->intip->as_hex(); 438 return $self->{'hexformat'}; 439} 440 441#------------------------------------------------------------------------------ 442# Subroutine hexmask 443# Purpose : Return the mask back in hex 444# Returns : hex string 445sub hexmask { 446 my $self = shift; 447 448 return $self->{hexmask} if(defined($self->{hexmask})); 449 450 my $intmask = ip_bintoint($self->binmask); 451 452 $self->{'hexmask'} = $intmask->as_hex(); 453 454 return ($self->{'hexmask'}); 455} 456 457#------------------------------------------------------------------------------ 458# Subroutine prefix 459# Purpose : Return the Prefix (n.n.n.n/s) 460# Returns : IP Prefix 461sub prefix { 462 my $self = shift; 463 464 if (not $self->is_prefix()) { 465 $self->{error} = "IP range $self->{ip} is not a Prefix."; 466 $self->{errno} = 209; 467 return; 468 } 469 470 return ($self->{prefix}) if defined($self->{prefix}); 471 472 my $prefix = $self->ip() . '/' . $self->prefixlen(); 473 474 if (!$prefix) { 475 $self->{error} = $ERROR; 476 $self->{errno} = $ERRNO; 477 return; 478 } 479 480 $self->{prefix} = $prefix; 481 482 return ($prefix); 483} 484 485#------------------------------------------------------------------------------ 486# Subroutine mask 487# Purpose : Return the IP mask in quad format 488# Returns : Mask (string) 489sub mask { 490 my $self = shift; 491 492 if (not $self->is_prefix()) { 493 $self->{error} = "IP range $self->{ip} is not a Prefix."; 494 $self->{errno} = 209; 495 return; 496 } 497 498 return ($self->{mask}) if defined($self->{mask}); 499 500 my $mask = ip_bintoip($self->binmask(), $self->version()); 501 502 if (!$mask) { 503 $self->{error} = $ERROR; 504 $self->{errno} = $ERRNO; 505 return; 506 } 507 508 $self->{mask} = $mask; 509 510 return ($mask); 511} 512 513#------------------------------------------------------------------------------ 514# Subroutine short 515# Purpose : Get the short format of an IP address or a Prefix 516# Returns : short format IP or undef 517sub short { 518 my $self = shift; 519 520 my $r; 521 522 if ($self->version == 6) { 523 $r = ip_compress_address($self->ip(), $self->version()); 524 } 525 else { 526 $r = ip_compress_v4_prefix($self->ip(), $self->prefixlen()); 527 } 528 529 if (!defined($r)) { 530 $self->{error} = $ERROR; 531 $self->{errno} = $ERRNO; 532 return; 533 } 534 535 return ($r); 536} 537 538#------------------------------------------------------------------------------ 539# Subroutine iptype 540# Purpose : Return the type of an IP 541# Returns : Type or undef (failure) 542sub iptype { 543 my ($self) = shift; 544 545 return ($self->{iptype}) if defined($self->{iptype}); 546 547 my $type = ip_iptype($self->binip(), $self->version()); 548 549 if (!$type) { 550 $self->{error} = $ERROR; 551 $self->{errno} = $ERRNO; 552 return; 553 } 554 555 $self->{iptype} = $type; 556 557 return ($type); 558} 559 560#------------------------------------------------------------------------------ 561# Subroutine reverse_ip 562# Purpose : Return the Reverse IP 563# Returns : Reverse IP or undef(failure) 564sub reverse_ip { 565 my ($self) = shift; 566 567 if (not $self->is_prefix()) { 568 $self->{error} = "IP range $self->{ip} is not a Prefix."; 569 $self->{errno} = 209; 570 return; 571 } 572 573 return ($self->{reverse_ip}) if defined($self->{reverse_ip}); 574 575 my $rev = ip_reverse($self->ip(), $self->prefixlen(), $self->version()); 576 577 if (!$rev) { 578 $self->{error} = $ERROR; 579 $self->{errno} = $ERRNO; 580 return; 581 } 582 583 $self->{reverse_ip} = $rev; 584 585 return ($rev); 586} 587 588#------------------------------------------------------------------------------ 589# Subroutine last_bin 590# Purpose : Get the last IP of a range in binary format 591# Returns : Last binary IP or undef (failure) 592sub last_bin { 593 my ($self) = shift; 594 595 return ($self->{last_bin}) if defined($self->{last_bin}); 596 597 my $last; 598 599 if ($self->is_prefix()) { 600 $last = 601 ip_last_address_bin($self->binip(), $self->prefixlen(), 602 $self->version()); 603 } 604 else { 605 $last = ip_iptobin($self->last_ip(), $self->version()); 606 } 607 608 if (!$last) { 609 $self->{error} = $ERROR; 610 $self->{errno} = $ERRNO; 611 return; 612 } 613 614 $self->{last_bin} = $last; 615 616 return ($last); 617} 618 619#------------------------------------------------------------------------------ 620# Subroutine last_int 621# Purpose : Get the last IP of a range in integer format 622# Returns : Last integer IP or undef (failure) 623sub last_int { 624 my ($self) = shift; 625 626 return ($self->{last_int}) if defined($self->{last_int}); 627 628 my $last_bin = $self->last_bin() or return; 629 630 my $last_int = ip_bintoint($last_bin, $self->version()) or return; 631 632 $self->{last_int} = $last_int; 633 634 return ($last_int); 635} 636 637#------------------------------------------------------------------------------ 638# Subroutine last_ip 639# Purpose : Get the last IP of a prefix in IP format 640# Returns : IP or undef (failure) 641sub last_ip { 642 my ($self) = shift; 643 644 return ($self->{last_ip}) if defined($self->{last_ip}); 645 646 my $last = ip_bintoip($self->last_bin(), $self->version()); 647 648 if (!$last) { 649 $self->{error} = $ERROR; 650 $self->{errno} = $ERRNO; 651 return; 652 } 653 654 $self->{last_ip} = $last; 655 656 return ($last); 657} 658 659#------------------------------------------------------------------------------ 660# Subroutine find_prefixes 661# Purpose : Get all prefixes in the range defined by two IPs 662# Params : IP 663# Returns : List of prefixes or undef (failure) 664sub find_prefixes { 665 my ($self) = @_; 666 667 my @list = 668 ip_range_to_prefix($self->binip(), $self->last_bin(), $self->version()); 669 670 if (!scalar(@list)) { 671 $self->{error} = $ERROR; 672 $self->{errno} = $ERRNO; 673 return; 674 } 675 676 return (@list); 677} 678 679#------------------------------------------------------------------------------ 680# Subroutine bincomp 681# Purpose : Compare two IPs 682# Params : Operation, IP to compare 683# Returns : 1 (True), 0 (False) or undef (problem) 684# Comments : Operation can be lt, le, gt, ge 685sub bincomp { 686 my ($self, $op, $other) = @_; 687 688 my $a = ip_bincomp($self->binip(), $op, $other->binip()); 689 690 unless (defined $a) { 691 $self->{error} = $ERROR; 692 $self->{errno} = $ERRNO; 693 return; 694 } 695 696 return ($a); 697} 698 699#------------------------------------------------------------------------------ 700# Subroutine binadd 701# Purpose : Add two IPs 702# Params : IP to add 703# Returns : New IP object or undef (failure) 704sub binadd { 705 my ($self, $other) = @_; 706 707 my $ip = ip_binadd($self->binip(), $other->binip()); 708 709 if (!$ip) { 710 $self->{error} = $ERROR; 711 $self->{errno} = $ERRNO; 712 return; 713 } 714 715 my $new = new Net::IP(ip_bintoip($ip, $self->version())) or return; 716 717 return ($new); 718} 719 720#------------------------------------------------------------------------------ 721# Subroutine aggregate 722# Purpose : Aggregate (append) two IPs 723# Params : IP to add 724# Returns : New IP object or undef (failure) 725sub aggregate { 726 my ($self, $other) = @_; 727 728 my $r = ip_aggregate( 729 $self->binip(), $self->last_bin(), 730 $other->binip(), $other->last_bin(), 731 $self->version() 732 ); 733 734 if (!$r) { 735 $self->{error} = $ERROR; 736 $self->{errno} = $ERRNO; 737 return; 738 } 739 740 return (new Net::IP($r)); 741} 742 743#------------------------------------------------------------------------------ 744# Subroutine overlaps 745# Purpose : Check if two prefixes overlap 746# Params : Prefix to compare 747# Returns : $NO_OVERLAP (no overlap) 748# $IP_PARTIAL_OVERLAP (overlap) 749# $IP_A_IN_B_OVERLAP (range1 is included in range2) 750# $IP_B_IN_A_OVERLAP (range2 is included in range1) 751# $IP_IDENTICAL (range1 == range2) 752# or undef (problem) 753 754sub overlaps { 755 my ($self, $other) = @_; 756 757 my $r = ip_is_overlap( 758 $self->binip(), $self->last_bin(), 759 $other->binip(), $other->last_bin() 760 ); 761 762 if (!defined($r)) { 763 $self->{error} = $ERROR; 764 $self->{errno} = $ERRNO; 765 return; 766 } 767 768 return ($r); 769} 770 771#------------------------------------------------------------------------------ 772# Subroutine auth 773# Purpose : Return Authority information from IP::Authority 774# Params : IP object 775# Returns : Authority Source 776 777sub auth { 778 my ($self) = shift; 779 780 return ($self->{auth}) if defined($self->{auth}); 781 782 my $auth = ip_auth($self->ip, $self->version); 783 784 if (!$auth) { 785 $self->{error} = $ERROR; 786 $self->{errno} = $ERRNO; 787 return; 788 } 789 790 $self->{auth} = $auth; 791 792 return ($self->{auth}); 793} 794 795#------------------------------ PROCEDURAL INTERFACE -------------------------- 796#------------------------------------------------------------------------------ 797# Subroutine Error 798# Purpose : Return the ERROR string 799# Returns : string 800sub Error { 801 return ($ERROR); 802} 803 804#------------------------------------------------------------------------------ 805# Subroutine Error 806# Purpose : Return the ERRNO value 807# Returns : number 808sub Errno { 809 return ($ERRNO); 810} 811 812#------------------------------------------------------------------------------ 813# Subroutine ip_iplengths 814# Purpose : Get the length in bits of an IP from its version 815# Params : IP version 816# Returns : Number of bits 817 818sub ip_iplengths { 819 my ($version) = @_; 820 821 if ($version == 4) { 822 return (32); 823 } 824 elsif ($version == 6) { 825 return (128); 826 } 827 else { 828 return; 829 } 830} 831 832#------------------------------------------------------------------------------ 833# Subroutine ip_iptobin 834# Purpose : Transform an IP address into a bit string 835# Params : IP address, IP version 836# Returns : bit string on success, undef otherwise 837sub ip_iptobin { 838 my ($ip, $ipversion) = @_; 839 840 # v4 -> return 32-bit array 841 if ($ipversion == 4) { 842 return unpack('B32', pack('C4C4C4C4', split(/\./, $ip))); 843 } 844 845 # Strip ':' 846 $ip =~ s/://g; 847 848 # Check size 849 unless (length($ip) == 32) { 850 $ERROR = "Bad IP address $ip"; 851 $ERRNO = 102; 852 return; 853 } 854 855 # v6 -> return 128-bit array 856 return unpack('B128', pack('H32', $ip)); 857} 858 859#------------------------------------------------------------------------------ 860# Subroutine ip_bintoip 861# Purpose : Transform a bit string into an IP address 862# Params : bit string, IP version 863# Returns : IP address on success, undef otherwise 864sub ip_bintoip { 865 my ($binip, $ip_version) = @_; 866 867 # Define normal size for address 868 my $len = ip_iplengths($ip_version); 869 870 if ($len < length($binip)) { 871 $ERROR = "Invalid IP length for binary IP $binip\n"; 872 $ERRNO = 189; 873 return; 874 } 875 876 # Prepend 0s if address is less than normal size 877 $binip = '0' x ($len - length($binip)) . $binip; 878 879 # IPv4 880 if ($ip_version == 4) { 881 return join '.', unpack('C4C4C4C4', pack('B32', $binip)); 882 } 883 884 # IPv6 885 return join(':', unpack('H4H4H4H4H4H4H4H4', pack('B128', $binip))); 886} 887 888#------------------------------------------------------------------------------ 889# Subroutine ip_bintoint 890# Purpose : Transform a bit string into an Integer 891# Params : bit string 892# Returns : BigInt 893sub ip_bintoint { 894 my $binip = shift; 895 896 # $n is the increment, $dec is the returned value 897 my ($n, $dec) = (Math::BigInt->new(1), Math::BigInt->new(0)); 898 899 900 # Reverse the bit string 901 foreach (reverse(split '', $binip)) { 902 903 # If the nth bit is 1, add 2**n to $dec 904 $_ and $dec += $n; 905 $n *= 2; 906 } 907 908 # Strip leading + sign 909 $dec =~ s/^\+//; 910 return $dec; 911} 912 913#------------------------------------------------------------------------------ 914# Subroutine ip_inttobin 915# Purpose : Transform a BigInt into a bit string 916# Comments : sets warnings (-w) off. 917# This is necessary because Math::BigInt is not compliant 918# Params : BigInt, IP version 919# Returns : bit string 920sub ip_inttobin { 921 922 my $dec = Math::BigInt->new(shift); 923 924 # Find IP version 925 my $ip_version = shift; 926 927 unless ($ip_version) { 928 $ERROR = "Cannot determine IP version for $dec"; 929 $ERRNO = 101; 930 return; 931 } 932 933 my $binip = $dec->as_bin(); 934 $binip =~ s/^0b//; 935 936 # Define normal size for address 937 my $len = ip_iplengths($ip_version); 938 939 # Prepend 0s if result is less than normal size 940 $binip = '0' x ($len - length($binip)) . $binip; 941 942 943 return $binip; 944 945} 946 947#------------------------------------------------------------------------------ 948# Subroutine ip_get_version 949# Purpose : Get an IP version 950# Params : IP address 951# Returns : 4, 6, 0(don't know) 952sub ip_get_version { 953 my $ip = shift; 954 955 # If the address does not contain any ':', maybe it's IPv4 956 $ip !~ /:/ and ip_is_ipv4($ip) and return '4'; 957 958 # Is it IPv6 ? 959 ip_is_ipv6($ip) and return '6'; 960 961 return; 962} 963 964#------------------------------------------------------------------------------ 965# Subroutine ip_is_ipv4 966# Purpose : Check if an IP address is version 4 967# Params : IP address 968# Returns : 1 (yes) or 0 (no) 969sub ip_is_ipv4 { 970 my $ip = shift; 971 972 # Check for invalid chars 973 unless ($ip =~ m/^[\d\.]+$/) { 974 $ERROR = "Invalid chars in IP $ip"; 975 $ERRNO = 107; 976 return 0; 977 } 978 979 if ($ip =~ m/^\./) { 980 $ERROR = "Invalid IP $ip - starts with a dot"; 981 $ERRNO = 103; 982 return 0; 983 } 984 985 if ($ip =~ m/\.$/) { 986 $ERROR = "Invalid IP $ip - ends with a dot"; 987 $ERRNO = 104; 988 return 0; 989 } 990 991 # Single Numbers are considered to be IPv4 992 if ($ip =~ m/^(\d+)$/ and $1 < 256) { return 1 } 993 994 # Count quads 995 my $n = ($ip =~ tr/\./\./); 996 997 # IPv4 must have from 1 to 4 quads 998 unless ($n >= 0 and $n < 4) { 999 $ERROR = "Invalid IP address $ip"; 1000 $ERRNO = 105; 1001 return 0; 1002 } 1003 1004 # Check for empty quads 1005 if ($ip =~ m/\.\./) { 1006 $ERROR = "Empty quad in IP address $ip"; 1007 $ERRNO = 106; 1008 return 0; 1009 } 1010 1011 foreach (split /\./, $ip) { 1012 1013 # Check for invalid quads 1014 unless ($_ >= 0 and $_ < 256) { 1015 $ERROR = "Invalid quad in IP address $ip - $_"; 1016 $ERRNO = 107; 1017 return 0; 1018 } 1019 } 1020 return 1; 1021} 1022 1023#------------------------------------------------------------------------------ 1024# Subroutine ip_is_ipv6 1025# Purpose : Check if an IP address is version 6 1026# Params : IP address 1027# Returns : 1 (yes) or 0 (no) 1028sub ip_is_ipv6 { 1029 my $ip = shift; 1030 1031 # Count octets 1032 my $n = ($ip =~ tr/:/:/); 1033 return 0 unless ($n > 0 and $n < 8); 1034 1035 # $k is a counter 1036 my $k; 1037 1038 foreach (split /:/, $ip) { 1039 $k++; 1040 1041 # Empty octet ? 1042 next if ($_ eq ''); 1043 1044 # Normal v6 octet ? 1045 next if (/^[a-f\d]{1,4}$/i); 1046 1047 # Last octet - is it IPv4 ? 1048 if ( ($k == $n + 1) && ip_is_ipv4($_) ) { 1049 $n++; # ipv4 is two octets 1050 next; 1051 } 1052 1053 $ERROR = "Invalid IP address $ip"; 1054 $ERRNO = 108; 1055 return 0; 1056 } 1057 1058 # Does the IP address start with : ? 1059 if ($ip =~ m/^:[^:]/) { 1060 $ERROR = "Invalid address $ip (starts with :)"; 1061 $ERRNO = 109; 1062 return 0; 1063 } 1064 1065 # Does the IP address finish with : ? 1066 if ($ip =~ m/[^:]:$/) { 1067 $ERROR = "Invalid address $ip (ends with :)"; 1068 $ERRNO = 110; 1069 return 0; 1070 } 1071 1072 # Does the IP address have more than one '::' pattern ? 1073 if ($ip =~ s/:(?=:)/:/g > 1) { 1074 $ERROR = "Invalid address $ip (More than one :: pattern)"; 1075 $ERRNO = 111; 1076 return 0; 1077 } 1078 1079 # number of octets 1080 if ($n != 7 && $ip !~ /::/) { 1081 $ERROR = "Invalid number of octets $ip"; 1082 $ERRNO = 112; 1083 return 0; 1084 } 1085 1086 # valid IPv6 address 1087 return 1; 1088} 1089 1090#------------------------------------------------------------------------------ 1091# Subroutine ip_expand_address 1092# Purpose : Expand an address from compact notation 1093# Params : IP address, IP version 1094# Returns : expanded IP address or undef on failure 1095sub ip_expand_address { 1096 my ($ip, $ip_version) = @_; 1097 1098 unless ($ip_version) { 1099 $ERROR = "Cannot determine IP version for $ip"; 1100 $ERRNO = 101; 1101 return; 1102 } 1103 1104 # v4 : add .0 for missing quads 1105 if ($ip_version == 4) { 1106 my @quads = split /\./, $ip; 1107 1108 # check number of quads 1109 if (scalar(@quads) > 4) { 1110 $ERROR = "Not a valid IPv address $ip"; 1111 $ERRNO = 102; 1112 return; 1113 } 1114 my @clean_quads = (0, 0, 0, 0); 1115 1116 foreach my $q (reverse @quads) { 1117 1118 #check quad data 1119 if ($q !~ m/^\d{1,3}$/) { 1120 $ERROR = "Not a valid IPv4 address $ip"; 1121 $ERRNO = 102; 1122 return; 1123 } 1124 1125 # build clean ipv4 1126 unshift(@clean_quads, $q + 1 - 1); 1127 } 1128 1129 return (join '.', @clean_quads[ 0 .. 3 ]); 1130 } 1131 1132 # Keep track of :: 1133 my $num_of_double_colon = ($ip =~ s/::/:!:/g); 1134 if ($num_of_double_colon > 1) { 1135 $ERROR = "Too many :: in ip"; 1136 $ERRNO = 102; 1137 return; 1138 } 1139 1140 # IP as an array 1141 my @ip = split /:/, $ip; 1142 1143 # Number of octets 1144 my $num = scalar(@ip); 1145 1146 foreach (0 .. (scalar(@ip) - 1)) { 1147 1148 # Embedded IPv4 1149 if ($ip[$_] =~ /\./) { 1150 1151 # Expand Ipv4 address 1152 # Convert into binary 1153 # Convert into hex 1154 # Keep the last two octets 1155 1156 $ip[$_] = substr( ip_bintoip( ip_iptobin( ip_expand_address($ip[$_], 4), 4), 6), -9); 1157 1158 # Has an error occured here ? 1159 return unless (defined($ip[$_])); 1160 1161 # $num++ because we now have one more octet: 1162 # IPv4 address becomes two octets 1163 $num++; 1164 next; 1165 } 1166 1167 # Add missing trailing 0s 1168 $ip[$_] = ('0' x (4 - length($ip[$_]))) . $ip[$_]; 1169 } 1170 1171 # Now deal with '::' ('000!') 1172 foreach (0 .. (scalar(@ip) - 1)) { 1173 1174 # Find the pattern 1175 next unless ($ip[$_] eq '000!'); 1176 1177 # @empty is the IP address 0 1178 my @empty = map { $_ = '0' x 4 } (0 .. 7); 1179 1180 # Replace :: with $num '0000' octets 1181 $ip[$_] = join ':', @empty[ 0 .. 8 - $num ]; 1182 last; 1183 } 1184 1185 return (lc(join ':', @ip)); 1186} 1187 1188#------------------------------------------------------------------------------ 1189# Subroutine ip_get_mask 1190# Purpose : Get IP mask from prefix length. 1191# Params : Prefix length, IP version 1192# Returns : Binary Mask 1193sub ip_get_mask { 1194 my ($len, $ip_version) = @_; 1195 1196 unless ($ip_version) { 1197 $ERROR = "Cannot determine IP version"; 1198 $ERRNO = 101; 1199 return; 1200 } 1201 1202 my $size = ip_iplengths($ip_version); 1203 1204 # mask is $len 1s plus the rest as 0s 1205 return (('1' x $len) . ('0' x ($size - $len))); 1206} 1207 1208#------------------------------------------------------------------------------ 1209# Subroutine ip_last_address_bin 1210# Purpose : Return the last binary address of a range 1211# Params : First binary IP, prefix length, IP version 1212# Returns : Binary IP 1213sub ip_last_address_bin { 1214 my ($binip, $len, $ip_version) = @_; 1215 1216 unless ($ip_version) { 1217 $ERROR = "Cannot determine IP version"; 1218 $ERRNO = 101; 1219 return; 1220 } 1221 1222 my $size = ip_iplengths($ip_version); 1223 1224 # Find the part of the IP address which will not be modified 1225 $binip = substr($binip, 0, $len); 1226 1227 # Fill with 1s the variable part 1228 return ($binip . ('1' x ($size - length($binip)))); 1229} 1230 1231#------------------------------------------------------------------------------ 1232# Subroutine ip_splitprefix 1233# Purpose : Split a prefix into IP and prefix length 1234# Comments : If it was passed a simple IP, it just returns it 1235# Params : Prefix 1236# Returns : IP, optionnaly length of prefix 1237sub ip_splitprefix { 1238 my $prefix = shift; 1239 1240 # Find the '/' 1241 return unless ($prefix =~ m!^([^/]+?)(/\d+)?$!); 1242 1243 my ($ip, $len) = ($1, $2); 1244 1245 defined($len) and $len =~ s!/!!; 1246 1247 return ($ip, $len); 1248} 1249 1250#------------------------------------------------------------------------------ 1251# Subroutine ip_prefix_to_range 1252# Purpose : Get a range from a prefix 1253# Params : IP, Prefix length, IP version 1254# Returns : First IP, last IP 1255sub ip_prefix_to_range { 1256 my ($ip, $len, $ip_version) = @_; 1257 1258 unless ($ip_version) { 1259 $ERROR = "Cannot determine IP version"; 1260 $ERRNO = 101; 1261 return; 1262 } 1263 1264 # Expand the first IP address 1265 $ip = ip_expand_address($ip, $ip_version); 1266 1267 # Turn into a binary 1268 # Get last address 1269 # Turn into an IP 1270 my $binip = ip_iptobin($ip, $ip_version) or return; 1271 1272 return unless (ip_check_prefix($binip, $len, $ip_version)); 1273 1274 my $lastip = ip_last_address_bin($binip, $len, $ip_version) or return; 1275 return unless ($lastip = ip_bintoip($lastip, $ip_version)); 1276 1277 return ($ip, $lastip); 1278} 1279 1280#------------------------------------------------------------------------------ 1281# Subroutine ip_is_valid_mask 1282# Purpose : Check the validity of an IP mask (11110000) 1283# Params : Mask 1284# Returns : 1 or undef (invalid) 1285sub ip_is_valid_mask { 1286 my ($mask, $ip_version) = @_; 1287 1288 unless ($ip_version) { 1289 $ERROR = "Cannot determine IP version for $mask"; 1290 $ERRNO = 101; 1291 return; 1292 } 1293 1294 my $len = ip_iplengths($ip_version); 1295 1296 if (length($mask) != $len) { 1297 $ERROR = "Invalid mask length for $mask"; 1298 $ERRNO = 150; 1299 return; 1300 } 1301 1302 # The mask should be of the form 111110000000 1303 unless ($mask =~ m/^1*0*$/) { 1304 $ERROR = "Invalid mask $mask"; 1305 $ERRNO = 151; 1306 return; 1307 } 1308 1309 return 1; 1310} 1311 1312#------------------------------------------------------------------------------ 1313# Subroutine ip_bincomp 1314# Purpose : Compare binary Ips with <, >, <=, >= 1315# Comments : Operators are lt(<), le(<=), gt(>), and ge(>=) 1316# Params : First binary IP, operator, Last binary Ip 1317# Returns : 1 (yes), 0 (no), or undef (problem) 1318sub ip_bincomp { 1319 my ($begin, $op, $end) = @_; 1320 1321 my ($b, $e); 1322 1323 if ($op =~ /^l[te]$/) # Operator is lt or le 1324 { 1325 ($b, $e) = ($end, $begin); 1326 } 1327 elsif ($op =~ /^g[te]$/) # Operator is gt or ge 1328 { 1329 ($b, $e) = ($begin, $end); 1330 } 1331 else { 1332 $ERROR = "Invalid Operator $op\n"; 1333 $ERRNO = 131; 1334 return; 1335 } 1336 1337 # le or ge -> return 1 if IPs are identical 1338 return (1) if ($op =~ /e/ and ($begin eq $end)); 1339 1340 # Check IP sizes 1341 unless (length($b) eq length($e)) { 1342 $ERROR = "IP addresses of different length\n"; 1343 $ERRNO = 130; 1344 return; 1345 } 1346 1347 my $c; 1348 1349 # Foreach bit 1350 for (0 .. length($b) - 1) { 1351 1352 # substract the two bits 1353 $c = substr($b, $_, 1) - substr($e, $_, 1); 1354 1355 # Check the result 1356 return (1) if ($c == 1); 1357 return (0) if ($c == -1); 1358 } 1359 1360 # IPs are identical 1361 return 0; 1362} 1363 1364#------------------------------------------------------------------------------ 1365# Subroutine ip_binadd 1366# Purpose : Add two binary IPs 1367# Params : First binary IP, Last binary Ip 1368# Returns : Binary sum or undef (problem) 1369sub ip_binadd { 1370 my ($b, $e) = @_; 1371 1372 # Check IP length 1373 unless (length($b) eq length($e)) { 1374 $ERROR = "IP addresses of different length\n"; 1375 $ERRNO = 130; 1376 return; 1377 } 1378 1379 # Reverse the two IPs 1380 $b = scalar(reverse $b); 1381 $e = scalar(reverse $e); 1382 1383 my ($carry, $result, $c) = (0); 1384 1385 # Foreach bit (reversed) 1386 for (0 .. length($b) - 1) { 1387 1388 # add the two bits plus the carry 1389 $c = substr($b, $_, 1) + substr($e, $_, 1) + $carry; 1390 $carry = 0; 1391 1392 # sum = 0 => $c = 0, $carry = 0 1393 # sum = 1 => $c = 1, $carry = 0 1394 # sum = 2 => $c = 0, $carry = 1 1395 # sum = 3 => $c = 1, $carry = 1 1396 if ($c > 1) { 1397 $c -= 2; 1398 $carry = 1; 1399 } 1400 1401 $result .= $c; 1402 } 1403 1404 # Reverse result 1405 return scalar(reverse($result)); 1406} 1407 1408#------------------------------------------------------------------------------ 1409# Subroutine ip_get_prefix_length 1410# Purpose : Get the prefix length for a given range of IPs 1411# Params : First binary IP, Last binary IP 1412# Returns : Length of prefix or undef (problem) 1413sub ip_get_prefix_length { 1414 my ($bin1, $bin2) = @_; 1415 1416 # Check length of IPs 1417 unless (length($bin1) eq length($bin2)) { 1418 $ERROR = "IP addresses of different length\n"; 1419 $ERRNO = 130; 1420 return; 1421 } 1422 1423 # reverse IPs 1424 $bin1 = scalar(reverse $bin1); 1425 $bin2 = scalar(reverse $bin2); 1426 1427 # foreach bit 1428 for (0 .. length($bin1) - 1) { 1429 1430 # If bits are equal it means we have reached the longest prefix 1431 return ("$_") if (substr($bin1, $_, 1) eq substr($bin2, $_, 1)); 1432 1433 } 1434 1435 # Return 32 (IPv4) or 128 (IPv6) 1436 return length($bin1); 1437} 1438 1439#------------------------------------------------------------------------------ 1440# Subroutine ip_range_to_prefix 1441# Purpose : Return all prefixes between two IPs 1442# Params : First IP, Last IP, IP version 1443# Returns : List of Prefixes or undef (problem) 1444sub ip_range_to_prefix { 1445 my ($binip, $endbinip, $ip_version) = @_; 1446 1447 unless ($ip_version) { 1448 $ERROR = "Cannot determine IP version"; 1449 $ERRNO = 101; 1450 return; 1451 } 1452 1453 unless (length($binip) eq length($endbinip)) { 1454 $ERROR = "IP addresses of different length\n"; 1455 $ERRNO = 130; 1456 return; 1457 } 1458 1459 my ($len, $nbits, $current, $add, @prefix); 1460 1461 # 1 in binary 1462 my $one = ('0' x (ip_iplengths($ip_version) - 1)) . '1'; 1463 1464 # While we have not reached the last IP 1465 while (ip_bincomp($binip, 'le', $endbinip) == 1) { 1466 1467 # Find all 0s at the end 1468 if ($binip =~ m/(0+)$/) { 1469 1470 # nbits = nb of 0 bits 1471 $nbits = length($1); 1472 } 1473 else { 1474 $nbits = 0; 1475 } 1476 1477 do { 1478 $current = $binip; 1479 $add = '1' x $nbits; 1480 1481 # Replace $nbits 0s with 1s 1482 $current =~ s/0{$nbits}$/$add/; 1483 $nbits--; 1484 1485 # Decrease $nbits if $current >= $endbinip 1486 } while (ip_bincomp($current, 'le', $endbinip) != 1); 1487 1488 # Find Prefix length 1489 $len = 1490 (ip_iplengths($ip_version)) - ip_get_prefix_length($binip, $current); 1491 1492 # Push prefix in list 1493 push(@prefix, ip_bintoip($binip, $ip_version) . "/$len"); 1494 1495 # Add 1 to current IP 1496 $binip = ip_binadd($current, $one); 1497 1498 # Exit if IP is 32/128 1s 1499 last if ($current =~ m/^1+$/); 1500 } 1501 1502 return (@prefix); 1503} 1504 1505#------------------------------------------------------------------------------ 1506# Subroutine ip_compress_v4_prefix 1507# Purpose : Compress an IPv4 Prefix 1508# Params : IP, Prefix length 1509# Returns : Compressed IP - ie: 194.5 1510sub ip_compress_v4_prefix { 1511 my ($ip, $len) = @_; 1512 1513 my @quads = split /\./, $ip; 1514 1515 my $qlen = int(($len - 1) / 8); 1516 1517 $qlen = 0 if ($qlen < 0); 1518 1519 my $newip = join '.', @quads[ 0 .. $qlen ]; 1520 1521 return ($newip); 1522} 1523 1524#------------------------------------------------------------------------------ 1525# Subroutine ip_compress_address 1526# Purpose : Compress an IPv6 address 1527# Params : IP, IP version 1528# Returns : Compressed IP or undef (problem) 1529sub ip_compress_address { 1530 my ($ip, $ip_version) = @_; 1531 1532 unless ($ip_version) { 1533 $ERROR = "Cannot determine IP version for $ip"; 1534 $ERRNO = 101; 1535 return; 1536 } 1537 1538 # Just return if IP is IPv4 1539 return ($ip) if ($ip_version == 4); 1540 1541 # already compressed addresses must be expanded first 1542 $ip = ip_expand_address( $ip, $ip_version); 1543 1544 # Remove leading 0s: 0034 -> 34; 0000 -> 0 1545 $ip =~ s/ 1546 (^|:) # Find beginning or ':' -> $1 1547 0+ # 1 or several 0s 1548 (?= # Look-ahead 1549 [a-fA-F\d]+ # One or several Hexs 1550 (?::|$)) # ':' or end 1551 /$1/gx; 1552 1553 my $reg = ''; 1554 1555 # Find the longuest :0:0: sequence 1556 while ( 1557 $ip =~ m/ 1558 ((?:^|:) # Find beginning or ':' -> $1 1559 0(?::0)+ # 0 followed by 1 or several ':0' 1560 (?::|$)) # ':' or end 1561 /gx 1562 ) 1563 { 1564 $reg = $1 if (length($reg) < length($1)); 1565 } 1566 1567 # Replace sequence by '::' 1568 $ip =~ s/$reg/::/ if ($reg ne ''); 1569 1570 return $ip; 1571} 1572 1573#------------------------------------------------------------------------------ 1574# Subroutine ip_is_overlap 1575# Purpose : Check if two ranges overlap 1576# Params : Four binary IPs (begin of range 1,end1,begin2,end2) 1577# Returns : $NO_OVERLAP (no overlap) 1578# $IP_PARTIAL_OVERLAP (overlap) 1579# $IP_A_IN_B_OVERLAP (range1 is included in range2) 1580# $IP_B_IN_A_OVERLAP (range2 is included in range1) 1581# $IP_IDENTICAL (range1 == range2) 1582# or undef (problem) 1583 1584sub ip_is_overlap { 1585 my ($b1, $e1, $b2, $e2) = (@_); 1586 1587 my $swap; 1588 $swap = 0; 1589 1590 unless ((length($b1) eq length($e1)) 1591 and (length($b2) eq length($e2)) 1592 and (length($b1) eq length($b2))) 1593 { 1594 $ERROR = "IP addresses of different length\n"; 1595 $ERRNO = 130; 1596 return; 1597 } 1598 1599 # begin1 <= end1 ? 1600 unless (ip_bincomp($b1, 'le', $e1) == 1) { 1601 $ERROR = "Invalid range $b1 - $e1"; 1602 $ERRNO = 140; 1603 return; 1604 } 1605 1606 # begin2 <= end2 ? 1607 unless (ip_bincomp($b2, 'le', $e2) == 1) { 1608 $ERROR = "Invalid range $b2 - $e2"; 1609 $ERRNO = 140; 1610 return; 1611 } 1612 1613 # b1 == b2 ? 1614 if ($b1 eq $b2) { 1615 1616 # e1 == e2 1617 return ($IP_IDENTICAL) if ($e1 eq $e2); 1618 1619 # e1 < e2 ? 1620 return ( 1621 ip_bincomp($e1, 'lt', $e2) 1622 ? $IP_A_IN_B_OVERLAP 1623 : $IP_B_IN_A_OVERLAP 1624 ); 1625 } 1626 1627 # e1 == e2 ? 1628 if ($e1 eq $e2) { 1629 1630 # b1 < b2 1631 return ( 1632 ip_bincomp($b1, 'lt', $b2) 1633 ? $IP_B_IN_A_OVERLAP 1634 : $IP_A_IN_B_OVERLAP 1635 ); 1636 } 1637 1638 # b1 < b2 1639 if ((ip_bincomp($b1, 'lt', $b2) == 1)) { 1640 1641 # e1 < b2 1642 return ($IP_NO_OVERLAP) if (ip_bincomp($e1, 'lt', $b2) == 1); 1643 1644 # e1 < e2 ? 1645 return ( 1646 ip_bincomp($e1, 'lt', $e2) 1647 ? $IP_PARTIAL_OVERLAP 1648 : $IP_B_IN_A_OVERLAP 1649 ); 1650 } 1651 else # b1 > b2 1652 { 1653 1654 # e2 < b1 1655 return ($IP_NO_OVERLAP) if (ip_bincomp($e2, 'lt', $b1) == 1); 1656 1657 # e2 < e1 ? 1658 return ( 1659 ip_bincomp($e2, 'lt', $e1) 1660 ? $IP_PARTIAL_OVERLAP 1661 : $IP_A_IN_B_OVERLAP 1662 ); 1663 } 1664} 1665 1666#------------------------------------------------------------------------------ 1667# Subroutine get_embedded_ipv4 1668# Purpose : Get an IPv4 embedded in an IPv6 address 1669# Params : IPv6 1670# Returns : IPv4 or undef (not found) 1671sub ip_get_embedded_ipv4 { 1672 my $ipv6 = shift; 1673 1674 my @ip = split /:/, $ipv6; 1675 1676 # Bugfix by Norbert Koch 1677 return unless (@ip); 1678 1679 # last octet should be ipv4 1680 return ($ip[-1]) if (ip_is_ipv4($ip[-1])); 1681 1682 return; 1683} 1684 1685#------------------------------------------------------------------------------ 1686# Subroutine aggregate 1687# Purpose : Aggregate 2 ranges 1688# Params : 1st range (1st IP, Last IP), last range (1st IP, last IP), 1689# IP version 1690# Returns : prefix or undef (invalid) 1691sub ip_aggregate { 1692 my ($binbip1, $bineip1, $binbip2, $bineip2, $ip_version) = @_; 1693 1694 unless ($ip_version) { 1695 $ERROR = "Cannot determine IP version for $binbip1"; 1696 $ERRNO = 101; 1697 return; 1698 } 1699 1700 # Bin 1 1701 my $one = (('0' x (ip_iplengths($ip_version) - 1)) . '1'); 1702 1703 # $eip1 + 1 = $bip2 ? 1704 unless (ip_binadd($bineip1, $one) eq $binbip2) { 1705 $ERROR = "Ranges not contiguous - $bineip1 - $binbip2"; 1706 $ERRNO = 160; 1707 return; 1708 } 1709 1710 # Get ranges 1711 my @prefix = ip_range_to_prefix($binbip1, $bineip2, $ip_version); 1712 1713 # There should be only one range 1714 return if scalar(@prefix) < 1; 1715 1716 if (scalar(@prefix) > 1) { 1717 $ERROR = "$binbip1 - $bineip2 is not a single prefix"; 1718 $ERRNO = 161; 1719 return; 1720 } 1721 return ($prefix[0]); 1722 1723} 1724 1725#------------------------------------------------------------------------------ 1726# Subroutine ip_iptype 1727# Purpose : Return the type of an IP (Public, Private, Reserved) 1728# Params : IP to test, IP version 1729# Returns : type or undef (invalid) 1730sub ip_iptype { 1731 my ($ip, $ip_version) = @_; 1732 1733 # handle known ip versions 1734 return ip_iptypev4($ip) if $ip_version == 4; 1735 return ip_iptypev6($ip) if $ip_version == 6; 1736 1737 # unsupported ip version 1738 $ERROR = "IP version $ip not supported"; 1739 $ERRNO = 180; 1740 return; 1741} 1742 1743#------------------------------------------------------------------------------ 1744# Subroutine ip_iptypev4 1745# Purpose : Return the type of an IP (Public, Private, Reserved) 1746# Params : IP to test, IP version 1747# Returns : type or undef (invalid) 1748sub ip_iptypev4 { 1749 my ($ip) = @_; 1750 1751 # check ip 1752 if ($ip !~ m/^[01]{1,32}$/) { 1753 $ERROR = "$ip is not a binary IPv4 address $ip"; 1754 $ERRNO = 180; 1755 return; 1756 } 1757 1758 # see if IP is listed 1759 foreach (sort { length($b) <=> length($a) } keys %IPv4ranges) { 1760 return ($IPv4ranges{$_}) if ($ip =~ m/^$_/); 1761 } 1762 1763 # not listed means IP is public 1764 return 'PUBLIC'; 1765} 1766 1767#------------------------------------------------------------------------------ 1768# Subroutine ip_iptypev6 1769# Purpose : Return the type of an IP (Public, Private, Reserved) 1770# Params : IP to test, IP version 1771# Returns : type or undef (invalid) 1772sub ip_iptypev6 { 1773 my ($ip) = @_; 1774 1775 # check ip 1776 if ($ip !~ m/^[01]{1,128}$/) { 1777 $ERROR = "$ip is not a binary IPv6 address"; 1778 $ERRNO = 180; 1779 return; 1780 } 1781 1782 foreach (sort { length($b) <=> length($a) } keys %IPv6ranges) { 1783 return ($IPv6ranges{$_}) if ($ip =~ m/^$_/); 1784 } 1785 1786 # How did we get here? All IPv6 addresses should match 1787 $ERROR = "Cannot determine type for $ip"; 1788 $ERRNO = 180; 1789 return; 1790} 1791 1792#------------------------------------------------------------------------------ 1793# Subroutine ip_check_prefix 1794# Purpose : Check the validity of a prefix 1795# Params : binary IP, length of prefix, IP version 1796# Returns : 1 or undef (invalid) 1797sub ip_check_prefix { 1798 my ($binip, $len, $ipversion) = (@_); 1799 1800 # Check if len is longer than IP 1801 if ($len > length($binip)) { 1802 $ERROR = 1803 "Prefix length $len is longer than IP address (" 1804 . length($binip) . ")"; 1805 $ERRNO = 170; 1806 return; 1807 } 1808 1809 my $rest = substr($binip, $len); 1810 1811 # Check if last part of the IP (len part) has only 0s 1812 unless ($rest =~ /^0*$/) { 1813 $ERROR = "Invalid prefix $binip/$len"; 1814 $ERRNO = 171; 1815 return; 1816 } 1817 1818 # Check if prefix length is correct 1819 unless (length($rest) + $len == ip_iplengths($ipversion)) { 1820 $ERROR = "Invalid prefix length /$len"; 1821 $ERRNO = 172; 1822 return; 1823 } 1824 1825 return 1; 1826} 1827 1828#------------------------------------------------------------------------------ 1829# Subroutine ip_reverse 1830# Purpose : Get a reverse name from a prefix 1831# Comments : From Lee's iplib.pm 1832# Params : IP, length of prefix, IP version 1833# Returns : Reverse name or undef (error) 1834sub ip_reverse { 1835 my ($ip, $len, $ip_version) = (@_); 1836 1837 $ip_version ||= ip_get_version($ip); 1838 unless ($ip_version) { 1839 $ERROR = "Cannot determine IP version for $ip"; 1840 $ERRNO = 101; 1841 return; 1842 } 1843 1844 if ($ip_version == 4) { 1845 my @quads = split /\./, $ip; 1846 my $no_quads = ($len / 8); 1847 1848 my @reverse_quads = reverse @quads; 1849 1850 while (@reverse_quads and $reverse_quads[0] == 0) { 1851 shift(@reverse_quads); 1852 } 1853 1854 return join '.', @reverse_quads, 'in-addr', 'arpa.'; 1855 } 1856 elsif ($ip_version == 6) { 1857 my @rev_groups = reverse split /:/, ip_expand_address($ip, 6); 1858 my @result; 1859 1860 foreach (@rev_groups) { 1861 my @revhex = reverse split //; 1862 push @result, @revhex; 1863 } 1864 1865 # This takes the zone above if it's not exactly on a nibble 1866 my $first_nibble_index = $len ? 32 - (int($len / 4)) : 0; 1867 return join '.', @result[ $first_nibble_index .. $#result ], 'ip6', 1868 'arpa.'; 1869 } 1870} 1871 1872#------------------------------------------------------------------------------ 1873# Subroutine ip_normalize 1874# Purpose : Normalize data to a range of IP addresses 1875# Params : IP or prefix or range 1876# Returns : ip1, ip2 (if range) or undef (error) 1877sub ip_normalize { 1878 my ($data) = shift; 1879 1880 my $ipversion; 1881 1882 my ($len, $ip, $ip2, $real_len, $first, $last, $curr_bin, $addcst, $clen); 1883 1884 # Prefix 1885 if ($data =~ m!^(\S+?)(/\S+)$!) { 1886 ($ip, $len) = ($1, $2); 1887 1888 return unless ($ipversion = ip_get_version($ip)); 1889 return unless ($ip = ip_expand_address($ip, $ipversion)); 1890 return unless ($curr_bin = ip_iptobin($ip, $ipversion)); 1891 1892 my $one = '0' x (ip_iplengths($ipversion) - 1) . '1'; 1893 1894 while ($len) { 1895 last unless ($len =~ s!^/(\d+)(\,|$)!!); 1896 1897 $clen = $1; 1898 $addcst = length($2) > 0; 1899 1900 return unless (ip_check_prefix($curr_bin, $clen, $ipversion)); 1901 1902 return 1903 unless ($curr_bin = 1904 ip_last_address_bin($curr_bin, $clen, $ipversion)); 1905 1906 if ($addcst) { 1907 return unless ($curr_bin = ip_binadd($curr_bin, $one)); 1908 } 1909 } 1910 1911 return ($ip, ip_bintoip($curr_bin, $ipversion)); 1912 } 1913 1914 # Range 1915 elsif ($data =~ /^(.+?)\s*\-\s*(.+)$/) { 1916 ($ip, $ip2) = ($1, $2); 1917 1918 return unless ($ipversion = ip_get_version($ip)); 1919 1920 return unless ($ip = ip_expand_address($ip, $ipversion)); 1921 return unless ($ip2 = ip_expand_address($ip2, $ipversion)); 1922 1923 return ($ip, $ip2); 1924 } 1925 1926 # IP + Number 1927 elsif ($data =~ /^(.+?)\s+\+\s+(.+)$/) { 1928 ($ip, $len) = ($1, $2); 1929 1930 return unless ($ipversion = ip_get_version($ip)); 1931 return unless ($ip = ip_expand_address($ip, $ipversion)); 1932 1933 my ($bin_ip); 1934 return unless ($bin_ip = ip_iptobin($ip, $ipversion)); 1935 1936 return unless ($len = ip_inttobin($len, $ipversion)); 1937 1938 return unless ($ip2 = ip_binadd($bin_ip, $len)); 1939 return unless ($ip2 = ip_bintoip($ip2, $ipversion)); 1940 1941 return ($ip, $ip2); 1942 } 1943 1944 # Single IP 1945 else { 1946 $ip = $data; 1947 1948 return unless ($ipversion = ip_get_version($ip)); 1949 1950 return unless ($ip = ip_expand_address($ip, $ipversion)); 1951 1952 return $ip; 1953 } 1954} 1955 1956#------------------------------------------------------------------------------ 1957# Subroutine normal_range 1958# Purpose : Return the normalized format of a range 1959# Params : IP or prefix or range 1960# Returns : "ip1 - ip2" or undef (error) 1961sub ip_normal_range { 1962 my ($data) = shift; 1963 1964 my ($ip1, $ip2) = ip_normalize($data); 1965 1966 return unless ($ip1); 1967 1968 $ip2 ||= $ip1; 1969 1970 return ("$ip1 - $ip2"); 1971} 1972 1973#------------------------------------------------------------------------------ 1974# Subroutine ip_auth 1975# Purpose : Get Authority information from IP::Authority Module 1976# Comments : Requires IP::Authority 1977# Params : IP, length of prefix 1978# Returns : Reverse name or undef (error) 1979sub ip_auth { 1980 my ($ip, $ip_version) = (@_); 1981 1982 unless ($ip_version) { 1983 $ERROR = "Cannot determine IP version for $ip"; 1984 $ERRNO = 101; 1985 die; 1986 return; 1987 } 1988 1989 if ($ip_version != 4) { 1990 1991 $ERROR = "Cannot get auth information: Not an IPv4 address"; 1992 $ERRNO = 308; 1993 die; 1994 return; 1995 } 1996 1997 require IP::Authority; 1998 1999 my $reg = new IP::Authority; 2000 2001 return ($reg->inet_atoauth($ip)); 2002} 2003 20041; 2005 2006__END__ 2007=encoding utf8 2008=head1 NAME 2009 2010Net::IP - Perl extension for manipulating IPv4/IPv6 addresses 2011 2012=head1 SYNOPSIS 2013 2014 use Net::IP; 2015 2016 my $ip = new Net::IP ('193.0.1/24') or die (Net::IP::Error()); 2017 print ("IP : ".$ip->ip()."\n"); 2018 print ("Sho : ".$ip->short()."\n"); 2019 print ("Bin : ".$ip->binip()."\n"); 2020 print ("Int : ".$ip->intip()."\n"); 2021 print ("Mask: ".$ip->mask()."\n"); 2022 print ("Last: ".$ip->last_ip()."\n"); 2023 print ("Len : ".$ip->prefixlen()."\n"); 2024 print ("Size: ".$ip->size()."\n"); 2025 print ("Type: ".$ip->iptype()."\n"); 2026 print ("Rev: ".$ip->reverse_ip()."\n"); 2027 2028=head1 DESCRIPTION 2029 2030This module provides functions to deal with B<IPv4/IPv6> addresses. The module 2031can be used as a class, allowing the user to instantiate IP objects, which can 2032be single IP addresses, prefixes, or ranges of addresses. There is also a 2033procedural way of accessing most of the functions. Most subroutines can take 2034either B<IPv4> or B<IPv6> addresses transparently. 2035 2036=head1 OBJECT-ORIENTED INTERFACE 2037 2038=head2 Object Creation 2039 2040A Net::IP object can be created from a single IP address: 2041 2042 $ip = new Net::IP ('193.0.1.46') || die ... 2043 2044Or from a Classless Prefix (a /24 prefix is equivalent to a C class): 2045 2046 $ip = new Net::IP ('195.114.80/24') || die ... 2047 2048Or from a range of addresses: 2049 2050 $ip = new Net::IP ('20.34.101.207 - 201.3.9.99') || die ... 2051 2052Or from a address plus a number: 2053 2054 $ip = new Net::IP ('20.34.10.0 + 255') || die ... 2055 2056The new() function accepts IPv4 and IPv6 addresses: 2057 2058 $ip = new Net::IP ('dead:beef::/32') || die ... 2059 2060Optionnaly, the function can be passed the version of the IP. Otherwise, it 2061tries to guess what the version is (see B<_is_ipv4()> and B<_is_ipv6()>). 2062 2063 $ip = new Net::IP ('195/8',4); # Class A 2064 2065=head1 OBJECT METHODS 2066 2067Most of these methods are front-ends for the real functions, which use a 2068procedural interface. Most functions return undef on failure, and a true 2069value on success. A detailed description of the procedural interface is 2070provided below. 2071 2072=head2 set 2073 2074Set an IP address in an existing IP object. This method has the same 2075functionality as the new() method, except that it reuses an existing object to 2076store the new IP. 2077 2078C<$ip-E<gt>set('130.23.1/24',4);> 2079 2080Like new(), set() takes two arguments - a string used to build an IP address, 2081prefix, or range, and optionally, the IP version of the considered address. 2082 2083It returns an IP object on success, and undef on failure. 2084 2085=head2 error 2086 2087Return the current object error string. The error string is set whenever one 2088of the methods produces an error. Also, a global, class-wide B<Error()> 2089function is avaliable. 2090 2091C<warn ($ip-E<gt>error());> 2092 2093=head2 errno 2094 2095Return the current object error number. The error number is set whenever one 2096of the methods produces an error. Also, a global B<$ERRNO> variable is set 2097when an error is produced. 2098 2099C<warn ($ip-E<gt>errno());> 2100 2101=head2 ip 2102 2103Return the IP address (or first IP of the prefix or range) in quad format, as 2104a string. 2105 2106C<print ($ip-E<gt>ip());> 2107 2108=head2 binip 2109 2110Return the IP address as a binary string of 0s and 1s. 2111 2112C<print ($ip-E<gt>binip());> 2113 2114=head2 prefixlen 2115 2116Return the length in bits of the current prefix. 2117 2118C<print ($ip-E<gt>prefixlen());> 2119 2120=head2 version 2121 2122Return the version of the current IP object (4 or 6). 2123 2124C<print ($ip-E<gt>version());> 2125 2126=head2 size 2127 2128Return the number of IP addresses in the current prefix or range. 2129Use of this function requires Math::BigInt. 2130 2131C<print ($ip-E<gt>size());> 2132 2133=head2 binmask 2134 2135Return the binary mask of the current prefix, if applicable. 2136 2137C<print ($ip-E<gt>binmask());> 2138 2139=head2 mask 2140 2141Return the mask in quad format of the current prefix. 2142 2143C<print ($ip-E<gt>mask());> 2144 2145=head2 prefix 2146 2147Return the full prefix (ip+prefix length) in quad (standard) format. 2148 2149C<print ($ip-E<gt>prefix());> 2150 2151=head2 print 2152 2153Print the IP object (IP/Prefix or First - Last) 2154 2155C<print ($ip-E<gt>print());> 2156 2157=head2 intip 2158 2159Convert the IP in integer format and return it as a Math::BigInt object. 2160 2161C<print ($ip-E<gt>intip());> 2162 2163=head2 hexip 2164 2165Return the IP in hex format 2166 2167C<print ($ip-E<gt>hexip());> 2168 2169=head2 hexmask 2170 2171Return the mask in hex format 2172 2173C<print ($ip-E<gt>hexmask());> 2174 2175=head2 short 2176 2177Return the IP in short format: 2178 IPv4 addresses: 194.5/16 2179 IPv6 addresses: ab32:f000:: 2180 2181 2182C<print ($ip-E<gt>short());> 2183 2184=head2 iptype 2185 2186Return the IP Type - this describes the type of an IP (Public, Private, 2187Reserved, etc.) See procedural interface ip_iptype for more details. 2188 2189C<print ($ip-E<gt>iptype());> 2190 2191=head2 reverse_ip 2192 2193Return the reverse IP for a given IP address (in.addr. format). 2194 2195C<print ($ip-E<gt>reserve_ip());> 2196 2197=head2 last_ip 2198 2199Return the last IP of a prefix/range in quad format. 2200 2201C<print ($ip-E<gt>last_ip());> 2202 2203=head2 last_bin 2204 2205Return the last IP of a prefix/range in binary format. 2206 2207C<print ($ip-E<gt>last_bin());> 2208 2209=head2 last_int 2210 2211Return the last IP of a prefix/range in integer format. 2212 2213C<print ($ip-E<gt>last_int());> 2214 2215=head2 find_prefixes 2216 2217This function finds all the prefixes that can be found between the two 2218addresses of a range. The function returns a list of prefixes. 2219 2220C<@list = $ip-E<gt>find_prefixes($other_ip));> 2221 2222=head2 bincomp 2223 2224Binary comparaison of two IP objects. The function takes an operation 2225and an IP object as arguments. It returns a boolean value. 2226 2227The operation can be one of: 2228lt: less than (smaller than) 2229le: smaller or equal to 2230gt: greater than 2231ge: greater or equal to 2232 2233C<if ($ip-E<gt>bincomp('lt',$ip2) {...}> 2234 2235=head2 binadd 2236 2237Binary addition of two IP objects. The value returned is an IP object. 2238 2239C<my $sum = $ip-E<gt>binadd($ip2);> 2240 2241=head2 aggregate 2242 2243Aggregate 2 IPs - Append one range/prefix of IPs to another. The last address 2244of the first range must be the one immediately preceding the first address of 2245the second range. A new IP object is returned. 2246 2247C<my $total = $ip-E<gt>aggregate($ip2);> 2248 2249=head2 overlaps 2250 2251Check if two IP ranges/prefixes overlap each other. The value returned by the 2252function should be one of: 2253 $IP_PARTIAL_OVERLAP (ranges overlap) 2254 $IP_NO_OVERLAP (no overlap) 2255 $IP_A_IN_B_OVERLAP (range2 contains range1) 2256 $IP_B_IN_A_OVERLAP (range1 contains range2) 2257 $IP_IDENTICAL (ranges are identical) 2258 undef (problem) 2259 2260C<if ($ip-E<gt>overlaps($ip2)==$IP_A_IN_B_OVERLAP) {...};> 2261 2262 2263=head2 looping 2264 2265The C<+> operator is overloaded in order to allow looping though a whole 2266range of IP addresses: 2267 2268 my $ip = new Net::IP ('195.45.6.7 - 195.45.6.19') || die; 2269 # Loop 2270 do { 2271 print $ip->ip(), "\n"; 2272 } while (++$ip); 2273 2274 2275 2276The ++ operator returns undef when the last address of the range is reached. 2277 2278 2279=head2 auth 2280 2281Return IP authority information from the IP::Authority module 2282 2283C<$auth = ip->auth ();> 2284 2285Note: IPv4 only 2286 2287 2288=head1 PROCEDURAL INTERFACE 2289 2290These functions do the real work in the module. Like the OO methods, 2291most of these return undef on failure. In order to access error codes 2292and strings, instead of using $ip-E<gt>error() and $ip-E<gt>errno(), use the 2293global functions C<Error()> and C<Errno()>. 2294 2295The functions of the procedural interface are not exported by default. In 2296order to import these functions, you need to modify the use statement for 2297the module: 2298 2299C<use Net::IP qw(:PROC);> 2300 2301=head2 Error 2302 2303Returns the error string corresponding to the last error generated in the 2304module. This is also useful for the OO interface, as if the new() function 2305fails, we cannot call $ip-E<gt>error() and so we have to use Error(). 2306 2307warn Error(); 2308 2309=head2 Errno 2310 2311Returns a numeric error code corresponding to the error string returned by 2312Error. 2313 2314=head2 ip_iptobin 2315 2316Transform an IP address into a bit string. 2317 2318 Params : IP address, IP version 2319 Returns : binary IP string on success, undef otherwise 2320 2321C<$binip = ip_iptobin ($ip,6);> 2322 2323=head2 ip_bintoip 2324 2325Transform a bit string into an IP address 2326 2327 Params : binary IP, IP version 2328 Returns : IP address on success, undef otherwise 2329 2330C<$ip = ip_bintoip ($binip,6);> 2331 2332=head2 ip_bintoint 2333 2334Transform a bit string into a BigInt. 2335 2336 Params : binary IP 2337 Returns : BigInt 2338 2339C<$bigint = new Math::BigInt (ip_bintoint($binip));> 2340 2341=head2 ip_inttobin 2342 2343Transform a BigInt into a bit string. 2344I<Warning>: sets warnings (C<-w>) off. This is necessary because Math::BigInt 2345is not compliant. 2346 2347 Params : BigInt, IP version 2348 Returns : binary IP 2349 2350C<$binip = ip_inttobin ($bigint);> 2351 2352=head2 ip_get_version 2353 2354Try to guess the IP version of an IP address. 2355 2356 Params : IP address 2357 Returns : 4, 6, undef(unable to determine) 2358 2359C<$version = ip_get_version ($ip)> 2360 2361=head2 ip_is_ipv4 2362 2363Check if an IP address is of type 4. 2364 2365 Params : IP address 2366 Returns : 1 (yes) or 0 (no) 2367 2368C<ip_is_ipv4($ip) and print "$ip is IPv4";> 2369 2370=head2 ip_is_ipv6 2371 2372Check if an IP address is of type 6. 2373 2374 Params : IP address 2375 Returns : 1 (yes) or 0 (no) 2376 2377C<ip_is_ipv6($ip) and print "$ip is IPv6";> 2378 2379=head2 ip_expand_address 2380 2381Expand an IP address from compact notation. 2382 2383 Params : IP address, IP version 2384 Returns : expanded IP address or undef on failure 2385 2386C<$ip = ip_expand_address ($ip,4);> 2387 2388=head2 ip_get_mask 2389 2390Get IP mask from prefix length. 2391 2392 Params : Prefix length, IP version 2393 Returns : Binary Mask 2394 2395C<$mask = ip_get_mask ($len,6);> 2396 2397=head2 ip_last_address_bin 2398 2399Return the last binary address of a prefix. 2400 2401 Params : First binary IP, prefix length, IP version 2402 Returns : Binary IP 2403 2404C<$lastbin = ip_last_address_bin ($ip,$len,6);> 2405 2406=head2 ip_splitprefix 2407 2408Split a prefix into IP and prefix length. 2409If it was passed a simple IP, it just returns it. 2410 2411 Params : Prefix 2412 Returns : IP, optionnaly length of prefix 2413 2414C<($ip,$len) = ip_splitprefix ($prefix)> 2415 2416=head2 ip_prefix_to_range 2417 2418Get a range of IPs from a prefix. 2419 2420 Params : Prefix, IP version 2421 Returns : First IP, last IP 2422 2423C<($ip1,$ip2) = ip_prefix_to_range ($prefix,6);> 2424 2425=head2 ip_bincomp 2426 2427Compare binary Ips with <, >, <=, >=. 2428 Operators are lt(<), le(<=), gt(>), and ge(>=) 2429 2430 Params : First binary IP, operator, Last binary IP 2431 Returns : 1 (yes), 0 (no), or undef (problem) 2432 2433C<ip_bincomp ($ip1,'lt',$ip2) == 1 or do {}> 2434 2435=head2 ip_binadd 2436 2437Add two binary IPs. 2438 2439 Params : First binary IP, Last binary IP 2440 Returns : Binary sum or undef (problem) 2441 2442C<$binip = ip_binadd ($bin1,$bin2);> 2443 2444=head2 ip_get_prefix_length 2445 2446Get the prefix length for a given range of 2 IPs. 2447 2448 Params : First binary IP, Last binary IP 2449 Returns : Length of prefix or undef (problem) 2450 2451C<$len = ip_get_prefix_length ($ip1,$ip2);> 2452 2453=head2 ip_range_to_prefix 2454 2455Return all prefixes between two IPs. 2456 2457 Params : First IP (binary format), Last IP (binary format), IP version 2458 Returns : List of Prefixes or undef (problem) 2459 2460The prefixes returned have the form q.q.q.q/nn. 2461 2462C<@prefix = ip_range_to_prefix ($ip1,$ip2,6);> 2463 2464 2465=head2 ip_compress_v4_prefix 2466 2467Compress an IPv4 Prefix. 2468 2469 Params : IP, Prefix length 2470 Returns : Compressed Prefix 2471 2472C<$ip = ip_compress_v4_prefix ($ip, $len);> 2473 2474 2475=head2 ip_compress_address 2476 2477Compress an IPv6 address. Just returns the IP if it is an IPv4. 2478 2479 Params : IP, IP version 2480 Returns : Compressed IP or undef (problem) 2481 2482C<$ip = ip_compress_adress ($ip, $version);> 2483 2484=head2 ip_is_overlap 2485 2486Check if two ranges of IPs overlap. 2487 2488 Params : Four binary IPs (begin of range 1,end1,begin2,end2), IP version 2489 $IP_PARTIAL_OVERLAP (ranges overlap) 2490 $IP_NO_OVERLAP (no overlap) 2491 $IP_A_IN_B_OVERLAP (range2 contains range1) 2492 $IP_B_IN_A_OVERLAP (range1 contains range2) 2493 $IP_IDENTICAL (ranges are identical) 2494 undef (problem) 2495 2496C<(ip_is_overlap($rb1,$re1,$rb2,$re2,4) eq $IP_A_IN_B_OVERLAP) and do {};> 2497 2498=head2 ip_get_embedded_ipv4 2499 2500Get an IPv4 embedded in an IPv6 address 2501 2502 Params : IPv6 2503 Returns : IPv4 string or undef (not found) 2504 2505C<$ip4 = ip_get_embedded($ip6);> 2506 2507=head2 ip_check_mask 2508 2509Check the validity of a binary IP mask 2510 2511 Params : Mask 2512 Returns : 1 or undef (invalid) 2513 2514C<ip_check_mask($binmask) or do {};> 2515 2516Checks if mask has only 1s followed by 0s. 2517 2518=head2 ip_aggregate 2519 2520Aggregate 2 ranges of binary IPs 2521 2522 Params : 1st range (1st IP, Last IP), last range (1st IP, last IP), IP version 2523 Returns : prefix or undef (invalid) 2524 2525C<$prefix = ip_aggregate ($bip1,$eip1,$bip2,$eip2) || die ...> 2526 2527=head2 ip_iptypev4 2528 2529Return the type of an IPv4 address. 2530 2531 Params: binary IP 2532 Returns: type as of the following table or undef (invalid ip) 2533 2534See RFC 5735 and RFC 6598 2535 2536S<Address Block Present Use Reference> 2537S<-------------------------------------------------------------------> 2538S<0.0.0.0/8 "This" Network RFC 1122 PRIVATE> 2539S<10.0.0.0/8 Private-Use Networks RFC 1918 PRIVATE> 2540S<100.64.0.0/10 CGN Shared Address Space RFC 6598 SHARED> 2541S<127.0.0.0/8 Loopback RFC 1122 LOOPBACK> 2542S<169.254.0.0/16 Link Local RFC 3927 LINK-LOCAL> 2543S<172.16.0.0/12 Private-Use Networks RFC 1918 PRIVATE> 2544S<192.0.0.0/24 IETF Protocol Assignments RFC 5736 RESERVED> 2545S<192.0.2.0/24 TEST-NET-1 RFC 5737 TEST-NET> 2546S<192.88.99.0/24 6to4 Relay Anycast RFC 3068 6TO4-RELAY> 2547S<192.168.0.0/16 Private-Use Networks RFC 1918 PRIVATE> 2548S<198.18.0.0/15 Network Interconnect> 2549S< Device Benchmark Testing RFC 2544 RESERVED> 2550S<198.51.100.0/24 TEST-NET-2 RFC 5737 TEST-NET> 2551S<203.0.113.0/24 TEST-NET-3 RFC 5737 TEST-NET> 2552S<224.0.0.0/4 Multicast RFC 3171 MULTICAST> 2553S<240.0.0.0/4 Reserved for Future Use RFC 1112 RESERVED> 2554S<255.255.255.255/32 Limited Broadcast RFC 919 BROADCAST> 2555S< RFC 922> 2556 2557=head2 ip_iptypev6 2558 2559Return the type of an IPv6 address. 2560 2561 Params: binary ip 2562 Returns: type as of the following table or undef (invalid) 2563 2564See L<IANA Internet Protocol Version 6 Address Space|http://www.iana.org/assignments/ipv6-address-space/ipv6-address-space.txt> and L<IANA IPv6 Special Purpose Address Registry|http://www.iana.org/assignments/iana-ipv6-special-registry/iana-ipv6-special-registry.txt> 2565 2566 2567S<Prefix Allocation Reference> 2568S<-------------------------------------------------------------> 2569S<0000::/8 Reserved by IETF [RFC4291] RESERVED> 2570S<0100::/8 Reserved by IETF [RFC4291] RESERVED> 2571S<0200::/7 Reserved by IETF [RFC4048] RESERVED> 2572S<0400::/6 Reserved by IETF [RFC4291] RESERVED> 2573S<0800::/5 Reserved by IETF [RFC4291] RESERVED> 2574S<1000::/4 Reserved by IETF [RFC4291] RESERVED> 2575S<2000::/3 Global Unicast [RFC4291] GLOBAL-UNICAST> 2576S<4000::/3 Reserved by IETF [RFC4291] RESERVED> 2577S<6000::/3 Reserved by IETF [RFC4291] RESERVED> 2578S<8000::/3 Reserved by IETF [RFC4291] RESERVED> 2579S<A000::/3 Reserved by IETF [RFC4291] RESERVED> 2580S<C000::/3 Reserved by IETF [RFC4291] RESERVED> 2581S<E000::/4 Reserved by IETF [RFC4291] RESERVED> 2582S<F000::/5 Reserved by IETF [RFC4291] RESERVED> 2583S<F800::/6 Reserved by IETF [RFC4291] RESERVED> 2584S<FC00::/7 Unique Local Unicast [RFC4193] UNIQUE-LOCAL-UNICAST> 2585S<FE00::/9 Reserved by IETF [RFC4291] RESERVED> 2586S<FE80::/10 Link Local Unicast [RFC4291] LINK-LOCAL-UNICAST> 2587S<FEC0::/10 Reserved by IETF [RFC3879] RESERVED> 2588S<FF00::/8 Multicast [RFC4291] MULTICAST> 2589 2590 2591S<Prefix Assignment Reference> 2592S<---------------------------------------------------------------------> 2593S<::1/128 Loopback Address [RFC4291] UNSPECIFIED> 2594S<::/128 Unspecified Address [RFC4291] LOOPBACK> 2595S<::FFFF:0:0/96 IPv4-mapped Address [RFC4291] IPV4MAP> 2596S<0100::/64 Discard-Only Prefix [RFC6666] DISCARD> 2597S<2001:0000::/32 TEREDO [RFC4380] TEREDO> 2598S<2001:0002::/48 BMWG [RFC5180] BMWG> 2599S<2001:db8::/32 Documentation Prefix [RFC3849] DOCUMENTATION> 2600S<2001:10::/28 ORCHID [RFC4843] ORCHID> 2601S<2002::/16 6to4 [RFC3056] 6TO4> 2602S<FC00::/7 Unique-Local [RFC4193] UNIQUE-LOCAL-UNICAST> 2603S<FE80::/10 Linked-Scoped Unicast [RFC4291] LINK-LOCAL-UNICAST> 2604S<FF00::/8 Multicast [RFC4291] MULTICAST> 2605 2606 2607=head2 ip_iptype 2608 2609Return the type of an IP (Public, Private, Reserved) 2610 2611 Params : Binary IP to test, IP version (defaults to 6) 2612 Returns : type (see ip_iptypev4 and ip_iptypev6 for details) or undef (invalid) 2613 2614C<$type = ip_iptype ($ip);> 2615 2616=head2 ip_check_prefix 2617 2618Check the validity of a prefix 2619 2620 Params : binary IP, length of prefix, IP version 2621 Returns : 1 or undef (invalid) 2622 2623Checks if the variant part of a prefix only has 0s, and the length is correct. 2624 2625C<ip_check_prefix ($ip,$len,$ipv) or do {};> 2626 2627=head2 ip_reverse 2628 2629Get a reverse name from a prefix 2630 2631 Params : IP, length of prefix, IP version 2632 Returns : Reverse name or undef (error) 2633 2634C<$reverse = ip_reverse ($ip);> 2635 2636=head2 ip_normalize 2637 2638Normalize data to a range/prefix of IP addresses 2639 2640 Params : Data String (Single IP, Range, Prefix) 2641 Returns : ip1, ip2 (if range/prefix) or undef (error) 2642 2643C<($ip1,$ip2) = ip_normalize ($data);> 2644 2645=head2 ip_auth 2646 2647Return IP authority information from the IP::Authority module 2648 2649 Params : IP, version 2650 Returns : Auth info (RI for RIPE, AR for ARIN, etc) 2651 2652C<$auth = ip_auth ($ip,4);> 2653 2654Note: IPv4 only 2655 2656 2657=head1 BUGS 2658 2659The Math::BigInt library is needed for functions that use integers. These are 2660ip_inttobin, ip_bintoint, and the size method. In a next version, 2661Math::BigInt will become optionnal. 2662 2663=head1 AUTHORS 2664 2665Manuel Valente <manuel.valente@gmail.com>. 2666 2667Original IPv4 code by Monica Cortes Sack <mcortes@ripe.net>. 2668 2669Original IPv6 code by Lee Wilmot <lee@ripe.net>. 2670 2671=head1 BASED ON 2672 2673ipv4pack.pm, iplib.pm, iplibncc.pm. 2674 2675=head1 SEE ALSO 2676 2677perl(1), IP::Authority 2678 2679=cut 2680