Net-Write-1.10000755001750001750 012475521430 12705 5ustar00gomorgomor000000000000Net-Write-1.10/MANIFEST000444001750001750 65112475521430 14155 0ustar00gomorgomor000000000000Build.PL Changes examples/layer2.pl examples/layer3-ipv6.pl examples/layer3.pl examples/layer4-ipv6.pl examples/layer4.pl lib/Net/Write/Layer2.pm lib/Net/Write/Layer3.pm lib/Net/Write/Layer4.pm lib/Net/Write/Layer.pm lib/Net/Write.pm LICENSE LICENSE.Artistic Makefile.PL MANIFEST This list of files README t/01-pod-coverage.t t/01-test-pod.t t/01-use.t t/02-inetpton.t t/03-layer3-open.t t/04-getsaddr.t META.yml META.json Net-Write-1.10/README000444001750001750 155112475521430 13724 0ustar00gomorgomor000000000000Net::Write ========== INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Perl v5.6.1 Class::Gomor Net::Pcap Socket Socket6 (if Socket does not support INET6 and getaddrinfo) Socket::GetAddrInfo (optional, in case Socket/Socket6 fails for 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-2015, Patrice Auffret Net-Write-1.10/Makefile.PL000444001750001750 132512475521430 15015 0ustar00gomorgomor000000000000# # $Id: Makefile.PL 2014 2015-03-04 06:16:57Z 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', ABSTRACT_FROM => 'lib/Net/Write.pm', AUTHOR => 'GomoR ', MIN_PERL_VERSION => '5.6.1', PREREQ_PM => { Class::Gomor => 0, Net::Pcap => '0.12', Socket => 0, Socket::GetAddrInfo => 0, @conditions_modules, }, ); Net-Write-1.10/Build.PL000444001750001750 150012475521430 14332 0ustar00gomorgomor000000000000# # $Id: Build.PL 2014 2015-03-04 06:16:57Z 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 ', dist_version_from => 'lib/Net/Write.pm', requires => { 'perl' => '5.6.1', 'Class::Gomor' => 0, 'Net::Pcap' => '0.12', 'Socket' => 0, 'Socket::GetAddrInfo' => 0, @conditions_modules, }, configure_requires => { 'Module::Build' => 0, }, ); $builder->create_build_script; Net-Write-1.10/LICENSE000444001750001750 26512475521430 14032 0ustar00gomorgomor000000000000LICENSE This program is free software. You can redistribute it and/or modify it under the following terms: - the Perl Artistic License (in the file LICENSE.Artistic), Net-Write-1.10/Changes000444001750001750 427712475521430 14347 0ustar00gomorgomor000000000000Revision history for Perl extension Net::Write. 1.10 Wed Mar 4 07:15:18 CET 2015 - bugfix: fallback on using Socket::GetAddrInfo for getaddrinfo() 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.04 Sun Oct 19 17:47:11 CEST 2008 - bugfix: IP_HDRINCL with IPv6 under Linux 2.6.x 1.03 Fri Mar 21 17:20:00 CET 2008 - added support for IP_HDRINCL with IPv6 raw sockets (Linux only) => in fact, it should have worked before, but it appears to be a regression 1.02 Tue Feb 19 12:11:21 CET 2008 - bugfix: due to Socket6 update, AF_INET6 definition has changed 1.01 Sun Feb 17 19:08:15 CET 2008 - update: portability patches for other Unix systems (untested), concerning IP_HDRINCL constants and the like - update: license string (lc(Artistic)), to make CPANTS happy 1.00 Sun Nov 26 19:41:54 CET 2006 - NEW: now a pure Perl module. You MUST have libpcap 0.9.x, or WinPcap 3.1 - UPGRADE: all constants have moved to Layer.pm - examples: examples for all layers - test: Test::Pod, Test::Pod::Coverage 0.83 Sun Oct 29 14:31:31 CET 2006 - bugfix: in Layer2.pm, added require IO::Socket 0.82 Sat May 6 18:07:16 CEST 2006 - bugfix: call to debugPrint() renamed to cgDebugPrint() 0.81 Mon May 1 20:38:00 CEST 2006 - now uses Class::Gomor::Array instead of Hash - bugfix: send() returns undef on failure, true otherwise - some minor code optimizations to improve speed (mostly on send()) 0.80 Sun Mar 19 13:39:59 2006 - first public release Net-Write-1.10/META.yml000444001750001750 157212475521430 14320 0ustar00gomorgomor000000000000--- abstract: 'a portable interface to open and send raw data to network' author: - 'GomoR ' 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.4.html version: '1.4' name: Net-Write provides: Net::Write: file: lib/Net/Write.pm version: '1.10' 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' Socket::GetAddrInfo: '0' perl: v5.6.1 resources: license: http://opensource.org/licenses/artistic-license.php version: '1.10' Net-Write-1.10/META.json000444001750001750 253212475521430 14465 0ustar00gomorgomor000000000000{ "abstract" : "a portable interface to open and send raw data to network", "author" : [ "GomoR " ], "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", "Socket::GetAddrInfo" : "0", "perl" : "v5.6.1" } } }, "provides" : { "Net::Write" : { "file" : "lib/Net/Write.pm", "version" : "1.10" }, "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.10" } Net-Write-1.10/LICENSE.Artistic000444001750001750 1373412475521430 15660 0ustar00gomorgomor000000000000 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Net-Write-1.10/lib000755001750001750 012475521430 13453 5ustar00gomorgomor000000000000Net-Write-1.10/lib/Net000755001750001750 012475521430 14201 5ustar00gomorgomor000000000000Net-Write-1.10/lib/Net/Write.pm000444001750001750 243012475521430 15765 0ustar00gomorgomor000000000000# # $Id: Write.pm 2014 2015-03-04 06:16:57Z gomor $ # package Net::Write; use strict; use warnings; require v5.6.1; our $VERSION = '1.10'; 1; __END__ =head1 NAME Net::Write - a portable interface to open and send raw data to network =head1 DESCRIPTION B provides a portable interface to open a network interface, and be able to write raw data directly to the network. It juste provides three methods when a B object has been created for an interface: B, B, B. It is possible to open a network interface to send frames at layer 2 (you craft a frame from link layer), or at layer 3 (you craft a frame from network layer), or at layer 4 (you craft a frame from transport layer). NOTE: not all operating systems support all layer opening. Currently, Windows only supports opening and sending at layer 2. Other Unix systems should be able to open and send at all layers. =head1 SEE ALSO L, L, L, L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Net-Write-1.10/lib/Net/Write000755001750001750 012475521430 15273 5ustar00gomorgomor000000000000Net-Write-1.10/lib/Net/Write/Layer2.pm000444001750001750 536012475521430 17130 0ustar00gomorgomor000000000000# # $Id: Layer2.pm 2005 2015-01-23 06:56:13Z gomor $ # package Net::Write::Layer2; use strict; use warnings; use base qw(Net::Write::Layer); __PACKAGE__->cgBuildIndices; no strict 'vars'; use Net::Pcap; sub new { my $self = shift->SUPER::new( @_, ) or return; if (! $self->[$__dev]) { print STDERR "[-] @{[(caller(0))[3]]}: you must pass `dev' parameter\n"; return; } return $self; } sub open { my $self = shift; my $err; my $pd = Net::Pcap::open_live( $self->[$__dev], 0, 0, 1000, \$err, ); unless ($pd) { print STDERR "[-] @{[(caller(0))[3]]}: Net::Pcap::open_live: ". "@{[$self->dev]}: $err\n"; return; } $self->[$___io] = $pd; return 1; } sub send { my $self = shift; my ($raw) = @_; while (1) { if (Net::Pcap::sendpacket($self->[$___io], $raw) < 0) { if ($!{ENOBUFS}) { $self->cgDebugPrint(2, "ENOBUFS, sleeping for 1 second"); sleep 1; next; } elsif ($!{EHOSTDOWN}) { $self->cgDebugPrint(2, "host is down"); last; } print STDERR "[!] @{[(caller(0))[3]]}: ". Net::Pcap::geterr($self->[$___io])."\n"; return; } last; } return 1; } sub close { my $self = shift; if ($self->[$___io]) { Net::Pcap::close($self->[$___io]); $self->[$___io] = undef; } } 1; __END__ =head1 NAME Net::Write::Layer2 - object for a link layer (layer 2) descriptor =head1 SYNOPSIS use Net::Write::Layer2; my $desc = Net::Write::Layer2->new( dev => 'eth0', ); $desc->open; $desc->send('G'x666); $desc->close; =head1 DESCRIPTION This is the class for creating a layer 2 descriptor. =head1 ATTRIBUTES =over 4 =item B The string specifying network interface to use. Under Unix-like systems, this is in this format: \w+\d+ (example: eth0). Under Windows systems, this is more complex; example: \Device\NPF_{0749A9BC-C665-4C55-A4A7-34AC2FBAB70F} =back =head1 METHODS =over 4 =item B Object constructor. You MUST pass a valid B attribute. There is no default value. Returns undef on error. =item B Open the interface. Returns undef on error. =item B (scalar) Send raw data to the network. =item B Close the descriptor. =back =head1 CAVEATS Writing junk to loopback interface on BSD systems will not work. =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Net-Write-1.10/lib/Net/Write/Layer.pm000444001750001750 2402112475521430 17061 0ustar00gomorgomor000000000000# # $Id: Layer.pm 2014 2015-03-04 06:16:57Z gomor $ # package Net::Write::Layer; use strict; use warnings; use base qw(Exporter Class::Gomor::Array); our @AS = qw( dev dst protocol family _io _sockaddr ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); sub _setIpProtoIpConstant { my $val = 0; if (defined(&IPPROTO_IP)) { $val = &IPPROTO_IP; } elsif ($^O eq 'darwin' || $^O eq 'linux' || $^O eq 'freebsd' || $^O eq 'openbsd' || $^O eq 'netbsd' || $^O eq 'aix') { $val = 0; } eval "use constant NW_IPPROTO_IP => $val;"; } sub _setIpProtoIpv6Constant { my $val = 0; if (defined(&IPPROTO_IPv6)) { $val = &IPPROTO_IPv6; } elsif ($^O eq 'linux' || $^O eq 'freebsd') { $val = 41; } eval "use constant NW_IPPROTO_IPv6 => $val;"; } sub _setIpProtoRawConstant { my $val = 255; if (defined(&IPPROTO_RAW)) { $val = &IPPROTO_RAW; } elsif ($^O eq 'darwin' || $^O eq 'linux' || $^O eq 'freebsd' || $^O eq 'openbsd' || $^O eq 'netbsd' || $^O eq 'aix') { $val = 255; } eval "use constant NW_IPPROTO_RAW => $val;"; } sub _setIpHdrInclConstant { my $val = 2; if (defined(&IP_HDRINCL)) { $val = &IP_HDRINCL; } elsif ($^O eq 'darwin' || $^O eq 'freebsd' || $^O eq 'openbsd' || $^O eq 'netbsd' || $^O eq 'linux' || $^O eq 'aix' || $^O eq 'cygwin') { $val = 2; } elsif ($^O eq 'hpux') { $val = 0x1002; } eval "use constant NW_IP_HDRINCL => $val;"; } sub _setAfinet6Constant { 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(); } 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; } # If still not found, we rely on Socket::GetAddrInfo() eval("use Socket::GetAddrInfo qw(getaddrinfo);"); if ($@) { chomp($@); die("[-] Net::Write: getaddrinfo: not supported, try installing ". "Socket::GetAddrInfo [$@]\n"); } else { *{__PACKAGE__.'::nw_getsaddr'} = sub { my ($dest, $family, $protocol, $socktype) = @_; #print STDERR "*** Fallback on Socket::GetAddrInfo support\n"; my %hints = ( family => $family ); my ($err, @res) = Socket::GetAddrInfo::getaddrinfo($dest, "", \%hints); if ($err) { return _croak("@{[(caller(0))[3]]}: getaddrinfo: $err"); } my $ai = $res[0]; if (! defined($ai)) { return _croak("@{[(caller(0))[3]]}: getaddrinfo: ai undefined"); } return $ai->{addr}; # return sockaddr struct }; } return 1; } BEGIN { my $osname = { cygwin => \&_checkWin32, MSWin32 => \&_checkWin32, }; { no strict 'refs'; *{__PACKAGE__.'::_check'} = $osname->{$^O} || \&_checkOther; } _setIpProtoIpConstant(); _setIpProtoIpv6Constant(); _setIpProtoRawConstant(); _setIpHdrInclConstant(); _setAfinet6Constant(); _setInetPtonSub(); _setGetaddrinfoSub(); } no strict 'vars'; use Socket qw(SOCK_RAW); use IO::Socket; use Net::Pcap; use constant NW_AF_INET => AF_INET(); use constant NW_AF_UNSPEC => AF_UNSPEC(); use constant NW_IPPROTO_ICMPv4 => 1; use constant NW_IPPROTO_TCP => 6; use constant NW_IPPROTO_UDP => 17; use constant NW_IPPROTO_ICMPv6 => 58; our %EXPORT_TAGS = ( constants => [qw( NW_AF_INET NW_AF_INET6 NW_AF_UNSPEC NW_IPPROTO_IP NW_IPPROTO_IPv6 NW_IPPROTO_ICMPv4 NW_IPPROTO_TCP NW_IPPROTO_UDP NW_IPPROTO_ICMPv6 NW_IP_HDRINCL NW_IPPROTO_RAW )], subs => [qw( nw_inet_pton nw_getsaddr )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{constants}}, @{$EXPORT_TAGS{subs}}, ); sub _checkWin32 { return 1; } sub _checkOther { 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 _croak { my ($msg) = @_; print STDERR "[-] $msg\n"; return; } sub open { my $self = shift; my ($hdrincl) = @_; _check() or return; my $saddr = nw_getsaddr($self->[$__dst], $self->[$__family], $self->[$__protocol]) or return _croak("@{[(caller(0))[3]]}: nw_getsaddr: error"); $self->[$___sockaddr] = $saddr; socket(my $s, $self->[$__family], SOCK_RAW(), $self->[$__protocol]) or return _croak("@{[(caller(0))[3]]}: socket: $!"); my $fd = fileno($s) or return _croak("@{[(caller(0))[3]]}: fileno: $!"); if ($hdrincl) { $self->_setIpHdrincl($s, $self->[$__family]) or return _croak("@{[(caller(0))[3]]}: setsockopt: $!"); } my $io = IO::Socket->new; $io->fdopen($fd, 'w') or return _croak("@{[(caller(0))[3]]}: fdopen: $!"); $self->[$___io] = $io; return 1; } sub send { my $self = shift; my ($raw) = @_; while (1) { my $ret = CORE::send($self->_io, $raw, 0, $self->_sockaddr); unless ($ret) { if ($!{ENOBUFS}) { $self->cgDebugPrint(2, "ENOBUFS returned, sleeping for 1 second"); sleep 1; next; } elsif ($!{EHOSTDOWN}) { $self->cgDebugPrint(2, "host is down"); last; } print STDERR "[!] @{[(caller(0))[3]]}: $!\n"; return; } last; } return 1; } sub close { shift->_io->close } 1; __END__ =head1 NAME Net::Write::Layer - base class and constants =head1 SYNOPSIS use Net::Write::Layer qw(:constants); =head1 DESCRIPTION This is the base class for B, B and B modules. It just provides those layers with inheritable attributes, methods and constants. =head1 ATTRIBUTES =over 4 =item B Network interface to use. =item B Target IPv4 or IPv6 address. =item B Transport layer protocol to use (TCP, UDP, ...). =item B Adresse family to use (NW_AF_INET, NW_AF_INET6). =back =head1 METHODS =over 4 =item B Object constructor. Returns undef on error. =item B Open the descriptor, when you are ready to B. Returns undef on error. =item B (scalar) Send the raw data passed as a parameter. Returns undef on failure, true otherwise. =item B Close the descriptor. =item B =item B Internal functions. =back =head1 CONSTANTS =over 4 =item B =item B =item B Address family constants, for use with B attribute. =item B =item B =item B =item B =item B =item B Transport layer protocol constants, for use with B attribute. =item B =item B Mostly used internally. =back =head1 SEE ALSO L, L, L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Net-Write-1.10/lib/Net/Write/Layer3.pm000444001750001750 570412475521430 17133 0ustar00gomorgomor000000000000# # $Id: Layer3.pm 2008 2015-02-10 06:33:53Z gomor $ # package Net::Write::Layer3; use strict; use warnings; use Net::Write::Layer qw(:constants); use base qw(Net::Write::Layer); __PACKAGE__->cgBuildIndices; BEGIN { my $osname = { cygwin => \&_newWin32, MSWin32 => \&_newWin32, }; *new = $osname->{$^O} || \&_newOther; } no strict 'vars'; sub _newWin32 { print STDERR "[-] Not possible to use layer 3 under Windows. Use layer 2 ". "instead.\n"; return; } sub _newOther { my $self = shift->SUPER::new( protocol => NW_IPPROTO_RAW, family => NW_AF_INET, @_, ) or return; if (! $self->[$__dst]) { print STDERR "[-] @{[(caller(0))[3]]}: you must pass `dst' parameter\n"; return; } return $self; } sub open { shift->SUPER::open(1) } sub _setIpHdrincl { my $self = shift; my ($sock, $family) = @_; if ($family == NW_AF_INET) { 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; } 1; __END__ =head1 NAME Net::Write::Layer3 - object for a network layer (layer 3) descriptor =head1 SYNOPSIS use Net::Write::Layer qw(:constants); use Net::Write::Layer3; my $desc = Net::Write::Layer3->new( dst => '192.168.0.1', protocol => NW_IPPROTO_RAW, family => NW_AF_INET, ); $desc->open; $desc->send('G'x666); $desc->close; =head1 DESCRIPTION This is the class for creating a layer 3 descriptor. =head1 ATTRIBUTES =over 4 =item B The target IPv4 or IPv6 address we will send frames to. =item B Address family, see B CONSTANTS section. =item B Transport layer protocol to use, see B CONSTANTS section. =back =head1 METHODS =over 4 =item B Object constructor. You MUST pass a valid B attribute. Default values: protocol: NW_IPPROTO_RAW family: NW_AF_INET Returns undef on error. =item B Open the interface. Returns undef on error. =item B (scalar) Send raw data to the network. =item B Close the descriptor. =back =head1 CAVEATS Sending IPv6 frames does not work under BSD systems. They can't do IP_HDRINCL for IPv6. For now, only Linux supports this (at least, with a 2.6.x kernel). Does not work at all under Win32 systems. They can't send frames at layer 3 (or I don't know how to do that). =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Net-Write-1.10/lib/Net/Write/Layer4.pm000444001750001750 436512475521430 17136 0ustar00gomorgomor000000000000# # $Id: Layer4.pm 2005 2015-01-23 06:56:13Z gomor $ # package Net::Write::Layer4; use strict; use warnings; use Net::Write::Layer qw(:constants); use base qw(Net::Write::Layer); __PACKAGE__->cgBuildIndices; BEGIN { my $osname = { cygwin => \&_newWin32, MSWin32 => \&_newWin32, }; *new = $osname->{$^O} || \&_newOther; } no strict 'vars'; sub _newWin32 { print STDERR "[-] Not possible to use layer 4 under Windows. Use layer 2 ". "instead.\n"; return; } sub _newOther { my $self = shift->SUPER::new( protocol => NW_IPPROTO_TCP, family => NW_AF_INET, @_, ) or return; if (! $self->[$__dst]) { print STDERR "[-] @{[(caller(0))[3]]}: you must pass `dst' parameter\n"; return; } return $self; } 1; __END__ =head1 NAME Net::Write::Layer4 - object for a transport layer (layer 4) descriptor =head1 SYNOPSIS use Net::Write::Layer qw(:constants); use Net::Write::Layer4; my $desc = Net::Write::Layer4->new( dst => '192.168.0.1', protocol => NW_IPPROTO_TCP, family => NW_AF_INET, ); $desc->open; $desc->send('G'x666); $desc->close; =head1 DESCRIPTION This is the class for creating a layer 4 descriptor. =head1 ATTRIBUTES =over 4 =item B The target IPv4 or IPv6 address we will send frames to. =item B Address family, see B CONSTANTS section. =item B Transport layer protocol to use, see B CONSTANTS section. =back =head1 METHODS =over 4 =item B Object constructor. You MUST pass a valid B attribute. Default values: protocol: NW_IPPROTO_TCP family: NW_AF_INET Returns undef on error. =item B Open the interface. Returns undef on error. =item B (scalar) Send raw data to the network. =item B Close the descriptor. =back =head1 CAVEATS Does not work at all under Win32 systems. They can't send frames at layer 4. =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2015, Patrice EGomoRE Auffret You may distribute this module under the terms of the Artistic license. See LICENSE.Artistic file in the source distribution archive. =cut Net-Write-1.10/t000755001750001750 012475521430 13150 5ustar00gomorgomor000000000000Net-Write-1.10/t/03-layer3-open.t000444001750001750 230712475521430 16052 0ustar00gomorgomor000000000000use 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, $@, ); Net-Write-1.10/t/01-use.t000444001750001750 26212475521430 14464 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Write; use Net::Write::Layer qw(:constants :subs); use Net::Write::Layer2; use Net::Write::Layer3; use Net::Write::Layer4; ok(1); Net-Write-1.10/t/01-test-pod.t000444001750001750 23112475521430 15423 0ustar00gomorgomor000000000000eval "use Test::Pod 1.00"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod 1.00 required for testing"); } else { all_pod_files_ok(); } Net-Write-1.10/t/02-inetpton.t000444001750001750 153612475521430 15556 0ustar00gomorgomor000000000000use 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, $@, ); Net-Write-1.10/t/01-pod-coverage.t000444001750001750 100012475521430 16252 0ustar00gomorgomor000000000000eval "use Test::Pod::Coverage tests => 5"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod::Coverage required for testing"); } else { my $trustparents = { coverage_class => 'Pod::Coverage::CountParents' }; pod_coverage_ok("Net::Write", $trustparents); pod_coverage_ok("Net::Write::Layer", $trustparents); pod_coverage_ok("Net::Write::Layer2", $trustparents); pod_coverage_ok("Net::Write::Layer3", $trustparents); pod_coverage_ok("Net::Write::Layer4", $trustparents); } Net-Write-1.10/t/04-getsaddr.t000444001750001750 235412475521430 15514 0ustar00gomorgomor000000000000use 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, $@, ); Net-Write-1.10/examples000755001750001750 012475521430 14523 5ustar00gomorgomor000000000000Net-Write-1.10/examples/layer2.pl000444001750001750 70012475521430 16370 0ustar00gomorgomor000000000000#!/usr/bin/perl # # $Id: layer2.pl 1637 2009-06-10 18:38:50Z gomor $ # use strict; use warnings; my $dev = shift || die("Specify a network interface as a parameter\n"); use Net::Write::Layer2; my $l2 = Net::Write::Layer2->new( dev => $dev, ); use Net::Packet::Consts qw(:eth); use Net::Packet::ETH; my $eth = Net::Packet::ETH->new(type => NP_ETH_TYPE_ARP); $eth->pack; print $eth->print."\n"; $l2->open; $l2->send($eth->raw); $l2->close; Net-Write-1.10/examples/layer3.pl000444001750001750 156212475521430 16420 0ustar00gomorgomor000000000000#!/usr/bin/perl # # $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"); # 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; my $l3 = Net::Write::Layer3->new( dst => $target, ); use Net::Frame::Simple; use Net::Frame::Layer::IPv4; use Net::Frame::Layer::TCP; 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", ); my $oSimple = Net::Frame::Simple->new( layers => [ $ip4, $tcp ], ); print $oSimple->print."\n"; print unpack('H*', $oSimple->raw)."\n"; $l3->open; $l3->send($oSimple->raw); $l3->close; Net-Write-1.10/examples/layer3-ipv6.pl000444001750001750 164412475521430 17303 0ustar00gomorgomor000000000000#!/usr/bin/perl # # $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"); 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, family => NW_AF_INET6, dev => $dev, ); 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, ); my $ip6 = Net::Frame::Layer::IPv6->new( dst => $target, ); my $tcp = Net::Frame::Layer::TCP->new( dst => 22, options => "\x02\x04\x54\x0b", ); my $oSimple = Net::Frame::Simple->new( layers => [ $ip6, $tcp ], ); print $oSimple->print."\n"; print unpack('H*', $oSimple->raw)."\n"; $l3->open; $l3->send($oSimple->raw); $l3->close; Net-Write-1.10/examples/layer4-ipv6.pl000444001750001750 76112475521430 17263 0ustar00gomorgomor000000000000#!/usr/bin/perl # # $Id: layer4-ipv6.pl 1636 2009-06-10 18:38:24Z gomor $ # use strict; use warnings; my $target = shift || die("Specify an IPv6 address as a parameter\n"); use Net::Write::Layer qw(:constants); use Net::Write::Layer4; my $l4 = Net::Write::Layer4->new( dst => $target, protocol => NW_IPPROTO_TCP, family => NW_AF_INET6, ); use Net::Packet::TCP; my $tcp = Net::Packet::TCP->new; $tcp->pack; print $tcp->print."\n"; $l4->open; $l4->send($tcp->raw); $l4->close; Net-Write-1.10/examples/layer4.pl000444001750001750 75312475521430 16402 0ustar00gomorgomor000000000000#!/usr/bin/perl # # $Id: layer4.pl 1636 2009-06-10 18:38:24Z gomor $ # use strict; use warnings; my $target = shift || die("Specify an IPv4 address as a parameter\n"); use Net::Write::Layer qw(:constants); use Net::Write::Layer4; my $l4 = Net::Write::Layer4->new( dst => $target, protocol => NW_IPPROTO_TCP, family => NW_AF_INET, ); use Net::Packet::TCP; my $tcp = Net::Packet::TCP->new; $tcp->pack; print $tcp->print."\n"; $l4->open; $l4->send($tcp->raw); $l4->close;