summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs44
-rw-r--r--src/Network.hs50
-rw-r--r--src/Network/ifaddrs.c41
-rw-r--r--src/Network/ifaddrs.h3
4 files changed, 111 insertions, 27 deletions
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 <arpa/inet.h>
+#include <ifaddrs.h>
+#include <net/if.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <endian.h>
+
+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 <stdint.h>
+
+uint32_t * broadcast_addresses(void);
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-07 21:18:39 +0000