summaryrefslogtreecommitdiff
path: root/src/Erebos/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Erebos/Network')
-rw-r--r--src/Erebos/Network/Channel.hs36
-rw-r--r--src/Erebos/Network/Protocol.hs24
-rw-r--r--src/Erebos/Network/ifaddrs.c110
-rw-r--r--src/Erebos/Network/ifaddrs.h13
4 files changed, 153 insertions, 30 deletions
diff --git a/src/Erebos/Network/Channel.hs b/src/Erebos/Network/Channel.hs
index 17e1a37..d9679bd 100644
--- a/src/Erebos/Network/Channel.hs
+++ b/src/Erebos/Network/Channel.hs
@@ -78,23 +78,23 @@ instance Storable ChannelAcceptData where
keySize :: Int
keySize = 32
-createChannelRequest :: (MonadStorage m, MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> m (Stored ChannelRequest)
+createChannelRequest :: (MonadStorage m, MonadIO m, MonadError e m, FromErebosError e) => UnifiedIdentity -> UnifiedIdentity -> m (Stored ChannelRequest)
createChannelRequest self peer = do
(_, xpublic) <- liftIO . generateKeys =<< getStorage
skey <- loadKey $ idKeyMessage self
mstore =<< sign skey =<< mstore ChannelRequest { crPeers = sort [idData self, idData peer], crKey = xpublic }
-acceptChannelRequest :: (MonadStorage m, MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelRequest -> m (Stored ChannelAccept, Channel)
+acceptChannelRequest :: (MonadStorage m, MonadIO m, MonadError e m, FromErebosError e) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelRequest -> m (Stored ChannelAccept, Channel)
acceptChannelRequest self peer req = do
case sequence $ map validateIdentity $ crPeers $ fromStored $ signedData $ fromStored req of
- Nothing -> throwError $ "invalid peers in channel request"
+ Nothing -> throwOtherError $ "invalid peers in channel request"
Just peers -> do
when (not $ any (self `sameIdentity`) peers) $
- throwError $ "self identity missing in channel request peers"
+ throwOtherError $ "self identity missing in channel request peers"
when (not $ any (peer `sameIdentity`) peers) $
- throwError $ "peer identity missing in channel request peers"
+ throwOtherError $ "peer identity missing in channel request peers"
when (idKeyMessage peer `notElem` (map (sigKey . fromStored) $ signedSignature $ fromStored req)) $
- throwError $ "channel requent not signed by peer"
+ throwOtherError $ "channel requent not signed by peer"
(xsecret, xpublic) <- liftIO . generateKeys =<< getStorage
skey <- loadKey $ idKeyMessage self
@@ -110,20 +110,20 @@ acceptChannelRequest self peer req = do
return (acc, Channel {..})
-acceptedChannel :: (MonadIO m, MonadError String m) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelAccept -> m Channel
+acceptedChannel :: (MonadIO m, MonadError e m, FromErebosError e) => UnifiedIdentity -> UnifiedIdentity -> Stored ChannelAccept -> m Channel
acceptedChannel self peer acc = do
let req = caRequest $ fromStored $ signedData $ fromStored acc
case sequence $ map validateIdentity $ crPeers $ fromStored $ signedData $ fromStored req of
- Nothing -> throwError $ "invalid peers in channel accept"
+ Nothing -> throwOtherError $ "invalid peers in channel accept"
Just peers -> do
when (not $ any (self `sameIdentity`) peers) $
- throwError $ "self identity missing in channel accept peers"
+ throwOtherError $ "self identity missing in channel accept peers"
when (not $ any (peer `sameIdentity`) peers) $
- throwError $ "peer identity missing in channel accept peers"
+ throwOtherError $ "peer identity missing in channel accept peers"
when (idKeyMessage peer `notElem` (map (sigKey . fromStored) $ signedSignature $ fromStored acc)) $
- throwError $ "channel accept not signed by peer"
+ throwOtherError $ "channel accept not signed by peer"
when (idKeyMessage self `notElem` (map (sigKey . fromStored) $ signedSignature $ fromStored req)) $
- throwError $ "original channel request not signed by us"
+ throwOtherError $ "original channel request not signed by us"
xsecret <- loadKey $ crKey $ fromStored $ signedData $ fromStored req
let chPeers = crPeers $ fromStored $ signedData $ fromStored req
@@ -137,23 +137,23 @@ acceptedChannel self peer acc = do
return Channel {..}
-channelEncrypt :: (ByteArray ba, MonadIO m, MonadError String m) => Channel -> ba -> m (ba, Word64)
+channelEncrypt :: (ByteArray ba, MonadIO m, MonadError e m, FromErebosError e) => Channel -> ba -> m (ba, Word64)
channelEncrypt Channel {..} plain = do
count <- liftIO $ modifyMVar chCounterNextOut $ \c -> return (c + 1, c)
let cbytes = convert $ BL.toStrict $ encode count
nonce = nonce8 chNonceFixedOur cbytes
state <- case initialize chKey =<< nonce of
CryptoPassed state -> return state
- CryptoFailed err -> throwError $ "failed to init chacha-poly1305 cipher: " <> show err
+ CryptoFailed err -> throwOtherError $ "failed to init chacha-poly1305 cipher: " <> show err
let (ctext, state') = encrypt plain state
tag = finalize state'
return (BA.concat [ convert $ BA.drop 7 cbytes, ctext, convert tag ], count)
-channelDecrypt :: (ByteArray ba, MonadIO m, MonadError String m) => Channel -> ba -> m (ba, Word64)
+channelDecrypt :: (ByteArray ba, MonadIO m, MonadError e m, FromErebosError e) => Channel -> ba -> m (ba, Word64)
channelDecrypt Channel {..} body = do
when (BA.length body < 17) $ do
- throwError $ "invalid encrypted data length"
+ throwOtherError $ "invalid encrypted data length"
expectedCount <- liftIO $ readMVar chCounterNextIn
let countByte = body `BA.index` 0
@@ -165,11 +165,11 @@ channelDecrypt Channel {..} body = do
tag = BA.dropView body' blen
state <- case initialize chKey =<< nonce of
CryptoPassed state -> return state
- CryptoFailed err -> throwError $ "failed to init chacha-poly1305 cipher: " <> show err
+ CryptoFailed err -> throwOtherError $ "failed to init chacha-poly1305 cipher: " <> show err
let (plain, state') = decrypt (convert ctext) state
when (not $ tag `BA.constEq` finalize state') $ do
- throwError $ "tag validation falied"
+ throwOtherError $ "tag validation falied"
liftIO $ modifyMVar_ chCounterNextIn $ return . max (guessedCount + 1)
return (plain, guessedCount)
diff --git a/src/Erebos/Network/Protocol.hs b/src/Erebos/Network/Protocol.hs
index c657759..c340503 100644
--- a/src/Erebos/Network/Protocol.hs
+++ b/src/Erebos/Network/Protocol.hs
@@ -323,7 +323,7 @@ connAddWriteStream conn@Connection {..} = do
Right (ctext, counter) -> do
let isAcked = True
return $ Just (0x80 `B.cons` ctext, if isAcked then [ AcknowledgedSingle $ fromIntegral counter ] else [])
- Left err -> do atomically $ gLog $ "Failed to encrypt data: " ++ err
+ Left err -> do atomically $ gLog $ "Failed to encrypt data: " ++ showErebosError err
return Nothing
Nothing | secure -> return Nothing
| otherwise -> return $ Just (plain, plainAckedBy)
@@ -402,16 +402,16 @@ readStreamToList stream = readFlowIO stream >>= \case
StreamData sq bytes -> fmap ((sq, bytes) :) <$> readStreamToList stream
StreamClosed sqEnd -> return (sqEnd, [])
-readObjectsFromStream :: PartialStorage -> RawStreamReader -> IO (Except String [PartialObject])
+readObjectsFromStream :: PartialStorage -> RawStreamReader -> IO (Except ErebosError [PartialObject])
readObjectsFromStream st stream = do
(seqEnd, list) <- readStreamToList stream
let validate s ((s', bytes) : rest)
| s == s' = (bytes : ) <$> validate (s + 1) rest
| s > s' = validate s rest
- | otherwise = throwError "missing object chunk"
+ | otherwise = throwOtherError "missing object chunk"
validate s []
| s == seqEnd = return []
- | otherwise = throwError "content length mismatch"
+ | otherwise = throwOtherError "content length mismatch"
return $ do
content <- BL.fromChunks <$> validate 0 list
deserializeObjects st content
@@ -434,7 +434,7 @@ data WaitingRef = WaitingRef
, wrefStatus :: TVar (Either [RefDigest] Ref)
}
-type WaitingRefCallback = ExceptT String IO ()
+type WaitingRefCallback = ExceptT ErebosError IO ()
wrDigest :: WaitingRef -> RefDigest
wrDigest = refDigest . wrefPartial
@@ -571,7 +571,7 @@ processIncoming gs@GlobalState {..} = do
let parse = case B.uncons msg of
Just (b, enc)
| b .&. 0xE0 == 0x80 -> do
- ch <- maybe (throwError "unexpected encrypted packet") return mbch
+ ch <- maybe (throwOtherError "unexpected encrypted packet") return mbch
(dec, counter) <- channelDecrypt ch enc
case B.uncons dec of
@@ -586,18 +586,18 @@ processIncoming gs@GlobalState {..} = do
return $ Right (snum, seq8, content, counter)
Just (_, _) -> do
- throwError "unexpected stream header"
+ throwOtherError "unexpected stream header"
Nothing -> do
- throwError "empty decrypted content"
+ throwOtherError "empty decrypted content"
| b .&. 0xE0 == 0x60 -> do
objs <- deserialize msg
return $ Left (False, objs, Nothing)
- | otherwise -> throwError "invalid packet"
+ | otherwise -> throwOtherError "invalid packet"
- Nothing -> throwError "empty packet"
+ Nothing -> throwOtherError "empty packet"
now <- getTime Monotonic
runExceptT parse >>= \case
@@ -648,7 +648,7 @@ processIncoming gs@GlobalState {..} = do
atomically $ gLog $ show addr <> ": stream packet without connection"
Left err -> do
- atomically $ gLog $ show addr <> ": failed to parse packet: " <> err
+ atomically $ gLog $ show addr <> ": failed to parse packet: " <> showErebosError err
processPacket :: GlobalState addr -> Either addr (Connection addr) -> Bool -> TransportPacket a -> IO (Maybe (Connection addr, Maybe (TransportPacket a)))
processPacket gs@GlobalState {..} econn secure packet@(TransportPacket (TransportHeader header) _) = if
@@ -882,7 +882,7 @@ processOutgoing gs@GlobalState {..} = do
Right (ctext, counter) -> do
let isAcked = any isHeaderItemAcknowledged hitems
return $ Just (0x80 `B.cons` ctext, if isAcked then [ AcknowledgedSingle $ fromIntegral counter ] else [])
- Left err -> do atomically $ gLog $ "Failed to encrypt data: " ++ err
+ Left err -> do atomically $ gLog $ "Failed to encrypt data: " ++ showErebosError err
return Nothing
mbs <- case (secure, mbch) of
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);
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-04 21:38:01 +0000