aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network/WireGuard/RPC.hs
diff options
context:
space:
mode:
authorBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-16 16:54:24 +0200
committerBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-16 17:11:53 +0200
commit4cc3292d6c59e48f22cbcaae0ee2773c22c2bad9 (patch)
treeacf8f8b90892625b423d2a7a62a80f09fde39edb /src/Network/WireGuard/RPC.hs
parentFix GHC and HLINT warnings. (diff)
downloadwireguard-hs-4cc3292d6c59e48f22cbcaae0ee2773c22c2bad9.tar.xz
wireguard-hs-4cc3292d6c59e48f22cbcaae0ee2773c22c2bad9.zip
Document RPC-related modules.HEADmaster
Diffstat (limited to 'src/Network/WireGuard/RPC.hs')
-rw-r--r--src/Network/WireGuard/RPC.hs101
1 files changed, 58 insertions, 43 deletions
diff --git a/src/Network/WireGuard/RPC.hs b/src/Network/WireGuard/RPC.hs
index 0175127..8fc6e82 100644
--- a/src/Network/WireGuard/RPC.hs
+++ b/src/Network/WireGuard/RPC.hs
@@ -1,10 +1,21 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module : Network.WireGuard.RPC
+Description : Wireguard's RPC protocol implementation.
+Copyright : Félix Baylac-Jacqué, 2017
+License : GPL-3
+Maintainer : felix@alternativebit.fr
+Stability : experimental
+Portability : POSIX
+
+Wireguard's RPC protocol implementation. This module contains
+the various operation needed to communicate with the wg CLI utility.
+|-}
module Network.WireGuard.RPC
( runRPC,
serveConduit,
- bytesToPair,
showDevice,
showPeer
) where
@@ -13,8 +24,7 @@ import Control.Concurrent.STM (STM, atomically,
readTVar, writeTVar)
import Control.Monad (when, unless)
import Control.Monad.IO.Class (liftIO)
-import qualified Crypto.Noise.DH as DH (dhPubToBytes, dhSecToBytes,
- dhBytesToPair, dhBytesToPair)
+import qualified Crypto.Noise.DH as DH (dhPubToBytes, dhSecToBytes)
import qualified Data.ByteArray as BA (convert)
import qualified Data.ByteString as BS (ByteString, concat,
empty)
@@ -35,26 +45,27 @@ import Data.Maybe (fromJust, isJust,
import Network.WireGuard.Internal.RpcParsers (requestParser)
import Network.WireGuard.Internal.State (Device(..), Peer(..),
createPeer)
-import Network.WireGuard.Internal.Data.Types (PrivateKey, PublicKey,
- KeyPair)
+import Network.WireGuard.Internal.Data.Types (PrivateKey, PublicKey)
import Network.WireGuard.Internal.Data.RpcTypes (RpcRequest(..), RpcSetPayload(..),
OpType(..), RpcDevicePayload(..),
RpcPeerPayload(..))
import Network.WireGuard.Internal.Util (catchIOExceptionAnd)
+--TODO: return appropriate errno during set operations.
+
-- | Run RPC service over a unix socket
runRPC :: FilePath -> Device -> IO ()
runRPC sockPath device = runUnixServer (serverSettings sockPath) $ \app ->
catchIOExceptionAnd (return ()) $
runConduit (appSource app .| serveConduit device .| appSink app)
-
--- TODO: ensure that all bytestring over sockets will be erased
+
+-- | Process a stream coming from a unix socket and writes back the
+-- appropriate response.
serveConduit :: Device -> ConduitM BS.ByteString BS.ByteString IO ()
serveConduit device = do
request <- sinkParserEither requestParser
routeRequest request
where
- --returnError = yield $ writeConfig (-invalidValueError)
routeRequest (Left _) = yield mempty
routeRequest (Right req) =
case opType req of
@@ -66,6 +77,45 @@ serveConduit device = do
deviceBstr <- liftIO . atomically $ showDevice device
yield $ BS.concat [deviceBstr, BC.pack "errno=0\n\n"]
+-- | Print a device in a bytestring according to wireguard's RPC format.
+--
+-- More infos about this format on this page <https://www.wireguard.com/xplatform/>
+showDevice :: Device -> STM BS.ByteString
+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
+ let devHm = [("private_key", private_key),
+ ("listen_port", Just listen_port),
+ ("fwmark", Just fwm)]
+ let devBs = serializeRpcKeyValue devHm
+ prs <- readTVar peers
+ peersBstrList <- mapM showPeer $ HM.elems prs
+ return . BS.concat $ (devBs : peersBstrList)
+
+-- | Print a peer in a bytestring according to wireguard's RPC format.
+--
+-- More infos about this format on this page <https://www.wireguard.com/xplatform/>
+showPeer :: Peer -> STM BS.ByteString
+showPeer Peer{..} = do
+ let public_key = pubToString remotePub
+ endpoint <- readTVar endPoint
+ persistant_keepalive_interval <- readTVar keepaliveInterval
+ allowed_ip <- readTVar ipmasks
+ rx_bytes <- readTVar receivedBytes
+ tx_bytes <- readTVar transferredBytes
+ last_handshake_time <- readTVar lastHandshakeTime
+ let peer = [("public_key", Just public_key),
+ ("endpoint", BC.pack . show <$> endpoint),
+ ("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
+ where
+ expandAllowedIps = foldr (\val acc -> ("allowed_ip", val):acc) []
+
setDevice :: RpcRequest -> Device -> STM (Maybe BS.ByteString)
setDevice req dev = do
let devReq = devicePayload . fromJust $ payload req
@@ -113,38 +163,6 @@ removePeer peer dev = do
let nPeers = HM.delete (pubToString $ pubK peer) currentPeers
writeTVar (peers dev) nPeers
-showDevice :: Device -> STM BS.ByteString
-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
- let devHm = [("private_key", private_key),
- ("listen_port", Just listen_port),
- ("fwmark", Just fwm)]
- let devBs = serializeRpcKeyValue devHm
- prs <- readTVar peers
- peersBstrList <- mapM showPeer $ HM.elems prs
- return . BS.concat $ (devBs : peersBstrList)
-
-showPeer :: Peer -> STM BS.ByteString
-showPeer Peer{..} = do
- let public_key = pubToString remotePub
- endpoint <- readTVar endPoint
- persistant_keepalive_interval <- readTVar keepaliveInterval
- allowed_ip <- readTVar ipmasks
- rx_bytes <- readTVar receivedBytes
- tx_bytes <- readTVar transferredBytes
- last_handshake_time <- readTVar lastHandshakeTime
- let peer = [("public_key", Just public_key),
- ("endpoint", BC.pack . show <$> endpoint),
- ("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
- where
- expandAllowedIps = foldr (\val acc -> ("allowed_ip", val):acc) []
serializeRpcKeyValue :: [(String, Maybe BS.ByteString)] -> BS.ByteString
serializeRpcKeyValue = foldl' showKeyValueLine BS.empty
@@ -163,8 +181,5 @@ pubToString = toLowerBs . hex . pubToBytes
privToBytes :: PrivateKey -> BS.ByteString
privToBytes = BA.convert . DH.dhSecToBytes
-bytesToPair :: BS.ByteString -> Maybe KeyPair
-bytesToPair = DH.dhBytesToPair . BA.convert
-
toLowerBs :: BS.ByteString -> BS.ByteString
toLowerBs = BC.map toLower