Git-Mirrors/qubes-mirage-firewall
1
0
Fork 0
mirror of https://github.com/mirage/qubes-mirage-firewall.git synced 2025-04-25 01:19:18 -04:00
Code Issues Packages Projects Releases Wiki Activity

begin changing the info type to something we find more comprehensible

Browse Source
This commit is contained in:
Mindy 2019-02-27 04:43:22 -06:00
parent 5119a22ca4
commit 1e7adb4a72
3 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Makefile.user
View File

@ -5,3 +5,8 @@ tar: build
touch _build/mirage-firewall/modules.img
cat /dev/null | gzip -n > _build/mirage-firewall/initramfs
tar cjf mirage-firewall.tar.bz2 -C _build --mtime=./build-with-docker.sh mirage-firewall
fetchmotron: qubes_firewall.xen
test-mirage qubes_firewall.xen mirage-fw-test &
sleep 1
boot-mirage fetchmotron

9
packet.ml
View File

@ -13,11 +13,14 @@ type ports = {
type host =
[ `Client of client_link | `Client_gateway | `Firewall_uplink | `NetVM | `External of Ipaddr.t ]
type ('src, 'dst) info = {
packet : Nat_packet.t;
type ('src, 'dst) packet = {
ipv4_header : Ipv4_packet.t;
transport_header : [`TCP of Tcp.Tcp_packet.t
|`UDP of Udp_packet.t
|`ICMP of Icmpv4_packet.t];
transport_payload : Cstruct.t;
src : 'src;
dst : 'dst;
proto : [ `UDP of ports | `TCP of ports | `ICMP | `Unknown ];
}
(* The first message in a TCP connection has SYN set and ACK clear. *)

11
rules.ml
View File

@ -42,12 +42,13 @@ let classify_client_packet (info : ([`Client of _], _) Packet.info) rules : Pack
let matches_port dstports (port : int) =
List.exists (fun (Q.Range_inclusive (min, max)) -> (min <= port && port <= max)) dstports
in
let matches_proto rule info = match rule.Pf_qubes.Parse_qubes.proto with
let matches_proto rule packet = match rule.Pf_qubes.Parse_qubes.proto with
| None -> true
| Some p -> match p, info.proto with
| `tcp, `TCP ports -> matches_port rule.Q.dstports ports.dport
| `udp, `UDP ports -> matches_port rule.Q.dstports ports.dport
| `icmp, `ICMP -> true (* TODO *)
| Some p ->
match p, packet.transport_header with
| `tcp, `TCP header -> matches_port rule.Q.dstports header.dst_port
| `udp, `UDP header -> matches_port rule.Q.dstports header.dst_port
| `icmp, `ICMP header -> true (* TODO *)
| _, _ -> false
in
let matches_dest rule info = match rule.Pf_qubes.Parse_qubes.dst with