A Linux Firewall DSL For tc in Haskell

About

A typed and embedded DSL in Haskell to describe iproute2’s tc (Traffic Control) firewall rules for Linux

Background

tc is one of the more complicated utilities to get the command arguments correct. For example¹

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 60² man pages with 100s³ 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

Typed Arguments

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)

Embedded DSL

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:

1. access to loops, functions, etc
2. creating rules from configuration files, databases Queries, etc.
3. type check proper arguments are used (e.g. a port should be a bounded number and not a string)
4. build tools on top (static analysis, exporting to another format, etc)

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.

Computing A Deterministic Handle

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:

1. when data changes handle changes
2. comparing rules
3. validating against the system (e.g. is this rule present)

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.

Emitting Runnable Commands

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"]
        ...

Footnotes