summaryrefslogtreecommitdiff
path: root/Assistant/Pairing.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-09-08 15:21:34 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-09-08 15:21:34 -0400
commit61ee1e16602900b279b96eb6e53192b1181ad581 (patch)
tree4f42855a21841d5e250f17d1d5f945f303c3fb0c /Assistant/Pairing.hs
parent0f0c7f8d701f813f226424d5ae2f21f40a983536 (diff)
fix build without pairing support
Diffstat (limited to 'Assistant/Pairing.hs')
-rw-r--r--Assistant/Pairing.hs94
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