Commit upstream/1.16 - libnet-frame-perl

Imported Upstream version 1.16 Florian Schlichting 8 years ago

21 changed file(s) with 498 addition(s) and 143 deletion(s). Raw diff Collapse all Expand all

+38

-0

Build.PL less more

	0	#
	1	# $Id: Build.PL 365 2015-01-28 19:04:14Z gomor $
	2	#
	3	use strict;
	4	use warnings;
	5
	6	use Module::Build;
	7
	8	my @conditions_modules = ();
	9	eval {
	10	require Socket;
	11	Socket->import(
	12	qw(AF_INET6 getaddrinfo getnameinfo inet_pton inet_ntop)
	13	);
	14	};
	15	if ($@) {
	16	@conditions_modules = ( Socket6 => 0 );
	17	}
	18
	19	my $builder = Module::Build->new(
	20	module_name => 'Net::Frame',
	21	license => 'artistic',
	22	dist_author => 'GomoR <gomor_at_cpan.org>',
	23	dist_version_from => 'lib/Net/Frame.pm',
	24	requires => {
	25	'perl' => '5.6.1',
	26	'Class::Gomor' => '1.00',
	27	'Net::IPv6Addr' => '0',
	28	'Bit::Vector' => '0',
	29	'Socket' => '0',
	30	@conditions_modules,
	31	},
	32	configure_requires => {
	33	'Module::Build' => 0,
	34	},
	35	);
	36
	37	$builder->create_build_script;

+22

-0

Changes less more

0	0	Revision history for Perl extension Net::Frame.
	1
	2	1.16 Mon Nov 16 09:31:06 CET 2015
	3	- bugfix: t/13-gethostsubs.t updated cause gomor.org addresses have changed
	4
	5	1.15 Sun Feb 15 18:09:23 CET 2015
	6	- BUGFIX: IPv4 header length calculation on Mac OS X and OpenBSD
	7	=> Read: support for OpenBSD and Mac OS X now ok
	8	- bugfix: check if inet_ntop/getaddrinfo are really supported by trying to use them.
	9
	10	1.14 Wed Jan 28 20:01:48 CET 2015
	11	- BUGFIX: getHostIpv6addr: not working on FreeBSD/Socket because of nasty getaddrinfo()
	12	- tests: added tests for getHost* subs and inet* subs
	13
	14	1.13 Wed Jan 28 07:49:11 CET 2015
	15	- BUGFIX: getHostIpv6Addr: use getaddrinfo/getnameinfo from Socket or Socket6 where available
	16	=> Thanks to Vince
	17
	18	1.12 Tue Jan 20 19:33:06 CET 2015
	19	- bugfix: TCP/UDP computeChecksums() so 6to4 and other encapsulations work
	20	=> Thanks to Vince
	21	- update: copyright notice
	22	- update: Kwalitee
1	23
2	24	1.11 Tue Apr 8 15:33:43 CEST 2014
3	25	- bugfix: https://rt.cpan.org/Public/Bug/Display.html?id=94035

-2

MANIFEST less more

	0	Build.PL
0	1	Changes
1	2	examples/arp-lookup.pl
2	3	examples/build-tcp-syn.pl
3	4	examples/pack-eth-ipv4-tcp-compute.pl
4	5	examples/pack-eth-ipv4-tcp.pl
	6	examples/resolv-ipv6.pl
5	7	examples/send-recv-tcp.pl
6	8	examples/send-recv-udp.pl
7	9	examples/send-tcp-with-padding.pl

35	37	t/10-null.t
36	38	t/11-udp.t
37	39	t/12-ppp.t
38		META.yml Module YAML meta-data (added by MakeMaker)
39		META.json Module JSON meta-data (added by MakeMaker)
	40	t/13-gethostsubs.t
	41	META.yml
	42	META.json

+48

-16

META.json less more

0	0	{
1	1	"abstract" : "the base framework for frame crafting",
2	2	"author" : [
3		"GomoR <gomor-cpan_at_gomor.org>"
	3	"GomoR <gomor_at_cpan.org>"
4	4	],
5	5	"dynamic_config" : 1,
6		"generated_by" : "ExtUtils::MakeMaker version 6.94, CPAN::Meta::Converter version 2.132510",
	6	"generated_by" : "Module::Build version 0.421",
7	7	"license" : [
8	8	"artistic_1"
9	9	],

12	12	"version" : "2"
13	13	},
14	14	"name" : "Net-Frame",
15		"no_index" : {
16		"directory" : [
17		"t",
18		"inc"
19		]
20		},
21	15	"prereqs" : {
22		"build" : {
23		"requires" : {
24		"ExtUtils::MakeMaker" : "0"
25		}
26		},
27	16	"configure" : {
28	17	"requires" : {
29		"ExtUtils::MakeMaker" : "0"
	18	"Module::Build" : "0"
30	19	}
31	20	},
32	21	"runtime" : {
33	22	"requires" : {
34	23	"Bit::Vector" : "0",
35	24	"Class::Gomor" : "1.00",
36		"Net::IPv6Addr" : "0"
	25	"Net::IPv6Addr" : "0",
	26	"Socket" : "0",
	27	"perl" : "v5.6.1"
37	28	}
38	29	}
39	30	},
	31	"provides" : {
	32	"Net::Frame" : {
	33	"file" : "lib/Net/Frame.pm",
	34	"version" : "1.16"
	35	},
	36	"Net::Frame::Layer" : {
	37	"file" : "lib/Net/Frame/Layer.pm"
	38	},
	39	"Net::Frame::Layer::ARP" : {
	40	"file" : "lib/Net/Frame/Layer/ARP.pm"
	41	},
	42	"Net::Frame::Layer::ETH" : {
	43	"file" : "lib/Net/Frame/Layer/ETH.pm"
	44	},
	45	"Net::Frame::Layer::IPv4" : {
	46	"file" : "lib/Net/Frame/Layer/IPv4.pm"
	47	},
	48	"Net::Frame::Layer::NULL" : {
	49	"file" : "lib/Net/Frame/Layer/NULL.pm"
	50	},
	51	"Net::Frame::Layer::PPP" : {
	52	"file" : "lib/Net/Frame/Layer/PPP.pm"
	53	},
	54	"Net::Frame::Layer::RAW" : {
	55	"file" : "lib/Net/Frame/Layer/RAW.pm"
	56	},
	57	"Net::Frame::Layer::SLL" : {
	58	"file" : "lib/Net/Frame/Layer/SLL.pm"
	59	},
	60	"Net::Frame::Layer::TCP" : {
	61	"file" : "lib/Net/Frame/Layer/TCP.pm"
	62	},
	63	"Net::Frame::Layer::UDP" : {
	64	"file" : "lib/Net/Frame/Layer/UDP.pm"
	65	}
	66	},
40	67	"release_status" : "stable",
41		"version" : "1.11"
	68	"resources" : {
	69	"license" : [
	70	"http://www.perlfoundation.org/artistic_license_1_0"
	71	]
	72	},
	73	"version" : "1.16"
42	74	}

+37

-14

META.yml less more

0	0	---
1	1	abstract: 'the base framework for frame crafting'
2	2	author:
3		- 'GomoR <gomor-cpan_at_gomor.org>'
4		build_requires:
5		ExtUtils::MakeMaker: 0
	3	- 'GomoR <gomor_at_cpan.org>'
	4	build_requires: {}
6	5	configure_requires:
7		ExtUtils::MakeMaker: 0
	6	Module::Build: '0'
8	7	dynamic_config: 1
9		generated_by: 'ExtUtils::MakeMaker version 6.94, CPAN::Meta::Converter version 2.132510'
	8	generated_by: 'Module::Build version 0.421, CPAN::Meta::Converter version 2.142690'
10	9	license: artistic
11	10	meta-spec:
12	11	url: http://module-build.sourceforge.net/META-spec-v1.4.html
13		version: 1.4
	12	version: '1.4'
14	13	name: Net-Frame
15		no_index:
16		directory:
17		- t
18		- inc
	14	provides:
	15	Net::Frame:
	16	file: lib/Net/Frame.pm
	17	version: '1.16'
	18	Net::Frame::Layer:
	19	file: lib/Net/Frame/Layer.pm
	20	Net::Frame::Layer::ARP:
	21	file: lib/Net/Frame/Layer/ARP.pm
	22	Net::Frame::Layer::ETH:
	23	file: lib/Net/Frame/Layer/ETH.pm
	24	Net::Frame::Layer::IPv4:
	25	file: lib/Net/Frame/Layer/IPv4.pm
	26	Net::Frame::Layer::NULL:
	27	file: lib/Net/Frame/Layer/NULL.pm
	28	Net::Frame::Layer::PPP:
	29	file: lib/Net/Frame/Layer/PPP.pm
	30	Net::Frame::Layer::RAW:
	31	file: lib/Net/Frame/Layer/RAW.pm
	32	Net::Frame::Layer::SLL:
	33	file: lib/Net/Frame/Layer/SLL.pm
	34	Net::Frame::Layer::TCP:
	35	file: lib/Net/Frame/Layer/TCP.pm
	36	Net::Frame::Layer::UDP:
	37	file: lib/Net/Frame/Layer/UDP.pm
19	38	requires:
20		Bit::Vector: 0
21		Class::Gomor: 1.00
22		Net::IPv6Addr: 0
23		version: 1.11
	39	Bit::Vector: '0'
	40	Class::Gomor: '1.00'
	41	Net::IPv6Addr: '0'
	42	Socket: '0'
	43	perl: v5.6.1
	44	resources:
	45	license: http://www.perlfoundation.org/artistic_license_1_0
	46	version: '1.16'

+15

-12

Makefile.PL less more

0	0	#
1		# $Id: Makefile.PL 353 2014-03-10 12:25:04Z gomor $
	1	# $Id: Makefile.PL 365 2015-01-28 19:04:14Z gomor $
2	2	#
3	3	use ExtUtils::MakeMaker;
4	4

6	6
7	7	my @conditions_modules = ();
8	8	eval {
9		require Socket;
10		Socket->import(
11		qw(AF_INET6 NI_NUMERICHOST NI_NUMERICSERV getaddrinfo getnameinfo inet_pton inet_ntop));
	9	require Socket;
	10	Socket->import(
	11	qw(AF_INET6 getaddrinfo getnameinfo inet_pton inet_ntop)
	12	);
12	13	};
13	14	if ($@) {
14		@conditions_modules = ( Socket6 => 0 );
	15	@conditions_modules = ( Socket6 => 0 );
15	16	}
16	17
17	18	WriteMakefile(
18		NAME => 'Net::Frame',
19		VERSION_FROM => 'lib/Net/Frame.pm',
20		LICENSE => 'artistic',
	19	NAME => 'Net::Frame',
	20	VERSION_FROM => 'lib/Net/Frame.pm',
	21	LICENSE => 'artistic',
21	22	ABSTRACT_FROM => 'lib/Net/Frame.pm',
22		AUTHOR => 'GomoR <gomor-cpan_at_gomor.org>',
23		PREREQ_PM => {
24		Class::Gomor => '1.00',
	23	AUTHOR => 'GomoR <gomor_at_cpan.org>',
	24	MIN_PERL_VERSION => '5.6.1',
	25	PREREQ_PM => {
	26	Class::Gomor => '1.00',
25	27	Net::IPv6Addr => 0,
26		Bit::Vector => 0,
	28	Bit::Vector => 0,
	29	Socket => 0,
27	30	@conditions_modules,
28	31	},
29	32	);

-6

README less more

13	13
14	14	This module requires these other modules and libraries:
15	15
16		Perl v5.6.1
17		Bit::Vector
18		Class::Gomor
19		Net::IPv6Addr
20		Socket6
	16	Perl v5.6.1
	17	Bit::Vector
	18	Class::Gomor
	19	Net::IPv6Addr
	20	Socket
	21	Socket6 (optional if Socket module supports IPv6)
21	22
22	23	GETTING HELP
23	24

30	31	You may distribute this module under the terms of the Artistic license.
31	32	See LICENSE.Artistic file in the source distribution archive.
32	33
33		Copyright (c) 2006-2014, Patrice <GomoR> Auffret
	34	Copyright (c) 2006-2015, Patrice <GomoR> Auffret
34	35

-0

examples/resolv-ipv6.pl less more

	0	#!/usr/bin/perl
	1	use strict;
	2	use warnings;
	3
	4	use Net::Frame::Layer qw(:subs);
	5
	6	print getHostIpv6Addr('www.google.com')."\n";

-0

examples/send-recv-tcp.pl less more

33	33	my $oSimple = Net::Frame::Simple->new(
34	34	layers => [ $ip4, $tcp ],
35	35	);
	36	print "raw: ".unpack('H*', $oSimple->raw)."\n";
36	37	$oWrite->open;
37	38	$oSimple->send($oWrite);
38	39	$oWrite->close;

-2

lib/Net/Frame/Layer/ARP.pm less more

0	0	#
1		# $Id: ARP.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: ARP.pm 360 2015-01-20 18:36:06Z gomor $
2	2	#
3	3	package Net::Frame::Layer::ARP;
4	4	use strict;

375	375
376	376	=head1 COPYRIGHT AND LICENSE
377	377
378		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	378	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
379	379
380	380	You may distribute this module under the terms of the Artistic license.
381	381	See LICENSE.Artistic file in the source distribution archive.

-2

lib/Net/Frame/Layer/ETH.pm less more

0	0	#
1		# $Id: ETH.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: ETH.pm 360 2015-01-20 18:36:06Z gomor $
2	2	#
3	3	package Net::Frame::Layer::ETH;
4	4	use strict;

404	404
405	405	=head1 COPYRIGHT AND LICENSE
406	406
407		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	407	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
408	408
409	409	You may distribute this module under the terms of the Artistic license.
410	410	See LICENSE.Artistic file in the source distribution archive.

-2

lib/Net/Frame/Layer/IPv4.pm less more

0	0	#
1		# $Id: IPv4.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: IPv4.pm 367 2015-02-15 17:11:07Z gomor $
2	2	#
3	3	package Net::Frame::Layer::IPv4;
4	4	use strict;

102	102	my $osname = {
103	103	freebsd => [ \&_fixLenBsd, ],
104	104	netbsd => [ \&_fixLenBsd, ],
	105	openbsd => [ \&_fixLenBsd, ],
	106	darwin => [ \&_fixLenBsd, ],
105	107	};
106	108
107	109	*_fixLen = $osname->{$^O}->[0] \|\| \&_fixLenOther;

586	588
587	589	=head1 COPYRIGHT AND LICENSE
588	590
589		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	591	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
590	592
591	593	You may distribute this module under the terms of the Artistic license.
592	594	See LICENSE.Artistic file in the source distribution archive.

-2

lib/Net/Frame/Layer/NULL.pm less more

0	0	#
1		# $Id: NULL.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: NULL.pm 360 2015-01-20 18:36:06Z gomor $
2	2	#
3	3	package Net::Frame::Layer::NULL;
4	4	use strict;

286	286
287	287	=head1 COPYRIGHT AND LICENSE
288	288
289		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	289	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
290	290
291	291	You may distribute this module under the terms of the Artistic license.
292	292	See LICENSE.Artistic file in the source distribution archive.

-2

lib/Net/Frame/Layer/PPP.pm less more

0	0	#
1		# $Id: PPP.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: PPP.pm 360 2015-01-20 18:36:06Z gomor $
2	2	#
3	3	package Net::Frame::Layer::PPP;
4	4	use strict;

231	231
232	232	=head1 COPYRIGHT AND LICENSE
233	233
234		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	234	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
235	235
236	236	You may distribute this module under the terms of the Artistic license.
237	237	See LICENSE.Artistic file in the source distribution archive.

-2

lib/Net/Frame/Layer/RAW.pm less more

0	0	#
1		# $Id: RAW.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: RAW.pm 360 2015-01-20 18:36:06Z gomor $
2	2	#
3	3	package Net::Frame::Layer::RAW;
4	4	use strict;

157	157
158	158	=head1 COPYRIGHT AND LICENSE
159	159
160		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	160	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
161	161
162	162	You may distribute this module under the terms of the Artistic license.
163	163	See LICENSE.Artistic file in the source distribution archive.

-2

lib/Net/Frame/Layer/SLL.pm less more

0	0	#
1		# $Id: SLL.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: SLL.pm 360 2015-01-20 18:36:06Z gomor $
2	2	#
3	3	package Net::Frame::Layer::SLL;
4	4	use strict;

384	384
385	385	=head1 COPYRIGHT AND LICENSE
386	386
387		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	387	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
388	388
389	389	You may distribute this module under the terms of the Artistic license.
390	390	See LICENSE.Artistic file in the source distribution archive.

-4

lib/Net/Frame/Layer/TCP.pm less more

0	0	#
1		# $Id: TCP.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: TCP.pm 360 2015-01-20 18:36:06Z gomor $
2	2	#
3	3	package Net::Frame::Layer::TCP;
4	4	use strict; use warnings;

180	180	if ($l->layer eq 'IPv4') {
181	181	$phpkt = $self->SUPER::pack('a4a4CCn',
182	182	inetAton($l->src), inetAton($l->dst), 0, 6, $len);
183		last;
184	183	}
185	184	elsif ($l->layer eq 'IPv6') {
186	185	$phpkt = $self->SUPER::pack('aaNnCC',
187	186	inet6Aton($l->src), inet6Aton($l->dst), $len, 0, 0, 6);
188		last;
189	187	}
190	188	}
191	189

463	461
464	462	=head1 COPYRIGHT AND LICENSE
465	463
466		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	464	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
467	465
468	466	You may distribute this module under the terms of the Artistic license.
469	467	See LICENSE.Artistic file in the source distribution archive.

-4

lib/Net/Frame/Layer/UDP.pm less more

0	0	#
1		# $Id: UDP.pm 356 2014-04-08 13:15:27Z gomor $
	1	# $Id: UDP.pm 360 2015-01-20 18:36:06Z gomor $
2	2	#
3	3	package Net::Frame::Layer::UDP;
4	4	use strict;

115	115	if ($l->layer eq 'IPv4') {
116	116	$phpkt = $self->SUPER::pack('a4a4CCn',
117	117	inetAton($l->src), inetAton($l->dst), 0, 17, $self->[$__length]);
118		last;
119	118	}
120	119	elsif ($l->layer eq 'IPv6') {
121	120	$phpkt = $self->SUPER::pack('aaNnCC',
122	121	inet6Aton($l->src), inet6Aton($l->dst), $self->[$__length],
123	122	0, 0, 17);
124		last;
125	123	}
126	124	}
127	125

331	329
332	330	=head1 COPYRIGHT AND LICENSE
333	331
334		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	332	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
335	333
336	334	You may distribute this module under the terms of the Artistic license.
337	335	See LICENSE.Artistic file in the source distribution archive.

+197

-68

lib/Net/Frame/Layer.pm less more

0	0	#
1		# $Id: Layer.pm 357 2014-04-08 13:34:04Z gomor $
	1	# $Id: Layer.pm 367 2015-02-15 17:11:07Z gomor $
2	2	#
3	3	package Net::Frame::Layer;
4	4	use strict;

94	94	# Useful subroutines
95	95	#
96	96
97		# load AF_INET and default imports from Socket. Safe back to at least 5.8.8
	97	# Load AF_INET and default imports from Socket. Safe back to at least 5.8.8.
98	98	use Socket qw(:DEFAULT AF_INET);
	99
	100	sub _setInet6Sub {
	101	no strict 'refs';
	102
	103	my $inetp_found = 0;
	104
	105	# Check Socket against some IPv6 functions and constants.
	106	eval {
	107	require Socket;
	108	Socket->import(qw(AF_INET6 inet_pton inet_ntop));
	109	};
	110	if (! $@) { # Socket has support for required functions and constants.
	111	*{__PACKAGE__.'::_inet_pton'} = \&Socket::inet_pton;
	112	*{__PACKAGE__.'::_inet_ntop'} = \&Socket::inet_ntop;
	113
	114	$inetp_found = 1;
	115	}
	116
	117	# Fallback to Socket6
	118	if (! $inetp_found) {
	119	eval {
	120	require Socket6;
	121	Socket6->import(qw(AF_INET6 inet_pton inet_ntop));
	122	};
	123	if (! $@) { # Socket6 has support for required functions and constants.
	124	*{__PACKAGE__.'::_inet_pton'} = \&Socket6::inet_pton;
	125	*{__PACKAGE__.'::_inet_ntop'} = \&Socket6::inet_ntop;
	126	}
	127	}
	128
	129	# Unfortunately, we have to test if inet_ntop()/inet_pton() works (i.e., are implemented)
	130	# If no support for inet_ntop/inet_pton, we branch to fake functions.
	131	if ($inetp_found) {
	132	eval {
	133	# inet_pton() may exist, but die with:
	134	# inet_pton not implemented on this architecture
	135	_inet_pton(AF_INET6(), "::1");
	136	};
	137	if ($@) {
	138	print "[!] inet_pton support: $@\n";
	139	*{__PACKAGE__.'::_inet_pton'} = sub { return 0; };
	140	*{__PACKAGE__.'::_inet_ntop'} = sub { return 0; };
	141	}
	142	else {
	143	return 1; # OK
	144	}
	145	}
	146
	147	die("[-] Net::Frame: inet_pton/inet_ntop: not supported by Socket nor Socket6: ".
	148	"try upgrading your Perl version or Socket/Socket6 modules.\n");
	149	}
	150
	151	sub _setGetAddressSub {
	152	no strict 'refs';
	153
	154	my $getaddr_found = 0;
	155
	156	# Check Socket against some IPv6 functions and constants.
	157	eval {
	158	require Socket;
	159	Socket->import(qw(getaddrinfo getnameinfo AF_INET6));
	160	};
	161	if (! $@) { # Socket has support for required functions and constants.
	162	*{__PACKAGE__.'::_getAddress'} = sub {
	163	my ($name) = @_;
	164
	165	#print STDERR "*** Socket supports IPv6 OK\n";
	166
	167	my %hints = (
	168	family => Socket::AF_INET6(),
	169	);
	170	my ($err, @res) = Socket::getaddrinfo($name, '', \%hints);
	171	if ($err) {
	172	carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname: getaddrinfo: $err\n");
	173	return;
	174	}
	175	if (@res > 0) {
	176	my $h = $res[0];
	177	my ($err, $ipv6) = Socket::getnameinfo(
	178	$h->{addr}, Socket::NI_NUMERICHOST() \| Socket::NI_NUMERICSERV()
	179	);
	180	if ($err) {
	181	carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname: getnameinfo: $err\n");
	182	return;
	183	}
	184
	185	return $ipv6;
	186	}
	187	else {
	188	carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname: getaddrinfo: $!\n");
	189	return;
	190	}
	191	};
	192
	193	$getaddr_found = 1;
	194	}
	195
	196	# Fallback to Socket6
	197	if (! $getaddr_found) {
	198	eval {
	199	require Socket6;
	200	Socket6->import(qw(getaddrinfo getnameinfo AF_INET6));
	201	};
	202	if (! $@) { # Socket6 has support for required functions and constants.
	203	*{__PACKAGE__.'::_getAddress'} = sub {
	204	my ($name) = @_;
	205
	206	#print STDERR "*** Fallback to Socket6 support\n";
	207
	208	my @res = Socket6::getaddrinfo($name, '', Socket6::AF_INET6(), SOCK_STREAM);
	209	if (@res >= 5) {
	210	my ($ipv6) = Socket6::getnameinfo(
	211	$res[3], Socket6::NI_NUMERICHOST() \| Socket6::NI_NUMERICSERV()
	212	);
	213
	214	return $ipv6;
	215	}
	216	};
	217	}
	218
	219	$getaddr_found = 1;
	220	}
	221
	222	# Unfortunately, we have to test if INET6 family is supported
	223	# If no support, we branch to fake functions.
	224	if ($getaddr_found) {
	225	eval {
	226	# getaddrinfo() may exist, but die with:
	227	# getaddrinfo: ai_family not supported
	228	_getAddress("::1");
	229	};
	230	if ($@) {
	231	print "[!] getaddrinfo support: $@\n";
	232	*{__PACKAGE__.'::_getAddress'} = sub { return 0; };
	233	*{__PACKAGE__.'::_getAddress'} = sub { return 0; };
	234	}
	235	else {
	236	return 1; # OK
	237	}
	238	}
	239
	240	die("[-] Net::Frame: getaddrinfo/getnameinfo: not supported by Socket nor Socket6: ".
	241	"try upgrading your Perl version or Socket/Socket6 modules.\n");
	242	}
	243
99	244	BEGIN {
100		# imports that may or may not be in Socket.
101		my @imports = (
102		qw(AF_INET6 NI_NUMERICHOST NI_NUMERICSERV getaddrinfo getnameinfo));
103		my @socket6_imports;
104
105		# This might be overkill, but I'm not certain that all these imports
106		# were added to Socket at the same time.
107		for my $export (@imports) {
108		eval { Socket->import($export); };
109		if ($@) {
110		push @socket6_imports, $export;
111		}
112		}
113
114		eval {
115		# Test to see if the sub works.
116		# Socket::inet_ntop() may exist, but die with:
117		# Socket::inet_ntop not implemented on this architecture
118		Socket::inet_ntop( AF_INET, "\0\0\0\0" ); # test
119		Socket->import('inet_ntop'); # import if the test doesn't die
120		};
121		if ($@) {
122		push @socket6_imports, 'inet_ntop';
123		}
124		eval {
125		# Test to see if the sub works.
126		# Socket::inet_pton() may exist, but die with:
127		# Socket::inet_pton not implemented on this architecture
128		Socket::inet_pton( AF_INET, '0.0.0.0' ); # test
129		Socket->import('inet_pton'); # import if the test doesn't die
130		};
131		if ($@) {
132		push @socket6_imports, 'inet_pton';
133		}
134
135		if (@socket6_imports) {
136
137		# something we want wasn't found in Socket time to try Socket6
138		eval { require Socket6 };
139		die $@ if $@;
140		Socket6->import(@socket6_imports);
141		}
	245	_setInet6Sub();
	246	_setGetAddressSub();
142	247	}
143	248
144	249	require Net::IPv6Addr;

146	251	sub getHostIpv4Addr {
147	252	my ($name) = @_;
148	253
149		return undef unless $name;
150		return $name if $name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
	254	# No address given
	255	if (! defined($name)) {
	256	return;
	257	}
	258
	259	# Already an IPv4 address
	260	if ($name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
	261	return $name;
	262	}
151	263
152	264	my @addrs = (gethostbyname($name))[4];
153	265	@addrs ? return join('.', CORE::unpack('C4', $addrs[0]))
154	266	: carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n");
155		return undef;
	267
	268	# Error
	269	return;
156	270	}
157	271
158	272	sub getHostIpv4Addrs {
159	273	my ($name) = @_;
160	274
161		return undef unless $name;
162		return $name if $name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
	275	# No address given
	276	if (! defined($name)) {
	277	return;
	278	}
	279
	280	# Already an IPv4 address
	281	if ($name =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
	282	return $name;
	283	}
163	284
164	285	my @addrs = (gethostbyname($name))[4];
165	286	@addrs ? return @addrs
166	287	: carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n");
	288
	289	# Error
167	290	return ();
168	291	}
169	292
170	293	sub getHostIpv6Addr {
171	294	my ($name) = @_;
172	295
173		return undef unless $name;
174		return $name if Net::IPv6Addr::is_ipv6($name);
175
176		my @res = getaddrinfo($name, 'ssh', AF_INET6, SOCK_STREAM);
177		if (@res >= 5) {
178		my ($ipv6) = getnameinfo($res[3], NI_NUMERICHOST \| NI_NUMERICSERV);
179		$ipv6 =~ s/%.*$//;
180		return $ipv6;
181		}
182		else {
	296	# No address given
	297	if (! defined($name)) {
	298	return;
	299	}
	300
	301	# Already an IPv6 address
	302	if (Net::IPv6Addr::is_ipv6($name)) {
	303	return $name;
	304	}
	305
	306	my $ipv6 = _getAddress($name);
	307	if (! defined($ipv6)) {
183	308	carp("@{[(caller(0))[3]]}: unable to resolv `$name' hostname\n");
184		}
185		undef;
186		}
187
188		sub inetAton { inet_aton(shift()) }
189		sub inetNtoa { inet_ntoa(shift()) }
190		sub inet6Aton { inet_pton(AF_INET6, shift()) }
191		sub inet6Ntoa { inet_ntop(AF_INET6, shift()) }
	309	return;
	310	}
	311
	312	$ipv6 =~ s/%.*$//;
	313
	314	return $ipv6;
	315	}
	316
	317	sub inetAton { Socket::inet_aton(shift()) }
	318	sub inetNtoa { Socket::inet_ntoa(shift()) }
	319	sub inet6Aton { _inet_pton(AF_INET6, shift()) }
	320	sub inet6Ntoa { _inet_ntop(AF_INET6, shift()) }
192	321
193	322	sub getRandomHighPort {
194	323	my $highPort = int rand 0xffff;

374	503
375	504	=head1 COPYRIGHT AND LICENSE
376	505
377		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	506	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
378	507
379	508	You may distribute this module under the terms of the Artistic license.
380	509	See LICENSE.Artistic file in the source distribution archive.

-3

lib/Net/Frame.pm less more

0	0	#
1		# $Id: Frame.pm 357 2014-04-08 13:34:04Z gomor $
	1	# $Id: Frame.pm 369 2015-11-16 08:40:19Z gomor $
2	2	#
3	3	package Net::Frame;
4	4	use strict;
5	5	use warnings;
6	6
7		our $VERSION = '1.11';
	7	our $VERSION = '1.16';
8	8
9	9	1;
10	10

83	83
84	84	=head1 COPYRIGHT AND LICENSE
85	85
86		Copyright (c) 2006-2014, Patrice E<lt>GomoRE<gt> Auffret
	86	Copyright (c) 2006-2015, Patrice E<lt>GomoRE<gt> Auffret
87	87
88	88	You may distribute this module under the terms of the Artistic license.
89	89	See LICENSE.Artistic file in the source distribution archive.

+98

-0

t/13-gethostsubs.t less more

	0	use Test;
	1	BEGIN { plan(tests => 6) }
	2
	3	use Net::Frame::Layer qw(:consts :subs);
	4
	5	my $host = 'gomor.org';
	6	my $ip6 = '2001:41d0:2:1a47::2';
	7	my $ip4 = '94.23.25.71';
	8
	9	#
	10	# IPv4 functions
	11	#
	12	ok(
	13	sub {
	14	my $ip = getHostIpv4Addr($host);
	15	if ($ip eq $ip4) {
	16	print "[+] $ip\n";
	17	return 1; # OK
	18	}
	19	print "[-] $ip\n";
	20	return 0; # NOK
	21	},
	22	1,
	23	$@,
	24	);
	25
	26	ok(
	27	sub {
	28	my $a = inetAton("127.0.0.1");
	29	if ($a && unpack('H*', $a) eq '7f000001') {
	30	print "[+] ".unpack('H*', $a)."\n";
	31	return 1; # OK
	32	}
	33	print "[-] ".unpack('H*', $a)."\n";
	34	return 0; # NOK
	35	},
	36	1,
	37	$@,
	38	);
	39
	40	ok(
	41	sub {
	42	my $a = inetNtoa(pack('H*', '7f000001'));
	43	if ($a && $a eq '127.0.0.1') {
	44	print "[+] $a\n";
	45	return 1; # OK
	46	}
	47	print "[-] $a\n";
	48	return 0; # NOK
	49	},
	50	1,
	51	$@,
	52	);
	53
	54	#
	55	# IPv6 functions
	56	#
	57	ok(
	58	sub {
	59	my $ip = getHostIpv6Addr($host);
	60	if ($ip eq $ip6) {
	61	print "[+] $ip\n";
	62	return 1; # OK
	63	}
	64	print "[-] $ip\n";
	65	return 0; # NOK
	66	},
	67	1,
	68	$@,
	69	);
	70
	71	ok(
	72	sub {
	73	my $a = inet6Aton($ip6);
	74	if ($a && unpack('H*', $a) eq '200141d000021a470000000000000002') {
	75	print "[+] ".unpack('H*', $a)."\n";
	76	return 1; # OK
	77	}
	78	print "[-] ".unpack('H*', $a)."\n";
	79	return 0; # NOK
	80	},
	81	1,
	82	$@,
	83	);
	84
	85	ok(
	86	sub {
	87	my $a = inet6Ntoa(pack('H*', '200141d000021a470000000000000002'));
	88	if ($a && $a eq $ip6) {
	89	print "[+] $a\n";
	90	return 1; # OK
	91	}
	92	print "[-] $a\n";
	93	return 0; # NOK
	94	},
	95	1,
	96	$@,
	97	);