Scripts
AI
Animation
CGI
Compression
Console
Database
Debug
Dialects
Dialogs
Editor
Email
Encryption
Extension
External Library
File
File Handling
Files
Financial
FTP
Game
Games
Graphics
GUI
HTML
HTTP
Internet
LDC
Markup
Math
Module
Network
Networking
None
Other - Net
Parse
Patch
Printing
Protocol
Rebol
Scheme
Scientific
SDK
Security
Shell
Sound
SQL
TCP
Testing
Text
Text Processing
UI
User Interface
Util
Utility
VID
Visualization
Web
Win API
X-File
XML
Wiki
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) ... "