diff options
| -rw-r--r-- | nara.cabal | 11 | ||||
| -rw-r--r-- | src/Network/WireGuard/Core.hs | 2 | ||||
| -rw-r--r-- | src/Network/WireGuard/Internal/Data/RpcTypes.hs | 63 | ||||
| -rw-r--r-- | src/Network/WireGuard/Internal/Data/Types.hs (renamed from src/Network/WireGuard/Internal/Types.hs) | 2 | ||||
| -rw-r--r-- | src/Network/WireGuard/Internal/Noise.hs | 2 | ||||
| -rw-r--r-- | src/Network/WireGuard/Internal/Packet.hs | 2 | ||||
| -rw-r--r-- | src/Network/WireGuard/Internal/RpcParsers.hs | 66 | ||||
| -rw-r--r-- | src/Network/WireGuard/Internal/State.hs | 2 | ||||
| -rw-r--r-- | src/Network/WireGuard/RPC.hs | 93 | ||||
| -rw-r--r-- | src/Network/WireGuard/TunListener.hs | 2 | ||||
| -rw-r--r-- | src/Network/WireGuard/UdpListener.hs | 2 | ||||
| -rw-r--r-- | tests/spec/Network/WireGuard/RPCSpec.hs | 115 |
12 files changed, 283 insertions, 79 deletions
@@ -56,13 +56,17 @@ library Network.WireGuard.Internal.Noise, Network.WireGuard.Internal.Packet, Network.WireGuard.Internal.PacketQueue, + Network.WireGuard.Internal.RpcParsers, Network.WireGuard.Internal.State, - Network.WireGuard.Internal.Types + Network.WireGuard.Internal.Data.Types, + Network.WireGuard.Internal.Data.RpcTypes build-depends: async, + attoparsec, base == 4.9.*, blake2, bytestring, + bytestring-conversion, cacophony >=0.9.2 && <0.10, cereal, conduit, @@ -84,6 +88,7 @@ library unix == 2.7.*, unordered-containers + if os(linux) c-sources: cbits/tun-linux.c cpp-options: -DOS_LINUX @@ -113,7 +118,8 @@ test-suite nara-test tests/spec ghc-options: -Wall build-depends: - base == 4.9.* + attoparsec + , base == 4.9.* , hspec , nara , bytestring @@ -125,6 +131,7 @@ test-suite nara-test , hex , network , iproute + , unordered-containers other-modules: Network.WireGuard.RPCSpec default-language: Haskell2010 diff --git a/src/Network/WireGuard/Core.hs b/src/Network/WireGuard/Core.hs index 6d65e37..5bbf317 100644 --- a/src/Network/WireGuard/Core.hs +++ b/src/Network/WireGuard/Core.hs @@ -41,7 +41,7 @@ import Network.WireGuard.Internal.Noise import Network.WireGuard.Internal.Packet import Network.WireGuard.Internal.PacketQueue import Network.WireGuard.Internal.State -import Network.WireGuard.Internal.Types +import Network.WireGuard.Internal.Data.Types import Network.WireGuard.Internal.Util runCore :: Device diff --git a/src/Network/WireGuard/Internal/Data/RpcTypes.hs b/src/Network/WireGuard/Internal/Data/RpcTypes.hs new file mode 100644 index 0000000..a3c148b --- /dev/null +++ b/src/Network/WireGuard/Internal/Data/RpcTypes.hs @@ -0,0 +1,63 @@ +module Network.WireGuard.Internal.Data.RpcTypes( + OpType(..), + RpcRequest(..), + RpcSetPayload(..), + RpcDevicePayload(..), + RpcPeerPayload(..) +) where + +import Data.Word (Word64) +import Data.IP (IPRange(..)) +import Crypto.Noise.DH (dhSecToBytes) +import Network.Socket.Internal (SockAddr) + +import Network.WireGuard.Internal.Data.Types (PublicKey, KeyPair, + Time) +-- | Kind of client operation. +-- +-- See <https://www.wireguard.com/xplatform/#configuration-protocol> for more informations. +data OpType = Get | Set + +-- | Request wrapper. The payload is set only for Set operations. +-- +-- See <https://www.wireguard.com/xplatform/#configuration-protocol> for more informations. +data RpcRequest = RpcRequest { + opType :: OpType, + payload :: Maybe RpcSetPayload +} + +-- | Payload sent together with a set RPC operation. +data RpcSetPayload = RpcSetPayload { + devicePayload :: RpcDevicePayload, + peersPayload :: [RpcPeerPayload] +} + +-- | Device related payload sent together with a set RPC operation. +data RpcDevicePayload = RpcDevicePayload { + pk :: Maybe KeyPair, + listenPort :: Int, + fwMark :: Maybe Word, + replacePeers :: Bool +} + +instance Show RpcDevicePayload where + show (RpcDevicePayload kp lp fwM rpp) = show (showKeyPair <$> kp) ++ show lp ++ show fwM ++ show rpp + where + showKeyPair (pk, _) = show $ dhSecToBytes pk + +instance Eq RpcDevicePayload where + (==) (RpcDevicePayload pk1 prt1 fw1 rp1) (RpcDevicePayload pk2 prt2 fw2 rp2) = + ((dhSecToBytes . fst) <$> pk1) == ((dhSecToBytes . fst) <$> pk2) && (prt1 == prt2) && + (rp1 == rp2) && (fw1 == fw2) + +-- | Peer related payload sent together with a set RPC operation. +data RpcPeerPayload = RpcPeerPayload { + pubK :: PublicKey, + remove :: Bool, + endpoint :: SockAddr, + persistantKeepaliveInterval :: Int, + allowedIp :: [IPRange], + rxBytes :: Word64, + txBytes :: Word64, + lastHandshake :: Time +} diff --git a/src/Network/WireGuard/Internal/Types.hs b/src/Network/WireGuard/Internal/Data/Types.hs index 3409e2a..53c3cea 100644 --- a/src/Network/WireGuard/Internal/Types.hs +++ b/src/Network/WireGuard/Internal/Data/Types.hs @@ -1,4 +1,4 @@ -module Network.WireGuard.Internal.Types +module Network.WireGuard.Internal.Data.Types ( Index , Counter , PeerId diff --git a/src/Network/WireGuard/Internal/Noise.hs b/src/Network/WireGuard/Internal/Noise.hs index 842e002..4084f42 100644 --- a/src/Network/WireGuard/Internal/Noise.hs +++ b/src/Network/WireGuard/Internal/Noise.hs @@ -31,7 +31,7 @@ import Data.Serialize (putWord64le, runPut) import Crypto.Noise -import Network.WireGuard.Internal.Types +import Network.WireGuard.Internal.Data.Types type NoiseStateWG = NoiseState ChaChaPoly1305 Curve25519 BLAKE2s diff --git a/src/Network/WireGuard/Internal/Packet.hs b/src/Network/WireGuard/Internal/Packet.hs index ebc24fc..f89c160 100644 --- a/src/Network/WireGuard/Internal/Packet.hs +++ b/src/Network/WireGuard/Internal/Packet.hs @@ -13,7 +13,7 @@ import Foreign.Storable (sizeOf) import Data.Serialize import Network.WireGuard.Internal.Constant -import Network.WireGuard.Internal.Types +import Network.WireGuard.Internal.Data.Types data Packet = HandshakeInitiation { senderIndex :: !Index diff --git a/src/Network/WireGuard/Internal/RpcParsers.hs b/src/Network/WireGuard/Internal/RpcParsers.hs new file mode 100644 index 0000000..b28b000 --- /dev/null +++ b/src/Network/WireGuard/Internal/RpcParsers.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.WireGuard.Internal.RpcParsers( + RpcRequest(..), + OpType(..), + RpcSetPayload(..), + RpcDevicePayload(..), + RpcPeerPayload(..), + requestParser, + deviceParser +) where + +import Control.Applicative ((*>), (<|>)) +import Control.Monad (liftM, join) +import Crypto.Noise.DH (dhSecToBytes, dhBytesToPair) +import Data.Attoparsec.ByteString.Char8 (Parser, string, + takeTill, option) +import Data.Attoparsec.Combinator ((<?>)) +import qualified Data.ByteArray as BA (convert) +import qualified Data.ByteString as BS (head) +import Data.ByteString.Conversion +import qualified Data.ByteString.Char8 as BC (pack) +import Data.Maybe (fromMaybe) +import Data.IP (IPRange(..)) +import Data.Hex (unhex) +import Data.Word (Word, Word64) +import Data.ByteString (ByteString) +import Network.Socket.Internal (SockAddr) + + +import Network.WireGuard.Internal.Data.RpcTypes (OpType(..), + RpcRequest(..), + RpcDevicePayload(..), + RpcPeerPayload(..), + RpcSetPayload(..)) + + +-- | Attoparsec parser used to parse a RPC request, both Set or Get. +requestParser :: Parser RpcRequest +requestParser = do + op <- requestTypeParser + let p = case op of + Set -> undefined + Get -> Nothing + _ <- string $ BC.pack "\n\n" + return $ RpcRequest op p + +requestTypeParser :: Parser OpType +requestTypeParser = "get=1" *> return Get + <|> "set=1" *> return Set + +setPayloadParser :: Parser RpcSetPayload +setPayloadParser = undefined + +deviceParser :: Parser RpcDevicePayload +deviceParser = do + pkHex <- option Nothing (unhex <$> keyParser "private_key") <?> "Primary key parser" + "\n" + let pk = join $ (dhBytesToPair . BA.convert) <$> pkHex + p <- (fromMaybe 0 . fromByteString) <$> keyParser "listen_port" <?> "Port parser" + "\n" + fwmark <- option Nothing (fromByteString <$> keyParser "fwmark") <?> "Fwmark parser" + return $ RpcDevicePayload pk p fwmark False + +keyParser :: ByteString -> Parser ByteString +keyParser str = (string str *> "=") *> takeTill (=='\n') diff --git a/src/Network/WireGuard/Internal/State.hs b/src/Network/WireGuard/Internal/State.hs index f7b1ca0..ea8ce1b 100644 --- a/src/Network/WireGuard/Internal/State.hs +++ b/src/Network/WireGuard/Internal/State.hs @@ -42,7 +42,7 @@ import Network.Socket.Internal (SockAddr) import Control.Concurrent.STM import Network.WireGuard.Internal.Constant -import Network.WireGuard.Internal.Types +import Network.WireGuard.Internal.Data.Types data Device = Device { intfName :: String diff --git a/src/Network/WireGuard/RPC.hs b/src/Network/WireGuard/RPC.hs index 73d9e7a..ae9e552 100644 --- a/src/Network/WireGuard/RPC.hs +++ b/src/Network/WireGuard/RPC.hs @@ -13,67 +13,49 @@ module Network.WireGuard.RPC import Control.Concurrent.STM (STM, atomically, modifyTVar', readTVar, writeTVar) -import Control.Monad (replicateM, sequence, - when) +import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import qualified Crypto.Noise.DH as DH (dhPubToBytes, dhSecToBytes, dhBytesToPair, dhBytesToPair, dhBytesToPub) import qualified Data.ByteArray as BA (convert) import qualified Data.ByteString as BS (ByteString, concat, - replicate, empty, pack) -import qualified Data.ByteString.Lazy.Char8 as CL (unpack) + replicate, empty) import qualified Data.ByteString.Char8 as BC (pack, singleton, map) import Data.Char (toLower) -import qualified Data.Conduit.Binary as CB (sinkStorable, sinkLbs) +import Data.Conduit.Attoparsec (sinkParserEither) import Data.Conduit.Network.Unix (appSink, appSource, runUnixServer, serverSettings) -import qualified Data.HashMap.Strict as HM (HashMap(..), size, delete, - lookup, insert, - empty, fromList, - foldrWithKey, elems) +import qualified Data.HashMap.Strict as HM ( delete, lookup, insert, + empty, elems) import Data.Hex (hex) import Data.Int (Int32) -import Data.List (foldl', genericLength) -import Foreign.C.Types (CTime (..)) - +import Data.List (foldl') import Data.Bits (Bits(..)) import Data.Conduit (ConduitM, (.|), - yield, runConduit, - toConsumer) + yield, runConduit) import Data.IP (IPRange(..), addrRangePair, toHostAddress, toHostAddress6, fromHostAddress, makeAddrRange, fromHostAddress6) -import Data.Maybe (fromMaybe, fromJust, isJust) +import Data.Maybe (fromJust, isJust) import Network.WireGuard.Foreign.UAPI (WgPeer(..), WgDevice(..), - WgIpmask(..), writeConfig, + WgIpmask(..), peerFlagRemoveMe, peerFlagReplaceIpmasks, deviceFlagRemoveFwmark, deviceFlagReplacePeers, deviceFlagRemovePrivateKey, deviceFlagRemovePresharedKey) import Network.WireGuard.Internal.Constant (keyLength) +import Network.WireGuard.Internal.RpcParsers (RpcRequest(..), RpcSetPayload(..), + OpType(..), requestParser) import Network.WireGuard.Internal.State (Device(..), Peer(..), - buildRouteTables, createPeer, + createPeer, invalidateSessions) -import Network.WireGuard.Internal.Types (PrivateKey, PublicKey, +import Network.WireGuard.Internal.Data.Types (PrivateKey, PublicKey, PresharedKey, KeyPair) import Network.WireGuard.Internal.Util (catchIOExceptionAnd) --- | Kind of client operation. --- --- See <https://www.wireguard.com/xplatform/#configuration-protocol> for more informations. -data OpType = Get | Set - --- | Request wrapper. The payload is set only for Set operations. --- --- See <https://www.wireguard.com/xplatform/#configuration-protocol> for more informations. -data RpcRequest = RpcRequest { - opType :: OpType, - payload :: BS.ByteString -} - -- | Run RPC service over a unix socket runRPC :: FilePath -> Device -> IO () runRPC sockPath device = runUnixServer (serverSettings sockPath) $ \app -> @@ -83,34 +65,30 @@ runRPC sockPath device = runUnixServer (serverSettings sockPath) $ \app -> -- TODO: ensure that all bytestring over sockets will be erased serveConduit :: Device -> ConduitM BS.ByteString BS.ByteString IO () serveConduit device = do - request <- CL.unpack <$> toConsumer CB.sinkLbs - if request /= "" - then routeRequest request - else yield mempty + request <- sinkParserEither requestParser + routeRequest request where --returnError = yield $ writeConfig (-invalidValueError) - isGet = (== "get=1") - isSet = (== "set=1") - routeRequest req = do - let line = head $ lines req - case () of _ - | isGet line -> do - deviceBstr <- liftIO . atomically $ showDevice device - yield deviceBstr - | otherwise -> yield mempty + routeRequest (Left _) = yield mempty + routeRequest (Right req) = + case opType req of + Set -> undefined + Get -> do + deviceBstr <- liftIO . atomically $ showDevice device + yield $ BS.concat [deviceBstr, BC.pack "errno=0\n\n"] showDevice :: Device -> STM BS.ByteString showDevice device@Device{..} = do listen_port <- BC.pack . show <$> readTVar port - fwmark <- BC.pack . show <$> readTVar fwmark + fwm <- BC.pack . show <$> readTVar fwmark private_key <- fmap (toLowerBs . hex . privToBytes . fst) <$> readTVar localKey let devHm = [("private_key", private_key), ("listen_port", Just listen_port), - ("fwmark", Just fwmark)] + ("fwmark", Just fwm)] let devBs = serializeRpcKeyValue devHm - peers <- readTVar peers - peersBstrList <- mapM showPeer $ HM.elems peers - return . BS.concat $ (devBs : peersBstrList ++ [BC.singleton '\n']) + prs <- readTVar peers + peersBstrList <- mapM showPeer $ HM.elems prs + return . BS.concat $ (devBs : peersBstrList) showPeer :: Peer -> STM BS.ByteString showPeer Peer{..} = do @@ -124,9 +102,9 @@ showPeer Peer{..} = do last_handshake_time <- readTVar lastHandshakeTime let peer = [("public_key", Just public_key), ("endpoint", BC.pack . show <$> endpoint), - ("persistant_keepalive_interval", Just . BC.pack . show $ persistant_keepalive_interval), - ("rx_bytes", Just . BC.pack . show $ rx_bytes), + ("persistent_keepalive_interval", Just . BC.pack . show $ persistant_keepalive_interval), ("tx_bytes", Just . BC.pack . show $ tx_bytes), + ("rx_bytes", Just . BC.pack . show $ rx_bytes), ("last_handshake_time", BC.pack . show <$> last_handshake_time) ] ++ expandAllowedIps (Just . BC.pack . show <$> allowed_ip) return $ serializeRpcKeyValue peer @@ -136,8 +114,10 @@ showPeer Peer{..} = do serializeRpcKeyValue :: [(String, Maybe BS.ByteString)] -> BS.ByteString serializeRpcKeyValue = foldl' showKeyValueLine BS.empty where - showKeyValueLine acc (key, Just val) = BS.concat [acc, BC.pack key, BC.singleton '=', val, BC.singleton '\n'] - showKeyValueLine acc (_, Nothing) = acc + showKeyValueLine acc (key, Just val) + | val == BC.pack "0" = acc + | otherwise = BS.concat [acc, BC.pack key, BC.singleton '=', val, BC.singleton '\n'] + showKeyValueLine acc (_, Nothing) = acc -- | implementation of config.c::set_peer() @@ -181,7 +161,6 @@ setDevice device@Device{..} WgDevice{..} = do changePSK = removePSK || devicePSK /= emptyKey changePSKTo = if removePSK then Nothing else Just (bytesToPSK devicePSK) when changePSK $ writeTVar presharedKey changePSKTo - when (changeLocalKey || changePSK) $ invalidateSessions device ipRangeToWgIpmask :: IPRange -> WgIpmask @@ -201,9 +180,6 @@ invalidValueError = 22 -- TODO: report back actual error emptyKey :: BS.ByteString emptyKey = BS.replicate keyLength 0 -testFlag :: Bits a => a -> a -> Bool -testFlag a flag = (a .&. flag) /= zeroBits - pubToBytes :: PublicKey -> BS.ByteString pubToBytes = BA.convert . DH.dhPubToBytes @@ -224,3 +200,6 @@ bytesToPSK = BA.convert toLowerBs :: BS.ByteString -> BS.ByteString toLowerBs = BC.map toLower + +testFlag :: Bits a => a -> a -> Bool +testFlag a flag = (a .&. flag) /= zeroBits diff --git a/src/Network/WireGuard/TunListener.hs b/src/Network/WireGuard/TunListener.hs index f5628e5..34b961b 100644 --- a/src/Network/WireGuard/TunListener.hs +++ b/src/Network/WireGuard/TunListener.hs @@ -14,7 +14,7 @@ import System.Posix.Types (Fd) import Network.WireGuard.Foreign.Tun import Network.WireGuard.Internal.Constant import Network.WireGuard.Internal.PacketQueue -import Network.WireGuard.Internal.Types +import Network.WireGuard.Internal.Data.Types import Network.WireGuard.Internal.Util runTunListener :: [Fd] -> PacketQueue (Time, TunPacket) -> PacketQueue TunPacket -> IO () diff --git a/src/Network/WireGuard/UdpListener.hs b/src/Network/WireGuard/UdpListener.hs index 93369f4..81743f7 100644 --- a/src/Network/WireGuard/UdpListener.hs +++ b/src/Network/WireGuard/UdpListener.hs @@ -19,7 +19,7 @@ import Network.WireGuard.Internal.State (Device (..)) import Network.WireGuard.Internal.Constant import Network.WireGuard.Internal.PacketQueue -import Network.WireGuard.Internal.Types +import Network.WireGuard.Internal.Data.Types import Network.WireGuard.Internal.Util runUdpListener :: Device -> PacketQueue UdpPacket -> PacketQueue UdpPacket -> IO () diff --git a/tests/spec/Network/WireGuard/RPCSpec.hs b/tests/spec/Network/WireGuard/RPCSpec.hs index 6d40e18..100819d 100644 --- a/tests/spec/Network/WireGuard/RPCSpec.hs +++ b/tests/spec/Network/WireGuard/RPCSpec.hs @@ -2,14 +2,18 @@ module Network.WireGuard.RPCSpec (spec) where import Control.Monad.STM (atomically, STM) import Control.Concurrent.STM.TVar (writeTVar) -import qualified Data.ByteArray as BA (convert) +import Data.Attoparsec.ByteString.Char8 (parse, eitherResult) +import qualified Data.ByteArray as BA (convert) import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BSL (ByteString, isSuffixOf) import qualified Data.ByteString.Char8 as BC (pack) import qualified Data.ByteString.Lazy.Char8 as BCL (pack) import Data.Maybe (fromJust) +import Data.HashMap.Strict as HM (fromList) import Data.Hex (unhex) -import Data.IP (AddrRange, IPv4, IPRange(..)) +import Data.IP (AddrRange, IPv4, + IPRange(..), + toHostAddress6) import qualified Crypto.Noise.DH as DH (dhBytesToPair, dhBytesToPub) import Data.Conduit (runConduit, yield, ( .|)) import Data.Conduit.Binary (sinkLbs) @@ -17,10 +21,11 @@ import Network.Socket (SockAddr(..), tupleToHostAdd import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) -import Network.WireGuard.RPC (serveConduit, showPeer) -import Network.WireGuard.Internal.State (Device(..), Peer(..), - createDevice, createPeer) -import Network.WireGuard.Internal.Types (PresharedKey) +import Network.WireGuard.RPC (serveConduit, showPeer) +import Network.WireGuard.Internal.RpcParsers (RpcDevicePayload(..), deviceParser) +import Network.WireGuard.Internal.State (Device(..), Peer(..), + createDevice, createPeer) +import Network.WireGuard.Internal.Data.Types (PresharedKey, PeerId) spec :: Spec spec = do @@ -35,29 +40,69 @@ spec = do device <- atomically devStm res <- runConduit (yield (BC.pack "\n\n") .| serveConduit device .| sinkLbs) res `shouldBe` BCL.pack "" - it "must respond to a correctly formed get v1 request" $ do + it "must respond to a correctly formed get v1 request not connected to any peer" $ do devStm <- testDevice device <- atomically devStm res <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit device .| sinkLbs) res `shouldBe` bsTestDevice chkCorrectEnd res + it "must respond to a correctly formed get v1 request connected to several peers" $ do + pubKey1 <- unhex $ BC.pack "b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33" + pubKey2 <- unhex $ BC.pack "58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376" + pubKey3 <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58" + peer1 <- atomically $ getPeer1 pubKey1 + peer2 <- atomically $ getPeer2 pubKey2 + peer3 <- atomically $ getPeer3 pubKey3 + devStm <- testDeviceWithPeers [(BC.pack "peer1", peer1), (BC.pack "peer2", peer2), (BC.pack "peer3", peer3)] + device <- atomically $ devStm + res <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit device .| sinkLbs) + res `shouldBe` bsTestDeviceWithPairs + chkCorrectEnd res describe "showPeer" $ do it "must correctly generate a complete peer bytestring containing one ip range" $ do peerPub <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58" peer <- atomically $ getTestPeerOneRange peerPub res <- atomically $ showPeer peer - res `shouldBe` BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\npersistant_keepalive_interval=0\nrx_bytes=777\ntx_bytes=778\nlast_handshake_time=1502895867\nallowed_ip=192.168.1.0/24\n" + res `shouldBe` BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\ntx_bytes=778\nrx_bytes=777\nlast_handshake_time=1502895867\nallowed_ip=192.168.1.0/24\n" it "must correctly generate a complete peer bytestring containing several ip ranges" $ do peerPub <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58" peer <- atomically $ getTestPeerTwoRanges peerPub res <- atomically $ showPeer peer - res `shouldBe` BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\npersistant_keepalive_interval=0\nrx_bytes=777\ntx_bytes=778\nlast_handshake_time=1502895867\nallowed_ip=192.168.1.0/24\nallowed_ip=192.168.2.0/24\n" + res `shouldBe` BC.pack "public_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=192.168.1.1:1337\ntx_bytes=778\nrx_bytes=777\nlast_handshake_time=1502895867\nallowed_ip=192.168.1.0/24\nallowed_ip=192.168.2.0/24\n" + describe "deviceParser" $ do + it "must parse a add device entry" $ do + pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" + let pk = DH.dhBytesToPair $ BA.convert pkHex + let expectedDevice = RpcDevicePayload pk 777 (Just 0) False + let result = parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=0\n" + eitherResult result `shouldBe` Right expectedDevice + it "must parse a remove pk device entry" $ do + let expectedDevice = RpcDevicePayload Nothing 777 (Just 0) False + let result = parse deviceParser $ BC.pack "private_key=\nlisten_port=777\nfwmark=0\n" + eitherResult result `shouldBe` Right expectedDevice + it "must parse a remove fwmark device entry" $ do + pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" + let pk = DH.dhBytesToPair $ BA.convert pkHex + let expectedDevice = RpcDevicePayload pk 777 Nothing False + let result = parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=\n" + eitherResult result `shouldBe` Right expectedDevice + it "must handle remove device flag" $ do + pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" + let pk = DH.dhBytesToPair $ BA.convert pkHex + let expectedDevice = RpcDevicePayload pk 777 Nothing True + let result = parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=\nreplace_peers=true\n" + eitherResult result `shouldBe` Right expectedDevice where testDevice = do pkH <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" pshH <- unhex $ BC.pack "188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52" return $ getTestDevice pkH pshH chkCorrectEnd bs = shouldSatisfy bs (BSL.isSuffixOf (BCL.pack "\n\n") ) + testDeviceWithPeers prs = do + pkH <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" + pshH <- unhex $ BC.pack "188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52" + return $ getTestDeviceWithPeers pkH pshH prs + getGenericPeer :: BS.ByteString -> STM Peer getGenericPeer pub = do @@ -96,10 +141,54 @@ getTestDevice pkHex pshHex = do writeTVar (port dev) 12912 return dev -bsTestDevice :: BSL.ByteString -bsTestDevice = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\nfwmark=0\n\n" +getTestDeviceWithPeers :: BS.ByteString -> BS.ByteString -> [(PeerId, Peer)] -> STM Device +getTestDeviceWithPeers pkHex pshHex prs = do + dev <- createDevice "wg0" + let keyPair = DH.dhBytesToPair $ BA.convert pkHex + let psh = Just $ BA.convert pshHex :: Maybe PresharedKey + writeTVar (localKey dev) keyPair + writeTVar (presharedKey dev) psh + writeTVar (port dev) 12912 + writeTVar (peers dev) $ HM.fromList prs + return dev + +getPeer1 :: BS.ByteString -> STM Peer +getPeer1 pubHex = do + peer <- createPeer pubKey + writeTVar (endPoint peer) . Just $ SockAddrInet6 51820 0 (toHostAddress6 $ read "abcd:23::33") 2 + writeTVar (ipmasks peer) ipRange + return peer + where + pubKey = fromJust . DH.dhBytesToPub $ BA.convert pubHex + ipRange = [IPv4Range (read "192.168.4.4/32" :: AddrRange IPv4)] +getPeer2 :: BS.ByteString -> STM Peer +getPeer2 pubHex = do + peer <- createPeer pubKey + writeTVar (endPoint peer) $ Just $ SockAddrInet 3233 $ tupleToHostAddress (182,122,22,19) + writeTVar (receivedBytes peer) 2224 + writeTVar (transferredBytes peer) 38333 + writeTVar (keepaliveInterval peer) 111 + writeTVar (ipmasks peer) ipRange + return peer + where + pubKey = fromJust . DH.dhBytesToPub $ BA.convert pubHex + ipRange = [IPv4Range (read "192.168.4.6/32" :: AddrRange IPv4)] +getPeer3 :: BS.ByteString -> STM Peer +getPeer3 pubHex = do + peer <- createPeer pubKey + writeTVar (endPoint peer) $ Just $ SockAddrInet 51820 $ tupleToHostAddress (5, 152, 198, 39) + writeTVar (receivedBytes peer) 1929999999 + writeTVar (transferredBytes peer) 1212111 + writeTVar (ipmasks peer) ipRange + return peer + where + pubKey = fromJust . DH.dhBytesToPub $ BA.convert pubHex + ipRange = [IPv4Range (read "192.168.4.10/32" :: AddrRange IPv4), + IPv4Range (read "192.168.4.11/32" :: AddrRange IPv4)] +bsTestDevice :: BSL.ByteString +bsTestDevice = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\nerrno=0\n\n" ---bsTestDeviceWithPairs :: BSL.ByteString ---bsTestDeviceWithPairs = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\npreshared_key=188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52\nallowed_ip=192.168.4.4/32\nendpoint=[abcd:23::33%2]:51820\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\ntx_bytes=38333\nrx_bytes=2224\nallowed_ip=192.168.4.6/32\npersistent_keepalive_interval=111\nendpoint=182.122.22.19:3233\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\ntx_bytes=1212111\nrx_bytes=1929999999\nerrno=0\n\n" +bsTestDeviceWithPairs :: BSL.ByteString +bsTestDeviceWithPairs = BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\nendpoint=[abcd:23::33%2]:51820\nallowed_ip=192.168.4.4/32\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\nendpoint=182.122.22.19:3233\npersistent_keepalive_interval=111\ntx_bytes=38333\nrx_bytes=2224\nallowed_ip=192.168.4.6/32\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\ntx_bytes=1212111\nrx_bytes=1929999999\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\nerrno=0\n\n" |