Skip to content

Instantly share code, notes, and snippets.

@bentayloruk bentayloruk/Ssdp.fs Secret
Last active Aug 29, 2015

Embed
What would you like to do?
module Ssdp
open System
open System.Net
open System.Text
open System.Net.Sockets
///
/// SSDP protocol types. Not complete as only adding when happy with design.
///
type SearchTarget = All | RootDevices
type DeviceResponseDelay = OneSecond | TwoSeconds | ThreeSeconds | FourSeconds | FiveSeconds
type MSearch = { SearchTarget:SearchTarget; DeviceResponseDelay:DeviceResponseDelay; }
type DeviceNotification = Available | Unavailable | Updated
/// Reveal F#s secret Agent!
type private Agent<'T> = MailboxProcessor<'T>
/// Extensions to the UdpClient. HT @jonharrop.
type private Sockets.UdpClient with
member client.AsyncSend(bytes, length, ep) =
let beginSend(f, o) = client.BeginSend(bytes, length, ep, f, o)
Async.FromBeginEnd(beginSend, client.EndSend)
member client.AsyncReceive() =
async { let ep = ref null
let endRecv res = client.EndReceive(res, ep)
let! bytes = Async.FromBeginEnd(client.BeginReceive, endRecv)
return bytes, !ep }
///Close and ignore any Exceptions.
member client.ProtectedClose() =
//TODO this is dirty. Make it better.
try client.Close() with | :? SocketException -> () | :? ObjectDisposedException -> ()
// Message types for the listener controller agent.
type private Port = int
type private ListenerController =
| ListenForSearchResponsesAndNotifyAdverts of Port * IPAddress seq
| StopListening
///
/// Represents an SSDP Discovery Session.
/// Create one and ask it to do searches, or just listen to notifications.
/// Search responses and notifications are all fired as events.
///
type Session private (port) =
let messageReceivedEvent = Event<_>()
let multicastIPEndpoint = IPEndPoint(IPAddress.Parse("239.255.255.250"), 1900)
let udpClientReceiveLoopAsync (client:UdpClient) = async {
while true do
let! msgBytes, _ = client.AsyncReceive()
let msg = String(Text.UTF8Encoding.UTF8.GetChars(msgBytes))
//TODO enable this event to fire on caller thread.
//TODO actually parse the message to a type. String just for now.
messageReceivedEvent.Trigger(msg)
}
let createMulticastClient (ip:IPAddress) =
let udpClient = new Sockets.UdpClient(IPEndPoint(ip, 1900))
udpClient.Client.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReuseAddress, true)
udpClient.JoinMulticastGroup(multicastIPEndpoint.Address)
udpClient
let createUnicastClient (port:int, ip:IPAddress) =
let udpClient = new Sockets.UdpClient ()
udpClient.Client.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReuseAddress, true)
udpClient.Client.Bind(IPEndPoint(ip, port))
udpClient
/// Agent that spins up listeners for us. We have this agent indirection step, so that
/// if the NIC ips change during the session, a message can be posted to this agent
/// and it can spin up new listeners. I took this approach to avoid mutation
/// in this class. Is there a more idiomatic way to do this kind of thing?
let udpClientListeningController = Agent.Start(fun inbox ->
let rec loop (runningClients:UdpClient seq) = async {
let! msg = inbox.Receive()
runningClients |> Seq.iter (fun client -> client.ProtectedClose())
match msg with
| ListenForSearchResponsesAndNotifyAdverts (port, ipAddresses) ->
let udpClients =
[ for ip in ipAddresses do
yield createUnicastClient(port, ip)
yield createMulticastClient(ip) ]
//Start em up.
udpClients |> Seq.iter (udpClientReceiveLoopAsync >> Async.Start)
return! loop udpClients
| StopListening -> return! loop Seq.empty
}
loop Seq.empty
)
let upnpIpAddresses () =
//TODO support IPV6 as per UPnP spec. Only v4 for now.
let ipVFourFilter (ipAddress:IPAddress) = ipAddress.AddressFamily = AddressFamily.InterNetwork
let allIps = Dns.GetHostEntry(Dns.GetHostName()).AddressList
allIps |> Seq.filter ipVFourFilter
do
//Start listening and also setup to re-start listening if NIC IP changes.
let listen () =
udpClientListeningController.Post(ListenForSearchResponsesAndNotifyAdverts(port, upnpIpAddresses()))
listen ()
Net.NetworkInformation.NetworkChange.NetworkAddressChanged.Add(fun x -> listen())
/// Create an SSDP Session. Start listening for notifications immediately.
/// Broadcast from the specified port and unicast receive on that port too.
static member Start(port:int) = Session(port)
[<CLIEvent>]
/// Fired when a search response or notification message is received.
member x.MessageReceived = messageReceivedEvent.Publish
/// Do a search for network devices.
member x.BroadcastMSearch(search) =
/// Create a search byte array from an MSearch.
let searchMessageBytes =
let delaySeconds =
match search.DeviceResponseDelay with
| OneSecond -> 1
| TwoSeconds -> 2
| ThreeSeconds -> 3
| FourSeconds -> 4
| FiveSeconds -> 5
let searchTarget =
match search.SearchTarget with
| All -> "ssdp:all"
| RootDevices -> "upnp:rootdevice"
let msg =
(sprintf "M-SEARCH * HTTP/1.1\n\
ST: %s\n\
MAN: \"ssdp:discover\"\n\
HOST: 239.255.255.250:1900\n\
MX: %i\n" searchTarget delaySeconds)
UTF8Encoding.UTF8.GetBytes(msg)
/// Multicast the search message on each local ip (IPv4 and v6 for example).
for ip in upnpIpAddresses () do
//TODO can we support NAT?
let udp = new Sockets.UdpClient (EnableBroadcast = true)
udp.Client.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReuseAddress, true)
udp.Client.Bind(IPEndPoint(ip, port))
udp.JoinMulticastGroup(multicastIPEndpoint.Address)
udp.AsyncSend (searchMessageBytes, searchMessageBytes.Length, multicastIPEndpoint)
|> Async.RunSynchronously |> ignore
//TODO spec says issue search more than once as Upnp not reliable.
//Perhaps set to do second search after delay on another thread.
()
//Fire up a session.
let ssdpSession = Ssdp.Session.Start(1985)
//Startlistening
ssdpSession.MessageReceived.Add(fun msg -> printfn "%s" msg)
//Do an MSearch.
let search = { MSearch.SearchTarget = All; DeviceResponseDelay = OneSecond; }
ssdpSession.BroadcastMSearch(search)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.