summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--main/Main.hs2
-rw-r--r--main/Test.hs31
-rw-r--r--src/Erebos/Discovery.hs129
-rw-r--r--src/Erebos/Network.hs63
-rw-r--r--src/Erebos/Network/ifaddrs.c110
-rw-r--r--src/Erebos/Network/ifaddrs.h13
-rw-r--r--test/discovery.test75
7 files changed, 352 insertions, 71 deletions
diff --git a/main/Main.hs b/main/Main.hs
index 528b8c2..6e96c14 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -849,7 +849,7 @@ cmdDiscoveryInit = void $ do
[] -> ("discovery.erebosprotocol.net", show discoveryPort)
addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just hostname) (Just port)
peer <- liftIO $ serverPeer server (addrAddress addr)
- sendToPeer peer $ DiscoverySelf (T.pack "ICE") 0
+ sendToPeer peer $ DiscoverySelf [ T.pack "ICE" ] Nothing
modify $ \s -> s { csIcePeer = Just peer }
cmdDiscovery :: Command
diff --git a/main/Test.hs b/main/Test.hs
index 35cc982..550e47f 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -37,6 +37,7 @@ import Erebos.Attach
import Erebos.Chatroom
import Erebos.Contact
import Erebos.DirectMessage
+import Erebos.Discovery
import Erebos.Identity
import Erebos.Network
import Erebos.Object
@@ -259,6 +260,7 @@ commands = map (T.pack *** id)
, ("head-watch", cmdHeadWatch)
, ("head-unwatch", cmdHeadUnwatch)
, ("create-identity", cmdCreateIdentity)
+ , ("identity-info", cmdIdentityInfo)
, ("start-server", cmdStartServer)
, ("stop-server", cmdStopServer)
, ("peer-add", cmdPeerAdd)
@@ -297,6 +299,7 @@ commands = map (T.pack *** id)
, ("chatroom-join-as", cmdChatroomJoinAs)
, ("chatroom-leave", cmdChatroomLeave)
, ("chatroom-message-send", cmdChatroomMessageSend)
+ , ("discovery-connect", cmdDiscoveryConnect)
]
cmdStore :: Command
@@ -455,6 +458,22 @@ cmdCreateIdentity = do
, lsOther = []
}
initTestHead h
+ cmdOut $ unwords [ "create-identity-done", "ref", show $ refDigest $ storedRef $ lsIdentity $ headObject h ]
+
+cmdIdentityInfo :: Command
+cmdIdentityInfo = do
+ st <- asks tiStorage
+ [ tref ] <- asks tiParams
+ Just ref <- liftIO $ readRef st $ encodeUtf8 tref
+ let sidata = wrappedLoad ref
+ idata = fromSigned sidata
+ cmdOut $ unwords $ concat
+ [ [ "identity-info" ]
+ , [ "ref", T.unpack tref ]
+ , [ "base", show $ refDigest $ storedRef $ eiddStoredBase sidata ]
+ , maybe [] (\owner -> [ "owner", show $ refDigest $ storedRef owner ]) $ eiddOwner idata
+ , maybe [] (\name -> [ "name", T.unpack name ]) $ eiddName idata
+ ]
cmdStartServer :: Command
cmdStartServer = do
@@ -473,6 +492,7 @@ cmdStartServer = do
"attach" -> return $ someServiceAttr $ pairingAttributes (Proxy @AttachService) out rsPeers "attach"
"chatroom" -> return $ someService @ChatroomService Proxy
"contact" -> return $ someServiceAttr $ pairingAttributes (Proxy @ContactService) out rsPeers "contact"
+ "discovery" -> return $ someService @DiscoveryService Proxy
"dm" -> return $ someServiceAttr $ directMessageAttributes out
"sync" -> return $ someService @SyncService Proxy
"test" -> return $ someServiceAttr $ (defaultServiceAttributes Proxy)
@@ -856,3 +876,14 @@ cmdChatroomMessageSend = do
[cid, msg] <- asks tiParams
to <- getChatroomStateData cid
void $ sendChatroomMessageByStateData to msg
+
+cmdDiscoveryConnect :: Command
+cmdDiscoveryConnect = do
+ st <- asks tiStorage
+ [ tref ] <- asks tiParams
+ Just ref <- liftIO $ readRef st $ encodeUtf8 tref
+
+ Just RunningServer {..} <- gets tsServer
+ peers <- liftIO $ getCurrentPeerList rsServer
+ forM_ peers $ \peer -> do
+ sendToPeer peer $ DiscoverySearch ref
diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
index 8003141..f0535fe 100644
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -10,11 +10,12 @@ import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
+import Data.IP qualified as IP
import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
+import Data.Map.Strict qualified as M
import Data.Maybe
import Data.Text (Text)
-import qualified Data.Text as T
+import Data.Text qualified as T
import Network.Socket
@@ -28,14 +29,10 @@ import Erebos.Service
import Erebos.Storable
-keepaliveSeconds :: Int
-keepaliveSeconds = 20
-
-
-data DiscoveryService = DiscoverySelf Text Int
+data DiscoveryService = DiscoverySelf [ Text ] (Maybe Int)
| DiscoveryAcknowledged Text
| DiscoverySearch Ref
- | DiscoveryResult Ref (Maybe Text)
+ | DiscoveryResult Ref [ Text ]
| DiscoveryConnectionRequest DiscoveryConnection
| DiscoveryConnectionResponse DiscoveryConnection
@@ -59,15 +56,15 @@ emptyConnection dconnSource dconnTarget = DiscoveryConnection {..}
instance Storable DiscoveryService where
store' x = storeRec $ do
case x of
- DiscoverySelf addr priority -> do
- storeText "self" addr
- storeInt "priority" priority
+ DiscoverySelf addrs priority -> do
+ mapM_ (storeText "self") addrs
+ mapM_ (storeInt "priority") priority
DiscoveryAcknowledged addr -> do
storeText "ack" addr
DiscoverySearch ref -> storeRawRef "search" ref
DiscoveryResult ref addr -> do
storeRawRef "result" ref
- storeMbText "address" addr
+ mapM_ (storeText "address") addr
DiscoveryConnectionRequest conn -> storeConnection "request" conn
DiscoveryConnectionResponse conn -> storeConnection "response" conn
@@ -81,15 +78,17 @@ instance Storable DiscoveryService where
#endif
load' = loadRec $ msum
- [ DiscoverySelf
- <$> loadText "self"
- <*> loadInt "priority"
+ [ do
+ addrs <- loadTexts "self"
+ guard (not $ null addrs)
+ DiscoverySelf addrs
+ <$> loadMbInt "priority"
, DiscoveryAcknowledged
<$> loadText "ack"
, DiscoverySearch <$> loadRawRef "search"
, DiscoveryResult
<$> loadRawRef "result"
- <*> loadMbText "address"
+ <*> loadTexts "address"
, loadConnection "request" DiscoveryConnectionRequest
, loadConnection "response" DiscoveryConnectionResponse
]
@@ -107,25 +106,25 @@ instance Storable DiscoveryService where
data DiscoveryPeer = DiscoveryPeer
{ dpPriority :: Int
, dpPeer :: Maybe Peer
- , dpAddress :: Maybe Text
+ , dpAddress :: [ Text ]
#ifdef ENABLE_ICE_SUPPORT
, dpIceSession :: Maybe IceSession
#endif
}
instance Service DiscoveryService where
- serviceID _ = mkServiceID "dd59c89c-69cc-4703-b75b-4ddcd4b3c23b"
+ serviceID _ = mkServiceID "dd59c89c-69cc-4703-b75b-4ddcd4b3c23c"
type ServiceGlobalState DiscoveryService = Map RefDigest DiscoveryPeer
emptyServiceGlobalState _ = M.empty
serviceHandler msg = case fromStored msg of
- DiscoverySelf addr priority -> do
+ DiscoverySelf addrs priority -> do
pid <- asks svcPeerIdentity
peer <- asks svcPeer
let insertHelper new old | dpPriority new > dpPriority old = new
| otherwise = old
- mbaddr <- case words (T.unpack addr) of
+ mbaddr <- fmap (listToMaybe . catMaybes) $ forM addrs $ \addr -> case words (T.unpack addr) of
[ipaddr, port] | DatagramAddress paddr <- peerAddress peer -> do
saddr <- liftIO $ head <$> getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port)
return $ if paddr == addrAddress saddr
@@ -134,70 +133,71 @@ instance Service DiscoveryService where
_ -> return Nothing
forM_ (idDataF =<< unfoldOwners pid) $ \s ->
svcModifyGlobal $ M.insertWith insertHelper (refDigest $ storedRef s) DiscoveryPeer
- { dpPriority = priority
+ { dpPriority = fromMaybe 0 priority
, dpPeer = Just peer
- , dpAddress = mbaddr
+ , dpAddress = addrs
#ifdef ENABLE_ICE_SUPPORT
, dpIceSession = Nothing
#endif
}
replyPacket $ DiscoveryAcknowledged $ fromMaybe (T.pack "ICE") mbaddr
- DiscoveryAcknowledged addr -> do
- when (addr == T.pack "ICE") $ do
- -- keep-alive packet from behind NAT
- peer <- asks svcPeer
- liftIO $ void $ forkIO $ do
- threadDelay (keepaliveSeconds * 1000 * 1000)
- res <- runExceptT $ sendToPeer peer $ DiscoverySelf addr 0
- case res of
- Right _ -> return ()
- Left err -> putStrLn $ "Discovery: failed to send keep-alive: " ++ err
+ DiscoveryAcknowledged _ -> do
+ return ()
DiscoverySearch ref -> do
- addr <- M.lookup (refDigest ref) <$> svcGetGlobal
- replyPacket $ DiscoveryResult ref $ fromMaybe (T.pack "ICE") . dpAddress <$> addr
+ dpeer <- M.lookup (refDigest ref) <$> svcGetGlobal
+ replyPacket $ DiscoveryResult ref $ maybe [] dpAddress dpeer
- DiscoveryResult ref Nothing -> do
+ DiscoveryResult ref [] -> do
svcPrint $ "Discovery: " ++ show (refDigest ref) ++ " not found"
- DiscoveryResult ref (Just addr) -> do
+ DiscoveryResult ref addrs -> do
-- TODO: check if we really requested that
server <- asks svcServer
- if addr == T.pack "ICE"
- then do
+ self <- svcSelf
+ discoveryPeer <- asks svcPeer
+ let runAsService = runPeerService @DiscoveryService discoveryPeer
+
+ liftIO $ void $ forkIO $ forM_ addrs $ \addr -> if
+ | addr == T.pack "ICE" -> do
#ifdef ENABLE_ICE_SUPPORT
- self <- svcSelf
- peer <- asks svcPeer
- ice <- liftIO $ iceCreate PjIceSessRoleControlling $ \ice -> do
+ ice <- iceCreate PjIceSessRoleControlling $ \ice -> do
rinfo <- iceRemoteInfo ice
- res <- runExceptT $ sendToPeer peer $
+ res <- runExceptT $ sendToPeer discoveryPeer $
DiscoveryConnectionRequest (emptyConnection (storedRef $ idData self) ref) { dconnIceSession = Just rinfo }
case res of
Right _ -> return ()
Left err -> putStrLn $ "Discovery: failed to send connection request: " ++ err
- svcModifyGlobal $ M.insert (refDigest ref) $
- DiscoveryPeer 0 Nothing Nothing (Just ice)
+ runAsService $ do
+ svcModifyGlobal $ M.insert (refDigest ref) DiscoveryPeer
+ { dpPriority = 0
+ , dpPeer = Nothing
+ , dpAddress = []
+ , dpIceSession = Just ice
+ }
#else
return ()
#endif
- else do
- case words (T.unpack addr) of
- [ipaddr, port] -> do
- saddr <- liftIO $ head <$>
- getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port)
- peer <- liftIO $ serverPeer server (addrAddress saddr)
- svcModifyGlobal $ M.insert (refDigest ref) DiscoveryPeer
- { dpPriority = 0
- , dpPeer = Just peer
- , dpAddress = Nothing
+
+ | [ ipaddr, port ] <- words (T.unpack addr) -> do
+ saddr <- head <$>
+ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port)
+ peer <- serverPeer server (addrAddress saddr)
+ runAsService $ do
+ svcModifyGlobal $ M.insert (refDigest ref) DiscoveryPeer
+ { dpPriority = 0
+ , dpPeer = Just peer
+ , dpAddress = []
#ifdef ENABLE_ICE_SUPPORT
- , dpIceSession = Nothing
+ , dpIceSession = Nothing
#endif
- }
+ }
- _ -> svcPrint $ "Discovery: invalid address in result: " ++ T.unpack addr
+ | otherwise -> do
+ runAsService $ do
+ svcPrint $ "Discovery: invalid address in result: " ++ T.unpack addr
DiscoveryConnectionRequest conn -> do
#ifdef ENABLE_ICE_SUPPORT
@@ -223,7 +223,7 @@ instance Service DiscoveryService where
mbdp <- M.lookup (refDigest $ dconnTarget conn) <$> svcGetGlobal
case mbdp of
Nothing -> replyPacket $ DiscoveryConnectionResponse rconn
- Just dp | Just addr <- dpAddress dp -> do
+ Just dp | addr : _ <- dpAddress dp -> do
replyPacket $ DiscoveryConnectionResponse rconn { dconnAddress = Just addr }
| Just dpeer <- dpPeer dp -> do
sendToPeer dpeer $ DiscoveryConnectionRequest conn
@@ -246,7 +246,7 @@ instance Service DiscoveryService where
getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port)
peer <- liftIO $ serverPeer server (addrAddress saddr)
svcModifyGlobal $ M.insert (refDigest $ dconnTarget conn) $
- DiscoveryPeer 0 (Just peer) Nothing Nothing
+ DiscoveryPeer 0 (Just peer) [] Nothing
| Just dp <- M.lookup (refDigest $ dconnTarget conn) dpeers
, Just ice <- dpIceSession dp
@@ -263,3 +263,14 @@ instance Service DiscoveryService where
#else
return ()
#endif
+
+ serviceNewPeer = do
+ server <- asks svcServer
+ peer <- asks svcPeer
+
+ let addrToText saddr = do
+ ( addr, port ) <- IP.fromSockAddr saddr
+ Just $ T.pack $ show addr <> " " <> show port
+ addrs <- catMaybes . map addrToText <$> liftIO (getServerAddresses server)
+
+ sendToPeer peer $ DiscoverySelf addrs Nothing
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 364597f..e398b56 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -6,6 +6,7 @@ module Erebos.Network (
stopServer,
getCurrentPeerList,
getNextPeerChange,
+ getServerAddresses,
ServerOptions(..), serverIdentity, defaultServerOptions,
Peer, peerServer, peerStorage,
@@ -46,17 +47,17 @@ import Data.Maybe
import Data.Typeable
import Data.Word
+import Foreign.C.Types
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
import Foreign.Ptr
-import Foreign.Storable
+import Foreign.Storable as F
import GHC.Conc.Sync (unsafeIOToSTM)
import Network.Socket hiding (ControlMessage)
import qualified Network.Socket.ByteString as S
-import Foreign.C.Types
-import Foreign.Marshal.Alloc
-
#ifdef ENABLE_ICE_SUPPORT
import Erebos.ICE
#endif
@@ -84,6 +85,7 @@ announceIntervalSeconds = 60
data Server = Server
{ serverStorage :: Storage
+ , serverOptions :: ServerOptions
, serverOrigHead :: Head LocalState
, serverIdentity_ :: MVar UnifiedIdentity
, serverThreads :: MVar [ThreadId]
@@ -230,7 +232,7 @@ forkServerThread server act = do
return (t:ts)
startServer :: ServerOptions -> Head LocalState -> (String -> IO ()) -> [SomeService] -> IO Server
-startServer opt serverOrigHead logd' serverServices = do
+startServer serverOptions serverOrigHead logd' serverServices = do
let serverStorage = headStorage serverOrigHead
serverIdentity_ <- newMVar $ headLocalIdentity serverOrigHead
serverThreads <- newMVar []
@@ -266,7 +268,7 @@ startServer opt serverOrigHead logd' serverServices = do
return sock
loop sock = do
- when (serverLocalDiscovery opt) $ forkServerThread server $ do
+ when (serverLocalDiscovery serverOptions) $ forkServerThread server $ do
announceAddreses <- fmap concat $ sequence $
[ map (SockAddrInet6 discoveryPort 0 discoveryMulticastGroup) <$> joinMulticast sock
, getBroadcastAddresses discoveryPort
@@ -378,7 +380,7 @@ startServer opt serverOrigHead logd' serverServices = do
, addrFamily = AF_INET6
, addrSocketType = Datagram
}
- addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show $ serverPort opt)
+ addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show $ serverPort serverOptions)
bracket (open addr) close loop
forkServerThread server $ forever $ do
@@ -955,17 +957,56 @@ runPeerServiceOn mbservice peer handler = liftIO $ do
foreign import ccall unsafe "Network/ifaddrs.h join_multicast" cJoinMulticast :: CInt -> Ptr CSize -> IO (Ptr Word32)
+foreign import ccall unsafe "Network/ifaddrs.h local_addresses" cLocalAddresses :: Ptr CSize -> IO (Ptr InetAddress)
foreign import ccall unsafe "Network/ifaddrs.h broadcast_addresses" cBroadcastAddresses :: IO (Ptr Word32)
-foreign import ccall unsafe "stdlib.h free" cFree :: Ptr Word32 -> IO ()
+foreign import ccall unsafe "stdlib.h free" cFree :: Ptr a -> IO ()
+
+data InetAddress = InetAddress { fromInetAddress :: IP.IP }
+
+instance F.Storable InetAddress where
+ sizeOf _ = sizeOf (undefined :: CInt) + 16
+ alignment _ = 8
+
+ peek ptr = (unpackFamily <$> peekByteOff ptr 0) >>= \case
+ AF_INET -> InetAddress . IP.IPv4 . IP.fromHostAddress <$> peekByteOff ptr (sizeOf (undefined :: CInt))
+ AF_INET6 -> InetAddress . IP.IPv6 . IP.toIPv6b . map fromIntegral <$> peekArray 16 (ptr `plusPtr` sizeOf (undefined :: CInt) :: Ptr Word8)
+ _ -> fail "InetAddress: unknown family"
+
+ poke ptr (InetAddress addr) = case addr of
+ IP.IPv4 ip -> do
+ pokeByteOff ptr 0 (packFamily AF_INET)
+ pokeByteOff ptr (sizeOf (undefined :: CInt)) (IP.toHostAddress ip)
+ IP.IPv6 ip -> do
+ pokeByteOff ptr 0 (packFamily AF_INET6)
+ pokeArray (ptr `plusPtr` sizeOf (undefined :: CInt) :: Ptr Word8) (map fromIntegral $ IP.fromIPv6b ip)
joinMulticast :: Socket -> IO [ Word32 ]
joinMulticast sock =
withFdSocket sock $ \fd ->
alloca $ \pcount -> do
ptr <- cJoinMulticast fd pcount
- count <- fromIntegral <$> peek pcount
- forM [ 0 .. count - 1 ] $ \i ->
- peekElemOff ptr i
+ if ptr == nullPtr
+ then do
+ return []
+ else do
+ count <- fromIntegral <$> peek pcount
+ res <- forM [ 0 .. count - 1 ] $ \i ->
+ peekElemOff ptr i
+ cFree ptr
+ return res
+
+getServerAddresses :: Server -> IO [ SockAddr ]
+getServerAddresses Server {..} = do
+ alloca $ \pcount -> do
+ ptr <- cLocalAddresses pcount
+ if ptr == nullPtr
+ then do
+ return []
+ else do
+ count <- fromIntegral <$> peek pcount
+ res <- peekArray count ptr
+ cFree ptr
+ return $ map (IP.toSockAddr . (, serverPort serverOptions ) . fromInetAddress) res
getBroadcastAddresses :: PortNumber -> IO [SockAddr]
getBroadcastAddresses port = do
diff --git a/src/Erebos/Network/ifaddrs.c b/src/Erebos/Network/ifaddrs.c
index 637716e..ff4382a 100644
--- a/src/Erebos/Network/ifaddrs.c
+++ b/src/Erebos/Network/ifaddrs.c
@@ -9,6 +9,7 @@
#ifndef _WIN32
#include <arpa/inet.h>
#include <net/if.h>
+#include <netinet/in.h>
#include <ifaddrs.h>
#include <endian.h>
#include <sys/types.h>
@@ -85,8 +86,73 @@ uint32_t * join_multicast(int fd, size_t * count)
return interfaces;
}
+static bool copy_local_address( struct InetAddress * dst, const struct sockaddr * src )
+{
+ int family = src->sa_family;
+
+ if( family == AF_INET ){
+ struct in_addr * addr = & (( struct sockaddr_in * ) src)->sin_addr;
+ if (! ((ntohl( addr->s_addr ) & 0xff000000) == 0x7f000000) && // loopback
+ ! ((ntohl( addr->s_addr ) & 0xffff0000) == 0xa9fe0000) // link-local
+ ){
+ dst->family = family;
+ memcpy( & dst->addr, addr, sizeof( * addr ));
+ return true;
+ }
+ }
+
+ if( family == AF_INET6 ){
+ struct in6_addr * addr = & (( struct sockaddr_in6 * ) src)->sin6_addr;
+ if (! IN6_IS_ADDR_LOOPBACK( addr ) &&
+ ! IN6_IS_ADDR_LINKLOCAL( addr )
+ ){
+ dst->family = family;
+ memcpy( & dst->addr, addr, sizeof( * addr ));
+ return true;
+ }
+ }
+
+ return false;
+}
+
#ifndef _WIN32
+struct InetAddress * local_addresses( size_t * count )
+{
+ struct ifaddrs * addrs;
+ if( getifaddrs( &addrs ) < 0 )
+ return 0;
+
+ * count = 0;
+ size_t capacity = 16;
+ struct InetAddress * ret = malloc( sizeof(* ret) * capacity );
+
+ for( struct ifaddrs * ifa = addrs; ifa; ifa = ifa->ifa_next ){
+ if ( ifa->ifa_addr ){
+ int family = ifa->ifa_addr->sa_family;
+ if( family == AF_INET || family == AF_INET6 ){
+ if( (* count) >= capacity ){
+ capacity *= 2;
+ struct InetAddress * nret = realloc( ret, sizeof(* ret) * capacity );
+ if (nret) {
+ ret = nret;
+ } else {
+ free( ret );
+ freeifaddrs( addrs );
+ return 0;
+ }
+ }
+
+ if( copy_local_address( & ret[ * count ], ifa->ifa_addr ))
+ (* count)++;
+ }
+ }
+ }
+
+ freeifaddrs(addrs);
+ return ret;
+}
+
uint32_t * broadcast_addresses(void)
{
struct ifaddrs * addrs;
@@ -106,6 +172,7 @@ uint32_t * broadcast_addresses(void)
ret = nret;
} else {
free(ret);
+ freeifaddrs(addrs);
return 0;
}
}
@@ -124,9 +191,52 @@ uint32_t * broadcast_addresses(void)
#include <winsock2.h>
#include <ws2tcpip.h>
+#include <iptypes.h>
+#include <iphlpapi.h>
#pragma comment(lib, "ws2_32.lib")
+struct InetAddress * local_addresses( size_t * count )
+{
+ * count = 0;
+ struct InetAddress * ret = NULL;
+
+ ULONG bufsize = 15000;
+ IP_ADAPTER_ADDRESSES * buf = NULL;
+
+ DWORD rv = 0;
+
+ do {
+ buf = realloc( buf, bufsize );
+ rv = GetAdaptersAddresses( AF_UNSPEC, 0, NULL, buf, & bufsize );
+
+ if( rv == ERROR_BUFFER_OVERFLOW )
+ continue;
+ } while (0);
+
+ if( rv == NO_ERROR ){
+ size_t capacity = 16;
+ ret = malloc( sizeof( * ret ) * capacity );
+
+ for( IP_ADAPTER_ADDRESSES * cur = (IP_ADAPTER_ADDRESSES *) buf;
+ cur && (* count) < capacity;
+ cur = cur->Next ){
+
+ for( IP_ADAPTER_UNICAST_ADDRESS * curAddr = cur->FirstUnicastAddress;
+ curAddr && (* count) < capacity;
+ curAddr = curAddr->Next ){
+
+ if( copy_local_address( & ret[ * count ], curAddr->Address.lpSockaddr ))
+ (* count)++;
+ }
+ }
+ }
+
+cleanup:
+ free( buf );
+ return ret;
+}
+
uint32_t * broadcast_addresses(void)
{
uint32_t * ret = NULL;
diff --git a/src/Erebos/Network/ifaddrs.h b/src/Erebos/Network/ifaddrs.h
index 8852ec6..2ee45a7 100644
--- a/src/Erebos/Network/ifaddrs.h
+++ b/src/Erebos/Network/ifaddrs.h
@@ -1,5 +1,18 @@
#include <stddef.h>
#include <stdint.h>
+#ifndef _WIN32
+#include <sys/socket.h>
+#else
+#include <winsock2.h>
+#endif
+
+struct InetAddress
+{
+ int family;
+ uint8_t addr[16];
+} __attribute__((packed));
+
uint32_t * join_multicast(int fd, size_t * count);
+struct InetAddress * local_addresses( size_t * count );
uint32_t * broadcast_addresses(void);
diff --git a/test/discovery.test b/test/discovery.test
new file mode 100644
index 0000000..f2dddb7
--- /dev/null
+++ b/test/discovery.test
@@ -0,0 +1,75 @@
+module discovery
+
+test ManualDiscovery:
+ let services = "discovery,test"
+ let refpat = /blake2#[0-9a-f]*/
+
+ subnet sd
+ subnet s1
+ subnet s2
+
+ spawn as pd on sd
+ spawn as p1 on s1
+ spawn as p2 on s2
+ send "create-identity Discovery" to pd
+ send "create-identity Device1 Owner1" to p1
+ send "create-identity Device2 Owner2" to p2
+
+ expect /create-identity-done ref ($refpat).*/ from p1 capture p1id
+ send "identity-info $p1id" to p1
+ expect /identity-info ref $p1id base ($refpat) owner ($refpat).*/ from p1 capture p1base, p1owner
+ send "identity-info $p1owner" to p1
+ expect /identity-info ref $p1owner base ($refpat).*/ from p1 capture p1obase
+
+ expect /create-identity-done ref $refpat.*/ from p2
+ expect /create-identity-done ref $refpat.*/ from pd
+
+ # TODO: avoid the need to send identity objects with weak refs
+ for p in [ p1, p2 ]:
+ with p:
+ send "start-server services $services"
+ send "peer-add ${p2.node.ip}" to p1
+ expect from p1:
+ /peer 1 addr ${p2.node.ip} 29665/
+ /peer 1 id Device2 Owner2/
+ expect from p2:
+ /peer 1 addr ${p1.node.ip} 29665/
+ /peer 1 id Device1 Owner1/
+ for r in [ p1base, p1obase ]:
+ with p1:
+ send "test-message-send 1 $r"
+ expect /test-message-send done/
+ with p2:
+ expect /test-message-received rec [0-9]+ $r/
+ for p in [ p1, p2 ]:
+ send "stop-server" to p
+ expect /stop-server-done/ from p
+
+ # Test discovery using owner and device identities:
+ for id in [ p1obase, p1base ]:
+ for p in [ pd, p1, p2 ]:
+ send "start-server services $services" to p
+
+ for p in [ p1, p2 ]:
+ with p:
+ send "peer-add ${pd.node.ip}"
+ expect:
+ /peer 1 addr ${pd.node.ip} 29665/
+ /peer 1 id Discovery/
+ expect from pd:
+ /peer [12] addr ${p.node.ip} 29665/
+ /peer [12] id .*/
+
+ send "discovery-connect $id" to p2
+
+ expect from p1:
+ /peer [0-9]+ addr ${p2.node.ip} 29665/
+ /peer [0-9]+ id Device2 Owner2/
+ expect from p2:
+ /peer [0-9]+ addr ${p1.node.ip} 29665/
+ /peer [0-9]+ id Device1 Owner1/
+
+ for p in [ pd, p1, p2 ]:
+ send "stop-server" to p
+ for p in [ pd, p1, p2 ]:
+ expect /stop-server-done/ from p
generated by cgit v1.2.3 (git 2.25.1) at 2025-02-23 23:41:30 +0000