Browse files

initial

  • Loading branch information...
0 parents commit 0c7d9cabf6d7f19dc71d5173c0238e18f786188f @elblake committed Oct 13, 2012
Showing with 1,304 additions and 0 deletions.
  1. +21 −0 LICENSE.txt
  2. +80 −0 docs/UPnP Example Actions.txt
  3. +67 −0 docs/UPnP Port Mapping.txt
  4. +531 −0 docs/UPnP Session.txt
  5. +80 −0 src/soap.rkt
  6. +525 −0 src/upnp-client.rkt
21 LICENSE.txt
@@ -0,0 +1,21 @@
+Copyright 2012 Edward L. Blake
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
80 docs/UPnP Example Actions.txt
@@ -0,0 +1,80 @@
+s=192.168.0.1
+m=POST
+>h
+SOAPAction: "urn:schemas-upnp-org:service:WANIPConnection:1#GetGenericPortMappingEntry"
+Content-Type: text/xml; charset="utf-8"
+>b
+<?xml version="1.0" encoding="utf-8"?>
+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+ <s:Body>
+ <u:GetGenericPortMappingEntry xmlns:u="urn:schemas-upnp-org:service:WANIPConnection:1">
+ <NewPortMappingIndex>0</NewPortMappingIndex>
+ </u:GetGenericPortMappingEntry>
+ </s:Body>
+</s:Envelope>
+/upnp/control3
+
+
+
+
+
+
+FOR EXTERNAL IP
+s=192.168.0.1
+m=POST
+>h
+SOAPAction: "urn:schemas-upnp-org:service:WANIPConnection:1#GetExternalIPAddress"
+Content-Type: text/xml; charset="utf-8"
+>b
+<?xml version="1.0" encoding="utf-8"?>
+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+ <s:Body>
+ <u:GetExternalIPAddress xmlns:u="urn:schemas-upnp-org:service:WANIPConnection:1" />
+ </s:Body>
+</s:Envelope>
+/upnp/control3
+
+
+
+FOR MAPPING A PORT
+s=192.168.0.1
+m=POST
+>h
+SOAPAction: "urn:schemas-upnp-org:service:WANIPConnection:1#AddPortMapping"
+Content-Type: text/xml; charset="utf-8"
+>b
+<?xml version="1.0" encoding="utf-8"?>
+<s:Envelope xmlns:s=�http://schemas.xmlsoap.org/soap/envelope/� s:encodingStyle=�http://schemas.xmlsoap.org/soap/encoding/�>
+ <s:Body>
+ <u:AddPortMapping xmlns:u=�urn:schemas-upnp-org:service:WANIPConnection:1">
+ <NewRemoteHost></NewRemoteHost>
+ <NewExternalPort>12180</NewExternalPort>
+ <NewProtocol>TCP</NewProtocol>
+ <NewInternalPort>12180</NewInternalPort>
+ <NewInternalClient>192.168.0.189</NewInternalClient>
+ <NewEnabled>1</NewEnabled>
+ <NewPortMappingDescription>Stuff</NewPortMappingDescription>
+ <NewLeaseDuration>0</NewLeaseDuration>
+ </u:AddPortMapping>
+ </s:Body>
+</s:Envelope>
+/upnp/control3
+
+FOR DELETING A PORT MAPPING
+s=192.168.0.1
+m=POST
+>h
+SOAPAction: "urn:schemas-upnp-org:service:WANIPConnection:1#DeletePortMapping"
+Content-Type: text/xml; charset="utf-8"
+>b
+<?xml version="1.0" encoding="utf-8"?>
+<s:Envelope xmlns:s=�http://schemas.xmlsoap.org/soap/envelope/� s:encodingStyle=�http://schemas.xmlsoap.org/soap/encoding/ �>
+ <s:Body>
+ <u:DeletePortMapping xmlns:u=�urn:schemas-upnp-org:service:WANIPConnection:1">
+ <NewRemoteHost></NewRemoteHost>
+ <NewExternalPort>12180</NewExternalPort>
+ <NewProtocol>TCP</NewProtocol>
+ </u:DeletePortMapping>
+ </s:Body>
+</s:Envelope>
+/upnp/control3
67 docs/UPnP Port Mapping.txt
@@ -0,0 +1,67 @@
+<action>
+ <name>AddPortMapping</name>
+ <argumentList>
+ <argument>
+ <name>NewRemoteHost</name>
+ <direction>in</direction>
+ <relatedStateVariable>RemoteHost</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewExternalPort</name>
+ <direction>in</direction>
+ <relatedStateVariable>ExternalPort</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewProtocol</name>
+ <direction>in</direction>
+ <relatedStateVariable>PortMappingProtocol</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewInternalPort</name>
+ <direction>in</direction>
+ <relatedStateVariable>InternalPort</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewInternalClient</name>
+ <direction>in</direction>
+ <relatedStateVariable>InternalClient</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewEnabled</name>
+ <direction>in</direction>
+ <relatedStateVariable>PortMappingEnabled</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewPortMappingDescription</name>
+ <direction>in</direction>
+ <relatedStateVariable>PortMappingDescription</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewLeaseDuration</name>
+ <direction>in</direction>
+ <relatedStateVariable>PortMappingLeaseDuration</relatedStateVariable>
+ </argument>
+ </argumentList>
+</action>
+
+<action>
+ <name>DeletePortMapping</name>
+ <argumentList>
+ <argument>
+ <name>NewRemoteHost</name>
+ <direction>in</direction>
+ <relatedStateVariable>RemoteHost</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewExternalPort</name>
+ <direction>in</direction>
+ <relatedStateVariable>ExternalPort</relatedStateVariable>
+ </argument>
+ <argument>
+ <name>NewProtocol</name>
+ <direction>in</direction>
+ <relatedStateVariable>PortMappingProtocol</relatedStateVariable>
+ </argument>
+ </argumentList>
+</action>
+<action>
531 docs/UPnP Session.txt
@@ -0,0 +1,531 @@
+Example UPnP Session
+====================
+
+UPnP Device Description
+-----------------------
+
+HTTP/1.0 200 OK
+Connection: close
+Last-Modified: Sun, 8 Mar 1998 00:00:00 GMT
+Expires: Fri, 31 Dec 2060 00:00:00 GMT
+Content-Type: text/xml
+
+<?xml version="1.0"?>
+<root xmlns="urn:schemas-upnp-org:device-1-0">
+<specVersion>
+<major>1</major>
+<minor>0</minor>
+</specVersion>
+<device>
+<deviceType>urn:schemas-upnp-org:device:InternetGatewayDevice:1</deviceType>
+<friendlyName>D-Link DI Series</friendlyName>
+<manufacturer>D-Link</manufacturer>
+<manufacturerURL>http://www.dlink.com</manufacturerURL>
+<modelDescription>D-Link Internet Gateway Device</modelDescription>
+<modelName>D-Link Internet Gateway Device</modelName>
+<UDN>uuid:000F3D19-AF81-0000-0000-0000C0A80001</UDN>
+<presentationURL>http://192.168.0.1:80/</presentationURL>
+<serviceList>
+<service>
+<serviceType>urn:schemas-upnp-org:service:Layer3Forwarding:1</serviceType>
+<serviceId>urn:upnp-org:serviceId:L3Forwarding1</serviceId>
+<controlURL>/upnp/control1</controlURL>
+<eventSubURL>/Layer3Forwarding</eventSubURL>
+<SCPDURL>http://192.168.0.1:80/serv1.xml</SCPDURL>
+</service>
+</serviceList>
+<deviceList>
+<device>
+<deviceType>urn:schemas-upnp-org:device:WANDevice:1</deviceType>
+<friendlyName>WAN Device</friendlyName>
+<manufacturer>D-Link</manufacturer>
+<manufacturerURL>http://www.dlink.com</manufacturerURL>
+<modelDescription>Residential Gateway</modelDescription>
+<modelName>Residential Gateway Device</modelName>
+<UDN>uuid:000F3D19-AF81-0000-0000-0001C0A80001</UDN>
+<serviceList>
+<service>
+<serviceType>urn:schemas-upnp-org:service:WANCommonInterfaceConfig:1</serviceType>
+<serviceId>urn:upnp-org:serviceId:WANCommonInterfaceConfig</serviceId>
+<controlURL>/upnp/control2</controlURL>
+<eventSubURL>/WANCommonInterfaceConfig</eventSubURL>
+<SCPDURL>http://192.168.0.1:80/serv2.xml</SCPDURL>
+</service>
+</serviceList>
+<deviceList>
+<device>
+<deviceType>urn:schemas-upnp-org:device:WANConnectionDevice:1</deviceType>
+<friendlyName>WAN Connection Device</friendlyName>
+<manufacturer>D-Link</manufacturer>
+<manufacturerURL>http://www.dlink.com</manufacturerURL>
+<modelDescription>Residential Gateway</modelDescription>
+<modelName>Residential Gateway Device</modelName>
+<UDN>uuid:000F3D19-AF81-0000-0000-0002C0A80001</UDN>
+<serviceList>
+<service>
+<serviceType>urn:schemas-upnp-org:service:WANIPConnection:1</serviceType>
+<serviceId>urn:upnp-org:serviceId:WANIPConnection</serviceId>
+<controlURL>/upnp/control3</controlURL>
+<eventSubURL>/WANIPConnection</eventSubURL>
+<SCPDURL>http://192.168.0.1:80/serv3.xml</SCPDURL>
+</service>
+</serviceList>
+</device>
+</deviceList>
+</device>
+</deviceList>
+</device>
+</root>
+
+
+Accessing /serv3.xml
+--------------------
+
+HTTP/1.0 200 OK
+Connection: close
+Last-Modified: Sun, 8 Mar 1998 00:00:00 GMT
+Expires: Fri, 31 Dec 2060 00:00:00 GMT
+Content-Type: text/xml
+
+<?xml version="1.0"?>
+<scpd xmlns="urn:schemas-upnp-org:service-1-0">
+<specVersion>
+<major>1</major>
+<minor>0</minor>
+</specVersion>
+<actionList>
+<action>
+<name>SetConnectionType</name>
+<argumentList>
+<argument>
+<name>NewConnectionType</name>
+<direction>in</direction>
+<relatedStateVariable>ConnectionType</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+<action>
+<name>GetConnectionTypeInfo</name>
+<argumentList>
+<argument>
+<name>NewConnectionType</name>
+<direction>out</direction>
+<relatedStateVariable>ConnectionType</relatedStateVariable>
+</argument>
+<argument>
+<name>NewPossibleConnectionTypes</name>
+<direction>out</direction>
+<relatedStateVariable>PossibleConnectionTypes</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+<action>
+<name>ForceTermination</name>
+</action>
+<action>
+<name>RequestConnection</name>
+</action>
+<action>
+<name>GetStatusInfo</name>
+<argumentList>
+<argument>
+<name>NewConnectionStatus</name>
+<direction>out</direction>
+<relatedStateVariable>ConnectionStatus</relatedStateVariable>
+</argument>
+<argument>
+<name>NewLastConnectionError</name>
+<direction>out</direction>
+<relatedStateVariable>LastConnectionError</relatedStateVariable>
+</argument>
+<argument>
+<name>NewUptime</name>
+<direction>out</direction>
+<relatedStateVariable>Uptime</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+<action>
+<name>GetNATRSIPStatus</name>
+<argumentList>
+<argument>
+<name>NewRSIPAvailable</name>
+<direction>out</direction>
+<relatedStateVariable>RSIPAvailable</relatedStateVariable>
+</argument>
+<argument>
+<name>NewNATEnabled</name>
+<direction>out</direction>
+<relatedStateVariable>NATEnabled</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+<action>
+<name>GetGenericPortMappingEntry</name>
+<argumentList>
+<argument>
+<name>NewPortMappingIndex</name>
+<direction>in</direction>
+<relatedStateVariable>PortMappingNumberOfEntries</relatedStateVariable>
+</argument>
+<argument>
+<name>NewRemoteHost</name>
+<direction>out</direction>
+<relatedStateVariable>RemoteHost</relatedStateVariable>
+</argument>
+<argument>
+<name>NewExternalPort</name>
+<direction>out</direction>
+<relatedStateVariable>ExternalPort</relatedStateVariable>
+</argument>
+<argument>
+<name>NewProtocol</name>
+<direction>out</direction>
+<relatedStateVariable>PortMappingProtocol</relatedStateVariable>
+</argument>
+<argument>
+<name>NewInternalPort</name>
+<direction>out</direction>
+<relatedStateVariable>InternalPort</relatedStateVariable>
+</argument>
+<argument>
+<name>NewInternalClient</name>
+<direction>out</direction>
+<relatedStateVariable>InternalClient</relatedStateVariable>
+</argument>
+<argument>
+<name>NewEnabled</name>
+<direction>out</direction>
+<relatedStateVariable>PortMappingEnabled</relatedStateVariable>
+</argument>
+<argument>
+<name>NewPortMappingDescription</name>
+<direction>out</direction>
+<relatedStateVariable>PortMappingDescription</relatedStateVariable>
+</argument>
+<argument>
+<name>NewLeaseDuration</name>
+<direction>out</direction>
+<relatedStateVariable>PortMappingLeaseDuration</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+<action>
+<name>GetSpecificPortMappingEntry</name>
+<argumentList>
+<argument>
+<name>NewRemoteHost</name>
+<direction>in</direction>
+<relatedStateVariable>RemoteHost</relatedStateVariable>
+</argument>
+<argument>
+<name>NewExternalPort</name>
+<direction>in</direction>
+<relatedStateVariable>ExternalPort</relatedStateVariable>
+</argument>
+<argument>
+<name>NewProtocol</name>
+<direction>in</direction>
+<relatedStateVariable>PortMappingProtocol</relatedStateVariable>
+</argument>
+<argument>
+<name>NewInternalPort</name>
+<direction>out</direction>
+<relatedStateVariable>InternalPort</relatedStateVariable>
+</argument>
+<argument>
+<name>NewInternalClient</name>
+<direction>out</direction>
+<relatedStateVariable>InternalClient</relatedStateVariable>
+</argument>
+<argument>
+<name>NewEnabled</name>
+<direction>out</direction>
+<relatedStateVariable>PortMappingEnabled</relatedStateVariable>
+</argument>
+<argument>
+<name>NewPortMappingDescription</name>
+<direction>out</direction>
+<relatedStateVariable>PortMappingDescription</relatedStateVariable>
+</argument>
+<argument>
+<name>NewLeaseDuration</name>
+<direction>out</direction>
+<relatedStateVariable>PortMappingLeaseDuration</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+<action>
+<name>AddPortMapping</name>
+<argumentList>
+<argument>
+<name>NewRemoteHost</name>
+<direction>in</direction>
+<relatedStateVariable>RemoteHost</relatedStateVariable>
+</argument>
+<argument>
+<name>NewExternalPort</name>
+<direction>in</direction>
+<relatedStateVariable>ExternalPort</relatedStateVariable>
+</argument>
+<argument>
+<name>NewProtocol</name>
+<direction>in</direction>
+<relatedStateVariable>PortMappingProtocol</relatedStateVariable>
+</argument>
+<argument>
+<name>NewInternalPort</name>
+<direction>in</direction>
+<relatedStateVariable>InternalPort</relatedStateVariable>
+</argument>
+<argument>
+<name>NewInternalClient</name>
+<direction>in</direction>
+<relatedStateVariable>InternalClient</relatedStateVariable>
+</argument>
+<argument>
+<name>NewEnabled</name>
+<direction>in</direction>
+<relatedStateVariable>PortMappingEnabled</relatedStateVariable>
+</argument>
+<argument>
+<name>NewPortMappingDescription</name>
+<direction>in</direction>
+<relatedStateVariable>PortMappingDescription</relatedStateVariable>
+</argument>
+<argument>
+<name>NewLeaseDuration</name>
+<direction>in</direction>
+<relatedStateVariable>PortMappingLeaseDuration</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+<action>
+<name>DeletePortMapping</name>
+<argumentList>
+<argument>
+<name>NewRemoteHost</name>
+<direction>in</direction>
+<relatedStateVariable>RemoteHost</relatedStateVariable>
+</argument>
+<argument>
+<name>NewExternalPort</name>
+<direction>in</direction>
+<relatedStateVariable>ExternalPort</relatedStateVariable>
+</argument>
+<argument>
+<name>NewProtocol</name>
+<direction>in</direction>
+<relatedStateVariable>PortMappingProtocol</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+<action>
+<name>GetExternalIPAddress</name>
+<argumentList>
+<argument>
+<name>NewExternalIPAddress</name>
+<direction>out</direction>
+<relatedStateVariable>ExternalIPAddress</relatedStateVariable>
+</argument>
+</argumentList>
+</action>
+</actionList>
+<serviceStateTable>
+<stateVariable sendEvents="no">
+<name>ConnectionType</name>
+<dataType>string</dataType>
+</stateVariable>
+<stateVariable sendEvents="yes">
+<name>PossibleConnectionTypes</name>
+<dataType>string</dataType>
+<allowedValueList>
+<allowedValue>Unconfigured</allowedValue>
+<allowedValue>IP_Routed</allowedValue>
+<allowedValue>IP_Bridged</allowedValue>
+</allowedValueList>
+</stateVariable>
+<stateVariable sendEvents="yes">
+<name>ConnectionStatus</name>
+<dataType>string</dataType>
+<defaultValue>Unconfigured</defaultValue>
+<allowedValueList>
+<allowedValue>Unconfigured</allowedValue>
+<allowedValue>Connected</allowedValue>
+<allowedValue>Disconnected</allowedValue>
+</allowedValueList>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>Uptime</name>
+<dataType>ui4</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>LastConnectionError</name>
+<dataType>string</dataType>
+<allowedValueList>
+<allowedValue>ERROR_NONE</allowedValue>
+<allowedValue>ERROR_UNKNOWN</allowedValue>
+</allowedValueList>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>RSIPAvailable</name>
+<dataType>boolean</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>NATEnabled</name>
+<dataType>boolean</dataType>
+</stateVariable>
+<stateVariable sendEvents="yes">
+<name>ExternalIPAddress</name>
+<dataType>string</dataType>
+</stateVariable>
+<stateVariable sendEvents="yes">
+<name>PortMappingNumberOfEntries</name>
+<dataType>ui2</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>PortMappingEnabled</name>
+<dataType>boolean</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>PortMappingLeaseDuration</name>
+<dataType>ui4</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>RemoteHost</name>
+<dataType>string</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>ExternalPort</name>
+<dataType>ui2</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>InternalPort</name>
+<dataType>ui2</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>PortMappingProtocol</name>
+<dataType>string</dataType>
+<allowedValueList>
+<allowedValue>TCP</allowedValue>
+<allowedValue>UDP</allowedValue>
+</allowedValueList>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>InternalClient</name>
+<dataType>string</dataType>
+</stateVariable>
+<stateVariable sendEvents="no">
+<name>PortMappingDescription</name>
+<dataType>string</dataType>
+</stateVariable>
+</serviceStateTable>
+</scpd>
+
+
+Example Action: GetGenericPortMappingEntry
+------------------------------------------
+
+POST /upnp/control3 HTTP/1.1
+SOAPAction: "urn:schemas-upnp-org:service:WANIPConnection:1#GetGenericPortMappingEntry"
+Content-Type: text/xml; charset="utf-8"
+User-Agent: UPnP
+Host: 192.168.0.1
+Accept: text/html, image/gif, image/jpeg, *; q=.2, */*; q=.2
+Connection: keep-alive
+Content-Length: ...
+
+<?xml version="1.0" encoding="utf-8"?>
+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/"
+ s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<s:Body>
+<u:GetGenericPortMappingEntry xmlns:u="urn:schemas-upnp-org:service:WANIPConnection:1">
+<NewPortMappingIndex>0</NewPortMappingIndex>
+</u:GetGenericPortMappingEntry>
+</s:Body>
+</s:Envelope>
+
+
+Action Reply to "GetGenericPortMappingEntry"
+--------------------------------------------
+
+HTTP/1.1 200 OK
+CONTENT-LENGTH: 644
+CONTENT-TYPE: text/xml; charset="utf-8"
+EXT:
+Connection: close
+SERVER: IGD-HTTP/1.1 UPnP/1.0 UPnP-Device-Host/1.0
+
+<?xml version="1.0"?>
+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<s:Body>
+<m:GetGenericPortMappingEntryResponse
+ xmlns:m="urn:schemas-upnp-org:service:WANIPConnection:1">
+<NewRemoteHost></NewRemoteHost>
+<NewExternalPort>54321</NewExternalPort>
+<NewProtocol>TCP</NewProtocol>
+<NewInternalPort>54321</NewInternalPort>
+<NewInternalClient>192.168.0.132</NewInternalClient>
+<NewEnabled>1</NewEnabled>
+<NewPortMappingDescription>LimeTCP4BC4CD2E33</NewPortMappingDescription>
+<NewLeaseDuration>0</NewLeaseDuration>
+</m:GetGenericPortMappingEntryResponse>
+</s:Body>
+</s:Envelope>
+
+
+Example Action "AddPortMapping"
+-------------------------------
+
+POST /upnp/control3 HTTP/1.1
+SOAPAction: "urn:schemas-upnp-org:service:WANIPConnection:1#AddPortMapping"
+Content-Type: text/xml; charset="utf-8"
+User-Agent: UPnP
+Host: 192.168.0.1
+Accept: text/html, image/gif, image/jpeg, *; q=.2, */*; q=.2
+Connection: keep-alive
+Content-Length: ...
+
+<?xml version="1.0" encoding="utf-8"?>
+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<s:Body>
+<u:AddPortMapping xmlns:u="urn:schemas-upnp-org:service:WANIPConnection:1">
+<NewRemoteHost></NewRemoteHost>
+<NewExternalPort>12345</NewExternalPort>
+<NewProtocol>UDP</NewProtocol>
+<NewInternalPort>12345</NewInternalPort>
+<NewInternalClient>192.168.0.189</NewInternalClient>
+<NewEnabled>1</NewEnabled>
+<NewPortMappingDescription>Example UPnP 12345 UDP</NewPortMappingDescription>
+<NewLeaseDuration>0</NewLeaseDuration>
+</u:AddPortMapping></s:Body>
+</s:Envelope>
+
+
+Example Error Reply "AddPortMapping"
+------------------------------------
+
+HTTP/1.1 500 Internal Server Error
+CONTENT-LENGTH: 441
+CONTENT-TYPE: text/xml; charset="utf-8"
+EXT:
+Connection: close
+SERVER: IGD-HTTP/1.1 UPnP/1.0 UPnP-Device-Host/1.0
+
+<?xml version="1.0"?>
+<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/" s:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">
+<s:Body>
+<s:Fault>
+<faultcode>s:Client</faultcode>
+<faultstring>UPnPError</faultstring>
+<detail>
+<UPnPError xmlns="urn:schemas-upnp-org:control-1-0">
+<errorCode>718</errorCode>
+<errorDescription>ConflictInMappingEntry</errorDescription>
+</UPnPError>
+</detail>
+</s:Fault>
+</s:Body>
+</s:Envelope>
+
+
80 src/soap.rkt
@@ -0,0 +1,80 @@
+#lang racket/base
+
+#|
+|| SOAP Library for Racket
+||
+|| Currently this is mainly used with UPnP, but it can be
+|| used for web services as well.
+||
+|#
+
+(require racket/match
+ racket/list
+ xml)
+
+(provide soap-encode
+ soap-decode )
+
+(define (soap-encode body0 [head0 #f] [ns #f] [enc #f])
+ (let* ( [n (if (eq? ns #f) "http://www.w3.org/2001/12/soap-envelope" ns)]
+ [e (if (eq? enc #f) '() `((s:encodingStyle ,enc)))]
+ [head (if (or (eq? #f head0) (pair? head0)) head0 (list head0))]
+ [body (if (pair? body0) body0 (list body0) )]
+ [h (if (eq? head #f) '() `((s:Header () ,@head)))]
+ [x `(s:Envelope ((xmlns:s ,n) ,@e) ,@h (s:Body () ,@body)) ] )
+ (string->bytes/utf-8
+ (format "<?xml version=\"1.0\" encoding=\"utf-8\"?>~a" (xexpr->string x)))
+ )
+ )
+
+(define (soap-decode m [proc-hdlf #f])
+ (let*([x (xml->xexpr (document-element (read-xml (open-input-string m))))]
+ [ns (match (symbol->string (first x))
+ [[regexp "^(.+):Envelope$" (list _ a)] a]
+ )]
+ [symns (string->symbol (format "xmlns:~a" ns))]
+ [symen (string->symbol (format "~a:encodingStyle" ns))]
+ [symhd (string->symbol (format "~a:Header" ns))]
+ [symbd (string->symbol (format "~a:Body" ns))]
+ [symfl (string->symbol (format "~a:Fault" ns))]
+ [enc #f] ; TODO
+ [nsurl (second (first (filter (lambda (a) (equal? symns (car a)))
+ (second x))))
+ ]
+ [cntal (rest (rest x))]
+ [cnthd (filter (lambda (a) (equal? symhd (car a))) cntal) ]
+ [cntbd (filter (lambda (a) (equal? symbd (car a))) cntal) ]
+ )
+ (cond
+ [((length cnthd) . > . 1) (raise "More than one SOAP Header")]
+ [((length cntbd) . > . 1) (raise "More than one SOAP Body")]
+ [else
+
+ (let* ( [cnthdc (if ((length cnthd) . eq? . 1) (cddr (first cnthd)) '())]
+ [cntbdc (if ((length cntbd) . eq? . 1) (cddr (first cntbd)) '())]
+ [cntflt (filter (lambda (a) (equal? symfl (car a))) cntbdc)] )
+ (if ((length cntflt) . > . 0)
+ (if (equal? proc-hdlf #f)
+ (raise "SOAP fault message not handled")
+ (let ([flbdc (first cntflt)]
+ [fcode #f]
+ [fstr #f]
+ [factor #f]
+ [fdetl #f])
+ (for ([z flbdc])
+ (match z
+ [`[faultcode () ,y] (set! fcode y)]
+ [`[faultstring () ,y] (set! fstr y)]
+ [`[faultactor () ,y] (set! factor y)]
+ [`[detail () ,y ...] (set! fdetl y)]
+ [_ (void)] )
+ )
+ (proc-hdlf fcode fstr factor fdetl)
+ )
+ )
+ (values cntbdc cnthdc ns enc))
+ )
+ ]
+ )
+ )
+ )
525 src/upnp-client.rkt
@@ -0,0 +1,525 @@
+#lang racket/base
+
+#|
+|| UPnP Client Library for Racket
+||
+|| How it (should) works:
+||
+|| (define d (upnp-discovery))
+|| (define s (upnp-search-service-srvid d "urn:upnp-org:serviceId:WANIPConn1"))
+|| (define c (upnp-control-lambda s))
+|| ; TODO: below
+|| (define get-external-ip (c "GetExternalIPAddress" '("NewExternalIPAddress")))
+|| (define add-port-mapping (c "AddPortMapping" '() "NewRemoteHost" "NewExternalPort" "NewProtocol" "NewInternalPort" "NewInternalClient" "NewEnabled" "NewPortMappingDescription" "NewLeaseDuration"))
+||
+|| And then use (get-external-ip) to get the external ip, or use (add-port-mapping ...) with the parameters
+||
+|#
+
+(require racket/match
+ racket/list
+ racket/bool
+ racket/udp
+ net/url
+ xml
+ "soap.rkt")
+
+(define USER_AGENT "Racket UPnP")
+
+(define (parse-httpu cnt)
+ (let* ([sp (open-input-string (bytes->string/utf-8 cnt))]
+ [rpc (read-line sp 'any)]
+ [f-loc #f]
+ [f-usn #f]
+ [f-st #f])
+ (match rpc
+ [[regexp #rx"^(?i:HTTP/[0-9.]+) +200([^0-9].*)$" [list _ _]]
+ (let loop ([a (read-line sp 'any)])
+ (unless (eof-object? a)
+ (match a
+ ["" (void)]
+ [[regexp #rx"^([^: ]+): *(.*)$" [list _ mf mv]]
+ (match (list (string-upcase mf) mv)
+ [`["AL" ,y] (void)]
+ [`["ST" ,y]
+ (set! f-st y)
+ ]
+ [`["01-NLS" ,y] (void)]
+ [`["LOCATION" ,y]
+ (match y
+ [[regexp "http://.+" (list _)]
+ (set! f-loc y)]
+ [[regexp "^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+:?[0-9]*$" (list _)]
+ (set! f-loc (format "http://~a/" y))]
+ [_ (void)]
+ )
+ ]
+ [`["CACHE-CONTROL" ,y] (void)]
+ [`["USN" ,y]
+ (set! f-usn y)
+ ]
+ [`["SERVER" ,y] (void)]
+ [`["EXT" ,y] (void)]
+ [`["OPT" ,y] (void)]
+ [`["DATE" ,y] (void)]
+ [`["X-USER-AGENT" ,y] (void)]
+ [_ (void)] )])
+ (loop (read-line sp 'any)) ))]
+ [_ (void)] )
+ (values f-loc f-usn f-st) )
+ )
+
+(define (upnp-discovery)
+ (let ([hshset (make-hash)] ; key: url-location value: #t
+ [hshst (make-hash)] ; key: url-location value: list of ST
+ [hshusn (make-hash)]) ; key: url-location value: list of USN
+ (thread
+ (lambda()
+ (define (storeresponse rip rpo cnt)
+ (let-values ([(f-loc f-usn f-st) (parse-httpu cnt)])
+ (when (not (equal? #f f-loc))
+ (hash-set! hshset f-loc #t)
+ (hash-set! hshusn f-loc (cons f-usn (hash-ref hshusn f-loc '())))
+ (hash-set! hshst f-loc (cons f-st (hash-ref hshst f-loc '())))
+ ))
+ )
+ (let*([ssdpip "239.255.255.250"]
+ [ssdpport 1900]
+ [randport 32322] ; TODO: Make random port
+ [us (udp-open-socket)]
+ [bf (make-bytes 2048)]
+ [ssdpqry (string->bytes/utf-8
+ (string-append
+ "M-SEARCH * HTTP/1.1\r\n"
+ "HOST: " ssdpip ":" (number->string ssdpport) "\r\n"
+ "MAN: \"ssdp:discover\"\r\n"
+ "MX: 10\r\n"
+ "ST: ssdp:all\r\n"
+ "\r\n"))])
+ (udp-bind! us "0.0.0.0" randport) ; make random port number
+ (udp-send-to us ssdpip ssdpport ssdpqry)
+ (let loop ()
+ (let-values ([(l rip rpo) (udp-receive! us bf)])
+ (storeresponse rip rpo (subbytes bf 0 l))
+ )
+ (loop))
+ ))
+ )
+ (lambda (cmd)
+ (case cmd
+ ['stop
+ ; TODO: stop and dispose UDP listener thread
+ #t]
+ ['list
+ (map (lambda (u0)
+ (let ([u (car u0)])
+ (list u (hash-ref hshst u '()) (hash-ref hshusn u '()))))
+ (hash->list hshset))
+ ]
+ ))
+ )
+ )
+
+; (define s (upnp-search-service-srvtype d "service:WANIPConnection:1"))
+; TODO: Change d0 to handle list of discovered devices
+(define (upnp-search-service-proc d filtproc)
+ (let ([lst (d 'list)])
+ (let loop ([l lst])
+ (if (equal? '() l)
+ #f
+ (let ([r (upnp-search-service-proc/one-url (first (first l)) filtproc)])
+ (if (procedure? r)
+ r
+ (if (equal? '() (rest l))
+ #f
+ (loop (rest l))))
+ )))))
+
+(define (upnp-search-service-proc/one-url urlreq filtproc)
+ (with-handlers ([exn:fail? (λ (e) #f)])
+ (call/cc
+ (lambda (return)
+ (let* ( [hdrs `(,(format "User-Agent: ~a" USER_AGENT)
+ "Connection: close"
+ "Accept: text/html, text/xml; q=.2, */*; q=.2"
+ "Content-type: application/x-www-form-urlencoded")]
+ [inp (get-pure-port (string->url urlreq) hdrs)]
+ [d (xml->xexpr (document-element (read-xml inp)))]
+ [location urlreq] )
+ (define (decode-desc-dvlst a)
+ (let ( [devtype #f] [frdname #f]
+ [mfg #f] [mfgurl #f] [mfgdesc #f]
+ [mdlname #f] [udn #f] [prsurl #f]
+ [srvs '()] )
+ (match a
+ [`((xmlns ,y)) (match y ["urn:schemas-upnp-org:device-1-0" #f])]
+ [`(specVersion () ,specversion ...)
+ (for ([t specversion])
+ (match t
+ [`(major () ,maj) (void)]
+ [`(minor () ,min) (void)]
+ [_ (void)]
+ ))
+ #f
+ ]
+ [`(device () ,devinfo ...)
+ (for ([b devinfo])
+ (define (decode-desc-srvlst c)
+ (let ( [srvtype #f] [srvid #f]
+ [ctlurl #f] [evturl #f] [scpdurl #f] )
+ (match c
+ [`(service () ,srvinf ...)
+ (for ([e srvinf])
+ (match e
+ [`(serviceType () ,y)
+ (set! srvtype y) ; e.g. "urn:schemas-upnp-org:service:WANIPConnection:1"
+ ]
+ [`(serviceId () ,y)
+ (set! srvid y) ; e.g. "urn:upnp-org:serviceId:WANIPConnection"
+ ]
+ [`(controlURL () ,y)
+ (set! ctlurl y) ; e.g. "/upnp/control1"
+ ]
+ [`(eventSubURL () ,y)
+ (set! evturl y) ; e.g. "/WANIPConnection"
+ ]
+ [`(SCPDURL () ,y)
+ (set! scpdurl y) ; e.g. "http://192.168.0.1:80/serv3.xml"
+ ]
+ [_ (void)]
+ )
+ )
+ (list srvtype srvid ctlurl evturl scpdurl)
+ ]
+ [_ #f]
+ )
+ )
+ )
+ (match b
+ [`(deviceType () ,y)
+ (set! devtype y) ; e.g. "urn:schemas-upnp-org:device:WANConnectionDevice:1"
+ ]
+ [`(friendlyName () ,y)
+ (set! frdname y) ; e.g. "WAN Connection Device"
+ ]
+ [`(manufacturer () ,y)
+ (set! mfg y) ; e.g. "D-Link"
+ ]
+ [`(manufacturerURL () ,y)
+ (set! mfgurl y) ; e.g. "http://www.dlink.com"
+ ]
+ [`(modelDescription () ,y)
+ (set! mfgdesc y) ; e.g. "Residential Gateway"
+ ]
+ [`(modelName () ,y)
+ (set! mdlname y) ; e.g. "Residential Gateway Device"
+ ]
+ [`(UDN () ,y)
+ (set! udn y) ; e.g. "uuid:000F3D19-AF81-0000-0000-0002C0A80001"
+ ]
+ [`(presentationURL () ,y)
+ (set! prsurl y) ; e.g. "http://192.168.0.1:80/"
+ ]
+ [`(serviceList () ,srvlst ...)
+ (set! srvs (filter-not false? (map decode-desc-srvlst srvlst)))
+ ]
+ [`(deviceList () ,dvlst ...)
+ (for-each decode-desc-dvlst dvlst)
+ ]
+ [_ (void)]
+ )
+ )
+ (for/list ([j srvs])
+ (match j
+ [`[,srvtype ,srvid ,ctlurl ,evturl ,scpdurl]
+ (when (filtproc location devtype srvtype srvid udn frdname
+ scpdurl ctlurl evturl prsurl
+ mfg mfgurl mfgdesc mdlname)
+ (return
+ (lambda()
+ (values location devtype srvtype srvid udn frdname
+ scpdurl ctlurl evturl prsurl
+ mfg mfgurl mfgdesc mdlname))))
+ ]))
+ ]
+ [_ #f])
+ )
+ )
+ ;(printf "~s~n~n" d)
+ (for-each decode-desc-dvlst d)
+ ))))
+ )
+
+(define (upnp-search-service-srvid d svu)
+ (let ([srx (regexp (string-append svu "$"))])
+ (upnp-search-service-proc
+ d (lambda (location devtype srvtype srvid udn frdname scpdurl ctlurl evturl prsurl mfg mfgurl mfgdesc mdlname)
+ (printf "~s ?= ~s -> ~s~n" srx srvid (regexp-match srx srvid))
+ (if (regexp-match srx srvid)
+ #t
+ #f ))))
+ )
+
+(define (upnp-search-service-udnsrvid d ud svu)
+ (let ([srx (regexp (string-append svu "$"))])
+ (upnp-search-service-proc
+ d (lambda (location devtype srvtype srvid udn frdname scpdurl ctlurl evturl prsurl mfg mfgurl mfgdesc mdlname)
+ (if (and (equal? ud udn) (regexp-match srx srvid))
+ #t
+ #f )))
+ )
+ )
+(define (upnp-search-service-devsrvtype d dev srv)
+ (let ([drx (regexp (string-append dev "$"))]
+ [srx (regexp (string-append srv "$"))])
+ (upnp-search-service-proc
+ d (lambda (location devtype srvtype srvid udn frdname scpdurl ctlurl evturl prsurl mfg mfgurl mfgdesc mdlname)
+ (if (and (regexp-match drx devtype) (regexp-match srx srvtype))
+ #t
+ #f ))))
+ )
+
+(define (upnp-search-service-srvtype d srv)
+ (let ([srx (regexp (string-append srv "$"))])
+ (upnp-search-service-proc
+ d (lambda (location devtype srvtype srvid udn frdname scpdurl ctlurl evturl prsurl mfg mfgurl mfgdesc mdlname)
+ (if (regexp-match srx srvtype)
+ #t
+ #f ))))
+ )
+
+; (define c (upnp-control-lambda s))
+(define (upnp-control-lambda s)
+ (let-values ([(location devtype srvtype srvid udn frdname
+ rel*scpdurl rel*ctlurl rel*evturl prsurl
+ mfg mfgurl mfgdesc mdlname) (s)])
+ (let* ([abs*scpdurl (combine-url/relative (string->url location) rel*scpdurl)]
+ [abs*ctlurl (combine-url/relative (string->url location) rel*ctlurl)]
+ [abs*evturl (combine-url/relative (string->url location) rel*evturl)]
+ [hdrs `(,(format "User-Agent: ~a" USER_AGENT)
+ "Connection: close"
+ "Accept: text/html, text/xml; q=.2, */*; q=.2"
+ "Content-type: application/x-www-form-urlencoded")]
+ [vam (let () (write (url->string abs*scpdurl)))]
+ [inp (get-pure-port abs*scpdurl hdrs)]
+ [d (xml->xexpr (document-element (read-xml inp)))]
+ [hshact (make-hash)]
+ [hshvar (make-hash)] )
+ (for ([a d])
+ (define (decode-scpd-aclst b)
+ (let ([e-nam #f]
+ [e-als #f])
+ (match b
+ [`(action () ,actinflst ...)
+ (for ([e actinflst])
+ (define (decode-scpd-aclst-act-arglist f)
+ (let ([g-stv #f]
+ [g-nam #f]
+ [g-dir #f])
+ (match f
+ [`(argument () ,arg ...)
+ (for ([g arg])
+ (match g
+ [`(relatedStateVariable () ,y) (set! g-stv y)]
+ [`(name () ,y) (set! g-nam y)]
+ [`(direction () ,y)
+ (set! g-dir (match y
+ ["in" 'in]
+ ["out" 'out]
+ ))
+ ]
+ [_ (void)]
+ )
+ )
+ (list g-dir g-nam g-stv)
+ ]
+ [_ #f])
+ )
+ )
+ (match e
+ [`(argumentList () ,arglst ...)
+ (set! e-als (filter-not false? (map decode-scpd-aclst-act-arglist arglst)))
+ ]
+ [`(name () ,y) (set! e-nam y)]
+ [_ (void)]
+ )
+ )
+ (hash-set! hshact e-nam e-als)
+ ]
+ [_ (void)]
+ )
+ )
+ )
+ (define (decode-scpd-stttbl b)
+ (let ([c-dvl #f]
+ [c-vls #f]
+ [c-nam #f]
+ [c-typ #f])
+ (match b
+ [`(stateVariable ((sendEvents ,se)) ,sttvarinf ...)
+ (for ([c sttvarinf])
+ (define (decode-scpd-stttbl-var-vallst d)
+ (match d
+ [`(allowedValue () ,y) y]
+ [_ #f]
+ )
+ )
+ (match c
+ [`(defaultValue () ,y)
+ (set! c-dvl y)
+ ]
+ [`(allowedValueList () ,vallst ...)
+ (set! c-vls (filter-not false? (map decode-scpd-stttbl-var-vallst vallst)))
+ ]
+ [`(name () ,y)
+ (set! c-nam y)
+ ]
+ [`(dataType () ,y)
+ (set! c-typ (match y
+ ["boolean" 'bool]
+ ["string" 'string]
+ ["ui2" 'ui2]
+ ["ui4" 'ui4] ))
+ ]
+ [_ (void)]
+ )
+ )
+ (hash-set! hshvar c-nam (list c-typ c-dvl c-vls))
+ ]
+ [_ (void)]
+ )
+ )
+ )
+ (match a
+ [`((xmlns ,y)) (match y ["urn:schemas-upnp-org:service-1-0" (void)])]
+ [`(specVersion () ,specversion)
+ (for ([t specversion])
+ (match t
+ [`(major () ,maj) (void)]
+ [`(minor () ,min) (void)]
+ [_ (void)]
+ ))
+ ]
+ [`(actionList () ,aclst ...)
+ (for-each decode-scpd-aclst aclst)]
+ [`(serviceStateTable () ,stttbl ...)
+ (for-each decode-scpd-stttbl stttbl)]
+ [_ (void)]
+ )
+ )
+ (lambda (arg0 . args)
+ ; TODO: Generate lambdas of UPnP actions:
+ ; (define scpd (decode-scpd ... ))
+ (match (cons arg0 args)
+ ; (scpd "AddPortMapping" '() "NewRemoteHost" "NewExternalPort" "NewProtocol" "NewInternalPort" "NewInternalClient" "NewEnabled" "NewPortMappingDescription" "NewLeaseDuration")
+ [`[,act (,r ...) ,a ...]
+ (let* ([ha (hash-ref hshact act)]
+ [ai (map (lambda (z)
+ (let loop ([hha ha])
+ (if (and (equal? 'in (first (first hha)))
+ (equal? z (second (first hha))))
+ (second (first hha))
+ (if (empty? hha)
+ (raise "Could not find In argument")
+ (loop (rest hha)))))
+ ) a)]
+ [ar (map (lambda (z)
+ (let loop ([hha ha])
+ (if (and (equal? 'out (first (first hha)))
+ (equal? z (second (first hha))))
+ (second (first hha))
+ (if (empty? hha)
+ (raise "Could not find Out argument")
+ (loop (rest hha)))))
+ ) r)])
+ ;(memq 'a '(a b c))
+ (lambda args/in
+ (when (not (eq? (length args/in) (length ai)))
+ (raise "Input argument mismatch")
+ )
+ (let* ([saargs (map (lambda (a b) `(,(string->symbol a) () ,b)) ai args/in)]
+ [soapac (format "~a#~a" srvtype act)]
+ [saenvb `(,(string->symbol (format "u:~a" act)) ((xmlns:u ,srvtype)) ,@saargs)]
+ [soapnv (soap-encode `(,saenvb) #f
+ "http://schemas.xmlsoap.org/soap/envelope/"
+ "http://schemas.xmlsoap.org/soap/encoding/")]
+ [fresp "<?xml version=\"1.0\"?><s:Envelope xmlns:s=\"http://schemas.xmlsoap.org/soap/envelope/\" s:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\"><s:Body><m:GetGenericPortMappingEntryResponse xmlns:m=\"urn:schemas-upnp-org:service:WANIPConnection:1\"><NewRemoteHost></NewRemoteHost><NewExternalPort>16293</NewExternalPort><NewProtocol>TCP</NewProtocol><NewInternalPort>16293</NewInternalPort><NewInternalClient>192.168.0.132</NewInternalClient><NewEnabled>1</NewEnabled><NewPortMappingDescription>LimeTCP4BC4CD2E33</NewPortMappingDescription><NewLeaseDuration>0</NewLeaseDuration></m:GetGenericPortMappingEntryResponse></s:Body></s:Envelope>"])
+ (define (handle-fault fcode fstr factor fdetl)
+ (printf "Fault happened: ~s~n~s~n~s~n~s~n" fcode fstr factor fdetl))
+ ; TODO: Implement actual UPnP call
+ (printf "POST ~a~nSOAPAction: ~s~nContent-Type: text/xml; charset=\"utf-8\"~nUser-Agent: ~a~n~n~a~n -> ~s~n~n"
+ rel*ctlurl soapac USER_AGENT soapnv ar)
+ (let-values ([(rb rh ns en) (soap-decode fresp handle-fault)])
+ (let ([respargs (cddr (first rb))]
+ [argoutset (make-hash)])
+ (for ([z respargs])
+ (match z
+ [`[,argo () ,argval]
+ (hash-set! argoutset (symbol->string argo) argval)
+ ]
+ [_ (void)]
+ ))
+ (apply values (map (lambda (z)
+ (hash-ref argoutset z #f))
+ ar))
+ )
+ )
+ )
+ )
+ )
+ ]
+ ; (scpd 'event "ConnectionType" (lambda(v) (void)))
+ [`[event ,var ,proc]
+ (printf "c: ~s evt ~s ~s -- ~s~n" abs*evturl var proc (hash-ref hshvar var))
+ ]
+ )
+ )
+ )
+ )
+ )
+
+#|
+((c "SetConnectionType" '() "NewConnectionType") "")
+((c "GetConnectionTypeInfo" '("NewConnectionType" "NewPossibleConnectionTypes")))
+((c "ForceTermination" '()))
+((c "RequestConnection" '()))
+((c "GetStatusInfo" '("NewConnectionStatus" "NewLastConnectionError" "NewUptime")))
+((c "GetNATRSIPStatus" '("NewRSIPAvailable" "NewNATEnabled")))
+((c "GetGenericPortMappingEntry" '("NewRemoteHost" "NewExternalPort" "NewProtocol" "NewInternalPort" "NewInternalClient" "NewEnabled" "NewPortMappingDescription" "NewLeaseDuration") "NewPortMappingIndex") "")
+((c "GetSpecificPortMappingEntry" '("NewInternalPort" "NewInternalClient" "NewEnabled" "NewPortMappingDescription" "NewLeaseDuration") "NewRemoteHost" "NewExternalPort" "NewProtocol") "NewRemoteHost" "NewExternalPort" "NewProtocol")
+((c "AddPortMapping" '() "NewRemoteHost" "NewExternalPort" "NewProtocol" "NewInternalPort" "NewInternalClient" "NewEnabled" "NewPortMappingDescription" "NewLeaseDuration") "NewRemoteHost" "NewExternalPort" "NewProtocol" "NewInternalPort" "NewInternalClient" "NewEnabled" "NewPortMappingDescription" "NewLeaseDuration")
+((c "DeletePortMapping" '() "NewRemoteHost" "NewExternalPort" "NewProtocol") "NewRemoteHost" "NewExternalPort" "NewProtocol")
+((c "GetExternalIPAddress" '("NewExternalIPAddress")))
+
+(c 'event "ConnectionType" (lambda(v) (void)))
+(c 'event "PossibleConnectionTypes" (lambda(v) (void)))
+(c 'event "ConnectionStatus" (lambda(v) (void)))
+(c 'event "Uptime" (lambda(v) (void)))
+(c 'event "LastConnectionError" (lambda(v) (void)))
+(c 'event "RSIPAvailable" (lambda(v) (void)))
+(c 'event "NATEnabled" (lambda(v) (void)))
+(c 'event "ExternalIPAddress" (lambda(v) (void)))
+(c 'event "PortMappingNumberOfEntries" (lambda(v) (void)))
+(c 'event "PortMappingEnabled" (lambda(v) (void)))
+(c 'event "PortMappingLeaseDuration" (lambda(v) (void)))
+(c 'event "RemoteHost" (lambda(v) (void)))
+(c 'event "ExternalPort" (lambda(v) (void)))
+(c 'event "InternalPort" (lambda(v) (void)))
+(c 'event "PortMappingProtocol" (lambda(v) (void)))
+(c 'event "InternalClient" (lambda(v) (void)))
+(c 'event "PortMappingDescription" (lambda(v) (void)))
+|#
+
+; Services:
+; "urn:upnp-org:serviceId:WANIPConnection"
+; "urn:upnp-org:serviceId:WANIPConn1"
+; "urn:upnp-org:serviceId:WANPPPConn1"
+; "urn:upnp-org:serviceId:WANCommonIFC1"
+; "urn:upnp-org:serviceId:Layer3Forwarding:11"
+
+;(module+ main
+; (define d (upnp-discovery))
+; (define s (upnp-search-service-srvid d "urn:upnp-org:serviceId:WANIPConn1"))
+; (define c (upnp-control-lambda s))
+; c
+; )

0 comments on commit 0c7d9ca

Please sign in to comment.