;; ================================================ ;; Script: upnp-igd.r ;; downloaded from: www.REBOL.org ;; on: 29-Mar-2024 ;; at: 4:34:38.643482 UTC ;; owner: coccinelle [script library member who can ;; update this script] ;; ================================================ ;; ================================================== ;; email address(es) have been munged to protect them ;; from spam harvesters. ;; If you were logged on the email addresses would ;; not be munged ;; ================================================== REBOL [ Title: "UPnP - IGD V1.0" Date: 10-Sep-2006 Name: "UPnP - Internet_Gateway_Device_IGD_V1.0" Author: ["Marco"] Version: 0.1 File: %upnp-igd.r Rights: "Public Domain" Email: [%marco--ladyreb--org] Category: [http internet] Library: [ level: 'beginner platform: 'all type: [function tool module protocol] domain: [game extension http protocol other-net html markup parse protocol tcp xml ] tested-under: [win] support: %marco--ladyreb--org license: PD see-also: none ] Comment: { This is script is a pilot to controle a Internet Gateway Device thru UPnP } Purpose: { UPnP-IGD tool to discover and control an Internet Gateway Device via UPnP } Modified: [ [0.0.1 10-Sep-2006 %marco--ladyreb--org {Fist publication of a pilote}] ] Defaults: { } Usage: { ... To be documented ... (sorry) } ] ; *********************************************************** ; XML Utility ; *********************************************************** load-xml: func [ {Loads an XML file and return a nested block/object structure with tag (t) attribute (a) and element (e) For example, this XML : "text tag 1" "text tag 2" is returned like this : [tag1 [ [ ; block of attribute name & value xmlns "ns" ] "text tag 1" tag2 [ [] "text tag 2" ] ]] } source [file! url! string! any-block! binary!] /local item result stack att ][ result: copy [] stack: reduce [result] parse load/markup source [ any [ set item tag! ( case [ #"/" = first item [ remove/part stack 1 ] find "/?" last item [ remove back tail item att: next item: to-block item if #"?" = first item/1: to-string item/1 [append item/1 #"?"] forskip att 2 [ att/1: to-word head remove back tail to-string att/1 ] append stack/1 compose/deep/only [ (to-word last parse item/1 ":") [ (to-tag item/1) (new-line/all/skip copy next item true 2) ] ] ] true [ att: next item: to-block item if #"?" = first item/1: to-string item/1 [append item/1 #"?"] forskip att 2 [ att/1: to-word head remove back tail to-string att/1 ] item: head item append stack/1 compose/deep/only [ (to-word last parse item/1 ":") [ (to-tag item/1) (new-line/all/skip copy next item true 2) ] ] new-line skip tail stack/1 -2 true insert/only stack last stack/1 ] ] ) | set item string! ( unless #"^/" = first item [ append stack/1 item new-line back tail stack/1 true ] ) ]] result ] save-xml: func [ "Saves an XML nested block structure (see load-xml)" where [file! url! binary!] "Where to save it." value [block!] "XML block/object to save." /indent tabs /local result tag attribute element ][ result: either binary? where [where][make binary! ""] unless tabs [tabs: copy ""] parse value rule: [ opt block! ; ignore first block! of attribute if any any [ word! into [ set tag tag! set attribute block! element: ( repend result [tabs mold build-tag [(to-word to-string tag) (attribute)] newline] save-xml/indent result element rejoin [tabs tab] repend result [tabs form to-tag mold to-refinement to-string tag newline] ) to end ] | set element any-type! ( repend result [tabs element newline] ) ] ] unless binary? where [ save where result ] return ] ; ************************************************** ; UPnP Utility ; ************************************************** upnp-search: func [ {Search for an UPnP device return the root device definition or throw an error} /all "Search all device" /type ST [string!] {Search Target must be one of the following single URI (default ssdp:all): ssdp:all Search for all devices and services. upnp:rootdevice Search for root devices only. uuid:device-UUID Search for a particular device. Device UUID specified by UPnP vendor. urn:schemas-upnp-org:device:deviceType:v Search for any device of this type. Device type and version defined by UPnP Forum working committee. urn:schemas-upnp-org:service:serviceType:v Search for any service of this type. Service type and version defined by UPnP Forum working committee. } /max-wait MX [integer!] {Maximum wait in second (default 3). Device responses should be delayed a random duration between 0 and this many seconds to balance load for the control point when it processes responses. This vue should be increased if a large number of devices are expected to respond or if network latencies are expected to be significant. Specified by UPnP vendor. } /local port rule result RC device ][ unless ST [ST: "ssdp:all"] unless MX [MX: 3] port: open/binary udp://239.255.255.250:1900 set-modes port compose/deep [ multicast-ttl: 4 ] insert port rejoin [ {M-SEARCH * HTTP/1.1} crlf {HOST: 239.255.255.250:1900} crlf {MAN: "ssdp:discover"} crlf {MX: } MX crlf {ST: } ST crlf crlf ] device: copy [] while [wait [port MX]][ parse replace/all copy port crlf newline [ {HTTP/1.1 } copy RC to newline newline result: to end (result: parse-header none result) ] unless "200 OK" = RC [ close port to-error reform ["UPnP error (search) :" RC] ] result: load-xml to-url result/LOCATION append device compose/only [root (result/root)] unless all [break] ] close port device ] upnp-invoke: func [ url [url! string!] soap-action [string!] body [string!] /local port result RC ][ url: decode-url url port: open/binary rejoin [tcp:// url/host ":" url/port-id] insert port probe rejoin [ {POST /} url/path url/target { HTTP/1.1} crlf {HOST: } url/host ":" url/port-id crlf {CONTENT-LENGTH: } length? body crlf {CONTENT-TYPE: text/xml; charset="utf-8"} crlf {SOAPACTION: "} soap-action {"} crlf crlf body ] either port = wait [port 5][ parse replace/all copy port crlf newline [ {HTTP/1.1 } copy RC to newline newline result: to end ] close port ][ close port to-error reform ["SOAP error (invoke) : No response"] ] result: load-xml result unless "200 OK" = RC [ to-error reform [ "UPnP error (invoke):" result/envelope/body/Fault/detail/UPnPError/errorCode/3 result/envelope/body/Fault/detail/UPnPError/errorDescription/3 "(" soap-action ")" ] ] result ] upnp-action: func [ url [url! string!] service [block!] actionName [string!] argument [block!] /local port rule result RC body ][ body: copy "" foreach [name value] argument [ repend body [ tab tab tab {<} name {>} value {} crlf ] ] body: rejoin [ {} crlf tab {} crlf tab tab {} crlf body tab tab {} crlf tab {} crlf {} crlf ] result: upnp-invoke rejoin [url service/controlURL/3] rejoin [service/serviceType/3 "#" actionName] body argument: copy [] foreach [item1 item2] at result/envelope/body/(to-word rejoin [actionName 'Response]) 3 [ repend argument [to-word to-string item2/1 item2/3] ] new-line/all/skip argument true 2 ] upnp-query: func [ url [url! string!] service [block!] varName [string! word!] /local port rule result RC body ][ print body: rejoin [ {} crlf tab {} crlf tab tab {} crlf tab tab tab {} varName {} crlf tab tab {} crlf tab {} crlf {} crlf ] result: upnp-invoke rejoin [url service/controlURL/3] "urn:schemas-upnp-org:control-1-0#QueryStateVariable" body result/envelope/body/QueryStateVariableResponse/return/3 ] ; ********************************************************* ; IGD Utility ; ********************************************************* igd-GetExternalIPAdress: func [ {Retrieve the value of the external IP address on this connection instance.} url [url! string!] "URL Base" service [block!] "UPnP Service" /local ][ to-tuple second upnp-action url service "GetExternalIPAddress" [] ] igd-GetGenericPortMappingEntry: func [ { Retrieve NAT port mappings one entry at a time. Control points can call this action with an incrementing array index until no more entries are found on the gateway. } url [url! string!] "URL Base" service [block!] "UPnP Service" index [integer!] /all {Return all port mapping starting at index} /local result item ][ either all [ result: copy [] while [attempt [ item: upnp-action url service "GetGenericPortMappingEntry" compose [ NewPortMappingIndex (index) ] ]][ append result compose/only [(item)] index: index + 1 ] result ][ upnp-action url service "GetGenericPortMappingEntry" compose [ NewPortMappingIndex (index) ] ] ] igd-GetSpecificPortMappingEntry: func [ {Reports the Static Port Mapping specified by the unique tuple of RemoteHost, ExternalPort and PortMappingProtocol.} url [url! string!] "URL Base" service [block!] "UPnP Service" remote-host [tuple! none!] external-port [integer!] protocol [word! string!] /local ][ upnp-action url service "GetSpecificPortMappingEntry" compose [ NewRemoteHost (either remote-host [remote-host][""]) NewExternalPort (external-port) NewProtocol (protocol) ] ] igd-AddPortMapping: func [ {Creates a new port mapping or overwrites an existing mapping with the same internal client} url [url! string!] "URL Base" service [block!] "UPnP Service" remote-host [tuple! none!] external-port [integer!] protocol [word! string!] internal-port [integer!] internal-client [tuple!] enabled [integer!] description [string!] lease-duration [integer!] /local ][ attempt [upnp-action url service "AddPortMapping" compose [ NewRemoteHost (either remote-host [remote-host][""]) NewExternalPort (external-port) NewProtocol (protocol) NewInternalPort (internal-port) NewInternalClient (internal-client) NewEnabled (enabled) NewPortMappingDescription (description) NewLeaseDuration (lease-duration) ]] ] igd-DeletePortMapping: func [ { Delete a previously instantiated port mapping. As each entry is deleted, the array is compacted, and the evented variable PortMappingNumberOfEntries is decremented. } url [url! string!] "URL Base" service [block!] "UPnP Service" remote-host [tuple! none!] external-port [integer!] protocol [word! string!] ][ upnp-action url service "DeletePortMapping" compose [ NewRemoteHost (either remote-host [remote-host][""]) NewExternalPort (external-port) NewProtocol (protocol) ] ] ; *********************************************** ; Testing script ; *********************************************** print [newline "Starting test ..." newline] r: ask "Searching for all root device (Y/N) ..." if "Y" = r [either empty? root-device: upnp-search/all/type "upnp:rootdevice" [ ask "No root device" quit ][ save-xml as-binary z: "" root-device print z ]] r: ask "Searching for first WANIPConnection service (Y/N) ..." if "Y" = r [either root: select upnp-search/type "urn:schemas-upnp-org:service:WANIPConnection:1" 'root [ service: root/device/devicelist/device/deviceList/device/serviceList/service print [ "Found :" newline tab "url Base :" root/urlBase/3 newline tab "friendly Name :" root/device/friendlyName/3 newline tab "device Type :" root/device/deviceType/3 newline tab "external IP Adress :" igd-GetExternalIPAdress root/urlBase/3 service newline ] r: ask "Searching for port mapping (Y/N) ..." if "Y" = r [ print mold/only igd-GetGenericPortMappingEntry/all root/urlBase/3 service 0 ] r: ask "Add & check new mapping port (Y/N) ..." if "Y" = r [ igd-AddPortMapping root/urlBase/3 service none 88 'tcp 88 probe system/network/host-address 1 "test" 0 print mold igd-GetSpecificPortMappingEntry root/urlBase/3 service none 88 'tcp ] ][ print "No device" ]] ask "Done (press Enter) ... "