Commit 679b6dda6f6a520c0d6b2f4f3e9a701b5e8f9999 - libnet-upnp-perl

+17

-0

AUTHORS less more

	0	Net::UPnP
	1
	2	Maintainer:
	3
	4	Satoshi Konno <skonno@cybergarage.org>
	5
	6	Authors:
	7
	8	Satoshi Konno <skonno@cybergarage.org>
	9
	10	Contributors:
	11
	12	Christian KrauBe
	13	miz <miz999@gmail.com>
	14	Tim Engler <engler@gmail.com>
	15	Thomas Liske <thomas@fiasko-nw.net>
	16	Ted Lyngmo <ted@lyncon.se>

+9

-4

Changes less more

0	0	Revision history for Perl extension UPnP.
1	1
2		2014-10-16 Satoshi Konno <skonno@cybergarage.org>
3		* v1.4.3
4		* Added Build.PL for Module::Build.
5		* Updated MANIFEST and Makefile.PL.
	2	2018-11-09 Satoshi Konno <skonno@cybergarage.org>
	3	* v1.4.5
	4	* Thanks for Ted Lyngmo <ted@lyncon.se>
	5	* Fallback for deprecated QueryStateVariable(PortMappingNumberOfEntries).
	6
	7	2018-05-21 Satoshi Konno <skonno@cybergarage.org>
	8	* v1.4.4
	9	* Thanks for Ted Lyngmo <ted@lyncon.se>
	10	* Bugfix: Unusual device locations should not crash the program.
6	11
7	12	2013-12-27 Thomas Liske <thomas at fiasko-nw.net>
8	13	* Implement handling of chunked "Transfer-Encoding".

+19

-18

MANIFEST less more

	0	AUTHORS
0	1	Build.PL
1	2	Changes
	3	examples/dms2vodcast.pl
	4	examples/upnpavchk.pl
	5	examples/upnpavdump.pl
	6	examples/upnpavsimple.pl
	7	examples/upnpchk.pl
2	8	examples/upnpdump.pl
3		examples/upnpchk.pl
4		examples/upnpavdump.pl
5		examples/upnpavchk.pl
6		examples/upnpavsimple.pl
7		examples/dms2vodcast.pl
8	9	examples/upnpgwdump.pl
9	10	examples/upnpgwtool.pl
10	11	lib/Net/UPnP.pm
	12	lib/Net/UPnP/ActionResponse.pm
	13	lib/Net/UPnP/AV/Container.pm
	14	lib/Net/UPnP/AV/Content.pm
	15	lib/Net/UPnP/AV/Item.pm
	16	lib/Net/UPnP/AV/MediaRenderer.pm
	17	lib/Net/UPnP/AV/MediaServer.pm
	18	lib/Net/UPnP/ControlPoint.pm
11	19	lib/Net/UPnP/Device.pm
	20	lib/Net/UPnP/GW/Gateway.pm
	21	lib/Net/UPnP/HTTP.pm
	22	lib/Net/UPnP/HTTPResponse.pm
	23	lib/Net/UPnP/QueryResponse.pm
12	24	lib/Net/UPnP/Service.pm
13		lib/Net/UPnP/GW/Gateway.pm
14		lib/Net/UPnP/ControlPoint.pm
15		lib/Net/UPnP/AV/MediaServer.pm
16		lib/Net/UPnP/AV/Container.pm
17		lib/Net/UPnP/AV/MediaRenderer.pm
18		lib/Net/UPnP/AV/Item.pm
19		lib/Net/UPnP/AV/Content.pm
20		lib/Net/UPnP/HTTPResponse.pm
21		lib/Net/UPnP/HTTP.pm
22		lib/Net/UPnP/QueryResponse.pm
23		lib/Net/UPnP/ActionResponse.pm
24	25	Makefile.PL
25	26	MANIFEST
	27	META.json
	28	META.yml
26	29	README
27	30	t/UPnP.t
28		META.yml
29		META.json

+1

-1

META.json less more

37	37	}
38	38	},
39	39	"release_status" : "stable",
40		"version" : "v1.4.4"
	40	"version" : "v1.4.5"
41	41	}

+1

-1

META.yml less more

19	19	requires:
20	20	Test::More: 0
21	21	version: 0
22		version: v1.4.4
	22	version: v1.4.5

+2

-2

README less more

0		Net::UPnP version 1.4.4
	0	Net::UPnP version 1.4.5
1	1	===========================
2	2
3	3	The README is used to introduce the module and provide instructions on

22	22
23	23	COPYRIGHT AND LICENCE
24	24
25		Copyright (C) 2005-2014 Satoshi Konno
	25	Copyright (C) 2005 Satoshi Konno
26	26	All rights reserved.
27	27
28	28	Redistribution and use in source and binary forms, with or without

+1

-1

examples/upnpgwdump.pl less more

26	26	print "\tExternalIPAddress = " . $gwdev->getexternalipaddress() . "\n";
27	27	print "\tPortMappingNumberOfEntries = " . $gwdev->getportmappingnumberofentries() . "\n";
28	28	print "\tTotalBytesRecived = " . $gwdev->gettotalbytesrecieved() . "\n";
29		@port_mapping = $gwdev->getportmappingentry();
	29	@port_mapping = $gwdev->getportmappingentries();
30	30	$port_num = 0;
31	31	foreach $port_entry (@port_mapping) {
32	32	if ($port_entry) {

+1

-1

examples/upnpgwtool.pl less more

116	116	if ($command eq "list") {
117	117	print " ExternalIPAddress = " . $gwdev->getexternalipaddress() . "\n";
118	118	print " PortMappingNumberOfEntries = " . $gwdev->getportmappingnumberofentries() . "\n";
119		@port_mapping = $gwdev->getportmappingentry();
	119	@port_mapping = $gwdev->getportmappingentries();
120	120	$port_num = 0;
121	121	foreach $port_entry (@port_mapping) {
122	122	if ($port_entry) {

+1

-0

lib/Net/UPnP/ControlPoint.pm less more

87	87	$dev_location = $1;
88	88	print "dev_location=$dev_location\n" if ($Net::UPnP::DEBUG);
89	89	unless ($dev_location =~ m{http://([0-9a-z.-]+)(?::(\d+))?/(.*)}i) {
	90	print "bad dev_location: $dev_location\n" if ($Net::UPnP::DEBUG);
90	91	next;
91	92	}
92	93	$dev_addr = $1;

+64

-70

lib/Net/UPnP/GW/Gateway.pm less more

80	80	# getportmappingnumberofentries
81	81	#------------------------------
82	82
83		sub getportmappingnumberofentries{
	83	sub getportmappingnumberofentries {
84	84	my($this) = shift;
85	85
86	86	my (

95	95	return 0;
96	96	}
97	97
98		$query_res = $wanipcon_service->postquery("PortMappingNumberOfEntries");
	98	$query_res = $wanipcon_service->postquery("PortMappingNumberOfEntries");
99	99
100	100	if ($query_res->getstatuscode() != 200) {
101	101	return 0;
102	102	}
103
104		return $query_res->getvalue();
	103
	104	if( $query_res->getvalue() =~ /^(\d+)$/ ) {
	105	return $1;
	106	} else {
	107	return scalar($this->getportmappingentries());
	108	}
105	109	}
106	110
107	111

109	113	# getportmapping
110	114	#------------------------------
111	115
112		sub getportmappingentry {
	116	sub getportmappingentries {
113	117	my($this) = shift;
114	118
115	119	my (

124	128	$ipaddr,
125	129	);
126	130
127		@port_mapping = ();
128
129		$port_mapping_num = $this->getportmappingnumberofentries();
130		if ($port_mapping_num <= 0) {
131		return @port_mapping;
132		}
133
134	131	$dev = $this->getdevice();
135	132	$wanipcon_service = $dev->getservicebyname($Net::UPnP::GW::Gateway::WANIPCONNECTION_SERVICE_TYPE);
136	133	unless ($wanipcon_service) {
137		return @port_mapping ;
138		}
139
140		for ($n=0; $n<$port_mapping_num; $n++) {
141		#print "[$n]";
	134	return @port_mapping;
	135	}
	136
	137	$n = 0;
	138	while( 1 ) {
142	139	%req_arg = (
143	140	'NewPortMappingIndex' => $n,
144	141	);

146	143	$action_res = $wanipcon_service->postaction("GetGenericPortMappingEntry", \%req_arg);
147	144	#print "[$n]" .$action_res->getstatuscode() . "\n";
148	145	#print %req_arg;
149		if ($action_res->getstatuscode() != 200) {
150		push(@port_mapping, undef);
151		next;
152		}
	146	last if ($action_res->getstatuscode() != 200);
153	147	$arg_list = $action_res->getargumentlist();
154	148	#print $arg_list;
155	149	push(@port_mapping, $arg_list);
	150	++$n;
156	151	}
157	152
158	153	return @port_mapping;
159	154	}
	155
	156	# deprecated method - mapped to new name
	157	sub getportmappingentry { getportmappingentries(@_); }
	158
160	159
161	160	#------------------------------
162	161	# addportmapping

320	319
321	320	=head1 SYNOPSIS
322	321
323		use Net::UPnP::ControlPoint;
324		use Net::UPnP::GW::Gateway;
325
326		my $obj = Net::UPnP::ControlPoint->new();
327
328		@dev_list = ();
329		while (@dev_list <= 0 \|\| $retry_cnt > 5) {
330		# @dev_list = $obj->search(st =>'urn:schemas-upnp-org:device:InternetGatewayDevice:1', mx => 10);
331		@dev_list = $obj->search(st =>'upnp:rootdevice', mx => 3);
332		$retry_cnt++;
333		}
334
335		$devNum= 0;
336		foreach $dev (@dev_list) {
337		my $device_type = $dev->getdevicetype();
338		if ($device_type ne 'urn:schemas-upnp-org:device:InternetGatewayDevice:1') {
339		next;
340		}
341		print "[$devNum] : " . $dev->getfriendlyname() . "\n";
342		unless ($dev->getservicebyname('urn:schemas-upnp-org:service:WANIPConnection:1')) {
343		next;
344		}
345		my $gwdev = Net::UPnP::GW::Gateway->new();
346		$gwdev->setdevice($dev);
347		print "\tExternalIPAddress = " . $gwdev->getexternalipaddress() . "\n";
348		print "\tPortMappingNumberOfEntries = " . $gwdev->getportmappingnumberofentries() . "\n";
349		@port_mapping = $gwdev->getportmappingentry();
350		$port_num = 0;
351		foreach $port_entry (@port_mapping) {
352		if ($port_entry) {
353		$port_map_name = $port_entry->{'NewPortMappingDescription'};
354		if (length($port_map_name) <= 0) {
355		$port_map_name = "(No name)";
356		}
357		print " [$port_num] : $port_map_name\n";
358		foreach $name ( keys %{$port_entry} ) {
359		print " $name = $port_entry->{$name}\n";
360		}
361		}
362		else {
363		print " [$port_num] : Unknown\n";
364		}
365		$port_num++;
366		}
367		}
	322	use Net::UPnP::ControlPoint;
	323	use Net::UPnP::GW::Gateway;
	324
	325	my $obj = Net::UPnP::ControlPoint->new();
	326
	327	@dev_list = ();
	328	while (@dev_list <= 0 \|\| $retry_cnt > 5) {
	329	# @dev_list = $obj->search(st =>'urn:schemas-upnp-org:device:InternetGatewayDevice:1', mx => 10);
	330	@dev_list = $obj->search(st =>'upnp:rootdevice', mx => 3);
	331	$retry_cnt++;
	332	}
	333
	334	$devNum= 0;
	335	foreach $dev (@dev_list) {
	336	my $device_type = $dev->getdevicetype();
	337	if ($device_type ne 'urn:schemas-upnp-org:device:InternetGatewayDevice:1') {
	338	next;
	339	}
	340	print "[$devNum] : " . $dev->getfriendlyname() . "\n";
	341	unless ($dev->getservicebyname('urn:schemas-upnp-org:service:WANIPConnection:1')) {
	342	next;
	343	}
	344	my $gwdev = Net::UPnP::GW::Gateway->new();
	345	$gwdev->setdevice($dev);
	346	print "\tExternalIPAddress = " . $gwdev->getexternalipaddress() . "\n";
	347	print "\tPortMappingNumberOfEntries = " . $gwdev->getportmappingnumberofentries() . "\n";
	348	@port_mapping = $gwdev->getportmappingentries();
	349	$port_num = 0;
	350	foreach $port_entry (@port_mapping) {
	351	$port_map_name = $port_entry->{'NewPortMappingDescription'};
	352	if (length($port_map_name) <= 0) {
	353	$port_map_name = "(No name)";
	354	}
	355	print " [$port_num] : $port_map_name\n";
	356	foreach $name ( keys %{$port_entry} ) {
	357	print " $name = $port_entry->{$name}\n";
	358	}
	359	$port_num++;
	360	}
	361	}
368	362
369	363	=head1 DESCRIPTION
370	364

396	390
397	391	=item B<getportmappingnumberofentries> - PortMappingNumberOfEntries
398	392
399		$gw->getexternalipaddress();
	393	$gw->getportmappingnumberofentries();
400	394
401	395	Get the number of the port mapping entries.
402	396
403		=item B<getportmappingentry> - PortMappingEntry
404
405		$gw->getexternalipaddress();
	397	=item B<getportmappingentries> - PortMappingEntry
	398
	399	$gw->getportmappingentries();
406	400
407	401	Get the port mapping entries.
408	402

+4

-1

lib/Net/UPnP/HTTP.pm less more

69	69
70	70	#print "header = " . %{$add_header} . "\n";
71	71	#%add_header = %{$add_header_ref};
	72	my $has_connection_header;
72	73	if (ref $add_header) {
	74	$has_connection_header = 1 if( defined ${$add_header}{'Connection'} );
73	75	while ( ($add_header_name, $add_header_value) = each %{$add_header}) {
74	76	$req_header .= "$add_header_name: $add_header_value\n";
75	77	}
76	78	}
77	79
	80	$req_header .= "Connection: close\n" unless( $has_connection_header );
78	81	$req_header .= "\n";
79	82	$req_header =~ s/\r//g;
80	83	$req_header =~ s/\n/\r\n/g;

178	181	}
179	182
180	183	#------------------------------
181		# postsoap
	184	# xmldecode
182	185	#------------------------------
183	186
184	187	sub xmldecode {

+1

-1

lib/Net/UPnP/QueryResponse.pm less more

98	98	$value = "";
99	99
100	100	$res_content = $http_res->getcontent();
101		if ($res_content =~ m/<return>(.*?)<\/return>/si) {
	101	if ($res_content =~ m{<return>(.*?)</return>}si) {
102	102	$value = $1;
103	103	}
104	104

+16

-15

lib/Net/UPnP/Service.pm less more

142	142	#print "$url_base\n";
143	143	#print "$ctrl_url\n";
144	144
145		unless ($ctrl_url =~ m/http:\/\/(.*)/i) {
	145	unless ($ctrl_url =~ m{http://(.*)}i) {
146	146	if (0 < length($url_base)) {
147	147	# Thanks for Thus0 (2005/01/12)
148	148	if (rindex($url_base, '/') == (length($url_base)-1) && index($ctrl_url, '/') == 0) {

152	152	}
153	153	}
154	154	else {
155		if ($location_url =~ m/http:\/\/([0-9a-z.]+)[:]([0-9])\/(.*)/i) {
	155	if ($location_url =~ m{http://([0-9a-z.-]+)(?::(\d+))?/(.*)}i) {
	156	my $port = $2 \|\| 80;
156	157	if (defined($3) && 0 < length($3)) {
157		$ctrl_url = "http:\/\/" . $1 . ":" . $2 . $ctrl_url;
	158	$ctrl_url = 'http://' . $1 . ":" . $port . $ctrl_url;
158	159	} else {
159		$ctrl_url = "http:\/\/" . $1 . ":" . $2 . "\/" . $ctrl_url;
	160	$ctrl_url = 'http://' . $1 . ":" . $port . '/' . $ctrl_url;
160	161	}
161	162	} else {
162	163	$ctrl_url = $location_url . $ctrl_url;

197	198	$ctrl_url = $this->getcontrolurl();
198	199	$ctrl_url = $this->getposturl($ctrl_url);
199	200
200		unless ($ctrl_url =~ m/http:\/\/([0-9a-z.]+)[:]([0-9])\/(.*)/i) {
	201	unless ($ctrl_url =~ m{http://([0-9a-z.-]+)(?::(\d+))?/(.*)}i) {
201	202	#print "Invalid URL : $ctrl_url\n";
202	203	$post_res = Net::UPnP::HTTPResponse->new();
203	204	$action_res->sethttpresponse($post_res);
204	205	return $action_res;
205	206	}
206	207	$post_addr = $1;
207		$post_port = $2;
	208	$post_port = $2 \|\| 80;
208	209	if (index($3, '/') == 0) {
209	210	$post_path = $3;
210	211	}
211	212	else {
212		$post_path = "\/" . $3;
	213	$post_path = '/' . $3;
213	214	}
214	215
215	216	$service_type = $this->getservicetype();
216		$soap_action = "\"" . $service_type . "#" . $action_name . "\"";
	217	$soap_action = '"' . $service_type . '#' . $action_name . '"';
217	218
218	219
219	220	$soap_content = <<"SOAP_CONTENT";

284	285	$ctrl_url = $this->getcontrolurl();
285	286	$ctrl_url = $this->getposturl($ctrl_url);
286	287
287		unless ($ctrl_url =~ m/http:\/\/([0-9a-z.]+)[:]([0-9])\/(.*)/i) {
288		#print "Invalid URL : $ctrl_url\n";
	288	print "ctrl_url=$ctrl_url\n" if ($Net::UPnP::DEBUG);
	289	unless ($ctrl_url =~ m{http://([0-9a-z.-]+)(?::(\d+))?/(.*)}i) {
289	290	$post_res = Net::UPnP::HTTPResponse->new();
290	291	$query_res->sethttpresponse($post_res);
291	292	return $query_res;
292	293	}
293	294	$post_addr = $1;
294		$post_port = $2;
	295	$post_port = $2 \|\| 80;
295	296	if (index($3, '/') == 0) {
296	297	$post_path = $3;
297	298	}
298	299	else {
299		$post_path = "\/" . $3;
300		}
301
	300	$post_path = '/' . $3;
	301	}
302	302	$service_type = $this->getservicetype();
303		$soap_action = "\"urn:schemas-upnp-org:control-1-0#QueryStateVariable\"";
	303	$soap_action = '"urn:schemas-upnp-org:control-1-0#QueryStateVariable"';
	304
304	305
305	306	$soap_content = <<"SOAP_CONTENT";
306	307	<?xml version=\"1.0\" encoding=\"utf-8\"?>

+1

-1

lib/Net/UPnP.pm less more

10	10	use vars qw($VERSION $DEBUG $SSDP_ADDR $SSDP_PORT);
11	11
12	12
13		$VERSION = '1.4.4';
	13	$VERSION = '1.4.5';
14	14	$DEBUG = 0;
15	15
16	16	$SSDP_ADDR = '239.255.255.250';