r26502 - in /branches/upstream/libnet-rawip-perl/current: ./ lib/Net/ lib/Net/RawIP/ t/
ghostbar-guest at users.alioth.debian.org
ghostbar-guest at users.alioth.debian.org
Sun Nov 2 05:27:03 UTC 2008
Author: ghostbar-guest
Date: Sun Nov 2 05:26:53 2008
New Revision: 26502
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26502
Log:
[svn-upgrade] Integrating new upstream version, libnet-rawip-perl (0.25)
Added:
branches/upstream/libnet-rawip-perl/current/t/00-load.t
branches/upstream/libnet-rawip-perl/current/t/01-api.t
branches/upstream/libnet-rawip-perl/current/t/90-pod.t
branches/upstream/libnet-rawip-perl/current/t/91-pod-coverage.t
branches/upstream/libnet-rawip-perl/current/t/99-critic.t
Removed:
branches/upstream/libnet-rawip-perl/current/t/critic.t
branches/upstream/libnet-rawip-perl/current/t/pod-coverage.t
branches/upstream/libnet-rawip-perl/current/t/pod.t
Modified:
branches/upstream/libnet-rawip-perl/current/Changes
branches/upstream/libnet-rawip-perl/current/MANIFEST
branches/upstream/libnet-rawip-perl/current/MANIFEST.SKIP
branches/upstream/libnet-rawip-perl/current/META.yml
branches/upstream/libnet-rawip-perl/current/Makefile.PL
branches/upstream/libnet-rawip-perl/current/RawIP.xs
branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP.pm
branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/ethhdr.pm
branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/generichdr.pm
branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/icmphdr.pm
branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/iphdr.pm
branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/opt.pm
branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/tcphdr.pm
branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/udphdr.pm
branches/upstream/libnet-rawip-perl/current/t/iflist.t
branches/upstream/libnet-rawip-perl/current/t/memory_leak.t
branches/upstream/libnet-rawip-perl/current/t/set_icmp.t
branches/upstream/libnet-rawip-perl/current/t/simple.t
Modified: branches/upstream/libnet-rawip-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/Changes?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/Changes (original)
+++ branches/upstream/libnet-rawip-perl/current/Changes Sun Nov 2 05:26:53 2008
@@ -1,4 +1,18 @@
Revision history for Perl extension Net::RawIP.
+
+2008.10.22 - 0.25 - Sebastien Aperghis-Tramoni (SAPER)
+ - [TESTS] CPAN-RT#39252: Proc::ProcessTable does not support the size
+ attribute on all systems. Thanks to Havard Eidnes for the patch.
+ - [DOC] Improved the documentation a bit.
+
+2008.10.21 - 0.24 - Sebastien Aperghis-Tramoni (SAPER)
+ - [BUGFIX] Fixed a segfault and a warning, thanks to Mike Lowell.
+ - [DIST] Simplified the detection logic to make it work on more systems.
+ - [DIST] Declared all prerequisite modules.
+ - [TESTS] Removed all the tests related to the warning that was emitted
+ by the module when ran as non root.
+ - [TESTS] Fixed several tests to make them more portable.
+ - [TESTS] Added 00-load.t, 01-api.t
0.23 Tue Jan8 2007
- add version number to submodules
Modified: branches/upstream/libnet-rawip-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/MANIFEST?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-rawip-perl/current/MANIFEST Sun Nov 2 05:26:53 2008
@@ -1,7 +1,8 @@
+META.yml Module meta-data (added by MakeMaker)
+Makefile.PL
Changes
MANIFEST
MANIFEST.SKIP
-Makefile.PL
README
README.Devel
TODO
@@ -38,12 +39,13 @@
examples/watch
examples/sniff.pl
+t/00-load.t
+t/01-api.t
+t/90-pod.t
+t/91-pod-coverage.t
+t/99-critic.t
+t/iflist.t
+t/memory_leak.t
+t/set_icmp.t
t/simple.t
-t/memory_leak.t
-t/iflist.t
-t/pod.t
-t/pod-coverage.t
-t/set_icmp.t
-t/critic.t
t/timem.t
-META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libnet-rawip-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/MANIFEST.SKIP?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libnet-rawip-perl/current/MANIFEST.SKIP Sun Nov 2 05:26:53 2008
@@ -3,6 +3,7 @@
\bCVS\b
,v$
\B\.svn\b
+\B\.git\b
# Avoid Makemaker generated and utility files.
\bMakefile$
Modified: branches/upstream/libnet-rawip-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/META.yml?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/META.yml (original)
+++ branches/upstream/libnet-rawip-perl/current/META.yml Sun Nov 2 05:26:53 2008
@@ -1,12 +1,20 @@
--- #YAML:1.0
name: Net-RawIP
-version: 0.23
-abstract: ~
-license: ~
-author: ~
-generated_by: ExtUtils::MakeMaker version 6.42
+version: 0.25
+abstract: Perl extension to manipulate raw IP packets with interface to B<libpcap>
+license: perl
+author:
+ - Sebastien Aperghis-Tramoni <sebastien at aperghis.net>
+generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
+ Carp: 0
+ Class::Struct: 0
+ Data::Dumper: 0
+ English: 0
+ Getopt::Long: 0
+ Socket: 0
+ Test::More: 0
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
Modified: branches/upstream/libnet-rawip-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/Makefile.PL?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/Makefile.PL (original)
+++ branches/upstream/libnet-rawip-perl/current/Makefile.PL Sun Nov 2 05:26:53 2008
@@ -1,16 +1,17 @@
-use ExtUtils::MakeMaker;
-use Config;
use strict;
use warnings;
+use Config;
+use DynaLoader;
+use ExtUtils::MakeMaker;
my %config = (
'linux' => [
- '-D_LINUX_ -D_ETH_ -D_IFLIST_ ' . (defined $ENV{CFLAGS} ? $ENV{'CFLAGS'} : ''),
+ '-D_LINUX_ -D_ETH_ -D_IFLIST_',
'RawIP.o util.o eth.o ifaddrlist.o',
'',
- q{$def .= ' -D_GLIBC_' if -e "/usr/include/net/if_packet.h"},
+ q{ $def .= ' -D_GLIBC_' if -e "/usr/include/net/if_packet.h" },
],
-
+
'solaris' => [
'-D_SOLARIS_ -D_IFLIST_',
'RawIP.o util.o ifaddrlist.o',
@@ -18,22 +19,8 @@
. "Sorry, the rdev function is not imlemented on Solaris\n",
'',
],
-
+
'freebsd' => [
- '-D_BSDRAW_ -D_ETH_ -D_BPF_ -D_IFLIST_ -DHAVE_SOCKADDR_SA_LEN',
- 'RawIP.o util.o ifaddrlist.o eth.o rdev.o',
- '',
- '',
- ],
-
- 'netbsd' => [
- '-D_BSDRAW_ -D_ETH_ -D_BPF_ -D_IFLIST_ -DHAVE_SOCKADDR_SA_LEN',
- 'RawIP.o util.o ifaddrlist.o eth.o rdev.o',
- '',
- '',
- ],
-
- 'bsdos' => [
'-D_BSDRAW_ -D_ETH_ -D_BPF_ -D_IFLIST_ -DHAVE_SOCKADDR_SA_LEN',
'RawIP.o util.o ifaddrlist.o eth.o rdev.o',
'',
@@ -44,9 +31,9 @@
'-D_ETH_ -D_BPF_ -D_IFLIST_ -DHAVE_SOCKADDR_SA_LEN',
'RawIP.o util.o ifaddrlist.o eth.o rdev.o',
'',
- q{$def .= ' -D_BSDRAW_' if join('',(split /\./,$Config{osvers})[0,1]) < 21},
+ q{ $def .= ' -D_BSDRAW_' if join('',(split /\./,$Config{osvers})[0,1]) < 21 },
],
-
+
'others' => [
'',
'RawIP.o util.o',
@@ -57,11 +44,12 @@
]
);
-my $name = $Config{osname};
-if (not exists $config{$name}) {
- $name = 'others';
-}
-my $def = $config{$name}->[0];
+$config{bsdos } = $config{freebsd};
+$config{darwin} = $config{freebsd};
+$config{netbsd} = $config{freebsd};
+
+my $name = $Config{osname} || "others";
+my $def = $config{$name}->[0] . (defined $ENV{CFLAGS} ? " $ENV{'CFLAGS'}" : "");
my $obj = $config{$name}->[1];
print $config{$name}->[2];
eval $config{$name}->[3];
@@ -73,53 +61,39 @@
WriteMakefile(
- NAME => 'Net::RawIP',
- VERSION_FROM => 'lib/Net/RawIP.pm',
+ NAME => 'Net::RawIP',
+ LICENSE => 'perl',
+ AUTHOR => 'Sebastien Aperghis-Tramoni <sebastien at aperghis.net>',
+ VERSION_FROM => 'lib/Net/RawIP.pm',
+ ABSTRACT_FROM => 'lib/Net/RawIP.pm',
LIBS => ['-lpcap'],
DEFINE => $def,
INC => '',
OBJECT => $obj,
PREREQ_PM => {
+ # prereqs
+ 'Carp' => 0,
+ 'Class::Struct'=> 0,
+ 'Data::Dumper' => 0,
+ 'English' => 0,
+ 'Getopt::Long' => 0,
+ 'Socket' => 0,
+
+ # build/test prereqs
+ 'Test::More' => 0,
},
+ PL_FILES => {},
);
-# on Ubuntu file locations:
-# /usr/lib/libpcap.so.0.8
-# /usr/lib/libpcap.so.0.9.4
-# /usr/lib/libpcap.so.0.7.2
-# /usr/lib/libpcap.so.0.7
-# /usr/lib/libpcap.a
-# /usr/lib/libpcap.so
+sub locate_pcap {
+ # temporary; in next releases, I'll just completely remove the pcap parts
+ # from Net::RawIP and use Net::pcap instead
-# /usr/include/pcap.h
-sub locate_pcap {
- my $header = '/usr/include/pcap.h';
-
- if (! -e $header) {
- print <<'END_REPORT';
-Could not find libpcap, see the README file how to install it.
-
-If you do have libpcap installed, please let me know the
-locations of the pcap.h file and what operating system are you using
-so I can include it in the next release
-
-END_REPORT
- die "Could not find pcap.h. Makefile.PL was not created.\n";
- }
-
- open my $fh, '<', $header or die "Could not open $header for reading: $!";
- while (my $line = <$fh>) {
- if ($line =~ /PCAP_VERSION/) {
- print $line;
- }
- }
-
-
- print "The following libpcap.so files were found:\n\n";
- my @so_files = glob "/usr/lib/libpcap.so*";
- die "No libpcap.so file found. Makefile.PL was not created.\n"
- if not @so_files;
- print map {"$_\n"} @so_files;
+ my @paths = DynaLoader::dl_findfile("-lpcap");
+ die <<'REASON' unless @paths;
+Could not load the pcap library. Please see the README file on how
+to install it. Be sure to also install the C headers (pcap.h).
+REASON
}
Modified: branches/upstream/libnet-rawip-perl/current/RawIP.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/RawIP.xs?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/RawIP.xs (original)
+++ branches/upstream/libnet-rawip-perl/current/RawIP.xs Sun Nov 2 05:26:53 2008
@@ -1454,7 +1454,6 @@
CODE:
fp = (struct bpf_program *)safemalloc(sizeof(struct bpf_program));
RETVAL = pcap_compile(p,fp,str,optimize,netmask);
- Safefree(fp);
OUTPUT:
fp
RETVAL
Modified: branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP.pm?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP.pm (original)
+++ branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP.pm Sun Nov 2 05:26:53 2008
@@ -1,12 +1,10 @@
-# Main package
package Net::RawIP;
use strict;
use warnings;
+use AutoLoader ();
use Carp;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
-use subs qw(timem ifaddrlist);
-
+use Exporter ();
use English qw( -no_match_vars );
use Net::RawIP::iphdr;
use Net::RawIP::tcphdr;
@@ -16,9 +14,11 @@
use Net::RawIP::opt;
use Net::RawIP::ethhdr;
-require Exporter;
-require DynaLoader;
-require AutoLoader;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+use subs qw(timem ifaddrlist);
+
+$VERSION = "0.25";
@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(timem open_live dump_open dispatch dump loop linkoffset ifaddrlist rdev);
@@ -38,7 +38,17 @@
]
);
-$VERSION = '0.23';
+# load the shared object
+eval {
+ require XSLoader;
+ XSLoader::load("Net::RawIP", $VERSION);
+ 1
+} or do {
+ require DynaLoader;
+ push @ISA, "DynaLoader";
+ bootstrap Net::RawIP $VERSION;
+};
+
# The number of members in the sub modules
my %n = (
@@ -66,12 +76,6 @@
*$AUTOLOAD = sub () { $val };
goto &$AUTOLOAD;
}
-bootstrap Net::RawIP $VERSION;
-
-# Warn if called from non-root accounts
-# TODO: move this warning only when calling functions that really need root
-# priviliges
-carp "Must have EUID == 0 to use Net::RawIP, currently you are seen with EUID=$EUID" if $EUID;
# The constructor
@@ -643,7 +647,7 @@
sub pcapinit_offline {
my($self,$fname) = @_;
- my ($erbuf,$pcap);
+ my ($erbuf,$pcap) = ('','');
$pcap = open_offline($fname, $erbuf);
croak $erbuf if (! $pcap);
@@ -651,23 +655,34 @@
}
sub rdev {
+ my ($addr) = @_;
+
+ return unless defined $addr and $addr;
+
my $rdev;
- my $ip = ($_[0] =~ /^-?\d+$/) ? $_[0] : host_to_ip($_[0]);
- my $ipn = unpack("I",pack("N",$ip));
- if (($rdev = ip_rt_dev($ipn)) eq 'proc'){
- my($dest,$mask);
- open (my $route, '<', '/proc/net/route') || croak "Can't open /proc/net/route: $!";
+ my $ip = ($addr =~ /^-?\d+$/) ? $addr : host_to_ip($addr);
+ my $ipn = unpack("I", pack("N", $ip));
+
+ if (($rdev = ip_rt_dev($ipn)) eq "proc") {
+ my ($dest, $mask);
+ open(my $route, "<", "/proc/net/route")
+ or croak "Can't open /proc/net/route: $!";
+
while (<$route>) {
next if /Destination/;
- ($rdev,$dest,$mask) = (split(/\s+/))[0,1,7];
+ ($rdev, $dest, $mask) = (split(/\s+/))[0,1,7];
last unless ($ipn & hex($mask)) ^ hex($dest);
}
- CORE::close($route);
+
+ close($route);
$rdev = 'lo' unless ($ip & 0xFF000000) ^ 0x7f000000; # For Linux 2.2.x
}
+
croak "rdev(): Destination unreachable" unless $rdev;
+
# The aliasing support
$rdev =~ s/([^:]+)(:.+)?/$1/;
+
return $rdev;
}
@@ -677,16 +692,23 @@
closefd($self->{tap}) if exists $self->{tap};
}
-1;
+
+"Rawhide!!"
+
__END__
=head1 NAME
-Net::RawIP - Perl extension for manipulate raw ip packets with interface to B<libpcap>
+Net::RawIP - Perl extension to manipulate raw IP packets with interface to B<libpcap>
+
+=head VERSION
+
+This is the documentation of C<Net::RawIP> version 0.25
=head1 SYNOPSIS
use Net::RawIP;
+
$n = Net::RawIP->new({
ip => {
saddr => 'my.target.lan',
@@ -708,13 +730,21 @@
$f = dump_open($p, "/my/home/log");
loop($p, 10, \&dump, $f);
+
=head1 DESCRIPTION
-This package provides a class object which can be used for
-creating, manipulating and sending raw ip packets with
-optional features for manipulating ethernet headers.
-
-B<NOTE:> Ethernet related methods are implemented on Linux and *BSD only
+This package provides a class which can be used for
+creating, manipulating and sending raw IP packets with
+optional features for manipulating Ethernet headers.
+
+B<Note:> Ethernet related methods are implemented on Linux and *BSD only.
+
+As its name implies, this module is quite low-level, and currently
+duplicates some features with C<Net::Pcap>. If you prefer a
+higher-level module (in terms of Perl support), please take a look
+at C<Net::Write>, which provides a portable interface to construct
+and send raw packets on the network.
+
=head1 Exported constants
@@ -797,29 +827,47 @@
The B<data> entries are scalars containing packed network byte order
data.
-As the real icmp packet is a C union one can specify specify only one
+As the real icmp packet is a C union one can specify only one
of the following set of values.
-=over 4
-
-=item B<gateway> - (int)
-
-=item (B<id> and B<sequence>) - (short and short)
-
-=item (B<mtu> and B<unused>) - (short and short)
+=over
+
+=item *
+
+B<gateway> - (int)
+
+=item *
+
+(B<id> and B<sequence>) - (short and short)
+
+=item *
+
+(B<mtu> and B<unused>) - (short and short)
=back
-The default values are
+The default values are:
+
+=over
+
+=item *
(0,0,0,0,5,0,0,0,0,0,0,0,0,0xffff,0,0,'') for tcp
+=item *
+
(0,0,0,0,0,0,0,0,'') for icmp
+=item *
+
(0,0,0,0,'') for udp
+=item *
+
('') for generic
+
+=back
The valid values for B<urg> B<ack> B<psh> B<rst> B<syn> B<fin> are 0 or 1.
The value of B<data> is a string. Length of the result packet will be calculated
@@ -850,14 +898,25 @@
The default values of the B<ip> hash are
+=over
+
+=item *
+
(4,5,16,0,0,0x4000,64,6,0,0,0) for B<tcp>
+=item *
+
(4,5,16,0,0,0x4000,64,17,0,0,0) for B<udp>
+=item *
+
(4,5,16,0,0,0x4000,64,1,0,0,0) for B<icmp>
+=item *
+
(4,5,16,0,0,0x4000,64,0,0,0,0) for B<generic>
+=back
=item dump_open
@@ -875,7 +934,7 @@
=item next
-B<next> returns a string (next packet).
+B<next()> returns a string (next packet).
=item timem
@@ -887,6 +946,7 @@
Similar to sprintf("%.6f", Time::HiRes::time());
+=for comment
TODO: replace this function with use of Time::HiRes ?
=item linkoffset
@@ -898,13 +958,13 @@
=item ifaddrlist
-B<ifaddrlist> returns a hash reference. In this hash keys are
+B<ifaddrlist()> returns a hash reference. In this hash keys are
the running network devices, values are ip addresses of those devices
in an internet address format.
=item rdev
-B<rdev> returns a name of the outgoing device for given destination address.
+B<rdev()> returns a name of the outgoing device for given destination address.
It has one input parameter (destination address in an internet address
or a domain name or a host byteorder int formats).
@@ -915,17 +975,17 @@
=item packet
-returns a scalar which contain the packed ip packet of the current object.
+Returns a scalar which contain the packed ip packet of the current object.
No input parameters.
=item set
-is a method for set the parameters to the current object. The given parameters
+Method for setting the parameters of the current object. The given parameters
must look like the parameters for the constructor.
=item bset($packet,$eth)
-is a method for set the parameters for the current object.
+Method for setting the parameters of the current object.
B<$packet> is a scalar which contain binary structure (an ip or an eth packet).
This scalar must match with the subclass of the current object.
If B<$eth> is given and it have a non-zero value then assumed that packet is a
@@ -938,7 +998,7 @@
packet if you'd call it with an array context.
If this method is called with a scalar context then it returns a hash reference.
In that hash will stored an asked parameters as values,the keys are their names.
-
+
The input parameter is a hash reference. In this hash can be three keys.
They are a B<ip> and an one of the B<ARGPROTO>s. The value must be an array reference. This
array contain asked parameters.
@@ -971,7 +1031,8 @@
E.g. you want to send the packet for ten times with delay equal to one second.
Here is a code :
-$packet->send(1,10);
+ $packet->send(1,10);
+
The delay could be specified not only as integer but
and as 0.25 for sleep to 250 ms or 3.5 to sleep for 3 seconds and 500 ms.
@@ -1051,12 +1112,12 @@
E.g. you want to know all the IP options from the current object.
Here is a code:
- at opts = $n->optget(ip => {});
+ @opts = $n->optget(ip => {});
E.g. you want to know just the IP options with the type which equal to 131 and 137.
Here is a code:
-($t131,$l131,$d131,$t137,$l137,$d137) = $n->optget(
+ ($t131,$l131,$d131,$t137,$l137,$d137) = $n->optget(
ip =>{
type =>[(131,137)]
} );
@@ -1070,22 +1131,46 @@
E.g. you want to unset an IP options.
Here is a code:
-$n->optunset('ip');
+ $n->optunset('ip');
E.g. you want to unset a TCP and an IP options.
Here is a code:
-$n->optunset('ip','tcp');
+ $n->optunset('ip','tcp');
=back
-=head1 AUTHOR
-
-Sergey Kolychev <ksv at al.lg.ua>
-
-Current Maintainer: Gabor Szabo <gabor at pti.co.il>
-
-=head1 COPYRIGHT
+
+=head1 SEE ALSO
+
+pcap(3), tcpdump(1), RFC 791-793, RFC 768.
+
+L<Net::Pcap>, L<Net::Pcap::Easy>, L<Net::Pcap::Reassemble>,
+L<Net::Pcap::FindDevice>
+
+L<Net::Write> for an alternative module to send raw packets on the network
+
+
+=head1 AUTHORS
+
+Current maintainer is SE<eacute>bastien Aperghis-Tramoni
+E<lt>sebastien at aperghis.netE<gt>
+
+Previous authors & maintainers:
+
+=over
+
+=item *
+
+Sergey Kolychev E<lt>ksv at al.lg.uaE<gt>
+
+=item *
+
+Gabor Szabo E<lt>gabor at pti.co.ilE<gt>
+
+=back
+
+=head1 COPYRIGHT & LICENSE
Copyright (c) 1998-2006 Sergey Kolychev. All rights reserved. This program is free
software; you can redistribute it and/or modify it under the same terms
@@ -1096,12 +1181,5 @@
Steve Bonds <u5rhsiz02 at sneakemail.com>
+ work on some endianness bugs and improving code comments
-=head1 SEE ALSO
-
-perl(1),Net::RawIP::libpcap(3pm),tcpdump(1),RFC 791-793,RFC 768.
-
-L<Net::Pcap>, L<Net::Pcap::Reassemble>, L<Net::PcapUtils>
-L<Net::Pcap::FindDevice>
-
=cut
Modified: branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/ethhdr.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/ethhdr.pm?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/ethhdr.pm (original)
+++ branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/ethhdr.pm Sun Nov 2 05:26:53 2008
@@ -1,7 +1,7 @@
package Net::RawIP::ethhdr;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use Class::Struct qw(struct);
our @ethhdr = qw(dest source proto);
struct ( 'Net::RawIP::ethhdr' => [map { $_ => '$' } @ethhdr ] );
Modified: branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/generichdr.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/generichdr.pm?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/generichdr.pm (original)
+++ branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/generichdr.pm Sun Nov 2 05:26:53 2008
@@ -1,7 +1,7 @@
package Net::RawIP::generichdr;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use Class::Struct qw(struct);
our @generichdr = qw(data);
struct ( 'Net::RawIP::generichdr' => [map { $_ => '$' } @generichdr ] );
Modified: branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/icmphdr.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/icmphdr.pm?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/icmphdr.pm (original)
+++ branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/icmphdr.pm Sun Nov 2 05:26:53 2008
@@ -1,7 +1,7 @@
package Net::RawIP::icmphdr;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use Class::Struct qw(struct);
our @icmphdr = qw(type code check gateway id sequence unused mtu data);
struct ( 'Net::RawIP::icmphdr' => [map { $_ => '$' } @icmphdr ] );
Modified: branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/iphdr.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/iphdr.pm?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/iphdr.pm (original)
+++ branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/iphdr.pm Sun Nov 2 05:26:53 2008
@@ -1,7 +1,7 @@
package Net::RawIP::iphdr;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use Class::Struct qw(struct);
our @iphdr
= qw(version ihl tos tot_len id frag_off ttl protocol check saddr daddr);
Modified: branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/opt.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/opt.pm?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/opt.pm (original)
+++ branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/opt.pm Sun Nov 2 05:26:53 2008
@@ -1,7 +1,7 @@
package Net::RawIP::opt;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use Class::Struct qw(struct);
my @opt = qw(type len data);
struct ( 'Net::RawIP::opt' => [map { $_ => '@' } @opt ] );
Modified: branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/tcphdr.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/tcphdr.pm?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/tcphdr.pm (original)
+++ branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/tcphdr.pm Sun Nov 2 05:26:53 2008
@@ -1,7 +1,7 @@
package Net::RawIP::tcphdr;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use Class::Struct qw(struct);
our @tcphdr = qw(source dest seq ack_seq doff res1 res2 urg ack psh rst syn
fin window check urg_ptr data);
Modified: branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/udphdr.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/udphdr.pm?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/udphdr.pm (original)
+++ branches/upstream/libnet-rawip-perl/current/lib/Net/RawIP/udphdr.pm Sun Nov 2 05:26:53 2008
@@ -1,7 +1,7 @@
package Net::RawIP::udphdr;
use strict;
use warnings;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
use Class::Struct qw(struct);
our @udphdr = qw(source dest len check data);
struct ( 'Net::RawIP::udphdr' => [map { $_ => '$' } @udphdr ] );
Added: branches/upstream/libnet-rawip-perl/current/t/00-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/00-load.t?rev=26502&op=file
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/00-load.t (added)
+++ branches/upstream/libnet-rawip-perl/current/t/00-load.t Sun Nov 2 05:26:53 2008
@@ -1,0 +1,6 @@
+#!perl -T
+use strict;
+use Test::More tests => 1;
+
+use_ok( 'Net::RawIP' );
+diag( "Testing Net::RawIP $Net::RawIP::VERSION under Perl $]" );
Added: branches/upstream/libnet-rawip-perl/current/t/01-api.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/01-api.t?rev=26502&op=file
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/01-api.t (added)
+++ branches/upstream/libnet-rawip-perl/current/t/01-api.t Sun Nov 2 05:26:53 2008
@@ -1,0 +1,87 @@
+#!perl -T
+use strict;
+use warnings;
+use Test::More;
+
+
+# public API
+my $module = "Net::RawIP";
+
+my @exported_functions = qw(
+ dispatch
+ dump
+ dump_open
+ loop
+ linkoffset
+ ifaddrlist
+ open_live
+ rdev
+ timem
+);
+
+my @class_methods = qw(
+ new
+ optget
+ optset
+ optunset
+);
+
+my @object_methods = qw(
+
+);
+
+
+# tests plan
+plan tests => 1 + 2 * @exported_functions + 1 * @class_methods + 2 + 2 * @object_methods;
+
+# load the module
+use_ok( $module );
+
+# check functions
+for my $function (@exported_functions) {
+ can_ok($module, $function);
+ can_ok(__PACKAGE__, $function);
+}
+
+# check class methods
+for my $methods (@class_methods) {
+ can_ok($module, $methods);
+}
+
+# check object methods
+my $object = eval { $module->new };
+is( $@, "", "creating a $module object" );
+isa_ok( $object, $module, "check that the object" );
+
+for my $method (@object_methods) {
+ can_ok($module, $method);
+ can_ok($object, $method);
+}
+
+__END__
+
+# subs defined in lib/New/RawIP.pm
+qw<
+ N2L
+ _pack
+ _unpack
+ bset
+ ethnew
+ ethsend
+ ethset
+ generic_default
+ get
+ icmp_default
+ mac
+ n2L
+ packet
+ pcapinit
+ pcapinit_offline
+ proto
+ s2i
+ send
+ send_eth_frame
+ set
+ tcp_default
+ udp_default
+>;
Added: branches/upstream/libnet-rawip-perl/current/t/90-pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/90-pod.t?rev=26502&op=file
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/90-pod.t (added)
+++ branches/upstream/libnet-rawip-perl/current/t/90-pod.t Sun Nov 2 05:26:53 2008
@@ -1,0 +1,10 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+plan skip_all => "Author tests" unless $ENV{AUTHOR_MODE};
+plan skip_all => "Test::Pod 1.00 required for testing POD"
+ unless eval "use Test::Pod; 1";
+
+all_pod_files_ok(all_pod_files('.'));
Added: branches/upstream/libnet-rawip-perl/current/t/91-pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/91-pod-coverage.t?rev=26502&op=file
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/91-pod-coverage.t (added)
+++ branches/upstream/libnet-rawip-perl/current/t/91-pod-coverage.t Sun Nov 2 05:26:53 2008
@@ -1,0 +1,10 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+plan skip_all => "Author tests" unless $ENV{AUTHOR_MODE};
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage"
+ unless eval "use Test::Pod::Coverage; 1";
+
+all_pod_coverage_ok();
Added: branches/upstream/libnet-rawip-perl/current/t/99-critic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/99-critic.t?rev=26502&op=file
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/99-critic.t (added)
+++ branches/upstream/libnet-rawip-perl/current/t/99-critic.t Sun Nov 2 05:26:53 2008
@@ -1,0 +1,12 @@
+use strict;
+use warnings;
+use Test::More;
+
+
+plan skip_all => "Author tests" unless $ENV{AUTHOR_MODE};
+plan skip_all => "Test::Perl::Critic required to criticise code"
+ unless eval "use Test::Perl::Critic; 1";
+
+all_critic_ok('blib');
+#all_critic_ok('blib', 't');
+
Modified: branches/upstream/libnet-rawip-perl/current/t/iflist.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/iflist.t?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/iflist.t (original)
+++ branches/upstream/libnet-rawip-perl/current/t/iflist.t Sun Nov 2 05:26:53 2008
@@ -1,56 +1,38 @@
-#!/usr/bin/perl
+#!perl
use strict;
use warnings;
-
+use Data::Dumper qw(Dumper);
+use English qw(-no_match_vars);
use Test::More;
-my $tests;
-plan tests => $tests;
-
-use Data::Dumper qw(Dumper);
-use English qw( -no_match_vars );
-
-my $warn;
-BEGIN {
- $SIG{__WARN__} = sub { $warn = shift; }
-}
use Net::RawIP;
-{
- if ($EUID) {
- like $warn, qr/Must have EUID == 0/, "root warning seen";
- } else {
- ok(not(defined $warn), "no root warning");
- }
- BEGIN { $tests += 1; }
-}
-$SIG{__WARN__} = 'DEFAULT';
-{
- my $list = ifaddrlist;
- is( ref($list), 'HASH', 'ifaddrlist retursn HASH ref');
+plan tests => my $tests;
- ok(exists $list->{lo}, 'lo interface exists');
- is($list->{lo}, '127.0.0.1', 'lo interface is 127.0.0.1');
+my $loopback = undef;
- # on my Linux machine this is
- # lo -> 127.0.0.1
- # eth0 -> 192.168.2.2
- # How can we test it on other machines?
+BEGIN { $tests += 3 } {
+ my $list = ifaddrlist();
+ is( ref($list), 'HASH', 'ifaddrlist() return HASH ref');
- diag "ifaddrelist returns: " . Dumper $list;
- BEGIN { $tests += 3; }
+ ($loopback) = grep { exists $list->{$_} } qw(lo lo0);
+ ok(exists $list->{$loopback}, "loopback interface is $loopback");
+ is($list->{$loopback}, '127.0.0.1', "loopback interface is 127.0.0.1");
}
-{
- is(rdev('127.0.0.1'), 'lo', 'rdev 127.0.0.1');
- is(rdev('localhost'), 'lo', 'rdev localhost');
- eval {
- rdev('ab cd');
- };
- like($@, qr{host_to_ip: failed}, 'rdev ab cd fails');
- # rdev will fail if there is not network connection
- ok(rdev('cisco.com'), 'rdev cisco.com'); # on my Linux machine this returns eth0
- BEGIN { $tests += 4; }
+BEGIN { $tests += 4 } SKIP: {
+ eval { rdev("127.0.0.1") };
+ skip "rdev() is not implemented on this system", 4
+ if $@ =~ /rdev\(\) is not implemented on this system/;
+
+ is( rdev('127.0.0.1'), $loopback, "rdev('127.0.0.1') => $loopback" );
+ is( rdev('localhost'), $loopback, "rdev('localhost') => $loopback" );
+
+ my $r = eval { rdev('ab cd') };
+ like( $@, qr{host_to_ip: failed}, "rdev('ab cd') => undef" );
+
+ # this test will fail if there is not network connection
+ $r = rdev('cisco.com');
+ ok( $r, "rdev('cisco.com') => $r" );
}
-
Modified: branches/upstream/libnet-rawip-perl/current/t/memory_leak.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/memory_leak.t?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/memory_leak.t (original)
+++ branches/upstream/libnet-rawip-perl/current/t/memory_leak.t Sun Nov 2 05:26:53 2008
@@ -1,49 +1,20 @@
#!/usr/bin/perl
use strict;
use warnings;
+use Data::Dumper qw(Dumper);
+use English qw(-no_match_vars);
+use Test::More;
+use Net::RawIP;
-use Test::More;
-my $tests;
-use Data::Dumper qw(Dumper);
-use English qw( -no_match_vars );
-eval {
- require Proc::ProcessTable;
-};
-if ($@) {
- plan skip_all => "Proc::ProcessTable is needed for this test";
-}
-else {
- plan tests => $tests;
-}
+plan skip_all => "Proc::ProcessTable is needed for this test"
+ unless eval "use Proc::ProcessTable; 1";
+plan skip_all => "Proc::ProcessTable does not support the size attribute on this platform"
+ unless eval { my $s = get_process_size($$) };
-sub get_process_size {
- my ($pid) = @_;
- my $pt = Proc::ProcessTable->new;
- foreach my $p ( @{$pt->table} ) {
- return $p->size if $pid == $p->pid;
- }
- return;
-}
+plan tests => my $tests;
-my $warn;
-BEGIN {
- $SIG{__WARN__} = sub { $warn = shift };
-}
-use_ok 'Net::RawIP';
-BEGIN { $tests += 1; }
-{
- if ($EUID) {
- like $warn, qr/Must have EUID == 0/, "root warning seen";
- } else {
- ok(not(defined $warn), "no root warning");
- }
- BEGIN { $tests += 1; }
-}
-$SIG{__WARN__} = 'DEFAULT';
-
-$warn = '';
diag "Testing Net::RawIP v$Net::RawIP::VERSION";
# one can run this test giving a number on the command line
@@ -58,6 +29,7 @@
for (2..$count) {
do_something();
}
+
sub do_something {
my $n = Net::RawIP->new({ udp => {} });
$n->set({
@@ -103,3 +75,14 @@
+sub get_process_size {
+ my ($pid) = @_;
+ my $pt = Proc::ProcessTable->new;
+
+ foreach my $p ( @{$pt->table} ) {
+ return $p->size if $pid == $p->pid;
+ }
+
+ return
+}
+
Modified: branches/upstream/libnet-rawip-perl/current/t/set_icmp.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/set_icmp.t?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/set_icmp.t (original)
+++ branches/upstream/libnet-rawip-perl/current/t/set_icmp.t Sun Nov 2 05:26:53 2008
@@ -8,22 +8,8 @@
my $tests;
plan tests => $tests;
-my $warn;
-BEGIN {
- $SIG{__WARN__} = sub { $warn = shift };
-}
use Net::RawIP qw{ :pcap };
-
-{
- if ($EUID) {
- like $warn, qr/Must have EUID == 0/, "root warning seen";
- } else {
- ok(not(defined $warn), "no root warning");
- }
- BEGIN { $tests += 1; }
-}
-$SIG{__WARN__} = 'DEFAULT';
is( test_undef(), 1, 'no_undefs' );
Modified: branches/upstream/libnet-rawip-perl/current/t/simple.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-rawip-perl/current/t/simple.t?rev=26502&op=diff
==============================================================================
--- branches/upstream/libnet-rawip-perl/current/t/simple.t (original)
+++ branches/upstream/libnet-rawip-perl/current/t/simple.t Sun Nov 2 05:26:53 2008
@@ -9,24 +9,9 @@
use Data::Dumper qw(Dumper);
use English qw( -no_match_vars );
-my $warn;
-BEGIN {
- $SIG{__WARN__} = sub { $warn = shift; }
-}
use_ok 'Net::RawIP';
-BEGIN { $tests += 1; }
-{
- if ($EUID) {
- like $warn, qr/Must have EUID == 0/, "root warning seen";
- } else {
- ok(not(defined $warn), "no root warning");
- }
- BEGIN { $tests += 1; }
-}
-$SIG{__WARN__} = 'DEFAULT';
-$warn = '';
diag "Testing $Net::RawIP::VERSION";
{
@@ -51,8 +36,7 @@
#diag Dumper $rawip;
is_deeply([sort keys %$rawip], [qw(iphdr pack proto tcphdr)]);
- is($warn, '', 'no warnnigs');
- BEGIN { $tests += 9; }
+ BEGIN { $tests += 8; }
}
{
@@ -122,7 +106,6 @@
#diag Dumper $scalar;
#$rawip->send(0,1);
- is($warn, '', 'no warnnigs');
BEGIN { $tests += 16; }
}
@@ -151,8 +134,7 @@
isnt(exists($rawip->{optsip}), 'optsip removed');
is_deeply($rawip->{udphdr}, [0, 0, 0, 0, '', 0], 'udphdr reset');
- is($warn, '', 'no warnnigs');
- BEGIN { $tests += 9; }
+ BEGIN { $tests += 8; }
}
{
@@ -172,8 +154,7 @@
is_deeply($rawip->{iphdr}, \@iphdr_result);
is_deeply([sort keys %$rawip], [qw(icmphdr iphdr pack proto)]);
- is($warn, '', 'no warnnigs');
- BEGIN { $tests += 8; }
+ BEGIN { $tests += 7; }
}
More information about the Pkg-perl-cvs-commits
mailing list