Posted to tcl by Napier at Sat Nov 22 02:12:00 GMT 2014view raw
- 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
- }
- }
- }