@@ -0,0 +1,37 @@
+#
+# $Id: Build.PL 2008 2015-02-10 06:33:53Z gomor $
+#
+use strict;
+use warnings;
+
+use Module::Build;
+
+# If Socket module does not support INET6 and getaddrinfo,
+# we will have to use Socket6 module.
+my @conditions_modules = ();
+eval {
+ require Socket;
+ Socket->import(qw(AF_INET6 getaddrinfo inet_pton));
+};
+if ($@) {
+ @conditions_modules = ( Socket6 => 0 );
+}
+
+my $builder = Module::Build->new(
+ module_name => 'Net::Write',
+ license => 'artistic',
+ dist_author => 'GomoR <gomor_at_cpan.org>',
+ dist_version_from => 'lib/Net/Write.pm',
+ requires => {
+ 'perl' => '5.6.1',
+ 'Class::Gomor' => 0,
+ 'Net::Pcap' => '0.12',
+ 'Socket' => 0,
+ @conditions_modules,
+ },
+ configure_requires => {
+ 'Module::Build' => 0,
+ },
+);
+
+$builder->create_build_script;
@@ -1,5 +1,23 @@
Revision history for Perl extension Net::Write.
+1.09 Sun Feb 15 18:06:48 CET 2015
+ - update: EUID 0 check is done at open() call instead of new() call
+ - bugfix: take inet_pton() and getaddrinfo() from Socket if available, or from Socket6
+ - tests: added tests 02 and 03 to test if inet_pton() and N:W:L3 open() are working
+
+1.08 Fri Jan 23 07:53:16 CET 2015
+ - bugfix: on setting AF_INET6(), and makes Socket6 module optional
+ => thanks to Vince
+ - update: copyright notice
+ - update: Kwalitee
+
+1.07 Sun Sep 2 18:42:02 CEST 2012
+ - bugfix: returns true when _check() is ok
+
+1.06 Sat Sep 1 12:45:09 CEST 2012
+ - update: better error handling scheme
+ - update: copyright notice
+
1.05 Wed Jun 10 20:37:44 CEST 2009
- bugfix: removed a warning on AF_INET6 constant declaration
- update: copyright notice
@@ -1,3 +1,4 @@
+Build.PL
Changes
examples/layer2.pl
examples/layer3-ipv6.pl
@@ -17,4 +18,8 @@ README
t/01-pod-coverage.t
t/01-test-pod.t
t/01-use.t
-META.yml Module meta-data (added by MakeMaker)
+t/02-inetpton.t
+t/03-layer3-open.t
+t/04-getsaddr.t
+META.yml
+META.json
@@ -0,0 +1,56 @@
+{
+ "abstract" : "a portable interface to open and send raw data to network",
+ "author" : [
+ "GomoR <gomor_at_cpan.org>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "Module::Build version 0.421",
+ "license" : [
+ "artistic_1"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Net-Write",
+ "prereqs" : {
+ "configure" : {
+ "requires" : {
+ "Module::Build" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Class::Gomor" : "0",
+ "Net::Pcap" : "0.12",
+ "Socket" : "0",
+ "perl" : "v5.6.1"
+ }
+ }
+ },
+ "provides" : {
+ "Net::Write" : {
+ "file" : "lib/Net/Write.pm",
+ "version" : "1.09"
+ },
+ "Net::Write::Layer" : {
+ "file" : "lib/Net/Write/Layer.pm"
+ },
+ "Net::Write::Layer2" : {
+ "file" : "lib/Net/Write/Layer2.pm"
+ },
+ "Net::Write::Layer3" : {
+ "file" : "lib/Net/Write/Layer3.pm"
+ },
+ "Net::Write::Layer4" : {
+ "file" : "lib/Net/Write/Layer4.pm"
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "license" : [
+ "http://opensource.org/licenses/artistic-license.php"
+ ]
+ },
+ "version" : "1.09"
+}
@@ -1,16 +1,34 @@
---- #YAML:1.0
-name: Net-Write
-version: 1.05
-abstract: a portable interface to open and send raw data to network
-license: artistic
-author:
- - GomoR <gomor-cpan_at_gomor.org>
-generated_by: ExtUtils::MakeMaker version 6.42
-distribution_type: module
-requires:
- Class::Gomor: 0
- Net::Pcap: 0.12
- Socket6: 0
+---
+abstract: 'a portable interface to open and send raw data to network'
+author:
+ - 'GomoR <gomor_at_cpan.org>'
+build_requires: {}
+configure_requires:
+ Module::Build: '0'
+dynamic_config: 1
+generated_by: 'Module::Build version 0.421, CPAN::Meta::Converter version 2.143240'
+license: artistic
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: Net-Write
+provides:
+ Net::Write:
+ file: lib/Net/Write.pm
+ version: '1.09'
+ Net::Write::Layer:
+ file: lib/Net/Write/Layer.pm
+ Net::Write::Layer2:
+ file: lib/Net/Write/Layer2.pm
+ Net::Write::Layer3:
+ file: lib/Net/Write/Layer3.pm
+ Net::Write::Layer4:
+ file: lib/Net/Write/Layer4.pm
+requires:
+ Class::Gomor: '0'
+ Net::Pcap: '0.12'
+ Socket: '0'
+ perl: v5.6.1
+resources:
+ license: http://opensource.org/licenses/artistic-license.php
+version: '1.09'
@@ -1,17 +1,30 @@
#
-# $Id: Makefile.PL 1636 2009-06-10 18:38:24Z gomor $
+# $Id: Makefile.PL 2008 2015-02-10 06:33:53Z gomor $
#
use ExtUtils::MakeMaker;
+# If Socket module does not support INET6 and getaddrinfo,
+# we will have to use Socket6 module.
+my @conditions_modules = ();
+eval {
+ require Socket;
+ Socket->import(qw(AF_INET6 getaddrinfo inet_pton));
+};
+if ($@) {
+ @conditions_modules = ( Socket6 => 0 );
+}
+
WriteMakefile(
- NAME => 'Net::Write',
- LICENSE => 'artistic',
- VERSION_FROM => 'lib/Net/Write.pm',
+ NAME => 'Net::Write',
+ LICENSE => 'artistic',
+ VERSION_FROM => 'lib/Net/Write.pm',
ABSTRACT_FROM => 'lib/Net/Write.pm',
- PREREQ_PM => {
+ AUTHOR => 'GomoR <gomor_at_cpan.org>',
+ MIN_PERL_VERSION => '5.6.1',
+ PREREQ_PM => {
Class::Gomor => 0,
- Socket6 => 0,
- Net::Pcap => '0.12',
+ Net::Pcap => '0.12',
+ Socket => 0,
+ @conditions_modules,
},
- AUTHOR => 'GomoR <gomor-cpan_at_gomor.org>',
);
@@ -1,10 +1,3 @@
-Tested ok against:
-
- - FreeBSD 6.1-RELEASE - Perl 5.8.8
- - Linux 2.6.x (Gentoo) - Perl 5.8.8
- - Windows XP SP2 - Perl 5.8.8
- - OpenBSD 3.8 - Perl 5.8.6
-
Net::Write
==========
@@ -21,18 +14,26 @@ DEPENDENCIES
This module requires these other modules and libraries:
- Perl v5.6.1
- Socket6
- Class::Gomor
- Net::Pcap
+ Perl v5.6.1
+ Class::Gomor
+ Net::Pcap
+ Socket
+ Socket6 (if Socket does not support INET6 and getaddrinfo)
You MUST have libpcap 0.9.x or WinPcap 3.1 in order for layer 2 sending
to work, as of Net::Write 1.00.
+TESTED OK AGAINST
+
+ FreeBSD 6.1-RELEASE - Perl 5.8.8
+ Linux 2.6.x (Gentoo) - Perl 5.8.8
+ Windows XP SP2 - Perl 5.8.8
+ OpenBSD 3.8 - Perl 5.8.6
+
COPYRIGHT AND LICENSE
You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.
-Copyright (c) 2006-2009, Patrice <GomoR> Auffret
+Copyright (c) 2006-2015, Patrice <GomoR> Auffret
@@ -1,37 +1,47 @@
#!/usr/bin/perl
#
-# $Id: layer3-ipv6.pl 1636 2009-06-10 18:38:24Z gomor $
+# $Id: layer3-ipv6.pl 2007 2015-01-27 06:26:42Z gomor $
#
use strict;
use warnings;
my $target = shift || die("Specify an IPv6 address as a parameter\n");
-
-use Net::Packet::Env qw($Env);
-$Env->noFrameAutoDesc(1);
-$Env->noFrameAutoDump(1);
+my $dev = shift || die("Specify an interface as a parameter\n");
use Net::Write::Layer qw(:constants);
use Net::Write::Layer3;
my $l3 = Net::Write::Layer3->new(
- dst => $target,
+ dst => $target,
family => NW_AF_INET6,
+ dev => $dev,
);
-use Net::Packet::IPv6;
-my $ip6 = Net::Packet::IPv6->new(dst => $target, hopLimit => 3);
-$ip6->pack;
+use Net::Frame::Device;
+use Net::Frame::Simple;
+use Net::Frame::Layer::IPv6;
+use Net::Frame::Layer::TCP;
+
+my $device = Net::Frame::Device->new(
+ target6 => $target,
+ dev => $dev,
+);
-use Net::Packet::TCP;
-my $tcp = Net::Packet::TCP->new(dst => 22);
-$tcp->pack;
+my $ip6 = Net::Frame::Layer::IPv6->new(
+ dst => $target,
+);
+my $tcp = Net::Frame::Layer::TCP->new(
+ dst => 22,
+ options => "\x02\x04\x54\x0b",
+);
-use Net::Packet::Frame;
-my $frame = Net::Packet::Frame->new(l3 => $ip6, l4 => $tcp);
+my $oSimple = Net::Frame::Simple->new(
+ layers => [ $ip6, $tcp ],
+);
-print $frame->print."\n";
+print $oSimple->print."\n";
+print unpack('H*', $oSimple->raw)."\n";
$l3->open;
-$l3->send($frame->raw);
+$l3->send($oSimple->raw);
$l3->close;
@@ -1,16 +1,14 @@
#!/usr/bin/perl
#
-# $Id: layer3.pl 1636 2009-06-10 18:38:24Z gomor $
+# $Id: layer3.pl 2011 2015-02-15 17:07:47Z gomor $
#
use strict;
use warnings;
my $target = shift || die("Specify an IPv4 address as a parameter\n");
-
-use Net::Packet::Env qw($Env);
-$Env->updateDevInfo($target);
-$Env->noFrameAutoDesc(1);
-$Env->noFrameAutoDump(1);
+# We choose a different source IP than 127.0.0.1
+# Under Mac OS, we won't be able to correctly send frame otherwise.
+(my $src = $target) =~ s/^\d+(\..*)$/2$1/;
use Net::Write::Layer3;
@@ -18,19 +16,26 @@ my $l3 = Net::Write::Layer3->new(
dst => $target,
);
-use Net::Packet::IPv4;
-my $ip4 = Net::Packet::IPv4->new(dst => $target);
-$ip4->pack;
+use Net::Frame::Simple;
+use Net::Frame::Layer::IPv4;
+use Net::Frame::Layer::TCP;
-use Net::Packet::TCP;
-my $tcp = Net::Packet::TCP->new(dst => 22);
-$tcp->pack;
+my $ip4 = Net::Frame::Layer::IPv4->new(
+ src => $src,
+ dst => $target,
+);
+my $tcp = Net::Frame::Layer::TCP->new(
+ dst => 11, # Easier for pcap filtering
+ options => "\x02\x04\x54\x0b",
+);
-use Net::Packet::Frame;
-my $frame = Net::Packet::Frame->new(l3 => $ip4, l4 => $tcp);
+my $oSimple = Net::Frame::Simple->new(
+ layers => [ $ip4, $tcp ],
+);
-print $frame->print."\n";
+print $oSimple->print."\n";
+print unpack('H*', $oSimple->raw)."\n";
$l3->open;
-$l3->send($frame->raw);
+$l3->send($oSimple->raw);
$l3->close;
@@ -1,13 +1,11 @@
#
-# $Id: Layer.pm 1636 2009-06-10 18:38:24Z gomor $
+# $Id: Layer.pm 2011 2015-02-15 17:07:47Z gomor $
#
package Net::Write::Layer;
use strict;
use warnings;
-require Exporter;
-require Class::Gomor::Array;
-our @ISA = qw(Exporter Class::Gomor::Array);
+use base qw(Exporter Class::Gomor::Array);
our @AS = qw(
dev
dst
@@ -84,39 +82,145 @@ sub _setIpHdrInclConstant {
}
sub _setAfinet6Constant {
- require Socket6;
- require Socket;
- my $val = 0;
- if (defined(&Socket6::AF_INET6)) {
- $val = &Socket6::AF_INET6;
+ my $val = 10; # Default value, in case we don't know.
+ # This is the value from a Ubuntu 14.10 system.
+ eval {
+ require Socket;
+ Socket->import(qw(AF_INET6));
+ };
+ if (! $@) { # AF_INET6 constant found in Socket module.
+ $val = Socket::AF_INET6();
}
- elsif (defined(&Socket::AF_INET6)) {
- $val = &Socket::AF_INET6;
+ else { # No AF_INET6 in Socket module, we try with Socket6.
+ eval {
+ require Socket6;
+ Socket6->import(qw(AF_INET6));
+ };
+ if (! $@) { # AF_INET6 constant found in Socket6 module.
+ $val = Socket6::AF_INET6();
+ }
}
+
+ # If constant is not found, we stick to the default value.
eval "use constant NW_AF_INET6 => $val;";
}
+sub _setInetPtonSub {
+ no strict 'refs';
+
+ eval {
+ require Socket;
+ Socket->import(qw(AF_INET6 inet_pton));
+ };
+ if (! $@) { # Socket supports AF_INET6 family and inet_pton.
+ *{__PACKAGE__.'::nw_inet_pton'} = \&Socket::inet_pton;
+
+ return 1;
+ }
+
+ eval {
+ require Socket6;
+ Socket6->import(qw(AF_INET6 inet_pton));
+ };
+ if (! $@) { # Socket6 supports AF_INET6 family and inet_pton.
+ *{__PACKAGE__.'::nw_inet_pton'} = \&Socket6::inet_pton;
+
+ return 1;
+ }
+
+ die("[-] Net::Write: inet_pton: not supported by Socket nor Socket6: ".
+ "try upgrading your Perl version or Socket/Socket6 modules.\n");
+}
+
+sub _setGetaddrinfoSub {
+ no strict 'refs';
+
+ # Try to use getaddrinfo() from main Socket module.
+ eval {
+ require Socket;
+ Socket->import(qw(AF_INET AF_INET6 getaddrinfo));
+ };
+ if (! $@) { # Socket supports AF_INET6 family and getaddrinfo.
+ *{__PACKAGE__.'::nw_getsaddr'} = sub {
+ my ($dest, $family, $protocol, $socktype) = @_;
+
+ #print STDERR "*** Socket support OK\n";
+
+ my %hints = (
+ family => $family,
+ # If we activate that, it breaks on some OS like Mac OS X
+ #protocol => $protocol,
+ #socktype => $socktype,
+ );
+ my ($err, @res) = Socket::getaddrinfo($dest, "", \%hints);
+ if ($err) {
+ return _croak("@{[(caller(0))[3]]}: getaddrinfo: $err");
+ }
+
+ if (@res > 0) {
+ my $h = $res[0];
+ return $h->{addr};
+ }
+
+ return _croak("@{[(caller(0))[3]]}: getaddrinfo: error: $!");
+ };
+
+ return 1;
+ }
+
+ # Main Socket module does not support getaddrinfo(), we try using Socket6
+ eval {
+ require Socket6;
+ Socket6->import(qw(AF_INET AF_INET6 getaddrinfo));
+ };
+ if (! $@) {
+ *{__PACKAGE__.'::nw_getsaddr'} = sub {
+ my ($dest, $family, $protocol, $socktype) = @_;
+
+ #print STDERR "*** Fallback on Socket6 support\n";
+
+ my @res = Socket6::getaddrinfo($dest, "", $family, $socktype)
+ or return _croak("@{[(caller(0))[3]]}: getaddrinfo: $!");
+
+ if (@res >= 5) {
+ my $saddr = $res[3];
+ return $saddr;
+ }
+
+ return _croak("@{[(caller(0))[3]]}: getaddrinfo: error: $!");
+ };
+
+ return 1;
+ }
+
+ return 1;
+}
+
BEGIN {
my $osname = {
cygwin => \&_checkWin32,
MSWin32 => \&_checkWin32,
};
- *_check = $osname->{$^O} || \&_checkOther;
+ {
+ no strict 'refs';
+ *{__PACKAGE__.'::_check'} = $osname->{$^O} || \&_checkOther;
+ }
+
_setIpProtoIpConstant();
_setIpProtoIpv6Constant();
_setIpProtoRawConstant();
_setIpHdrInclConstant();
_setAfinet6Constant();
+ _setInetPtonSub();
+ _setGetaddrinfoSub();
}
no strict 'vars';
-use Socket;
-use Socket6 qw(getaddrinfo);
+use Socket qw(SOCK_RAW);
use IO::Socket;
use Net::Pcap;
-use Carp;
use constant NW_AF_INET => AF_INET();
use constant NW_AF_UNSPEC => AF_UNSPEC();
@@ -140,47 +244,74 @@ our %EXPORT_TAGS = (
NW_IP_HDRINCL
NW_IPPROTO_RAW
)],
+ subs => [qw(
+ nw_inet_pton
+ nw_getsaddr
+ )],
);
our @EXPORT_OK = (
@{$EXPORT_TAGS{constants}},
+ @{$EXPORT_TAGS{subs}},
);
-sub _checkWin32 { }
+sub _checkWin32 {
+ return 1;
+}
sub _checkOther {
- croak("Must be EUID 0 (or equivalent) to open a device for writing.\n")
- if $>;
+ if ($>) {
+ print STDERR "[-] Must be EUID 0 (or equivalent) to open a device for ".
+ "writing.\n";
+ return;
+ }
+
+ return 1;
+}
+
+sub new {
+ my $self = shift->SUPER::new(
+ @_,
+ );
+
+ return $self;
}
-sub new { _check(); shift->SUPER::new(@_) }
+sub _croak {
+ my ($msg) = @_;
+ print STDERR "[-] $msg\n";
+ return;
+}
sub open {
my $self = shift;
my ($hdrincl) = @_;
- my @res = getaddrinfo($self->[$__dst], 0, $self->[$__family], SOCK_STREAM)
- or croak("@{[(caller(0))[3]]}: getaddrinfo: $!\n");
+ _check() or return;
+
+ my $saddr = nw_getsaddr($self->[$__dst], $self->[$__family], $self->[$__protocol])
+ or return _croak("@{[(caller(0))[3]]}: nw_getsaddr: error");
- my ($family, $saddr) = @res[0, 3] if @res >= 5;
$self->[$___sockaddr] = $saddr;
- socket(my $s, $family, SOCK_RAW, $self->[$__protocol])
- or croak("@{[(caller(0))[3]]}: socket: $!\n");
+ socket(my $s, $self->[$__family], SOCK_RAW(), $self->[$__protocol])
+ or return _croak("@{[(caller(0))[3]]}: socket: $!");
- my $fd = fileno($s) or croak("@{[(caller(0))[3]]}: fileno: $!\n");
+ my $fd = fileno($s)
+ or return _croak("@{[(caller(0))[3]]}: fileno: $!");
if ($hdrincl) {
$self->_setIpHdrincl($s, $self->[$__family])
- or croak("@{[(caller(0))[3]]}: setsockopt: $!\n");
+ or return _croak("@{[(caller(0))[3]]}: setsockopt: $!");
}
my $io = IO::Socket->new;
- $io->fdopen($fd, 'w') or croak("@{[(caller(0))[3]]}: fdopen: $!\n");
+ $io->fdopen($fd, 'w')
+ or return _croak("@{[(caller(0))[3]]}: fdopen: $!");
$self->[$___io] = $io;
- 1;
+ return 1;
}
sub send {
@@ -199,13 +330,13 @@ sub send {
$self->cgDebugPrint(2, "host is down");
last;
}
- carp("@{[(caller(0))[3]]}: $!\n");
- return undef;
+ print STDERR "[!] @{[(caller(0))[3]]}: $!\n";
+ return;
}
last;
}
- 1;
+ return 1;
}
sub close { shift->_io->close }
@@ -256,11 +387,11 @@ Adresse family to use (NW_AF_INET, NW_AF_INET6).
=item B<new>
-Object constructor.
+Object constructor. Returns undef on error.
=item B<open>
-Open the descriptor, when you are ready to B<send>.
+Open the descriptor, when you are ready to B<send>. Returns undef on error.
=item B<send> (scalar)
@@ -270,6 +401,12 @@ Send the raw data passed as a parameter. Returns undef on failure, true otherwis
Close the descriptor.
+=item B<nw_getsaddr>
+
+=item B<nw_inet_pton>
+
+Internal functions.
+
=back
=head1 CONSTANTS
@@ -316,7 +453,7 @@ Patrice E<lt>GomoRE<gt> Auffret
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2006-2009, Patrice E<lt>GomoRE<gt> Auffret
+Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.
@@ -1,26 +1,28 @@
#
-# $Id: Layer2.pm 1636 2009-06-10 18:38:24Z gomor $
+# $Id: Layer2.pm 2005 2015-01-23 06:56:13Z gomor $
#
package Net::Write::Layer2;
use strict;
use warnings;
-require Net::Write::Layer;
-our @ISA = qw(Net::Write::Layer);
+use base qw(Net::Write::Layer);
__PACKAGE__->cgBuildIndices;
no strict 'vars';
-use Carp;
use Net::Pcap;
sub new {
- my $self = shift->SUPER::new(@_);
+ my $self = shift->SUPER::new(
+ @_,
+ ) or return;
- croak("@{[(caller(0))[3]]}: you must pass `dev' parameter\n")
- unless $self->[$__dev];
+ if (! $self->[$__dev]) {
+ print STDERR "[-] @{[(caller(0))[3]]}: you must pass `dev' parameter\n";
+ return;
+ }
- $self;
+ return $self;
}
sub open {
@@ -35,13 +37,14 @@ sub open {
\$err,
);
unless ($pd) {
- croak("@{[(caller(0))[3]]}: Net::Pcap::open_live: @{[$self->dev]}: ".
- "$err\n");
+ print STDERR "[-] @{[(caller(0))[3]]}: Net::Pcap::open_live: ".
+ "@{[$self->dev]}: $err\n";
+ return;
}
$self->[$___io] = $pd;
- 1;
+ return 1;
}
sub send {
@@ -59,13 +62,14 @@ sub send {
$self->cgDebugPrint(2, "host is down");
last;
}
- carp("@{[(caller(0))[3]]}: ".Net::Pcap::geterr($self->[$___io])."\n");
- return undef;
+ print STDERR "[!] @{[(caller(0))[3]]}: ".
+ Net::Pcap::geterr($self->[$___io])."\n";
+ return;
}
last;
}
- 1;
+ return 1;
}
sub close {
@@ -121,11 +125,11 @@ Under Windows systems, this is more complex; example:
=item B<new>
-Object constructor. You MUST pass a valid B<dev> attribute. There is no default value.
+Object constructor. You MUST pass a valid B<dev> attribute. There is no default value. Returns undef on error.
=item B<open>
-Open the interface.
+Open the interface. Returns undef on error.
=item B<send> (scalar)
@@ -151,7 +155,7 @@ Patrice E<lt>GomoRE<gt> Auffret
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2006-2009, Patrice E<lt>GomoRE<gt> Auffret
+Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.
@@ -1,13 +1,12 @@
#
-# $Id: Layer3.pm 1636 2009-06-10 18:38:24Z gomor $
+# $Id: Layer3.pm 2008 2015-02-10 06:33:53Z gomor $
#
package Net::Write::Layer3;
use strict;
use warnings;
-use Carp;
use Net::Write::Layer qw(:constants);
-our @ISA = qw(Net::Write::Layer);
+use base qw(Net::Write::Layer);
__PACKAGE__->cgBuildIndices;
BEGIN {
@@ -22,7 +21,9 @@ BEGIN {
no strict 'vars';
sub _newWin32 {
- croak("Not possible to use layer 3 under Windows. Use layer 2 instead.\n");
+ print STDERR "[-] Not possible to use layer 3 under Windows. Use layer 2 ".
+ "instead.\n";
+ return;
}
sub _newOther {
@@ -30,12 +31,14 @@ sub _newOther {
protocol => NW_IPPROTO_RAW,
family => NW_AF_INET,
@_,
- );
+ ) or return;
- croak("@{[(caller(0))[3]]}: you must pass `dst' parameter\n")
- unless $self->[$__dst];
+ if (! $self->[$__dst]) {
+ print STDERR "[-] @{[(caller(0))[3]]}: you must pass `dst' parameter\n";
+ return;
+ }
- $self;
+ return $self;
}
sub open { shift->SUPER::open(1) }
@@ -47,6 +50,10 @@ sub _setIpHdrincl {
return setsockopt($sock, NW_IPPROTO_IP, NW_IP_HDRINCL, 1);
}
if ($family == NW_AF_INET6) {
+ # Currently, only Linux supports IPHDRINCL for IPv6, no Layer3 sending for others :(
+ if ($^O ne 'linux') {
+ die("[-] @{[(caller(0))[3]]}: IPHDRINCL only supported on Linux\n");
+ }
return setsockopt($sock, NW_IPPROTO_IPv6, NW_IP_HDRINCL, 1);
}
return;
@@ -109,9 +116,11 @@ protocol: NW_IPPROTO_RAW
family: NW_AF_INET
+Returns undef on error.
+
=item B<open>
-Open the interface.
+Open the interface. Returns undef on error.
=item B<send> (scalar)
@@ -139,7 +148,7 @@ Patrice E<lt>GomoRE<gt> Auffret
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2006-2009, Patrice E<lt>GomoRE<gt> Auffret
+Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.
@@ -1,13 +1,12 @@
#
-# $Id: Layer4.pm 1636 2009-06-10 18:38:24Z gomor $
+# $Id: Layer4.pm 2005 2015-01-23 06:56:13Z gomor $
#
package Net::Write::Layer4;
use strict;
use warnings;
-use Carp;
use Net::Write::Layer qw(:constants);
-our @ISA = qw(Net::Write::Layer);
+use base qw(Net::Write::Layer);
__PACKAGE__->cgBuildIndices;
BEGIN {
@@ -22,7 +21,9 @@ BEGIN {
no strict 'vars';
sub _newWin32 {
- croak("Not possible to use layer 4 under Windows. Use layer 2 instead.\n");
+ print STDERR "[-] Not possible to use layer 4 under Windows. Use layer 2 ".
+ "instead.\n";
+ return;
}
sub _newOther {
@@ -30,12 +31,14 @@ sub _newOther {
protocol => NW_IPPROTO_TCP,
family => NW_AF_INET,
@_,
- );
+ ) or return;
- croak("@{[(caller(0))[3]]}: you must pass `dst' parameter\n")
- unless $self->[$__dst];
+ if (! $self->[$__dst]) {
+ print STDERR "[-] @{[(caller(0))[3]]}: you must pass `dst' parameter\n";
+ return;
+ }
- $self;
+ return $self;
}
1;
@@ -95,9 +98,11 @@ protocol: NW_IPPROTO_TCP
family: NW_AF_INET
+Returns undef on error.
+
=item B<open>
-Open the interface.
+Open the interface. Returns undef on error.
=item B<send> (scalar)
@@ -123,7 +128,7 @@ Patrice E<lt>GomoRE<gt> Auffret
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2006-2009, Patrice E<lt>GomoRE<gt> Auffret
+Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.
@@ -1,5 +1,5 @@
#
-# $Id: Write.pm 1636 2009-06-10 18:38:24Z gomor $
+# $Id: Write.pm 2007 2015-01-27 06:26:42Z gomor $
#
package Net::Write;
use strict;
@@ -7,7 +7,7 @@ use warnings;
require v5.6.1;
-our $VERSION = '1.05';
+our $VERSION = '1.09';
1;
@@ -35,7 +35,7 @@ Patrice E<lt>GomoRE<gt> Auffret
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2006-2009, Patrice E<lt>GomoRE<gt> Auffret
+Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.
@@ -2,7 +2,7 @@ use Test;
BEGIN { plan(tests => 1) }
use Net::Write;
-use Net::Write::Layer qw(:constants);
+use Net::Write::Layer qw(:constants :subs);
use Net::Write::Layer2;
use Net::Write::Layer3;
use Net::Write::Layer4;
@@ -0,0 +1,45 @@
+use Test;
+BEGIN { plan(tests => 2) }
+
+use Net::Write::Layer qw(:constants :subs);
+
+my $ip4 = '127.0.0.1';
+my $ip6 = '::1';
+
+ok(
+ sub {
+ my $saddr;
+ eval { $saddr = Net::Write::Layer::nw_inet_pton(NW_AF_INET6, $ip6); };
+ if ($@) {
+ return 0; # Error
+ }
+ if (defined($saddr)) {
+ my $hex = unpack('H*', $saddr);
+ if ($hex eq '00000000000000000000000000000001') {
+ return 1; # OK
+ }
+ }
+ return 0; # Error
+ },
+ 1,
+ $@,
+);
+
+ok(
+ sub {
+ my $saddr;
+ eval { $saddr = Net::Write::Layer::nw_inet_pton(NW_AF_INET, $ip4); };
+ if ($@) {
+ return 0; # Error
+ }
+ if (defined($saddr)) {
+ my $hex = unpack('H*', $saddr);
+ if ($hex eq '7f000001') {
+ return 1; # OK
+ }
+ }
+ return 0; # Error
+ },
+ 1,
+ $@,
+);
@@ -0,0 +1,63 @@
+use Test;
+BEGIN { plan(tests => 2) }
+
+use Net::Write::Layer qw(:constants);
+use Net::Write::Layer3;
+
+my $ip4 = '127.0.0.1';
+my $ip6 = '::1';
+
+ok(
+ sub {
+ my $fd = Net::Write::Layer3->new(
+ dst => $ip4,
+ protocol => NW_IPPROTO_RAW,
+ family => NW_AF_INET,
+ );
+ eval { $fd->open; };
+ if ($@) {
+ if ($@ =~ /EUID 0/) {
+ return 1; # SKIP as non-root
+ }
+ return 0; # Error
+ }
+ if (! defined($fd)) {
+ return 0; # Error
+ }
+ if ($fd <= 0) {
+ return 0; # Error
+ }
+ return 1; # OK
+ },
+ 1,
+ $@,
+);
+
+ok(
+ sub {
+ my $fd = Net::Write::Layer3->new(
+ dst => $ip6,
+ protocol => NW_IPPROTO_RAW,
+ family => NW_AF_INET6,
+ );
+ eval { $fd->open; };
+ if ($@) {
+ if ($@ =~ /EUID 0/) {
+ return 1; # SKIP as non-root
+ }
+ elsif ($@ =~ /IPHDRINCL only supported on Linux/) {
+ return 1; # SKIP as not supported
+ }
+ return 0; # Error
+ }
+ if (! defined($fd)) {
+ return 0; # Error
+ }
+ if ($fd <= 0) {
+ return 0; # Error
+ }
+ return 1; # OK
+ },
+ 1,
+ $@,
+);
@@ -0,0 +1,56 @@
+use Test;
+BEGIN { plan(tests => 2) }
+
+use Net::Write::Layer qw(:constants :subs);
+
+my $ip4 = '127.0.0.1';
+my $ip6 = '::1';
+my $os = $^O;
+
+ok(
+ sub {
+ my $saddr;
+ eval { $saddr = Net::Write::Layer::nw_getsaddr($ip6, NW_AF_INET6); };
+ if ($@) {
+ return 0; # Error
+ }
+ if (defined($saddr)) {
+ my $hex = unpack('H*', $saddr);
+ print "1: $hex\n";
+ # Only Linux currently support sending at Layer3
+ if ($os eq 'linux') {
+ return $hex eq '0a000000000000000000000000000000000000000000000100000000' ? 1 : 0;
+ }
+ else {
+ return 1; # SKIP for others
+ }
+ }
+ return 0; # Error
+ },
+ 1,
+ $@,
+);
+
+ok(
+ sub {
+ my $saddr;
+ eval { $saddr = Net::Write::Layer::nw_getsaddr($ip4, NW_AF_INET); };
+ if ($@) {
+ return 0; # Error
+ }
+ if (defined($saddr)) {
+ my $hex = unpack('H*', $saddr);
+ print "2: $hex\n";
+ # Only Linux currently support sending at Layer3
+ if ($os eq 'linux') {
+ return $hex eq '020000007f0000010000000000000000' ? 1 : 0;
+ }
+ else {
+ return 1; # SKIP for others
+ }
+ }
+ return 0; # Error
+ },
+ 1,
+ $@,
+);