package Net::CDP;## $Id: CDP.pm,v 1.20 2005/08/16 11:52:30 mchapman Exp $#use 5.00503;use strict;use Carp::Clan qw(^Net::CDP);use vars qw($VERSION $XS_VERSION @ISA $AUTOLOAD @EXPORT @EXPORT_OK %EXPORT_TAGS @EXPORT_FAIL);$VERSION = (qw$Revision: 1.20 $)[1];$XS_VERSION = '0.09'; # XXX Keep this in sync with libcdprequire Exporter;require DynaLoader;@ISA = qw(Exporter DynaLoader);my @EXPORT_GENERAL = qw(	CDP_PROMISCUOUS);my @EXPORT_RECV = qw(	CDP_RECV_NONBLOCK CDP_RECV_DECODE_ERRORS);my @EXPORT_CAPS = qw(	CDP_CAP_ROUTER CDP_CAP_TRANSPARENT_BRIDGE CDP_CAP_SOURCE_BRIDGE	CDP_CAP_SWITCH CDP_CAP_HOST CDP_CAP_IGMP CDP_CAP_REPEATER);my @EXPORT_PROTOS = qw(	CDP_ADDR_PROTO_CLNP CDP_ADDR_PROTO_IPV4 CDP_ADDR_PROTO_IPV6	CDP_ADDR_PROTO_DECNET CDP_ADDR_PROTO_APPLETALK CDP_ADDR_PROTO_IPX	CDP_ADDR_PROTO_VINES CDP_ADDR_PROTO_XNS CDP_ADDR_PROTO_APOLLO);@EXPORT = qw();@EXPORT_OK = (@EXPORT_CAPS, @EXPORT_PROTOS, @EXPORT_GENERAL, @EXPORT_RECV, );%EXPORT_TAGS = (	general => [ @EXPORT_GENERAL, ],	recv => [ @EXPORT_RECV, ],	caps => [ @EXPORT_CAPS, ],	protos => [ @EXPORT_PROTOS, ],);@EXPORT_FAIL = (@EXPORT_OK, );sub AUTOLOAD {	my $constname;	($constname = $AUTOLOAD) =~ s/.*:://;	croak '&Net::CDP::constant not defined' if $constname eq 'constant';	my ($error, $val) = Net::CDP::Constants::constant($constname);	croak $error if $error;		no strict 'refs';	*$AUTOLOAD = sub { $val };	goto &$AUTOLOAD;}# If you REALLY need the warnings suppressed, set this to 0use vars qw($warn_deprecated);$warn_deprecated = 1;{	my $warned;	sub _deprecated() {		return unless $warn_deprecated;		return if $warned;		$warned = 1;		warn <<EOF;************************************************************* You're using a deprecated interface! Check out the ****** Net::CDP documentation for more info.              *************************************************************EOF	}}sub export_fail(@) {	my $self = shift;	_deprecated;	();}bootstrap Net::CDP $XS_VERSION;# Load in the Perl part of the Net::CDP::Address# and Net::CDP::IPPrefix namespacesrequire Net::CDP::Address;require Net::CDP::IPPrefix;sub _parse_args($@) {	croak 'Invalid arguments' if @{$_[0]} % 2;	my %args = @{+shift};	my %check = map { $_ => 1 } keys %args;	foreach (@_) {		delete $check{$_} if exists $check{$_};	}	croak "Unknown argument '$_'" foreach keys %check;	%args;}sub _v4_pack {	my $ip = shift;		if ($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ &&		$1 >= 0 && $1 <= 255 &&		$2 >= 0 && $2 <= 255 &&		$3 >= 0 && $3 <= 255 &&		$4 >= 0 && $4 <= 255	) {		pack 'C4', $1, $2, $3, $4;	} elsif ($ip =~ /^(\d+)\.(\d+)\.(\d+)$/ &&		$1 >= 0 && $1 <= 255 &&		$2 >= 0 && $2 <= 255 &&		$3 >= 0 && $3 <= 255	) {		pack 'C4', $1, $2, 0, $3;	} elsif ($ip =~ /^(\d+)\.(\d+)$/ &&		$1 >= 0 && $1 <= 255 &&		$2 >= 0 && $2 <= 255	) {		pack 'C4', $1, 0, 0, $4;	} else {		undef;	}}sub _v4_unpack {	join '.', unpack 'C4', shift;}use constant POWERS => "\x00\x80\xc0\xe0\xf0\xf8\xfc\xfe\xff";sub _mask_pack {	my $mask = shift;	if ($mask =~ /^255\.255\.255\.(\d+)$/) {		my $index = index POWERS, chr $1;		$index >= 0 ? 24 + $index : undef;	} elsif ($mask =~ /^255\.255\.(\d+)\.0$/) {		my $index = index POWERS, chr $1;		$index >= 0 ? 16 + $index : undef;	} elsif ($mask =~ /^255\.(\d+)\.0\.0$/) {		my $index = index POWERS, chr $1;		$index >= 0 ? 8 + $index : undef;	} elsif ($mask =~ /^(\d+)\.0\.0\.0$/) {		my $index = index POWERS, chr $1;		$index >= 0 ? $index : undef;	} else {		undef;	}}sub _mask_unpack {	_v4_unpack(pack 'B32', 1 x shift);}sub _v6_pack {	my $ip = shift;	if ($ip =~ /^([\da-f\:]+)(?::(\d+)\.(\d+)\.(\d+)\.(\d+))?$/i) {		my $ipv6 = $1;		if (			defined $2 &&			$2 >= 0 && $2 <= 255 &&			$3 >= 0 && $3 <= 255 &&			$4 >= 0 && $4 <= 255 &&			$5 >= 0 && $5 <= 255		) {			$ipv6 .= sprintf ':%x:%x',				($2 << 8) | $3,				($4 << 8) | $5;		}		unless ($ipv6 =~ /:::/ || $ipv6 =~ /::.*::/) {			$ipv6 =~ s/::/':0' x (9 - ($ipv6 =~ tr,:,:,))/e;			if (($ipv6 =~ tr/:/:/) == 7) {				$ipv6 =~ s/^:/0:/;				$ipv6 =~ s/:$/:0/;				return pack 'n8', map hex, split /:/, $ipv6;			}		}	}	undef;}sub _v6_unpack {	my $result = sprintf '%x:%x:%x:%x:%x:%x:%x:%x', unpack 'n8', shift;	$result =~ s/:0(:0)+:/::/;	$result =~ s/^0:/:/;	$result;}sub _rethrow(&) {	my $sub = shift;	if (wantarray) {		my @result = eval { &$sub };		if ($@) {			$@ =~ s/ at \S+ line \d+\.\n\z//;			croak $@;		}		@result;	} else {		my $result = eval { &$sub };		if ($@) {			$@ =~ s/ at \S+ line \d+\.\n\z//;			croak $@;		}		$result;	}}=head1 NAMENet::CDP - Cisco Discovery Protocol (CDP) advertiser/listener=head1 SYNOPSIS  use Net::CDP;  # Available network ports  @ports = Net::CDP::ports;    # Creating a CDP advertiser/listener  $cdp = new Net::CDP;  # Receiving a CDP packet  $packet = $cdp->recv;    # Sending a CDP packet  $cdp->send($packet);    # Other Net::CDP methods  $port = $cdp->port;  @addresses = $cdp->addresses;=head1 DESCRIPTIONThe Net::CDP module implements an advertiser/listener for the CiscoDiscovery Protocol.CDP is a proprietary Cisco protocol for discovering devices on a network. Atypical CDP implementation sends periodic CDP packets on every networkport. It might also listen for packets for advertisements sent by neighboringdevices.A Net::CDP object represents an advertiser/listener for a single networkport. It can send and receive individual CDP packets, each represented by aL<Net::CDP::Packet> object.To manage multiple ports simultaneously, you might like to take a look atL<Net::CDP::Manager>.If you are upgrading code from an older version of Net::CDP, please read theL</"UPGRADING FROM PREVIOUS VERSIONS"> section below.=head1 CONSTRUCTORS=over=item B<new>    $cdp = new Net::CDP($port)    $cdp = new Net::CDP(             [ port        => $port,        ]             [ promiscuous => $promiscuous, ] # default = 0             [ enable_recv => $enable_recv, ] # default = 1             [ enable_send => $enable_send, ] # default = 1           );Returns a new Net::CDP object.If specified, C<$port> must be the name of the network port that should be usedto send and receive packets. If no port is specified, the first port on yoursystem is used (typically, this is the first Ethernet device -- "eth0", forinstance).You can use the L</"ports"> class method to retrieve a list of valid port names.If C<$promiscuous> is non-zero, then promiscuous mode is enabled on thespecified port. Otherwise, Net::CDP attempts to use a multicast ethernetaddress instead. Multicast addresses may not work with all network drivers.By default, C<$enable_recv> and C<$enable_send> are both 1. If either of theseare set to 0 the corresponding function is disabled. This saves a small amountof memory and a file descriptor, and might be useful when you do not intend toboth send and receive packets. You probably won't want to set I<both> to 0.This constructor used to take a single argument, C<$flags>. This is nowdeprecated. See L</"UPGRADING FROM PREVIOUS VERSIONS"> below.=back=cutsub new($;@) {	my $class = shift;	my $port;	my $flags = 0;		if (@_ == 2 && $_[1] =~ /^\d+$/) {		_deprecated;		$flags = pop;	}		$port = shift if @_ == 1;	my %args = _parse_args \@_, qw(port promiscuous enable_recv enable_send);		$port = $args{port} if exists $args{port};	$flags |= CDP_PROMISCUOUS() if $args{promiscuous};	$flags |= CDP_DISABLE_RECV()		if exists $args{enable_recv} && !$args{enable_recv};	$flags |= CDP_DISABLE_SEND()		if exists $args{enable_send} && !$args{enable_send};	carp "enable_recv => 0 and enable_send => 0 both specified"		if $flags & CDP_DISABLE_RECV() and $flags & CDP_DISABLE_SEND();		_rethrow { $class->_new($port, $flags) };}=head1 CLASS METHODS=over =item B<ports>    @ports = Net::CDP::ports()Returns a list of network ports that can be used by this module.=back=cutsub ports() { _rethrow { _ports(); } }=head1 OBJECT METHODS=over=item B<port>    $port = $cdp->port()Returns the network port associated with this Net::CDP object.=item B<addresses>    @addresses = $cdp->addresses()Returns the addresses of the network port associated with thisNet::CDP object. In scalar context the number of addresses is returned.I<NOTE:> Currently only a single IPv4 address is returned, even if the porthas more than one bound address.=item B<recv>    $packet = $cdp->recv(                 [ nonblock      => $nonblock,      ] # default = 0                 [ decode_errors => $decode_errors, ] # default = 0              )Returns the next available CDP packet as a L<Net::CDP::Packet> object. If theC<$nonblock> flag is set, an undefined value returned if no packets areimmediately available. Otherwise, this method blocks until a packet is receivedor an error occurs. If an error occurs, this method croaks.By default, decoding errors will be silently ignored. If C<$decode_errors> isset, this method will croak on a decoding error.This method used to take a single argument, C<$flags>. This is nowdeprecated. See L</"UPGRADING FROM PREVIOUS VERSIONS"> below.=cutsub recv($;@) {	my $self = shift;	my $flags = 0;		if (@_ == 1 && $_[0] =~ /^\d+$/) {		_deprecated;		$flags = pop;	}		my %args = _parse_args \@_, qw(nonblock decode_errors);		$flags |= CDP_RECV_NONBLOCK() if $args{nonblock};	$flags |= CDP_RECV_DECODE_ERRORS() if  $args{decode_errors};		_rethrow { $self->_recv($flags) };}=item B<send>    $bytes = $cdp->send($packet)Transmits the specified packet, which must be a L<Net::CDP::Packet> object,and returns the number of bytes sent. If an error occurs, this method croaks.=back=cutsub send($;@) {	my $self = shift;	my $packet;		$packet = shift if @_ == 1;	my %args = _parse_args \@_, qw(packet);		$packet = $args{packet} if exists $args{packet};		croak 'No packet supplied' unless defined $packet;		_rethrow { $self->_send($packet) };}=head1 UPGRADING FROM PREVIOUS VERSIONSNet::CDP version 0.07 introduces the use of named arguments instead of flagbitmaps for the L</"new"> constructor and L</"recv"> method. Furthermore, theC<:caps> and C<:protos> import tags now live in L<Net::CDP::Packet> andL<Net::CDP::Address> respectively.A warning is generated the first time you attempt to use a deprecated feature.Actual support for the old-style flag bitmaps will be removed soon. To upgradeyour code you will need to:=over=item *Do not import the C<:general> or C<:recv> tags; use named argumentsin calls to L</"new"> and L</"recv"> instead.=item *Replace C<use Net::CDP qw(:caps)> with C<use Net::CDP::Packet qw(:caps)>, andC<use Net::CDP qw(:protos)> with C<use Net::CDP::Address qw(:protos)>.=back=head1 SEE ALSOL<Net::CDP::Packet>=head1 AUTHORMichael Chapman, E<lt>cpan@very.puzzling.orgE<gt>=head1 COPYRIGHT AND LICENSECopyright (C) 2005 by Michael Chapmanlibcdp is released under the terms and conditions of the GNU Library GeneralPublic License version 2. Net::CDP may be redistributed and/or modified underthe same terms as Perl itself.=cut1;