fix build without pairing support

4 files changed, 113 insertions, 96 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
diff --git a/Assistant/Pairing/Network.hs b/Assistant/Pairing/Network.hs
new file mode 100644
index 000000000..ec7054f9e
--- /dev/null
+++ b/Assistant/Pairing/Network.hs
@@ -0,0 +1,103 @@
+{- git-annex assistant pairing network code
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Pairing.Network where
+
+import Common
+import Assistant.Pairing
+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
+
+{- 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
+
+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
diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index f76f0ed4e..bb9ab6d0f 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -9,6 +9,7 @@ module Assistant.Threads.PairListener where
 
 import Assistant.Common
 import Assistant.Pairing
+import Assistant.Pairing.Network
 import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.Alert
diff --git a/Assistant/WebApp/Configurators/Pairing.hs b/Assistant/WebApp/Configurators/Pairing.hs
index d79752426..cc7d1cf77 100644
--- a/Assistant/WebApp/Configurators/Pairing.hs
+++ b/Assistant/WebApp/Configurators/Pairing.hs
@@ -28,25 +28,28 @@
 
 module Assistant.WebApp.Configurators.Pairing where
 
-import Assistant.Common
-#ifdef WITH_PAIRING
 import Assistant.Pairing
-#endif
+#ifdef WITH_PAIRING
+import Assistant.Pairing.Network
+import Assistant.Common
 import Assistant.DaemonStatus
 import Utility.Verifiable
+import Utility.Network
+#endif
 import Assistant.WebApp
 import Assistant.WebApp.Types
 import Assistant.WebApp.SideBar
 import Utility.Yesod
-import Utility.Network
 
 import Yesod
 import Data.Text (Text)
+#ifdef WITH_PAIRING
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.ByteString.Lazy as B
 import Data.Char
 import System.Posix.User
+#endif
 
 getStartPairR :: Handler RepHtml
 #ifdef WITH_PAIRING