mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

fix fd leak

Browse source 
also, tested on ipv6.. doesn't work
This commit is contained in:
Joey Hess 2012-09-08 13:34:50 -04:00
parent 2d1b215328
commit 92b1f42730
2 changed files with 22 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
Assistant/Pairing.hs
View file

@ -16,6 +16,7 @@ import Network.Multicast
import Network.Info import Network.Info
import Network.Socket import Network.Socket
import Control.Concurrent import Control.Concurrent
import Control.Exception (bracket)
import qualified Data.Map as M import qualified Data.Map as M
{- "I'll pair with anybody who shares the secret that can be used to verify {- "I'll pair with anybody who shares the secret that can be used to verify
@ -62,8 +63,9 @@ pairingPort = 55556
{- This is the All Hosts multicast group, which should reach all hosts {- This is the All Hosts multicast group, which should reach all hosts
- on the same network segment. -} - on the same network segment. -}
multicastAddress :: HostName multicastAddress :: SomeAddr -> HostName
multicastAddress = "224.0.0.1" multicastAddress (IPv4Addr _) = "224.0.0.1"
multicastAddress (IPv6Addr _) = "ff02::1"
type MkPairMsg = HostName -> PairMsg type MkPairMsg = HostName -> PairMsg
@ -77,7 +79,8 @@ type MkPairMsg = HostName -> PairMsg
- -
- Note that new sockets are opened each time. This is hardly efficient, - Note that new sockets are opened each time. This is hardly efficient,
- but it allows new network interfaces to be used as they come up. - but it allows new network interfaces to be used as they come up.
- On the other hand, the expensive DNS lookups are cached. -} - On the other hand, the expensive DNS lookups are cached.
-}
multicastPairMsg :: MkPairMsg -> IO ThreadId multicastPairMsg :: MkPairMsg -> IO ThreadId
multicastPairMsg mkmsg = forkIO $ go =<< initMsgCache mkmsg multicastPairMsg mkmsg = forkIO $ go =<< initMsgCache mkmsg
where where
@ -87,11 +90,15 @@ multicastPairMsg mkmsg = forkIO $ go =<< initMsgCache mkmsg
mapM_ (sendinterface cache') addrs mapM_ (sendinterface cache') addrs
threadDelaySeconds (Seconds 2) threadDelaySeconds (Seconds 2)
go cache' go cache'
sendinterface cache i = void $ catchMaybeIO $ withSocketsDo $ do sendinterface cache i = void $ catchMaybeIO $
(sock, addr) <- multicastSender multicastAddress pairingPort withSocketsDo $ bracket
(multicastSender (multicastAddress i) pairingPort)
(sClose . fst)
(\(sock, addr) -> do
setInterface sock (show i) setInterface sock (show i)
maybe noop (\s -> void $ sendTo sock s addr) maybe noop (\s -> void $ sendTo sock s addr)
(M.lookup i cache) (M.lookup i cache)
)
{- A cache of serialized messages. -} {- A cache of serialized messages. -}
type MsgCache = M.Map SomeAddr String type MsgCache = M.Map SomeAddr String

9
doc/design/assistant/pairing.mdwn
View file

@ -21,5 +21,10 @@ It could work like this:
5. Pull over a clone of the repository. 5. Pull over a clone of the repository.
6. Start [[syncing]]. 6. Start [[syncing]].
Also look into the method used by ## TODO
<https://support.mozilla.org/en-US/kb/add-a-device-to-firefox-sync>
* pairing over IPV6 only networks does not work. Haskell's
`network-multicast` library complains "inet_addr: Malformed address: ff02::1"
.. seems it just doesn't support IPv6. The pairing code in git-annex
does support ipv6, apart from this, it's just broadcasting the messages
that fails. (Pairing over mixed networks is fine.)