aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network
diff options
context:
space:
mode:
authorBaylac-Jacqué Félix <felix@alternativebit.fr>2017-08-10 17:08:36 +0200
committerBaylac-Jacqué Félix <felix@alternativebit.fr>2017-09-16 17:09:23 +0200
commitf3061edf5943454d17bc9db7e431327736a2745b (patch)
tree660454b7b52ea3af6e5af8f22630874f20ae2e3a /src/Network
parentSetup travis CI. (diff)
downloadwireguard-hs-f3061edf5943454d17bc9db7e431327736a2745b.tar.xz
wireguard-hs-f3061edf5943454d17bc9db7e431327736a2745b.zip
Make imports in RPC.hs explicit.
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/WireGuard/RPC.hs103
1 files changed, 57 insertions, 46 deletions
diff --git a/src/Network/WireGuard/RPC.hs b/src/Network/WireGuard/RPC.hs
index 3aa4e44..76f5d63 100644
--- a/src/Network/WireGuard/RPC.hs
+++ b/src/Network/WireGuard/RPC.hs
@@ -5,37 +5,52 @@ module Network.WireGuard.RPC
serveConduit
) where
-import Control.Concurrent.STM (STM, atomically,
- modifyTVar', readTVar,
- writeTVar)
-import Control.Monad (replicateM, sequence,
- when)
-import Control.Monad.IO.Class (liftIO)
-import qualified Crypto.Noise.DH as DH
-import qualified Data.ByteArray as BA
-import qualified Data.ByteString as BS
-import qualified Data.Conduit.Binary as CB
-import Data.Conduit.Network.Unix (appSink, appSource,
- runUnixServer,
- serverSettings)
-import qualified Data.HashMap.Strict as HM
-import Data.Int (Int32)
-import Data.List (genericLength)
-import Foreign.C.Types (CTime (..))
-
-import Data.Bits
-import Data.Conduit
-import Data.IP
-import Data.Maybe
-
-import Network.WireGuard.Foreign.UAPI
-import Network.WireGuard.Internal.Constant
-import Network.WireGuard.Internal.State
-import Network.WireGuard.Internal.Types
-import Network.WireGuard.Internal.Util (catchIOExceptionAnd,
- catchSomeExceptionAnd)
-
-import Debug.Trace
+import Control.Concurrent.STM (STM, atomically,
+ modifyTVar', readTVar,
+ writeTVar)
+import Control.Monad (replicateM, sequence,
+ 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)
+import qualified Data.ByteString.Lazy.Char8 as CL (pack)
+import qualified Data.Conduit.Binary as CB (sinkStorable, take)
+import Data.Conduit.Network.Unix (appSink, appSource,
+ runUnixServer,
+ serverSettings)
+import qualified Data.HashMap.Strict as HM (size, delete,
+ lookup, insert,
+ empty)
+import Data.Int (Int32)
+import Data.List (genericLength)
+import Foreign.C.Types (CTime (..))
+
+import Data.Bits (Bits(..))
+import Data.Conduit (ConduitM, (.|),
+ yield, runConduit)
+import Data.IP (IPRange(..), addrRangePair,
+ toHostAddress, toHostAddress6,
+ fromHostAddress, makeAddrRange,
+ fromHostAddress6)
+import Data.Maybe (fromMaybe, fromJust, isJust)
+
+import Network.WireGuard.Foreign.UAPI (WgPeer(..), WgDevice(..),
+ WgIpmask(..), writeConfig,
+ peerFlagRemoveMe, peerFlagReplaceIpmasks,
+ deviceFlagRemoveFwmark, deviceFlagReplacePeers,
+ deviceFlagRemovePrivateKey, deviceFlagRemovePresharedKey)
+import Network.WireGuard.Internal.Constant (keyLength)
+import Network.WireGuard.Internal.State (Device(..), Peer(..),
+ buildRouteTables, createPeer,
+ invalidateSessions)
+import Network.WireGuard.Internal.Types (PrivateKey, PublicKey,
+ PresharedKey, KeyPair)
+import Network.WireGuard.Internal.Util (catchIOExceptionAnd)
+
-- | Run RPC service over a unix socket
runRPC :: FilePath -> Device -> IO ()
runRPC sockPath device = runUnixServer (serverSettings sockPath) $ \app ->
@@ -44,19 +59,15 @@ 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
- h <- CB.head
- traceM $ "Received " ++ show h
- case h of
- Just 0 -> showDevice device
- Just byte -> do
- leftover (BS.singleton byte)
- mWgdev <- CB.sinkStorable
- case mWgdev of
- Just wgdev -> catchSomeExceptionAnd returnError (updateDevice wgdev)
- Nothing -> mempty
- Nothing -> mempty
+ line <- CB.take 5
+ case () of _
+ | isGet line -> showDevice device
+ | isSet line -> undefined
+ | otherwise -> mempty
where
- returnError = yield $ writeConfig (-invalidValueError)
+ --returnError = yield $ writeConfig (-invalidValueError)
+ isGet = (== CL.pack "get=1")
+ isSet = (== CL.pack "set=1")
showDevice Device{..} = do
(wgdevice, peers') <- liftIO buildWgDevice
@@ -68,10 +79,10 @@ serveConduit device = do
let (pub, priv) = case localKey' of
Nothing -> (emptyKey, emptyKey)
Just (sec, pub') -> (pubToBytes pub', privToBytes sec)
- psk' <- fmap pskToBytes <$> readTVar presharedKey
+ psk' <- fmap pskToBytes <$> readTVar presharedKey
fwmark' <- fromIntegral <$> readTVar fwmark
- port' <- fromIntegral <$> readTVar port
- peers' <- readTVar peers
+ port' <- fromIntegral <$> readTVar port
+ peers' <- readTVar peers
return (WgDevice intfName 0 pub priv (fromMaybe emptyKey psk')
fwmark' port' (fromIntegral $ HM.size peers'), peers')