Current section
Files
Jump to
Current section
Files
src/nat_upnp_proto.erl
%%% -*- erlang -*-
%%% This file is part of nat_upnp released under the MIT license.
%%% See the NOTICE for more information.
%%%
%%% Copyright (c) 2013 Benoît Chesneau <benoitc@refuge.io>
%%%
-module(nat_upnp_proto).
-include_lib("xmerl/include/xmerl.hrl").
-export([discover/0,
discover/1,
status_info/1,
add_port_mapping/6,
delete_port_mapping/3]).
-record(nat_upnp, {
service_url,
ip}).
-type nat_upnp() :: #nat_upnp{}.
-export_type([nat_upnp/0]).
-define(DEFAULT_TIMEOUT, 5000).
discover() ->
discover(?DEFAULT_TIMEOUT).
discover(Timeout) ->
_ = application:start(inets),
{ok, Sock} = gen_udp:open(0, [{active, once}, inet, binary]),
ST = <<"urn:schemas-upnp-org:device:InternetGatewayDevice:1" >>,
MSearch = [<<"M-SEARCH * HTTP/1.1\r\n"
"HOST: 239.255.255.250:1900\r\n"
"MAN: \"ssdp:discover\"\r\n"
"ST: ">>, ST, <<"\r\n"
"MX: 3"
"\r\n\r\n">>],
try
discover1(Sock, iolist_to_binary(MSearch), Timeout, 3)
after
gen_udp:close(Sock)
end.
discover1(_Sock, _MSearch, _Timeout, 0) ->
{error, failed_discovery};
discover1(Sock, MSearch, Timeout, Tries) ->
inet:setopts(Sock, [{active, once}]),
ok = gen_udp:send(Sock, "239.255.255.250", 1900, MSearch),
receive
{udp, _Sock, Ip, _Port, Packet} ->
case get_location(Packet) of
error ->
discover1(Sock, MSearch, Timeout, Tries-1);
Location ->
case get_service_url(binary_to_list(Location)) of
{ok, Url} ->
MyIp = get_myip(Ip),
{ok, #nat_upnp{service_url=Url, ip=MyIp}};
Error ->
Error
end
end
after Timeout ->
discover1(Sock, MSearch, Timeout, Tries-1)
end.
status_info(#nat_upnp{service_url=Url}) ->
Message = "<u:GetStatusInfo xmlns:u=\""
"urn:schemas-upnp-org:service:WANIPConnection:1\">"
"</u:GetStatusInfo>",
case soap_request(Url, "GetStatusInfo", Message) of
{ok, Body} ->
{Xml, _} = xmerl_scan:string(Body, [{space, normalize}]),
[Infos | _] = xmerl_xpath:string("//s:Envelope/s:Body/"
"u:GetStatusInfoResponse", Xml),
Status = extract_txt(
xmerl_xpath:string("NewConnectionStatus/text()",
Infos)
),
LastConnectionError = extract_txt(
xmerl_xpath:string("NewLastConnectionError/text()",
Infos)
),
Uptime = extract_txt(
xmerl_xpath:string("NewUptime/text()",
Infos)
),
{Status, LastConnectionError, Uptime};
Error ->
Error
end.
add_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort,
InternalPort, Description, Timeout) ->
Protocol = string:to_upper(atom_to_list(Protocol0)),
Msg = "<u:AddPortMapping xmlns:u=\""
"urn:schemas-upnp-org:service:WANIPConnection:1\">"
"<NewRemoteHost></NewRemoteHost>"
"<NewExternalPort>" ++ integer_to_list(ExternalPort) ++
"</NewExternalPort>"
"<NewProtocol>" ++ Protocol ++ "</NewProtocol>"
"<NewInternalPort>" ++ integer_to_list(InternalPort) ++
"</NewInternalPort>"
"<NewInternalClient>" ++ Ip ++ "</NewInternalClient>"
"<NewEnabled>1</NewEnabled>"
"<NewPortMappingDescription>" ++ Description ++
"</NewPortMappingDescription>"
"<NewLeaseDuration>" ++ integer_to_list(Timeout) ++
"</NewLeaseDuration></u:AddPortMapping>",
case soap_request(Url, "AddPortMapping", Msg) of
{ok, _} -> ok;
Error -> Error
end.
delete_port_mapping(#nat_upnp{service_url=Url}, Protocol0,
ExternalPort) ->
Protocol = string:to_upper(atom_to_list(Protocol0)),
Msg = "<u:DeletePortMapping xmlns:u=\""
"urn:schemas-upnp-org:service:WANIPConnection:1\">"
"<NewRemoteHost></NewRemoteHost>"
"<NewExternalPort>" ++ integer_to_list(ExternalPort) ++
"</NewExternalPort>"
"<NewProtocol>" ++ Protocol ++ "</NewProtocol>"
"</u:DeletePortMapping>",
case soap_request(Url, "DeletePortMapping", Msg) of
{ok, _} -> ok;
Error -> Error
end.
soap_request(Url, Function, Msg0) ->
Msg = "<?xml version=\"1.0\"?>"
"<s:Envelope"
" xmlns:s=\"http://schemas.xmlsoap.org/soap/envelope/\""
" s:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\">"
"<s:Body>" ++ Msg0 ++ "</s:Body></s:Envelope>",
Action = "\"urn:schemas-upnp-org:service:WANIPConnection:1#"
++ Function ++ "\"",
Headers = [{"Content-Length", integer_to_list(length(Msg))},
{"User-Agent", "Darwin/10.0.0, UPnP/1.0, MiniUPnPc/1.3"},
{"SOAPAction", Action},
{"Connection", "close"},
{"Cache-Control", "no-cache"},
{"Pragma", "no-cache"}],
Req = {Url, Headers, "text/xml; charset=\"utf-8\"", Msg},
case httpc:request(post, Req, [], []) of
{ok, {{_, 200, _}, _, Body}} ->
{ok, Body};
{ok, {{_, Status, _}, _, _}} ->
{error, integer_to_list(Status)};
Error ->
Error
end.
get_myip(Ip) ->
[{_, {MyIp, _}}|_] = inet_ext:route(Ip),
inet_parse:ntoa(MyIp).
get_location(Raw) ->
case erlang:decode_packet(httph_bin, Raw, []) of
{ok, {http_error, _}, Rest} ->
get_location(Rest);
{ok, {http_header, _, 'Location', _, Location}, _Rest} ->
Location;
{ok, {http_header, _, _H, _, _V}, Rest} ->
get_location(Rest);
_ ->
error
end.
get_service_url(RootUrl) ->
case httpc:request(RootUrl) of
{ok, {{_, 200, _}, _, Body}} ->
{Xml, _} = xmerl_scan:string(Body, [{space, normalize}]),
[Device | _] = xmerl_xpath:string("//device", Xml),
case device_type(Device) of
"urn:schemas-upnp-org:device:InternetGatewayDevice:1" ->
get_wan_device(Device, RootUrl);
_ ->
{error, no_gateway_device}
end;
{ok, {{_, StatusCode, _}, _, _}} ->
{error, integer_to_list(StatusCode)};
Error ->
Error
end.
get_wan_device(D, RootUrl) ->
case get_device(D, "urn:schemas-upnp-org:device:WANDevice:1") of
{ok, D1} ->
get_connection_device(D1, RootUrl);
_ ->
{erro, no_wan_device}
end.
get_connection_device(D, RootUrl) ->
case get_device(D, "urn:schemas-upnp-org:device:WANConnectionDevice:1") of
{ok, D1} ->
get_connection_url(D1, RootUrl);
_ ->
{error, no_wanconnection_device}
end.
get_connection_url(D, RootUrl) ->
case get_service(D, "urn:schemas-upnp-org:service:WANIPConnection:1") of
{ok, S} ->
Url = extract_txt(xmerl_xpath:string("controlURL/text()",
S)),
case split(RootUrl, "://") of
[Scheme, Rest] ->
case split(Rest, "/") of
[NetLoc| _] ->
CtlUrl = Scheme ++ "://" ++ NetLoc ++ Url,
{ok, CtlUrl};
_Else ->
{error, invalid_control_url}
end;
_Else ->
{error, invalid_control_url}
end;
_ ->
{error, no_wanipconnection}
end.
get_device(Device, DeviceType) ->
DeviceList = xmerl_xpath:string("deviceList/device", Device),
find_device(DeviceList, DeviceType).
find_device([], _DeviceType) ->
false;
find_device([D | Rest], DeviceType) ->
case device_type(D) of
DeviceType ->
{ok, D};
_ ->
find_device(Rest, DeviceType)
end.
get_service(Device, ServiceType) ->
ServiceList = xmerl_xpath:string("serviceList/service", Device),
find_service(ServiceList, ServiceType).
find_service([], _ServiceType) ->
false;
find_service([S | Rest], ServiceType) ->
case extract_txt(xmerl_xpath:string("serviceType/text()", S)) of
ServiceType ->
{ok, S};
_ ->
find_service(Rest, ServiceType)
end.
device_type(Device) ->
extract_txt(xmerl_xpath:string("deviceType/text()", Device)).
%% Given a xml text node, extract its text value.
extract_txt(Xml) ->
[T|_] = [X#xmlText.value || X <- Xml, is_record(X, xmlText)],
T.
split(String, Pattern) ->
re:split(String, Pattern, [{return, list}]).