From b888759a791e62654a046c22221012f1cff4285a Mon Sep 17 00:00:00 2001 From: Baylac-Jacqué Félix Date: Sat, 9 Sep 2017 16:44:19 +0200 Subject: Implemented RPC parsers. --- src/Network/WireGuard/Internal/RpcParsers.hs | 167 ++++++++++++++++++++++----- 1 file changed, 136 insertions(+), 31 deletions(-) (limited to 'src/Network/WireGuard/Internal/RpcParsers.hs') diff --git a/src/Network/WireGuard/Internal/RpcParsers.hs b/src/Network/WireGuard/Internal/RpcParsers.hs index b28b000..c5179c8 100644 --- a/src/Network/WireGuard/Internal/RpcParsers.hs +++ b/src/Network/WireGuard/Internal/RpcParsers.hs @@ -1,39 +1,37 @@ {-# LANGUAGE OverloadedStrings #-} module Network.WireGuard.Internal.RpcParsers( - RpcRequest(..), - OpType(..), - RpcSetPayload(..), - RpcDevicePayload(..), - RpcPeerPayload(..), requestParser, - deviceParser + deviceParser, + peerParser ) where - import Control.Applicative ((*>), (<|>)) -import Control.Monad (liftM, join) -import Crypto.Noise.DH (dhSecToBytes, dhBytesToPair) +import Control.Monad (join) +import Crypto.Noise.DH (dhBytesToPair, dhBytesToPub) 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) + takeTill, option, + endOfLine, peekChar') +import Data.Attoparsec.Text (isEndOfLine) +import Data.Attoparsec.Combinator ((), many') +import qualified Data.ByteArray as BA (convert, ) import Data.ByteString (ByteString) -import Network.Socket.Internal (SockAddr) +import Data.ByteString.Conversion (fromByteString) +import qualified Data.ByteString.Char8 as BC (pack, unpack) +import Data.Maybe (fromMaybe, listToMaybe, + fromJust) +import Data.IP (IPRange, toHostAddress6) +import Data.Hex (unhex) +import Network.Socket (SockAddr, tupleToHostAddress, + SockAddr(..)) import Network.WireGuard.Internal.Data.RpcTypes (OpType(..), RpcRequest(..), RpcDevicePayload(..), RpcPeerPayload(..), - RpcSetPayload(..)) - + RpcSetPayload(..), + RpcDeviceField(..), + RpcPeerField(..)) -- | Attoparsec parser used to parse a RPC request, both Set or Get. requestParser :: Parser RpcRequest @@ -54,13 +52,120 @@ 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 + fields <- deviceFieldsParser + let pk = join $ listToMaybe [ pkF | RpcPk pkF <- fields] + let p = head [ pF | RpcPort pF <- fields] + let fw = join $ listToMaybe [ fwF | RpcFwMark fwF <- fields] + let rmDev = not $ null [True | RpcReplacePeers <- fields] + return $ RpcDevicePayload pk p fw rmDev + +deviceFieldsParser :: Parser [RpcDeviceField] +deviceFieldsParser = many' (deviceFieldParser <* endOfLine) + +deviceFieldParser :: Parser RpcDeviceField +deviceFieldParser = do + key <- takeTill (=='=') + _ <- "=" + case key of + "private_key" -> do + pkHex <- option Nothing (unhex <$> takeTill isEndOfLine) "Primary Key parser" + return . RpcPk . join $ (dhBytesToPair . BA.convert) <$> pkHex + "listen_port" -> do + p <- (fromMaybe 0 . fromByteString) <$> takeTill isEndOfLine "Listen Port parser" + return $ RpcPort p + "fwmark" -> do + fwmark <- option Nothing (fromByteString <$> takeTill isEndOfLine) "fwmark parser" + return $ RpcFwMark fwmark + "replace_peers" -> do + _ <- "true" + return RpcReplacePeers + _ -> fail "Not a device key" + +peerParser :: Parser RpcPeerPayload +peerParser = do + pubK <- parsePubKey + fields <- peerFieldsParser + let rm = not $ null [rmF | RpcRmFlag rmF <- fields] + let psh = listToMaybe [pshF | RpcPsh pshF <- fields] + let endPL = [endPF | RpcEndp endPF <- fields] + endP <- if null endPL + then fail "Cannot parse Peer endpoint" + else return $ head endPL + let ka = fromMaybe 0 $ listToMaybe [kaF | RpcKA kaF <- fields] + let rmIps = not $ null [rmIpsF | RpcDelIps rmIpsF <- fields] + let allIpR = [ipRF | RpcAllIp ipRF <- fields] + return $ RpcPeerPayload pubK rm psh endP ka rmIps allIpR + where + parsePubKey = do + _ <- "public_key=" "Peer delimiter" + pubHex <- unhex <$> takeTill isEndOfLine :: Parser (Maybe ByteString) + _ <- "\n" + let pubMaybe = join $ (dhBytesToPub . BA.convert) <$> pubHex + maybe (fail "Cannot parse peer's public key") return pubMaybe + +peerFieldsParser :: Parser [RpcPeerField] +peerFieldsParser = many' (peerFieldParser <* endOfLine) + +peerFieldParser :: Parser RpcPeerField +peerFieldParser = do + key <- takeTill (=='=') + _ <- "=" + case key of + "remove" -> (do + _ <- "true" + return $ RpcRmFlag True) "Remove peer parser" + "preshared_key" -> (do + pshHex <- unhex <$> takeTill isEndOfLine + return . RpcPsh . BA.convert . fromJust $ pshHex) "Psh key peer parser" + "endpoint" -> RpcEndp <$> parseIpAddress "Endpoint peer parser" + "persistent_keepalive_interval" -> (RpcKA . read . BC.unpack) <$> takeTill isEndOfLine "Persistant keepalive parser" + "replace_allowed_ips" -> (do + _ <- "true" + return $ RpcDelIps True) "Replace allowed Ips parser" + "allowed_ip" -> RpcAllIp <$> parseIpRange "Allowed ips parser" + _ -> fail "Not a peer key" + +parseIpAddress :: Parser SockAddr +parseIpAddress = do + f <- peekChar' + if f == '[' + then parseIpv6 + else parseIpv4 + where + parseIpv6 = do + _ <- "[" + host1 <- (fromJust . fromByteString) <$> takeTill (=='%') + _ <- "%" + scope_id <- (fromJust . fromByteString) <$> takeTill (==']') + _ <- "]:" + port <- (read . fromJust . fromByteString) <$> takeTill isEndOfLine + let host = toHostAddress6 $ read host1 + return $ SockAddrInet6 port 0 host scope_id + parseIpv4 = do + ip1 <- (fromJust . fromByteString) <$> takeTill (=='.') + _ <- "." + ip2 <- (fromJust . fromByteString) <$> takeTill (=='.') + _ <- "." + ip3 <- (fromJust . fromByteString) <$> takeTill (=='.') + _ <- "." + ip4 <- (fromJust . fromByteString) <$> takeTill (==':') + _ <- ":" + p <- (fromInteger . fromJust . fromByteString) <$> takeTill isEndOfLine + return . SockAddrInet p $ tupleToHostAddress (ip1,ip2,ip3,ip4) -keyParser :: ByteString -> Parser ByteString -keyParser str = (string str *> "=") *> takeTill (=='\n') +parseIpRange :: Parser IPRange +parseIpRange = do + f <- peekChar' + if f == '[' + then parseIpv6Range + else parseIpv4Range + where + parseIpv4Range = do + line <- takeTill isEndOfLine + return . read . fromJust $ fromByteString line + parseIpv6Range = do + _ <- "[" + rng <- takeTill (==']') + _ <- "]" + return . read . fromJust $ fromByteString rng + -- cgit v1.2.3-59-g8ed1b