Posted to tcl by Napier at Sat Nov 22 02:12:00 GMT 2014view pretty
namespace eval ::ssdp { package require udp variable addr 239.255.255.250 variable port 1900 variable handler "" ## Constructs the request to search for the specified search target # @function discover # @param st: Search Target for a device that responds to SSDP # @param mx: Amount of time the devices can take to respond # @param repeat: The amount of times to repeat the command proc discover {st callback {mx 1} {repeat 2}} { variable addr; variable port; variable handler set fd [udp_open $port] set handler $callback #fconfigure $fd -buffering none -blocking 0 #fconfigure $fd -mcastadd $addr -remote [list $addr $port] fileevent $fd readable [namespace code [list receive $fd]] set message [list "M-SEARCH * HTTP/1.1"] lappend message "ST: $st" lappend message "MAN: \"ssdp:discover\"" lappend message "MX: $mx" lappend message "HOST: $addr:$port" lappend message "" # UDP messages may be lost, so send it several times broadcast $fd [join $message \n] $repeat # Clean up the temporary socket when it's no longer needed after [expr {1000 * ($mx + 2)}] [list close $fd] } proc broadcast {fd msg {count 1} {delay 400}} { variable addr; variable port; variable handler fconfigure $fd -remote [list $addr $port] -ttl 4 -translation crlf puts $fd $msg flush $fd if {[incr count -1] > 0} { after $delay [namespace code [list broadcast $fd $msg $count $delay]] } } proc receive {fd} { variable handler set data [read $fd] # Discard false triggers if {$data eq ""} return set peer [fconfigure $fd -peer] LOG "Received [string length $data] bytes from [join $peer :]:\n$data\n" LOG "Calling handler" if {[procExists $handler]} { $handler $data } } }