UPnP port mapping problem
Hello, new to VBForums. I am trying to automate the mapping of ports as part of the setting up of a server program intended for PC usage. I am familiar with networking theory but just getting my feet wet with implementations. I stumbled upon this C# routine -> http://bytes.com/topic/c-sharp/answe...s-nat-firewall and have translated it to VB to my best ability.
Code:
Sub setPF()
Dim nics() As System.Net.NetworkInformation.NetworkInterface = System.Net.NetworkInformation.NetworkInterface.GetAllNetworkInterfaces()
'For Each nic As System.Net.NetworkInformation.NetworkInterface In nics
Dim nic As System.Net.NetworkInformation.NetworkInterface = nics(2)
Dim machineIP As String = nic.GetIPProperties().UnicastAddresses(0).Address.ToString()
For Each gwInfo As System.Net.NetworkInformation.GatewayIPAddressInformation In nic.GetIPProperties.GatewayAddresses
openFireWallPort(machineIP, gwInfo.Address.ToString(), 40)
Next
'Next
End Sub
Sub openFireWallPort(ByVal machineIP As String, ByVal firewallIP As String, ByVal openPort As Integer)
Dim svc As String = getServicesFromDevice(firewallIP)
openPortFromService(svc, "urn:schemas-upnp-org:service:WANIPConnection:1", machineIP, firewallIP, 80, openPort)
openPortFromService(svc, "urn:schemas-upnp-org:service:WANPPPConnection:1", machineIP, firewallIP, 80, openPort)
End Sub
Function getServicesFromDevice(ByVal firewallIP As String)
Dim queryResponse As String = ""
Dim query As String = "M-SEARCH * HTTP/1.1" & vbCrLf & "Host:" & firewallIP & ":1900" & vbCrLf & "ST:upnp:rootdevice" & vbCrLf & _
"Man:""ssdp:discover""" & vbCrLf & "MX:3" & vbCrLf & vbCrLf & vbCrLf
Dim client As System.Net.Sockets.Socket = New System.Net.Sockets.Socket(System.Net.Sockets.AddressFamily.InterNetwork, System.Net.Sockets.SocketType.Dgram, System.Net.Sockets.ProtocolType.Udp)
Dim endPoint As System.Net.IPEndPoint = New System.Net.IPEndPoint(System.Net.IPAddress.Parse(firewallIP), 1900)
client.SetSocketOption(Net.Sockets.SocketOptionLevel.Socket, Net.Sockets.SocketOptionName.ReceiveTimeout, 1500)
Dim q As Byte() = System.Text.Encoding.ASCII.GetBytes(query)
client.SendTo(q, q.Length, Net.Sockets.SocketFlags.None, endPoint)
Dim sender As System.Net.IPEndPoint = New System.Net.IPEndPoint(System.Net.IPAddress.Any, 0)
Dim senderEP As System.Net.EndPoint = CType(sender, System.Net.EndPoint)
Dim data As Byte() = New Byte(1024) {}
Dim recv As Integer = client.ReceiveFrom(data, senderEP)
queryResponse = System.Text.Encoding.ASCII.GetString(data)
If queryResponse.Length = 0 Then Return ""
' QueryResult is somthing like this:
'HTTP/1.1 200 OK
'Cache-Control:max-age=60
'Location:http://10.10.10.1:80/upnp/service/des_ppp.xml
'Server:NT/5.0 UPnP/1.0
'ST:upnp:rootdevice
'EXT:
'USN:uuid:upnp-InternetGatewayDevice-1_0-00095bd945a2::upnp:rootdevice
Dim location As String = ""
Dim parts() As String = queryResponse.Split(New String() {System.Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
For Each part As String In parts
If part.ToLower().StartsWith("location") Then
location = part.Substring(part.IndexOf(":") + 1)
Exit For
End If
Next
If location.Length() = 0 Then Return ""
Dim webClient As System.Net.WebClient = New System.Net.WebClient()
Dim ret As String = webClient.DownloadString(location)
MsgBox("webClient String: " & ret)
Return ret
End Function
Sub openPortFromService(ByVal services As String, ByVal serviceType As String, _
ByVal machineIP As String, ByVal firewallIP As String, _
ByVal gatewayPort As Integer, ByVal portToForward As Integer)
If services.Length = 0 Then Exit Sub
Dim svcIndex As Integer = services.IndexOf(serviceType)
If svcIndex = -1 Then Exit Sub
Dim controlUrl As String = services.Substring(svcIndex)
Dim tag1 As String = "<controlURL>"
Dim tag2 As String = "</controlURL>"
controlUrl = controlUrl.Substring(controlUrl.IndexOf(tag1) + tag1.Length)
controlUrl = controlUrl.Substring(0, controlUrl.IndexOf(tag2))
Dim soapBody As String = "<s:Envelope " & "xmlns:s=""http://schemas.xmlsoap.org/soap/envelope/"" " & _
"s:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/ "">" & "<s:Body>" & _
"<u:AddPortMapping xmlns:u=""" + serviceType + """>" & "<NewRemoteHost></NewRemoteHost>" & _
"<NewExternalPort>" & portToForward.ToString() & "</NewExternalPort>" & _
"<NewProtocol>TCP</NewProtocol>" & "<NewInternalPort>" + portToForward.ToString() & _
"</NewInternalPort>" & "<NewInternalClient>" & machineIP & "</NewInternalClient>" & _
"<NewEnabled>1</NewEnabled>" & "<NewPortMappingDescription>Woodchop Client</NewPortMappingDescription>" &
"<NewLeaseDuration>0</NewLeaseDuration>" & "</u:AddPortMapping>" & "</s:Body>" & "</s:Envelope>"
Dim body() As Byte = System.Text.UTF8Encoding.ASCII.GetBytes(soapBody)
Dim url As String = "http://" & firewallIP & ":" & gatewayPort.ToString() & controlUrl
Dim wr As System.Net.WebRequest = System.Net.WebRequest.Create(url)
wr.Method = "POST"
Dim header As String = Chr(34) & serviceType & "#AddPortMapping"""
wr.Headers.Add("SOAPAction", header)
wr.ContentType = "text/xml;charset=""utf-8"""
wr.ContentLength = body.Length
Dim stream As System.IO.Stream = wr.GetRequestStream()
stream.Write(body, 0, body.Length)
stream.Flush()
stream.Close()
Dim wres As System.Net.WebResponse = wr.GetResponse()
Dim sr As System.IO.StreamReader = New System.IO.StreamReader(wres.GetResponseStream())
Dim ret As String = sr.ReadToEnd()
sr.Close()
MsgBox("Setting port forwarding:" & portToForward.ToString() & vbcrlf & vbcrlf & ret)
This code runs fine until the end when the SOAP message with the port mapping details is sent. Here my router is returning a 404 error after i send it the message. I have tried two routers of different manufacturers and i'm getting the same response. Any help would be greatly appreciated.
Re: UPnP port mapping problem
Have you tried the techniques described in Easy UPnP NAT Traversal yet?
