summaryrefslogtreecommitdiff
path: root/src/Network/UPNP.hs
blob: e89471c2c2f777919123b25a071ba0ec674205ae (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
module Network.UPNP where

import Data.Maybe
import Network.Address (sockAddrPort)
import Network.Socket
import System.Directory
import System.Process  as Process
import DPut

protocols :: SocketType -> [String]
protocols Stream   = ["tcp"]
protocols Datagram = ["udp"]
protocols _        = ["udp","tcp"]

upnpc :: FilePath
upnpc = "/usr/bin/upnpc"

-- | Invokes the miniupnpc command line program to request ports from a UPNP
-- wifi router.  Returns the process handle on success.
requestPorts :: String -- ^ Description stored on router.
                -> [(SocketType, SockAddr)] -- ^ Protocol-port pairs to request.
                -> IO (Maybe ProcessHandle)
requestPorts description binds = do
    let requests = do
            (stype,saddr) <- binds
            proto <- protocols stype
            port <- maybeToList (sockAddrPort saddr)
            [ show port, proto ]
        bail = return Nothing
    case requests of
        [] -> bail
        _  -> do
            gotMiniUPNPC <- doesFileExist upnpc
            if gotMiniUPNPC then do
                phandle <- spawnProcess upnpc $ "-e": description : "-r" : requests
                return $ Just phandle
            else do
                dput XMisc $ "Warning: unable to find miniupnpc client at "++upnpc++"."
                bail