FB Here is a small SSDP package that I wrote for a UPnP media server of mine ("Mediatheque", just change the ssdp::Server variable to whatever you choose). The code is quite simple: it creates a UDP multicast socket on the well known SSDP address and port 239.255.255.250:1900, posts periodic alive messages and listens to incoming discovery requests on its advertised services:
# # ssdp.tcl -- # # SSDP handling. Note that only features needed by this application are # supported, this is not a generic SSDP package although it can serve as # a basis for implementing one. # # SSDP uses HTTPU messages on the multicast UDP address 239.255.255.250:1900 # UPNP uses SSDP for service announcement and discovery. # # This package uses a single UDP socket provided by the Tcl udp extension. # Minimal version is 1.0.9 for address reuse support (SO_REUSEADDR) because # several applications (clients or servers) may open this address on the same # machine. # # TODO: at present the udp package doesn't support binding to specific # interfaces, so we have to specify the advertised device addresses manually. # package require udp 1.0.9 namespace eval ssdp { variable Server "Mediatheque" # Refresh interval. variable Refresh 1800 # # log -- # # Simple logging. # proc log {sock message} { puts "\[[clock format [clock seconds] -format %Y%m%d\ %H:%M:%S]\] ($sock) $message" } # # start -- # # Starts SSDP listening and announcement. This creates the socket and # a fileevent for incoming message handling. # # Parameters: # - addresses: List of HTTP device addresses to advertise. # - port: HTTP port of device. # - path: Path of the device description file. # - udn: UDN of the provided device. # - services: List of provided service types. # proc start {addresses port path udn services} { # Remember parameters. variable Addresses $addresses variable Port $port variable Path $path variable Udn $udn variable Services $services # Open SSDP socket. This will stay open until a call to stop. variable Sock [udp_open 1900 reuse] fconfigure $Sock -translation crlf -buffering none fconfigure $Sock -mcastadd 239.255.255.250 fileevent $Sock readable [namespace code incoming] # Send announcement periodically. announce } # # stop -- # # Stops SSDP listening and announcement. # proc stop {} { variable Services # Cancel the announcement event. after cancel [namespace code announce] # Send byebye messages. byebye upnp:rootdevice byebye {} foreach serviceType $Services { byebye $serviceType } } # # announce -- # # Send alive messages periodically. # proc announce {} { variable Services variable Refresh # Send alive messages. alive upnp:rootdevice alive {} foreach serviceType $Services { alive $serviceType } # Reschedule event. after [expr {$Refresh*1000}] [namespace code announce] } # # incoming -- # # Handle incoming HTTPU messages. Respond to discovery requests for one # of the provided services. # proc incoming {} { variable Sock variable Services # Read UDP datagram. set message [read $Sock] set peer [fconfigure $Sock -peer] log $Sock "SSDP message from [join $peer :] <<ENDMARKER\n$message\nENDMARKER" # Decode as HTTPU. Headers are converted to lower case. set message [split $message \n] lassign [lindex $message 0] method url version set headers [list] foreach line [lreplace $message 0 0] { if {$line eq ""} break regexp {^([^:]+):(.*)$} $line all header value lappend headers [string tolower $header] [string trim $value] } switch -exact $method { M-SEARCH { if {[string trim [dict get $headers man] \"] eq "ssdp:discover"} { # Service discovery. set serviceType [dict get $headers st] if {[string match uuid:* $serviceType]} { # Samsung DLNA fix set serviceType urn:schemas-upnp-org:device:MediaServer:1 } if {[lsearch $Services $serviceType] >= 0} { log $Sock "Scheduling response to [join $peer :] for service $serviceType" # Randomize response delay between 0 and MX seconds. if {[catch {set mx [dict get $headers mx]}]} {set mx 0} after [expr {int(rand()*1000*$mx)}] [namespace code [list respond $peer $serviceType]] } } } } } # # respond - # # Respond to incoming discovery requests. # # Parameters: # - peer: Request sender. # - serviceType: Service type from the discovery request. # proc respond {peer serviceType} { variable Sock variable Server variable Refresh variable Port variable Path variable Udn # Get device address to advertise. set s [socket -async [lindex $peer 0] 0] set address [lindex [fconfigure $s -sockname] 0] close $s log $Sock "Responding to [join $peer :] for service $serviceType on interface $address" fconfigure $Sock -remote $peer puts -nonewline $Sock \ "HTTP/1.1 200 OK CACHE-CONTROL: max-age=$Refresh SERVER: $Server EXT: LOCATION: http://$address:$Port$Path ST: $serviceType USN: ${Udn}::$serviceType Content-Length: 0 " } # # notify -- # # Send SSDP notification for a given service type. # # Parameters: # - nts: Message type (e.g. ssdp:alive or ssdp:byebye) # - serviceType: Service type. If empty, notifies device. # proc notify {nts serviceType} { variable Sock variable Refresh variable Addresses variable Port variable Path variable Udn if {$serviceType eq ""} { # Notify device. set nt $Udn set usn $Udn } else { # Notify service. set nt $serviceType set usn ${Udn}::$serviceType } # Send over multicast channel. fconfigure $Sock -remote {239.255.255.250 1900} foreach address $Addresses { # Advertise all device addresses. puts -nonewline $Sock \ "NOTIFY * HTTP/1.1 HOST: 239.255.255.250:1900 CACHE-CONTROL: max-age=$Refresh LOCATION: http://$address:$Port$Path NTS: $nts NT: $nt USN: $usn " } } # Shortcuts for common message types. proc alive {serviceType} {notify ssdp:alive $serviceType} proc byebye {serviceType} {notify ssdp:byebye $serviceType} }Example:
package require uuid set udn "uuid:[::uuid::uuid generate]" set addresses [list 192.168.0.1] set port 12345 set path /description.xml set services { urn:schemas-upnp-org:device:MediaServer:1 urn:schemas-upnp-org:service:ContentDirectory:1 urn:schemas-upnp-org:service:ConnectionManager:1 } ssdp::start $addresses $port $path $udn $servicesThis advertises services for a typical UPnP media server, using description file http://192.168.0.1:12345/description.xml. You'll also need a HTTP server somewhere to serve this file, especially the description file given by the SSDP LOCATION header (here http://192.168.0.1:12345/description.xml but you can use anything as long as it follows the UPnP standard). For my project I use a mini HTTP server adapted from Embedded TCL Web Server, but any server software will do the job (TclHttpd, Apache, lighttpd, whatever), so if you have your own HTTP server already up & running somewhere, just use its address here.
EF Thanks for publishing this, this can be a fantastic start...EF I have repackaged part of that code into a library that really is meant to be used by clients (and especially UPnP clients, see below). The code is part of my new Context Manager, browse further from [1]. The library actively search (by sending M-SEARCH) and listen to spontaneous and requested advertisement to build a cache of known root devices, together with the ability to deliver device and service notifications to clients. So, to use it to discover all known root devices on your network, you would do:
package require ssdp proc rootDeviceDiscoverer {l d type} { #type contains the type of the notification, in this case upnp:rootdevice #d points to an object with information on the root device. puts "New root device with UUID [$d config -uuid] at [$d config -location]" } set listener [::ssdp::new] $listener register rootDeviceDiscoverer upnp:rootdeviceI am sure that there are ways to merge the two libraries. I was interested in discovery and the ability to call actions in discovered UPnP services (see [2], which contains a UPnP implementation), so I never spent the necessary time on declaration of devices and services and ways to answer properly when receiving M-SEARCH notifications (or ways to send NOTIFY at regular intervals). As suggested by FB, one way would be to embed a web server and send the raw XML specifications whenever necessary. Another way would actually be to have an interface that would expose objects and procedures via UPnP devices and services, generating the XML from the exposed objects and procedure whenever requested for it. This requires a web server that can serve dynamic pages, perhaps the one from the TIL [3].
sbron I've started a UPnP project that also includes an ssdp package.