aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network/WireGuard
diff options
context:
space:
mode:
authorBaylac-Jacqué Félix <felix@alternativebit.fr>2017-08-17 16:11:33 +0200
committerBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-16 17:10:35 +0200
commite36a4cf345fede7f8b9f6a57ac842bf48fd9c068 (patch)
tree052c4f45baf7edd5e7e574da246b3740bdf85358 /src/Network/WireGuard
parentImplement and test RPC show Peer feature. (diff)
downloadwireguard-hs-e36a4cf345fede7f8b9f6a57ac842bf48fd9c068.tar.xz
wireguard-hs-e36a4cf345fede7f8b9f6a57ac842bf48fd9c068.zip
Extracted RPC types to proper module.
Diffstat (limited to 'src/Network/WireGuard')
-rw-r--r--src/Network/WireGuard/Core.hs2
-rw-r--r--src/Network/WireGuard/Internal/Data/RpcTypes.hs63
-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.hs2
-rw-r--r--src/Network/WireGuard/Internal/Packet.hs2
-rw-r--r--src/Network/WireGuard/Internal/RpcParsers.hs66
-rw-r--r--src/Network/WireGuard/Internal/State.hs2
-rw-r--r--src/Network/WireGuard/RPC.hs93
-rw-r--r--src/Network/WireGuard/TunListener.hs2
-rw-r--r--src/Network/WireGuard/UdpListener.hs2
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 ()