diff options
author | Baylac-Jacqué Félix <felix@alternativebit.fr> | 2017-08-17 16:11:33 +0200 |
---|---|---|
committer | Baylac-Jacqué Félix <felix@alternativebit.fr> | 2017-09-16 17:10:35 +0200 |
commit | e36a4cf345fede7f8b9f6a57ac842bf48fd9c068 (patch) | |
tree | 052c4f45baf7edd5e7e574da246b3740bdf85358 /src | |
parent | Implement and test RPC show Peer feature. (diff) | |
download | wireguard-hs-e36a4cf345fede7f8b9f6a57ac842bf48fd9c068.tar.xz wireguard-hs-e36a4cf345fede7f8b9f6a57ac842bf48fd9c068.zip |
Extracted RPC types to proper module.
Diffstat (limited to '')
-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 |
10 files changed, 172 insertions, 64 deletions
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 () |