CaZzzer/fwl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: CaZzzer:d01be7bc23ef192fd716f25c575a1e60670398f5
Branches Tags
CaZzzer:master CaZzzer:v2-1 CaZzzer:v2
...
compare: CaZzzer:9390647f7ad2d0e34927552630d67c46a4f37033
Branches Tags
CaZzzer:v2-1 CaZzzer:v2 CaZzzer:master

5 Commits
d01be7bc23 ... 9390647f7a

Author SHA1 Message Date
Yuri Tatishchev
9390647f7a add more ruleset examples 2026-05-04 01:47:10 -07:00
Yuri Tatishchev
25f95996fb I don't even know rn 2026-05-04 01:44:11 -07:00
Yuri Tatishchev
d79206440a stupid compilation 2026-05-04 00:41:52 -07:00
Yuri Tatishchev
d136bd62f7 more compiler fixes 2026-05-04 00:14:47 -07:00
Yuri Tatishchev
8a508ad7cc gemini fixes nft json compilation 2026-05-03 19:01:02 -07:00
13 changed files with 2167 additions and 76 deletions
Expand all files Collapse all files

1
doc/fwl_grammar.md
View File

@@ -165,6 +165,7 @@ pat ::= wildcardPat -- _
| bytesPat -- [ byteElem* ] | bytesPat -- [ byteElem* ]
| recordPat -- Ctor { field = lit, ... } | recordPat -- Ctor { field = lit, ... }
| namedOrCtorPat -- Ctor(p,...) or bare identifier | namedOrCtorPat -- Ctor(p,...) or bare identifier
| pat "|" pat -- Or-pattern
wildcardPat ::= "_" wildcardPat ::= "_"
framePat ::= "Frame" "(" frameArgs ")" framePat ::= "Frame" "(" frameArgs ")"

1
doc/ref/ruleset-1.json Normal file
View File

File diff suppressed because one or more lines are too long

163
doc/ref/ruleset-1.nft Normal file
View File

@@ -0,0 +1,163 @@
#!/usr/sbin/nft -f
# Compiled from examples/router.fwl
# Single inet table: fwl
flush ruleset
table inet fwl {
# ── Data: let rfc1918 ────────────────────────────────────────────────────
set rfc1918 {
type ipv4_addr
flags interval
elements = {
10.0.0.0/8,
172.16.0.0/12,
192.168.0.0/16
}
}
# ── Data: let forwards ──────────────────────────────────────────────────
map forwards {
type inet_proto . inet_service : ipv4_addr . inet_service
elements = {
tcp . 8080 : 10.17.1.10 . 80,
tcp . 2222 : 10.17.1.11 . 22
}
}
# ── WireGuard ct mark state machine ─────────────────────────────────────
# Compiles: flow WireGuardHandshake = WGInitiation . WGResponse within 5s
# State: ct mark 0 = Idle, 1 = SawInitiation, 2 = Confirmed
#
# WGInitiation: UDP, udp length == 156 (8 hdr + 148 payload), payload[0] == 0x01
# WGResponse: UDP, udp length == 100 (8 hdr + 92 payload), payload[0] == 0x02
# @th,64,8 = first byte of UDP payload (offset 64 bits past transport header start)
chain wg_flow {
# Packet 1: Idle → SawInitiation
ct state new ct mark 0 \
meta l4proto udp udp length 156 \
@th,64,8 0x01 \
ct mark set 1 \
return
# Packet 2: SawInitiation → Confirmed
ct mark 1 \
meta l4proto udp udp length 100 \
@th,64,8 0x02 \
ct mark set 2 \
return
}
# ── rule blockOutboundWG ─────────────────────────────────────────────────
# Compiles: rule blockOutboundWG : Frame -> <FlowMatch, Log> Action
# Called via jump from forward. Drops confirmed WG handshakes, returns otherwise.
chain blockOutboundWG {
# Feed matching UDP into the WG state machine
meta nfproto ipv4 meta l4proto udp \
udp length 156 \
@th,64,8 0x01 \
jump wg_flow
# If handshake is now Confirmed (ct mark 2): log + drop
ct mark 2 \
log prefix "WG blocked: " level warn \
drop
# Continue: return to forward chain (no verdict)
return
}
# ── policy input ─────────────────────────────────────────────────────────
# hook = Input, table = Filter, priority = filter (0), default = drop
chain input {
type filter hook input priority filter; policy drop;
# | _ if ct.state in { Established, Related } -> Allow
ct state { established, related } accept
# | Frame(lo, _) -> Allow
iifname "lo" accept
# | Frame(_, IPv6(ip6, ICMPv6(_, _))) if ip6.src in fe80::/10 -> Allow
meta nfproto ipv6 ip6 nexthdr ipv6-icmp ip6 saddr fe80::/10 accept
# | Frame(_, IPv4(_, TCP(tcp, _))) if tcp.dport == :22 -> Allow
meta nfproto ipv4 meta l4proto tcp tcp dport 22 accept
# | Frame(_, IPv4(_, UDP(udp, _))) if udp.dport == :51944 -> Allow
meta nfproto ipv4 meta l4proto udp udp dport 51944 accept
# | _ -> Drop (chain policy)
}
# ── policy forward ───────────────────────────────────────────────────────
# hook = Forward, table = Filter, priority = filter (0), default = drop
chain forward {
type filter hook forward priority filter; policy drop;
# | _ if ct.state in { Established, Related } -> Allow
ct state { established, related } accept
# | frame if iif in lan_zone && oif == wan -> blockOutboundWG(frame)
meta iifname { "lan", "wg0" } meta oifname "wan" jump blockOutboundWG
# | _ if ct.status == DNAT -> Allow
ct status dnat accept
# | Frame(iif in lan_zone -> wan, _) -> Allow
meta iifname { "lan", "wg0" } meta oifname "wan" accept
# | Frame(iif in lan_zone -> lan_zone, _) -> Allow
meta iifname { "lan", "wg0" } meta oifname { "lan", "wg0" } accept
# | Frame(wan -> lan_zone, IPv4(ip, TCP|UDP)) if (proto, dport) in forwards -> Allow
# Membership test only — the actual DNAT is done in nat_prerouting.
meta iifname "wan" meta oifname { "lan", "wg0" } \
meta nfproto ipv4 \
meta l4proto { tcp, udp } \
meta l4proto . th dport @forwards \
accept
# | _ -> Drop (chain policy)
}
# ── policy output ────────────────────────────────────────────────────────
# hook = Output, table = Filter, priority = filter (0), default = accept
chain output {
type filter hook output priority filter; policy accept;
# | _ -> Allow (chain policy)
}
# ── policy nat_prerouting ────────────────────────────────────────────────
# hook = Prerouting, table = NAT, priority = dstnat (-100), default = accept
chain nat_prerouting {
type nat hook prerouting priority dstnat; policy accept;
# | Frame(_, IPv4(ip, TCP|UDP)) ->
# if FIB.daddrLocal(ip.dst) then DNATMap((proto, dport), forwards) else Allow
meta nfproto ipv4 meta l4proto { tcp, udp } \
fib daddr type local \
dnat ip to meta l4proto . th dport map @forwards
# | _ -> Allow (chain policy)
}
# ── policy nat_postrouting ───────────────────────────────────────────────
# hook = Postrouting, table = NAT, priority = srcnat (100), default = accept
chain nat_postrouting {
type nat hook postrouting priority srcnat; policy accept;
# | Frame(_ -> wan, IPv4(ip, _)) if ip.src in rfc1918 -> Masquerade
meta oifname "wan" meta nfproto ipv4 ip saddr @rfc1918 masquerade
# | _ -> Allow (chain policy)
}
}

10
examples/router.fwl
View File

@@ -7,7 +7,7 @@ interface wg0 : WireGuard {};
zone lan_zone = { lan, wg0 }; zone lan_zone = { lan, wg0 };
import rfc1918 : CIDRSet from "builtin:rfc1918"; let rfc1918 : Set<IPv4> = { 10.0.0.0/8, 172.16.0.0/12, 192.168.0.0/16 };
let forwards : Map<(Protocol, Port), (IP, Port)> = { let forwards : Map<(Protocol, Port), (IP, Port)> = {
(tcp, :8080) -> (10.17.1.10, :80), (tcp, :8080) -> (10.17.1.10, :80),
@@ -64,8 +64,8 @@ policy forward : Frame
| _ if ct.status == DNAT -> Allow; | _ if ct.status == DNAT -> Allow;
| Frame(iif in lan_zone -> wan, _) -> Allow; | Frame(iif in lan_zone -> wan, _) -> Allow;
| Frame(iif in lan_zone -> lan_zone, _) -> Allow; | Frame(iif in lan_zone -> lan_zone, _) -> Allow;
| Frame(wan -> lan_zone, IPv4(ip, TCP(tcp, _))) | Frame(wan -> lan_zone, IPv4(ip, TCP(th, _) | UDP(th, _)))
if (ip.dst, tcp.dport) in forwards -> Allow; if (ip.protocol, th.dport) in forwards -> Allow;
| _ -> Drop; | _ -> Drop;
}; };
@@ -80,9 +80,9 @@ policy output : Frame
policy nat_prerouting : Frame policy nat_prerouting : Frame
on { hook = Prerouting, table = NAT, priority = DstNat } on { hook = Prerouting, table = NAT, priority = DstNat }
= { = {
| Frame(_, IPv4(ip, _)) -> | Frame(_, IPv4(ip, TCP(th, _) | UDP(th, _))) ->
if perform FIB.daddrLocal(ip.dst) if perform FIB.daddrLocal(ip.dst)
then DNATMap(forwards) then DNATMap((ip.protocol, th.dport), forwards)
else Allow; else Allow;
| _ -> Allow; | _ -> Allow;
}; };

69
examples/simple-router.fwl Normal file
View File

@@ -0,0 +1,69 @@
interface wan : WAN { dynamic; };
interface lan : LAN { cidr4 = { 10.0.0.0/24 }; };
zone lan_zone = { lan };
let rfc1918 : Set<IPv4> = { 10.0.0.0/8, 172.16.0.0/12, 192.168.0.0/16 };
-- Single IPv4 port forward: tcp:8080 -> 10.0.0.10:80
let forwards : Map<(Protocol, Port), (IP, Port)> = {
(tcp, :8080) -> (10.0.0.10, :80)
};
-- Open inbound ports on the router itself
let open_ports : Set<Port> = { :22 };
-- IPv6 forwarded destination: tcp . 2001:db8::1 . 22000
let forwards_v6 : Set<(Protocol, IP, Port)> = {
(tcp, 2001:db8::1, :22000)
};
policy input : Frame
on { hook = Input, table = Filter, priority = Filter }
= {
| _ if ct.state in { Established, Related } -> Allow;
| Frame(lo, _) -> Allow;
| Frame(_, IPv6(ip6, ICMPv6(_, _)))
if ip6.src in fe80::/10 -> Allow;
| Frame(_, IPv4(_, TCP(tcp, _)))
if tcp.dport in open_ports -> Allow;
| Frame(_, IPv4(_, UDP(udp, _)))
if udp.dport == :51944 -> Allow;
| _ -> Drop;
};
policy forward : Frame
on { hook = Forward, table = Filter, priority = Filter }
= {
| _ if ct.state in { Established, Related } -> Allow;
| _ if ct.status == DNAT -> Allow;
| Frame(iif in lan_zone -> wan, _) -> Allow;
| Frame(wan -> iif in lan_zone, IPv4(ip, TCP(th, _) | UDP(th, _)))
if (ip.protocol, th.dport) in forwards -> Allow;
| Frame(wan -> iif in lan_zone, IPv6(ip6, TCP(th, _) | UDP(th, _)))
if (ip6.protocol, ip6.dst, th.dport) in forwards_v6 -> Allow;
| _ -> Drop;
};
policy output : Frame
on { hook = Output, table = Filter, priority = Filter }
= {
| _ -> Allow;
};
policy nat_prerouting : Frame
on { hook = Prerouting, table = NAT, priority = DstNat }
= {
| Frame(_, IPv4(ip, TCP(th, _) | UDP(th, _))) ->
if perform FIB.daddrLocal(ip.dst)
then DNATMap((ip.protocol, th.dport), forwards)
else Allow;
| _ -> Allow;
};
policy nat_postrouting : Frame
on { hook = Postrouting, table = NAT, priority = SrcNat }
= {
| Frame(_ -> wan, IPv4(ip, _)) if ip.src in rfc1918 -> Masquerade;
| _ -> Allow;
};

955
examples/simple-router.fwl.json Normal file
View File

@@ -0,0 +1,955 @@
{
"nftables": [
{
"metainfo": {
"json_schema_version": 1
}
},
{
"table": {
"family": "inet",
"name": "fwl"
}
},
{
"chain": {
"family": "inet",
"hook": "input",
"name": "input",
"policy": "drop",
"prio": 0,
"table": "fwl",
"type": "filter"
}
},
{
"chain": {
"family": "inet",
"hook": "forward",
"name": "forward",
"policy": "drop",
"prio": 0,
"table": "fwl",
"type": "filter"
}
},
{
"chain": {
"family": "inet",
"hook": "output",
"name": "output",
"policy": "accept",
"prio": 0,
"table": "fwl",
"type": "filter"
}
},
{
"chain": {
"family": "inet",
"hook": "prerouting",
"name": "nat_prerouting",
"policy": "accept",
"prio": -100,
"table": "fwl",
"type": "nat"
}
},
{
"chain": {
"family": "inet",
"hook": "postrouting",
"name": "nat_postrouting",
"policy": "accept",
"prio": 100,
"table": "fwl",
"type": "nat"
}
},
{
"set": {
"elem": [
{
"prefix": {
"addr": "10.0.0.0",
"len": 8
}
},
{
"prefix": {
"addr": "172.16.0.0",
"len": 12
}
},
{
"prefix": {
"addr": "192.168.0.0",
"len": 16
}
}
],
"family": "inet",
"name": "rfc1918",
"table": "fwl",
"type": "ipv4_addr"
}
},
{
"map": {
"elem": [
[
{
"concat": [
"tcp",
8080
]
},
{
"concat": [
"10.0.0.10",
80
]
}
]
],
"family": "inet",
"map": [
"ipv4_addr",
"inet_service"
],
"name": "forwards",
"table": "fwl",
"type": [
"inet_proto",
"inet_service"
]
}
},
{
"set": {
"elem": [
22
],
"family": "inet",
"name": "open_ports",
"table": "fwl",
"type": "inet_service"
}
},
{
"set": {
"elem": [
{
"concat": [
"tcp",
"2001:db8:0:0:0:0:0:1",
22000
]
}
],
"family": "inet",
"name": "forwards_v6",
"table": "fwl",
"type": [
"inet_proto",
"ipv4_addr",
"inet_service"
]
}
},
{
"rule": {
"chain": "input",
"expr": [
{
"match": {
"left": {
"ct": {
"key": "state"
}
},
"op": "in",
"right": [
"established",
"related"
]
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "input",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "iifname"
}
},
"op": "==",
"right": "lo"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "input",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv6"
}
},
{
"match": {
"left": {
"payload": {
"field": "nexthdr",
"protocol": "ip6"
}
},
"op": "==",
"right": "ipv6-icmp"
}
},
{
"match": {
"left": {
"payload": {
"field": "saddr",
"protocol": "ip6"
}
},
"op": "==",
"right": {
"prefix": {
"addr": "fe80:0:0:0:0:0:0:0",
"len": 10
}
}
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "input",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv4"
}
},
{
"match": {
"left": {
"meta": {
"key": "l4proto"
}
},
"op": "==",
"right": "tcp"
}
},
{
"match": {
"left": {
"payload": {
"field": "dport",
"protocol": "tcp"
}
},
"op": "==",
"right": "@open_ports"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "input",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv4"
}
},
{
"match": {
"left": {
"meta": {
"key": "l4proto"
}
},
"op": "==",
"right": "udp"
}
},
{
"match": {
"left": {
"payload": {
"field": "dport",
"protocol": "udp"
}
},
"op": "==",
"right": "51944"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "input",
"expr": [
{
"drop": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "forward",
"expr": [
{
"match": {
"left": {
"ct": {
"key": "state"
}
},
"op": "in",
"right": [
"established",
"related"
]
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "forward",
"expr": [
{
"match": {
"left": {
"ct": {
"key": "status"
}
},
"op": "==",
"right": "dnat"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "forward",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "iifname"
}
},
"op": "in",
"right": {
"set": [
"lan"
]
}
}
},
{
"match": {
"left": {
"meta": {
"key": "oifname"
}
},
"op": "==",
"right": "wan"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "forward",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "iifname"
}
},
"op": "==",
"right": "wan"
}
},
{
"match": {
"left": {
"meta": {
"key": "oifname"
}
},
"op": "in",
"right": {
"set": [
"lan"
]
}
}
},
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv4"
}
},
{
"match": {
"left": {
"meta": {
"key": "l4proto"
}
},
"op": "==",
"right": "tcp"
}
},
{
"match": {
"left": {
"concat": [
{
"payload": {
"field": "protocol",
"protocol": "ip"
}
},
{
"payload": {
"field": "dport",
"protocol": "th"
}
}
]
},
"op": "==",
"right": "@forwards"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "forward",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "iifname"
}
},
"op": "==",
"right": "wan"
}
},
{
"match": {
"left": {
"meta": {
"key": "oifname"
}
},
"op": "in",
"right": {
"set": [
"lan"
]
}
}
},
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv4"
}
},
{
"match": {
"left": {
"meta": {
"key": "l4proto"
}
},
"op": "==",
"right": "udp"
}
},
{
"match": {
"left": {
"concat": [
{
"payload": {
"field": "protocol",
"protocol": "ip"
}
},
{
"payload": {
"field": "dport",
"protocol": "th"
}
}
]
},
"op": "==",
"right": "@forwards"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "forward",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "iifname"
}
},
"op": "==",
"right": "wan"
}
},
{
"match": {
"left": {
"meta": {
"key": "oifname"
}
},
"op": "in",
"right": {
"set": [
"lan"
]
}
}
},
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv6"
}
},
{
"match": {
"left": {
"meta": {
"key": "l4proto"
}
},
"op": "==",
"right": "tcp"
}
},
{
"match": {
"left": {
"concat": [
{
"payload": {
"field": "protocol",
"protocol": "ip6"
}
},
{
"payload": {
"field": "daddr",
"protocol": "ip6"
}
},
{
"payload": {
"field": "dport",
"protocol": "th"
}
}
]
},
"op": "==",
"right": "@forwards_v6"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "forward",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "iifname"
}
},
"op": "==",
"right": "wan"
}
},
{
"match": {
"left": {
"meta": {
"key": "oifname"
}
},
"op": "in",
"right": {
"set": [
"lan"
]
}
}
},
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv6"
}
},
{
"match": {
"left": {
"meta": {
"key": "l4proto"
}
},
"op": "==",
"right": "udp"
}
},
{
"match": {
"left": {
"concat": [
{
"payload": {
"field": "protocol",
"protocol": "ip6"
}
},
{
"payload": {
"field": "daddr",
"protocol": "ip6"
}
},
{
"payload": {
"field": "dport",
"protocol": "th"
}
}
]
},
"op": "==",
"right": "@forwards_v6"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "forward",
"expr": [
{
"drop": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "output",
"expr": [
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "nat_prerouting",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv4"
}
},
{
"match": {
"left": {
"meta": {
"key": "l4proto"
}
},
"op": "==",
"right": "tcp"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "nat_prerouting",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv4"
}
},
{
"match": {
"left": {
"meta": {
"key": "l4proto"
}
},
"op": "==",
"right": "udp"
}
},
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "nat_prerouting",
"expr": [
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "nat_postrouting",
"expr": [
{
"match": {
"left": {
"meta": {
"key": "oifname"
}
},
"op": "==",
"right": "wan"
}
},
{
"match": {
"left": {
"meta": {
"key": "nfproto"
}
},
"op": "==",
"right": "ipv4"
}
},
{
"match": {
"left": {
"payload": {
"field": "saddr",
"protocol": "ip"
}
},
"op": "==",
"right": "@rfc1918"
}
},
{
"masquerade": null
}
],
"family": "inet",
"table": "fwl"
}
},
{
"rule": {
"chain": "nat_postrouting",
"expr": [
{
"accept": null
}
],
"family": "inet",
"table": "fwl"
}
}
]
}

98
examples/simple-router.nft Normal file
View File

@@ -0,0 +1,98 @@
table inet fwl {
# ── let rfc1918 ──────────────────────────────────────────────────────────
set rfc1918 {
type ipv4_addr
flags interval
elements = {
10.0.0.0/8,
172.16.0.0/12,
192.168.0.0/16
}
}
# ── let open_ports : Set<Port> ───────────────────────────────────────────
set open_ports {
type inet_service
elements = { 22 }
}
# ── let forwards_v6 : Set<(Protocol, IP, Port)> ──────────────────────────
set forwards_v6 {
type inet_proto . ipv6_addr . inet_service
elements = {
tcp . 2001:db8::1 . 22000
}
}
# ── let forwards : Map<(Protocol, Port), (IP, Port)> ────────────────────
map forwards {
type inet_proto . inet_service : ipv4_addr . inet_service
elements = {
tcp . 8080 : 10.0.0.10 . 80
}
}
# ── zone lan_zone = { lan } ──────────────────────────────────────────────
# Zones compile to anonymous sets wherever referenced in iifname/oifname.
# With a single member the set degenerates to a plain string match,
# but we keep the set form so the compiler output is uniform regardless
# of zone size.
set lan_zone {
type ifname
elements = { "lan" }
}
# ── policy input ─────────────────────────────────────────────────────────
chain input {
type filter hook input priority filter; policy drop;
ct state { established, related } accept
iifname "lo" accept
meta nfproto ipv6 ip6 nexthdr ipv6-icmp ip6 saddr fe80::/10 accept
meta nfproto ipv4 meta l4proto tcp tcp dport @open_ports accept
meta nfproto ipv4 meta l4proto udp udp dport 51944 accept
}
# ── policy forward ───────────────────────────────────────────────────────
chain forward {
type filter hook forward priority filter; policy drop;
ct state { established, related } accept
ct status dnat accept
# | Frame(iif in lan_zone -> wan, _) -> Allow
meta iifname @lan_zone meta oifname "wan" accept
# | Frame(wan -> iif in lan_zone, IPv4 TCP|UDP) if (proto,dport) in forwards
meta iifname "wan" meta oifname @lan_zone \
meta nfproto ipv4 meta l4proto { tcp, udp } \
meta l4proto . th dport @forwards accept
# | Frame(wan -> iif in lan_zone, IPv6 TCP|UDP) if (proto,dst,dport) in forwards_v6
meta iifname "wan" meta oifname @lan_zone \
meta nfproto ipv6 meta l4proto { tcp, udp } \
meta l4proto . ip6 daddr . th dport @forwards_v6 accept
}
# ── policy output ────────────────────────────────────────────────────────
chain output {
type filter hook output priority filter; policy accept;
}
# ── policy nat_prerouting ────────────────────────────────────────────────
chain nat_prerouting {
type nat hook prerouting priority dstnat; policy accept;
meta nfproto ipv4 meta l4proto { tcp, udp } \
fib daddr type local \
dnat ip to meta l4proto . th dport map @forwards
}
# ── policy nat_postrouting ───────────────────────────────────────────────
chain nat_postrouting {
type nat hook postrouting priority srcnat; policy accept;
meta oifname "wan" meta nfproto ipv4 ip saddr @rfc1918 masquerade
}
}

693
examples/simple-router.nft.json Normal file
View File

@@ -0,0 +1,693 @@
{
"nftables": [
{
"metainfo": {
"version": "1.1.6",
"release_name": "Commodore Bullmoose #7",
"json_schema_version": 1
}
},
{
"table": {
"family": "inet",
"name": "fwl"
}
},
{
"chain": {
"family": "inet",
"table": "fwl",
"name": "input",
"type": "filter",
"hook": "input",
"prio": 0,
"policy": "drop"
}
},
{
"chain": {
"family": "inet",
"table": "fwl",
"name": "forward",
"type": "filter",
"hook": "forward",
"prio": 0,
"policy": "drop"
}
},
{
"chain": {
"family": "inet",
"table": "fwl",
"name": "output",
"type": "filter",
"hook": "output",
"prio": 0,
"policy": "accept"
}
},
{
"chain": {
"family": "inet",
"table": "fwl",
"name": "nat_prerouting",
"type": "nat",
"hook": "prerouting",
"prio": -100,
"policy": "accept"
}
},
{
"chain": {
"family": "inet",
"table": "fwl",
"name": "nat_postrouting",
"type": "nat",
"hook": "postrouting",
"prio": 100,
"policy": "accept"
}
},
{
"set": {
"family": "inet",
"name": "rfc1918",
"table": "fwl",
"type": "ipv4_addr",
"flags": [
"interval"
],
"elem": [
{
"prefix": {
"addr": "10.0.0.0",
"len": 8
}
},
{
"prefix": {
"addr": "172.16.0.0",
"len": 12
}
},
{
"prefix": {
"addr": "192.168.0.0",
"len": 16
}
}
]
}
},
{
"set": {
"family": "inet",
"name": "open_ports",
"table": "fwl",
"type": "inet_service",
"elem": [
22
]
}
},
{
"set": {
"family": "inet",
"name": "forwards_v6",
"table": "fwl",
"type": [
"inet_proto",
"ipv6_addr",
"inet_service"
],
"elem": [
{
"concat": [
"tcp",
"2001:db8::1",
22000
]
}
]
}
},
{
"map": {
"family": "inet",
"name": "forwards",
"table": "fwl",
"type": [
"inet_proto",
"inet_service"
],
"map": [
"ipv4_addr",
"inet_service"
],
"elem": [
[
{
"concat": [
"tcp",
8080
]
},
{
"concat": [
"10.0.0.10",
80
]
}
]
]
}
},
{
"set": {
"family": "inet",
"name": "lan_zone",
"table": "fwl",
"type": "ifname",
"elem": [
"lan"
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "input",
"expr": [
{
"match": {
"op": "==",
"left": {
"ct": {
"key": "state"
}
},
"right": {
"set": [
"established",
"related"
]
}
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "input",
"expr": [
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "iifname"
}
},
"right": "lo"
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "input",
"expr": [
{
"match": {
"op": "==",
"left": {
"payload": {
"protocol": "ip6",
"field": "nexthdr"
}
},
"right": "ipv6-icmp"
}
},
{
"match": {
"op": "==",
"left": {
"payload": {
"protocol": "ip6",
"field": "saddr"
}
},
"right": {
"prefix": {
"addr": "fe80::",
"len": 10
}
}
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "input",
"expr": [
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "nfproto"
}
},
"right": "ipv4"
}
},
{
"match": {
"op": "==",
"left": {
"payload": {
"protocol": "tcp",
"field": "dport"
}
},
"right": "@open_ports"
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "input",
"expr": [
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "nfproto"
}
},
"right": "ipv4"
}
},
{
"match": {
"op": "==",
"left": {
"payload": {
"protocol": "udp",
"field": "dport"
}
},
"right": 51944
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "forward",
"expr": [
{
"match": {
"op": "==",
"left": {
"ct": {
"key": "state"
}
},
"right": {
"set": [
"established",
"related"
]
}
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "forward",
"expr": [
{
"match": {
"op": "in",
"left": {
"ct": {
"key": "status"
}
},
"right": "dnat"
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "forward",
"expr": [
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "iifname"
}
},
"right": "@lan_zone"
}
},
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "oifname"
}
},
"right": "wan"
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "forward",
"expr": [
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "iifname"
}
},
"right": "wan"
}
},
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "oifname"
}
},
"right": "@lan_zone"
}
},
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "nfproto"
}
},
"right": "ipv4"
}
},
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "l4proto"
}
},
"right": {
"set": [
"tcp",
"udp"
]
}
}
},
{
"match": {
"op": "==",
"left": {
"concat": [
{
"meta": {
"key": "l4proto"
}
},
{
"payload": {
"protocol": "th",
"field": "dport"
}
}
]
},
"right": "@forwards"
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "forward",
"expr": [
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "iifname"
}
},
"right": "wan"
}
},
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "oifname"
}
},
"right": "@lan_zone"
}
},
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "l4proto"
}
},
"right": {
"set": [
"tcp",
"udp"
]
}
}
},
{
"match": {
"op": "==",
"left": {
"concat": [
{
"meta": {
"key": "l4proto"
}
},
{
"payload": {
"protocol": "ip6",
"field": "daddr"
}
},
{
"payload": {
"protocol": "th",
"field": "dport"
}
}
]
},
"right": "@forwards_v6"
}
},
{
"accept": null
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "nat_prerouting",
"expr": [
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "nfproto"
}
},
"right": "ipv4"
}
},
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "l4proto"
}
},
"right": {
"set": [
"tcp",
"udp"
]
}
}
},
{
"match": {
"op": "==",
"left": {
"fib": {
"result": "type",
"flags": [
"daddr"
]
}
},
"right": "local"
}
},
{
"dnat": {
"family": "ip",
"addr": {
"map": {
"key": {
"concat": [
{
"meta": {
"key": "l4proto"
}
},
{
"payload": {
"protocol": "th",
"field": "dport"
}
}
]
},
"data": "@forwards"
}
}
}
}
]
}
},
{
"rule": {
"family": "inet",
"table": "fwl",
"chain": "nat_postrouting",
"expr": [
{
"match": {
"op": "==",
"left": {
"meta": {
"key": "oifname"
}
},
"right": "wan"
}
},
{
"match": {
"op": "==",
"left": {
"payload": {
"protocol": "ip",
"field": "saddr"
}
},
"right": "@rfc1918"
}
},
{
"masquerade": null
}
]
}
}
]
}

1
src/FWL/AST.hs
View File

@@ -82,6 +82,7 @@ data Pat
| PTuple [Pat] | PTuple [Pat]
| PFrame (Maybe PathPat) Pat | PFrame (Maybe PathPat) Pat
| PBytes [ByteElem] | PBytes [ByteElem]
| POr Pat Pat
deriving (Show) deriving (Show)
data FieldPat data FieldPat

22
src/FWL/Check.hs
View File

@@ -20,6 +20,7 @@ data CheckError
| PolicyNoContinue String -- policy name | PolicyNoContinue String -- policy name
| PatternCycle [String] -- cycle path | PatternCycle [String] -- cycle path
| DuplicateDecl String String -- kind, name | DuplicateDecl String String -- kind, name
| OrPatternMismatch [String] [String]
deriving (Show, Eq) deriving (Show, Eq)
type Env = Map.Map String DeclKind type Env = Map.Map String DeclKind
@@ -117,6 +118,25 @@ checkPat env (PRecord _ fs) = concatMap (checkFP env) fs
checkPat env (PTuple ps) = concatMap (checkPat env) ps checkPat env (PTuple ps) = concatMap (checkPat env) ps
checkPat env (PFrame mp inner)= maybe [] (checkPath env) mp ++ checkPat env inner checkPat env (PFrame mp inner)= maybe [] (checkPath env) mp ++ checkPat env inner
checkPat _ (PBytes _) = [] checkPat _ (PBytes _) = []
checkPat env (POr p1 p2) =
let v1 = boundVars p1
v2 = boundVars p2
errs = if Set.fromList v1 == Set.fromList v2 then [] else [OrPatternMismatch v1 v2]
in errs ++ checkPat env p1 ++ checkPat env p2
boundVars :: Pat -> [String]
boundVars (PVar n) = [n]
boundVars (PCtor _ ps) = concatMap boundVars ps
boundVars (PRecord _ fs) = concatMap boundFP fs
boundVars (PTuple ps) = concatMap boundVars ps
boundVars (PFrame _ p) = boundVars p
boundVars (POr p1 p2) = boundVars p1
boundVars _ = []
boundFP :: FieldPat -> [String]
boundFP (FPBind n) = [n]
boundFP (FPAs _ v) = [v]
boundFP _ = []
checkFP :: Env -> FieldPat -> [CheckError] checkFP :: Env -> FieldPat -> [CheckError]
checkFP _ _ = [] -- field names checked by type-checker later checkFP _ _ = [] -- field names checked by type-checker later
@@ -153,6 +173,7 @@ addPat env (PFrame mp inner) =
in case md of Just (EPName n) -> Map.insert n KLet env1; _ -> env1 in case md of Just (EPName n) -> Map.insert n KLet env1; _ -> env1
Nothing -> env Nothing -> env
in addPat env' inner in addPat env' inner
addPat env (POr p1 _) = addPat env p1
addPat env _ = env addPat env _ = env
addFP :: Env -> FieldPat -> Env addFP :: Env -> FieldPat -> Env
@@ -211,6 +232,7 @@ checkPatternCycles decls =
refsInPat (PCtor _ ps) = concatMap refsInPat ps refsInPat (PCtor _ ps) = concatMap refsInPat ps
refsInPat (PTuple ps) = concatMap refsInPat ps refsInPat (PTuple ps) = concatMap refsInPat ps
refsInPat (PFrame _ p) = refsInPat p refsInPat (PFrame _ p) = refsInPat p
refsInPat (POr p1 p2) = refsInPat p1 ++ refsInPat p2
refsInPat _ = [] refsInPat _ = []
findCycles :: Map.Map String [String] -> [[String]] findCycles :: Map.Map String [String] -> [[String]]

220
src/FWL/Compile.hs
View File

@@ -48,7 +48,7 @@ programToValue (Program cfg decls) =
policies policies
letDecls = [ (n, t, e) | DLet n t e <- decls ] letDecls = [ (n, t, e) | DLet n t e <- decls ]
mapObjs = mapMaybe (\(n, _, e) -> letToMapValue tbl n e) letDecls mapObjs = mapMaybe (\(n, t, e) -> letToSetOrMapValue tbl n t e) letDecls
-- ─── Table / Chain declarations ────────────────────────────────────────────── -- ─── Table / Chain declarations ──────────────────────────────────────────────
@@ -98,18 +98,17 @@ armToRuleValues env tbl chain (Arm p mg body) =
case compileAction env body of case compileAction env body of
Nothing -> [] Nothing -> []
Just verdict -> Just verdict ->
let patExprs = compilePat env p let patExprsAlts = compilePat env p
guardExprs = maybe [] (compileGuard env) mg guardExprs = maybe [] (compileGuard env) mg
allExprs = patExprs ++ guardExprs ++ [verdict]
in [ object in [ object
[ "rule" .= object [ "rule" .= object
[ "family" .= ("inet" :: String) [ "family" .= ("inet" :: String)
, "table" .= tbl , "table" .= tbl
, "chain" .= chain , "chain" .= chain
, "expr" .= toJSON allExprs , "expr" .= toJSON (patExprs ++ guardExprs ++ [verdict])
]
] ]
] ]
| patExprs <- patExprsAlts ]
-- ─── Pattern → [Value] ─────────────────────────────────────────────────────── -- ─── Pattern → [Value] ───────────────────────────────────────────────────────
@@ -127,75 +126,81 @@ buildEnv = foldr (\d m -> Map.insert (declNameOf d) d m) Map.empty
declNameOf (DLet n _ _) = n declNameOf (DLet n _ _) = n
declNameOf (DImport n _ _) = n declNameOf (DImport n _ _) = n
compilePat :: CompileEnv -> Pat -> [Value] compilePat :: CompileEnv -> Pat -> [[Value]]
compilePat _ PWild = [] compilePat _ PWild = [[]]
compilePat _ (PVar _) = [] compilePat _ (PVar _) = [[]]
compilePat env (PNamed n) = expandNamedPat env n compilePat env (PNamed n) = expandNamedPat env n
compilePat env (PFrame mp inner) = compilePat env (PFrame mp inner) = do
maybe [] (compilePathPat env) mp ++ compilePat env inner pathConds <- maybe [[]] (compilePathPat env) mp
innerConds <- compilePat env inner
return (pathConds ++ innerConds)
compilePat env (PCtor n ps) = compileCtorPat env n ps compilePat env (PCtor n ps) = compileCtorPat env n ps
compilePat _ (PRecord n fs) = compileRecordPat n fs compilePat _ (PRecord n fs) = compileRecordPat n fs
compilePat env (PTuple ps) = concatMap (compilePat env) ps compilePat env (PTuple ps) = map concat (sequence (map (compilePat env) ps))
compilePat _ (PBytes _) = [] compilePat _ (PBytes _) = [[]]
compilePat env (POr p1 p2) = compilePat env p1 ++ compilePat env p2
expandNamedPat :: CompileEnv -> Name -> [Value] expandNamedPat :: CompileEnv -> Name -> [[Value]]
expandNamedPat env n = expandNamedPat env n =
case Map.lookup n env of case Map.lookup n env of
Just (DPattern _ _ p) -> compilePat env p Just (DPattern _ _ p) -> compilePat env p
_ -> [] _ -> []
compileCtorPat :: CompileEnv -> String -> [Pat] -> [Value] compileCtorPat :: CompileEnv -> String -> [Pat] -> [[Value]]
compileCtorPat env ctor ps = case ctor of compileCtorPat env ctor ps = case ctor of
"Ether" -> children "Ether" -> children
"IPv4" -> matchMeta "nfproto" "ipv4" : children "IPv4" -> map (matchMeta "nfproto" "ipv4" :) children
"IPv6" -> matchMeta "nfproto" "ipv6" : children "IPv6" -> map (matchMeta "nfproto" "ipv6" :) children
"TCP" -> matchPayload "th" "protocol" "tcp" : children "TCP" -> map (matchMeta "l4proto" "tcp" :) children
"UDP" -> matchPayload "th" "protocol" "udp" : children "UDP" -> map (matchMeta "l4proto" "udp" :) children
"ICMPv6" -> matchPayload "ip6" "nexthdr" "ipv6-icmp" : children "ICMPv6" -> map (matchPayload "ip6" "nexthdr" "ipv6-icmp" :) children
"ICMP" -> matchPayload "ip" "protocol" "icmp" : children "ICMP" -> map (matchPayload "ip" "protocol" "icmp" :) children
_ -> children _ -> children
where where
children = concatMap (compilePat env) ps children = map concat (sequence (map (compilePat env) ps))
compileRecordPat :: String -> [FieldPat] -> [Value] compileRecordPat :: String -> [FieldPat] -> [[Value]]
compileRecordPat proto = mapMaybe go compileRecordPat proto fs = [mapMaybe go fs]
where where
go (FPEq field lit) = Just (matchPayload proto field (renderLit lit)) go (FPEq field lit) = Just (matchPayload proto field (renderLit lit))
go _ = Nothing go _ = Nothing
compilePathPat :: CompileEnv -> PathPat -> [Value] compilePathPat :: CompileEnv -> PathPat -> [[Value]]
compilePathPat _ (PathPat ms md) = compilePathPat env (PathPat ms md) =
maybe [] (compileEndpoint "iifname") ms ++ [ maybe [] (compileEndpoint env "iifname") ms ++
maybe [] (compileEndpoint "oifname") md maybe [] (compileEndpoint env "oifname") md ]
compileEndpoint :: String -> EndpointPat -> [Value] compileEndpoint :: CompileEnv -> String -> EndpointPat -> [Value]
compileEndpoint _ EPWild = [] compileEndpoint _ _ EPWild = []
compileEndpoint dir (EPName n) = [matchMeta dir n] compileEndpoint _ dir (EPName n) = [matchMeta dir n]
compileEndpoint dir (EPMember _ z) = [matchInSet (metaVal dir) [z]] compileEndpoint env dir (EPMember _ z) =
case Map.lookup z env of
Just (DZone _ ns) -> [matchInSet (metaVal dir) (map (A.String . toText) ns)]
_ -> [matchInSet (metaVal dir) [A.String (toText z)]]
-- ─── Guard → [Value] ───────────────────────────────────────────────────────── -- ─── Guard → [Value] ─────────────────────────────────────────────────────────
compileGuard :: CompileEnv -> Expr -> [Value] compileGuard :: CompileEnv -> Expr -> [Value]
compileGuard env (EInfix OpAnd l r) = compileGuard env l ++ compileGuard env r compileGuard env (EInfix OpAnd l r) = compileGuard env l ++ compileGuard env r
compileGuard _ (EInfix OpIn l r) = [compileInExpr l r] compileGuard env (EInfix OpIn l r) = [compileInExpr env l r]
compileGuard _ (EInfix OpEq l r) = [matchExpr "==" (exprVal l) (exprVal r)] compileGuard env (EInfix OpEq l r) = [matchExpr "==" (exprVal env l) (exprVal env r)]
compileGuard _ (EInfix OpNeq l r) = [matchExpr "!=" (exprVal l) (exprVal r)] compileGuard env (EInfix OpNeq l r) = [matchExpr "!=" (exprVal env l) (exprVal env r)]
compileGuard _ _ = [] compileGuard _ _ = []
compileInExpr :: Expr -> Expr -> Value compileInExpr :: CompileEnv -> Expr -> Expr -> Value
-- Fix 4: put the more-specific ct patterns BEFORE the generic 2-element -- Fix 4: put the more-specific ct patterns BEFORE the generic 2-element
-- EQual case to eliminate the overlapping pattern match warning. -- EQual case to eliminate the overlapping pattern match warning.
compileInExpr (EQual ["ct", "state"]) (ESet vs) = ctMatch "state" vs compileInExpr env (EQual ["ct", "state"]) (ESet vs) =
compileInExpr (EQual ["ct", "status"]) (ESet vs) = ctMatch "status" vs matchExpr "in" (object ["ct" .= object ["key" .= ("state" :: String)]]) (toJSON (map (exprVal env) vs))
compileInExpr l (ESet vs) = compileInExpr env (EQual ["ct", "status"]) (ESet vs) =
matchExpr "in" (exprVal l) (setVal (map exprToStr vs)) matchExpr "in" (object ["ct" .= object ["key" .= ("status" :: String)]]) (toJSON (map (exprVal env) vs))
compileInExpr l r = compileInExpr env l (ESet vs) =
matchExpr "==" (exprVal l) (exprVal r) matchExpr "==" (exprVal env l) (setVal (map (exprVal env) vs))
compileInExpr env l (EVar z)
ctMatch :: String -> [Expr] -> Value | Just (DZone _ ns) <- Map.lookup z env =
ctMatch key vs = matchExpr "in" matchExpr "==" (exprVal env l) (setVal (map (A.String . toText) ns))
(object ["ct" .= object ["key" .= (key :: String)]]) compileInExpr env l r =
(setVal (map exprToStr vs)) matchExpr "==" (exprVal env l) (exprVal env r)
-- ─── Action → Maybe Value ───────────────────────────────────────────────────── -- ─── Action → Maybe Value ─────────────────────────────────────────────────────
@@ -206,37 +211,82 @@ compileAction _ (EVar "Continue") = Nothing
compileAction _ (EVar "Masquerade") = Just (object ["masquerade" .= Null]) compileAction _ (EVar "Masquerade") = Just (object ["masquerade" .= Null])
compileAction _ (EApp (EVar "DNAT") arg) = compileAction _ (EApp (EVar "DNAT") arg) =
Just $ object ["dnat" .= object ["addr" .= exprToStr arg]] Just $ object ["dnat" .= object ["addr" .= exprToStr arg]]
compileAction _ (EApp (EVar "DNATMap") arg) = compileAction env (EApp (EVar "DNATMap") (ETuple [key, arg])) =
Just $ object ["dnat" .= object ["addr" .= object Just $ object ["dnat" .= object ["addr" .= object
[ "map" .= object [ "key" .= object ["concat" .= Array mempty] [ "map" .= object [ "key" .= exprVal env key
, "data" .= exprToStr arg ]]]] , "data" .= A.String ("@" <> toText (exprToStr arg)) ]]]]
compileAction env (EApp (EVar rn) _) = compileAction env (EApp (EVar rn) _) =
case Map.lookup rn env of case Map.lookup rn env of
Just (DRule _ _ _) -> Just $ object ["jump" .= object ["target" .= rn]] Just (DRule _ _ _) -> Just $ object ["jump" .= object ["target" .= rn]]
_ -> Just (object ["accept" .= Null]) _ -> Just (object ["accept" .= Null])
compileAction _ _ = Just (object ["accept" .= Null]) compileAction _ _ = Just (object ["accept" .= Null])
-- ─── Let → Map object ──────────────────────────────────────────────────────── letToSetOrMapValue :: String -> Name -> Type -> Expr -> Maybe Value
letToSetOrMapValue tbl n (TName "Map" [tk, tv]) (EMap entries) = Just $ object
letToMapValue :: String -> Name -> Expr -> Maybe Value
letToMapValue tbl n (EMap entries) = Just $ object
[ "map" .= object [ "map" .= object
[ "family" .= ("inet" :: String) [ "family" .= ("inet" :: String)
, "table" .= tbl , "table" .= tbl
, "name" .= n , "name" .= n
, "type" .= ("inetproto . inetservice" :: String) , "type" .= renderNftType (fwlTypeToNft tk)
, "map" .= ("ipv4_addr . inetservice" :: String) , "map" .= renderNftType (fwlTypeToNft tv)
, "elem" .= toJSON (map renderMapElem entries) , "elem" .= toJSON (map renderMapElem entries)
] ]
] ]
letToMapValue _ _ _ = Nothing letToSetOrMapValue tbl n (TName "Set" [t]) (ESet entries) = Just $ object
[ "set" .= object
[ "family" .= ("inet" :: String)
, "table" .= tbl
, "name" .= n
, "type" .= renderNftType (fwlTypeToNft t)
, "elem" .= toJSON (map renderSetElem entries)
]
]
letToSetOrMapValue _ _ _ _ = Nothing
fwlTypeToNft :: Type -> [String]
fwlTypeToNft (TName "Protocol" []) = ["inet_proto"]
fwlTypeToNft (TName "Port" []) = ["inet_service"]
fwlTypeToNft (TName "IP" []) = ["ipv4_addr"]
fwlTypeToNft (TName "IPv4" []) = ["ipv4_addr"]
fwlTypeToNft (TName "IPv6" []) = ["ipv6_addr"]
fwlTypeToNft (TTuple ts) = concatMap fwlTypeToNft ts
fwlTypeToNft _ = ["any"]
renderNftType :: [String] -> Value
renderNftType [t] = A.String (toText t)
renderNftType ts = toJSON ts
exprToVal :: Expr -> Value
exprToVal (ELit (LPort p)) = toJSON p
exprToVal (ELit (LInt n)) = toJSON n
exprToVal (ELit (LCIDR ip p))= object
[ "prefix" .= object
[ "addr" .= A.String (toText (renderLit ip))
, "len" .= p
]
]
exprToVal (ELit l) = A.String (toText (renderLit l))
exprToVal (EVar n) = A.String (toText n)
exprToVal (EQual ns) = A.String (toText (intercalate "." ns))
exprToVal _ = A.String "_"
exprToConcatList :: Expr -> [Value]
exprToConcatList (ETuple es) = concatMap exprToConcatList es
exprToConcatList e = [exprToVal e]
renderMapOrSetKey :: Expr -> Value
renderMapOrSetKey (ETuple es) = object ["concat" .= toJSON (exprToConcatList (ETuple es))]
renderMapOrSetKey e = exprToVal e
renderMapElem :: (Expr, Expr) -> Value renderMapElem :: (Expr, Expr) -> Value
renderMapElem (k, v) = toJSON renderMapElem (k, v) = toJSON
[ object ["concat" .= toJSON [exprToStr k]] [ renderMapOrSetKey k
, A.String (toText (exprToStr v)) , renderMapOrSetKey v
] ]
renderSetElem :: Expr -> Value
renderSetElem = renderMapOrSetKey
-- ─── Aeson building blocks ─────────────────────────────────────────────────── -- ─── Aeson building blocks ───────────────────────────────────────────────────
matchExpr :: String -> Value -> Value -> Value matchExpr :: String -> Value -> Value -> Value
@@ -255,7 +305,7 @@ matchPayload :: String -> String -> String -> Value
matchPayload proto field val = matchPayload proto field val =
matchExpr "==" (payloadVal proto field) (A.String (toText val)) matchExpr "==" (payloadVal proto field) (A.String (toText val))
matchInSet :: Value -> [String] -> Value matchInSet :: Value -> [Value] -> Value
matchInSet lhs vals = matchExpr "in" lhs (setVal vals) matchInSet lhs vals = matchExpr "in" lhs (setVal vals)
metaVal :: String -> Value metaVal :: String -> Value
@@ -268,23 +318,55 @@ payloadVal proto field =
, "field" .= (field :: String) , "field" .= (field :: String)
]] ]]
setVal :: [String] -> Value setVal :: [Value] -> Value
setVal vs = object ["set" .= toJSON vs] setVal vs = object ["set" .= toJSON vs]
-- ─── Expression helpers ─────────────────────────────────────────────────────── -- ─── Expression helpers ───────────────────────────────────────────────────────
isSetOrMapRef :: CompileEnv -> Name -> Bool
isSetOrMapRef env n = case Map.lookup n env of
Just (DLet _ _ _) -> True
Just (DImport _ _ _) -> True
_ -> False
mapField :: String -> String
mapField "src" = "saddr"
mapField "dst" = "daddr"
mapField f = f
-- Fix 3 (overlap): specific ct pattern first, generic 2-element case second. -- Fix 3 (overlap): specific ct pattern first, generic 2-element case second.
exprVal :: Expr -> Value exprVal :: CompileEnv -> Expr -> Value
exprVal (EQual ["ct", k]) = object ["ct" .= object ["key" .= (k :: String)]] exprVal _ (EQual ["ct", k]) = object ["ct" .= object ["key" .= (k :: String)]]
exprVal (EQual [p, f]) = payloadVal p f exprVal _ (EQual ["meta", k])= metaVal k
exprVal (EQual ns) = A.String (toText (intercalate "." ns)) exprVal _ (EQual ["th", k]) = payloadVal "th" k
exprVal (EVar n) = metaVal n exprVal _ (EQual [p, f]) = payloadVal p (mapField f)
exprVal (ELit l) = A.String (toText (renderLit l)) exprVal _ (EQual ns) = A.String (toText (intercalate "." ns))
exprVal (ESet vs) = setVal (map exprToStr vs) exprVal env (EVar n)
exprVal e = A.String (toText (exprToStr e)) | Just (DInterface _ _ _) <- Map.lookup n env = A.String (toText n)
| isSetOrMapRef env n = A.String ("@" <> toText n)
| n == "iif" = metaVal "iifname"
| n == "oif" = metaVal "oifname"
| n == "DNAT" = A.String "dnat"
| n == "Established" = A.String "established"
| n == "Related" = A.String "related"
| otherwise = metaVal n
exprVal _ (ELit (LCIDR ip p)) = object
[ "prefix" .= object
[ "addr" .= A.String (toText (renderLit ip))
, "len" .= p
]
]
exprVal _ (ELit l) = A.String (toText (renderLit l))
exprVal env (ESet vs) = setVal (map (exprVal env) vs)
exprVal env (ETuple es) = object ["concat" .= toJSON (map (exprVal env) es)]
exprVal _ e = A.String (toText (exprToStr e))
exprToStr :: Expr -> String exprToStr :: Expr -> String
exprToStr (EVar n) = n exprToStr (EVar n) = case n of
"Established" -> "established"
"Related" -> "related"
"DNAT" -> "dnat"
_ -> n
exprToStr (ELit l) = renderLit l exprToStr (ELit l) = renderLit l
exprToStr (EQual ns) = intercalate "." ns exprToStr (EQual ns) = intercalate "." ns
exprToStr (ETuple es) = intercalate " . " (map exprToStr es) exprToStr (ETuple es) = intercalate " . " (map exprToStr es)

7
src/FWL/Parser.hs
View File

@@ -225,7 +225,12 @@ arm = do
-- ─── Patterns ──────────────────────────────────────────────────────────────── -- ─── Patterns ────────────────────────────────────────────────────────────────
pat :: Parser Pat pat :: Parser Pat
pat = wildcardPat pat = Ex.buildExpressionParser patTable patAtom <?> "pattern"
where
patTable = [ [Ex.Infix (reservedOp "|" >> return POr) Ex.AssocLeft] ]
patAtom :: Parser Pat
patAtom = wildcardPat
<|> try framePat <|> try framePat
<|> try tuplePat <|> try tuplePat
<|> bytesPat <|> bytesPat

1
src/FWL/Pretty.hs
View File

@@ -82,6 +82,7 @@ prettyPat (PTuple ps) = "(" ++ intercalate ", " (map prettyPat ps) ++ ")"
prettyPat (PFrame mp inner)= prettyPat (PFrame mp inner)=
"Frame(" ++ maybe "" (\pp -> prettyPath pp ++ ", ") mp ++ prettyPat inner ++ ")" "Frame(" ++ maybe "" (\pp -> prettyPath pp ++ ", ") mp ++ prettyPat inner ++ ")"
prettyPat (PBytes bs) = "[" ++ unwords (map prettyBE bs) ++ "]" prettyPat (PBytes bs) = "[" ++ unwords (map prettyBE bs) ++ "]"
prettyPat (POr p1 p2) = prettyPat p1 ++ " | " ++ prettyPat p2
prettyFP :: FieldPat -> String prettyFP :: FieldPat -> String
prettyFP (FPEq n l) = n ++ " = " ++ prettyLit l prettyFP (FPEq n l) = n ++ " = " ++ prettyLit l