diff options
| -rw-r--r-- | src/Network/WireGuard/RPC.hs | 118 | ||||
| -rw-r--r-- | tests/spec/Network/WireGuard/RPCSpec.hs | 69 |
2 files changed, 136 insertions, 51 deletions
diff --git a/src/Network/WireGuard/RPC.hs b/src/Network/WireGuard/RPC.hs index 162b5b4..6875332 100644 --- a/src/Network/WireGuard/RPC.hs +++ b/src/Network/WireGuard/RPC.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module Network.WireGuard.RPC ( runRPC, @@ -16,17 +17,20 @@ import Control.Monad.IO.Class (liftIO) import qualified Crypto.Noise.DH as DH (dhPubToBytes, dhSecToBytes, dhBytesToPair, dhBytesToPair, dhBytesToPub) +import Crypto.Noise.DH.Curve25519 (Curve25519) 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') 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) +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') @@ -37,7 +41,8 @@ import Data.IP (IPRange(..), addrRan toHostAddress, toHostAddress6, fromHostAddress, makeAddrRange, fromHostAddress6) -import Data.Maybe (fromJust, isJust) +import Data.Maybe (fromJust, isJust, + fromMaybe) import Network.WireGuard.Foreign.UAPI (WgPeer(..), WgDevice(..), WgIpmask(..), @@ -52,7 +57,8 @@ import Network.WireGuard.Internal.State (Device(..), Peer(..) import Network.WireGuard.Internal.Data.Types (PrivateKey, PublicKey, PresharedKey, KeyPair) import Network.WireGuard.Internal.Data.RpcTypes (RpcRequest(..), RpcSetPayload(..), - OpType(..)) + OpType(..), RpcDevicePayload(..), + RpcPeerPayload(..)) import Network.WireGuard.Internal.Util (catchIOExceptionAnd) -- | Run RPC service over a unix socket @@ -71,11 +77,66 @@ serveConduit device = do routeRequest (Left _) = yield mempty routeRequest (Right req) = case opType req of - Set -> undefined + Set -> do + err <- liftIO . atomically $ setDevice req device + let errno = fromMaybe "0" err + yield $ BS.concat [BC.pack "errno=", errno, BC.pack "\n\n"] Get -> do deviceBstr <- liftIO . atomically $ showDevice device yield $ BS.concat [deviceBstr, BC.pack "errno=0\n\n"] +setDevice :: RpcRequest -> Device -> STM (Maybe BS.ByteString) +setDevice req dev = do + let devReq = devicePayload . fromJust $ payload req + when (isJust $ pk devReq) . writeTVar (localKey dev) $ pk devReq + writeTVar (port dev) $ listenPort devReq + 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 + return Nothing + -- TODO: Handle errors using errno.h + +setPeers :: [RpcPeerPayload] -> Device -> STM () +setPeers peerList dev = mapM_ inFunc peerList + where + inFunc peer = do + statePeers <- readTVar $ peers dev + let peerPubK = pubToString $ pubK peer + let peerExists = HM.member peerPubK statePeers + if remove peer + 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 + writeTVar (endPoint stmPeer) . Just $ endpoint peer + writeTVar (keepaliveInterval stmPeer) $ persistantKeepaliveInterval peer + writeTVar (ipmasks stmPeer) $ allowedIp peer + return stmPeer + + +delDevPeers :: Device -> STM () +delDevPeers dev = writeTVar (peers dev) HM.empty + +removePeer :: RpcPeerPayload -> Device -> STM () +removePeer peer dev = do + currentPeers <- readTVar $ peers dev + let nPeers = HM.delete (pubToString $ pubK peer) currentPeers + writeTVar (peers dev) nPeers + showDevice :: Device -> STM BS.ByteString showDevice device@Device{..} = do listen_port <- BC.pack . show <$> readTVar port @@ -92,7 +153,7 @@ showDevice device@Device{..} = do showPeer :: Peer -> STM BS.ByteString showPeer Peer{..} = do let hm = HM.empty - let public_key = toLowerBs . hex $ pubToBytes remotePub + let public_key = pubToString remotePub endpoint <- readTVar endPoint persistant_keepalive_interval <- readTVar keepaliveInterval allowed_ip <- readTVar ipmasks @@ -119,48 +180,6 @@ serializeRpcKeyValue = foldl' showKeyValueLine BS.empty showKeyValueLine acc (_, Nothing) = acc --- | implementation of config.c::set_peer() -setPeer :: Device -> WgPeer -> [IPRange] -> STM Bool -setPeer Device{..} WgPeer{..} ipranges - | peerPubKey == emptyKey = return False - | testFlag peerFlags peerFlagRemoveMe = modifyTVar' peers (HM.delete peerPubKey) >> return False - | otherwise = do - peers' <- readTVar peers - Peer{..} <- case HM.lookup peerPubKey peers' of - Nothing -> do - newPeer <- createPeer (fromJust $ bytesToPub peerPubKey) -- TODO: replace fromJust - modifyTVar' peers (HM.insert peerPubKey newPeer) - return newPeer - Just p -> return p - when (isJust peerAddr) $ writeTVar endPoint peerAddr - let replaceIpmasks = testFlag peerFlags peerFlagReplaceIpmasks - changeIpmasks = replaceIpmasks || not (null ipranges) - when changeIpmasks $ - if replaceIpmasks - then writeTVar ipmasks ipranges - else modifyTVar' ipmasks (++ipranges) - when (peerKeepaliveInterval /= complement 0) $ - writeTVar keepaliveInterval (fromIntegral peerKeepaliveInterval) - return changeIpmasks - --- | implementation of config.c::config_set_device() -setDevice :: Device -> WgDevice -> STM () -setDevice device@Device{..} WgDevice{..} = do - when (deviceFwmark /= 0 || deviceFwmark == 0 && testFlag deviceFlags deviceFlagRemoveFwmark) $ - writeTVar fwmark (fromIntegral deviceFwmark) - when (devicePort /= 0) $ writeTVar port (fromIntegral devicePort) - when (testFlag deviceFlags deviceFlagReplacePeers) $ writeTVar peers HM.empty - - let removeLocalKey = testFlag deviceFlags deviceFlagRemovePrivateKey - changeLocalKey = removeLocalKey || devicePrivkey /= emptyKey - changeLocalKeyTo = if removeLocalKey then Nothing else bytesToPair devicePrivkey - when changeLocalKey $ writeTVar localKey changeLocalKeyTo - - let removePSK = testFlag deviceFlags deviceFlagRemovePresharedKey - 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 ipRangeToWgIpmask (IPv4Range ipv4range) = case addrRangePair ipv4range of @@ -182,6 +201,9 @@ emptyKey = BS.replicate keyLength 0 pubToBytes :: PublicKey -> BS.ByteString pubToBytes = BA.convert . DH.dhPubToBytes +pubToString :: PublicKey -> BS.ByteString +pubToString = toLowerBs . hex . pubToBytes + privToBytes :: PrivateKey -> BS.ByteString privToBytes = BA.convert . DH.dhSecToBytes diff --git a/tests/spec/Network/WireGuard/RPCSpec.hs b/tests/spec/Network/WireGuard/RPCSpec.hs index e0c3e87..aae0678 100644 --- a/tests/spec/Network/WireGuard/RPCSpec.hs +++ b/tests/spec/Network/WireGuard/RPCSpec.hs @@ -59,11 +59,54 @@ spec = do 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)] + let 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 + it "must respond to a correctly formed set device v1 request" $ do + pk <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" + let devStm = getSetTestDevice pk 777 1 + device <- atomically devStm + err <- runConduit (yield (BC.pack "set=1\nprivate_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=1\n\n") .| serveConduit device .| sinkLbs) + err `shouldBe` BCL.pack "errno=0\n\n" + dev <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit device .| sinkLbs) + dev `shouldBe` BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=1\nerrno=0\n\n" + it "must repond to a correctly formed set device's peers V1 request" $ do + pk <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" + let devStm = getSetTestDevice pk 777 1 + dev <- atomically devStm + err <- runConduit (yield (BC.pack "set=1\nprivate_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\nallowed_ip=192.168.4.6/32\npublic_key=662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58\nendpoint=5.152.198.39:51820\nallowed_ip=192.168.4.10/32\nallowed_ip=192.168.4.11/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=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 + dev <- atomically devStm + 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) + 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" + 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" + pubKey3 <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58" + peer1 <- atomically $ getPeer1 pubKey1 + peer2 <- atomically $ getPeer2 pubKey2 + peer3 <- atomically $ getPeer3 pubKey3 + let devStm = testDeviceWithPeers [(BC.pack "peer1", peer1), (BC.pack "peer2", peer2), (BC.pack "peer3", peer3)] + deviceWithPeers <- atomically devStm + err <- runConduit (yield (BC.pack "set=1\nprivate_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=1\nreplace_peers=true\n\n") .| serveConduit deviceWithPeers .| sinkLbs) + err `shouldBe` BCL.pack "errno=0\n\n" + dev <- runConduit (yield (BC.pack "get=1\n\n") .| serveConduit deviceWithPeers .| sinkLbs) + dev `shouldBe` BCL.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=1\nerrno=0\n\n" describe "showPeer" $ do it "must correctly generate a complete peer bytestring containing one ip range" $ do peerPub <- unhex $ BC.pack "662e14fd594556f522604703340351258903b64f35553763f19426ab2a515c58" @@ -87,7 +130,7 @@ spec = do let result = feed (parse deviceParser $ BC.pack "private_key=\nlisten_port=777\nfwmark=0\n") BC.empty eitherResult result `shouldBe` Right expectedDevice it "must parse a remove fwmark device entry" $ do - pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" + pkHex <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" let pk = DH.dhBytesToPair $ BA.convert pkHex let expectedDevice = RPC.RpcDevicePayload pk 777 Nothing False let result = feed (parse deviceParser $ BC.pack "private_key=e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a\nlisten_port=777\nfwmark=\n") BC.empty @@ -199,7 +242,7 @@ spec = do testDeviceWithPeers prs = do pkH <- unhex $ BC.pack "e84b5a6d2717c1003a13b431570353dbaca9146cf150c5f8575680feba52027a" pshH <- unhex $ BC.pack "188515093e952f5f22e865cef3012e72f8b5f0b598ac0309d5dacce3b70fcf52" - return $ getTestDeviceWithPeers pkH pshH prs + getTestDeviceWithPeers pkH pshH prs getGenericPeer :: BS.ByteString -> STM Peer @@ -239,6 +282,25 @@ getTestDevice pkHex pshHex = do writeTVar (port dev) 12912 return dev +getSetTestDevice :: BS.ByteString -> Int -> Word -> STM Device +getSetTestDevice pkHex p fwm = do + dev <- createDevice "wg0" + let keyPair = DH.dhBytesToPair $ BA.convert pkHex + writeTVar (localKey dev) keyPair + writeTVar (fwmark dev) fwm + writeTVar (port dev) p + return dev + +getSetTestDeviceWithPeers :: BS.ByteString -> Int -> Word -> [(PeerId, Peer)] -> STM Device +getSetTestDeviceWithPeers pkHex p fwm prs = do + dev <- createDevice "wg0" + let keyPair = DH.dhBytesToPair $ BA.convert pkHex + writeTVar (localKey dev) keyPair + writeTVar (fwmark dev) fwm + writeTVar (port dev) p + writeTVar (peers dev) $ HM.fromList prs + return dev + getTestDeviceWithPeers :: BS.ByteString -> BS.ByteString -> [(PeerId, Peer)] -> STM Device getTestDeviceWithPeers pkHex pshHex prs = do dev <- createDevice "wg0" @@ -259,6 +321,7 @@ getPeer1 pubHex = do 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 |