1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : Network.WireGuard.Internal.RpcParsers
Description : Collection of parsers related to the communication with the wg CLI utility.
Copyright : Félix Baylac-Jacqué, 2017
License : GPL-3
Maintainer : felix@alternativebit.fr
Stability : experimental
Portability : POSIX
Collection of attoparsec parsers related to the communication with the wg CLI utility.
|-}
module Network.WireGuard.Internal.RpcParsers(
requestParser,
deviceParser,
peerParser,
setPayloadParser
) where
import Control.Applicative ((*>), (<|>))
import Control.Monad (join)
import Crypto.Noise.DH (dhBytesToPair, dhBytesToPub)
import Data.Attoparsec.ByteString.Char8 (Parser, string,
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 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(..),
RpcDeviceField(..),
RpcPeerField(..))
-- | Parses a RPC operation coming from the wg CLI.
--
-- See <https://www.wireguard.com/xplatform/> for more informations about the RPC set operation.
requestParser :: Parser RpcRequest
requestParser = do
op <- requestTypeParser
p <- case op of
Set -> Just <$> setPayloadParser
Get -> return Nothing
_ <- string $ BC.pack "\n"
return $ RpcRequest op p
-- | Parses a set operation.
--
-- See <https://www.wireguard.com/xplatform/> for more informations about the RPC set operation.
setPayloadParser :: Parser RpcSetPayload
setPayloadParser = do
dev <- deviceParser
peers <- many' peerParser
return $ RpcSetPayload dev peers
-- | Parses a device entry during a RPC set operation.
--
-- See <https://www.wireguard.com/xplatform/> for more informations about the RPC set operation.
deviceParser :: Parser RpcDevicePayload
deviceParser = do
fields <- deviceFieldsParser
let devPk = 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 devPk p fw rmDev
-- | Parses a peer entry during a RPC set operation.
--
-- See <https://www.wireguard.com/xplatform/> for more informations about the RPC set operation.
peerParser :: Parser RpcPeerPayload
peerParser = do
peerPubK <- 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 peerPubK 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
requestTypeParser :: Parser OpType
requestTypeParser = "get=1\n" *> return Get
<|> "set=1\n" *> return Set
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"
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)
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
|
