From cac8f382588e33c83f533936ba980ed06d4340aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Wed, 1 Dec 2021 22:10:39 +0100 Subject: Network: automatically find broadcast addresses --- src/Main.hs | 44 +++++++++++++++++++++++++++++++++----------- src/Network.hs | 50 ++++++++++++++++++++++++++++++++++---------------- src/Network/ifaddrs.c | 41 +++++++++++++++++++++++++++++++++++++++++ src/Network/ifaddrs.h | 3 +++ 4 files changed, 111 insertions(+), 27 deletions(-) create mode 100644 src/Network/ifaddrs.c create mode 100644 src/Network/ifaddrs.h (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index 54c5714..8d6f8de 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -22,6 +22,7 @@ import Data.Typeable import Network.Socket +import System.Console.GetOpt import System.Console.Haskeline import System.Environment @@ -39,6 +40,26 @@ import Storage import Storage.Merge import Sync +data Options = Options + { optServer :: ServerOptions + } + +defaultOptions :: Options +defaultOptions = Options + { optServer = defaultServerOptions + } + +options :: [OptDescr (Options -> Options)] +options = + [ Option ['p'] ["port"] + (ReqArg (\p -> so $ \opts -> opts { serverPort = read p }) "PORT") + "local port to bind" + , Option ['s'] ["silent"] + (NoArg (so $ \opts -> opts { serverLocalDiscovery = False })) + "do not send announce packets for local discovery" + ] + where so f opts = opts { optServer = f $ optServer opts } + main :: IO () main = do st <- liftIO $ openStorage . fromMaybe "./.erebos" =<< lookupEnv "EREBOS_DIR" @@ -88,12 +109,16 @@ main = do BC.putStrLn . showRefDigest . refDigest . storedRef . idData =<< interactiveIdentityUpdate idt | otherwise -> error "invalid identity" - [bhost] -> interactiveLoop st (Just bhost) - [] -> interactiveLoop st Nothing - _ -> error "Unrecognized options" + args -> do + opts <- case getOpt Permute options args of + (o, [], []) -> return (foldl (flip id) defaultOptions o) + (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) + where header = "Usage: erebos [OPTION...]" + interactiveLoop st opts -interactiveLoop :: Storage -> Maybe String -> IO () -interactiveLoop st bhost = runInputT defaultSettings $ do + +interactiveLoop :: Storage -> Options -> IO () +interactiveLoop st opts = runInputT defaultSettings $ do erebosHead <- liftIO $ loadLocalStateHead st outputStrLn $ T.unpack $ displayIdentity $ headLocalIdentity erebosHead @@ -103,10 +128,7 @@ interactiveLoop st bhost = runInputT defaultSettings $ do let extPrintLn str = extPrint $ case reverse str of ('\n':_) -> str _ -> str ++ "\n"; server <- liftIO $ do - let sopt = defaultServerOptions - { serverLocalDiscovery = bhost - } - startServer sopt erebosHead extPrintLn + startServer (optServer opts) erebosHead extPrintLn [ SomeService @AttachService Proxy , SomeService @SyncService Proxy , SomeService @ContactService Proxy @@ -312,8 +334,8 @@ cmdDiscoveryInit = void $ do (hostname, port) <- (words <$> asks ciLine) >>= return . \case hostname:p:_ -> (hostname, p) - [hostname] -> (hostname, discoveryPort) - [] -> ("discovery.erebosprotocol.net", discoveryPort) + [hostname] -> (hostname, show discoveryPort) + [] -> ("discovery.erebosprotocol.net", show discoveryPort) addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just hostname) (Just port) peer <- liftIO $ serverPeer server (addrAddress addr) sendToPeer self peer $ DiscoverySelf (T.pack "ICE") 0 diff --git a/src/Network.hs b/src/Network.hs index f857ef9..1edc70c 100644 --- a/src/Network.hs +++ b/src/Network.hs @@ -31,6 +31,10 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Maybe import Data.Typeable +import Data.Word + +import Foreign.Ptr +import Foreign.Storable import GHC.Conc.Sync (unsafeIOToSTM) @@ -48,8 +52,8 @@ import Storage.Merge import Sync -discoveryPort :: ServiceName -discoveryPort = "29665" +discoveryPort :: PortNumber +discoveryPort = 29665 announceIntervalSeconds :: Int announceIntervalSeconds = 60 @@ -72,12 +76,14 @@ getNextPeerChange :: Server -> IO Peer getNextPeerChange = atomically . readTChan . serverChanPeer data ServerOptions = ServerOptions - { serverLocalDiscovery :: Maybe String + { serverPort :: PortNumber + , serverLocalDiscovery :: Bool } defaultServerOptions :: ServerOptions defaultServerOptions = ServerOptions - { serverLocalDiscovery = Nothing + { serverPort = discoveryPort + , serverLocalDiscovery = True } @@ -245,6 +251,8 @@ startServer opt origHead logd' services = do either (atomically . logd) return =<< runExceptT =<< atomically (readTQueue $ serverIOActions server) + broadcastAddreses <- getBroadcastAddresses discoveryPort + let open addr = do sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) putMVar ssocket sock @@ -255,15 +263,12 @@ startServer opt origHead logd' services = do return sock loop sock = do - case serverLocalDiscovery opt of - Just bhost -> do - void $ forkIO $ forever $ do - readMVar midentity >>= \identity -> do - st <- derivePartialStorage storage - baddr:_ <- getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just bhost) (Just discoveryPort) - void $ S.sendTo sock (BL.toStrict $ serializeObject $ transportToObject $ TransportHeader [ AnnounceSelf $ partialRef st $ storedRef $ idData identity ]) (addrAddress baddr) - threadDelay $ announceIntervalSeconds * 1000 * 1000 - Nothing -> return () + when (serverLocalDiscovery opt) $ void $ forkIO $ forever $ do + readMVar midentity >>= \identity -> do + st <- derivePartialStorage storage + let packet = BL.toStrict $ serializeObject $ transportToObject $ TransportHeader [ AnnounceSelf $ partialRef st $ storedRef $ idData identity ] + mapM_ (void . S.sendTo sock packet) broadcastAddreses + threadDelay $ announceIntervalSeconds * 1000 * 1000 let announceUpdate identity = do st <- derivePartialStorage storage @@ -344,9 +349,7 @@ startServer opt origHead logd' services = do { addrFlags = [AI_PASSIVE] , addrSocketType = Datagram } - addr:_ <- getAddrInfo (Just hints) Nothing - -- use ephemeral port when local discovery is disabled - (Just $ if isJust (serverLocalDiscovery opt) then discoveryPort else "0") + addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show $ serverPort opt) bracket (open addr) close loop void $ forkIO $ forever $ do @@ -797,3 +800,18 @@ sendToPeerWith identity peer fobj = do Right (Just obj) -> sendToPeer identity peer obj Right Nothing -> return () Left err -> throwError err + + +foreign import ccall unsafe "Network/ifaddrs.h broadcast_addresses" cBroadcastAddresses :: IO (Ptr Word32) +foreign import ccall unsafe "stdlib.h free" cFree :: Ptr Word32 -> IO () + +getBroadcastAddresses :: PortNumber -> IO [SockAddr] +getBroadcastAddresses port = do + ptr <- cBroadcastAddresses + let parse i = do + w <- peekElemOff ptr i + if w == 0 then return [] + else (SockAddrInet port w:) <$> parse (i + 1) + addrs <- parse 0 + cFree ptr + return addrs diff --git a/src/Network/ifaddrs.c b/src/Network/ifaddrs.c new file mode 100644 index 0000000..37c3e00 --- /dev/null +++ b/src/Network/ifaddrs.c @@ -0,0 +1,41 @@ +#include "ifaddrs.h" + +#include +#include +#include +#include +#include +#include + +uint32_t * broadcast_addresses(void) +{ + struct ifaddrs * addrs; + if (getifaddrs(&addrs) < 0) + return 0; + + size_t capacity = 16, count = 0; + uint32_t * ret = malloc(sizeof(uint32_t) * capacity); + + for (struct ifaddrs * ifa = addrs; ifa; ifa = ifa->ifa_next) { + if (ifa->ifa_addr && ifa->ifa_addr->sa_family == AF_INET && + ifa->ifa_flags & IFF_BROADCAST) { + if (count + 2 >= capacity) { + capacity *= 2; + uint32_t * nret = realloc(ret, sizeof(uint32_t) * capacity); + if (nret) { + ret = nret; + } else { + free(ret); + return 0; + } + } + + ret[count] = ((struct sockaddr_in*)ifa->ifa_broadaddr)->sin_addr.s_addr; + count++; + } + } + + freeifaddrs(addrs); + ret[count] = 0; + return ret; +} diff --git a/src/Network/ifaddrs.h b/src/Network/ifaddrs.h new file mode 100644 index 0000000..06d26ec --- /dev/null +++ b/src/Network/ifaddrs.h @@ -0,0 +1,3 @@ +#include + +uint32_t * broadcast_addresses(void); -- cgit v1.2.3