UPnP search

ssdp.tcl

package require udp

set count 0

# A SSDP multicast demo.
proc udpEvent {chan} {
    global count
    set data [read $chan]
    set peer [fconfigure $chan -peer]
    puts "=================== $count ========================="
    set count [expr $count + 1] 
    puts "$peer [string length $data] $data"
    return
}

set group 239.255.255.250
set port  1900

global s
set s [udp_open $port]
fconfigure $s -buffering none -blocking 0
fconfigure $s -mcastadd $group -remote [list $group $port]
fileevent $s readable [list udpEvent $s]

puts -nonewline $s "M-SEARCH * HTTP/1.1\r\nMX: 3\r\nHOST: 239.255.255.250:1900\r\nMAN: \"ssdp:discover\"\r\nST: upnp:rootdevice\r\n\r\n"
#puts -nonewline $s "M-SEARCH * HTTP/1.1\r\nMX: 3\r\nHOST: 239.255.255.250:1900\r\nMAN: \"ssdp:discover\"\r\nST: ssdp:all\r\n\r\n"


set ::forever 0
vwait ::forever