Description: An emebedded domain specific language for Haskell to describe tc firewall rules for Linux
Authored: 2021-10-20;
Permalink: https://adamflott.com/programming/haskell/tc-firewall-dsl/
tags :
dsl;
haskell;
linux;
networking;
tc;
categories :
programming;
A typed and embedded DSL in Haskell to describe iproute2's tc (Traffic Control) firewall rules for Linux
tc is one of the more complicated utilities to get the command arguments correct. For example1
tc filter add dev eth0.5 parent 1: protocol ip prio 10 u32 \
match ip src 195.69.208.252/32 flowid 1:16 \
action police rate 64kbit burst 64k conform-exceed pipe/continue \
action mirred egress redirect dev eth0.6
In order to understand that it would take you to read, understand, and remember the content across 602 man pages with 100s3 of options.
Not to mention debugging is a pain, this is about as useful information you will get when a tc
rule fails
Error: Specified filter kind does not match existing one.
We have an error talking to the kernel
In order to safely represent the possible combinations, the possible arguments need to be typed.
A limited example:
data TCRule
= TCRuleQDiscI TCRuleQDisc
| TCRuleFilterI TCRuleFilter
| TCActionsI TCActions
deriving stock (Eq, Generic, Show)
Haskell's relaxed syntax and monadic abilities are a great fit for embedded DSLs
For example this drop all ingress rule:
filter add dev eth0 ingress priority 1 protocol ipv4 flower ip_proto tcp src_ip 10.0.0.0/24 dst_port 443 action pass
filter add dev eth0 ingress priority 1 protocol ipv4 flower ip_proto udp src_ip 10.0.0.0/24 dst_port 443 action pass
filter add dev eth0 ingress priority 2 flower action drop
Can be represented as a function in Haskell like:
openHTTPSPort :: IP -> TCRule
openHTTPSPort ip = do
forM_ [ tcp, udp] \p -> do
filter add ingress
do
priority 1
protocol ipv4
flower do
ip_proto p
src_ip ip
dst_port 443
action [pass]
denyAll :: TCRule
denyAll = filter add ingress
do
priority 2
flower do
action [drop]
We gain a few features when the rules are runnable code:
Many of the "reserved words" are simple functions in a State-based monad.
src_ip :: IP -> TCFlowerM ()
src_ip ip = _addKey (KeyIP Src ip)
This does require a richer set of networking types to keep the values legal.
By default if no handle is supplied tc
will generate a unique for us. For the example above we get 43
$ sudo tc -s filter show dev macvtap1 ingress
...
filter protocol ip pref 1 flower chain 0 handle 0x1
eth_type ipv4
ip_proto tcp
src_ip 10.0.0.0/24
dst_port 443
not_in_hw
action order 1: gact action pass
random type none pass val 0
index 43 ref 1 bind 1 installed 20 sec used 20 sec
Action statistics:
Sent 0 bytes 0 pkt (dropped 0, overlimits 0 requeues 0)
backlog 0b 0p requeues 0
However, deterministic handles are beneficial in a few ways:
If every data structure derives Hashable
, we can traverse the rule set and compute the handle via the arguments data.
mkHandleId :: Hashable a => a -> Word32
mkHandleId a = murmur3 murmur3Seed (encodeUtf8 (show (hashWithSalt hashableSeed a)))
where
murmur3Seed = 21
hashableSeed = 100
Due to hashWithSalt
returning a value much larger than unsigned 32bit integer, we can use a second hash to enforce that constraint
> :t hashWithSalt
hashWithSalt :: Hashable a => Int -> a -> Int
> maxBound :: Int
9223372036854775807
Take the hashWithSalt
value, convert it to a string, and then pass through a MurmurHash
3 u32 variant.
In order to actually execute the system commands, we need to produce valid arguments. A typeclass is a natural fit
class ToCommand a where
toCmd :: a -> [Maybe Text]
instance ToCommand TCRule where
toCmd = \case
TCRuleQDiscI qdisc -> toCmd qdisc
...
instance ToCommand ActionI where
toCmd (GAct act) = toCmd act
toCmd Pipe = [Just "pipe", Just "action"]
...
instance ToCommand ControlActionType where
toCmd = \case
ControlActionTypeContinue -> [Just "continue"]
ControlActionTypePass -> [Just "pass"]
ControlActionTypeDrop -> [Just "drop"]
...
From https://wiki.linuxfoundation.org/networking/iproute2_examples#load_balancing
From the iproute2 source
$ find man -iname 'tc*' | wc -l
60
I've never counted, so this is an assumption