Posted to tcl by Napier at Sat Nov 22 02:12:00 GMT 2014view raw

  1. namespace eval ::ssdp {
  2. package require udp
  3. variable addr 239.255.255.250
  4. variable port 1900
  5. variable handler ""
  6.  
  7. ## Constructs the request to search for the specified search target
  8. # @function discover
  9. # @param st: Search Target for a device that responds to SSDP
  10. # @param mx: Amount of time the devices can take to respond
  11. # @param repeat: The amount of times to repeat the command
  12. proc discover {st callback {mx 1} {repeat 2}} {
  13. variable addr; variable port; variable handler
  14.  
  15. set fd [udp_open $port]
  16. set handler $callback
  17.  
  18. #fconfigure $fd -buffering none -blocking 0
  19. #fconfigure $fd -mcastadd $addr -remote [list $addr $port]
  20. fileevent $fd readable [namespace code [list receive $fd]]
  21.  
  22. set message [list "M-SEARCH * HTTP/1.1"]
  23. lappend message "ST: $st"
  24. lappend message "MAN: \"ssdp:discover\""
  25. lappend message "MX: $mx"
  26. lappend message "HOST: $addr:$port"
  27. lappend message ""
  28.  
  29. # UDP messages may be lost, so send it several times
  30. broadcast $fd [join $message \n] $repeat
  31.  
  32. # Clean up the temporary socket when it's no longer needed
  33. after [expr {1000 * ($mx + 2)}] [list close $fd]
  34. }
  35.  
  36. proc broadcast {fd msg {count 1} {delay 400}} {
  37. variable addr; variable port; variable handler
  38.  
  39. fconfigure $fd -remote [list $addr $port] -ttl 4 -translation crlf
  40. puts $fd $msg
  41. flush $fd
  42. if {[incr count -1] > 0} {
  43. after $delay [namespace code [list broadcast $fd $msg $count $delay]]
  44. }
  45. }
  46.  
  47. proc receive {fd} {
  48. variable handler
  49.  
  50. set data [read $fd]
  51.  
  52. # Discard false triggers
  53. if {$data eq ""} return
  54.  
  55. set peer [fconfigure $fd -peer]
  56. LOG "Received [string length $data] bytes from [join $peer :]:\n$data\n"
  57. LOG "Calling handler"
  58.  
  59. if {[procExists $handler]} {
  60. $handler $data
  61. }
  62. }
  63. }