diff options
author | Joey Hess <joey@kitenet.net> | 2012-09-08 15:21:34 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-09-08 15:21:34 -0400 |
commit | 61ee1e16602900b279b96eb6e53192b1181ad581 (patch) | |
tree | 4f42855a21841d5e250f17d1d5f945f303c3fb0c /Assistant/Pairing.hs | |
parent | 0f0c7f8d701f813f226424d5ae2f21f40a983536 (diff) |
fix build without pairing support
Diffstat (limited to 'Assistant/Pairing.hs')
-rw-r--r-- | Assistant/Pairing.hs | 94 |
1 files changed, 2 insertions, 92 deletions
diff --git a/Assistant/Pairing.hs b/Assistant/Pairing.hs index 2ad339969..eced43793 100644 --- a/Assistant/Pairing.hs +++ b/Assistant/Pairing.hs @@ -1,4 +1,4 @@ -{- git-annex assistant repo pairing +{- git-annex assistant repo pairing, core data types - - Copyright 2012 Joey Hess <joey@kitenet.net> - @@ -7,16 +7,10 @@ module Assistant.Pairing where -import Common import Utility.Verifiable -import Utility.ThreadScheduler -import Network.Multicast -import Network.Info -import Network.Socket import Control.Concurrent -import Control.Exception (bracket) -import qualified Data.Map as M +import Network.Socket {- "I'll pair with anybody who shares the secret that can be used to verify - this request." -} @@ -55,89 +49,5 @@ type UserName = String - broadcasting pairing requests. -} data PairingInProgress = PairingInProgress Secret ThreadId -{- This is an arbitrary port in the dynamic port range, that could - - conceivably be used for some other broadcast messages. - - If so, hope they ignore the garbage from us; we'll certianly - - ignore garbage from them. Wild wild west. -} -pairingPort :: PortNumber -pairingPort = 55556 - -{- This is the All Hosts multicast group, which should reach all hosts - - on the same network segment. -} -multicastAddress :: SomeAddr -> HostName -multicastAddress (IPv4Addr _) = "224.0.0.1" -multicastAddress (IPv6Addr _) = "ff02::1" - -{- Multicasts a message repeatedly on all interfaces until its thread - - is killed, with a 2 second delay between each transmission. - - - - The remoteHostAddress is set to the interface's IP address. - - - - 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. - -} -multicastPairMsg :: (SomeAddr -> PairMsg) -> IO ThreadId -multicastPairMsg mkmsg = forkIO $ go M.empty - where - go cache = do - addrs <- activeNetworkAddresses - let cache' = updatecache cache addrs - mapM_ (sendinterface cache') addrs - threadDelaySeconds (Seconds 2) - go cache' - sendinterface cache i = void $ catchMaybeIO $ - withSocketsDo $ bracket - (multicastSender (multicastAddress i) pairingPort) - (sClose . fst) - (\(sock, addr) -> do - setInterface sock (showAddr i) - maybe noop (\s -> void $ sendTo sock s addr) - (M.lookup i cache) - ) - updatecache cache [] = cache - updatecache cache (i:is) - | M.member i cache = updatecache cache is - | otherwise = updatecache (M.insert i (show $ mkmsg i) cache) is - -{- Finds the best hostname to use for the host that sent the PairData. - - - - If remoteHostName is set, tries to use a .local address based on it. - - That's the most robust, if this system supports .local. - - Otherwise, looks up the hostname in the DNS for the remoteAddress, - - if any. May fall back to remoteAddress if there's no DNS. Ugh. -} -bestHostName :: PairData -> IO HostName -bestHostName d = case remoteHostName d of - Just h -> do - let localname = h ++ ".local" - addrs <- catchDefaultIO (getAddrInfo Nothing (Just localname) Nothing) [] - maybe fallback (const $ return localname) (headMaybe addrs) - Nothing -> fallback - where - fallback = do - let sockaddr = case remoteAddress d of - IPv4Addr a -> SockAddrInet (PortNum 0) a - IPv6Addr a -> SockAddrInet6 (PortNum 0) 0 a 0 - fromMaybe (show $ remoteAddress d) - <$> catchDefaultIO (fst <$> getNameInfo [] True False sockaddr) Nothing - data SomeAddr = IPv4Addr HostAddress | IPv6Addr HostAddress6 deriving (Ord, Eq, Read, Show) - -class ToSomeAddr a where - toSomeAddr :: a -> SomeAddr - -instance ToSomeAddr IPv4 where - toSomeAddr (IPv4 a) = IPv4Addr a - -instance ToSomeAddr IPv6 where - toSomeAddr (IPv6 o1 o2 o3 o4) = IPv6Addr (o1, o2, o3, o4) - -showAddr :: SomeAddr -> HostName -showAddr (IPv4Addr a) = show $ IPv4 a -showAddr (IPv6Addr (o1, o2, o3, o4)) = show $ IPv6 o1 o2 o3 o4 - -activeNetworkAddresses :: IO [SomeAddr] -activeNetworkAddresses = filter (not . all (`elem` "0.:") . showAddr) - . concat . map (\ni -> [toSomeAddr $ ipv4 ni, toSomeAddr $ ipv6 ni]) - <$> getNetworkInterfaces |