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
		}
    } 
}