├── .github └── workflows │ └── ci.yml ├── .gitignore ├── LICENSE.md ├── README.md ├── config.ml └── unikernel.ml /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: Main CI workflow 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - main 8 | 9 | jobs: 10 | build: 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | os: 15 | - ubuntu-latest 16 | 17 | ocaml-compiler: 18 | # - 4.08.x 19 | # - 4.09.x 20 | # - 4.10.x 21 | # - 4.11.x 22 | # - 4.12.x 23 | # - 4.13.x 24 | - 4.14.x 25 | # - 5.3.x 26 | 27 | runs-on: ${{ matrix.os }} 28 | 29 | steps: 30 | - name: Checkout code 31 | uses: actions/checkout@v4 32 | 33 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 34 | uses: ocaml/setup-ocaml@v3 35 | with: 36 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 37 | 38 | - run: opam install mirage -y 39 | 40 | - run: opam exec -- mirage configure -t unix --dhcp false --net direct 41 | 42 | - run: opam exec -- make depend 43 | 44 | - run: opam exec -- make build 45 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | 11 | # ocamlbuild working directory 12 | _build/ 13 | 14 | # ocamlbuild targets 15 | *.byte 16 | *.native 17 | 18 | # Merlin configuring file for Vim and Emacs 19 | .merlin 20 | 21 | # Dune generated files 22 | *.install 23 | 24 | # Local OPAM switch 25 | _opam/ 26 | 27 | # emacs 28 | *~ 29 | *.#.* 30 | 31 | # mirage 32 | .mirage.config 33 | Makefile 34 | dune 35 | dune.build 36 | dune.config 37 | dune-project 38 | myocamlbuild.ml 39 | main.ml 40 | *unikernel*.opam 41 | key_gen.ml 42 | dnsvizor 43 | dnsvizor.hvt 44 | dnsvizor.spt 45 | dnsvizor.xen 46 | dnsvizor.virtio 47 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | BSD 2-Clause License 2 | 3 | Copyright (c) 2020-2025, robur.coop and Jan Midtgaard. All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Mirage-hole 2 | =========== 3 | 4 | This repo contains a prototype implementation of a [DNS 5 | sinkhole](https://en.wikipedia.org/wiki/DNS_sinkhole) in the style of 6 | [Pi-hole](https://github.com/pi-hole/pi-hole) running as a 7 | MirageOS unikernel in OCaml. 8 | 9 | The DNS node works by fetching a list of domain names to be blocked 10 | and then maps them to `localhost` (127.0.0.1) instead of their usual 11 | IP address. DNS queries to non-blocked domains will be passed on to 12 | the upstream DNS server. 13 | 14 | 15 | Building and running as linux binary 16 | ------------------------------------ 17 | 18 | To build: 19 | ``` 20 | mirage configure -t unix --dhcp false --net direct 21 | make depend 22 | make build 23 | ``` 24 | 25 | To run on Linux 26 | - you need a `tap` interface set up (here with IP 10.0.0.10): 27 | ``` 28 | sudo modprobe tun 29 | sudo tunctl -u $USER -t tap0 30 | sudo ifconfig tap0 10.0.0.10 up 31 | ``` 32 | - forwarding should be set up: 33 | ``` 34 | sysctl net.ipv4.ip_forward 35 | sudo sysctl -w net.ipv4.ip_forward=1 36 | ``` 37 | - masquerading should be set up to translate responses coming back (here from the wireless interface): 38 | ``` 39 | sudo iptables -t nat -L -v 40 | sudo iptables -t nat -A POSTROUTING -o wlp0s20f3 -s 10.0.0.2 -j MASQUERADE 41 | ``` 42 | 43 | Now run it as follows: 44 | ``` 45 | sudo ./dist/mirage-hole --ipv4-only=true --ipv4-gateway=10.0.0.10 --dns-upstream=192.168.42.2 --no-tls=true --blocklist-url=https://blocklistproject.github.io/Lists/tracking.txt 46 | ``` 47 | where we pass command-line arguments 48 | - `--ipv4-only=true` as IPv4 is only supported 49 | - `--ipv4-gateway=10.0.0.10` to specify 50 | - `--dns-upstream=192.168.42.2` to specify the upstream DNS server 51 | - `--no-tls=true` to disable DNS over TLS 52 | - `--blocklist-url=URL` is optional (currently defaults to https://blocklistproject.github.io/Lists/tracking.txt) 53 | 54 | Building and running as qubes AppVM 55 | ----------------------------------- 56 | To build: 57 | ``` 58 | mirage configure -t qubes --dhcp true 59 | make depend 60 | make build 61 | ``` 62 | 63 | (note that other solo5 targets should be usable as well) 64 | 65 | To create a Qubes AppVM (this is similar to the procedure for qubes-mirage-firewall): 66 | Run those commands in dom0 to create a `mirage-hole` kernel and an AppVM using that kernel (replace the name of your AppVM where you build your unikernel `dev`, and the corresponding directory `mirage-hole`): 67 | ``` 68 | mkdir -p /var/lib/qubes/vm-kernels/mirage-hole/ 69 | cd /var/lib/qubes/vm-kernels/mirage-hole/ 70 | qvm-run -p dev 'cat mirage-hole/dist/mirage-hole.xen' > vmlinuz 71 | qvm-create \ 72 | --property kernel=mirage-hole \ 73 | --property kernelopts='' \ 74 | --property memory=32 \ 75 | --property maxmem=32 \ 76 | --property netvm=sys-net \ 77 | --property provides_network=False \ 78 | --property vcpus=1 \ 79 | --property virt_mode=pvh \ 80 | --label=green \ 81 | --class StandaloneVM \ 82 | mirage-hole 83 | qvm-features mirage-hole no-default-kernelopts 1 84 | ``` 85 | 86 | Setup DNS: 87 | In order to use it as your default resolver, you will need to run the following in dom0 (with your favorite resolver, which can eventually be another unikernel :) ): 88 | ``` 89 | qvm-prefs mirage-hole kernelopts -- '--dns-upstream=8.8.8.8' 90 | ``` 91 | And specify in sys-net that the resolver should not be retrieved from the DHCP configuration but be fixed: `10.137.0.XX` where `XX` is the IP address given by Qubes to your `mirage-hole` AppVM. 92 | 93 | Usage 94 | ----- 95 | 96 | A DNS query to mirage-hole for a blocked domain will now map to `localhost`: 97 | ``` 98 | $ dig @10.0.0.2 1-cl0ud.com 99 | 100 | ; <<>> DiG 9.16.1-Ubuntu <<>> @10.0.0.2 1-cl0ud.com 101 | ; (1 server found) 102 | ;; global options: +cmd 103 | ;; Got answer: 104 | ;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 42109 105 | ;; flags: qr rd ad; QUERY: 1, ANSWER: 1, AUTHORITY: 0, ADDITIONAL: 0 106 | ;; WARNING: recursion requested but not available 107 | 108 | ;; QUESTION SECTION: 109 | ;1-cl0ud.com. IN A 110 | 111 | ;; ANSWER SECTION: 112 | 1-cl0ud.com. 3600 IN A 127.0.0.1 113 | 114 | ;; Query time: 0 msec 115 | ;; SERVER: 10.0.0.2#53(10.0.0.2) 116 | ;; WHEN: Thu Oct 06 13:28:26 CEST 2022 117 | ;; MSG SIZE rcvd: 45 118 | 119 | ``` 120 | 121 | Note: It can be helpful to trace `tap` network traffic with `sudo tcpdump -i tap0 -n`. 122 | 123 | 124 | TODO 125 | ---- 126 | 127 | - try out with other Mirage backends 128 | - try out with a browser 129 | - add a web-server with a bit of statistics 130 | - check that it works for IPv6 131 | - block other kinds of queries (`TXT`,...) 132 | - extend to fetch blocklist updates dynamically 133 | - as a web-page button 134 | - as cron-like weekly/daily task 135 | - write tests? How? 136 | - ... 137 | 138 | 139 | Acknowledgments 140 | --------------- 141 | 142 | - The code builds on a DNS-stub example from [dnsvizor](https://github.com/roburio/dnsvizor) 143 | - The project is heavily inspired by [Pi-hole](https://github.com/pi-hole/pi-hole) 144 | -------------------------------------------------------------------------------- /config.ml: -------------------------------------------------------------------------------- 1 | (* mirage >= 4.9.0 & < 4.10.0 *) 2 | (* Copyright Robur, 2020 *) 3 | 4 | open Mirage 5 | 6 | let dnsvizor = 7 | main 8 | ~packages: 9 | [ 10 | package "logs" ; 11 | package "metrics" ; 12 | package ~min:"6.0.0" ~sublibs:["mirage"] "dns-stub"; 13 | package "mirage-ptime"; 14 | package "http-mirage-client"; 15 | package "dns"; 16 | package "dns-client"; 17 | package "dns-mirage"; 18 | package "dns-resolver"; 19 | package "dns-tsig"; 20 | package "dns-server"; 21 | package "ca-certs-nss"; 22 | package "hex"; 23 | ] 24 | "Unikernel.Main" 25 | (stackv4v6 @-> http_client @-> job) 26 | 27 | let http_client = 28 | let connect _ modname = function 29 | | [ _tcpv4v6; ctx ] -> 30 | code ~pos:__POS__ {ocaml|%s.connect %s|ocaml} modname ctx 31 | | _ -> assert false 32 | in 33 | impl ~connect "Http_mirage_client.Make" 34 | (tcpv4v6 @-> mimic @-> Mirage.http_client) 35 | 36 | let stackv4v6 = generic_stackv4v6 default_network 37 | let he = generic_happy_eyeballs stackv4v6 38 | let dns = generic_dns_client stackv4v6 he 39 | let tcp = tcpv4v6_of_stackv4v6 stackv4v6 40 | 41 | let http_client = 42 | let happy_eyeballs = mimic_happy_eyeballs stackv4v6 he dns in 43 | http_client $ tcp $ happy_eyeballs 44 | 45 | let () = 46 | register "mirage-hole" [ 47 | dnsvizor 48 | $ stackv4v6 49 | $ http_client ] 50 | -------------------------------------------------------------------------------- /unikernel.ml: -------------------------------------------------------------------------------- 1 | 2 | let argument_error = 64 3 | 4 | (* a default/fall-back blocking URL *) 5 | let url = "https://blocklistproject.github.io/Lists/tracking.txt" 6 | 7 | open Cmdliner 8 | 9 | let src = Logs.Src.create "unikernel" ~doc:"Main unikernel code" 10 | module Log = (val Logs.src_log src : Logs.LOG) 11 | 12 | let dns_upstream = 13 | let doc = Arg.info ~doc:"Upstream DNS resolver IP" ["dns-upstream"] in 14 | Mirage_runtime.register_arg Arg.(value & opt (some string) None doc) 15 | 16 | let dns_port = 17 | let doc = Arg.info ~doc:"Upstream DNS resolver port" ["dns-port"] in 18 | Mirage_runtime.register_arg Arg.(value & opt int 53 doc) 19 | 20 | let dns_cache = 21 | let doc = Arg.info ~doc:"DNS cache size" ["dns-cache"] in 22 | Mirage_runtime.register_arg Arg.(value & opt (some int) None doc) 23 | 24 | let blocklist_url = 25 | let doc = Arg.info ~doc:"URL to fetch the blocked list of domains from" ["blocklist-url"] in 26 | Mirage_runtime.register_arg Arg.(value & opt string url doc) 27 | 28 | let timeout = 29 | let doc = Arg.info ~doc:"Timeout value in ns" ["timeout"] in 30 | Mirage_runtime.register_arg Arg.(value & opt (some int64) None doc) 31 | 32 | module Main 33 | (S : Tcpip.Stack.V4V6) 34 | (HTTP : Http_mirage_client.S) = struct 35 | 36 | module Stub = Dns_stub_mirage.Make(S) 37 | 38 | let is_ip_address str = 39 | try ignore (Ipaddr.V4.of_string_exn str); true 40 | with Ipaddr.Parse_error (_,_) -> false 41 | 42 | (* a simple parser of files in the common blocking list format: 43 | # comment 44 | 0.0.0.0 evil-domain.com *) 45 | let parse_domain_file str = 46 | let lines = String.split_on_char '\n' str in 47 | let lines = List.filter (fun l -> l <> "" && not (String.starts_with ~prefix:"#" l)) lines in 48 | List.filter_map (fun l -> match String.split_on_char ' ' l with 49 | | [ ip; dom_name ] -> 50 | if is_ip_address dom_name 51 | then (Logs.warn (fun m -> m "ip address in hostname position: \"%s\"" l); None) 52 | else 53 | if String.equal "0.0.0.0" ip 54 | then Some dom_name 55 | else (Logs.warn (fun m -> m "non-0.0.0.0 ip in input file: %s" l); Some dom_name) 56 | | _ -> Logs.warn (fun m -> m "unexpected input line format: \"%s\"" l); None) 57 | lines 58 | 59 | (* declare these pairs up front, so that they'll only be allocated once *) 60 | let ipv6_pair = (3600l,Ipaddr.V6.(Set.singleton localhost)) 61 | let ipv4_pair = (3600l,Ipaddr.V4.(Set.singleton localhost)) 62 | let soa = (Dns.Soa.create (Domain_name.of_string_exn "localhost")) 63 | let add_dns_entries str t = 64 | Logs.debug (fun m -> m "adding domain: \"%s\"" str); 65 | match Domain_name.of_string str with 66 | | Error (`Msg msg) -> (Logs.err (fun m -> m "Invalid domain name: %s" msg); t) 67 | | Ok name -> 68 | let t = Dns_trie.insert name Dns.Rr_map.Aaaa ipv6_pair t in 69 | let t = Dns_trie.insert name Dns.Rr_map.A ipv4_pair t in 70 | let t = Dns_trie.insert name Dns.Rr_map.Soa soa t 71 | in t 72 | 73 | let start s http_ctx = 74 | let open Lwt.Syntax in 75 | let open Lwt.Infix in 76 | let dns_upstream = dns_upstream () in 77 | let dns_port = dns_port () in 78 | let cache_size = dns_cache () in 79 | let blocklist_url = blocklist_url () in 80 | let timeout = timeout () in 81 | 82 | let nameservers = 83 | match dns_upstream, dns_port with 84 | | Some ns, port -> 85 | let ns = "udp:"^ns^":"^Int.to_string(port) in 86 | Some [ ns ] 87 | | _, _ -> None 88 | in 89 | 90 | Log.info (fun m -> m "downloading %s" blocklist_url); 91 | let* result = Http_mirage_client.request 92 | http_ctx 93 | blocklist_url 94 | (fun resp acc body -> 95 | if H2.Status.is_successful resp.status 96 | then 97 | begin 98 | Lwt.return (acc^body) 99 | end 100 | else 101 | begin 102 | Logs.warn (fun m -> m "%s: %a" blocklist_url H2.Status.pp_hum resp.status); 103 | Lwt.return acc 104 | end 105 | ) 106 | "" 107 | in 108 | match result with 109 | | Error e -> failwith (Fmt.str "%a" Mimic.pp_error e) 110 | | Ok (_resp, body) -> 111 | Logs.info (fun m -> m "downloaded %s" blocklist_url); 112 | let domains = parse_domain_file body in 113 | let trie = List.fold_right add_dns_entries domains Dns_trie.empty in 114 | let primary_t = 115 | (* setup DNS server state: *) 116 | Dns_server.Primary.create ~rng:Mirage_crypto_rng.generate trie 117 | in 118 | (* setup stub forwarding state and IP listeners: *) 119 | Stub.H.connect_device s >>= fun happy_eyeballs -> 120 | let _ = Stub.create ?cache_size ?timeout ?nameservers primary_t ~happy_eyeballs s in 121 | 122 | (* Since {Stub.create} registers UDP + TCP listeners asynchronously there 123 | is no Lwt task. 124 | We need to return an infinite Lwt task to prevent the unikernel from 125 | exiting early: *) 126 | fst (Lwt.task ()) 127 | end 128 | --------------------------------------------------------------------------------