From f3061edf5943454d17bc9db7e431327736a2745b Mon Sep 17 00:00:00 2001 From: Baylac-Jacqué Félix Date: Thu, 10 Aug 2017 17:08:36 +0200 Subject: Make imports in RPC.hs explicit. --- src/Network/WireGuard/RPC.hs | 103 ++++++++++++++++++++++++------------------- 1 file changed, 57 insertions(+), 46 deletions(-) (limited to 'src/Network') 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') -- cgit v1.2.3-59-g8ed1b