diff --git a/info.rkt b/info.rkt index 5ee0c1c..abeed9d 100644 --- a/info.rkt +++ b/info.rkt @@ -1,7 +1,7 @@ #lang info (define pkg-authors '(hnmdijkema)) -(define version "0.1.5") +(define version "0.1.6") (define license 'MIT) (define collection "racket-upnp") (define pkg-desc "racket-upnp - UpnP and DLNA for racket") diff --git a/main.rkt b/main.rkt index 77f0b32..3d6912b 100644 --- a/main.rkt +++ b/main.rkt @@ -2,7 +2,8 @@ ;; Main public interface for racket-upnp. -(require "query.rkt" +(require "network.rkt" + "query.rkt" "service.rkt" "didl-lite.rkt" "media-renderer.rkt" @@ -11,6 +12,7 @@ (provide (all-from-out + "network.rkt" "query.rkt" "service.rkt" "didl-lite.rkt" diff --git a/network.rkt b/network.rkt new file mode 100644 index 0000000..a6f20fe --- /dev/null +++ b/network.rkt @@ -0,0 +1,33 @@ +#lang racket/base + +;; Network helpers used by UPnP and SSDP. + +(require racket/udp + simple-log) + +(provide upnp-default-ipv4-address) + +(sl-def-log upnp-network) + +(define ssdp-multicast-address "239.255.255.250") +(define ssdp-multicast-port 1900) + +;; Return the local IPv4 address selected by the operating system for traffic +;; to the SSDP multicast destination. No datagram is transmitted. +(define (upnp-default-ipv4-address) + (let ([socket (udp-open-socket ssdp-multicast-address + ssdp-multicast-port)]) + (dynamic-wind + void + (lambda () + (udp-connect! socket ssdp-multicast-address ssdp-multicast-port) + (define-values (local-address local-port remote-address remote-port) + (udp-addresses socket #t)) + (dbg-upnp-network + "Selected UPnP IPv4 address ~a for SSDP destination ~a:~a" + local-address + ssdp-multicast-address + ssdp-multicast-port) + local-address) + (lambda () + (udp-close socket))))) diff --git a/query.rkt b/query.rkt index 6e271c9..7648ddf 100644 --- a/query.rkt +++ b/query.rkt @@ -183,7 +183,7 @@ (dbg-upnp-query "Querying UPnP devices kinds=~s interface=~a dns?=~a mx=~a timeout=~a repeat=~a" kinds-value - (or interface "default") + (or interface "automatic") dns? mx (or timeout "default") diff --git a/scribblings/main.scrbl b/scribblings/main.scrbl index ead2aee..837f717 100644 --- a/scribblings/main.scrbl +++ b/scribblings/main.scrbl @@ -13,6 +13,14 @@ interface. @section{Discovering devices} +@defproc[(upnp-default-ipv4-address) string?]{ +Returns the local IPv4 address selected by the operating system for traffic to +the SSDP multicast destination @tt{239.255.255.250:1900}. No datagram is sent. +This is normally the interface through which UPnP devices on the local network +can be reached. +} + + @defproc[(query-upnp-devices [kinds (or/c 'all symbol? (listof symbol?)) 'all] [#:interface interface (or/c #f string?) #f] @@ -26,7 +34,10 @@ Discovers and describes matching UPnP devices. @racket['all] returns all described devices. A symbol such as @racket['media-renderer] selects one known kind, and a list selects several kinds. When @racket[interface] is a local IPv4 address, SSDP multicast is sent -through that interface. Reverse DNS lookup is only attempted when @racket[dns?] is true. +through that interface. When it is @racket[#f], +@racket[upnp-default-ipv4-address] is used automatically. If automatic +detection fails, discovery falls back to the interface selected by the +operating system. Reverse DNS lookup is only attempted when @racket[dns?] is true. @racket[mx] is the SSDP response delay advertised in the M-SEARCH request. The default receive window is @racket[mx] plus one second. An explicit diff --git a/ssdp.rkt b/ssdp.rkt index 821a83f..f06c02f 100644 --- a/ssdp.rkt +++ b/ssdp.rkt @@ -9,7 +9,8 @@ (require racket/list simple-log racket/string - racket/udp) + racket/udp + "network.rkt") (provide ssdp-response? ssdp-response-address @@ -179,6 +180,7 @@ ;; Search for a UPnP search target. The default "ssdp:all" returns all ;; advertised device and service targets. #:interface may be a local IPv4 ;; address such as "10.7.3.118" when the machine has multiple interfaces. +;; Without #:interface, the local IPv4 address for the SSDP route is detected. (define (ssdp-discover [search-target "ssdp:all"] #:mx [mx 3] #:timeout [timeout #f] @@ -186,24 +188,36 @@ #:interface [interface #f] #:ttl [ttl 2] #:user-agent [user-agent #f]) - (let ([effective-timeout (or timeout (+ mx 1.0))]) + (let* ([effective-timeout (or timeout (+ mx 1.0))] + [effective-interface + (or interface + (with-handlers + ([exn:fail? + (lambda (exception) + (warn-upnp-ssdp + "Could not determine the UPnP IPv4 address: ~a; using the OS-selected interface" + (exn-message exception)) + #f)]) + (upnp-default-ipv4-address)))]) (check-discovery-arguments search-target mx effective-timeout repeat - interface + effective-interface ttl user-agent) - (dbg-upnp-ssdp "Starting SSDP discovery target=~a mx=~a timeout=~a repeat=~a interface=~a ttl=~a" search-target mx effective-timeout repeat (or interface "default") ttl) + (dbg-upnp-ssdp "Starting SSDP discovery target=~a mx=~a timeout=~a repeat=~a interface=~a ttl=~a" search-target mx effective-timeout repeat (or effective-interface "OS-selected") ttl) (let ([socket (udp-open-socket ssdp-multicast-address ssdp-multicast-port)] [request (make-search-request search-target mx user-agent)]) (dynamic-wind void (lambda () (define started-at (current-inexact-milliseconds)) - (udp-bind! socket interface 0) - (dbg-upnp-ssdp "SSDP socket bound to interface ~a" (or interface "default")) - (udp-multicast-set-interface! socket interface) + (udp-bind! socket effective-interface 0) + (dbg-upnp-ssdp + "SSDP socket bound to local interface ~a" + (or effective-interface "OS-selected")) + (udp-multicast-set-interface! socket effective-interface) (udp-multicast-set-ttl! socket ttl) (for ([attempt (in-range repeat)]) (dbg-upnp-ssdp "Sending SSDP M-SEARCH attempt ~a of ~a" (add1 attempt) repeat)