aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network/WireGuard
diff options
context:
space:
mode:
authorBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-14 15:38:29 +0200
committerBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-16 17:11:27 +0200
commit9fe8c0f80dafd297fa7828095241b5be005432de (patch)
tree198dd79f111662e122e3bb3ba60b050cc7261a7c /src/Network/WireGuard
parentImplemented rpc request parser. (diff)
downloadwireguard-hs-9fe8c0f80dafd297fa7828095241b5be005432de.tar.xz
wireguard-hs-9fe8c0f80dafd297fa7828095241b5be005432de.zip
Wire up RPC set parsers to STM state.
Diffstat (limited to 'src/Network/WireGuard')
-rw-r--r--src/Network/WireGuard/RPC.hs118
1 files changed, 70 insertions, 48 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