summaryrefslogtreecommitdiff
path: root/src/Erebos/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Erebos/Network')
-rw-r--r--src/Erebos/Network/Protocol.hs100
-rw-r--r--src/Erebos/Network/ifaddrs.c84
-rw-r--r--src/Erebos/Network/ifaddrs.h2
3 files changed, 168 insertions, 18 deletions
diff --git a/src/Erebos/Network/Protocol.hs b/src/Erebos/Network/Protocol.hs
index d759994..2955473 100644
--- a/src/Erebos/Network/Protocol.hs
+++ b/src/Erebos/Network/Protocol.hs
@@ -40,7 +40,17 @@ import Control.Monad
import Control.Monad.Except
import Control.Monad.Trans
+import Crypto.Cipher.ChaChaPoly1305 qualified as C
+import Crypto.MAC.Poly1305 qualified as C (Auth(..), authTag)
+import Crypto.Error
+import Crypto.Random
+
+import Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
import Data.Bits
+import Data.ByteArray (Bytes, ScrubbedBytes)
+import Data.ByteArray qualified as BA
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as BC
@@ -51,7 +61,6 @@ import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void
-import Data.Word
import System.Clock
@@ -96,14 +105,41 @@ data TransportHeaderItem
| StreamOpen Word8
deriving (Eq, Show)
-newtype Cookie = Cookie ByteString
- deriving (Eq, Show)
-
data SecurityRequirement = PlaintextOnly
| PlaintextAllowed
| EncryptedOnly
deriving (Eq, Ord)
+data Cookie = Cookie
+ { cookieNonce :: C.Nonce
+ , cookieValidity :: Word32
+ , cookieContent :: ByteString
+ , cookieMac :: C.Auth
+ }
+
+instance Eq Cookie where
+ (==) = (==) `on` (\c -> ( BA.convert (cookieNonce c) :: ByteString, cookieValidity c, cookieContent c, cookieMac c ))
+
+
+instance Show Cookie where
+ show Cookie {..} = show (nonce, cookieValidity, cookieContent, mac)
+ where C.Auth mac = cookieMac
+ nonce = BA.convert cookieNonce :: ByteString
+
+instance Binary Cookie where
+ put Cookie {..} = do
+ putByteString $ BA.convert cookieNonce
+ putWord32be cookieValidity
+ putByteString $ BA.convert cookieMac
+ putByteString cookieContent
+
+ get = do
+ Just cookieNonce <- maybeCryptoError . C.nonce12 <$> getByteString 12
+ cookieValidity <- getWord32be
+ Just cookieMac <- maybeCryptoError . C.authTag <$> getByteString 16
+ cookieContent <- BL.toStrict <$> getRemainingLazyByteString
+ return Cookie {..}
+
isHeaderItemAcknowledged :: TransportHeaderItem -> Bool
isHeaderItemAcknowledged = \case
Acknowledged {} -> False
@@ -123,8 +159,8 @@ transportToObject st (TransportHeader items) = Rec $ map single items
Rejected dgst -> (BC.pack "REJ", RecRef $ partialRefFromDigest st dgst)
ProtocolVersion ver -> (BC.pack "VER", RecText ver)
Initiation dgst -> (BC.pack "INI", RecRef $ partialRefFromDigest st dgst)
- CookieSet (Cookie bytes) -> (BC.pack "CKS", RecBinary bytes)
- CookieEcho (Cookie bytes) -> (BC.pack "CKE", RecBinary bytes)
+ CookieSet cookie -> (BC.pack "CKS", RecBinary $ BL.toStrict $ encode cookie)
+ CookieEcho cookie -> (BC.pack "CKE", RecBinary $ BL.toStrict $ encode cookie)
DataRequest dgst -> (BC.pack "REQ", RecRef $ partialRefFromDigest st dgst)
DataResponse dgst -> (BC.pack "RSP", RecRef $ partialRefFromDigest st dgst)
AnnounceSelf dgst -> (BC.pack "ANN", RecRef $ partialRefFromDigest st dgst)
@@ -145,8 +181,12 @@ transportFromObject (Rec items) = case catMaybes $ map single items of
| name == BC.pack "REJ", RecRef ref <- content -> Just $ Rejected $ refDigest ref
| name == BC.pack "VER", RecText ver <- content -> Just $ ProtocolVersion ver
| name == BC.pack "INI", RecRef ref <- content -> Just $ Initiation $ refDigest ref
- | name == BC.pack "CKS", RecBinary bytes <- content -> Just $ CookieSet (Cookie bytes)
- | name == BC.pack "CKE", RecBinary bytes <- content -> Just $ CookieEcho (Cookie bytes)
+ | name == BC.pack "CKS", RecBinary bytes <- content
+ , Right (_, _, cookie) <- decodeOrFail (BL.fromStrict bytes)
+ -> Just $ CookieSet cookie
+ | name == BC.pack "CKE", RecBinary bytes <- content
+ , Right (_, _, cookie) <- decodeOrFail (BL.fromStrict bytes)
+ -> Just $ CookieEcho cookie
| name == BC.pack "REQ", RecRef ref <- content -> Just $ DataRequest $ refDigest ref
| name == BC.pack "RSP", RecRef ref <- content -> Just $ DataResponse $ refDigest ref
| name == BC.pack "ANN", RecRef ref <- content -> Just $ AnnounceSelf $ refDigest ref
@@ -168,9 +208,12 @@ data GlobalState addr = (Eq addr, Show addr) => GlobalState
, gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
, gLog :: String -> STM ()
, gStorage :: PartialStorage
+ , gStartTime :: TimeSpec
, gNowVar :: TVar TimeSpec
, gNextTimeout :: TVar TimeSpec
, gInitConfig :: Ref
+ , gCookieKey :: ScrubbedBytes
+ , gCookieStartTime :: Word32
}
data Connection addr = Connection
@@ -444,11 +487,14 @@ erebosNetworkProtocol initialIdentity gLog gDataFlow gControlFlow = do
mStorage <- memoryStorage
gStorage <- derivePartialStorage mStorage
- startTime <- getTime Monotonic
- gNowVar <- newTVarIO startTime
- gNextTimeout <- newTVarIO startTime
+ gStartTime <- getTime Monotonic
+ gNowVar <- newTVarIO gStartTime
+ gNextTimeout <- newTVarIO gStartTime
gInitConfig <- store mStorage $ (Rec [] :: Object)
+ gCookieKey <- getRandomBytes 32
+ gCookieStartTime <- runGet getWord32host . BL.pack . BA.unpack @ScrubbedBytes <$> getRandomBytes 4
+
let gs = GlobalState {..}
let signalTimeouts = forever $ do
@@ -702,11 +748,36 @@ generateCookieHeaders Connection {..} ch = catMaybes <$> sequence [ echoHeader,
_ -> return Nothing
createCookie :: GlobalState addr -> addr -> IO Cookie
-createCookie GlobalState {} addr = return (Cookie $ BC.pack $ show addr)
+createCookie GlobalState {..} addr = do
+ (nonceBytes :: Bytes) <- getRandomBytes 12
+ validUntil <- (fromNanoSecs (60 * 10^(9 :: Int)) +) <$> getTime Monotonic
+ let validSecondsFromStart = fromIntegral $ toNanoSecs (validUntil - gStartTime) `div` (10^(9 :: Int))
+ cookieValidity = validSecondsFromStart - gCookieStartTime
+ plainContent = BC.pack (show addr)
+ throwCryptoErrorIO $ do
+ cookieNonce <- C.nonce12 nonceBytes
+ st1 <- C.initialize gCookieKey cookieNonce
+ let st2 = C.finalizeAAD $ C.appendAAD (BL.toStrict $ runPut $ putWord32be cookieValidity) st1
+ (cookieContent, st3) = C.encrypt plainContent st2
+ cookieMac = C.finalize st3
+ return $ Cookie {..}
verifyCookie :: GlobalState addr -> addr -> Cookie -> IO Bool
-verifyCookie GlobalState {} addr (Cookie cookie) = return $ show addr == BC.unpack cookie
-
+verifyCookie GlobalState {..} addr Cookie {..} = do
+ ctime <- getTime Monotonic
+ return $ fromMaybe False $ maybeCryptoError $ do
+ st1 <- C.initialize gCookieKey cookieNonce
+ let st2 = C.finalizeAAD $ C.appendAAD (BL.toStrict $ runPut $ putWord32be cookieValidity) st1
+ (plainContent, st3) = C.decrypt cookieContent st2
+ mac = C.finalize st3
+
+ validSecondsFromStart = fromIntegral $ cookieValidity + gCookieStartTime
+ validUntil = gStartTime + fromNanoSecs (validSecondsFromStart * (10^(9 :: Int)))
+ return $ and
+ [ mac == cookieMac
+ , ctime <= validUntil
+ , show addr == BC.unpack plainContent
+ ]
reservePacket :: Connection addr -> STM ReservedToSend
reservePacket conn@Connection {..} = do
@@ -891,6 +962,7 @@ processOutgoing gs@GlobalState {..} = do
now <- readTVar gNowVar
if next <= now
then do
+ writeTVar cNextKeepAlive Nothing
identity <- fst <$> readTVar gIdentity
let header = TransportHeader [ AnnounceSelf $ refDigest $ storedRef $ idData identity ]
writeTQueue cSecureOutQueue (EncryptedOnly, TransportPacket header [], [])
diff --git a/src/Erebos/Network/ifaddrs.c b/src/Erebos/Network/ifaddrs.c
index efeca18..70685bc 100644
--- a/src/Erebos/Network/ifaddrs.c
+++ b/src/Erebos/Network/ifaddrs.c
@@ -1,13 +1,89 @@
#include "ifaddrs.h"
-#ifndef _WIN32
+#include <errno.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#ifndef _WIN32
#include <arpa/inet.h>
-#include <ifaddrs.h>
#include <net/if.h>
-#include <stdlib.h>
-#include <sys/types.h>
+#include <ifaddrs.h>
#include <endian.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#else
+#include <winsock2.h>
+#include <ws2ipdef.h>
+#include <ws2tcpip.h>
+#endif
+
+#define DISCOVERY_MULTICAST_GROUP "ff12:b6a4:6b1f:969:caee:acc2:5c93:73e1"
+
+uint32_t * join_multicast(int fd, size_t * count)
+{
+ size_t capacity = 16;
+ *count = 0;
+ uint32_t * interfaces = malloc(sizeof(uint32_t) * capacity);
+
+#ifdef _WIN32
+ interfaces[0] = 0;
+ *count = 1;
+#else
+ struct ifaddrs * addrs;
+ if (getifaddrs(&addrs) < 0)
+ return 0;
+
+ for (struct ifaddrs * ifa = addrs; ifa; ifa = ifa->ifa_next) {
+ if (ifa->ifa_addr && ifa->ifa_addr->sa_family == AF_INET6 &&
+ !(ifa->ifa_flags & IFF_LOOPBACK)) {
+ int idx = if_nametoindex(ifa->ifa_name);
+
+ bool seen = false;
+ for (size_t i = 0; i < *count; i++) {
+ if (interfaces[i] == idx) {
+ seen = true;
+ break;
+ }
+ }
+ if (seen)
+ continue;
+
+ if (*count + 1 >= capacity) {
+ capacity *= 2;
+ uint32_t * nret = realloc(interfaces, sizeof(uint32_t) * capacity);
+ if (nret) {
+ interfaces = nret;
+ } else {
+ free(interfaces);
+ *count = 0;
+ return NULL;
+ }
+ }
+
+ interfaces[*count] = idx;
+ (*count)++;
+ }
+ }
+
+ freeifaddrs(addrs);
+#endif
+
+ for (size_t i = 0; i < *count; i++) {
+ struct ipv6_mreq group;
+ group.ipv6mr_interface = interfaces[i];
+ inet_pton(AF_INET6, DISCOVERY_MULTICAST_GROUP, &group.ipv6mr_multiaddr);
+ int ret = setsockopt(fd, IPPROTO_IPV6, IPV6_ADD_MEMBERSHIP,
+ (const void *) &group, sizeof(group));
+ if (ret < 0)
+ fprintf(stderr, "IPV6_ADD_MEMBERSHIP failed: %s\n", strerror(errno));
+ }
+
+ return interfaces;
+}
+
+#ifndef _WIN32
uint32_t * broadcast_addresses(void)
{
diff --git a/src/Erebos/Network/ifaddrs.h b/src/Erebos/Network/ifaddrs.h
index 06d26ec..8852ec6 100644
--- a/src/Erebos/Network/ifaddrs.h
+++ b/src/Erebos/Network/ifaddrs.h
@@ -1,3 +1,5 @@
+#include <stddef.h>
#include <stdint.h>
+uint32_t * join_multicast(int fd, size_t * count);
uint32_t * broadcast_addresses(void);
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-19 14:48:23 +0000