diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-09-08 13:34:50 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-09-08 13:34:50 -0400 |
| commit | 92b1f427306b92706a4d785fe819c8b0cbedca63 (patch) | |
| tree | 09a6156f5bb022b8952edaf3a015dea5bf7276c7 | |
| parent | 2d1b215328e40a7c9eb1dad0422917728faa79a0 (diff) | |
fix fd leak
also, tested on ipv6.. doesn't work
| -rw-r--r-- | Assistant/Pairing.hs | 23 | ||||
| -rw-r--r-- | doc/design/assistant/pairing.mdwn | 9 |
2 files changed, 22 insertions, 10 deletions
diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs index 42fc29929..4f8a8bb11 100644 --- a/Assistant/Pairing.hs +++ b/Assistant/Pairing.hs @@ -16,6 +16,7 @@ import Network.Multicast import Network.Info import Network.Socket import Control.Concurrent +import Control.Exception (bracket) import qualified Data.Map as M {- "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 - on the same network segment. -} -multicastAddress :: HostName -multicastAddress = "224.0.0.1" +multicastAddress :: SomeAddr -> HostName +multicastAddress (IPv4Addr _) = "224.0.0.1" +multicastAddress (IPv6Addr _) = "ff02::1" type MkPairMsg = HostName -> PairMsg @@ -77,7 +79,8 @@ type MkPairMsg = HostName -> PairMsg - - 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. - - 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 mkmsg = forkIO $ go =<< initMsgCache mkmsg where @@ -87,11 +90,15 @@ multicastPairMsg mkmsg = forkIO $ go =<< initMsgCache mkmsg mapM_ (sendinterface cache') addrs threadDelaySeconds (Seconds 2) go cache' - sendinterface cache i = void $ catchMaybeIO $ withSocketsDo $ do - (sock, addr) <- multicastSender multicastAddress pairingPort - setInterface sock (show i) - maybe noop (\s -> void $ sendTo sock s addr) - (M.lookup i cache) + sendinterface cache i = void $ catchMaybeIO $ + withSocketsDo $ bracket + (multicastSender (multicastAddress i) pairingPort) + (sClose . fst) + (\(sock, addr) -> do + setInterface sock (show i) + maybe noop (\s -> void $ sendTo sock s addr) + (M.lookup i cache) + ) {- A cache of serialized messages. -} type MsgCache = M.Map SomeAddr String diff --git a/doc/design/assistant/pairing.mdwn b/doc/design/assistant/pairing.mdwn index 32815698c..2b9df67a1 100644 --- a/doc/design/assistant/pairing.mdwn +++ b/doc/design/assistant/pairing.mdwn @@ -21,5 +21,10 @@ It could work like this: 5. Pull over a clone of the repository. 6. Start [[syncing]]. -Also look into the method used by -<https://support.mozilla.org/en-US/kb/add-a-device-to-firefox-sync> +## TODO + +* 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.) |