diff options
| -rw-r--r-- | src/Network/WireGuard/RPC.hs | 106 | ||||
| -rw-r--r-- | tests/spec/Network/WireGuard/RPCSpec.hs | 20 |
2 files changed, 42 insertions, 84 deletions
diff --git a/src/Network/WireGuard/RPC.hs b/src/Network/WireGuard/RPC.hs index 6875332..0175127 100644 --- a/src/Network/WireGuard/RPC.hs +++ b/src/Network/WireGuard/RPC.hs @@ -10,52 +10,33 @@ module Network.WireGuard.RPC ) where import Control.Concurrent.STM (STM, atomically, - modifyTVar', readTVar, - writeTVar) -import Control.Monad (when) + readTVar, writeTVar) +import Control.Monad (when, unless) import Control.Monad.IO.Class (liftIO) import qualified Crypto.Noise.DH as DH (dhPubToBytes, dhSecToBytes, - dhBytesToPair, dhBytesToPair, - dhBytesToPub) -import Crypto.Noise.DH.Curve25519 (Curve25519) + dhBytesToPair, dhBytesToPair) import qualified Data.ByteArray as BA (convert) import qualified Data.ByteString as BS (ByteString, concat, - replicate, empty) -import Data.ByteString.Lazy (fromStrict) -import Data.ByteString.Conversion (toByteString') + empty) import qualified Data.ByteString.Char8 as BC (pack, singleton, map) import Data.Char (toLower) import Data.Conduit.Attoparsec (sinkParserEither) import Data.Conduit.Network.Unix (appSink, appSource, runUnixServer, serverSettings) -import qualified Data.HashMap.Strict as HM (delete, lookup, insert, - empty, elems, member) +import qualified Data.HashMap.Strict as HM (delete, lookup, insert, empty, + elems, member) import Data.Hex (hex) -import Data.Int (Int32) import Data.List (foldl') -import Data.Bits (Bits(..)) import Data.Conduit (ConduitM, (.|), yield, runConduit) -import Data.IP (IPRange(..), addrRangePair, - toHostAddress, toHostAddress6, - fromHostAddress, makeAddrRange, - fromHostAddress6) import Data.Maybe (fromJust, isJust, fromMaybe) - -import Network.WireGuard.Foreign.UAPI (WgPeer(..), WgDevice(..), - WgIpmask(..), - peerFlagRemoveMe, peerFlagReplaceIpmasks, - deviceFlagRemoveFwmark, deviceFlagReplacePeers, - deviceFlagRemovePrivateKey, deviceFlagRemovePresharedKey) -import Network.WireGuard.Internal.Constant (keyLength) import Network.WireGuard.Internal.RpcParsers (requestParser) import Network.WireGuard.Internal.State (Device(..), Peer(..), - createPeer, - invalidateSessions) + createPeer) import Network.WireGuard.Internal.Data.Types (PrivateKey, PublicKey, - PresharedKey, KeyPair) + KeyPair) import Network.WireGuard.Internal.Data.RpcTypes (RpcRequest(..), RpcSetPayload(..), OpType(..), RpcDevicePayload(..), RpcPeerPayload(..)) @@ -93,7 +74,7 @@ setDevice req dev = do when (isJust $ fwMark devReq) . writeTVar (fwmark dev) . fromJust $ fwMark devReq when (replacePeers devReq) $ delDevPeers dev let peersList = peersPayload . fromJust $ payload req - when (not $ null peersList) $ setPeers peersList dev + unless (null peersList) $ setPeers peersList dev return Nothing -- TODO: Handle errors using errno.h @@ -104,30 +85,25 @@ setPeers peerList dev = mapM_ inFunc peerList statePeers <- readTVar $ peers dev let peerPubK = pubToString $ pubK peer let peerExists = HM.member peerPubK statePeers - if remove peer + if remove peer && peerExists then removePeer peer dev - else if peerExists - then do - stmPeer <- modifyPeer peer (fromJust $ HM.lookup peerPubK statePeers) - let nPeers = HM.insert peerPubK stmPeer statePeers - writeTVar (peers dev) nPeers - else do - stmPeer <- createSTMPeer peer - let nPeers = HM.insert peerPubK stmPeer statePeers - writeTVar (peers dev) nPeers - -modifyPeer :: RpcPeerPayload -> Peer -> STM Peer -modifyPeer peer stmPeer = undefined - -createSTMPeer :: RpcPeerPayload -> STM Peer -createSTMPeer peer = do - stmPeer <- createPeer $ pubK peer + else do + stmPeer <- if peerExists + then return . fromJust $ HM.lookup peerPubK statePeers + else createPeer $ pubK peer + modifySTMPeer peer stmPeer + let nPeers = HM.insert peerPubK stmPeer statePeers + writeTVar (peers dev) nPeers + +modifySTMPeer :: RpcPeerPayload -> Peer -> STM () +modifySTMPeer peer stmPeer = do + stmPIps <- if replaceIps peer + then return [] + else readTVar $ ipmasks stmPeer writeTVar (endPoint stmPeer) . Just $ endpoint peer writeTVar (keepaliveInterval stmPeer) $ persistantKeepaliveInterval peer - writeTVar (ipmasks stmPeer) $ allowedIp peer - return stmPeer + writeTVar (ipmasks stmPeer) $ stmPIps ++ allowedIp peer - delDevPeers :: Device -> STM () delDevPeers dev = writeTVar (peers dev) HM.empty @@ -138,7 +114,7 @@ removePeer peer dev = do writeTVar (peers dev) nPeers showDevice :: Device -> STM BS.ByteString -showDevice device@Device{..} = do +showDevice Device{..} = do listen_port <- BC.pack . show <$> readTVar port fwm <- BC.pack . show <$> readTVar fwmark private_key <- fmap (toLowerBs . hex . privToBytes . fst) <$> readTVar localKey @@ -152,7 +128,6 @@ showDevice device@Device{..} = do showPeer :: Peer -> STM BS.ByteString showPeer Peer{..} = do - let hm = HM.empty let public_key = pubToString remotePub endpoint <- readTVar endPoint persistant_keepalive_interval <- readTVar keepaliveInterval @@ -179,25 +154,6 @@ serializeRpcKeyValue = foldl' showKeyValueLine BS.empty | otherwise = BS.concat [acc, BC.pack key, BC.singleton '=', val, BC.singleton '\n'] showKeyValueLine acc (_, Nothing) = acc - - -ipRangeToWgIpmask :: IPRange -> WgIpmask -ipRangeToWgIpmask (IPv4Range ipv4range) = case addrRangePair ipv4range of - (ipv4, prefix) -> WgIpmask (Left (toHostAddress ipv4)) (fromIntegral prefix) -ipRangeToWgIpmask (IPv6Range ipv6range) = case addrRangePair ipv6range of - (ipv6, prefix) -> WgIpmask (Right (toHostAddress6 ipv6)) (fromIntegral prefix) - -wgIpmaskToIpRange :: WgIpmask -> IPRange -wgIpmaskToIpRange (WgIpmask ip cidr) = case ip of - Left ipv4 -> IPv4Range $ makeAddrRange (fromHostAddress ipv4) (fromIntegral cidr) - Right ipv6 -> IPv6Range $ makeAddrRange (fromHostAddress6 ipv6) (fromIntegral cidr) - -invalidValueError :: Int32 -invalidValueError = 22 -- TODO: report back actual error - -emptyKey :: BS.ByteString -emptyKey = BS.replicate keyLength 0 - pubToBytes :: PublicKey -> BS.ByteString pubToBytes = BA.convert . DH.dhPubToBytes @@ -207,20 +163,8 @@ pubToString = toLowerBs . hex . pubToBytes privToBytes :: PrivateKey -> BS.ByteString privToBytes = BA.convert . DH.dhSecToBytes -pskToBytes :: PresharedKey -> BS.ByteString -pskToBytes = BA.convert - bytesToPair :: BS.ByteString -> Maybe KeyPair bytesToPair = DH.dhBytesToPair . BA.convert -bytesToPub :: BS.ByteString -> Maybe PublicKey -bytesToPub = DH.dhBytesToPub . BA.convert - -bytesToPSK :: BS.ByteString -> PresharedKey -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/tests/spec/Network/WireGuard/RPCSpec.hs b/tests/spec/Network/WireGuard/RPCSpec.hs index aae0678..a69a9b5 100644 --- a/tests/spec/Network/WireGuard/RPCSpec.hs +++ b/tests/spec/Network/WireGuard/RPCSpec.hs @@ -82,18 +82,32 @@ spec = do dev `shouldBe` BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\nfwmark=1\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\nendpoint=[abcd:23::33%2]:51820\nallowed_ip=192.168.4.4/32\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\nendpoint=182.122.22.19:3233\npersistent_keepalive_interval=111\nallowed_ip=192.168.4.6/32\nerrno=0\n\n" it "must repond to a correctly formed set device's peers V1 request with one peer remove instruction" $ do pk <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" - let devStm = getSetTestDevice pk 777 1 + 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 + let devStm = getSetTestDeviceWithPeers pk 777 1 [(BC.pack "b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33",peer1),(BC.pack "58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376",peer2),(BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58",peer3)] dev <- atomically devStm + err <- runConduit (yield (BC.pack "set=1\nprivate_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\nremove=true\nendpoint=[abcd:23::33%2]:51820\nallowed_ip=192.168.4.4/32\n\n") .| serveConduit dev .| sinkLbs) + err `shouldBe` BCL.pack "errno=0\n\n" + dev <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit dev .| sinkLbs) + dev `shouldBe` BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\nfwmark=1\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\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\nerrno=0\n\n" + it "must repond to a correctly formed set device's peers V1 request with one peer alter instruction" $ do + pk <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" 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 - err <- runConduit (yield (BC.pack "set=1\nprivate_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\nremove=true\nendpoint=[abcd:23::33%2]:51820\nallowed_ip=192.168.4.4/32\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\nendpoint=182.122.22.19:3233\npersistent_keepalive_interval=111\nallowed_ip=192.168.4.6/32\n\n") .| serveConduit dev .| sinkLbs) + let devStm = getSetTestDeviceWithPeers pk 777 1 [(BC.pack "b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33",peer1),(BC.pack "58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376",peer2),(BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58",peer3)] + dev <- atomically devStm + err <- runConduit (yield (BC.pack "set=1\nprivate_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\npublic_key=b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33\nremove=true\nendpoint=[abcd:23::33%2]:51820\nallowed_ip=192.168.4.4/32\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\nendpoint=182.122.22.19:3233\npersistent_keepalive_interval=111\nallowed_ip=192.168.5.6/32\n\n") .| serveConduit dev .| sinkLbs) err `shouldBe` BCL.pack "errno=0\n\n" dev <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit dev .| sinkLbs) - dev `shouldBe` BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\nfwmark=1\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/32\npublic_key=58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376\nendpoint=182.122.22.19:3233\npersistent_keepalive_interval=111\nallowed_ip=192.168.4.6/32\nerrno=0\n\n" + dev `shouldBe` BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=12912\nfwmark=1\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\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/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\nallowed_ip=192.168.5.6/32\nerrno=0\n\n" it "must repond to a correctly formed delete device's peers set V1 request" $ do pubKey1 <- unhex $ BC.pack "b85996fecc9c7f1fc6d2572a76eda11d59bcd20be8e543b15ce4bd85a8e75a33" pubKey2 <- unhex $ BC.pack "58402e695ba1772b1cc9309755f043251ea77fdcf10fbe63989ceb7e19321376" |