blob: 01d222bf39f3fae622cfc1c1f707e13a97a6ddd7 (
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
40
|
module Network.UPNP where
import Data.Maybe
import Network.Address (sockAddrPort)
import Network.Socket
import System.Directory
import System.Process as Process
import DPut
import DebugTag
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
|
