Net-Frame-1.21000755001750001750 013471433226 12651 5ustar00gomorgomor000000000000Net-Frame-1.21/Build.PL000444001750001750 141713471433226 14305 0ustar00gomorgomor000000000000# # $Id: Build.PL,v 7609c9d085d3 2018/03/15 15:17:19 gomor $ # use strict; use warnings; use Module::Build; my @conditions_modules = (); eval { require Socket; Socket->import( qw(AF_INET6 getaddrinfo getnameinfo inet_pton inet_ntop) ); }; if ($@) { @conditions_modules = ( Socket6 => 0 ); } my $builder = Module::Build->new( module_name => 'Net::Frame', license => 'artistic', dist_author => 'GomoR ', dist_version_from => 'lib/Net/Frame.pm', requires => { 'perl' => '5.6.1', 'Class::Gomor' => '1.00', 'Net::IPv6Addr' => '0', 'Bit::Vector' => '0', 'Socket' => '2.019', @conditions_modules, }, configure_requires => { 'Module::Build' => 0, }, ); $builder->create_build_script; Net-Frame-1.21/Changes000444001750001750 733313471433226 14307 0ustar00gomorgomor000000000000Revision history for Perl extension Net::Frame. 1.21 Thu 23 May 07:54:16 CEST 2019 - update: copyright notice 1.20 Wed 22 May 11:15:40 CEST 2019 - bugfix: tests for IPv4 & IPv6 DNS resolutions => https://rt.cpan.org/Ticket/Display.html?id=129409 1.19 Thu 17 May 13:59:33 CEST 2018 - bugfix: test 13 when DNS getHostIpv6Addr() returns an IPv4 mapped to an IPv6 address => https://rt.cpan.org/Ticket/Display.html?id=124780 1.18 Thu 15 Mar 16:16:39 CET 2018 - bugfix: https://rt.cpan.org/Ticket/Display.html?id=104689 - update: copyright notice 1.17 Sun 7 May 14:21:26 CEST 2017 - update: IP in IP encapsulation should use IPv4 layer type - update: copyright notice 1.16 Mon Nov 16 09:31:06 CET 2015 - bugfix: t/13-gethostsubs.t updated cause gomor.org addresses have changed 1.15 Sun Feb 15 18:09:23 CET 2015 - BUGFIX: IPv4 header length calculation on Mac OS X and OpenBSD => Read: support for OpenBSD and Mac OS X now ok - bugfix: check if inet_ntop/getaddrinfo are *really* supported by trying to use them. 1.14 Wed Jan 28 20:01:48 CET 2015 - BUGFIX: getHostIpv6addr: not working on FreeBSD/Socket because of nasty getaddrinfo() - tests: added tests for getHost* subs and inet* subs 1.13 Wed Jan 28 07:49:11 CET 2015 - BUGFIX: getHostIpv6Addr: use getaddrinfo/getnameinfo from Socket or Socket6 where available => Thanks to Vince 1.12 Tue Jan 20 19:33:06 CET 2015 - bugfix: TCP/UDP computeChecksums() so 6to4 and other encapsulations work => Thanks to Vince - update: copyright notice - update: Kwalitee 1.11 Tue Apr 8 15:33:43 CEST 2014 - bugfix: https://rt.cpan.org/Public/Bug/Display.html?id=94035 - bugfix: on making Socket6 optional, bugfix contributed by Andrew Feren - optimization: convertMac() contributed by Andrew Feren - optimization: inetChecksum() contributed by Andrew Feren 1.10 Mon Mar 10 13:26:53 CET 2014 - UPDATE: makes Socket6 optional, contributed by Andrew Feren - update: copyright notice 1.09 Wed Jan 25 22:48:18 CET 2012 - UPDATE: %Next in UDP and TCP layers are now empty by default. The developper who wants to add a new layer 7 seven will have to fill the variable straight from his module. 1.08 Sat Jan 14 09:49:09 CET 2012 - bugfix: TCP and UDP checksum computation when using another Net::Frame::Layer object (instead of plain payload). => Thanks to Vince - update: copyright notice 1.07 Sun Feb 20 17:49:11 CET 2011 - bugfix: in ARP pack/unpack - bugfix: AF_INET6 constant badly used - UPDATE: IGMPv4 renamed to IGMP - update: copyright notice 1.06 Sat May 23 15:33:44 CEST 2009 - update: TCP computeChecksums() - update: UDP computeChecksums() - update: IPv4 added UDPLite support - update: IPv4 computeLengths() - update: copyright notice 1.05 Sun Nov 9 22:51:39 CET 2008 - new: computeLengths() in ETH, to use 802.3 easily - new: $Next global variable in each module to allow customized encapsulation() => mainly used to encapsulate application layer procotols - new: UDP now have some $Next values (DHCP, RIPv1, HSRP) - new: added link to a MPLS layer from ETH and SLL layers - bugfix: pad TCP and UDP raw data if less than required length 1.04 Mon Mar 26 23:19:44 CEST 2007 - bugfix: TCP: computeLengths() with options - update: ETH: more checks for next layer decoding (LLC) 1.03 Wed Jan 3 22:44:59 CET 2007 - update: Net::Libdnet no more required 1.02 Thu Dec 21 23:51:07 CET 2006 - bugfix: forgot to load some subs for IPv6 subs in Layer.pm 1.01 Sun Dec 17 17:45:32 CET 2006 - UPDATE: moved all layers to Net::Frame::Layer::* namespace - bugfix: IPv6 layer handling in computeLengths() for TCP layer 1.00 Sat Dec 9 18:39:09 CET 2006 - first public release Net-Frame-1.21/LICENSE000444001750001750 26513471433226 13776 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-Frame-1.21/LICENSE.Artistic000444001750001750 1373413471433226 15624 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-Frame-1.21/MANIFEST000444001750001750 152713471433226 14144 0ustar00gomorgomor000000000000Build.PL Changes examples/arp-lookup.pl examples/build-tcp-syn.pl examples/pack-eth-ipv4-tcp-compute.pl examples/pack-eth-ipv4-tcp.pl examples/resolv-ipv6.pl examples/send-recv-tcp.pl examples/send-recv-udp.pl examples/send-tcp-with-padding.pl examples/send-tcp-with-payload.pl examples/unpack-eth-ipv4-tcp.pl lib/Net/Frame/Layer/ARP.pm lib/Net/Frame/Layer/ETH.pm lib/Net/Frame/Layer/IPv4.pm lib/Net/Frame/Layer/NULL.pm lib/Net/Frame/Layer.pm lib/Net/Frame/Layer/PPP.pm lib/Net/Frame/Layer/RAW.pm lib/Net/Frame/Layer/SLL.pm lib/Net/Frame/Layer/TCP.pm lib/Net/Frame/Layer/UDP.pm lib/Net/Frame.pm LICENSE LICENSE.Artistic Makefile.PL MANIFEST This list of files README t/01-use.t t/02-pod-coverage.t t/03-test-pod.t t/04-eth.t t/05-arp.t t/06-ipv4.t t/07-raw.t t/08-sll.t t/09-tcp.t t/10-null.t t/11-udp.t t/12-ppp.t t/13-gethostsubs.t META.yml META.json Net-Frame-1.21/META.json000444001750001750 367713471433226 14444 0ustar00gomorgomor000000000000{ "abstract" : "the base framework for frame crafting", "author" : [ "GomoR " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4224", "license" : [ "artistic_1" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Frame", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0" } }, "runtime" : { "requires" : { "Bit::Vector" : "0", "Class::Gomor" : "1.00", "Net::IPv6Addr" : "0", "Socket" : "2.019", "perl" : "v5.6.1" } } }, "provides" : { "Net::Frame" : { "file" : "lib/Net/Frame.pm", "version" : "1.21" }, "Net::Frame::Layer" : { "file" : "lib/Net/Frame/Layer.pm" }, "Net::Frame::Layer::ARP" : { "file" : "lib/Net/Frame/Layer/ARP.pm" }, "Net::Frame::Layer::ETH" : { "file" : "lib/Net/Frame/Layer/ETH.pm" }, "Net::Frame::Layer::IPv4" : { "file" : "lib/Net/Frame/Layer/IPv4.pm" }, "Net::Frame::Layer::NULL" : { "file" : "lib/Net/Frame/Layer/NULL.pm" }, "Net::Frame::Layer::PPP" : { "file" : "lib/Net/Frame/Layer/PPP.pm" }, "Net::Frame::Layer::RAW" : { "file" : "lib/Net/Frame/Layer/RAW.pm" }, "Net::Frame::Layer::SLL" : { "file" : "lib/Net/Frame/Layer/SLL.pm" }, "Net::Frame::Layer::TCP" : { "file" : "lib/Net/Frame/Layer/TCP.pm" }, "Net::Frame::Layer::UDP" : { "file" : "lib/Net/Frame/Layer/UDP.pm" } }, "release_status" : "stable", "resources" : { "license" : [ "http://www.perlfoundation.org/artistic_license_1_0" ] }, "version" : "1.21", "x_serialization_backend" : "JSON::PP version 2.27400_02" } Net-Frame-1.21/META.yml000444001750001750 246313471433226 14264 0ustar00gomorgomor000000000000--- abstract: 'the base framework for frame crafting' author: - 'GomoR ' build_requires: {} configure_requires: Module::Build: '0' dynamic_config: 1 generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010' license: artistic meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-Frame provides: Net::Frame: file: lib/Net/Frame.pm version: '1.21' Net::Frame::Layer: file: lib/Net/Frame/Layer.pm Net::Frame::Layer::ARP: file: lib/Net/Frame/Layer/ARP.pm Net::Frame::Layer::ETH: file: lib/Net/Frame/Layer/ETH.pm Net::Frame::Layer::IPv4: file: lib/Net/Frame/Layer/IPv4.pm Net::Frame::Layer::NULL: file: lib/Net/Frame/Layer/NULL.pm Net::Frame::Layer::PPP: file: lib/Net/Frame/Layer/PPP.pm Net::Frame::Layer::RAW: file: lib/Net/Frame/Layer/RAW.pm Net::Frame::Layer::SLL: file: lib/Net/Frame/Layer/SLL.pm Net::Frame::Layer::TCP: file: lib/Net/Frame/Layer/TCP.pm Net::Frame::Layer::UDP: file: lib/Net/Frame/Layer/UDP.pm requires: Bit::Vector: '0' Class::Gomor: '1.00' Net::IPv6Addr: '0' Socket: '2.019' perl: v5.6.1 resources: license: http://www.perlfoundation.org/artistic_license_1_0 version: '1.21' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Net-Frame-1.21/Makefile.PL000444001750001750 126113471433226 14760 0ustar00gomorgomor000000000000# # $Id: Makefile.PL,v 7609c9d085d3 2018/03/15 15:17:19 gomor $ # use ExtUtils::MakeMaker; require v5.6.1; my @conditions_modules = (); eval { require Socket; Socket->import( qw(AF_INET6 getaddrinfo getnameinfo inet_pton inet_ntop) ); }; if ($@) { @conditions_modules = ( Socket6 => 0 ); } WriteMakefile( NAME => 'Net::Frame', VERSION_FROM => 'lib/Net/Frame.pm', LICENSE => 'artistic', ABSTRACT_FROM => 'lib/Net/Frame.pm', AUTHOR => 'GomoR ', MIN_PERL_VERSION => '5.6.1', PREREQ_PM => { Class::Gomor => '1.00', Net::IPv6Addr => 0, Bit::Vector => 0, Socket => '2.019', @conditions_modules, }, ); Net-Frame-1.21/README000444001750001750 130613471433226 13666 0ustar00gomorgomor000000000000Net::Frame ========== 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 Bit::Vector Class::Gomor Net::IPv6Addr Socket Socket6 (optional if Socket module supports IPv6) GETTING HELP A mailing list is available for all questions concerning Net::Frame::*. Here is the link: https://www.secure-side.com/lists/mailman/listinfo/netframe 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-2019, Patrice Auffret Net-Frame-1.21/examples000755001750001750 013471433226 14467 5ustar00gomorgomor000000000000Net-Frame-1.21/examples/arp-lookup.pl000444001750001750 174613471433226 17262 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $oDump; my $target = shift || die("Specify target\n"); use Net::Write::Layer2; use Net::Frame::Device; use Net::Frame::Simple; use Net::Frame::Dump::Online; use Net::Frame::Layer::ETH qw(:consts); use Net::Frame::Layer::ARP; my $oDevice = Net::Frame::Device->new(target => $target); my $eth = Net::Frame::Layer::ETH->new( src => $oDevice->mac, type => NF_ETH_TYPE_ARP, ); my $arp = Net::Frame::Layer::ARP->new( src => $oDevice->mac, srcIp => $oDevice->ip, dstIp => $target, ); my $oWrite = Net::Write::Layer2->new( dev => $oDevice->dev, ); $oDump = Net::Frame::Dump::Online->new( dev => $oDevice->dev, ); $oDump->start; my $oSimple = Net::Frame::Simple->new( layers => [ $eth, $arp ], ); $oWrite->open; $oSimple->send($oWrite); $oWrite->close; until ($oDump->timeout) { if (my $recv = $oSimple->recv($oDump)) { print $recv->print."\n"; last; } } END { $oDump && $oDump->isRunning && $oDump->stop } Net-Frame-1.21/examples/build-tcp-syn.pl000444001750001750 54213471433226 17634 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; use Net::Frame::Layer::IPv4; use Net::Frame::Layer::TCP; use Net::Frame::Simple; my $ip4 = Net::Frame::Layer::IPv4->new; my $tcp = Net::Frame::Layer::TCP->new( options => "\x02\x04\x54\x0b", ); my $oSimple = Net::Frame::Simple->new( layers => [ $ip4, $tcp ], ); print unpack('H*', $oSimple->raw)."\n"; Net-Frame-1.21/examples/pack-eth-ipv4-tcp-compute.pl000444001750001750 105513471433226 21774 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; use Net::Frame::Layer::ETH; use Net::Frame::Layer::IPv4; use Net::Frame::Layer::TCP; my $eth = Net::Frame::Layer::ETH->new; my $ip4 = Net::Frame::Layer::IPv4->new; my $tcp = Net::Frame::Layer::TCP->new( options => "\x02\x04\x54\x0b", ); $tcp->computeLengths; $tcp->computeChecksums({ type => 'IPv4', src => $ip4->src, dst => $ip4->dst, }); $ip4->computeLengths({ payloadLength => $tcp->getLength }); $ip4->computeChecksums; print $eth->print."\n"; print $ip4->print."\n"; print $tcp->print."\n"; Net-Frame-1.21/examples/pack-eth-ipv4-tcp.pl000444001750001750 70713471433226 20305 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; use Net::Frame::Layer::ETH; use Net::Frame::Layer::IPv4; use Net::Frame::Layer::TCP; use Net::Frame::Simple; my $eth = Net::Frame::Layer::ETH->new; my $ip4 = Net::Frame::Layer::IPv4->new; my $tcp = Net::Frame::Layer::TCP->new( options => "\x02\x04\x54\x0b", ); my $oSimple = Net::Frame::Simple->new( layers => [ $eth, $ip4, $tcp ], ); print $oSimple->print."\n"; print unpack('H*', $oSimple->raw)."\n"; Net-Frame-1.21/examples/resolv-ipv6.pl000444001750001750 17313471433226 17336 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; use Net::Frame::Layer qw(:subs); print getHostIpv6Addr('www.google.com')."\n"; Net-Frame-1.21/examples/send-recv-tcp.pl000444001750001750 202513471433226 17632 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $target = shift || die("Pass target as first param\n"); my $port = shift || die("Pass port as second param\n"); use Net::Frame::Device; use Net::Write::Layer3; use Net::Frame::Simple; use Net::Frame::Dump::Online; use Net::Frame::Layer::IPv4; use Net::Frame::Layer::TCP; my $oDevice = Net::Frame::Device->new(target => $target); my $ip4 = Net::Frame::Layer::IPv4->new( src => $oDevice->ip, dst => $target, ); my $tcp = Net::Frame::Layer::TCP->new( dst => $port, options => "\x02\x04\x54\x0b", payload => 'test', ); my $oWrite = Net::Write::Layer3->new(dst => $target); my $oDump = Net::Frame::Dump::Online->new(dev => $oDevice->dev); $oDump->start; my $oSimple = Net::Frame::Simple->new( layers => [ $ip4, $tcp ], ); print "raw: ".unpack('H*', $oSimple->raw)."\n"; $oWrite->open; $oSimple->send($oWrite); $oWrite->close; until ($oDump->timeout) { if (my $recv = $oSimple->recv($oDump)) { print "RECV:\n".$recv->print."\n"; last; } } $oDump->stop; Net-Frame-1.21/examples/send-recv-udp.pl000444001750001750 203113471433226 17631 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $target = shift || die("Pass target as first param\n"); my $port = shift || die("Pass port as second param\n"); use Net::Frame::Device; use Net::Write::Layer3; use Net::Frame::Simple; use Net::Frame::Dump::Online; use Net::Frame::Layer::IPv4 qw(:consts); use Net::Frame::Layer::UDP; my $oDevice = Net::Frame::Device->new(target => $target); my $ip4 = Net::Frame::Layer::IPv4->new( src => $oDevice->ip, dst => $target, protocol => NF_IPv4_PROTOCOL_UDP, ); my $udp = Net::Frame::Layer::UDP->new( dst => $port, payload => 'test', ); my $oWrite = Net::Write::Layer3->new(dst => $target); my $oDump = Net::Frame::Dump::Online->new( dev => $oDevice->dev, filter => 'udp or icmp', ); $oDump->start; my $oSimple = Net::Frame::Simple->new( layers => [ $ip4, $udp ], ); $oWrite->open; $oSimple->send($oWrite); $oWrite->close; until ($oDump->timeout) { if (my $recv = $oSimple->recv($oDump)) { print "RECV:\n".$recv->print."\n"; last; } } $oDump->stop; Net-Frame-1.21/examples/send-tcp-with-padding.pl000444001750001750 132213471433226 21251 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; my $target = shift || die("Specify target\n"); use Net::Frame::Device; use Net::Frame::Simple; use Net::Frame::Layer::ETH; use Net::Frame::Layer::IPv4; use Net::Frame::Layer::TCP; my $oDevice = Net::Frame::Device->new(target => $target); my $eth = Net::Frame::Layer::ETH->new( src => $oDevice->mac, dst => $oDevice->lookupMac($target), ); my $ip4 = Net::Frame::Layer::IPv4->new( src => $oDevice->ip, dst => $target, ); my $tcp = Net::Frame::Layer::TCP->new( options => "\x02\x04\x54\x0b", ); my $oSimple = Net::Frame::Simple->new( layers => [ $eth, $ip4, $tcp ], padding => 'G'x2, ); print $oSimple->print."\n"; print unpack('H*', $oSimple->raw)."\n"; Net-Frame-1.21/examples/send-tcp-with-payload.pl000444001750001750 62413471433226 21260 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; use Net::Frame::Layer::IPv4; use Net::Frame::Layer::TCP; use Net::Frame::Simple; my $ip4 = Net::Frame::Layer::IPv4->new; my $tcp = Net::Frame::Layer::TCP->new( options => "\x02\x04\x54\x0b", payload => 'test', ); my $oSimple = Net::Frame::Simple->new( layers => [ $ip4, $tcp ], ); print $oSimple->print."\n"; print unpack('H*', $oSimple->raw)."\n"; Net-Frame-1.21/examples/unpack-eth-ipv4-tcp.pl000444001750001750 51113471433226 20641 0ustar00gomorgomor000000000000#!/usr/bin/perl use strict; use warnings; use Net::Frame::Simple; my $raw = pack('H*', "ffffffffffff00000000000008004500001483d80000800600007f0000017f0000018e100000212c69e5000000006002ffff000000000204540b"); my $oSimple = Net::Frame::Simple->new( raw => $raw, firstLayer => 'ETH', ); print $oSimple->print."\n"; Net-Frame-1.21/lib000755001750001750 013471433226 13417 5ustar00gomorgomor000000000000Net-Frame-1.21/lib/Net000755001750001750 013471433226 14145 5ustar00gomorgomor000000000000Net-Frame-1.21/lib/Net/Frame.pm000444001750001750 502413471433226 15673 0ustar00gomorgomor000000000000# # $Id: Frame.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame; use strict; use warnings; our $VERSION = '1.21'; 1; __END__ =head1 NAME Net::Frame - the base framework for frame crafting =head1 SYNOPSIS # Basic example, send a TCP SYN to a target, using all modules # the framework comprises. It also waits for the response, and # prints it. my $target = '192.168.0.1'; my $port = 22; use Net::Frame::Device; use Net::Write::Layer3; use Net::Frame::Simple; use Net::Frame::Dump::Online; use Net::Frame::Layer::IPv4; use Net::Frame::Layer::TCP; my $oDevice = Net::Frame::Device->new(target => $target); my $ip4 = Net::Frame::Layer::IPv4->new( src => $oDevice->ip, dst => $target, ); my $tcp = Net::Frame::Layer::TCP->new( dst => $port, options => "\x02\x04\x54\x0b", payload => 'test', ); my $oWrite = Net::Write::Layer3->new(dst => $target); my $oDump = Net::Frame::Dump::Online->new(dev => $oDevice->dev); $oDump->start; my $oSimple = Net::Frame::Simple->new( layers => [ $ip4, $tcp ], ); $oWrite->open; $oSimple->send($oWrite); $oWrite->close; until ($oDump->timeout) { if (my $recv = $oSimple->recv($oDump)) { print "RECV:\n".$recv->print."\n"; last; } } $oDump->stop; =head1 DESCRIPTION B is a fork of B. The goal here was to greatly simplify the use of the frame crafting framework. B does many things undercover, and it was difficult to document all the thingies. Also, B may suffer from unease of use, because frames were assembled using layers stored in L2, L3, L4 and L7 attributes. B removes all this, and is split into different modules, for those who only want to use part of the framework, and not whole framework. Finally, anyone can create a layer, and put it on his CPAN space, because of the modularity B offers. For an example, see B on my CPAN space. B does ship with basic layers, to start playing. =head1 SEE ALSO L, L, L, L, L, L, L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame000755001750001750 013471433226 15177 5ustar00gomorgomor000000000000Net-Frame-1.21/lib/Net/Frame/Layer.pm000444001750001750 3022413471433226 16767 0ustar00gomorgomor000000000000# # $Id: Layer.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer; use strict; use warnings; require Class::Gomor::Array; require Exporter; our @ISA = qw(Class::Gomor::Array Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_LAYER_NONE NF_LAYER_UNKNOWN NF_LAYER_NOT_AVAILABLE )], subs => [qw( getHostIpv4Addr getHostIpv4Addrs getHostIpv6Addr inetAton inetNtoa inet6Aton inet6Ntoa getRandomHighPort getRandom32bitsInt getRandom16bitsInt convertMac inetChecksum )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, @{$EXPORT_TAGS{subs}}, ); use constant NF_LAYER_NONE => 0; use constant NF_LAYER_UNKNOWN => 1; use constant NF_LAYER_NOT_AVAILABLE => 2; our @AS = qw( raw payload nextLayer ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); no strict 'vars'; use Carp; sub new { shift->SUPER::new(nextLayer => NF_LAYER_NONE, @_) } sub layer { my $layer = ref(shift); $layer =~ s/^Net::Frame::Layer:://; $layer; } # XXX: may use some optimizations sub pack { my $self = shift; my ($fmt, @args) = @_; my $res; eval { $res = CORE::pack($fmt, @args) }; $@ ? do { carp("@{[ref($self)]}: unable to pack structure\n"); undef } : $res; } sub unpack { my $self = shift; my ($fmt, $arg) = @_; my @res; eval { @res = CORE::unpack($fmt, $arg) }; $@ ? do { carp("@{[ref($self)]}: unable to unpack structure\n"); () } : @res; } sub getPayloadLength { my $self = shift; $self->payload ? length($self->payload) : 0; } sub encapsulate { shift->nextLayer } sub computeLengths { 1 } sub computeChecksums { 1 } sub print { $self->layer.': to implement' } sub getLength { 0 } sub dump { CORE::unpack('H*', shift->raw) } # # Useful subroutines # # Load AF_INET and default imports from Socket. Safe back to at least 5.8.8. use Socket qw(:DEFAULT AF_INET); sub _setInet6Sub { no strict 'refs'; my $inetp_found = 0; # Check Socket against some IPv6 functions and constants. eval { require Socket; Socket->import(qw(AF_INET6 inet_pton inet_ntop)); }; if (! $@) { # Socket has support for required functions and constants. *{__PACKAGE__.'::_inet_pton'} = \&Socket::inet_pton; *{__PACKAGE__.'::_inet_ntop'} = \&Socket::inet_ntop; $inetp_found = 1; } # Fallback to Socket6 if (! $inetp_found) { eval { require Socket6; Socket6->import(qw(AF_INET6 inet_pton inet_ntop)); }; if (! $@) { # Socket6 has support for required functions and constants. *{__PACKAGE__.'::_inet_pton'} = \&Socket6::inet_pton; *{__PACKAGE__.'::_inet_ntop'} = \&Socket6::inet_ntop; } } # Unfortunately, we have to test if inet_ntop()/inet_pton() works (i.e., are implemented) # If no support for inet_ntop/inet_pton, we branch to fake functions. if ($inetp_found) { eval { # inet_pton() may exist, but die with: # inet_pton not implemented on this architecture _inet_pton(AF_INET6(), "::1"); }; if ($@) { print "[!] inet_pton support: $@\n"; *{__PACKAGE__.'::_inet_pton'} = sub { return 0; }; *{__PACKAGE__.'::_inet_ntop'} = sub { return 0; }; } else { return 1; # OK } } die("[-] Net::Frame: inet_pton/inet_ntop: not supported by Socket nor Socket6: ". "try upgrading your Perl version or Socket/Socket6 modules.\n"); } sub _setGetAddressSub { no strict 'refs'; my $getaddr_found = 0; # Check Socket against some IPv6 functions and constants. eval { require Socket; Socket->import(qw(getaddrinfo getnameinfo AF_INET6)); }; if (! $@) { # Socket has support for required functions and constants. *{__PACKAGE__.'::_getAddress'} = sub { my ($name) = @_; #print STDERR "*** Socket supports IPv6 OK\n"; my %hints = ( family => Socket::AF_INET6(), ); my ($err, @res) = Socket::getaddrinfo($name, '', \%hints); if ($err) { carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname: getaddrinfo: $err\n"); return; } if (@res > 0) { my $h = $res[0]; my ($err, $ipv6) = Socket::getnameinfo( $h->{addr}, Socket::NI_NUMERICHOST() | Socket::NI_NUMERICSERV() ); if ($err) { carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname: getnameinfo: $err\n"); return; } return $ipv6; } else { carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname: getaddrinfo: $!\n"); return; } }; $getaddr_found = 1; } # Fallback to Socket6 if (! $getaddr_found) { eval { require Socket6; Socket6->import(qw(getaddrinfo getnameinfo AF_INET6)); }; if (! $@) { # Socket6 has support for required functions and constants. *{__PACKAGE__.'::_getAddress'} = sub { my ($name) = @_; #print STDERR "*** Fallback to Socket6 support\n"; my @res = Socket6::getaddrinfo($name, '', Socket6::AF_INET6(), SOCK_STREAM); if (@res >= 5) { my ($ipv6) = Socket6::getnameinfo( $res[3], Socket6::NI_NUMERICHOST() | Socket6::NI_NUMERICSERV() ); return $ipv6; } }; } $getaddr_found = 1; } # Unfortunately, we have to test if INET6 family is supported # If no support, we branch to fake functions. if ($getaddr_found) { eval { # getaddrinfo() may exist, but die with: # getaddrinfo: ai_family not supported _getAddress("::1"); }; if ($@) { print "[!] getaddrinfo support: $@\n"; *{__PACKAGE__.'::_getAddress'} = sub { return 0; }; *{__PACKAGE__.'::_getAddress'} = sub { return 0; }; } else { return 1; # OK } } die("[-] Net::Frame: getaddrinfo/getnameinfo: not supported by Socket nor Socket6: ". "try upgrading your Perl version or Socket/Socket6 modules.\n"); } BEGIN { _setInet6Sub(); _setGetAddressSub(); } require Net::IPv6Addr; sub getHostIpv4Addr { my ($name) = @_; # No address given if (! defined($name)) { return; } # Already an IPv4 address if ($name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { return $name; } my @addrs = (gethostbyname($name))[4]; @addrs ? return join('.', CORE::unpack('C4', $addrs[0])) : carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n"); # Error return; } sub getHostIpv4Addrs { my ($name) = @_; # No address given if (! defined($name)) { return; } # Already an IPv4 address if ($name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { return $name; } my @addrs = (gethostbyname($name))[4]; @addrs ? return @addrs : carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n"); # Error return (); } sub getHostIpv6Addr { my ($name) = @_; # No address given if (! defined($name)) { return; } # Already an IPv6 address if (Net::IPv6Addr::is_ipv6($name)) { return $name; } my $ipv6 = _getAddress($name); if (! defined($ipv6)) { carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n"); return; } $ipv6 =~ s/%.*$//; return $ipv6; } sub inetAton { Socket::inet_aton(shift()) } sub inetNtoa { Socket::inet_ntoa(shift()) } sub inet6Aton { _inet_pton(AF_INET6, shift()) } sub inet6Ntoa { _inet_ntop(AF_INET6, shift()) } sub getRandomHighPort { my $highPort = int rand 0xffff; $highPort += 1024 if $highPort < 1025; $highPort; } sub getRandom32bitsInt { int rand 0xffffffff } sub getRandom16bitsInt { int rand 0xffff } sub convertMac { return lc(join(':', $_[0] =~ /../g)); } sub inetChecksum { my ($phpkt) = @_; $phpkt .= "\x00" if length($phpkt) % 2; my $len = length $phpkt; my $nshort = $len / 2; my $checksum = 0; $checksum += $_ for CORE::unpack("S$nshort", $phpkt); # XXX: This line never does anything as the lenth was made even above. Currently testing it breaks nothing. #$checksum += CORE::unpack('C', substr($phpkt, $len - 1, 1)) if $len % 2; $checksum = ($checksum >> 16) + ($checksum & 0xffff); CORE::unpack('n', CORE::pack('S', ~(($checksum >> 16) + $checksum) & 0xffff), ); } 1; __END__ =head1 NAME Net::Frame::Layer - base class for all layer objects =head1 DESCRIPTION This is the base class for all other layer modules. It provides those layers with inheritable attributes, methods, constants and useful subroutines. =head1 ATTRIBUTES =over 4 =item B Stores the raw layer (as captured from the network, or packed to send to network). =item B Stores what is not part of the layer, that is the encapsulated part to be decoded by upper layers. =item B User definable next layer. It may be used to define custom protocols. =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. =item B Returns the string describing the layer (example: 'IPv4' for a B object). =item B =item B Generally, when a layer is built, some attributes are not yet known until all layers that will be assembled are known. Those methods computes various lengths and checksums attributes found in a specific layer. Return 1 on success, undef otherwise. The usage depends from layer to layer, so see related documentation. Also note that in most cases, you will need to call B before B, because checksums may depend upon lengths. =item B Packs all attributes into a raw format, in order to inject to network. Returns the raw packed string on success, undef otherwise. Result is stored into B attribute. =item B Unpacks raw data from network and stores attributes into the object. Returns B<$self> on success, undef otherwise. =item B Returns the next layer type (parsed from payload). This is the same string as returned by B method. =item B Returns the layer length in bytes. =item B Returns the length of layer's payload in bytes. =item B Just returns a string in a human readable format describing attributes found in the layer. =item B Just returns a string in hexadecimal format which is how the layer appears on the network. =back =head1 USEFUL SUBROUTINES Load them: use Net::Frame::Layer qw(:subs); =over 4 =item B (hostname) Resolves IPv4 address of specified hostname. =item B (hostname) Same as above, but returns an array of IPv4 addresses. =item B (hostname) Resolves IPv6 address of specified hostname. =item B (IPv6 address) Takes IPv6 address and returns the network form. =item B (IPv6 network form) Takes IPv6 address in network format, and returns the IPv6 human form. =item B (IPv4 address) =item B (IPv4 network form) Same as for IPv6, but for IPv4 addresses. =item B (MAC network form) Takes a MAC address from network form, and returns the human form. =item B =item B Returns respectively a random 16 bits integer, and a random 32 bits integer. =item B Returns a random high port (> 1024). =item B (pseudo header format) Will take a frame in pseudo header format, and compute the INET checksum. =back =head1 CONSTANTS Load them: use Net::Frame::Layer qw(:consts); =over 4 =item B =item B =item B =back =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer000755001750001750 013471433226 16253 5ustar00gomorgomor000000000000Net-Frame-1.21/lib/Net/Frame/Layer/ARP.pm000444001750001750 2004413471433226 17410 0ustar00gomorgomor000000000000# # $Id: ARP.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::ARP; use strict; use warnings; use Net::Frame::Layer qw(:consts :subs); require Exporter; our @ISA = qw(Net::Frame::Layer Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_ARP_HDR_LEN NF_ARP_HTYPE_ETH NF_ARP_PTYPE_IPv4 NF_ARP_PTYPE_IPv6 NF_ARP_HSIZE_ETH NF_ARP_PSIZE_IPv4 NF_ARP_PSIZE_IPv6 NF_ARP_OPCODE_REQUEST NF_ARP_OPCODE_REPLY NF_ARP_ADDR_BROADCAST )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); use constant NF_ARP_HDR_LEN => 28; use constant NF_ARP_HTYPE_ETH => 0x0001; use constant NF_ARP_PTYPE_IPv4 => 0x0800; use constant NF_ARP_PTYPE_IPv6 => 0x86dd; use constant NF_ARP_HSIZE_ETH => 0x06; use constant NF_ARP_PSIZE_IPv4 => 0x04; use constant NF_ARP_PSIZE_IPv6 => 0x16; use constant NF_ARP_OPCODE_REQUEST => 0x0001; use constant NF_ARP_OPCODE_REPLY => 0x0002; use constant NF_ARP_ADDR_BROADCAST => '00:00:00:00:00:00'; our @AS = qw( hType pType hSize pSize opCode src srcIp dst dstIp ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); no strict 'vars'; sub new { my $self = shift->SUPER::new( hType => NF_ARP_HTYPE_ETH, pType => NF_ARP_PTYPE_IPv4, hSize => NF_ARP_HSIZE_ETH, pSize => NF_ARP_PSIZE_IPv4, opCode => NF_ARP_OPCODE_REQUEST, src => '00:00:00:00:00:00', dst => NF_ARP_ADDR_BROADCAST, srcIp => '127.0.0.1', dstIp => '127.0.0.1', @_, ); $self->[$__src] = lc($self->[$__src]) if $self->[$__src]; $self->[$__dst] = lc($self->[$__dst]) if $self->[$__dst]; return $self; } sub getLength { my $self = shift; my $len = NF_ARP_HDR_LEN; $len += 24 if $self->[$__pType] == NF_ARP_PTYPE_IPv6; return $len; } sub pack { my $self = shift; (my $srcMac = $self->[$__src]) =~ s/://g; (my $dstMac = $self->[$__dst]) =~ s/://g; # IPv4 packing if ($self->[$__pType] == NF_ARP_PTYPE_IPv4) { $self->[$__raw] = $self->SUPER::pack('nnCCnH12a4H12a4', $self->[$__hType], $self->[$__pType], $self->[$__hSize], $self->[$__pSize], $self->[$__opCode], $srcMac, inetAton($self->[$__srcIp]), $dstMac, inetAton($self->[$__dstIp]), ) or return; } # IPv6 packing else { $self->[$__raw] = $self->SUPER::pack('nnCCnH12a*H12a*', $self->[$__hType], $self->[$__pType], $self->[$__hSize], $self->[$__pSize], $self->[$__opCode], $srcMac, inet6Aton($self->[$__srcIp]), $dstMac, inet6Aton($self->[$__dstIp]), ) or return; } return $self->[$__raw]; } sub unpack { my $self = shift; my ($hType, $pType, $tail) = $self->SUPER::unpack('nn a*', $self->[$__raw]) or return; my ($hSize, $pSize, $opCode, $srcMac, $srcIp, $dstMac, $dstIp, $payload); # IPv4 unpacking if ($pType == NF_ARP_PTYPE_IPv4) { ($hSize, $pSize, $opCode, $srcMac, $srcIp, $dstMac, $dstIp, $payload) = $self->SUPER::unpack('CCnH12a4H12a4 a*', $tail) or return; $self->[$__srcIp] = inetNtoa($srcIp); $self->[$__dstIp] = inetNtoa($dstIp); } # IPv6 unpacking else { ($hSize, $pSize, $opCode, $srcMac, $srcIp, $dstMac, $dstIp, $payload) = $self->SUPER::unpack('CCnH12a16H12a16 a*', $tail) or return; $self->[$__srcIp] = inet6Ntoa($srcIp); $self->[$__dstIp] = inet6Ntoa($dstIp); } $self->[$__hType] = $hType; $self->[$__pType] = $pType; $self->[$__hSize] = $hSize; $self->[$__pSize] = $pSize; $self->[$__opCode] = $opCode; $self->[$__src] = convertMac($srcMac); $self->[$__dst] = convertMac($dstMac); $self->[$__payload] = $payload; return $self; } sub getKey { shift->layer } sub getKeyReverse { shift->layer } sub match { my $self = shift; my ($with) = @_; ($self->[$__opCode] == NF_ARP_OPCODE_REQUEST) && ($with->[$__opCode] == NF_ARP_OPCODE_REPLY) && ($with->[$__dst] eq $self->[$__src]) && ($with->[$__srcIp] eq $self->[$__dstIp]) && ($with->[$__dstIp] eq $self->[$__srcIp]); } sub encapsulate { my $self = shift; return $self->[$__nextLayer]; } sub print { my $self = shift; my $l = $self->layer; sprintf "$l: hType:0x%04x pType:0x%04x hSize:0x%02x pSize:0x%02x". " opCode:0x%04x\n". "$l: src:%s srcIp:%s\n". "$l: dst:%s dstIp:%s", $self->[$__hType], $self->[$__pType], $self->[$__hSize], $self->[$__pSize], $self->[$__opCode], $self->[$__src], $self->[$__srcIp], $self->[$__dst], $self->[$__dstIp]; } 1; __END__ =head1 NAME Net::Frame::Layer::ARP - Address Resolution Protocol layer object =head1 SYNOPSIS use Net::Frame::Layer::ARP qw(:consts); # Build a layer my $layer = Net::Frame::Layer::ARP->new( hType => NF_ARP_HTYPE_ETH, pType => NF_ARP_PTYPE_IPv4, hSize => NF_ARP_HSIZE_ETH, pSize => NF_ARP_PSIZE_IPv4, opCode => NF_ARP_OPCODE_REQUEST, src => '00:00:00:00:00:00', dst => NF_ARP_ADDR_BROADCAST, srcIp => '127.0.0.1', dstIp => '127.0.0.1', ); $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::ARP->new(raw => $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the ARP layer. RFC: ftp://ftp.rfc-editor.org/in-notes/rfc826.txt See also B for other attributes and methods. =head1 ATTRIBUTES =over 4 =item B =item B Hardware and protocol address types. =item B =item B Hardware and protocol address sizes in bytes. =item B The operation code number to perform. =item B =item B Source and destination hardware addresses. =item B =item B Source and destination IP addresses. =back The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. You can pass attributes that will overwrite default ones. See B for default values. =item B =item B These two methods are basically used to increase the speed when using B method from B. Usually, you write them when you need to write B method. =item B (Net::Frame::Layer::ARP object) This method is mostly used internally. You pass a B layer as a parameter, and it returns true if this is a response corresponding for the request, or returns false if not. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS Load them: use Net::Frame::Layer::ARP qw(:consts); =over 4 =item B Hardware address types. =item B =item B Protocol address types. =item B Hardware address sizes. =item B =item B Protocol address sizes. =item B =item B Operation code numbers. =item B Broadcast address for B or B attributes. =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer/ETH.pm000444001750001750 2165313471433226 17415 0ustar00gomorgomor000000000000# # $Id: ETH.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::ETH; use strict; use warnings; use Net::Frame::Layer qw(:consts :subs); require Exporter; our @ISA = qw(Net::Frame::Layer Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_ETH_HDR_LEN NF_ETH_ADDR_BROADCAST NF_ETH_TYPE_IPv4 NF_ETH_TYPE_X25 NF_ETH_TYPE_ARP NF_ETH_TYPE_CGMP NF_ETH_TYPE_80211 NF_ETH_TYPE_PPPIPCP NF_ETH_TYPE_RARP NF_ETH_TYPE_DDP NF_ETH_TYPE_AARP NF_ETH_TYPE_PPPCCP NF_ETH_TYPE_WCP NF_ETH_TYPE_8021Q NF_ETH_TYPE_IPX NF_ETH_TYPE_STP NF_ETH_TYPE_IPv6 NF_ETH_TYPE_WLCCP NF_ETH_TYPE_MPLS NF_ETH_TYPE_PPPoED NF_ETH_TYPE_PPPoES NF_ETH_TYPE_8021X NF_ETH_TYPE_AoE NF_ETH_TYPE_80211I NF_ETH_TYPE_LLDP NF_ETH_TYPE_LLTD NF_ETH_TYPE_LOOP NF_ETH_TYPE_VLAN NF_ETH_TYPE_PPPPAP NF_ETH_TYPE_PPPCHAP )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); use constant NF_ETH_HDR_LEN => 14; use constant NF_ETH_ADDR_BROADCAST => 'ff:ff:ff:ff:ff:ff'; use constant NF_ETH_TYPE_IPv4 => 0x0800; use constant NF_ETH_TYPE_X25 => 0x0805; use constant NF_ETH_TYPE_ARP => 0x0806; use constant NF_ETH_TYPE_CGMP => 0x2001; use constant NF_ETH_TYPE_80211 => 0x2452; use constant NF_ETH_TYPE_PPPIPCP => 0x8021; use constant NF_ETH_TYPE_RARP => 0x8035; use constant NF_ETH_TYPE_DDP => 0x809b; use constant NF_ETH_TYPE_AARP => 0x80f3; use constant NF_ETH_TYPE_PPPCCP => 0x80fd; use constant NF_ETH_TYPE_WCP => 0x80ff; use constant NF_ETH_TYPE_8021Q => 0x8100; use constant NF_ETH_TYPE_IPX => 0x8137; use constant NF_ETH_TYPE_STP => 0x8181; use constant NF_ETH_TYPE_IPv6 => 0x86dd; use constant NF_ETH_TYPE_WLCCP => 0x872d; use constant NF_ETH_TYPE_MPLS => 0x8847; use constant NF_ETH_TYPE_PPPoED => 0x8863; use constant NF_ETH_TYPE_PPPoES => 0x8864; use constant NF_ETH_TYPE_8021X => 0x888e; use constant NF_ETH_TYPE_AoE => 0x88a2; use constant NF_ETH_TYPE_80211I => 0x88c7; use constant NF_ETH_TYPE_LLDP => 0x88cc; use constant NF_ETH_TYPE_LLTD => 0x88d9; use constant NF_ETH_TYPE_LOOP => 0x9000; use constant NF_ETH_TYPE_VLAN => 0x9100; use constant NF_ETH_TYPE_PPPPAP => 0xc023; use constant NF_ETH_TYPE_PPPCHAP => 0xc223; our @AS = qw( dst src type ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); BEGIN { *length = \&type; } no strict 'vars'; sub new { my $self = shift->SUPER::new( src => '00:00:00:00:00:00', dst => NF_ETH_ADDR_BROADCAST, type => NF_ETH_TYPE_IPv4, @_, ); $self->[$__src] = lc($self->[$__src]) if $self->[$__src]; $self->[$__dst] = lc($self->[$__dst]) if $self->[$__dst]; $self; } sub getLength { NF_ETH_HDR_LEN } sub pack { my $self = shift; (my $dst = $self->[$__dst]) =~ s/://g; (my $src = $self->[$__src]) =~ s/://g; $self->[$__raw] = $self->SUPER::pack('H12H12n', $dst, $src, $self->[$__type]) or return undef; $self->[$__raw]; } sub unpack { my $self = shift; my ($dst, $src, $type, $payload) = $self->SUPER::unpack('H12H12n a*', $self->[$__raw]) or return undef; $self->[$__dst] = convertMac($dst); $self->[$__src] = convertMac($src); $self->[$__type] = $type; $self->[$__payload] = $payload; $self; } sub computeLengths { my $self = shift; my ($layers) = @_; if ($self->[$__type] <= 1500) { my $len = 0; for my $l (@$layers) { next if $l->layer eq 'ETH'; # We do not use getLength(), because the layer may # have a fake length, due to fuzzing or stress # testing attempts from the user $len += CORE::length($l->pack), } $self->type($len); } return 1; } our $Next = { NF_ETH_TYPE_IPv4() => 'IPv4', NF_ETH_TYPE_X25() => 'X25', NF_ETH_TYPE_ARP() => 'ARP', NF_ETH_TYPE_CGMP() => 'CGMP', NF_ETH_TYPE_80211() => '80211', NF_ETH_TYPE_PPPIPCP() => 'PPPIPCP', NF_ETH_TYPE_RARP() => 'RARP', NF_ETH_TYPE_DDP () => 'DDP', NF_ETH_TYPE_AARP() => 'AARP', NF_ETH_TYPE_PPPCCP() => 'PPPCCP', NF_ETH_TYPE_WCP() => 'WCP', NF_ETH_TYPE_8021Q() => '8021Q', NF_ETH_TYPE_IPX() => 'IPX', NF_ETH_TYPE_STP() => 'STP', NF_ETH_TYPE_IPv6() => 'IPv6', NF_ETH_TYPE_WLCCP() => 'WLCCP', NF_ETH_TYPE_MPLS() => 'MPLS', NF_ETH_TYPE_PPPoED() => 'PPPoED', NF_ETH_TYPE_PPPoES() => 'PPPoES', NF_ETH_TYPE_8021X() => '8021X', NF_ETH_TYPE_AoE() => 'AoE', NF_ETH_TYPE_80211I() => '80211I', NF_ETH_TYPE_LLDP() => 'LLDP', NF_ETH_TYPE_LLTD() => 'LLTD', NF_ETH_TYPE_LOOP() => 'LOOP', NF_ETH_TYPE_VLAN() => 'VLAN', NF_ETH_TYPE_PPPPAP() => 'PPPPAP', NF_ETH_TYPE_PPPCHAP() => 'PPPCHAP', }; sub encapsulate { my $self = shift; return $self->[$__nextLayer] if $self->[$__nextLayer]; # Is this a 802.3 layer ? if ($self->[$__type] <= 1500 && $self->[$__payload]) { my $payload = CORE::unpack('H*', $self->[$__payload]); # We consider this is a LLC layer if the payload is more than 6 bytes long if (CORE::length($payload) > 6) { return 'LLC'; } return NF_LAYER_UNKNOWN; } $Next->{$self->[$__type]} || NF_LAYER_UNKNOWN; } sub print { my $self = shift; my $l = $self->layer; my $buf = sprintf "$l: dst:%s src:%s ", $self->[$__dst], $self->[$__src]; if ($self->[$__type] <= 1500) { $buf .= sprintf "length:%d", $self->[$__type]; } else { $buf .= sprintf "type:0x%04x", $self->[$__type]; } $buf; } 1; __END__ =head1 NAME Net::Frame::Layer::ETH - Ethernet/802.3 layer object =head1 SYNOPSIS use Net::Frame::Layer::ETH qw(:consts); # Build a layer my $layer = Net::Frame::Layer::ETH->new( src => '00:00:00:00:00:00', dst => NF_ETH_ADDR_BROADCAST, type => NF_ETH_TYPE_IPv4, ); $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::ETH->new(raw => $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the Ethernet/802.3 layer. RFC: ftp://ftp.rfc-editor.org/in-notes/rfc894.txt See also B for other attributes and methods. =head1 ATTRIBUTES =over 4 =item B =item B Source and destination MAC addresses, in classical format (00:11:22:33:44:55). =item B The encapsulated layer type (IPv4, IPv6 ...) for Ethernet. Values for Ethernet types are greater than 1500. If it is less than 1500 the layer is considered a 802.3 one. See http://www.iana.org/assignments/ethernet-numbers . =item B The length of the payload when this layer is a 802.3 one. This is the same attribute as B, but you cannot use it when calling B (you can only use it as an accessor after that). =back The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. You can pass attributes that will overwrite default ones. See B for default values. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS Load them: use Net::Frame::Layer::ETH qw(:consts); =over 4 =item B Ethernet broadcast address. =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B Various supported Ethernet types. =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer/IPv4.pm000444001750001750 3353413471433226 17560 0ustar00gomorgomor000000000000# # $Id: IPv4.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::IPv4; use strict; use warnings; use Net::Frame::Layer qw(:consts :subs); require Exporter; our @ISA = qw(Net::Frame::Layer Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_IPv4_HDR_LEN NF_IPv4_PROTOCOL_ICMPv4 NF_IPv4_PROTOCOL_IGMP NF_IPv4_PROTOCOL_IPIP NF_IPv4_PROTOCOL_TCP NF_IPv4_PROTOCOL_EGP NF_IPv4_PROTOCOL_IGRP NF_IPv4_PROTOCOL_CHAOS NF_IPv4_PROTOCOL_UDP NF_IPv4_PROTOCOL_IDP NF_IPv4_PROTOCOL_DCCP NF_IPv4_PROTOCOL_IPv6 NF_IPv4_PROTOCOL_IPv6ROUTING NF_IPv4_PROTOCOL_IPv6FRAGMENT NF_IPv4_PROTOCOL_IDRP NF_IPv4_PROTOCOL_RSVP NF_IPv4_PROTOCOL_GRE NF_IPv4_PROTOCOL_ESP NF_IPv4_PROTOCOL_AH NF_IPv4_PROTOCOL_ICMPv6 NF_IPv4_PROTOCOL_EIGRP NF_IPv4_PROTOCOL_OSPF NF_IPv4_PROTOCOL_ETHERIP NF_IPv4_PROTOCOL_PIM NF_IPv4_PROTOCOL_VRRP NF_IPv4_PROTOCOL_STP NF_IPv4_PROTOCOL_SCTP NF_IPv4_PROTOCOL_UDPLITE NF_IPv4_MORE_FRAGMENT NF_IPv4_DONT_FRAGMENT NF_IPv4_RESERVED_FRAGMENT )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); use constant NF_IPv4_HDR_LEN => 20; use constant NF_IPv4_PROTOCOL_ICMPv4 => 0x01; use constant NF_IPv4_PROTOCOL_IGMP => 0x02; use constant NF_IPv4_PROTOCOL_IPIP => 0x04; use constant NF_IPv4_PROTOCOL_TCP => 0x06; use constant NF_IPv4_PROTOCOL_EGP => 0x08; use constant NF_IPv4_PROTOCOL_IGRP => 0x09; use constant NF_IPv4_PROTOCOL_CHAOS => 0x10; use constant NF_IPv4_PROTOCOL_UDP => 0x11; use constant NF_IPv4_PROTOCOL_IDP => 0x16; use constant NF_IPv4_PROTOCOL_DCCP => 0x21; use constant NF_IPv4_PROTOCOL_IPv6 => 0x29; use constant NF_IPv4_PROTOCOL_IPv6ROUTING => 0x2b; use constant NF_IPv4_PROTOCOL_IPv6FRAGMENT => 0x2c; use constant NF_IPv4_PROTOCOL_IDRP => 0x2d; use constant NF_IPv4_PROTOCOL_RSVP => 0x2e; use constant NF_IPv4_PROTOCOL_GRE => 0x2f; use constant NF_IPv4_PROTOCOL_ESP => 0x32; use constant NF_IPv4_PROTOCOL_AH => 0x33; use constant NF_IPv4_PROTOCOL_ICMPv6 => 0x3a; use constant NF_IPv4_PROTOCOL_EIGRP => 0x58; use constant NF_IPv4_PROTOCOL_OSPF => 0x59; use constant NF_IPv4_PROTOCOL_ETHERIP => 0x61; use constant NF_IPv4_PROTOCOL_PIM => 0x67; use constant NF_IPv4_PROTOCOL_VRRP => 0x70; use constant NF_IPv4_PROTOCOL_STP => 0x76; use constant NF_IPv4_PROTOCOL_SCTP => 0x84; use constant NF_IPv4_PROTOCOL_UDPLITE => 0x88; use constant NF_IPv4_MORE_FRAGMENT => 1; use constant NF_IPv4_DONT_FRAGMENT => 2; use constant NF_IPv4_RESERVED_FRAGMENT => 4; our @AS = qw( id ttl src dst protocol checksum flags offset version tos length hlen options noFixLen ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); BEGIN { my $osname = { freebsd => [ \&_fixLenBsd, ], netbsd => [ \&_fixLenBsd, ], openbsd => [ \&_fixLenBsd, ], darwin => [ \&_fixLenBsd, ], }; *_fixLen = $osname->{$^O}->[0] || \&_fixLenOther; } no strict 'vars'; use Carp; use Bit::Vector; sub _fixLenBsd { pack('v', shift) } sub _fixLenOther { pack('n', shift) } sub new { shift->SUPER::new( version => 4, tos => 0, id => getRandom16bitsInt(), length => NF_IPv4_HDR_LEN, hlen => 5, flags => 0, offset => 0, ttl => 128, protocol => NF_IPv4_PROTOCOL_TCP, checksum => 0, src => '127.0.0.1', dst => '127.0.0.1', options => '', noFixLen => 0, @_, ); } sub pack { my $self = shift; # Here, we pack in this order: version, hlen (4 bits each) my $version = Bit::Vector->new_Dec(4, $self->[$__version]); my $hlen = Bit::Vector->new_Dec(4, $self->[$__hlen]); my $v8 = $version->Concat_List($hlen); # Here, we pack in this order: flags (3 bits), offset (13 bits) my $flags = Bit::Vector->new_Dec(3, $self->[$__flags]); my $offset = Bit::Vector->new_Dec(13, $self->[$__offset]); my $v16 = $flags->Concat_List($offset); my $len = ($self->[$__noFixLen] ? _fixLenOther($self->[$__length]) : _fixLen($self->[$__length])); $self->[$__raw] = $self->SUPER::pack('CCa*nnCCna4a4', $v8->to_Dec, $self->[$__tos], $len, $self->[$__id], $v16->to_Dec, $self->[$__ttl], $self->[$__protocol], $self->[$__checksum], inetAton($self->[$__src]), inetAton($self->[$__dst]), ) or return undef; my $opt; if ($self->[$__options]) { $opt = $self->SUPER::pack('a*', $self->[$__options]) or return undef; $self->[$__raw] = $self->[$__raw].$opt; } $self->[$__raw]; } sub unpack { my $self = shift; my ($verHlen, $tos, $len, $id, $flagsOffset, $ttl, $proto, $cksum, $src, $dst, $payload) = $self->SUPER::unpack('CCnnnCCna4a4 a*', $self->[$__raw]) or return undef; my $v8 = Bit::Vector->new_Dec(8, $verHlen); my $v16 = Bit::Vector->new_Dec(16, $flagsOffset); # Here, we unpack in this order: hlen, version (4 bits each) $self->[$__hlen] = $v8->Chunk_Read(4, 0); $self->[$__version] = $v8->Chunk_Read(4, 4); $self->[$__tos] = $tos; $self->[$__length] = $len; $self->[$__id] = $id; # Here, we unpack in this order: offset (13 bits), flags (3 bits) $self->[$__offset] = $v16->Chunk_Read(13, 0); $self->[$__flags] = $v16->Chunk_Read( 3, 13); $self->[$__ttl] = $ttl; $self->[$__protocol] = $proto; $self->[$__checksum] = $cksum; $self->[$__src] = inetNtoa($src); $self->[$__dst] = inetNtoa($dst); $self->[$__payload] = $payload; my ($options, $payload2) = $self->SUPER::unpack( 'a'. $self->getOptionsLength. 'a*', $self->[$__payload] ) or return undef; $self->[$__options] = $options; $self->[$__payload] = $payload2; $self; } sub getLength { my $self = shift; $self->[$__hlen] > 0 ? $self->[$__hlen] * 4 : 0; } sub getPayloadLength { my $self = shift; my $gLen = $self->getLength; $self->[$__length] > $gLen ? $self->[$__length] - $gLen : 0; } sub getOptionsLength { my $self = shift; my $gLen = $self->getLength; my $hLen = NF_IPv4_HDR_LEN; $gLen > $hLen ? $gLen - $hLen : 0; } sub computeLengths { my $self = shift; my ($layers) = @_; my $hLen = NF_IPv4_HDR_LEN; $hLen += length($self->[$__options]) if $self->[$__options]; $self->[$__hlen] = $hLen / 4; my $len = $hLen; my $last; my $start; for my $l (@$layers) { if (! $start) { $start++ if $l->layer eq 'IPv4'; next; } $len += $l->getLength; $last = $l; } if (defined($last->payload)) { $len += length($last->payload); } $self->length($len); return 1; } sub computeChecksums { my $self = shift; my ($layers) = @_; # Reset the checksum if already filled by a previous pack if ($self->[$__checksum]) { $self->[$__checksum] = 0; } $self->[$__checksum] = inetChecksum($self->pack); return 1; } our $Next = { NF_IPv4_PROTOCOL_ICMPv4() => 'ICMPv4', NF_IPv4_PROTOCOL_IGMP() => 'IGMP', NF_IPv4_PROTOCOL_IPIP() => 'IPv4', NF_IPv4_PROTOCOL_TCP() => 'TCP', NF_IPv4_PROTOCOL_EGP() => 'EGP', NF_IPv4_PROTOCOL_IGRP() => 'IGRP', NF_IPv4_PROTOCOL_CHAOS() => 'CHAOS', NF_IPv4_PROTOCOL_UDP() => 'UDP', NF_IPv4_PROTOCOL_IDP() => 'IDP', NF_IPv4_PROTOCOL_DCCP() => 'DCCP', NF_IPv4_PROTOCOL_IPv6() => 'IPv6', NF_IPv4_PROTOCOL_IPv6ROUTING() => 'IPv6Routing', NF_IPv4_PROTOCOL_IPv6FRAGMENT() => 'IPv6Fragment', NF_IPv4_PROTOCOL_IDRP() => 'IDRP', NF_IPv4_PROTOCOL_RSVP() => 'RSVP', NF_IPv4_PROTOCOL_GRE() => 'GRE', NF_IPv4_PROTOCOL_ESP() => 'ESP', NF_IPv4_PROTOCOL_AH() => 'AH', NF_IPv4_PROTOCOL_ICMPv6() => 'ICMPv6', NF_IPv4_PROTOCOL_EIGRP() => 'EIGRP', NF_IPv4_PROTOCOL_OSPF() => 'OSPF', NF_IPv4_PROTOCOL_ETHERIP() => 'ETHERIP', NF_IPv4_PROTOCOL_PIM() => 'PIM', NF_IPv4_PROTOCOL_VRRP() => 'VRRP', NF_IPv4_PROTOCOL_STP() => 'STP', NF_IPv4_PROTOCOL_SCTP() => 'SCTP', NF_IPv4_PROTOCOL_UDPLITE() => 'UDPLite', }; sub encapsulate { my $self = shift; return $self->[$__nextLayer] if $self->[$__nextLayer]; return $Next->{$self->[$__protocol]} || NF_LAYER_UNKNOWN; } sub print { my $self = shift; my $l = $self->layer; my $buf = sprintf "$l: version:%d hlen:%d tos:0x%02x length:%d id:%d\n". "$l: flags:0x%02x offset:%d ttl:%d protocol:0x%02x checksum:0x%04x\n". "$l: src:%s dst:%s", $self->[$__version], $self->[$__hlen], $self->[$__tos], $self->[$__length], $self->[$__id], $self->[$__flags], $self->[$__offset], $self->[$__ttl], $self->[$__protocol], $self->[$__checksum], $self->[$__src], $self->[$__dst]; if ($self->[$__options]) { $buf .= sprintf "\n$l: optionsLength:%d options:%s", $self->getOptionsLength, CORE::unpack('H*', $self->[$__options]); } $buf; } 1; __END__ =head1 NAME Net::Frame::Layer::IPv4 - Internet Protocol v4 layer object =head1 SYNOPSIS use Net::Frame::Layer::IPv4 qw(:consts); # Build a layer my $layer = Net::Frame::Layer::IPv4->new( version => 4, tos => 0, id => getRandom16bitsInt(), length => NF_IPv4_HDR_LEN, hlen => 5, flags => 0, offset => 0, ttl => 128, protocol => NF_IPv4_PROTOCOL_TCP, checksum => 0, src => '127.0.0.1', dst => '127.0.0.1', options => '', noFixLen => 0, ); $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::IPv4->new(raw => $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the IPv4 layer. RFC: ftp://ftp.rfc-editor.org/in-notes/rfc791.txt See also B for other attributes and methods. =head1 ATTRIBUTES =over 4 =item B IP ID of the datagram. =item B Time to live. =item B =item B Source and destination IP addresses. =item B Of which type the layer 4 is. =item B IP checksum. =item B IP Flags. =item B IP fragment offset. =item B IP version, here it is 4. =item B Type of service flag. =item B Total length in bytes of the packet, including IP headers (that is, layer 3 + layer 4 + layer 7). =item B Header length in number of words, including IP options. =item B IP options, as a hexadecimal string. =item B Since the byte ordering of B attribute varies from system to system, a subroutine inside this module detects which byte order to use. Sometimes, like when you build B layers, you may have the need to avoid this. So set it to 1 in order to avoid fixing. Default is 0 (that is to fix). =back The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. You can pass attributes that will overwrite default ones. See B for default values. =item B Returns the header length in bytes, not including IP options. =item B Returns the length in bytes of IP options. 0 if none. =item B ({ payloadLength => VALUE }) In order to compute lengths attributes within IPv4 header, you need to pass via a hashref the number of bytes contained in IPv4 payload (that is, the sum of all layers after the IPv4 one). =item B Computes the IPv4 checksum. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS Load them: use Net::Frame::Layer::IPv4 qw(:consts); =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B Various protocol type constants. =item B =item B =item B Various possible flags. =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer/NULL.pm000444001750001750 1344613471433226 17550 0ustar00gomorgomor000000000000# # $Id: NULL.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::NULL; use strict; use warnings; use Net::Frame::Layer qw(:consts); require Exporter; our @ISA = qw(Net::Frame::Layer Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_NULL_HDR_LEN NF_NULL_TYPE_IPv4 NF_NULL_TYPE_ARP NF_NULL_TYPE_CGMP NF_NULL_TYPE_80211 NF_NULL_TYPE_DDP NF_NULL_TYPE_AARP NF_NULL_TYPE_WCP NF_NULL_TYPE_8021Q NF_NULL_TYPE_IPX NF_NULL_TYPE_STP NF_NULL_TYPE_IPv6 NF_NULL_TYPE_WLCCP NF_NULL_TYPE_PPPoED NF_NULL_TYPE_PPPoES NF_NULL_TYPE_8021X NF_NULL_TYPE_AoE NF_NULL_TYPE_LLDP NF_NULL_TYPE_LOOP NF_NULL_TYPE_VLAN NF_NULL_TYPE_ETH )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); use constant NF_NULL_HDR_LEN => 4; use constant NF_NULL_TYPE_IPv4 => 0x02000000; use constant NF_NULL_TYPE_ARP => 0x06080000; use constant NF_NULL_TYPE_CGMP => 0x01200000; use constant NF_NULL_TYPE_80211 => 0x52240000; use constant NF_NULL_TYPE_DDP => 0x9b800000; use constant NF_NULL_TYPE_AARP => 0xf3800000; use constant NF_NULL_TYPE_WCP => 0xff800000; use constant NF_NULL_TYPE_8021Q => 0x00810000; use constant NF_NULL_TYPE_IPX => 0x37810000; use constant NF_NULL_TYPE_STP => 0x81810000; use constant NF_NULL_TYPE_IPv6 => 0x1c000000; use constant NF_NULL_TYPE_WLCCP => 0x2d870000; use constant NF_NULL_TYPE_PPPoED => 0x63880000; use constant NF_NULL_TYPE_PPPoES => 0x64880000; use constant NF_NULL_TYPE_8021X => 0x8e880000; use constant NF_NULL_TYPE_AoE => 0xa2880000; use constant NF_NULL_TYPE_LLDP => 0xcc880000; use constant NF_NULL_TYPE_LOOP => 0x00900000; use constant NF_NULL_TYPE_VLAN => 0x00910000; use constant NF_NULL_TYPE_ETH => 0x58650000; our @AS = qw( type ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); no strict 'vars'; sub new { shift->SUPER::new( type => NF_NULL_TYPE_IPv4, @_, ); } sub getLength { NF_NULL_HDR_LEN } sub pack { my $self = shift; $self->[$__raw] = $self->SUPER::pack('N', $self->[$__type]) or return undef; $self->[$__raw]; } sub unpack { my $self = shift; my ($type, $payload) = $self->SUPER::unpack('N a*', $self->[$__raw]) or return undef; $self->[$__type] = $type; $self->[$__payload] = $payload; $self; } our $Next = { NF_NULL_TYPE_IPv4() => 'IPv4', NF_NULL_TYPE_ARP() => 'ARP', NF_NULL_TYPE_CGMP() => 'CGMP', NF_NULL_TYPE_80211() => '80211', NF_NULL_TYPE_DDP() => 'DDP', NF_NULL_TYPE_AARP() => 'AARP', NF_NULL_TYPE_WCP() => 'WCP', NF_NULL_TYPE_8021Q() => '8021Q', NF_NULL_TYPE_IPX() => 'IPX', NF_NULL_TYPE_STP() => 'STP', NF_NULL_TYPE_IPv6() => 'IPv6', NF_NULL_TYPE_WLCCP() => 'WLCCP', NF_NULL_TYPE_PPPoED() => 'PPPoED', NF_NULL_TYPE_PPPoES() => 'PPPoES', NF_NULL_TYPE_8021X() => '8021X', NF_NULL_TYPE_AoE() => 'AoE', NF_NULL_TYPE_LLDP() => 'LLDP', NF_NULL_TYPE_LOOP() => 'LOOP', NF_NULL_TYPE_VLAN() => 'VLAN', NF_NULL_TYPE_ETH() => 'ETH', }; sub encapsulate { my $self = shift; return $self->[$__nextLayer] if $self->[$__nextLayer]; return $Next->{$self->[$__type]} || NF_LAYER_UNKNOWN; } sub print { my $self = shift; my $l = $self->layer; sprintf "$l: type:0x%08x", $self->type; } 1; __END__ =head1 NAME Net::Frame::Layer::NULL - BSD loopback layer object =head1 SYNOPSIS use Net::Frame::Layer::NULL qw(:consts); # Build a layer my $layer = Net::Frame::Layer::NULL->new( type => NF_NULL_TYPE_IPv4, ); $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::NULL->new(raw => $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the BSD loopback layer. See also B for other attributes and methods. =head1 ATTRIBUTES =over 4 =item B Stores the type of encapsulated layer. =back The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. You can pass attributes that will overwrite default ones. See B for default values. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS Load them: use Net::Frame::Layer::NULL qw(:consts); =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B Various supported encapsulated layer types. =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer/PPP.pm000444001750001750 1061413471433226 17427 0ustar00gomorgomor000000000000# # $Id: PPP.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::PPP; use strict; use warnings; use Net::Frame::Layer qw(:consts); require Exporter; our @ISA = qw(Net::Frame::Layer Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_PPP_HDR_LEN NF_PPP_PROTOCOL_IPv4 NF_PPP_PROTOCOL_DDP NF_PPP_PROTOCOL_IPX NF_PPP_PROTOCOL_IPv6 NF_PPP_PROTOCOL_CDP NF_PPP_PROTOCOL_PPPLCP )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); use constant NF_PPP_HDR_LEN => 4; use constant NF_PPP_PROTOCOL_IPv4 => 0x0021; use constant NF_PPP_PROTOCOL_DDP => 0x0029; use constant NF_PPP_PROTOCOL_IPX => 0x002b; use constant NF_PPP_PROTOCOL_IPv6 => 0x0057; use constant NF_PPP_PROTOCOL_CDP => 0x0207; use constant NF_PPP_PROTOCOL_PPPLCP => 0xc021; our @AS = qw( address control protocol ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); no strict 'vars'; sub new { shift->SUPER::new( address => 0xff, control => 0x03, protocol => NF_PPP_PROTOCOL_IPv4, @_, ); } sub getLength { NF_PPP_HDR_LEN } sub pack { my $self = shift; $self->[$__raw] = $self->SUPER::pack('CCn', $self->[$__address], $self->[$__control], $self->[$__protocol]) or return undef; $self->[$__raw]; } sub unpack { my $self = shift; my ($address, $control, $protocol, $payload) = $self->SUPER::unpack('CCn a*', $self->[$__raw]) or return undef; $self->[$__address] = $address; $self->[$__control] = $control; $self->[$__protocol] = $protocol; $self->[$__payload] = $payload; $self; } our $Next = { NF_PPP_PROTOCOL_IPv4() => 'IPv4', NF_PPP_PROTOCOL_DDP() => 'DDP', NF_PPP_PROTOCOL_IPX() => 'IPX', NF_PPP_PROTOCOL_IPv6() => 'IPv6', NF_PPP_PROTOCOL_CDP() => 'CDP', NF_PPP_PROTOCOL_PPPLCP() => 'PPPLCP', }; sub encapsulate { my $self = shift; return $self->[$__nextLayer] if $self->[$__nextLayer]; return $Next->{$self->[$__protocol]} || NF_LAYER_UNKNOWN; } sub print { my $self = shift; my $l = $self->layer; sprintf "$l: address:0x%02x control:0x%02x protocol:0x%04x", $self->[$__address], $self->[$__control], $self->[$__protocol]; } 1; __END__ =head1 NAME Net::Frame::Layer::PPP - Point-to-Point Protocol layer object =head1 SYNOPSIS use Net::Frame::Layer::PPP qw(:consts); # Build a layer my $layer = Net::Frame::Layer::PPP->new( address => 0xff, control => 0x03, protocol => NF_PPP_PROTOCOL_IPv4, ); $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::PPP->new(raw => $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the Point-to-Point Protocol layer. See also B for other attributes and methods. =head1 ATTRIBUTES =over 4 =item B
- 8 bits =item B - 8 bits =item B - 16 bits =back The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. You can pass attributes that will overwrite default ones. See B for default values. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS Load them: use Net::Frame::Layer::PPP qw(:consts); =over 4 =item B =item B =item B =item B =item B =item B Various supported encapsulated layer types. =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer/RAW.pm000444001750001750 535513471433226 17407 0ustar00gomorgomor000000000000# # $Id: RAW.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::RAW; use strict; use warnings; use Net::Frame::Layer qw(:consts); require Exporter; our @ISA = qw(Net::Frame::Layer Exporter); __PACKAGE__->cgBuildIndices; our %EXPORT_TAGS = ( consts => [], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); no strict 'vars'; sub pack { my $self = shift; $self->[$__raw] = ''; $self->[$__raw]; } sub unpack { my $self = shift; $self->[$__payload] = $self->[$__raw]; $self; } sub encapsulate { my $self = shift; return $self->[$__nextLayer] if $self->[$__nextLayer]; return NF_LAYER_NONE if ! $self->[$__payload]; # With RAW layer, we must guess which type is the first layer my $payload = CORE::unpack('H*', $self->[$__payload]); # XXX: may not work on big-endian arch if ($payload =~ /^4/) { return 'IPv4'; } elsif ($payload =~ /^6/) { return 'IPv6'; } elsif ($payload =~ /^0001....06/) { return 'ARP'; } return NF_LAYER_UNKNOWN; } sub print { my $self = shift; my $l = $self->layer; "$l: empty"; } 1; __END__ =head1 NAME Net::Frame::Layer::RAW - empty layer object =head1 SYNOPSIS use Net::Frame::Layer::RAW qw(:consts); # Build a layer my $layer = Net::Frame::Layer::RAW->new; $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::RAW->new(raw => $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the raw layer 2. See also B for other attributes and methods. =head1 ATTRIBUTES No attributes in this layer. The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B Object constructor. No default values, because no attributes here. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS No constants here. =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer/SLL.pm000444001750001750 2137313471433226 17426 0ustar00gomorgomor000000000000# # $Id: SLL.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::SLL; use strict; use warnings; use Net::Frame::Layer qw(:consts); require Exporter; our @ISA = qw(Net::Frame::Layer Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_SLL_HDR_LEN NF_SLL_PACKET_TYPE_SENT_BY_US NF_SLL_PACKET_TYPE_UNICAST_TO_US NF_SLL_ADDRESS_TYPE_512 NF_SLL_PROTOCOL_IPv4 NF_SLL_PROTOCOL_X25 NF_SLL_PROTOCOL_ARP NF_SLL_PROTOCOL_CGMP NF_SLL_PROTOCOL_80211 NF_SLL_PROTOCOL_PPPIPCP NF_SLL_PROTOCOL_RARP NF_SLL_PROTOCOL_DDP NF_SLL_PROTOCOL_AARP NF_SLL_PROTOCOL_PPPCCP NF_SLL_PROTOCOL_WCP NF_SLL_PROTOCOL_8021Q NF_SLL_PROTOCOL_IPX NF_SLL_PROTOCOL_STP NF_SLL_PROTOCOL_IPv6 NF_SLL_PROTOCOL_WLCCP NF_SLL_PROTOCOL_MPLS NF_SLL_PROTOCOL_PPPoED NF_SLL_PROTOCOL_PPPoES NF_SLL_PROTOCOL_8021X NF_SLL_PROTOCOL_AoE NF_SLL_PROTOCOL_80211I NF_SLL_PROTOCOL_LLDP NF_SLL_PROTOCOL_LLTD NF_SLL_PROTOCOL_LOOP NF_SLL_PROTOCOL_VLAN NF_SLL_PROTOCOL_PPPPAP NF_SLL_PROTOCOL_PPPCHAP )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); use constant NF_SLL_HDR_LEN => 16; use constant NF_SLL_PACKET_TYPE_SENT_BY_US => 4; use constant NF_SLL_PACKET_TYPE_UNICAST_TO_US => 0; use constant NF_SLL_ADDRESS_TYPE_512 => 512; use constant NF_SLL_PROTOCOL_IPv4 => 0x0800; use constant NF_SLL_PROTOCOL_X25 => 0x0805; use constant NF_SLL_PROTOCOL_ARP => 0x0806; use constant NF_SLL_PROTOCOL_CGMP => 0x2001; use constant NF_SLL_PROTOCOL_80211 => 0x2452; use constant NF_SLL_PROTOCOL_PPPIPCP => 0x8021; use constant NF_SLL_PROTOCOL_RARP => 0x8035; use constant NF_SLL_PROTOCOL_DDP => 0x809b; use constant NF_SLL_PROTOCOL_AARP => 0x80f3; use constant NF_SLL_PROTOCOL_PPPCCP => 0x80fd; use constant NF_SLL_PROTOCOL_WCP => 0x80ff; use constant NF_SLL_PROTOCOL_8021Q => 0x8100; use constant NF_SLL_PROTOCOL_IPX => 0x8137; use constant NF_SLL_PROTOCOL_STP => 0x8181; use constant NF_SLL_PROTOCOL_IPv6 => 0x86dd; use constant NF_SLL_PROTOCOL_WLCCP => 0x872d; use constant NF_SLL_PROTOCOL_MPLS => 0x8847; use constant NF_SLL_PROTOCOL_PPPoED => 0x8863; use constant NF_SLL_PROTOCOL_PPPoES => 0x8864; use constant NF_SLL_PROTOCOL_8021X => 0x888e; use constant NF_SLL_PROTOCOL_AoE => 0x88a2; use constant NF_SLL_PROTOCOL_80211I => 0x88c7; use constant NF_SLL_PROTOCOL_LLDP => 0x88cc; use constant NF_SLL_PROTOCOL_LLTD => 0x88d9; use constant NF_SLL_PROTOCOL_LOOP => 0x9000; use constant NF_SLL_PROTOCOL_VLAN => 0x9100; use constant NF_SLL_PROTOCOL_PPPPAP => 0xc023; use constant NF_SLL_PROTOCOL_PPPCHAP => 0xc223; our @AS = qw( packetType addressType addressLength source protocol ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); no strict 'vars'; sub new { shift->SUPER::new( packetType => NF_SLL_PACKET_TYPE_SENT_BY_US, addressType => NF_SLL_ADDRESS_TYPE_512, addressLength => 0, source => 0, protocol => NF_SLL_PROTOCOL_IPv4, @_, ); } sub getLength { NF_SLL_HDR_LEN } sub pack { my $self = shift; $self->[$__raw] = $self->SUPER::pack('nnnH16n', $self->[$__packetType], $self->[$__addressType], $self->[$__addressLength], $self->[$__source], $self->[$__protocol], ) or return undef; $self->[$__raw]; } sub unpack { my $self = shift; my ($pt, $at, $al, $s, $p, $payload) = $self->SUPER::unpack('nnnH16n a*', $self->[$__raw]) or return undef; $self->[$__packetType] = $pt; $self->[$__addressType] = $at; $self->[$__addressLength] = $al; $self->[$__source] = $s; $self->[$__protocol] = $p; $self->[$__payload] = $payload; $self; } our $Next = { NF_SLL_PROTOCOL_IPv4() => 'IPv4', NF_SLL_PROTOCOL_X25() => 'X25', NF_SLL_PROTOCOL_ARP() => 'ARP', NF_SLL_PROTOCOL_CGMP() => 'CGMP', NF_SLL_PROTOCOL_80211() => '80211', NF_SLL_PROTOCOL_PPPIPCP() => 'PPPIPCP', NF_SLL_PROTOCOL_RARP() => 'RARP', NF_SLL_PROTOCOL_DDP () => 'DDP', NF_SLL_PROTOCOL_AARP() => 'AARP', NF_SLL_PROTOCOL_PPPCCP() => 'PPPCCP', NF_SLL_PROTOCOL_WCP() => 'WCP', NF_SLL_PROTOCOL_8021Q() => '8021Q', NF_SLL_PROTOCOL_IPX() => 'IPX', NF_SLL_PROTOCOL_STP() => 'STP', NF_SLL_PROTOCOL_IPv6() => 'IPv6', NF_SLL_PROTOCOL_WLCCP() => 'WLCCP', NF_SLL_PROTOCOL_MPLS() => 'MPLS', NF_SLL_PROTOCOL_PPPoED() => 'PPPoED', NF_SLL_PROTOCOL_PPPoES() => 'PPPoES', NF_SLL_PROTOCOL_8021X() => '8021X', NF_SLL_PROTOCOL_AoE() => 'AoE', NF_SLL_PROTOCOL_80211I() => '80211I', NF_SLL_PROTOCOL_LLDP() => 'LLDP', NF_SLL_PROTOCOL_LLTD() => 'LLTD', NF_SLL_PROTOCOL_LOOP() => 'LOOP', NF_SLL_PROTOCOL_VLAN() => 'VLAN', NF_SLL_PROTOCOL_PPPPAP() => 'PPPPAP', NF_SLL_PROTOCOL_PPPCHAP() => 'PPPCHAP', }; sub encapsulate { my $self = shift; return $self->[$__nextLayer] if $self->[$__nextLayer]; return $Next->{$self->[$__protocol]} || NF_LAYER_UNKNOWN; } sub print { my $self = shift; my $l = $self->layer; sprintf "$l: packetType:0x%04x addressType:0x%04x ". "addressLength:0x%04x\n". "$l: source:%d protocol:0x%04x", $self->[$__packetType], $self->[$__addressType], $self->[$__addressLength], $self->[$__source], $self->[$__protocol]; } 1; __END__ =head1 NAME Net::Frame::Layer::SLL - Linux cooked capture layer object =head1 SYNOPSIS use Net::Frame::Layer::SLL qw(:consts); # Build a layer my $layer = Net::Frame::Layer::SLL->new( packetType => NF_SLL_PACKET_TYPE_SENT_BY_US, addressType => NF_SLL_ADDRESS_TYPE_512, addressLength => 0, source => 0, protocol => NF_SLL_PROTOCOL_IPv4, ); $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::SLL->new(raw => $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the Linux cooked capture layer. See also B for other attributes and methods. =head1 ATTRIBUTES =over 4 =item B Stores the packet type (unicast to us, sent by us ...). =item B The address type. =item B The length of the previously specified address. =item B Source address. =item B Encapsulated protocol. =back The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. You can pass attributes that will overwrite default ones. See B for default values. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS Load them: use Net::Frame::Layer::SLL qw(:consts); =over 4 =item B =item B Various possible packet types. =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B Various supported encapsulated layer types. =item B =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer/TCP.pm000444001750001750 2323113471433226 17415 0ustar00gomorgomor000000000000# # $Id: TCP.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::TCP; use strict; use warnings; use Net::Frame::Layer qw(:consts :subs); use Exporter; our @ISA = qw(Net::Frame::Layer Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_TCP_HDR_LEN NF_TCP_FLAGS_FIN NF_TCP_FLAGS_SYN NF_TCP_FLAGS_RST NF_TCP_FLAGS_PSH NF_TCP_FLAGS_ACK NF_TCP_FLAGS_URG NF_TCP_FLAGS_ECE NF_TCP_FLAGS_CWR )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); use constant NF_TCP_HDR_LEN => 20; use constant NF_TCP_FLAGS_FIN => 0x01; use constant NF_TCP_FLAGS_SYN => 0x02; use constant NF_TCP_FLAGS_RST => 0x04; use constant NF_TCP_FLAGS_PSH => 0x08; use constant NF_TCP_FLAGS_ACK => 0x10; use constant NF_TCP_FLAGS_URG => 0x20; use constant NF_TCP_FLAGS_ECE => 0x40; use constant NF_TCP_FLAGS_CWR => 0x80; our @AS = qw( src dst flags win seq ack off x2 checksum urp options ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); no strict 'vars'; sub new { my $self = shift->SUPER::new( src => getRandomHighPort(), dst => 0, seq => getRandom32bitsInt(), ack => 0, x2 => 0, off => 0, flags => NF_TCP_FLAGS_SYN, win => 0xffff, checksum => 0, urp => 0, options => '', @_, ); return $self; } sub pack { my $self = shift; my $offX2Flags = ($self->[$__off] << 12)|(0x0f00 & ($self->[$__x2] << 8)) |(0x00ff & $self->[$__flags]); $self->[$__raw] = $self->SUPER::pack('nnNNnnnn', $self->[$__src], $self->[$__dst], $self->[$__seq], $self->[$__ack], $offX2Flags, $self->[$__win], $self->[$__checksum], $self->[$__urp], ) or return; if ($self->[$__options]) { $self->[$__raw] = $self->[$__raw].$self->SUPER::pack('a*', $self->[$__options]) or return; } return $self->[$__raw]; } sub unpack { my $self = shift; # Pad it if less than the required length if (length($self->[$__raw]) < NF_TCP_HDR_LEN) { $self->[$__raw] .= ("\x00" x (NF_TCP_HDR_LEN - length($self->[$__raw]))); } my ($src, $dst, $seq, $ack, $offX2Flags, $win, $checksum, $urp, $payload) = $self->SUPER::unpack('nnNNnnnn a*', $self->[$__raw]) or return; $self->[$__src] = $src; $self->[$__dst] = $dst; $self->[$__seq] = $seq; $self->[$__ack] = $ack; $self->[$__off] = ($offX2Flags & 0xf000) >> 12; $self->[$__x2] = ($offX2Flags & 0x0f00) >> 8; $self->[$__flags] = $offX2Flags & 0x00ff; $self->[$__win] = $win; $self->[$__checksum] = $checksum; $self->[$__urp] = $urp; $self->[$__payload] = $payload; my ($options, $payload2) = $self->SUPER::unpack( 'a'. $self->getOptionsLength. 'a*', $self->[$__payload] ) or return; $self->[$__options] = $options; $self->[$__payload] = $payload2; return $self; } sub getLength { my $self = shift; $self->[$__off] ? $self->[$__off] * 4 : 0 } sub getOptionsLength { my $self = shift; my $gLen = $self->getLength; my $hLen = NF_TCP_HDR_LEN; return $gLen > $hLen ? $gLen - $hLen : 0; } sub computeLengths { my $self = shift; my $optLen = ($self->[$__options] && length($self->[$__options])) || 0; my $hLen = NF_TCP_HDR_LEN; $self->[$__off] = ($hLen + $optLen) / 4; return 1; } sub computeChecksums { my $self = shift; my ($layers) = @_; my $len = $self->getLength; my $start = 0; my $last = $self; my $payload = ''; for my $l (@$layers) { $last = $l; if (! $start) { $start++ if $l->layer eq 'TCP'; next; } $len += $l->getLength; $payload .= $l->pack; } if (defined($last->payload) && length($last->payload)) { $len += length($last->payload); $payload .= $last->payload; } my $phpkt; for my $l (@$layers) { if ($l->layer eq 'IPv4') { $phpkt = $self->SUPER::pack('a4a4CCn', inetAton($l->src), inetAton($l->dst), 0, 6, $len); } elsif ($l->layer eq 'IPv6') { $phpkt = $self->SUPER::pack('a*a*NnCC', inet6Aton($l->src), inet6Aton($l->dst), $len, 0, 0, 6); } } my $offX2Flags = ($self->[$__off] << 12) | (0x0f00 & ($self->[$__x2] << 8)) | (0x00ff & $self->[$__flags]); $phpkt .= $self->SUPER::pack('nnNNnnnn', $self->[$__src], $self->[$__dst], $self->[$__seq], $self->[$__ack], $offX2Flags, $self->[$__win], 0, $self->[$__urp], ) or return; if ($self->[$__options]) { $phpkt .= $self->SUPER::pack('a*', $self->[$__options]) or return; } if (length($payload)) { $phpkt .= $self->SUPER::pack('a*', $payload) or return; } $self->[$__checksum] = inetChecksum($phpkt); return 1; } our $Next = { }; sub encapsulate { my $self = shift; return $Next->{$self->[$__dst]} || $Next->{$self->[$__src]} || $self->[$__nextLayer]; } sub match { my $self = shift; my ($with) = @_; ($with->[$__ack] == $self->[$__seq] + 1) || ($with->[$__flags] & NF_TCP_FLAGS_RST); } sub getKey { my $self = shift; $self->layer.':'.$self->[$__src].'-'.$self->[$__dst]; } sub getKeyReverse { my $self = shift; $self->layer.':'.$self->[$__dst].'-'.$self->[$__src]; } sub print { my $self = shift; my $l = $self->layer; my $buf = sprintf "$l: src:%d dst:%d seq:0x%04x ack:0x%04x \n". "$l: off:0x%02x x2:0x%01x flags:0x%02x win:%d checksum:0x%04x ". "urp:0x%02x", $self->[$__src], $self->[$__dst], $self->[$__seq], $self->[$__ack], $self->[$__off], $self->[$__x2], $self->[$__flags], $self->[$__win], $self->[$__checksum], $self->[$__urp]; if ($self->[$__options]) { $buf .= sprintf("\n$l: optionsLength:%d options:%s", $self->getOptionsLength, $self->SUPER::unpack('H*', $self->[$__options]) ) or return undef; } $buf; } 1; __END__ =head1 NAME Net::Frame::Layer::TCP - Transmission Control Protocol layer object =head1 SYNOPSIS use Net::Frame::Layer::TCP qw(:consts); # Build a layer my $layer = Net::Frame::Layer::TCP->new( src => getRandomHighPort(), dst => 0, seq => getRandom32bitsInt(), ack => 0, x2 => 0, off => 0, flags => NF_TCP_FLAGS_SYN, win => 0xffff, checksum => 0, urp => 0, options => '', ); $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::TCP->new(raw => $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the TCP layer. RFC: ftp://ftp.rfc-editor.org/in-notes/rfc793.txt See also B for other attributes and methods. =head1 ATTRIBUTES =over 4 =item B =item B Source and destination ports. =item B TCP flags, see CONSTANTS. =item B The window size. =item B =item B Sequence and acknowledgment numbers. =item B The size in number of words of the TCP header. =item B Reserved field. =item B The TCP header checksum. =item B Urgent pointer. =item B TCP options, as a hexadecimal string. =back The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. You can pass attributes that will overwrite default ones. See B for default values. =item B Returns the header length in bytes, not including TCP options. =item B Returns options length in bytes. =item B Computes various lengths contained within this layer. =item B ({ type => PROTO, src => IP, dst => IP }) In order to compute checksums of TCP, you need to pass the protocol type (IPv4, IPv6), the source and destination IP addresses (IPv4 for IPv4, IPv6 for IPv6). =item B =item B These two methods are basically used to increase the speed when using B method from B. Usually, you write them when you need to write B method. =item B (Net::Frame::Layer::TCP object) This method is mostly used internally. You pass a B layer as a parameter, and it returns true if this is a response corresponding for the request, or returns false if not. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS Load them: use Net::Frame::Layer::TCP qw(:consts); =over 4 =item B =item B =item B =item B =item B =item B =item B =item B TCP flags constants. =back =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/lib/Net/Frame/Layer/UDP.pm000444001750001750 1473213471433226 17425 0ustar00gomorgomor000000000000# # $Id: UDP.pm,v ce68fbcc7f6d 2019/05/23 05:58:40 gomor $ # package Net::Frame::Layer::UDP; use strict; use warnings; use Net::Frame::Layer qw(:consts :subs); require Exporter; our @ISA = qw(Net::Frame::Layer Exporter); our %EXPORT_TAGS = ( consts => [qw( NF_UDP_HDR_LEN )], ); our @EXPORT_OK = ( @{$EXPORT_TAGS{consts}}, ); use constant NF_UDP_HDR_LEN => 8; our @AS = qw( src dst length checksum ); __PACKAGE__->cgBuildIndices; __PACKAGE__->cgBuildAccessorsScalar(\@AS); no strict 'vars'; sub new { my $self = shift->SUPER::new( src => getRandomHighPort(), dst => 0, length => 0, checksum => 0, @_, ); return $self; } sub pack { my $self = shift; $self->[$__raw] = $self->SUPER::pack('nnnn', $self->[$__src], $self->[$__dst], $self->[$__length], $self->[$__checksum], ) or return; return $self->[$__raw]; } sub unpack { my $self = shift; # Pad it if less than the required length if (length($self->[$__raw]) < NF_UDP_HDR_LEN) { $self->[$__raw] .= ("\x00" x (NF_UDP_HDR_LEN - length($self->[$__raw]))); } my ($src, $dst, $len, $checksum, $payload) = $self->SUPER::unpack('nnnn a*', $self->[$__raw]) or return; $self->[$__src] = $src; $self->[$__dst] = $dst; $self->[$__length] = $len; $self->[$__checksum] = $checksum; $self->[$__payload] = $payload; return $self; } sub getLength { return NF_UDP_HDR_LEN; } sub computeLengths { my $self = shift; my ($layers) = @_; my $len = $self->getLength; my $start = 0; my $last = $self; for my $l (@$layers) { $last = $l; if (! $start) { $start++ if $l->layer eq 'UDP'; next; } $len += $l->getLength; } if (defined($last->payload) && length($last->payload)) { $len += length($last->payload); } $self->[$__length] = $len; return 1; } sub computeChecksums { my $self = shift; my ($layers) = @_; my $phpkt; for my $l (@$layers) { if ($l->layer eq 'IPv4') { $phpkt = $self->SUPER::pack('a4a4CCn', inetAton($l->src), inetAton($l->dst), 0, 17, $self->[$__length]); } elsif ($l->layer eq 'IPv6') { $phpkt = $self->SUPER::pack('a*a*NnCC', inet6Aton($l->src), inet6Aton($l->dst), $self->[$__length], 0, 0, 17); } } $phpkt .= $self->SUPER::pack('nnnn', $self->[$__src], $self->[$__dst], $self->[$__length], 0) or return; my $start = 0; my $last = $self; my $payload = ''; for my $l (@$layers) { $last = $l; if (! $start) { $start++ if $l->layer eq 'UDP'; next; } $payload .= $l->pack; } if (defined($last->payload) && length($last->payload)) { $payload .= $last->payload; } if (length($payload)) { $phpkt .= $self->SUPER::pack('a*', $payload) or return; } $self->[$__checksum] = inetChecksum($phpkt); return 1; } our $Next = { }; sub encapsulate { my $self = shift; return $Next->{$self->[$__dst]} || $Next->{$self->[$__src]} || $self->[$__nextLayer]; } sub getKey { my $self = shift; return $self->layer.':'.$self->[$__src].'-'.$self->[$__dst]; } sub getKeyReverse { my $self = shift; return $self->layer.':'.$self->[$__dst].'-'.$self->[$__src]; } sub match { my $self = shift; my ($with) = @_; return 1; } sub print { my $self = shift; my $l = $self->layer; return sprintf "$l: src:%d dst:%d length:%d checksum:0x%02x", $self->[$__src], $self->[$__dst], $self->[$__length], $self->[$__checksum]; } 1; __END__ =head1 NAME Net::Frame::Layer::UDP - User Datagram Protocol layer object =head1 SYNOPSIS use Net::Frame::Layer::UDP qw(:consts); # Build a layer my $layer = Net::Frame::Layer::UDP->new( src => getRandomHighPort(), dst => 0, length => 0, checksum => 0, ); $layer->pack; print 'RAW: '.$layer->dump."\n"; # Read a raw layer my $layer = Net::Frame::Layer::UDP->new(raw = $raw); print $layer->print."\n"; print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n" if $layer->payload; =head1 DESCRIPTION This modules implements the encoding and decoding of the UDP layer. RFC: ftp://ftp.rfc-editor.org/in-notes/rfc768.txt See also B for other attributes and methods. =head1 ATTRIBUTES =over 4 =item B =item B Source and destination ports. =item B The length in bytes of the datagram, including layer 7 payload (that is, layer 4 + layer 7). =item B Checksum of the datagram. =back The following are inherited attributes. See B for more information. =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B (hash) Object constructor. You can pass attributes that will overwrite default ones. See B for default values. =item B Computes various lengths contained within this layer. =item B ({ type => PROTO, src => IP, dst => IP }) In order to compute checksums of TCP, you need to pass the protocol type (IPv4, IPv6), the source and destination IP addresses (IPv4 for IPv4, IPv6 for IPv6). =item B =item B These two methods are basically used to increase the speed when using B method from B. Usually, you write them when you need to write B method. =item B (Net::Frame::Layer::UDP object) This method is mostly used internally. You pass a B layer as a parameter, and it returns true if this is a response corresponding for the request, or returns false if not. =back The following are inherited methods. Some of them may be overridden in this layer, and some others may not be meaningful in this layer. See B for more information. =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 CONSTANTS No constants here. =head1 SEE ALSO L =head1 AUTHOR Patrice EGomoRE Auffret =head1 COPYRIGHT AND LICENSE Copyright (c) 2006-2019, 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-Frame-1.21/t000755001750001750 013471433226 13114 5ustar00gomorgomor000000000000Net-Frame-1.21/t/01-use.t000444001750001750 72113471433226 14430 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame; use Net::Frame::Layer qw(:consts :subs); use Net::Frame::Layer::IPv4 qw(:consts); use Net::Frame::Layer::TCP qw(:consts); use Net::Frame::Layer::UDP qw(:consts); use Net::Frame::Layer::ETH qw(:consts); use Net::Frame::Layer::ARP qw(:consts); use Net::Frame::Layer::NULL qw(:consts); use Net::Frame::Layer::RAW qw(:consts); use Net::Frame::Layer::SLL qw(:consts); use Net::Frame::Layer::PPP qw(:consts); ok(1); Net-Frame-1.21/t/02-pod-coverage.t000444001750001750 114113471433226 16225 0ustar00gomorgomor000000000000eval "use Test::Pod::Coverage tests => 10"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod::Coverage required for testing"); } else { pod_coverage_ok("Net::Frame::Layer::IPv4"); pod_coverage_ok("Net::Frame::Layer::TCP"); pod_coverage_ok("Net::Frame::Layer::UDP"); pod_coverage_ok("Net::Frame::Layer::ARP"); pod_coverage_ok("Net::Frame::Layer::ETH"); pod_coverage_ok("Net::Frame::Layer::NULL"); pod_coverage_ok("Net::Frame::Layer::PPP"); pod_coverage_ok("Net::Frame::Layer::RAW"); pod_coverage_ok("Net::Frame::Layer::SLL"); pod_coverage_ok("Net::Frame::Layer"); } Net-Frame-1.21/t/03-test-pod.t000444001750001750 23113471433226 15371 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-Frame-1.21/t/04-eth.t000444001750001750 36713471433226 14425 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::ETH qw(:consts); my $l = Net::Frame::Layer::ETH->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/05-arp.t000444001750001750 36713471433226 14430 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::ARP qw(:consts); my $l = Net::Frame::Layer::ARP->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/06-ipv4.t000444001750001750 37113471433226 14524 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::IPv4 qw(:consts); my $l = Net::Frame::Layer::IPv4->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/07-raw.t000444001750001750 36713471433226 14441 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::RAW qw(:consts); my $l = Net::Frame::Layer::RAW->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/08-sll.t000444001750001750 36713471433226 14443 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::SLL qw(:consts); my $l = Net::Frame::Layer::SLL->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/09-tcp.t000444001750001750 36713471433226 14440 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::TCP qw(:consts); my $l = Net::Frame::Layer::TCP->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/10-null.t000444001750001750 37113471433226 14607 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::NULL qw(:consts); my $l = Net::Frame::Layer::NULL->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/11-udp.t000444001750001750 36713471433226 14433 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::UDP qw(:consts); my $l = Net::Frame::Layer::UDP->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/12-ppp.t000444001750001750 36713471433226 14443 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 1) } use Net::Frame::Layer::PPP qw(:consts); my $l = Net::Frame::Layer::PPP->new; $l->pack; $l->unpack; print $l->print."\n"; my $encap = $l->encapsulate; $encap ? print "[$encap]\n" : print "[none]\n"; ok(1); Net-Frame-1.21/t/13-gethostsubs.t000444001750001750 345213471433226 16235 0ustar00gomorgomor000000000000use Test; BEGIN { plan(tests => 6) } use Net::Frame::Layer qw(:consts :subs); my $host = 'google.com'; my $ip6 = qr{^[a-f0-9:]+$}; my $ip6v4mapping = qr{^::ffff:\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$}; my $ip4 = qr{^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$}; # # IPv4 functions # ok( sub { my $ip = getHostIpv4Addr($host); if ($ip =~ $ip4) { print "[+] $ip\n"; return 1; # OK } printf(STDERR "[-] 1: $ip\n"); return 0; # NOK }, 1, $@, ); ok( sub { my $a = inetAton("127.0.0.1"); if ($a && unpack('H*', $a) eq '7f000001') { print "[+] ".unpack('H*', $a)."\n"; return 1; # OK } printf(STDERR "[-] 2: ".unpack('H*', $a)."\n"); return 0; # NOK }, 1, $@, ); ok( sub { my $a = inetNtoa(pack('H*', '7f000001')); if ($a && $a eq '127.0.0.1') { print "[+] $a\n"; return 1; # OK } printf(STDERR "[-] 3: $a\n"); return 0; # NOK }, 1, $@, ); # # IPv6 functions # ok( sub { my $ip = getHostIpv6Addr($host); if ($ip =~ $ip6 || $ip =~ $ip6v4mapping) { print "[+] $ip\n"; return 1; # OK } printf(STDERR "[-] 4: $ip\n"); return 0; # NOK }, 1, $@, ); ok( sub { my $a = inet6Aton('::1'); if ($a && unpack('H*', $a) eq '00000000000000000000000000000001') { print "[+] ".unpack('H*', $a)."\n"; return 1; # OK } printf(STDERR "[-] 5: ".unpack('H*', $a)."\n"); return 0; # NOK }, 1, $@, ); ok( sub { my $a = inet6Ntoa(pack('H*', '00000000000000000000000000000001')); if ($a && $a =~ $ip6) { print "[+] $a\n"; return 1; # OK } printf(STDERR "[-] 6: $a\n"); return 0; # NOK }, 1, $@, );