├── .ocamlformat ├── .gitignore ├── vendor ├── dune ├── letsencrypt │ ├── .gitignore │ ├── dune-project │ ├── src │ │ ├── letsencrypt.ml │ │ ├── dune │ │ ├── primitives.mli │ │ ├── b64u.ml │ │ ├── primitives.ml │ │ └── hTTP_client.ml │ ├── test │ │ ├── dune │ │ ├── tests.ml │ │ ├── b64u_test.ml │ │ └── jwk_test.ml │ ├── dns │ │ ├── dune │ │ ├── letsencrypt_dns.mli │ │ └── letsencrypt_dns.ml │ ├── bin │ │ ├── dune │ │ └── acme_server.ml │ ├── mirage │ │ ├── dune │ │ ├── lE_http_server.mli │ │ └── lE.mli │ ├── README.md │ ├── letsencrypt-dns.opam │ ├── letsencrypt-mirage.opam │ ├── letsencrypt-app.opam │ ├── letsencrypt.opam │ ├── LICENSE.md │ └── CHANGES.md └── dns │ ├── dune-project │ ├── resolvconf │ ├── dns_resolvconf.mli │ ├── resolvconf_state.ml │ ├── dune │ ├── dns_resolvconf.ml │ ├── resolvconf_parser.mly │ └── resolvconf_lexer.mll │ ├── tsig │ ├── dune │ └── dns_tsig.mli │ ├── mirage │ ├── dune │ ├── server │ │ ├── dune │ │ └── dns_server_mirage.mli │ ├── certify │ │ ├── dune │ │ └── dns_certify_mirage.mli │ ├── resolver │ │ ├── dune │ │ └── dns_resolver_mirage.mli │ ├── stub │ │ └── dune │ ├── client │ │ ├── dune │ │ └── dns_client_mirage.mli │ ├── dns_mirage.mli │ └── dns_mirage.ml │ ├── .gitignore │ ├── server │ └── dune │ ├── dnssec │ └── dune │ ├── resolver │ ├── dune │ ├── dns_resolver_utils.mli │ ├── dns_resolver_root.mli │ ├── dns_resolver_cache.mli │ ├── dns_resolver.mli │ └── dns_resolver_root.ml │ ├── Makefile │ ├── certify │ └── dune │ ├── cache │ ├── dune │ └── dns_cache.mli │ ├── client │ └── dune │ ├── miou │ └── client │ │ ├── dune │ │ └── dns_client_miou_unix.mli │ ├── src │ └── dune │ ├── zone │ ├── dune │ ├── dns_zone_state.mli │ ├── dns_zone_state.ml │ ├── dns_zone.mli │ └── dns_zone_lexer.mll │ ├── lwt │ └── client │ │ ├── dune │ │ └── dns_client_lwt.mli │ ├── unix │ └── client │ │ ├── dune │ │ ├── dns_client_unix.mli │ │ └── ohost.ml │ ├── dns-tsig.opam │ ├── dns-client.opam │ ├── dns-client-miou-unix.opam │ ├── dns-client-lwt.opam │ ├── test │ ├── dune │ ├── tsig.ml │ └── resolvconf.ml │ ├── dnssec.opam │ ├── dns-client-mirage.opam │ ├── dns-stub.opam │ ├── dns-resolver.opam │ ├── dns-server.opam │ ├── dns-certify.opam │ ├── LICENSE.md │ ├── dns-mirage.opam │ ├── app │ ├── dune │ ├── ozone.ml │ ├── dns_cli.ml │ └── oupdate.ml │ ├── dns-cli.opam │ └── dns.opam ├── dune-project ├── lib ├── cap │ ├── raw.ml │ ├── store.capnp │ ├── dune │ ├── cert_callback.ml │ ├── schema.capnp │ ├── secondary.ml │ └── db.ml ├── acme │ ├── dune │ ├── tls_le.mli │ └── tls_le.ml ├── transport │ ├── dune │ ├── datagram.ml │ ├── stream.mli │ ├── datagram.mli │ ├── transport.ml │ ├── packet.mli │ ├── domain_name_data.mli │ ├── unique_packet.mli │ ├── cstruct_stream.mli │ ├── packet.ml │ ├── frag_packet.mli │ ├── unique_packet.ml │ ├── stream.ml │ ├── frag_packet.ml │ ├── transport.mli │ ├── cstruct_stream.ml │ └── domain_name_data.ml ├── util │ ├── zonefile.mli │ ├── listen.mli │ ├── server_args.mli │ ├── dns_log.mli │ ├── dune │ ├── listen.ml │ ├── dns_log.ml │ ├── zonefile.ml │ └── server_args.ml ├── dns_client_eio.mli ├── dns_resolver_eio.mli ├── dune ├── dns_server_eio.mli └── dns_client_eio.ml ├── bin ├── transport │ ├── dodo │ │ ├── README.md │ │ ├── dune │ │ └── dodo_resolver.ml │ ├── tunnel │ │ ├── dune │ │ ├── tund.ml │ │ └── tun.ml │ ├── netcat │ │ ├── dune │ │ ├── netcat.ml │ │ └── netcatd.ml │ └── sod │ │ ├── fork_actions.ml │ │ ├── dune │ │ ├── pty.ml │ │ ├── fork_actions.c │ │ └── sod.ml ├── dune ├── hibernia │ ├── dune │ └── hibernia.ml ├── cap │ └── dune └── eon.ml ├── example ├── example.org._keys └── example.org ├── docs ├── transport.md ├── dynamic-updates.md └── cap.md ├── LICENSE ├── flake.nix ├── eon.opam └── README.md /.ocamlformat: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _* 2 | result 3 | 4 | -------------------------------------------------------------------------------- /vendor/dune: -------------------------------------------------------------------------------- 1 | (vendored_dirs *) 2 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.4) 2 | (name eon) 3 | -------------------------------------------------------------------------------- /lib/cap/raw.ml: -------------------------------------------------------------------------------- 1 | module Api = Schema.MakeRPC (Capnp_rpc) 2 | -------------------------------------------------------------------------------- /vendor/letsencrypt/.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | .merlin 3 | *.install 4 | .*.swp 5 | -------------------------------------------------------------------------------- /vendor/letsencrypt/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.2) 2 | (name letsencrypt) 3 | -------------------------------------------------------------------------------- /vendor/dns/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | (name dns) 3 | (formatting disabled) 4 | -------------------------------------------------------------------------------- /bin/transport/dodo/README.md: -------------------------------------------------------------------------------- 1 | 2 | # DNS over DNS Obliviously (DoDO) 🦤 3 | 4 | TODO... 5 | -------------------------------------------------------------------------------- /vendor/letsencrypt/src/letsencrypt.ml: -------------------------------------------------------------------------------- 1 | include Acme_common 2 | 3 | module Client = Acme_client 4 | -------------------------------------------------------------------------------- /example/example.org._keys: -------------------------------------------------------------------------------- 1 | $ORIGIN example.org. 2 | client._update IN DNSKEY 0 3 163 FGwot7AqiDIthEv6TippJm35DaRpRac5NSLd/wSp9go= 3 | -------------------------------------------------------------------------------- /lib/acme/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name tls_le) 3 | (modules tls_le) 4 | (public_name eon.tls-le) 5 | (libraries eio letsencrypt)) 6 | -------------------------------------------------------------------------------- /vendor/dns/resolvconf/dns_resolvconf.mli: -------------------------------------------------------------------------------- 1 | val parse : string -> ([ `Nameserver of Ipaddr.t ] list, [> `Msg of string ]) result 2 | -------------------------------------------------------------------------------- /lib/transport/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name transport) 3 | (public_name eon.transport) 4 | (libraries dns_server_eio dns_client_eio)) 5 | -------------------------------------------------------------------------------- /lib/transport/datagram.ml: -------------------------------------------------------------------------------- 1 | type t = { send : Cstruct.t -> unit; recv : Cstruct.t -> int } 2 | 3 | let create send recv = { send; recv } 4 | -------------------------------------------------------------------------------- /vendor/dns/tsig/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_tsig) 3 | (public_name dns-tsig) 4 | (wrapped false) 5 | (libraries dns digestif base64)) 6 | -------------------------------------------------------------------------------- /vendor/letsencrypt/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name tests) 3 | (package letsencrypt) 4 | (libraries letsencrypt ounit2 mirage-crypto-rng.unix)) 5 | -------------------------------------------------------------------------------- /lib/transport/stream.mli: -------------------------------------------------------------------------------- 1 | type t = Eio.Flow.two_way_ty Eio.Resource.t 2 | 3 | val create : inc:Cstruct_stream.t -> out:Cstruct_stream.t -> t 4 | -------------------------------------------------------------------------------- /vendor/dns/mirage/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_mirage) 3 | (public_name dns-mirage) 4 | (wrapped false) 5 | (libraries dns tcpip ipaddr lwt)) 6 | -------------------------------------------------------------------------------- /vendor/dns/.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | *.install 3 | .merlin 4 | 5 | *pcap 6 | *out 7 | coverage/ 8 | *req 9 | *key 10 | *private 11 | *pem 12 | -------------------------------------------------------------------------------- /vendor/letsencrypt/dns/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name letsencrypt_dns) 3 | (public_name letsencrypt-dns) 4 | (libraries letsencrypt logs dns dns-tsig)) 5 | -------------------------------------------------------------------------------- /lib/transport/datagram.mli: -------------------------------------------------------------------------------- 1 | type t = { send : Cstruct.t -> unit; recv : Cstruct.t -> int } 2 | 3 | val create : (Cstruct.t -> unit) -> (Cstruct.t -> int) -> t 4 | -------------------------------------------------------------------------------- /vendor/dns/server/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_server) 3 | (public_name dns-server) 4 | (wrapped false) 5 | (libraries dns randomconv duration metrics)) 6 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name eon) 3 | (modules eon) 4 | (public_name eon) 5 | (package eon) 6 | (libraries dns_server_eio dns_resolver_eio server_args dns_log)) 7 | -------------------------------------------------------------------------------- /vendor/dns/dnssec/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dnssec) 3 | (public_name dnssec) 4 | (wrapped false) 5 | (libraries mirage-crypto mirage-crypto-pk mirage-crypto-ec dns logs domain-name ohex)) 6 | -------------------------------------------------------------------------------- /vendor/dns/resolver/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_resolver) 3 | (public_name dns-resolver) 4 | (wrapped false) 5 | (libraries dns dns.cache dns-server lru duration randomconv dnssec)) 6 | -------------------------------------------------------------------------------- /lib/transport/transport.ml: -------------------------------------------------------------------------------- 1 | module Stream_server = Stream_server 2 | module Stream_client = Stream_client 3 | module Datagram_server = Datagram_server 4 | module Datagram_client = Datagram_client 5 | -------------------------------------------------------------------------------- /vendor/dns/Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: build clean test doc 2 | 3 | build: 4 | dune build 5 | 6 | test: 7 | dune runtest 8 | 9 | doc: 10 | dune build @doc 11 | 12 | clean: 13 | dune clean 14 | -------------------------------------------------------------------------------- /vendor/dns/certify/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_certify) 3 | (public_name dns-certify) 4 | (wrapped false) 5 | (libraries dns dns-tsig x509 randomconv logs mirage-crypto-ec mirage-crypto-pk)) 6 | -------------------------------------------------------------------------------- /lib/util/zonefile.mli: -------------------------------------------------------------------------------- 1 | val parse_zonefiles : 2 | fs:_ Eio.Path.t -> 3 | string list -> 4 | Dns_trie.t 5 | * ([ `raw ] Domain_name.t * Dns.Dnskey.t) list 6 | * [ `raw ] Domain_name.t list 7 | -------------------------------------------------------------------------------- /bin/hibernia/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name hibernia) 3 | (modules hibernia) 4 | (public_name hibernia) 5 | (package eon) 6 | (libraries dns_server_eio dns_resolver_eio server_args dns_log wol wol-eio)) 7 | -------------------------------------------------------------------------------- /lib/transport/packet.mli: -------------------------------------------------------------------------------- 1 | type t = { 2 | (* for retransmissions *) 3 | seq_no : int; 4 | data : Cstruct.t; 5 | } 6 | 7 | val decode : Cstruct.t -> t 8 | val encode : int -> Cstruct.t -> Cstruct.t 9 | -------------------------------------------------------------------------------- /vendor/dns/cache/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_cache) 3 | (public_name dns.cache) 4 | (modules dns_cache) 5 | (libraries domain-name dns duration lru metrics) 6 | (wrapped false)) 7 | -------------------------------------------------------------------------------- /vendor/dns/client/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_client) 3 | (public_name dns-client) 4 | (modules dns_client) 5 | (libraries dns.cache domain-name dns randomconv) 6 | (wrapped false)) 7 | -------------------------------------------------------------------------------- /vendor/dns/miou/client/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_client_miou_unix) 3 | (modules dns_client_miou_unix) 4 | (public_name dns-client-miou-unix) 5 | (libraries dns-client tls-miou-unix happy-eyeballs-miou-unix)) 6 | -------------------------------------------------------------------------------- /vendor/dns/mirage/server/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_server_mirage) 3 | (public_name dns-server.mirage) 4 | (wrapped false) 5 | (libraries dns dns-server dns-mirage lwt duration randomconv mirage-time mirage-clock tcpip metrics)) 6 | -------------------------------------------------------------------------------- /vendor/dns/resolvconf/resolvconf_state.ml: -------------------------------------------------------------------------------- 1 | (* State variables for the parser & lexer *) 2 | type parserstate = { 3 | mutable lineno : int ; 4 | } 5 | 6 | let state = { 7 | lineno = 1 ; 8 | } 9 | 10 | let reset () = 11 | state.lineno <- 1 12 | -------------------------------------------------------------------------------- /vendor/dns/mirage/certify/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_certify_mirage) 3 | (public_name dns-certify.mirage) 4 | (wrapped false) 5 | (libraries dns dns-mirage dns-certify mirage-crypto-rng-mirage mirage-crypto-pk lwt duration mirage-time mirage-clock tcpip)) 6 | -------------------------------------------------------------------------------- /lib/transport/domain_name_data.mli: -------------------------------------------------------------------------------- 1 | val max_encoded_len : int 2 | 3 | val decode : 4 | String.t -> 5 | [ `raw ] Domain_name.t -> 6 | (Cstruct.t * [ `raw ] Domain_name.t) option 7 | 8 | val encode : [ `raw ] Domain_name.t -> Cstruct.t -> [ `raw ] Domain_name.t 9 | -------------------------------------------------------------------------------- /vendor/dns/mirage/resolver/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_resolver_mirage) 3 | (public_name dns-resolver.mirage) 4 | (wrapped false) 5 | (libraries dns dns-resolver dns-server dns-mirage lwt duration mirage-time mirage-clock tcpip mirage-crypto-rng-mirage tls tls-mirage)) 6 | -------------------------------------------------------------------------------- /vendor/dns/mirage/stub/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_stub_mirage) 3 | (public_name dns-stub.mirage) 4 | (wrapped false) 5 | (libraries dns dns-server dns-tsig metrics dns-resolver dns-mirage dns-client-mirage lwt mirage-time mirage-clock tcpip mirage-crypto-rng-mirage)) 6 | -------------------------------------------------------------------------------- /vendor/dns/src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns) 3 | (public_name dns) 4 | (wrapped false) 5 | (libraries fmt ipaddr logs ptime gmap domain-name metrics base64 ohex) 6 | ; (preprocess (pps ppx_expect)) ; once https://github.com/ocaml/dune/issues/897 is resolved 7 | ; (inline_tests) 8 | ) 9 | -------------------------------------------------------------------------------- /vendor/dns/zone/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_zone) 3 | (public_name dns-server.zone) 4 | (private_modules dns_zone_state dns_zone_parser dns_zone_lexer) 5 | (libraries dns dns-server logs) 6 | (wrapped false)) 7 | 8 | (ocamlyacc dns_zone_parser) 9 | (ocamllex dns_zone_lexer) 10 | -------------------------------------------------------------------------------- /lib/util/listen.mli: -------------------------------------------------------------------------------- 1 | val on_addrs : 2 | net:[> 'a Eio.Net.ty ] Eio.Resource.t -> 3 | proto:[< `Tcp | `Udp ] list -> 4 | ('a Eio.Net.datagram_socket_ty Eio.Resource.t -> unit) -> 5 | ('a Eio.Net.listening_socket_ty Eio.Resource.t -> unit) -> 6 | (Eio.Net.Ipaddr.v4v6 * int) list -> 7 | unit 8 | -------------------------------------------------------------------------------- /lib/transport/unique_packet.mli: -------------------------------------------------------------------------------- 1 | type t = { 2 | (* for uniqueness when encoding in query domain names *) 3 | id : int; 4 | (* for retransmissions *) 5 | seq_no : int; 6 | data : Cstruct.t; 7 | } 8 | 9 | val decode : Cstruct.t -> t 10 | val encode : int -> int -> Cstruct.t -> Cstruct.t 11 | -------------------------------------------------------------------------------- /vendor/dns/mirage/client/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_client_mirage) 3 | (public_name dns-client-mirage) 4 | (libraries domain-name ipaddr mirage-crypto-rng-mirage mirage-time tcpip mirage-clock dns-client happy-eyeballs happy-eyeballs-mirage tls-mirage ca-certs-nss) 5 | (wrapped false)) 6 | -------------------------------------------------------------------------------- /vendor/dns/resolvconf/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_resolvconv) 3 | (public_name dns-client.resolvconf) 4 | (private_modules resolvconf_lexer resolvconf_parser resolvconf_state) 5 | (libraries ipaddr fmt) 6 | (wrapped false)) 7 | 8 | (ocamlyacc resolvconf_parser) 9 | (ocamllex resolvconf_lexer) 10 | -------------------------------------------------------------------------------- /vendor/letsencrypt/test/tests.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let () = 4 | let tests = 5 | B64u_test.all_tests @ Jwk_test.all_tests @ Jws_test.all_tests 6 | in 7 | let suite = "suite">::: tests in 8 | Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna); 9 | run_test_tt_main suite 10 | -------------------------------------------------------------------------------- /vendor/dns/miou/client/dns_client_miou_unix.mli: -------------------------------------------------------------------------------- 1 | module Transport : Dns_client.S 2 | with type io_addr = [ `Plaintext of Ipaddr.t * int | `Tls of Tls.Config.client * Ipaddr.t * int ] 3 | and type +'a io = 'a 4 | and type stack = Happy_eyeballs_miou_unix.t 5 | 6 | include module type of Dns_client.Make (Transport) 7 | -------------------------------------------------------------------------------- /lib/cap/store.capnp: -------------------------------------------------------------------------------- 1 | @0x8c940eaf41b95341; 2 | 3 | struct SavedDomain { 4 | name @0 :Text; 5 | primary @1 :Text; 6 | } 7 | 8 | struct SavedSecondary { 9 | name @0 :Text; 10 | } 11 | 12 | struct SavedService { 13 | union { 14 | domain @0 :SavedDomain; 15 | secondary @1 :SavedSecondary; 16 | } 17 | } 18 | 19 | -------------------------------------------------------------------------------- /bin/transport/tunnel/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name tun) 3 | (modules tun) 4 | (public_name tun) 5 | (package eon) 6 | (libraries transport server_args dns_log tuntap)) 7 | 8 | (executable 9 | (name tund) 10 | (modules tund) 11 | (public_name tund) 12 | (package eon) 13 | (libraries transport server_args dns_log tuntap)) 14 | -------------------------------------------------------------------------------- /vendor/dns/lwt/client/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_client_lwt) 3 | (modules dns_client_lwt) 4 | (public_name dns-client-lwt) 5 | (libraries lwt lwt.unix dns dns-client dns-client.resolvconf mtime.clock.os mirage-crypto-rng-lwt ipaddr.unix happy-eyeballs happy-eyeballs-lwt tls-lwt ca-certs) 6 | (wrapped false)) 7 | -------------------------------------------------------------------------------- /bin/transport/netcat/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name netcat) 3 | (modules netcat) 4 | (public_name netcat) 5 | (package eon) 6 | (libraries transport server_args dns_log)) 7 | 8 | (executable 9 | (name netcatd) 10 | (modules netcatd) 11 | (public_name netcatd) 12 | (package eon) 13 | (libraries transport server_args dns_log)) 14 | -------------------------------------------------------------------------------- /vendor/letsencrypt/src/dune: -------------------------------------------------------------------------------- 1 | (rule (with-stdout-to version.ml (echo "let t = \"%{version:letsencrypt}\""))) 2 | 3 | (library 4 | (name letsencrypt) 5 | (public_name letsencrypt) 6 | (libraries http cohttp-eio eio eio.unix logs yojson lwt base64 mirage-crypto mirage-crypto-pk mirage-crypto-ec asn1-combinators x509 uri tls-eio digestif)) 7 | -------------------------------------------------------------------------------- /vendor/letsencrypt/bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name oacmel) 3 | (public_name oacmel) 4 | (package letsencrypt-app) 5 | (modules oacmel) 6 | (libraries letsencrypt letsencrypt-dns ptime.clock.os ipaddr.unix cohttp cohttp-eio mirage-crypto-rng-eio eio_main fpath randomconv cmdliner mirage-crypto-rng.unix fmt.cli fmt.tty logs.fmt logs.cli)) 7 | -------------------------------------------------------------------------------- /vendor/letsencrypt/src/primitives.mli: -------------------------------------------------------------------------------- 1 | 2 | val pub_of_z : e:Z.t -> n:Z.t -> (Mirage_crypto_pk.Rsa.pub, [> `Msg of string ]) result 3 | val pub_to_z : Mirage_crypto_pk.Rsa.pub -> Z.t * Z.t 4 | 5 | val sign : Digestif.hash' -> X509.Private_key.t -> string -> string 6 | val verify : Digestif.hash' -> X509.Public_key.t -> string -> string -> bool 7 | 8 | val sha256 : string -> string 9 | -------------------------------------------------------------------------------- /lib/util/server_args.mli: -------------------------------------------------------------------------------- 1 | open Cmdliner 2 | 3 | val zonefiles : string list Term.t 4 | val log_level : Dns_log.level -> Dns_log.level Term.t 5 | val port : int Term.t 6 | val addresses : string list Term.t 7 | val parse_addresses : int -> string list -> (Eio.Net.Ipaddr.v4v6 * int) list 8 | val proto : [> `Tcp | `Udp ] list Term.t 9 | val resolver : bool Term.t 10 | val man : Manpage.block list 11 | -------------------------------------------------------------------------------- /docs/transport.md: -------------------------------------------------------------------------------- 1 | ### Transport 2 | 3 | The [transport.ml](src/transport.ml) file contains logic to use DNS as a stream or datagram [transport](https://en.wikipedia.org/wiki/Transport_layer) protocol. 4 | An example application that uses this can be found in [netcat.ml](bin/transport/netcat.ml)/[netcatd.ml](bin/transport/netcatd.ml). 5 | 6 | This is a work in progress and seems to have some bugs to iron out. 7 | 8 | -------------------------------------------------------------------------------- /lib/transport/cstruct_stream.mli: -------------------------------------------------------------------------------- 1 | type t = { 2 | items : Cstruct.t list ref; 3 | mut : Eio.Mutex.t; 4 | cond : Eio.Condition.t; 5 | } 6 | 7 | exception Empty 8 | 9 | val create : unit -> t 10 | val add : t -> Cstruct.t list -> unit 11 | val take : t -> Cstruct.t -> int 12 | val try_take : t -> Cstruct.t -> int option 13 | val take_one : t -> Cstruct.t -> int 14 | val try_take_one : t -> Cstruct.t option 15 | -------------------------------------------------------------------------------- /lib/util/dns_log.mli: -------------------------------------------------------------------------------- 1 | type dir = Rx | Tx 2 | type log = Format.formatter -> dir -> Eio.Net.Sockaddr.t -> string -> unit 3 | type formattedLog = dir -> Eio.Net.Sockaddr.t -> string -> unit 4 | type level = Level0 | Level1 | Level2 | Level3 5 | 6 | (* TODO is there a way to deduplciate these type signatures? *) 7 | val level_0 : log 8 | val level_1 : log 9 | val level_2 : log 10 | val level_3 : log 11 | val get : level -> log 12 | -------------------------------------------------------------------------------- /lib/transport/packet.ml: -------------------------------------------------------------------------------- 1 | type t = { seq_no : int; data : Cstruct.t } 2 | 3 | let decode buf = 4 | let seq_no = Cstruct.BE.get_uint16 buf 0 in 5 | let data = Cstruct.sub buf 2 (Cstruct.length buf - 2) in 6 | { seq_no; data } 7 | 8 | let encode seq_no data = 9 | let buf = Cstruct.create (2 + Cstruct.length data) in 10 | Cstruct.BE.set_uint16 buf 0 seq_no; 11 | Cstruct.blit data 0 buf 2 (Cstruct.length data); 12 | buf 13 | -------------------------------------------------------------------------------- /lib/dns_client_eio.mli: -------------------------------------------------------------------------------- 1 | type 'a dns_handler = Dns.proto -> Eio.Net.Sockaddr.t -> string -> 'a -> 'a 2 | 3 | val send_query : 4 | Dns_log.formattedLog -> 5 | int -> 6 | 'a Dns.Rr_map.rr -> 7 | 'b Domain_name.t -> 8 | _ Eio.Net.datagram_socket -> 9 | Eio.Net.Sockaddr.datagram -> 10 | unit 11 | 12 | val listen : 13 | _ Eio.Net.datagram_socket -> 14 | Dns_log.formattedLog -> 15 | 'a dns_handler -> 16 | 'a -> 17 | unit 18 | -------------------------------------------------------------------------------- /bin/transport/sod/fork_actions.ml: -------------------------------------------------------------------------------- 1 | (* TODO upstream PTY support: https://github.com/ocaml-multicore/eio/pull/461#issuecomment-1497427461 *) 2 | 3 | external action_setup_shell : unit -> Eio_unix.Private.Fork_action.fork_fn 4 | = "eio_unix_fork_setup_shell" 5 | 6 | let action_setup_shell = action_setup_shell () 7 | 8 | let setup_shell pty : Eio_unix.Private.Fork_action.t = 9 | { run = (fun k -> k (Obj.repr (action_setup_shell, pty))) } 10 | -------------------------------------------------------------------------------- /vendor/letsencrypt/mirage/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name le) 3 | (wrapped false) 4 | (public_name letsencrypt-mirage) 5 | (modules lE) 6 | (libraries letsencrypt http-mirage-client tcpip mirage-time duration emile)) 7 | 8 | (library 9 | (name le_http_server) 10 | (wrapped false) 11 | (public_name letsencrypt-mirage.http-server) 12 | (modules lE_http_server) 13 | (libraries letsencrypt letsencrypt-mirage paf.mirage mirage-crypto-rng-mirage)) 14 | -------------------------------------------------------------------------------- /bin/transport/dodo/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name dodo_resolver) 3 | (modules dodo_resolver) 4 | (public_name dodo-resolver) 5 | (package eon) 6 | (libraries transport server_args dns_log)) 7 | 8 | (executable 9 | (name dodo_server) 10 | (modules dodo_server) 11 | (public_name dodo-server) 12 | (package eon) 13 | (libraries transport dns_resolver_eio server_args dns_log)) 14 | 15 | (env 16 | (dev 17 | (flags 18 | (:standard -w -27 -w -26)))) 19 | -------------------------------------------------------------------------------- /example/example.org: -------------------------------------------------------------------------------- 1 | $ORIGIN example.org. 2 | $TTL 3600 3 | @ IN SOA ns1 dns ( 4 | 1 ; Serial No. 5 | 3600 ; 1hr Refresh 6 | 900 ; 15m Retry 7 | 1814400 ; 21d Expire 8 | 3600 ; 1hr Negative Cache TTL 9 | ) 10 | @ IN NS ns1 11 | ns1 IN A 203.0.113.0 12 | @ IN A 203.0.113.0 13 | @ IN AAAA 2001:DB8:: 14 | ns.subdomain IN A 128.232.113.136 15 | subdomain IN NS ns.subdomain 16 | -------------------------------------------------------------------------------- /bin/cap/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name capd) 3 | (modules capd) 4 | (public_name capd) 5 | (package eon) 6 | (libraries 7 | dns_server_eio 8 | server_args 9 | dns_log 10 | dns_acme 11 | dns 12 | eio_main 13 | cap 14 | capnp-rpc-unix 15 | mirage-crypto-rng.unix 16 | logs.fmt)) 17 | 18 | (executable 19 | (name capc) 20 | (modules capc) 21 | (public_name capc) 22 | (package eon) 23 | (libraries cap eio_main capnp-rpc-unix mirage-crypto-rng.unix)) 24 | -------------------------------------------------------------------------------- /vendor/dns/unix/client/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_client_unix) 3 | (modules dns_client_unix) 4 | (public_name dns-client.unix) 5 | (libraries domain-name ipaddr ipaddr.unix dns-client dns-client.resolvconf unix mtime.clock.os mirage-crypto-rng.unix) 6 | (wrapped false)) 7 | 8 | (executable 9 | (name ohost) 10 | (modules ohost) 11 | (package dns-client) 12 | (public_name dns-client.unix) 13 | (libraries fmt dns-client.unix mtime.clock.os)) 14 | -------------------------------------------------------------------------------- /lib/dns_resolver_eio.mli: -------------------------------------------------------------------------------- 1 | type dns_handler = 2 | Dns.proto -> 3 | Eio.Net.Sockaddr.t -> 4 | string -> 5 | (* answers *) 6 | (Dns.proto * Ipaddr.t * int * string) list (* queries *) 7 | * (Dns.proto * Ipaddr.t * string) list 8 | 9 | val resolver : 10 | < net : _ Eio.Net.t 11 | ; clock : _ Eio.Time.clock 12 | ; mono_clock : _ Eio.Time.Mono.t 13 | ; .. > -> 14 | [ `Tcp | `Udp ] list -> 15 | Dns_resolver.t ref -> 16 | Dns_log.formattedLog -> 17 | (Eio.Net.Ipaddr.v4v6 * int) list -> 18 | unit 19 | -------------------------------------------------------------------------------- /lib/transport/frag_packet.mli: -------------------------------------------------------------------------------- 1 | type packet = { 2 | id : int; 3 | n_frags : int; (** how many fragments to expect for this packet *) 4 | } 5 | 6 | type t = 7 | | Packet of { 8 | packet : packet; 9 | frag_nb : int; (** identifying fragment in packet *) 10 | data : Cstruct.t; 11 | } 12 | (* we need a packet id for the client to send unique dummy packets to avoid caching *) 13 | | Dummy of { id : int } 14 | 15 | val decode : Cstruct.t -> t 16 | val encode : t -> Cstruct.t 17 | val dummy : int -> t 18 | -------------------------------------------------------------------------------- /lib/transport/unique_packet.ml: -------------------------------------------------------------------------------- 1 | type t = { id : int; seq_no : int; data : Cstruct.t } 2 | 3 | let decode buf = 4 | let id = Cstruct.BE.get_uint16 buf 0 in 5 | let seq_no = Cstruct.BE.get_uint16 buf 2 in 6 | let data = Cstruct.sub buf 4 (Cstruct.length buf - 4) in 7 | { id; seq_no; data } 8 | 9 | let encode id seq_no data = 10 | let buf = Cstruct.create (4 + Cstruct.length data) in 11 | Cstruct.BE.set_uint16 buf 0 id; 12 | Cstruct.BE.set_uint16 buf 2 seq_no; 13 | Cstruct.blit data 0 buf 4 (Cstruct.length data); 14 | buf 15 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_client_eio) 3 | (modules dns_client_eio) 4 | (public_name eon.dns-client-eio) 5 | (libraries dns_log eio_main dns)) 6 | 7 | (library 8 | (name dns_server_eio) 9 | (modules dns_server_eio) 10 | (public_name eon.dns-server-eio) 11 | (libraries dns_log zonefile listen eio_main dns dns-tsig dns-server fmt)) 12 | 13 | (library 14 | (name dns_resolver_eio) 15 | (modules dns_resolver_eio) 16 | (public_name eon.dns-resolver-eio) 17 | (libraries dns_log zonefile listen eio_main dns dns-tsig dns-resolver fmt)) 18 | -------------------------------------------------------------------------------- /lib/util/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_log) 3 | (modules dns_log) 4 | (public_name eon.dns-log) 5 | (libraries eio_main dns)) 6 | 7 | (library 8 | (name server_args) 9 | (modules server_args) 10 | (public_name eon.server-args) 11 | (libraries cmdliner ipaddr eio dns_log)) 12 | 13 | (library 14 | (name zonefile) 15 | (modules zonefile) 16 | (public_name eon.zonefile) 17 | (libraries eio_main dns dns-server.zone)) 18 | 19 | (library 20 | (name listen) 21 | (modules listen) 22 | (public_name eon.listen) 23 | (libraries eio_main dns)) 24 | -------------------------------------------------------------------------------- /vendor/dns/resolvconf/dns_resolvconf.ml: -------------------------------------------------------------------------------- 1 | let parse buf = 2 | try 3 | Resolvconf_state.reset (); 4 | let buf = 5 | if String.(get buf (pred (length buf))) = '\n' then buf else buf ^ "\n" 6 | in 7 | let lexbuf = Lexing.from_string buf in 8 | Ok (Resolvconf_parser.resolvconf Resolvconf_lexer.lex lexbuf) 9 | with 10 | | Parsing.Parse_error -> 11 | Error (`Msg (Fmt.str "parse error at line %d" Resolvconf_state.(state.lineno))) 12 | | exn -> 13 | Error (`Msg (Fmt.str "error at line %d: %s" Resolvconf_state.(state.lineno) 14 | (Printexc.to_string exn))) 15 | -------------------------------------------------------------------------------- /vendor/dns/unix/client/dns_client_unix.mli: -------------------------------------------------------------------------------- 1 | (** [Unix] helper module for {!Dns_client}. 2 | For more information see the {!Dns_client.Make} functor. 3 | 4 | It initializes the RNG (using 5 | [Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna)]). 6 | *) 7 | 8 | 9 | (** A flow module based on blocking I/O on top of the Unix socket API. 10 | 11 | TODO: Implement the connect timeout. 12 | *) 13 | module Transport : Dns_client.S 14 | with type io_addr = Ipaddr.t * int 15 | and type stack = unit 16 | and type +'a io = 'a 17 | 18 | include module type of Dns_client.Make(Transport) 19 | -------------------------------------------------------------------------------- /bin/transport/sod/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name sodd) 3 | (modules sodd) 4 | (public_name sodd) 5 | (libraries 6 | pty 7 | fork_actions 8 | eio_main 9 | eio_linux 10 | cmdliner 11 | eon.transport 12 | eon.server-args)) 13 | 14 | (executable 15 | (name sod) 16 | (modules sod) 17 | (public_name sod) 18 | (libraries pty eio_main eio_linux cmdliner eon.transport eon.server-args)) 19 | 20 | (library 21 | (name pty) 22 | (modules pty) 23 | (libraries unix) 24 | (foreign_stubs 25 | (language c) 26 | (names pty))) 27 | 28 | (library 29 | (name fork_actions) 30 | (modules fork_actions) 31 | (libraries eio_main) 32 | (foreign_stubs 33 | (language c) 34 | (names fork_actions))) 35 | -------------------------------------------------------------------------------- /vendor/dns/lwt/client/dns_client_lwt.mli: -------------------------------------------------------------------------------- 1 | (** {!Lwt_unix} helper module for {!Dns_client}. 2 | For more information see the {!Dns_client.Make} functor. 3 | 4 | The {!Dns_client} is available as Dns_client_lwt after 5 | linking to dns-client.lwt in your dune file. 6 | 7 | It initializes the RNG (using Mirage_crypto_rng_lwt.initialize ()). 8 | *) 9 | 10 | 11 | (** A flow module based on non-blocking I/O on top of the 12 | Lwt_unix socket API. *) 13 | module Transport : Dns_client.S 14 | with type io_addr = [ `Plaintext of Ipaddr.t * int | `Tls of Tls.Config.client * Ipaddr.t * int ] 15 | and type +'a io = 'a Lwt.t 16 | and type stack = Happy_eyeballs_lwt.t 17 | 18 | include module type of Dns_client.Make(Transport) 19 | -------------------------------------------------------------------------------- /vendor/dns/resolver/dns_resolver_utils.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | open Dns 4 | 5 | type e = E : 'a Rr_map.key * 'a Dns_cache.entry -> e 6 | 7 | val scrub : [ `raw ] Domain_name.t -> signed:bool -> Packet.Question.qtype -> 8 | Packet.t -> 9 | (([ `raw ] Domain_name.t * e * Dns_cache.rank) list, Rcode.t) result 10 | (** [scrub bailiwick packet] returns a list of entries to-be-added to the 11 | cache. This respects only in-bailiwick resources records, and qualifies the 12 | [packet]. The purpose is to avoid cache poisoning by not accepting all 13 | resource records. *) 14 | 15 | val invalid_soa : [ `raw ] Domain_name.t -> Soa.t (** [invalid_soa name] returns a stub 16 | SOA for [name]. *) 17 | -------------------------------------------------------------------------------- /lib/cap/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name cap) 3 | (package eon) 4 | (modules 5 | cert 6 | cert_callback 7 | db 8 | domain 9 | primary 10 | raw 11 | secondary 12 | update 13 | schema 14 | store) 15 | (libraries dns_acme eio_main capnp-rpc-unix) 16 | (flags 17 | (:standard -w -53-55))) 18 | 19 | (library 20 | (name dns_acme) 21 | (modules dns_acme) 22 | (public_name eon.dns-acme) 23 | (libraries tls_le dns_server_eio letsencrypt-dns capnp-rpc)) 24 | 25 | (rule 26 | (targets schema.ml schema.mli) 27 | (deps schema.capnp) 28 | (action 29 | (run capnp compile -o %{bin:capnpc-ocaml} %{deps}))) 30 | 31 | (rule 32 | (targets store.ml store.mli) 33 | (deps store.capnp) 34 | (action 35 | (run capnp compile -o %{bin:capnpc-ocaml} %{deps}))) 36 | -------------------------------------------------------------------------------- /vendor/letsencrypt/src/b64u.ml: -------------------------------------------------------------------------------- 1 | let rec trim_leading_null s = 2 | if String.length s = 0 then 3 | s 4 | else if String.get s 0 = '\000' then 5 | trim_leading_null (String.sub s 1 (String.length s - 1)) 6 | else 7 | s 8 | 9 | (** byte reversing *) 10 | let rev s = 11 | let slen = String.length s in 12 | String.init slen (fun idx -> String.get s (slen - succ idx)) 13 | 14 | let urlencode = 15 | Base64.encode_string ~pad:false ~alphabet:Base64.uri_safe_alphabet 16 | 17 | let urldecode s = 18 | Base64.decode ~pad:false ~alphabet:Base64.uri_safe_alphabet s 19 | 20 | let urlencodez z = urlencode (trim_leading_null (rev (Z.to_bits z))) 21 | 22 | let urldecodez z64 = 23 | Result.map (fun bits -> Z.of_bits (rev bits)) (urldecode z64) 24 | 25 | -------------------------------------------------------------------------------- /vendor/letsencrypt/README.md: -------------------------------------------------------------------------------- 1 | # [let's encrypt](https://letsencrypt.org/) - an ACME implementation in OCaml 2 | 3 | This package contains an implementation of the ACME protocol (mostly client 4 | side) purely in OCaml based on [RFC 8555](https://tools.ietf.org/html/rfc8555). 5 | The HTTP, DNS, and [ALPN](https://tools.ietf.org/html/draft-ietf-acme-tls-alpn-07) 6 | challenges are implemented. 7 | 8 | Build with: 9 | 10 | $ opam install letsencrypt 11 | $ opam install letsencrypt-app #for oacmel, the LE client binary 12 | 13 | Generate a new account key with: 14 | 15 | $ openssl req -newkey rsa > csr.pem 16 | $ openssl genrsa > account.pem 17 | 18 | with OCaml version ≥ 4.07.0. 19 | Note: acme.ml is not tested, and should be considered yet to be implemented. 20 | -------------------------------------------------------------------------------- /vendor/dns/mirage/resolver/dns_resolver_mirage.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | module Make (R : Mirage_crypto_rng_mirage.S) (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (T : Mirage_time.S) (S : Tcpip.Stack.V4V6) : sig 4 | 5 | val resolver : S.t -> ?root:bool -> ?timer:int -> ?udp:bool -> ?tcp:bool -> ?tls:Tls.Config.server -> ?port:int -> ?tls_port:int -> Dns_resolver.t -> unit 6 | (** [resolver stack ~root ~timer ~udp ~tcp ~tls ~port ~tls_port resolver] 7 | registers a caching resolver on the provided protocols [udp], [tcp], [tls] 8 | using [port] for udp and tcp (defaults to 53), [tls_port] for tls (defaults 9 | to 853) using the [resolver] configuration. The [timer] is in milliseconds 10 | and defaults to 500 milliseconds.*) 11 | end 12 | -------------------------------------------------------------------------------- /lib/dns_server_eio.mli: -------------------------------------------------------------------------------- 1 | (* The plumbing for a process to send and receive DNS packets. 2 | Takes a `dns_handler` that returns a list of answers *) 3 | 4 | type dns_handler = Dns.proto -> Eio.Net.Sockaddr.t -> string -> string list 5 | 6 | val with_handler : 7 | < net : _ Eio.Net.t ; .. > -> 8 | [ `Tcp | `Udp ] list -> 9 | dns_handler -> 10 | Dns_log.formattedLog -> 11 | (Eio.Net.Ipaddr.v4v6 * int) list -> 12 | unit 13 | 14 | val primary : 15 | < net : _ Eio.Net.t 16 | ; clock : _ Eio.Time.clock 17 | ; mono_clock : _ Eio.Time.Mono.t 18 | ; .. > -> 19 | [ `Tcp | `Udp ] list -> 20 | ?packet_callback:Dns_server.packet_callback -> 21 | Dns_server.Primary.s ref -> 22 | Dns_log.formattedLog -> 23 | (Eio.Net.Ipaddr.v4v6 * int) list -> 24 | unit 25 | 26 | (* TODO support secondary server *) 27 | -------------------------------------------------------------------------------- /lib/transport/stream.ml: -------------------------------------------------------------------------------- 1 | type t = Eio.Flow.two_way_ty Eio.Resource.t 2 | 3 | let create ~inc ~out = 4 | let module CstructFlow = struct 5 | type t = unit 6 | 7 | let copy _t ~src = 8 | let buf = Cstruct.create 4096 in 9 | try 10 | while true do 11 | let got = Eio.Flow.single_read src buf in 12 | Cstruct_stream.add out [ Cstruct.sub buf 0 got ] 13 | done 14 | with End_of_file -> () 15 | 16 | let single_write _t bufs = 17 | Cstruct_stream.add out bufs; 18 | List.fold_left (fun acc buf -> acc + Cstruct.length buf) 0 bufs 19 | 20 | let read_methods = [] 21 | let single_read _t buf = Cstruct_stream.take inc buf 22 | let shutdown _t _cmd = () 23 | end in 24 | let ops = Eio.Flow.Pi.two_way (module CstructFlow) in 25 | Eio.Resource.T ((), ops) 26 | -------------------------------------------------------------------------------- /vendor/dns/resolvconf/resolvconf_parser.mly: -------------------------------------------------------------------------------- 1 | %{ 2 | %} 3 | 4 | %token EOF 5 | %token EOL 6 | %token SPACE 7 | %token SNAMESERVER 8 | %token DOT 9 | %token COLON 10 | %token PERCENT 11 | %token IPV4 12 | %token IPV6 13 | %token ZONE_ID 14 | 15 | %start resolvconf 16 | %type <[ `Nameserver of Ipaddr.t ] list> resolvconf 17 | 18 | %% 19 | 20 | resolvconf: lines EOF { List.rev $1 } 21 | 22 | lines: 23 | /* nothing */ { [] } 24 | | lines EOL { $1 } 25 | | lines nameserver EOL { $2 :: $1 } 26 | 27 | s: SPACE {} | s SPACE {} 28 | 29 | ipv4: IPV4 { Ipaddr.V4.of_string_exn $1 } 30 | 31 | ipv6: 32 | IPV6 { Ipaddr.V6.of_string_exn $1 } 33 | | IPV6 PERCENT ZONE_ID { Ipaddr.V6.of_string_exn $1 } 34 | 35 | nameserver: 36 | SNAMESERVER s ipv4 { `Nameserver (Ipaddr.V4 $3) } 37 | | SNAMESERVER s ipv6 { `Nameserver (Ipaddr.V6 $3) } 38 | -------------------------------------------------------------------------------- /lib/acme/tls_le.mli: -------------------------------------------------------------------------------- 1 | exception Le_error of string 2 | 3 | val errcheck : ('a, [< `Msg of string ]) result -> 'a 4 | val gen_account_key : unit -> X509.Private_key.t 5 | val gen_private_key : unit -> X509.Private_key.t 6 | 7 | val gen_cert : 8 | ?account_key:X509.Private_key.t -> 9 | ?private_key:X509.Private_key.t -> 10 | email:string -> 11 | ?org:string option -> 12 | [ `raw ] Domain_name.t list -> 13 | endpoint:Uri.t -> 14 | solver:Letsencrypt.Client.solver -> 15 | < clock : _ Eio.Time.clock ; net : _ Eio.Net.t ; .. > -> 16 | X509.Certificate.t list 17 | * X509.Private_key.t 18 | * X509.Private_key.t 19 | * X509.Signing_request.t 20 | 21 | val tls_config : 22 | ?alpn_protocols:string list -> 23 | cert:X509.Certificate.t list -> 24 | private_key:X509.Private_key.t -> 25 | unit -> 26 | (Tls.Config.server, [> `Msg of string ]) result 27 | -------------------------------------------------------------------------------- /vendor/dns/dns-tsig.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "dns" {= version} 14 | "digestif" {>= "1.2.0"} 15 | "base64" {>= "3.0.0"} 16 | "alcotest" {with-test} 17 | ] 18 | 19 | build: [ 20 | ["dune" "subst"] {dev} 21 | ["dune" "build" "-p" name "-j" jobs] 22 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 23 | ] 24 | 25 | synopsis: "TSIG support for DNS" 26 | description: """ 27 | TSIG is used to authenticate nsupdate frames using a HMAC. 28 | """ 29 | -------------------------------------------------------------------------------- /vendor/dns/dns-client.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Joe Hill"] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | license: "BSD-2-Clause" 8 | 9 | build: [ 10 | [ "dune" "subst"] {dev} 11 | [ "dune" "build" "-p" name "-j" jobs ] 12 | [ "dune" "runtest" "-p" name "-j" jobs ] {with-test} 13 | ] 14 | 15 | depends: [ 16 | "dune" {>="2.0.0"} 17 | "ocaml" {>= "4.13.0"} 18 | "dns" {= version} 19 | "randomconv" {>= "0.2.0"} 20 | "domain-name" {>= "0.4.0"} 21 | "mtime" {>= "1.2.0"} 22 | "mirage-crypto-rng" {>= "1.0.0"} 23 | "fmt" {>= "0.9.0"} 24 | "ipaddr" {>= "5.5.0"} 25 | "alcotest" {with-test} 26 | ] 27 | synopsis: "DNS client API" 28 | description: """ 29 | A client implementation using uDNS. 30 | """ 31 | -------------------------------------------------------------------------------- /vendor/dns/dns-client-miou-unix.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Robur "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | license: "BSD-2-Clause" 8 | 9 | build: [ 10 | [ "dune" "subst"] {dev} 11 | [ "dune" "build" "-p" name "-j" jobs ] 12 | [ "dune" "runtest" "-p" name "-j" jobs ] {with-test} 13 | ] 14 | 15 | depends: [ 16 | "dune" {>="2.0.0"} 17 | "ocaml" {>= "5.0.0"} 18 | "dns-client" {= version} 19 | "domain-name" {>= "0.4.0"} 20 | "ipaddr" {>= "5.3.0"} 21 | "miou" {>= "0.1.0"} 22 | "tls-miou-unix" 23 | "happy-eyeballs" {>= "0.6.0"} 24 | "happy-eyeballs-miou-unix" 25 | ] 26 | synopsis: "DNS client API for Miou" 27 | description: """ 28 | A client implementation using uDNS using Miou. 29 | """ 30 | -------------------------------------------------------------------------------- /vendor/dns/dns-client-lwt.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Joe Hill"] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | license: "BSD-2-Clause" 8 | 9 | build: [ 10 | [ "dune" "subst"] {dev} 11 | [ "dune" "build" "-p" name "-j" jobs ] 12 | [ "dune" "runtest" "-p" name "-j" jobs ] {with-test} 13 | ] 14 | 15 | depends: [ 16 | "dune" {>="2.0.0"} 17 | "ocaml" {>= "4.13.0"} 18 | "dns-client" {= version} 19 | "dns" {= version} 20 | "ipaddr" {>= "5.3.0"} 21 | "lwt" {>= "4.2.1"} 22 | "mtime" {>= "1.2.0"} 23 | "mirage-crypto-rng-lwt" {>= "1.0.0"} 24 | "happy-eyeballs-lwt" {>= "1.1.0"} 25 | "happy-eyeballs" {>= "1.0.0"} 26 | "tls-lwt" {>= "1.0.0"} 27 | "ca-certs" {>= "1.0.0"} 28 | ] 29 | synopsis: "DNS client API using lwt" 30 | description: """ 31 | A client implementation using uDNS and lwt for side effects. 32 | """ 33 | -------------------------------------------------------------------------------- /vendor/letsencrypt/test/b64u_test.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let test_decodez_216p1 _ctx = 4 | let e64 = "AQAB" in 5 | match Letsencrypt__B64u.urldecodez e64 with 6 | | Error (`Msg e) -> assert_failure e 7 | | Ok e -> 8 | let got = Z.format "%x" e in 9 | let expected = "10001" in 10 | assert_equal got expected 11 | 12 | let test_encodez_216p1 _ctx = 13 | let e = Z.of_int 65537 in 14 | let e64 = Letsencrypt__B64u.urlencodez e in 15 | assert_equal e64 "AQAB" 16 | 17 | (* Appendix A.1.1 of RFC7515. *) 18 | let test_encode _ctx = 19 | let msg = 20 | "\123\034\116\121\112\034\058\034\074\087\084\034\044\013\010\032\034" ^ 21 | "\097\108\103\034\058\034\072\083\050\053\054\034\125" 22 | in 23 | let msg64 = "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9" in 24 | assert_equal (Letsencrypt__B64u.urlencode msg) msg64 25 | 26 | let all_tests = [ 27 | "test_encodez_216p1" >:: test_encodez_216p1; 28 | "tests_decodez_216p1" >:: test_decodez_216p1; 29 | "test_encode" >:: test_encode; 30 | ] 31 | -------------------------------------------------------------------------------- /vendor/letsencrypt/letsencrypt-dns.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | synopsis: "DNS solver for ACME implementation in OCaml" 3 | description: "A DNS solver for the ACME implementation in OCaml." 4 | maintainer: "Michele Mu " 5 | authors: 6 | "Michele Mu , Hannes Mehnert " 7 | license: "BSD-2-clause" 8 | homepage: "https://github.com/robur-coop/ocaml-letsencrypt" 9 | bug-reports: "https://github.com/robur-coop/ocaml-letsencrypt/issues" 10 | doc: "https://robur-coop.github.io/ocaml-letsencrypt" 11 | depends: [ 12 | "ocaml" {>= "4.13.0"} 13 | "dune" {>= "1.2.0"} 14 | "letsencrypt" {= version} 15 | "logs" 16 | "fmt" {>= "0.8.7"} 17 | "lwt" {>= "2.6.0"} 18 | "dns" {>= "9.0.0"} 19 | "dns-tsig" {>= "9.0.0"} 20 | "domain-name" {>= "0.2.0"} 21 | ] 22 | build: [ 23 | ["dune" "subst"] {dev} 24 | ["dune" "build" "-p" name "-j" jobs] 25 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 26 | ] 27 | dev-repo: "git+https://github.com/robur-coop/ocaml-letsencrypt.git" 28 | -------------------------------------------------------------------------------- /vendor/letsencrypt/letsencrypt-mirage.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | synopsis: "ACME implementation in OCaml for MirageOS" 3 | description: "An ACME client implementation of the ACME protocol (RFC 8555) for OCaml & MirageOS" 4 | maintainer: "Michele Mu " 5 | authors: 6 | "Michele Mu , Hannes Mehnert " 7 | license: "BSD-2-clause" 8 | homepage: "https://github.com/robur-coop/ocaml-letsencrypt" 9 | bug-reports: "https://github.com/robur-coop/ocaml-letsencrypt/issues" 10 | doc: "https://robur-coop.github.io/ocaml-letsencrypt" 11 | depends: [ 12 | "ocaml" {>= "4.13.0"} 13 | "dune" {>= "1.2.0"} 14 | "letsencrypt" {= version} 15 | "http-mirage-client" 16 | "tcpip" {>= "7.0.0"} 17 | "mirage-time" {>= "3.0.0"} 18 | "duration" 19 | "emile" {>= "1.1"} 20 | "paf" {>= "0.4.0"} 21 | ] 22 | build: [ 23 | ["dune" "subst"] {dev} 24 | ["dune" "build" "-p" name "-j" jobs] 25 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 26 | ] 27 | dev-repo: "git+https://github.com/robur-coop/ocaml-letsencrypt.git" 28 | -------------------------------------------------------------------------------- /vendor/dns/test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name tests) 3 | (package dns) 4 | (libraries dns alcotest) 5 | (modules tests)) 6 | 7 | (test 8 | (name server) 9 | (package dns-server) 10 | (libraries base64 dns-server dns-server.zone dns-tsig alcotest mirage-crypto-rng.unix) 11 | (modules server)) 12 | 13 | (test 14 | (name tsig) 15 | (package dns-tsig) 16 | (libraries dns-tsig alcotest) 17 | (modules tsig)) 18 | 19 | (test 20 | (name resolver) 21 | (package dns-resolver) 22 | (libraries dns-resolver alcotest) 23 | (modules resolver)) 24 | 25 | (test 26 | (name client) 27 | (package dns-client) 28 | (libraries dns-client alcotest) 29 | (modules client)) 30 | 31 | (test 32 | (name cache) 33 | (package dns) 34 | (libraries dns.cache alcotest) 35 | (modules cache)) 36 | 37 | (test 38 | (name resolvconf) 39 | (package dns-client) 40 | (libraries dns-client.resolvconf ipaddr alcotest) 41 | (modules resolvconf)) 42 | 43 | (test 44 | (name test_dnssec) 45 | (package dnssec) 46 | (libraries dns dnssec mirage-crypto-pk base64 logs.fmt alcotest) 47 | (modules test_dnssec)) 48 | -------------------------------------------------------------------------------- /vendor/dns/dnssec.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert " "Reynir Björnsson "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "dns" {= version} 14 | "alcotest" {with-test} 15 | "mirage-crypto" {>= "1.0.0"} 16 | "mirage-crypto-pk" {>= "1.0.0"} 17 | "mirage-crypto-ec" {>= "1.0.0"} 18 | "domain-name" {>= "0.4.0"} 19 | "base64" {with-test & >= "3.0.0"} 20 | "logs" {>= "0.7.0"} 21 | ] 22 | build: [ 23 | ["dune" "subst"] {dev} 24 | ["dune" "build" "-p" name "-j" jobs] 25 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 26 | ] 27 | 28 | synopsis: "DNSSec support for OCaml-DNS" 29 | description: """ 30 | DNSSec (DNS security extensions) for OCaml-DNS, including 31 | signing and verifying of RRSIG records. 32 | """ 33 | -------------------------------------------------------------------------------- /vendor/dns/dns-client-mirage.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Joe Hill"] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | license: "BSD-2-Clause" 8 | 9 | build: [ 10 | [ "dune" "subst"] {dev} 11 | [ "dune" "build" "-p" name "-j" jobs ] 12 | [ "dune" "runtest" "-p" name "-j" jobs ] {with-test} 13 | ] 14 | 15 | depends: [ 16 | "dune" {>="2.0.0"} 17 | "ocaml" {>= "4.13.0"} 18 | "dns-client" {= version} 19 | "domain-name" {>= "0.4.0"} 20 | "ipaddr" {>= "5.3.0"} 21 | "lwt" {>= "4.2.1"} 22 | "tcpip" {>= "8.2.0"} 23 | "mirage-time" {>= "2.0.0"} 24 | "mirage-clock" {>= "3.0.0"} 25 | "happy-eyeballs-mirage" {>= "1.1.0"} 26 | "happy-eyeballs" {>= "1.0.0"} 27 | "tls-mirage" {>= "1.0.0"} 28 | "x509" {>= "1.0.0"} 29 | "ca-certs-nss" {>= "3.101-1"} 30 | "mirage-crypto-rng-mirage" {>= "1.0.0"} 31 | ] 32 | synopsis: "DNS client API for MirageOS" 33 | description: """ 34 | A client implementation using uDNS using MirageOS. 35 | """ 36 | -------------------------------------------------------------------------------- /bin/transport/sod/pty.ml: -------------------------------------------------------------------------------- 1 | (* Pseudo terminal handling functions *) 2 | type pty = { 3 | masterfd : Unix.file_descr; 4 | slavefd : Unix.file_descr; 5 | name : string; 6 | } 7 | 8 | type pty_window = { row : int32; col : int32; xpixel : int32; ypixel : int32 } 9 | 10 | (* Exceptions raised by Pty functions *) 11 | exception Pty_error of string 12 | 13 | let _ = Callback.register_exception "pty_error" (Pty_error "") 14 | 15 | (* External declarations of Pty bindings *) 16 | external open_pty : unit -> pty = "pty_open_pty" 17 | external switch_controlling_pty : pty -> unit = "pty_switch_controlling_tty" 18 | external set_window_size : pty -> pty_window -> unit = "pty_window_size" 19 | external tty_window_size : unit -> pty_window = "pty_tty_window_size" 20 | external get_sigwinch : unit -> int option = "ocaml_terminal_get_sigwinch" 21 | 22 | (* Convenience ML functions *) 23 | let close_pty pty = 24 | try Unix.close pty.masterfd 25 | with _ -> ( 26 | (); 27 | try Unix.close pty.slavefd with _ -> ()) 28 | 29 | (* Internal declarations of Pty bindings *) 30 | let string_of_pty p = Printf.sprintf "name=%s" p.name 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2025 Ryan Gibb 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /vendor/dns/resolver/dns_resolver_root.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | open Dns 4 | 5 | val root_servers : ([ `raw ] Domain_name.t * Ipaddr.V4.t * Ipaddr.V6.t) list 6 | (** [root_servers] are the root servers. *) 7 | 8 | val ns_records : (int32 * Domain_name.Host_set.t) 9 | (** [ns_records] is the root nameserver binding. *) 10 | 11 | val a_records : ([ `raw ] Domain_name.t * (int32 * Ipaddr.V4.Set.t)) list 12 | (** [a_records] is a list of names and bindings (A records) for the root 13 | servers. *) 14 | 15 | val aaaa_records : ([ `raw ] Domain_name.t * (int32 * Ipaddr.V6.Set.t)) list 16 | (** [aaaa_records] is a list of names and bindings (AAAA records) for the root 17 | servers. *) 18 | 19 | val ips : [ `Both | `Ipv4_only | `Ipv6_only ] -> Ipaddr.t list 20 | (** [ips ip_proto] is a list of ip addresses of the root servers. *) 21 | 22 | val reserved_zones : ([ `raw ] Domain_name.t * Rr_map.b) list 23 | (** [reserved_zones] is a list of names and bindings for reserved zones 24 | specified by RFCs (private network address ranges, private domains) *) 25 | 26 | val reserved : Dns_trie.t 27 | (** [reserved] is a trie with all [reserved_zones]. *) 28 | -------------------------------------------------------------------------------- /vendor/letsencrypt/letsencrypt-app.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | synopsis: "ACME implementation in OCaml" 3 | description: "An ACME client implementation of the ACME protocol (RFC 8555) for OCaml" 4 | maintainer: "Michele Mu " 5 | authors: 6 | "Michele Mu , Hannes Mehnert " 7 | license: "BSD-2-clause" 8 | homepage: "https://github.com/robur-coop/ocaml-letsencrypt" 9 | bug-reports: "https://github.com/robur-coop/ocaml-letsencrypt/issues" 10 | doc: "https://robur-coop.github.io/ocaml-letsencrypt" 11 | depends: [ 12 | "ocaml" {>= "4.13.0"} 13 | "dune" {>= "1.2.0"} 14 | "letsencrypt" {= version} 15 | "letsencrypt-dns" {= version} 16 | "cmdliner" {>= "1.1.0"} 17 | "cohttp-lwt-unix" {>= "1.0.0"} 18 | "logs" 19 | "fmt" {>= "0.8.7"} 20 | "lwt" {>= "2.6.0"} 21 | "mirage-crypto-rng" {>= "1.0.0"} 22 | "mirage-crypto-rng-eio" {>= "1.0.0"} 23 | "ptime" 24 | "bos" 25 | "fpath" 26 | "randomconv" {>= "0.2.0"} 27 | ] 28 | build: [ 29 | ["dune" "subst"] {dev} 30 | ["dune" "build" "-p" name "-j" jobs] 31 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 32 | ] 33 | dev-repo: "git+https://github.com/robur-coop/ocaml-letsencrypt.git" 34 | -------------------------------------------------------------------------------- /vendor/dns/dns-stub.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "cstruct" {>= "6.0.0"} 14 | "dns" {= version} 15 | "dns-client-mirage" {= version} 16 | "dns-mirage" {= version} 17 | "dns-resolver" {= version} 18 | "dns-tsig" {= version} 19 | "dns-server" {= version} 20 | "duration" {>= "0.1.2"} 21 | "randomconv" {>= "0.2.0"} 22 | "lwt" {>= "4.2.1"} 23 | "mirage-time" {>= "2.0.0"} 24 | "mirage-clock" {>= "3.0.0"} 25 | "tcpip" {>= "8.2.0"} 26 | "metrics" 27 | "mirage-crypto-rng-mirage" {>= "1.0.0"} 28 | ] 29 | 30 | build: [ 31 | ["dune" "subst"] {dev} 32 | ["dune" "build" "-p" name "-j" jobs] 33 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 34 | ] 35 | 36 | synopsis: "DNS stub resolver" 37 | description: """ 38 | Forwarding and recursive resolvers as value-passing functions. To be used with 39 | an effectful layer. 40 | """ 41 | -------------------------------------------------------------------------------- /vendor/dns/dns-resolver.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "dns" {= version} 14 | "dns-server" {= version} 15 | "dns-mirage" {= version} 16 | "dnssec" {= version} 17 | "lru" {>= "0.3.0"} 18 | "duration" {>= "0.1.2"} 19 | "randomconv" {>= "0.2.0"} 20 | "lwt" {>= "4.2.1"} 21 | "mirage-time" {>= "2.0.0"} 22 | "mirage-clock" {>= "3.0.0"} 23 | "tcpip" {>= "8.2.0"} 24 | "alcotest" {with-test} 25 | "tls" {>= "1.0.0"} 26 | "tls-mirage" {>= "1.0.0"} 27 | "mirage-crypto-rng-mirage" {>= "1.0.0"} 28 | ] 29 | 30 | build: [ 31 | ["dune" "subst"] {dev} 32 | ["dune" "build" "-p" name "-j" jobs] 33 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 34 | ] 35 | 36 | synopsis: "DNS resolver business logic" 37 | description: """ 38 | Forwarding and recursive resolvers as value-passing functions. To be used with 39 | an effectful layer. 40 | """ 41 | -------------------------------------------------------------------------------- /vendor/dns/dns-server.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "cstruct" {>= "6.0.0"} 14 | "dns" {= version} 15 | "dns-mirage" {= version} 16 | "randomconv" {>= "0.2.0"} 17 | "duration" {>= "0.1.2"} 18 | "lwt" {>= "4.2.1"} 19 | "mirage-time" {>= "2.0.0"} 20 | "mirage-clock" {>= "3.0.0"} 21 | "tcpip" {>= "8.2.0"} 22 | "mirage-crypto-rng" {with-test & >= "1.0.0"} 23 | "alcotest" {with-test} 24 | "dns-tsig" {with-test} 25 | "base64" {with-test & >= "3.0.0"} 26 | "metrics" 27 | "logs" {>= "0.7.0"} 28 | ] 29 | 30 | build: [ 31 | ["dune" "subst"] {dev} 32 | ["dune" "build" "-p" name "-j" jobs] 33 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 34 | ] 35 | 36 | synopsis: "DNS server, primary and secondary" 37 | description: """ 38 | Primary and secondary DNS server implemented in value-passing style. Needs an 39 | effectful layer to be useful. 40 | """ 41 | -------------------------------------------------------------------------------- /vendor/dns/dns-certify.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "dns" {= version} 14 | "dns-tsig" {= version} 15 | "dns-mirage" {= version} 16 | "randomconv" {>= "0.2.0"} 17 | "duration" {>= "0.1.2"} 18 | "x509" {>= "1.0.0"} 19 | "lwt" {>= "4.2.1"} 20 | "mirage-time" {>= "2.0.0"} 21 | "mirage-clock" {>= "3.0.0"} 22 | "tcpip" {>= "8.2.0"} 23 | "logs" 24 | "mirage-crypto-ec" 25 | "mirage-crypto-pk" {>= "1.0.0"} 26 | "mirage-crypto-rng-mirage" {>= "1.0.0"} 27 | ] 28 | 29 | build: [ 30 | ["dune" "subst"] {dev} 31 | ["dune" "build" "-p" name "-j" jobs] 32 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 33 | ] 34 | 35 | synopsis: "MirageOS let's encrypt certificate retrieval" 36 | description: """ 37 | A function to retrieve a certificate when providing a hostname, TSIG key, server 38 | IP, and an optional key seed. Best used with an letsencrypt unikernel. 39 | """ 40 | -------------------------------------------------------------------------------- /vendor/dns/resolver/dns_resolver_cache.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 2 | open Dns 3 | 4 | val pp_question : ([ `raw ] Domain_name.t * Packet.Question.qtype) Fmt.t 5 | 6 | val follow_cname : Dns_cache.t -> int64 -> 'a Rr_map.key -> name:[ `raw ] Domain_name.t -> int32 -> 7 | alias:[ `raw ] Domain_name.t -> 8 | [ `Out of Rcode.t * bool * Name_rr_map.t * Name_rr_map.t 9 | | `Query of [ `raw ] Domain_name.t ] * Dns_cache.t 10 | 11 | val answer : Dns_cache.t -> int64 -> [ `raw ] Domain_name.t -> Packet.Question.qtype -> 12 | [ `Query of [ `raw ] Domain_name.t 13 | | `Packet of Packet.Flags.t * Packet.reply ] * Dns_cache.t 14 | 15 | val resolve : Dns_cache.t -> dnssec:bool -> rng:(int -> string) -> [`Both | `Ipv4_only | `Ipv6_only] -> int64 -> [ `raw ] Domain_name.t -> 16 | Packet.Question.qtype -> [ `raw ] Domain_name.t * [ `raw ] Domain_name.t * Packet.Question.qtype list * Ipaddr.t * Dns_cache.t 17 | 18 | val handle_query : Dns_cache.t -> dnssec:bool -> rng:(int -> string) -> 19 | [`Both | `Ipv4_only | `Ipv6_only ] -> 20 | int64 -> 21 | [ `raw ] Domain_name.t * Packet.Question.qtype -> 22 | [ `Reply of Packet.Flags.t * Packet.reply 23 | | `Query of [ `raw ] Domain_name.t * ([ `raw ] Domain_name.t * Packet.Question.qtype list) * Ipaddr.t ] * Dns_cache.t 24 | -------------------------------------------------------------------------------- /lib/util/listen.ml: -------------------------------------------------------------------------------- 1 | (* bind to sockets with callback/conection handler *) 2 | 3 | let on_addrs ~net ~proto udp_listen tcp_listen addrs = 4 | let on_addr addr = 5 | let try_bind bind addr = 6 | try bind addr 7 | with Unix.Unix_error (error, "bind", _) -> 8 | Format.fprintf Format.err_formatter "Error binding to %a %s\n" 9 | Eio.Net.Sockaddr.pp addr (Unix.error_message error); 10 | Format.pp_print_flush Format.err_formatter (); 11 | exit 2 12 | in 13 | List.map 14 | (fun proto -> 15 | match proto with 16 | | `Udp -> 17 | fun () -> 18 | Eio.Switch.run @@ fun sw -> 19 | let sockUDP = 20 | try_bind 21 | (Eio.Net.datagram_socket ~sw ~reuse_addr:true net) 22 | (`Udp addr) 23 | in 24 | udp_listen sockUDP 25 | | `Tcp -> 26 | fun () -> 27 | Eio.Switch.run @@ fun sw -> 28 | let sockTCP = 29 | try_bind 30 | (Eio.Net.listen ~sw ~reuse_addr:true ~backlog:4096 net) 31 | (`Tcp addr) 32 | in 33 | tcp_listen sockTCP) 34 | proto 35 | in 36 | Eio.Fiber.all (List.flatten (List.map on_addr addrs)) 37 | -------------------------------------------------------------------------------- /vendor/dns/resolvconf/resolvconf_lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Resolvconf_state 3 | open Resolvconf_parser 4 | } 5 | 6 | let ipv4 = (['0'-'9']+ '.' ['0'-'9']+ '.' ['0'-'9']+ '.' ['0'-'9']+) as contents 7 | let ipv6 = (['0'-'9' 'a'-'f' 'A'-'F' ':']+) as contents 8 | 9 | let zone_id = (['0'-'9' 'a'-'z' 'A'-'Z' '.' ]+) as contents 10 | 11 | (* inspired by https://github.com/tailhook/resolv-conf/blob/master/src/grammar.rs *) 12 | 13 | rule lex = parse 14 | | "nameserver" { SNAMESERVER } 15 | | "options" ([^'\n']*) '\n' { state.lineno <- state.lineno + 1 ; EOL } 16 | | "search" ([^'\n']*) '\n' { state.lineno <- state.lineno + 1 ; EOL } 17 | | "domain" ([^'\n']*) '\n' { state.lineno <- state.lineno + 1 ; EOL } 18 | | "sortlist" ([^'\n']*) '\n' { state.lineno <- state.lineno + 1 ; EOL } 19 | | "lookup" ([^'\n']*) '\n' { state.lineno <- state.lineno + 1 ; EOL } 20 | | "family" ([^'\n']*) '\n' { state.lineno <- state.lineno + 1 ; EOL } 21 | | [' ' '\t']+ { SPACE } 22 | | ipv4 { IPV4 contents } 23 | | ipv6 { IPV6 contents } 24 | | '.' { DOT } 25 | | ':' { COLON } 26 | | '%' { PERCENT } 27 | | [' ' '\t']* ('#' [^'\n']*)? '\n' { state.lineno <- state.lineno + 1 ; EOL } 28 | | [' ' '\t']* (';' [^'\n']*)? '\n' { state.lineno <- state.lineno + 1 ; EOL } 29 | | zone_id { ZONE_ID contents } 30 | | eof { EOF } 31 | -------------------------------------------------------------------------------- /vendor/dns/zone/dns_zone_state.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2005-2006 Tim Deegan 3 | * Copyright (c) 2017 Hannes Mehnert 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | * 17 | *) 18 | 19 | type parserstate = { 20 | mutable paren : int; 21 | mutable lineno : int; 22 | mutable origin : [ `raw ] Domain_name.t; 23 | mutable ttl : int32; 24 | mutable owner : [ `raw ] Domain_name.t; 25 | mutable zone : Dns.Name_rr_map.t ; 26 | } 27 | 28 | val state : parserstate 29 | 30 | val reset : unit -> unit 31 | 32 | exception Zone_parse_problem of string 33 | -------------------------------------------------------------------------------- /docs/dynamic-updates.md: -------------------------------------------------------------------------------- 1 | 2 | ### Dynamic Updates 3 | 4 | The server uses [TSIG](https://www.rfc-editor.org/rfc/rfc2845) resources records (RRs) to authenticate queries. For example, [DNS UPDATE](https://www.rfc-editor.org/rfc/rfc2136) queries can be authenticated to provide secure dynamic updates. 5 | 6 | We pass [HMAC](https://www.rfc-editor.org/rfc/rfc2104) keys to the server through a zonefile representation that is in a file eon `._keys`, e.g. [`example.org._keys`](./example/example.org._keys). These are secret keys, and should not be published. 7 | 8 | A DNSKEY RR domain name in this file must be of the format `..`, where `` can be `_update`, `_transfer`, or `_notify`. 9 | 10 | To generate these keys we can use: 11 | ``` 12 | $ cat /dev/random | head -c 32 | base64 13 | FGwot7AqiDIthEv6TippJm35DaRpRac5NSLd/wSp9go= 14 | ``` 15 | 16 | Then to perform a dynamic update we can use use the BIND utility `nsupdate`: 17 | ``` 18 | $ echo "update add test.example.org 86400 A 203.0.113.1\n" | nsupdate -l -y hmac-sha256:client._update.example.org:FGwot7AqiDIthEv6TippJm35DaRpRac5NSLd/wSp9go= 19 | $ dig test.example.org @localhost 20 | 203.0.113.1 21 | ``` 22 | 23 | The TSIG key name, `client._update.example.org` here, must match the name in the zonefile. 24 | 25 | See also the [capability interface](./cap.md). 26 | 27 | -------------------------------------------------------------------------------- /lib/cap/cert_callback.ml: -------------------------------------------------------------------------------- 1 | open Raw 2 | open Capnp_rpc 3 | 4 | let local callback = 5 | let module CertCallback = Api.Service.CertCallback in 6 | CertCallback.local 7 | @@ object 8 | inherit CertCallback.service 9 | 10 | method register_impl params release_param_caps = 11 | let open CertCallback.Register in 12 | callback 13 | (match Params.success_get params with 14 | | true -> 15 | Ok 16 | ( Params.cert_get params, 17 | Params.key_get params, 18 | Params.renewed_get params ) 19 | | false -> Error (`Remote (Params.error_get params))); 20 | release_param_caps (); 21 | Service.return_empty () 22 | end 23 | 24 | let register t success error cert key renewed = 25 | let open Api.Client.CertCallback.Register in 26 | let request, params = Capability.Request.create Params.init_pointer in 27 | Params.success_set params success; 28 | Params.error_set params error; 29 | Params.cert_set params 30 | (match cert with 31 | | None -> "" 32 | | Some v -> v |> X509.Certificate.encode_pem_multiple); 33 | Params.key_set params 34 | (match key with None -> "" | Some v -> v |> X509.Private_key.encode_pem); 35 | Params.renewed_set params renewed; 36 | Capability.call_for_unit t method_id request 37 | -------------------------------------------------------------------------------- /vendor/letsencrypt/letsencrypt.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | synopsis: "ACME implementation in OCaml" 3 | description: "An implementation of the ACME protocol (RFC 8555) for OCaml" 4 | maintainer: "Michele Mu " 5 | authors: 6 | "Michele Mu , Hannes Mehnert " 7 | license: "BSD-2-clause" 8 | homepage: "https://github.com/robur-coop/ocaml-letsencrypt" 9 | bug-reports: "https://github.com/robur-coop/ocaml-letsencrypt/issues" 10 | doc: "https://robur-coop.github.io/ocaml-letsencrypt" 11 | depends: [ 12 | "ocaml" {>= "4.13.0"} 13 | "dune" {>= "1.2.0"} 14 | "base64" {>= "3.3.0"} 15 | "logs" 16 | "fmt" {>= "0.8.7"} 17 | "uri" 18 | "lwt" {>= "2.6.0"} 19 | "mirage-crypto" {>= "1.0.0"} 20 | "mirage-crypto-ec" {>= "1.0.0"} 21 | "mirage-crypto-pk" {>= "1.0.0"} 22 | "mirage-crypto-rng" {with-test & >= "1.0.0"} 23 | "digestif" {>= "1.2.0"} 24 | "x509" {>= "1.0.0"} 25 | "yojson" {>= "1.6.0"} 26 | "ounit2" {with-test} 27 | "ptime" 28 | "domain-name" {>= "0.2.0"} 29 | "cstruct" {>= "6.0.0"} 30 | "cohttp-eio" 31 | "tls-eio" 32 | ] 33 | conflicts: [ "result" {< "1.5"} ] 34 | build: [ 35 | ["dune" "subst"] {dev} 36 | ["dune" "build" "-p" name "-j" jobs] 37 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 38 | ] 39 | dev-repo: "git+https://github.com/robur-coop/ocaml-letsencrypt.git" 40 | -------------------------------------------------------------------------------- /vendor/dns/mirage/dns_mirage.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | module Make (S : Tcpip.Stack.V4V6) : sig 4 | 5 | module IPM : sig 6 | include Map.S with type key = Ipaddr.t * int 7 | val find : Ipaddr.t * int -> 'a t -> 'a option 8 | end 9 | (** [IPM] is a map using [ip * port] as key. *) 10 | 11 | type f 12 | (** A 2byte-length per message flow abstraction, the embedding of DNS frames 13 | via TCP. *) 14 | 15 | val of_flow : S.TCP.flow -> f 16 | (** [of_flow flow] is [f]. *) 17 | 18 | val flow : f -> S.TCP.flow 19 | (** [flow f] is the underlying flow. *) 20 | 21 | val read_tcp : f -> (Cstruct.t, unit) result Lwt.t 22 | (** [read_tcp f] returns either a buffer or an error (logs actual error). *) 23 | 24 | val send_tcp : S.TCP.flow -> Cstruct.t -> (unit, unit) result Lwt.t 25 | (** [send_tcp flow buf] sends the buffer, either succeeds or fails (logs 26 | actual error). *) 27 | 28 | val send_tcp_multiple : S.TCP.flow -> Cstruct.t list -> 29 | (unit, unit) result Lwt.t 30 | (** [send_tcp_multiple flow bufs] sends the buffers, either succeeds or fails 31 | (logs actual error). *) 32 | 33 | val send_udp : S.t -> int -> Ipaddr.t -> int -> Cstruct.t -> unit Lwt.t 34 | (** [send_udp stack source_port dst dst_port buf] sends the [buf] as UDP 35 | packet to [dst] on [dst_port]. *) 36 | end 37 | -------------------------------------------------------------------------------- /vendor/dns/LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, 2018, Hannes Mehnert 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, this 11 | list of conditions and the following disclaimer in the documentation and/or 12 | other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 15 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 16 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 18 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 19 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 20 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 21 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 22 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 23 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | -------------------------------------------------------------------------------- /vendor/letsencrypt/LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyleft Ⓚ 2016, maker@tumbolandia.net 2 | All rights reversed. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 14 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 15 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 16 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 17 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 18 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 19 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 20 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 22 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | -------------------------------------------------------------------------------- /bin/eon.ml: -------------------------------------------------------------------------------- 1 | let run zonefiles log_level address_strings port proto resolver = 2 | Eio_main.run @@ fun env -> 3 | let addresses = Server_args.parse_addresses port address_strings in 4 | let log = Dns_log.get log_level Format.std_formatter in 5 | let rng ?_g length = 6 | let buf = Cstruct.create length in 7 | Eio.Flow.read_exact env#secure_random buf; 8 | Cstruct.to_string buf 9 | in 10 | let server_state = 11 | let trie, keys, _ = Zonefile.parse_zonefiles ~fs:env#fs zonefiles in 12 | Dns_server.Primary.create ~keys ~rng ~tsig_verify:Dns_tsig.verify 13 | ~tsig_sign:Dns_tsig.sign trie 14 | in 15 | match resolver with 16 | | true -> 17 | let resolver_state = 18 | let now = Mtime.to_uint64_ns @@ Eio.Time.Mono.now env#mono_clock in 19 | Dns_resolver.create ~cache_size:29 ~dnssec:false ~ip_protocol:`Ipv4_only 20 | now rng server_state 21 | in 22 | Dns_resolver_eio.resolver env proto (ref resolver_state) log addresses 23 | | false -> Dns_server_eio.primary env proto (ref server_state) log addresses 24 | 25 | let () = 26 | let open Cmdliner in 27 | let open Server_args in 28 | let cmd = 29 | let term = 30 | Term.( 31 | const run $ zonefiles $ log_level Dns_log.Level0 $ addresses $ port 32 | $ proto $ resolver) 33 | in 34 | let info = Cmd.info "eon" ~man in 35 | Cmd.v info term 36 | in 37 | exit (Cmd.eval cmd) 38 | -------------------------------------------------------------------------------- /lib/transport/frag_packet.ml: -------------------------------------------------------------------------------- 1 | type packet = { 2 | id : int; 3 | n_frags : int; (** how many fragments to expect for this packet *) 4 | } 5 | 6 | type t = 7 | | Packet of { 8 | packet : packet; 9 | frag_nb : int; (** identifying fragment in packet *) 10 | data : Cstruct.t; 11 | } 12 | | Dummy of { id : int } 13 | 14 | let decode buf = 15 | let id = Cstruct.BE.get_uint16 buf 0 in 16 | let frag_nb = Cstruct.BE.get_uint16 buf 2 in 17 | let n_frags = Cstruct.BE.get_uint16 buf 4 in 18 | match n_frags with 19 | | 0 -> Dummy { id } 20 | | _ -> 21 | let packet = { id; n_frags } in 22 | let data = Cstruct.sub buf 6 (Cstruct.length buf - 6) in 23 | Packet { packet; frag_nb; data } 24 | 25 | let encode frag = 26 | match frag with 27 | | Dummy { id } -> 28 | let buf = Cstruct.create 6 in 29 | let frag_nb = 0 in 30 | let n_frags = 0 in 31 | Cstruct.BE.set_uint16 buf 0 id; 32 | Cstruct.BE.set_uint16 buf 2 frag_nb; 33 | Cstruct.BE.set_uint16 buf 4 n_frags; 34 | buf 35 | | Packet { packet; frag_nb; data } -> 36 | let { id; n_frags } = packet in 37 | let buf = Cstruct.create (6 + Cstruct.length data) in 38 | Cstruct.BE.set_uint16 buf 0 id; 39 | Cstruct.BE.set_uint16 buf 2 frag_nb; 40 | Cstruct.BE.set_uint16 buf 4 n_frags; 41 | Cstruct.blit data 0 buf 6 (Cstruct.length data); 42 | buf 43 | 44 | let dummy id = Dummy { id } 45 | -------------------------------------------------------------------------------- /vendor/dns/mirage/certify/dns_certify_mirage.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 2 | module Make (R : Mirage_crypto_rng_mirage.S) (P : Mirage_clock.PCLOCK) (T : Mirage_time.S) (S : Tcpip.Stack.V4V6) : sig 3 | 4 | val retrieve_certificate : 5 | S.t -> dns_key_name:[`raw ] Domain_name.t -> Dns.Dnskey.t -> 6 | hostname:[ `host ] Domain_name.t -> 7 | ?additional_hostnames:[ `raw ] Domain_name.t list -> 8 | ?key_type:X509.Key_type.t -> ?key_data:string -> ?key_seed:string -> 9 | ?bits:int -> S.TCP.ipaddr -> int -> 10 | (X509.Certificate.t list * X509.Private_key.t, [ `Msg of string ]) result Lwt.t 11 | (** [retrieve_certificate stack ~dns_key_name dns_key ~hostname ~key_type ~key_data ~key_seed ~bits server_ip port] 12 | generates a private key (using [key_type], [key_data], [key_seed], and 13 | [bits]), a certificate signing request for the given [hostname] and 14 | [additional_hostnames], and sends [server_ip] an nsupdate (DNS-TSIG with 15 | [dns_key_name] and [dns_key]) with the csr as TLSA record, awaiting for a matching 16 | certificate as TLSA record. Requires a service that interacts with let's 17 | encrypt to transform the CSR into a signed certificate. If something 18 | fails, an exception (via [Lwt.fail]) is raised. This is meant for 19 | unikernels that require a valid TLS certificate before they can start 20 | their service (i.e. most web servers, mail servers). *) 21 | end 22 | -------------------------------------------------------------------------------- /vendor/letsencrypt/dns/letsencrypt_dns.mli: -------------------------------------------------------------------------------- 1 | (** [dns_solver (fun domain content)] is a solver for dns-01 challenges. 2 | The provided function should return [Ok ()] once the authoritative 3 | name servers serve a TXT record at [domain] with the content. The 4 | [domain] already has the [_acme-challenge.] prepended. *) 5 | val dns_solver : 6 | ([`raw] Domain_name.t -> string -> 7 | (unit, [ `Msg of string ]) result) -> Letsencrypt.Client.solver 8 | 9 | (** [print_dns] outputs the DNS challenge solution, and waits for user input 10 | before continuing with ACME. *) 11 | val print_dns : Letsencrypt.Client.solver 12 | 13 | (** [nsupdate ~proto id now send ~recv ~keyname key ~zone] 14 | constructs a dns solver that sends a DNS update packet (using [send]) 15 | and optionally waits for a signed reply (using [recv] if present) to solve 16 | challenges. The update is signed with a hmac transaction signature 17 | (DNS TSIG) using [now ()] as timestamp, and the [keyname] and [key] for 18 | the cryptographic material. The [zone] is the one to be used in the 19 | query section of the update packet. If signing, sending, or receiving 20 | fails, the error is reported. *) 21 | val nsupdate : ?proto:Dns.proto -> int -> (unit -> Ptime.t) -> 22 | (string -> (unit, [ `Msg of string ]) result) -> 23 | ?recv:(unit -> (string, [ `Msg of string ]) result) -> 24 | zone:[ `host ] Domain_name.t -> 25 | keyname:'a Domain_name.t -> Dns.Dnskey.t -> Letsencrypt.Client.solver 26 | -------------------------------------------------------------------------------- /vendor/dns/dns-mirage.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "cstruct" {>= "6.0.0"} 14 | "dns" {= version} 15 | "ipaddr" {>= "5.2.0"} 16 | "lwt" {>= "4.2.1"} 17 | "tcpip" {>= "8.2.0"} 18 | ] 19 | 20 | build: [ 21 | ["dune" "subst"] {dev} 22 | ["dune" "build" "-p" name "-j" jobs] 23 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 24 | ] 25 | 26 | synopsis: "An opinionated Domain Name System (DNS) library" 27 | description: """ 28 | µDNS supports most of the domain name system used in the wild. It adheres to 29 | strict conventions. Failing early and hard. It is mostly implemented in the 30 | pure fragment of OCaml (no mutation, isolated IO, no exceptions). 31 | 32 | Legacy resource record types are not dealt with, and there is no plan to support 33 | `ISDN`, `MAILA`, `MAILB`, `WKS`, `MB`, `NULL`, `HINFO`, ... . `AXFR` is only 34 | handled via TCP connections. The only resource class supported is `IN` (the 35 | Internet). Truncated hmac in `TSIG` are not supported (always the full length 36 | of the hash algorithm is used). 37 | 38 | Please read [the blog article](https://hannes.robur.coop/Posts/DNS) for a more 39 | detailed overview. 40 | """ 41 | -------------------------------------------------------------------------------- /vendor/dns/unix/client/ohost.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna); 3 | let t = Dns_client_unix.create () in 4 | let domain = Domain_name.(host_exn (of_string_exn Sys.argv.(1))) in 5 | let ipv4 = 6 | match Dns_client_unix.gethostbyname t domain with 7 | | Ok addr -> Fmt.pr "%a has address %a\n" 8 | Domain_name.pp domain Ipaddr.V4.pp addr ; Ok () 9 | | Error _ as err -> err 10 | in 11 | let ipv6 = 12 | match Dns_client_unix.gethostbyname6 t domain with 13 | | Ok addr -> Fmt.pr "%a has IPv6 address %a\n" 14 | Domain_name.pp domain Ipaddr.V6.pp addr ; Ok () 15 | | Error _ as err -> err 16 | in 17 | let mx = 18 | match Dns_client_unix.getaddrinfo t Mx domain with 19 | | Ok (_ttl, resp) -> 20 | Fmt.pr "%a\n" 21 | (Fmt.list (fun ppf -> Fmt.pf ppf "%a mail is handled by %a" 22 | Domain_name.pp domain 23 | Dns.Mx.pp)) (Dns.Rr_map.Mx_set.elements resp) ; 24 | Ok () 25 | | Error _ as err -> err 26 | in 27 | let results = [ ipv4 ; ipv6 ; mx ] in 28 | let is_error = (function Error _ -> true | Ok _ -> false) in 29 | match List.find_opt is_error results with 30 | | None | Some Ok _ -> () (* no errors *) 31 | | Some (Error `Msg msg) -> (* at least one error *) 32 | if List.for_all is_error results then 33 | (* Everything failed; print an error message *) 34 | ( Fmt.epr "Host %a not found: @[%s@]\n" 35 | Domain_name.pp domain msg ; 36 | exit 1) 37 | -------------------------------------------------------------------------------- /vendor/dns/app/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dns_cli) 3 | (public_name dns-cli) 4 | (wrapped false) 5 | (modules dns_cli) 6 | (libraries dns cmdliner ptime.clock.os logs.fmt fmt.cli logs.cli fmt.tty ipaddr.unix)) 7 | 8 | (executable 9 | (name ocertify) 10 | (public_name ocertify) 11 | (package dns-cli) 12 | (modules ocertify) 13 | (libraries dns dns-certify dns-cli bos fpath x509 ptime ptime.clock.os mirage-crypto-pk mirage-crypto-rng mirage-crypto-rng.unix)) 14 | 15 | (executable 16 | (name oupdate) 17 | (public_name oupdate) 18 | (package dns-cli) 19 | (modules oupdate) 20 | (libraries dns dns-tsig dns-cli ptime ptime.clock.os mirage-crypto-rng mirage-crypto-rng.unix randomconv)) 21 | 22 | (executable 23 | (name onotify) 24 | (public_name onotify) 25 | (package dns-cli) 26 | (modules onotify) 27 | (libraries dns dns-tsig dns-cli ptime ptime.clock.os mirage-crypto-rng mirage-crypto-rng.unix randomconv)) 28 | 29 | (executable 30 | (name ozone) 31 | (public_name ozone) 32 | (package dns-cli) 33 | (modules ozone) 34 | (libraries dns dns-cli dns-server.zone dns-server bos)) 35 | 36 | (executable 37 | (name odns) 38 | (public_name odns) 39 | (modules odns) 40 | (package dns-cli) 41 | (libraries dns dns-client-lwt dns-cli cmdliner mtime.clock.os 42 | lwt.unix ohex bos)) 43 | 44 | (executable 45 | (name odnssec) 46 | (public_name odnssec) 47 | (modules odnssec) 48 | (package dns-cli) 49 | (libraries dns dns-client-lwt dns-cli cmdliner mtime.clock.os 50 | lwt.unix dnssec)) 51 | -------------------------------------------------------------------------------- /vendor/dns/dns-cli.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "dns" {= version} 14 | "dnssec" {= version} 15 | "dns-tsig" {= version} 16 | "dns-client-lwt" {= version} 17 | "dns-server" {= version} 18 | "dns-certify" {= version} 19 | "bos" {>= "0.2.0"} 20 | "cmdliner" {>= "1.1.0"} 21 | "fpath" {>= "0.7.2"} 22 | "x509" {>= "1.0.0"} 23 | "mirage-crypto" {>= "1.0.0"} 24 | "mirage-crypto-pk" {>= "1.0.0"} 25 | "mirage-crypto-rng" {>= "1.0.0"} 26 | "ohex" {>= "0.2.0"} 27 | "ptime" {>= "0.8.5"} 28 | "mtime" {>= "1.2.0"} 29 | "logs" {>= "0.6.3"} 30 | "fmt" {>= "0.8.8"} 31 | "ipaddr" {>= "4.0.0"} 32 | "lwt" {>= "4.0.0"} 33 | "randomconv" {>= "0.2.0"} 34 | "alcotest" {with-test} 35 | ] 36 | 37 | build: [ 38 | ["dune" "subst"] {dev} 39 | ["dune" "build" "-p" name "-j" jobs] 40 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 41 | ] 42 | 43 | synopsis: "Unix command line utilities using uDNS" 44 | description: """ 45 | 'oupdate' sends a DNS update frome to a DNS server that sets 'hostname A ip'. 46 | For authentication via TSIG, a hmac secret needs to be provided. 47 | 48 | 'ocertify' updates DNS with a certificate signing request, and polls a matching 49 | certificate. Best used with an letsencrypt unikernel. 50 | """ 51 | -------------------------------------------------------------------------------- /vendor/letsencrypt/src/primitives.ml: -------------------------------------------------------------------------------- 1 | let pub_of_z ~e ~n = Mirage_crypto_pk.Rsa.pub ~e ~n 2 | let pub_to_z (key : Mirage_crypto_pk.Rsa.pub) = 3 | Mirage_crypto_pk.Rsa.(key.e, key.n) 4 | 5 | let sign hash priv data = 6 | let module H = (val (Digestif.module_of_hash' hash)) in 7 | let data = H.to_raw_string (H.digest_string data) in 8 | let ecdsa (r, s) = r ^ s in 9 | match priv with 10 | | `RSA key -> Mirage_crypto_pk.Rsa.PKCS1.sign ~key ~hash (`Digest data) 11 | | `P256 key -> ecdsa (Mirage_crypto_ec.P256.Dsa.sign ~key data) 12 | | `P384 key -> ecdsa (Mirage_crypto_ec.P384.Dsa.sign ~key data) 13 | | `P521 key -> ecdsa (Mirage_crypto_ec.P521.Dsa.sign ~key data) 14 | | _ -> assert false 15 | 16 | let verify hash pub data signature = 17 | let module H = (val (Digestif.module_of_hash' hash)) in 18 | let data = H.to_raw_string (H.digest_string data) in 19 | match pub with 20 | | `RSA key -> 21 | let hashp h = h = hash in 22 | Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Digest data) 23 | | `P256 key when String.length signature = 64 -> 24 | let s = String.sub signature 0 32, String.sub signature 32 32 in 25 | Mirage_crypto_ec.P256.Dsa.verify ~key s data 26 | | `P384 key when String.length signature = 96 -> 27 | let s = String.sub signature 0 48, String.sub signature 48 48 in 28 | Mirage_crypto_ec.P384.Dsa.verify ~key s data 29 | | `P521 key when String.length signature = 132 -> 30 | let s = String.sub signature 0 66, String.sub signature 66 66 in 31 | Mirage_crypto_ec.P521.Dsa.verify ~key s data 32 | | _ -> false 33 | 34 | let sha256 x = 35 | Digestif.SHA256.(to_raw_string (digest_string x)) 36 | -------------------------------------------------------------------------------- /lib/dns_client_eio.ml: -------------------------------------------------------------------------------- 1 | type 'a dns_handler = Dns.proto -> Eio.Net.Sockaddr.t -> string -> 'a -> 'a 2 | 3 | let udp_listen log sock handle_dns state = 4 | let buf = Cstruct.create 4096 in 5 | let rec loop state = 6 | let addr, recv = 7 | let addr, size = Eio.Net.recv sock buf in 8 | let trimmedBuf = Cstruct.sub buf 0 size in 9 | (addr, Cstruct.to_string trimmedBuf) 10 | in 11 | (* convert Eio.Net.Sockaddr.datagram to Eio.Net.Sockaddr.t *) 12 | let addr = 13 | match addr with 14 | | `Udp a -> `Udp a 15 | | `Unix _ -> failwith "unix domain sockets unsupported" 16 | in 17 | log Dns_log.Rx addr recv; 18 | let state = handle_dns `Udp addr recv state in 19 | loop state 20 | in 21 | loop state 22 | 23 | let create_query identifier record_type name = 24 | let question = Dns.Packet.Question.create name record_type 25 | and header = 26 | let flags = Dns.Packet.Flags.singleton `Recursion_desired in 27 | (identifier, flags) 28 | in 29 | let query = Dns.Packet.create header question `Query in 30 | let cs, _ = Dns.Packet.encode `Udp query in 31 | cs 32 | 33 | let send_query log identifier record_type name sock addr = 34 | let query = create_query identifier record_type name in 35 | (* convert Eio.Net.Sockaddr.datagram to Eio.Net.Sockaddr.t *) 36 | let addr = 37 | match addr with 38 | | `Udp a -> `Udp a 39 | | `Unix _ -> failwith "unix domain sockets unsupported" 40 | in 41 | log Dns_log.Tx addr query; 42 | Eio.Net.send sock ~dst:addr [ Cstruct.of_string query ] 43 | 44 | let listen sock log (handle_dns : _ dns_handler) state = 45 | udp_listen log sock handle_dns state 46 | -------------------------------------------------------------------------------- /lib/transport/transport.mli: -------------------------------------------------------------------------------- 1 | module Datagram_server : sig 2 | val run : 3 | sw:Eio.Switch.t -> 4 | < net : _ Eio.Net.t 5 | ; clock : _ Eio.Time.clock 6 | ; mono_clock : _ Eio.Time.Mono.t 7 | ; .. > -> 8 | [ `Tcp | `Udp ] list -> 9 | subdomain:string -> 10 | authorative:string -> 11 | Dns_server.Primary.s ref -> 12 | Dns_log.formattedLog -> 13 | (Eio.Net.Ipaddr.v4v6 * int) list -> 14 | Datagram.t 15 | end 16 | 17 | module Datagram_client : sig 18 | val run : 19 | sw:Eio.Switch.t -> 20 | < net : _ Eio.Net.t 21 | ; clock : _ Eio.Time.clock 22 | ; secure_random : _ Eio.Flow.source 23 | ; .. > -> 24 | nameserver:string -> 25 | subdomain:string -> 26 | authorative:string -> 27 | int -> 28 | Dns_log.formattedLog -> 29 | float -> 30 | Datagram.t 31 | end 32 | 33 | module Stream_server : sig 34 | val run : 35 | sw:Eio.Switch.t -> 36 | < net : _ Eio.Net.t 37 | ; clock : _ Eio.Time.clock 38 | ; mono_clock : _ Eio.Time.Mono.t 39 | ; .. > -> 40 | [ `Tcp | `Udp ] list -> 41 | subdomain:string -> 42 | authorative:string -> 43 | Dns_server.Primary.s ref -> 44 | Dns_log.formattedLog -> 45 | (Eio.Net.Ipaddr.v4v6 * int) list -> 46 | Eio.Flow.two_way_ty Eio.Resource.t 47 | end 48 | 49 | module Stream_client : sig 50 | val run : 51 | sw:Eio.Switch.t -> 52 | < net : _ Eio.Net.t 53 | ; clock : _ Eio.Time.clock 54 | ; secure_random : _ Eio.Flow.source 55 | ; .. > -> 56 | nameserver:string -> 57 | subdomain:string -> 58 | authorative:string -> 59 | int -> 60 | Dns_log.formattedLog -> 61 | float -> 62 | Eio.Flow.two_way_ty Eio.Resource.t 63 | end 64 | -------------------------------------------------------------------------------- /vendor/dns/resolver/dns_resolver.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | type t 4 | (** The type of a DNS resolver. *) 5 | 6 | val create : ?cache_size:int -> 7 | ?ip_protocol:[ `Both | `Ipv4_only | `Ipv6_only ] -> 8 | ?dnssec:bool -> 9 | int64 -> (int -> string) -> Dns_server.Primary.s -> t 10 | (** [create ~cache_size ~ip_protocol ~dnssec now rng primary] creates the value 11 | of a resolver, pre-filled with root NS and their IP addresses. If 12 | [ip_protocol] is provided, and set to [`V4_only], only IPv4 packets will be 13 | emitted. If [`V6_only] is set, only IPv6 packets will be emitted. If [`Both] 14 | (the default), either IPv4 and IPv6 packets are emitted. If [dnssec] is 15 | provided and [false] (defaults to [true]), DNSSec validation will be 16 | disabled. *) 17 | 18 | val handle_buf : t -> Ptime.t -> int64 -> bool -> Dns.proto -> Ipaddr.t -> 19 | int -> string -> 20 | t * (Dns.proto * Ipaddr.t * int * string) list 21 | * (Dns.proto * Ipaddr.t * string) list 22 | (** [handle_buf t now ts query_or_reply proto sender source-port buf] handles 23 | resolution of [buf], which leads to a new [t], a list of answers to be 24 | transmitted (quadruple of protocol, ip address, port, buffer), and a list of 25 | queries (triple of protocol, ip address, buffer). *) 26 | 27 | val query_root : t -> int64 -> Dns.proto -> 28 | t * (Dns.proto * Ipaddr.t * string) 29 | (** [query_root t now proto] potentially requests an update of the root 30 | zone. Best invoked by a regular timer. *) 31 | 32 | val timer : t -> int64 -> 33 | t * (Dns.proto * Ipaddr.t * int * string) list 34 | * (Dns.proto * Ipaddr.t * string) list 35 | (** [timer t now] potentially retransmits DNS requests and/or sends NXDomain 36 | answers. *) 37 | -------------------------------------------------------------------------------- /vendor/dns/dns.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "team AT robur dot coop" 3 | authors: ["Hannes Mehnert " "Reynir Björnsson "] 4 | homepage: "https://github.com/mirage/ocaml-dns" 5 | doc: "https://mirage.github.io/ocaml-dns/" 6 | dev-repo: "git+https://github.com/mirage/ocaml-dns.git" 7 | bug-reports: "https://github.com/mirage/ocaml-dns/issues" 8 | license: "BSD-2-Clause" 9 | 10 | depends: [ 11 | "dune" {>= "2.0.0"} 12 | "ocaml" {>= "4.13.0"} 13 | "logs" "ptime" 14 | "fmt" {>= "0.8.8"} 15 | "domain-name" {>= "0.4.0"} 16 | "gmap" {>= "0.3.0"} 17 | "ipaddr" {>= "5.2.0"} 18 | "alcotest" {with-test} 19 | "lru" {>= "0.3.0"} 20 | "duration" {>= "0.1.2"} 21 | "metrics" 22 | "ohex" {>= "0.2.0"} 23 | "base64" {>= "3.3.0"} 24 | ] 25 | conflicts: [ "result" {< "1.5"} ] 26 | build: [ 27 | ["dune" "subst"] {dev} 28 | ["dune" "build" "-p" name "-j" jobs] 29 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 30 | ] 31 | 32 | synopsis: "An opinionated Domain Name System (DNS) library" 33 | description: """ 34 | µDNS supports most of the domain name system used in the wild. It adheres to 35 | strict conventions. Failing early and hard. It is mostly implemented in the 36 | pure fragment of OCaml (no mutation, isolated IO, no exceptions). 37 | 38 | Legacy resource record types are not dealt with, and there is no plan to support 39 | `ISDN`, `MAILA`, `MAILB`, `WKS`, `MB`, `NULL`, `HINFO`, ... . `AXFR` is only 40 | handled via TCP connections. The only resource class supported is `IN` (the 41 | Internet). Truncated hmac in `TSIG` are not supported (always the full length 42 | of the hash algorithm is used). 43 | 44 | Please read [the blog article](https://hannes.robur.coop/Posts/DNS) for a more 45 | detailed overview. 46 | """ 47 | -------------------------------------------------------------------------------- /vendor/dns/zone/dns_zone_state.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2005-2006 Tim Deegan 3 | * Copyright (c) 2017 Hannes Mehnert 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | * 17 | * dnsloader.ml -- how to build up a DNS trie from separate RRs 18 | * 19 | *) 20 | 21 | (* State variables for the parser & lexer *) 22 | type parserstate = { 23 | mutable paren : int ; 24 | mutable lineno : int ; 25 | mutable origin : [ `raw ] Domain_name.t ; 26 | mutable ttl : int32 ; 27 | mutable owner : [ `raw ] Domain_name.t ; 28 | mutable zone : Dns.Name_rr_map.t ; 29 | } 30 | 31 | let state = { 32 | paren = 0 ; 33 | lineno = 1 ; 34 | ttl = Int32.of_int 3600 ; 35 | origin = Domain_name.root ; 36 | owner = Domain_name.root ; 37 | zone = Domain_name.Map.empty ; 38 | } 39 | 40 | let reset () = 41 | state.paren <- 0 ; 42 | state.lineno <- 1 ; 43 | state.ttl <- Int32.of_int 3600 ; 44 | state.origin <- Domain_name.root ; 45 | state.owner <- Domain_name.root ; 46 | state.zone <- Dns.Name_rr_map.empty 47 | 48 | exception Zone_parse_problem of string 49 | 50 | -------------------------------------------------------------------------------- /vendor/dns/mirage/server/dns_server_mirage.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | module Make (P : Mirage_clock.PCLOCK) (M : Mirage_clock.MCLOCK) (T : Mirage_time.S) (S : Tcpip.Stack.V4V6) : sig 4 | 5 | val primary : 6 | ?on_update:(old:Dns_trie.t -> authenticated_key:[`raw] Domain_name.t option -> update_source:Ipaddr.t -> Dns_server.Primary.s -> unit Lwt.t) -> 7 | ?on_notify:([ `Notify of Dns.Soa.t option | `Signed_notify of Dns.Soa.t option ] -> 8 | Dns_server.Primary.s -> 9 | (Dns_trie.t * ([ `raw ] Domain_name.t * Dns.Dnskey.t) list) option Lwt.t) -> 10 | ?timer:int -> ?port:int -> S.t -> Dns_server.Primary.s -> unit 11 | (** [primary ~on_update ~timer ~port stack primary] starts a primary server on 12 | [port] (default 53, both TCP and UDP) with the given [primary] 13 | configuration. [timer] is the DNS notify timer in seconds, and defaults to 14 | 2 seconds. [on_update ~old ~authenticated_key ~update_source s] is a 15 | callback if the data served by the primary server [s] got updated by a 16 | potentially authenticated nsupdate packet, the used [authenticated_key] 17 | and source [update_source] are passed to the callback. The 18 | [on_notify notify s] callback is executed when a notify request is received 19 | by the primary DNS server (may be used for signaling of a (hidden) DNS 20 | secondary server). *) 21 | 22 | val secondary : 23 | ?on_update:(old:Dns_trie.t -> Dns_server.Secondary.s -> unit Lwt.t) -> 24 | ?timer:int -> ?port:int -> S.t -> Dns_server.Secondary.s -> 25 | unit 26 | (** [secondary ~on_update ~timer ~port stack secondary] starts a secondary 27 | server on [port] (default 53). The [on_update] callback is executed when 28 | the zone changes. The [timer] (in seconds, defaults to 5 seconds) is used 29 | for refreshing zones. *) 30 | end 31 | -------------------------------------------------------------------------------- /lib/transport/cstruct_stream.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | items : Cstruct.t list ref; 3 | mut : Eio.Mutex.t; 4 | cond : Eio.Condition.t; 5 | } 6 | 7 | exception Empty 8 | 9 | let create () = 10 | { items = ref []; mut = Eio.Mutex.create (); cond = Eio.Condition.create () } 11 | 12 | let add t bufs = 13 | Eio.Mutex.use_rw t.mut ~protect:false (fun () -> 14 | t.items := !(t.items) @ bufs; 15 | Eio.Condition.broadcast t.cond) 16 | 17 | let take t buf = 18 | Eio.Mutex.use_rw t.mut ~protect:false (fun () -> 19 | (* if `Cstruct.lenv !(t.items) == 0` we just send an empty packet *) 20 | while !(t.items) == [] do 21 | Eio.Condition.await t.cond t.mut 22 | done; 23 | let read, new_items = Cstruct.fillv ~src:!(t.items) ~dst:buf in 24 | t.items := new_items; 25 | read) 26 | 27 | let try_take q buf = 28 | let read, empty = 29 | Eio.Mutex.use_rw ~protect:false q.mut (fun () -> 30 | (* if `Cstruct.lenv !(q.items) == 0` we just send an empty packet *) 31 | if !(q.items) == [] then (0, true) 32 | else 33 | let read, new_items = Cstruct.fillv ~src:!(q.items) ~dst:buf in 34 | q.items := new_items; 35 | (read, false)) 36 | in 37 | if empty then None else Some read 38 | 39 | let take_one t buf = 40 | Eio.Mutex.use_rw t.mut ~protect:false (fun () -> 41 | let rec f () = 42 | match !(t.items) with 43 | | [] -> 44 | Eio.Condition.await t.cond t.mut; 45 | f () 46 | | packet :: new_items -> 47 | let packet_len = Cstruct.length packet in 48 | (* will raise if buf isn't big enough to hold packet *) 49 | Cstruct.blit packet 0 buf 0 packet_len; 50 | t.items := new_items; 51 | packet_len 52 | in 53 | f ()) 54 | 55 | let try_take_one t = 56 | Eio.Mutex.use_rw t.mut ~protect:false (fun () -> 57 | match !(t.items) with 58 | | [] -> None 59 | | packet :: new_items -> 60 | t.items := new_items; 61 | Some packet) 62 | -------------------------------------------------------------------------------- /lib/util/dns_log.ml: -------------------------------------------------------------------------------- 1 | type dir = Rx | Tx 2 | type log = Format.formatter -> dir -> Eio.Net.Sockaddr.t -> string -> unit 3 | type formattedLog = dir -> Eio.Net.Sockaddr.t -> string -> unit 4 | type level = Level0 | Level1 | Level2 | Level3 5 | 6 | let level_0 _fmt (_direction : dir) _addr _buf = () 7 | 8 | let log_helper fmt (direction : dir) addr buf log_packet = 9 | let log_transmssion (direction : dir) addr = 10 | (match direction with 11 | | Rx -> Format.fprintf fmt "<-" 12 | | Tx -> Format.fprintf fmt "->"); 13 | Format.print_space (); 14 | Eio.Net.Sockaddr.pp fmt addr; 15 | Format.print_space () 16 | in 17 | log_transmssion direction addr; 18 | match Dns.Packet.decode buf with 19 | | Error e -> 20 | Format.fprintf fmt "error decoding:"; 21 | Dns.Packet.pp_err fmt e; 22 | Format.print_space (); 23 | Format.print_flush () 24 | | Ok packet -> 25 | log_packet packet; 26 | Format.print_space (); 27 | Format.print_space (); 28 | Format.print_flush () 29 | 30 | let level_1 fmt (direction : dir) addr buf = 31 | let log_packet (packet : Dns.Packet.t) = 32 | let id, _flags = packet.header in 33 | Format.fprintf fmt "header %04X question %a@ data %a@" id 34 | Dns.Packet.Question.pp packet.question Dns.Packet.pp_data packet.data 35 | in 36 | log_helper fmt direction addr buf log_packet 37 | 38 | let level_2 fmt (direction : dir) addr buf = 39 | let log_packet = Dns.Packet.pp fmt in 40 | log_helper fmt direction addr buf log_packet 41 | 42 | let level_3 fmt (direction : dir) addr buf = 43 | let log_transmssion (direction : dir) addr = 44 | (match direction with 45 | | Rx -> Format.fprintf fmt "<-" 46 | | Tx -> Format.fprintf fmt "->"); 47 | Format.print_space (); 48 | Eio.Net.Sockaddr.pp fmt addr; 49 | Format.print_space () 50 | in 51 | log_transmssion direction addr; 52 | Format.print_flush (); 53 | (Fmt.on_string (Fmt.hex ())) fmt buf; 54 | Format.print_space (); 55 | Format.print_flush () 56 | 57 | let get i = 58 | match i with 59 | | Level0 -> level_0 60 | | Level1 -> level_1 61 | | Level2 -> level_2 62 | | Level3 -> level_3 63 | -------------------------------------------------------------------------------- /vendor/dns/zone/dns_zone.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2005-2006 Tim Deegan 3 | * Copyright (c) 2017 Hannes Mehnert 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | * 17 | *) 18 | 19 | val parse : string -> (Dns.Name_rr_map.t, [> `Msg of string ]) result 20 | (** [parse data] attempts to parse the [data], given in [zone file format]. 21 | It either returns the content as a map, or an error. *) 22 | 23 | val decode_keys : 'a Domain_name.t -> string -> Dns.Dnskey.t Domain_name.Map.t 24 | (** [decode_keys zone data] decodes DNSKEY in [data], and ensure that all are 25 | within [zone]. Errors are logged via the logs library. *) 26 | 27 | val decode_zones : (string * string) list -> Domain_name.Set.t * Dns_trie.t 28 | (** [decode_zones (name, data)] parses the zones [data] with the names 29 | [name], and constructs a trie that has been checked for consistency. 30 | The set of zones are returned, together with the constructed trie. 31 | Errors and inconsistencies are logged via the logs library, and the 32 | respective zone data is ignored. *) 33 | 34 | val decode_zones_keys : (string * string) list -> 35 | Domain_name.Set.t * Dns_trie.t * ([`raw] Domain_name.t * Dns.Dnskey.t) list 36 | (** [decode_zones_keys (name, data)] is [decode_zones], but also if a [name] 37 | ends with "_keys", the Dnskey records are decoded (using [decode_keys] and 38 | are added to the last part of the return value. *) 39 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | inputs = { 3 | nixpkgs.url = "github:nixos/nixpkgs"; 4 | opam-nix.url = "github:tweag/opam-nix"; 5 | flake-utils.url = "github:numtide/flake-utils"; 6 | # we pin opam-nix's nixpkgs to follow the flakes, avoiding using two different instances 7 | opam-nix.inputs.nixpkgs.follows = "nixpkgs"; 8 | 9 | # maintain a different opam-repository to those pinned upstream 10 | # opam-repository = { 11 | # url = "github:ocaml/opam-repository"; 12 | # flake = false; 13 | # }; 14 | # opam-nix.inputs.opam-repository.follows = "opam-repository"; 15 | 16 | # deduplicate flakes 17 | opam-nix.inputs.flake-utils.follows = "flake-utils"; 18 | }; 19 | outputs = { self, nixpkgs, flake-utils, opam-nix, ... }@inputs: 20 | # create outputs for each default system 21 | flake-utils.lib.eachDefaultSystem (system: 22 | let 23 | package = "eon"; 24 | pkgs = nixpkgs.legacyPackages.${system}; 25 | opam-nix-lib = opam-nix.lib.${system}; 26 | devPackagesQuery = { 27 | ocaml-lsp-server = "*"; 28 | ocamlformat = "*"; 29 | utop = "*"; 30 | }; 31 | query = { 32 | ocaml-base-compiler = "*"; 33 | }; 34 | scope = 35 | # recursive finds vendored dependancies in duniverse 36 | opam-nix-lib.buildOpamProject' { recursive = true; } ./. (query // devPackagesQuery); 37 | in { 38 | packages.default = scope.${package}; 39 | defaultPackage = scope.${package}; 40 | 41 | devShells.default = let 42 | devPackages = builtins.attrValues 43 | (pkgs.lib.getAttrs (builtins.attrNames devPackagesQuery) scope); 44 | in pkgs.mkShell { 45 | inputsFrom = [ scope.${package} ]; 46 | buildInputs = devPackages; 47 | }; 48 | }) // { 49 | nixosModules = { 50 | default.imports = [ (import ./module.nix self.packages) ]; 51 | acme.imports = [ (import ./acme.nix self.packages) ]; 52 | }; 53 | 54 | formatter = nixpkgs.lib.genAttrs nixpkgs.lib.systems.flakeExposed 55 | (system: nixpkgs.legacyPackages.${system}.nixfmt); 56 | }; 57 | } 58 | -------------------------------------------------------------------------------- /lib/acme/tls_le.ml: -------------------------------------------------------------------------------- 1 | (* adapted from 2 | https://github.com/avsm/eeww/blob/ea7c8e5513e6524b28b24947de6bf0fabef78ef9/src/tls_le/tls_le.ml *) 3 | 4 | exception Le_error of string 5 | 6 | let errcheck = function Ok v -> v | Error (`Msg m) -> raise (Le_error m) 7 | let gen_account_key () = `RSA (Mirage_crypto_pk.Rsa.generate ~bits:2048 ()) 8 | let gen_private_key () = `RSA (Mirage_crypto_pk.Rsa.generate ~bits:4096 ()) 9 | 10 | let gen_csr ~private_key ~email ?(org = None) domains = 11 | let open X509 in 12 | match List.map Domain_name.to_string domains with 13 | | [] -> raise (Invalid_argument "Must specify at least one domain") 14 | | names -> 15 | let dn = 16 | let open X509.Distinguished_name in 17 | [ Relative_distinguished_name.(singleton (Mail email)) ] 18 | @ 19 | match org with 20 | | Some org -> [ Relative_distinguished_name.(singleton (O org)) ] 21 | | None -> [] 22 | in 23 | let extensions = 24 | let extensions = 25 | Extension.( 26 | singleton Subject_alt_name 27 | (false, General_name.(General_name.singleton DNS names))) 28 | in 29 | Signing_request.Ext.(add Extensions extensions empty) 30 | in 31 | X509.Signing_request.create dn private_key ~extensions |> errcheck 32 | 33 | let gen_cert ?account_key ?private_key ~email ?(org = None) domains ~endpoint 34 | ~solver env = 35 | let account_key = 36 | Option.value account_key ~default:(Lazy.force (lazy (gen_account_key ()))) 37 | in 38 | let private_key = 39 | Option.value private_key ~default:(Lazy.force (lazy (gen_private_key ()))) 40 | in 41 | let csr = gen_csr ~private_key ~email ~org domains in 42 | let sleep n = Eio.Time.sleep env#clock (float_of_int n) in 43 | let le = 44 | Letsencrypt.Client.initialise env ~endpoint ~email account_key |> errcheck 45 | in 46 | let cert = 47 | Letsencrypt.Client.sign_certificate env solver le sleep csr |> errcheck 48 | in 49 | (cert, account_key, private_key, csr) 50 | 51 | let tls_config ?alpn_protocols ~cert ~private_key () = 52 | let certificates : Tls.Config.own_cert = `Single (cert, private_key) in 53 | Tls.Config.( 54 | server ?alpn_protocols ~version:(`TLS_1_0, `TLS_1_3) ~certificates 55 | ~ciphers:Ciphers.supported ()) 56 | -------------------------------------------------------------------------------- /bin/transport/sod/fork_actions.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #include 9 | #include 10 | 11 | typedef void fork_fn(int errors, value v_args); 12 | 13 | static void handle_error(int errors, char *msg) { 14 | dprintf(errors, "%s: %s", msg, strerror(errno)); 15 | _exit(errno); 16 | } 17 | 18 | Caml_inline value Val_fork_fn(fork_fn *fn) { 19 | return caml_copy_nativeint((intnat) fn); 20 | } 21 | 22 | static void action_setup_shell(int errors, value v_config) { 23 | value pty = Field(v_config, 1); 24 | 25 | int fd, masterfd, slavefd; 26 | const char *ttyname; 27 | 28 | masterfd = Int_val(Field(pty, 0)); 29 | slavefd = Int_val(Field(pty, 1)); 30 | ttyname = String_val(Field(pty, 2)); 31 | 32 | if (dup2(slavefd, STDIN_FILENO) == -1) 33 | handle_error(errors, "action_setup_shell Error switching stdin"); 34 | if (dup2(slavefd, STDOUT_FILENO) == -1) 35 | handle_error(errors, "action_setup_shell Error switching stdout"); 36 | if (dup2(slavefd, STDERR_FILENO) == -1) 37 | handle_error(errors, "action_setup_shell Error switching stderr"); 38 | 39 | /* Disconnect from the old tty */ 40 | fd = open(_PATH_TTY, O_RDWR | O_NOCTTY); 41 | if (fd != -1) { 42 | ioctl(fd, TIOCNOTTY, NULL); 43 | close(fd); 44 | } 45 | 46 | if (setsid() == -1) 47 | handle_error(errors, "action_setup_shell Error creating session"); 48 | 49 | /* Verify that we have successfully disconnected */ 50 | fd = open(_PATH_TTY, O_RDWR | O_NOCTTY); 51 | if (fd != -1) 52 | handle_error(errors, "action_setup_shell Failed to disconnect original tty"); 53 | 54 | /* Switch to the new tty */ 55 | if (ioctl(slavefd, TIOCSCTTY, NULL) < 0) 56 | handle_error(errors, "TIOCSCTTY"); 57 | 58 | fd = open(ttyname, O_RDWR); 59 | if (fd == -1) 60 | dprintf(errors, "action_setup_shell Error opening %s: %s", ttyname, strerror(errno)); 61 | else 62 | close(fd); 63 | 64 | /* Verify that the tty is now the controller */ 65 | fd = open(_PATH_TTY, O_WRONLY); 66 | if (fd == -1) 67 | handle_error(errors, "action_setup_shell Failed to set controlling tty"); 68 | else 69 | close(fd); 70 | } 71 | 72 | CAMLprim value eio_unix_fork_setup_shell(value v_unit) { 73 | return Val_fork_fn(action_setup_shell); 74 | } 75 | -------------------------------------------------------------------------------- /vendor/letsencrypt/CHANGES.md: -------------------------------------------------------------------------------- 1 | # v1.0.0 (2024-09-04) 2 | 3 | * update to mirage-crypto 1.0.0 and x509 1.0.0 API (#34 @hannesm) 4 | * package moved to the robur-coop organization 5 | 6 | # v0.5.1 (2023-03-13) 7 | 8 | * letsencrypt-mirage: allow alpn protocols to be specified (#33 @dinosaure) 9 | 10 | # v0.5.0 (2023-02-17) 11 | 12 | * adapt to mirage-crypto-rng 0.11.0 API changes (@hannesm) 13 | * upgrade bin/oacmel with cmdliner 1.1.0 (#30 @dinosaure) 14 | * add new letsencrypt-mirage package (#30 @dinosaure) 15 | * export HTTP_client module directly (#30 @dinosaure) 16 | 17 | # v0.4.1 (2021-10-27) 18 | 19 | * remove rresult dependency (#29 @hannesm) 20 | * avoid deprecated fmt functions (#29 @hannesm) 21 | 22 | # v0.4.0 (2021-09-21) 23 | 24 | * support EC (P-256, P-384, P-521) account keys (@reynir @hannesm) 25 | (reported in #24 by @dinosaure) 26 | * allow key_type to be passed into the alpn_solver (@hannesm) 27 | * add RFC 7520 test cases (@reynir @hannesm) 28 | * remove astring dependency (@hannesm) 29 | * bugfix: "orders" field in account is Uri.t option, not a list (@hannesm) 30 | (reported in #27 by @torinnd) 31 | 32 | # v0.3.0 (2021-07-19) 33 | 34 | Reduce dependency cone (#26, @dinosaure & @hannesm) 35 | - remove cohttp dependency, provide a HTTP_client module type 36 | - provide letsencrypt-dns with dns solver 37 | - provide letsencrypt-app for the client binary 38 | 39 | # v0.2.5 (2021-04-22) 40 | 41 | * adapt to X.509 0.13.0 API (@hannesm) 42 | 43 | # v0.2.4 (2021-04-14) 44 | 45 | * adapt to X.509 0.12.0 (#23 @dinosaure) by completing the pattern match in 46 | oacmel (still, only RSA account keys are supported) 47 | 48 | # v0.2.3 (2021-01-21) 49 | 50 | * adapt to mirage-crypto-pk 0.8.9 changes (d = e ^ -1 mod lam n) #22 51 | 52 | # v0.2.2 (2020-04-09) 53 | 54 | * adapt to x509 0.11.0 API #21 55 | 56 | # v0.2.1 (2020-03-12) 57 | 58 | * use mirage-crypto instead of nocrypto #20 59 | * reorder arguments for nsupdate to avoid a labelled one at the end #20 60 | 61 | # v0.2.0 (2020-02-18) 62 | 63 | * support ACME as specified in RFC 8555 (letsencrypt v2 endpoints) #19 64 | * support for the ALPN challenge as well #19 65 | 66 | # v0.1.1 (2020-01-27) 67 | 68 | * use X509.Signing_request.hostnames, introduced in x509 v0.9.0 69 | * provide a custom log source 70 | 71 | # v0.1.0 (2019-11-02) 72 | 73 | * Initial release 74 | -------------------------------------------------------------------------------- /lib/transport/domain_name_data.ml: -------------------------------------------------------------------------------- 1 | (* rfc1035 section 2.3.4 *) 2 | let max_name_len = 255 3 | let max_label_len = 63 4 | 5 | let max_encoded_len = 6 | (* subtract the characters needed for label delimination *) 7 | let max_name_non_label_len = max_name_len - (max_name_len / max_label_len) in 8 | (* as base64 encodes 6 bits in a byte, this gives us 3/4 of the `max_name_len` rounded up *) 9 | 1 + ((max_name_non_label_len - 1) / 4 * 3) 10 | 11 | let decode subdomain name = 12 | let ( let* ) = Option.bind in 13 | let* i = 14 | Domain_name.find_label name (fun s -> 15 | String.equal subdomain (String.lowercase_ascii s)) 16 | in 17 | let data_name = 18 | Domain_name.drop_label_exn ~rev:true 19 | ~amount:(Domain_name.count_labels name - i) 20 | name 21 | in 22 | let root = Domain_name.drop_label_exn ~amount:(i + 1) name in 23 | let data_array = Domain_name.to_array data_name in 24 | let data = String.concat "" (Array.to_list data_array) in 25 | (* if there is no data encoded, return an empty buffer *) 26 | if String.length data == 0 then Some (Cstruct.empty, root) 27 | else 28 | try 29 | let cstruct = Cstruct.of_string @@ Base64.decode_exn data in 30 | Some (cstruct, root) 31 | with Invalid_argument e -> 32 | Format.fprintf Format.err_formatter "Transport: error decoding %s\n" e; 33 | Format.pp_print_flush Format.err_formatter (); 34 | None 35 | 36 | let encode root cstruct = 37 | let data = Base64.encode_exn @@ Cstruct.to_string cstruct in 38 | let authority = Domain_name.to_string root in 39 | (* String.length (data_subdomain ^ "." ^ authority) *) 40 | assert (String.length data + 1 + String.length authority <= max_name_len); 41 | let rec labels_of_string string = 42 | let len = String.length string in 43 | if len > max_label_len then 44 | let label = String.sub string 0 max_label_len in 45 | let string = String.sub string max_label_len (len - max_label_len) in 46 | let list = labels_of_string string in 47 | label :: list 48 | else [ string ] 49 | in 50 | let data_name = Array.of_list @@ labels_of_string data in 51 | let name_array = Array.append (Domain_name.to_array root) data_name in 52 | let hostname = Domain_name.of_array name_array in 53 | (* if the message is empty, just return the root *) 54 | if Cstruct.length cstruct == 0 then root else hostname 55 | -------------------------------------------------------------------------------- /vendor/letsencrypt/bin/acme_server.ml: -------------------------------------------------------------------------------- 1 | open Cohttp 2 | open Cohttp_lwt_unix 3 | open Dispatch 4 | open Lwt 5 | 6 | module Json = Yojson.Basic 7 | 8 | open Dispatch 9 | open Acme_common 10 | 11 | let ca = "http://localhost:8080/" 12 | let path_directory = "directory" 13 | 14 | type t = { 15 | port : int; 16 | dir : directory_t; 17 | } 18 | 19 | let new_directory root = 20 | let u path = root ^ path |> Uri.of_string in 21 | { 22 | directory = u "/directory"; 23 | new_authz = u "/acme/new-authz"; 24 | new_reg = u "/acme/new-reg"; 25 | new_cert = u "/acme/new-cert"; 26 | revoke_cert = u "/acme/revoke-cert"; 27 | } 28 | 29 | 30 | let new_server root port = 31 | let dir = new_directory root in 32 | { 33 | dir = dir; 34 | port = port; 35 | } 36 | 37 | let index_handler keys rest s request = 38 | let body = "Hello!\n" in 39 | Server.respond_string ~status:`OK ~body () 40 | 41 | let directory_handler keys rest s request = 42 | let p = Uri.to_string in 43 | let body = Printf.sprintf 44 | {|{"new-authz": "%s", "new-cert": "%s", "new-reg": "%s", "revoke-cert": "%s"}|} 45 | (p s.dir.new_authz) 46 | (p s.dir.new_cert) 47 | (p s.dir.new_reg) 48 | (p s.dir.revoke_cert) 49 | in 50 | Server.respond_string ~status:`OK ~body () 51 | 52 | let new_reg_handler keys rest s request = 53 | let body = "" in 54 | Server.respond_string ~status:`OK ~body () 55 | 56 | let notfound_handler uri = 57 | let body = "404: Not found." in 58 | Server.respond_string ~status:`Not_found ~body () 59 | 60 | let serve s request = 61 | let path = Request.uri request |> Uri.path in 62 | let table = [ 63 | "/", index_handler; 64 | Uri.path s.dir.directory, directory_handler; 65 | Uri.path s.dir.new_reg, new_reg_handler; 66 | ] 67 | in 68 | match DSL.dispatch table path with 69 | | Ok handler -> handler s request 70 | | Error _ -> notfound_handler path 71 | 72 | 73 | let start_server s = 74 | let callback conn_id request body = serve s request in 75 | let port = `Port s.port in 76 | Server.create ~mode:(`TCP port) (Server.make ~callback ()) 77 | 78 | let () = 79 | let host = "localhost" in 80 | let port = 8000 in 81 | let root = Printf.sprintf "http://%s:%d" host port in 82 | let s = new_server root port in 83 | Printf.printf "Starting server on %s" root; 84 | start_server s |> Lwt_main.run |> ignore 85 | -------------------------------------------------------------------------------- /vendor/dns/tsig/dns_tsig.mli: -------------------------------------------------------------------------------- 1 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | open Dns 4 | 5 | (** DNS TSIG signatures *) 6 | 7 | (** As specified by {{:https://tools.ietf.org/html/rfc2845}RFC 2845} *) 8 | 9 | val sign : Tsig_op.sign 10 | (** [sign ~mac ~max_size name tsig ~key packet buffer] signs the given 11 | [buffer] with the provided [key], its [name], the [tsig]. The [mac] 12 | argument is expected when a reply to a signed DNS packet should be signed. 13 | If signing fails, an error may be produced. The result is a buffer and a 14 | mac. *) 15 | 16 | val verify : Tsig_op.verify 17 | (** [verify ~mac now packet name ~key tsig buffer] verifies the [buffer] 18 | using the provided [tsig], [key] and [name].*) 19 | 20 | type s = [ `Key_algorithm of Dnskey.t | `Tsig_creation | `Sign ] 21 | (** The type for signing errors. *) 22 | 23 | val pp_s : s Fmt.t 24 | (** [pp_s ppf s] pretty-prints [s] on [ppf]. *) 25 | 26 | val encode_and_sign : ?proto:proto -> ?mac:string -> Packet.t -> Ptime.t -> 27 | Dns.Dnskey.t -> 'a Domain_name.t -> (string * string, s) result 28 | (** [encode_and_sign ~proto ~mac t now dnskey name] signs and encodes the DNS 29 | packet. If a reply to a request is signed, the [mac] argument should be the 30 | message authentication code from the request (needed to sign the reply). 31 | The returned value is the encoded byte buffer and the mac of the packet 32 | (useful for passing into {!decode_and_verify} when receiving a reply to the 33 | signed request). *) 34 | 35 | type e = [ 36 | | `Decode of Packet.err 37 | | `Unsigned of Packet.t 38 | | `Crypto of Tsig_op.e 39 | | `Invalid_key of [ `raw ] Domain_name.t * [ `raw ] Domain_name.t 40 | ] 41 | (** The type for decode and verify errors. *) 42 | 43 | val pp_e : e Fmt.t 44 | (** [pp_e ppf e] prety-prints [e] on [ppf]. *) 45 | 46 | val decode_and_verify : Ptime.t -> Dnskey.t -> 'a Domain_name.t -> 47 | ?mac:string -> string -> 48 | (Packet.t * Tsig.t * string, e) result 49 | (** [decode_and_verify now dnskey name ~mac buffer] decodes and verifies the 50 | given buffer using the key material, resulting in a DNS packet, a signature, 51 | and the [mac], or a failure. The optional [mac] argument should be provided 52 | if an answer to a signed DNS packet is to be decoded. *) 53 | 54 | (**/**) 55 | val compute_tsig : 'a Domain_name.t -> Tsig.t -> key:string -> 56 | string -> string 57 | (** [compute_tsig name tsig ~key buffer] computes the mac over [buffer] 58 | and [tsig], using the provided [key] and [name]. *) 59 | -------------------------------------------------------------------------------- /lib/cap/schema.capnp: -------------------------------------------------------------------------------- 1 | @0xf8f86fb5561e3599; 2 | 3 | struct Prereq { 4 | name @0: Text; 5 | union { 6 | exists :group { 7 | type @1 :Int16; 8 | } 9 | existsData :group { 10 | type @2 :Int16; 11 | value @3 :Data; 12 | } 13 | notExists :group { 14 | type @4 :Int16; 15 | } 16 | nameInUse @5 :Void; 17 | notNameInUse @6 :Void; 18 | } 19 | } 20 | 21 | struct Update { 22 | name @0: Text; 23 | union { 24 | add :group { 25 | type @1 :Int16; 26 | value @2 :Data; 27 | ttl @3 :Int32; 28 | } 29 | remove :group { 30 | type @4 :Int16; 31 | } 32 | removeAll @5 :Void; 33 | removeSingle :group { 34 | type @6 :Int16; 35 | value @7 :Data; 36 | } 37 | } 38 | } 39 | 40 | struct CertReq { 41 | # Used to request a certificate for a service 42 | union { 43 | callback @0 :CertCallback; 44 | none @1 :Void; 45 | } 46 | } 47 | 48 | interface Domain { 49 | # Capability for a domain 50 | 51 | getName @0 () -> (name :Text); 52 | # Get the domain name 53 | 54 | delegate @1 (subdomain :Text) -> (domain :Domain); 55 | # Create a capability for a subdomain 56 | 57 | update @2 (prereqs :List(Prereq), updates :List(Update)) -> (success :Bool, error :Text); 58 | # DNS update 59 | 60 | cert @3 (email: Text, domains :List(Text), org :Text, certCallback :CertCallback) -> (); 61 | # Request a certificate for a domain ("") / wildcard domain "*" 62 | } 63 | 64 | interface Primary { 65 | # Capability for a primary nameserver for a domain 66 | 67 | getName @0 () -> (name :Text); 68 | # Get the domain name that this primary is serving 69 | 70 | registerSeconday @1 (secondary :Secondary) -> (); 71 | # register a secondary server with this primary 72 | # as an optimisation we could add a serial number here 73 | 74 | updateSecondaries @2 (prereqs :List(Prereq), updates :List(Update)) -> (success :Bool, error :Text); 75 | # update secondary nameservers for this primary 76 | } 77 | 78 | interface Secondary { 79 | # Capability for a secondary nameserver for a domain 80 | 81 | getName @0 () -> (name :Text); 82 | # Get the domain name that this secondary is serving 83 | 84 | update @1 (prereqs :List(Prereq), updates :List(Update)) -> (success :Bool, error :Text); 85 | # DNS update from primary 86 | } 87 | 88 | interface CertCallback { 89 | # Callback to support provisioning and renewal 90 | 91 | register @0 (success :Bool, error :Text, cert :Data, key :Text, renewed: Bool) -> (); 92 | # register a provisioned certificate 93 | } 94 | 95 | -------------------------------------------------------------------------------- /vendor/letsencrypt/dns/letsencrypt_dns.ml: -------------------------------------------------------------------------------- 1 | let src = Logs.Src.create "letsencrypt.dns" ~doc:"let's encrypt library" 2 | module Log = (val Logs.src_log src : Logs.LOG) 3 | 4 | let dns_solver writef = 5 | let solve_challenge ~token:_ ~key_authorization domain = 6 | let solution = Letsencrypt.sha256_and_base64 key_authorization in 7 | let domain_name = Domain_name.prepend_label_exn domain "_acme-challenge" in 8 | writef domain_name solution 9 | in 10 | { Letsencrypt.Client.typ = `Dns ; solve_challenge } 11 | 12 | let print_dns = 13 | let solve domain solution = 14 | Log.warn (fun f -> f "Setup a TXT record for %a to return %s and press enter to continue" 15 | Domain_name.pp domain solution); 16 | ignore (read_line ()); 17 | Ok () 18 | in 19 | dns_solver solve 20 | 21 | let nsupdate ?proto id now out ?recv ~zone ~keyname key = 22 | let open Dns in 23 | let nsupdate name record = 24 | Log.info (fun m -> m "solving dns by update to! %a (name %a)" 25 | Domain_name.pp zone Domain_name.pp name); 26 | let zone = Packet.Question.create zone Rr_map.Soa 27 | and update = 28 | let up = 29 | Domain_name.Map.singleton name 30 | [ 31 | Packet.Update.Remove (Rr_map.K Txt) ; 32 | Packet.Update.Add Rr_map.(B (Txt, (3600l, Txt_set.singleton record))) 33 | ] 34 | in 35 | (Domain_name.Map.empty, up) 36 | and header = (id, Packet.Flags.empty) 37 | in 38 | let packet = Packet.create header zone (`Update update) in 39 | match Dns_tsig.encode_and_sign ?proto packet (now ()) key keyname with 40 | | Error s -> Error(`Msg (Fmt.to_to_string Dns_tsig.pp_s s)) 41 | | Ok (data, mac) -> 42 | out data |> function 43 | | Error err -> Error err 44 | | Ok () -> 45 | match recv with 46 | | None -> Ok () 47 | | Some recv -> recv () |> function 48 | | Error e -> Error e 49 | | Ok data -> 50 | match Dns_tsig.decode_and_verify (now ()) key keyname ~mac data with 51 | | Error e -> 52 | Error (`Msg (Fmt.str "decode and verify error %a" Dns_tsig.pp_e e)) 53 | | Ok (res, _, _) -> 54 | match Packet.reply_matches_request ~request:packet res with 55 | | Ok _ -> Ok () 56 | | Error mismatch -> 57 | Error (`Msg (Fmt.str "error %a expected reply to %a, got %a" 58 | Packet.pp_mismatch mismatch 59 | Packet.pp packet Packet.pp res)) 60 | in 61 | dns_solver nsupdate 62 | -------------------------------------------------------------------------------- /vendor/dns/app/ozone.ml: -------------------------------------------------------------------------------- 1 | (* (c) 2019 Hannes Mehnert, all rights reserved *) 2 | 3 | (* goal is to check a given zonefile whether it is valid (and to-be-used 4 | by an authoritative NS - i.e. there must be a SOA record, TTL are good) 5 | if a NS/MX name is within the zone, it needs an address record 6 | the name of the file is taken as the domain name *) 7 | open Dns 8 | 9 | let ( let* ) = Result.bind 10 | 11 | let load_zone zone = 12 | let* data = Bos.OS.File.read Fpath.(v zone) in 13 | let* rrs = Dns_zone.parse data in 14 | let domain = Domain_name.of_string_exn Fpath.(basename (v zone)) in 15 | let bad = Domain_name.Map.filter 16 | (fun name _ -> not (Domain_name.is_subdomain ~domain ~subdomain:name)) 17 | rrs 18 | in 19 | if not (Domain_name.Map.is_empty bad) then 20 | Error (`Msg (Fmt.str "Entries of domain '%a' are not in its zone, won't handle this:@.%a" 21 | Domain_name.pp domain Dns.Name_rr_map.pp bad)) 22 | else 23 | Ok (Dns_trie.insert_map rrs Dns_trie.empty) 24 | 25 | let jump _ zone old = 26 | let* trie = load_zone zone in 27 | let* () = 28 | Result.map_error 29 | (fun e -> `Msg (Fmt.to_to_string Dns_trie.pp_zone_check e)) 30 | (Dns_trie.check trie) 31 | in 32 | Logs.app (fun m -> m "successfully checked zone") ; 33 | let zones = 34 | Dns_trie.fold Soa trie 35 | (fun name _ acc -> Domain_name.Set.add name acc) 36 | Domain_name.Set.empty 37 | in 38 | if Domain_name.Set.cardinal zones = 1 then 39 | let zone = Domain_name.Set.choose zones in 40 | let* zone_data = Dns_server.text zone trie in 41 | Logs.debug (fun m -> m "assembled zone data %s" zone_data) ; 42 | (match old with 43 | | None -> Ok () 44 | | Some fn -> 45 | let* old = load_zone fn in 46 | match Dns_trie.lookup zone Soa trie, Dns_trie.lookup zone Soa old with 47 | | Ok fresh, Ok old when Soa.newer ~old fresh -> 48 | Logs.debug (fun m -> m "zone %a newer than old" Domain_name.pp zone) ; 49 | Ok () 50 | | _ -> 51 | Error (`Msg "SOA comparison wrong")) 52 | else 53 | Error (`Msg "expected exactly one zone") 54 | 55 | open Cmdliner 56 | 57 | let newzone = 58 | let doc = "New zone file" in 59 | Arg.(required & pos 0 (some file) None & info [] ~doc ~docv:"ZONE") 60 | 61 | let oldzone = 62 | let doc = "Old zone file" in 63 | Arg.(value & opt (some file) None & info [ "old" ] ~doc ~docv:"ZONE") 64 | 65 | let cmd = 66 | let term = 67 | Term.(term_result (const jump $ Dns_cli.setup_log $ newzone $ oldzone)) 68 | and info = Cmd.info "ozone" ~version:"%%VERSION_NUM%%" 69 | in 70 | Cmd.v info term 71 | 72 | let () = exit (Cmd.eval cmd) 73 | -------------------------------------------------------------------------------- /vendor/dns/app/dns_cli.ml: -------------------------------------------------------------------------------- 1 | (* (c) 2018 Hannes Mehnert, all rights reserved *) 2 | let setup_log style_renderer level = 3 | Fmt_tty.setup_std_outputs ?style_renderer (); 4 | Logs.set_level level; 5 | Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ()) 6 | 7 | let connect_tcp ip port = 8 | let sa = Unix.ADDR_INET (Ipaddr_unix.to_inet_addr ip, port) in 9 | let fam = match ip with Ipaddr.V4 _ -> Unix.PF_INET | Ipaddr.V6 _ -> Unix.PF_INET6 in 10 | let sock = Unix.(socket fam SOCK_STREAM 0) in 11 | Unix.(setsockopt sock SO_REUSEADDR true) ; 12 | Unix.connect sock sa ; 13 | sock 14 | 15 | (* TODO EINTR, SIGPIPE *) 16 | let send_tcp sock buf = 17 | let size = String.length buf in 18 | let size_buf = 19 | let b = Bytes.create 2 in 20 | Bytes.set_int16_be b 0 size ; 21 | b 22 | in 23 | let data = Bytes.cat size_buf (Bytes.of_string buf) in 24 | let whole = size + 2 in 25 | let rec out off = 26 | if off = whole then () 27 | else 28 | let bytes = Unix.send sock data off (whole - off) [] in 29 | out (bytes + off) 30 | in 31 | out 0 32 | 33 | let recv_tcp sock = 34 | let rec read_exactly buf len off = 35 | if off = len then () 36 | else 37 | let n = Unix.recv sock buf off (len - off) [] in 38 | read_exactly buf len (off + n) 39 | in 40 | let buf = Bytes.create 2 in 41 | read_exactly buf 2 0 ; 42 | let len = Bytes.get_int16_be buf 0 in 43 | let buf' = Bytes.create len in 44 | read_exactly buf' len 0 ; 45 | Bytes.unsafe_to_string buf' 46 | 47 | open Cmdliner 48 | 49 | let setup_log = 50 | Term.(const setup_log 51 | $ Fmt_cli.style_renderer () 52 | $ Logs_cli.level ()) 53 | 54 | let ip_c = Arg.conv (Ipaddr.of_string, Ipaddr.pp) 55 | 56 | let namekey_c = 57 | let parse s = 58 | let ( let* ) = Result.bind in 59 | let* (name, key) = Dns.Dnskey.name_key_of_string s in 60 | let is_op s = 61 | Domain_name.(equal_label s "_update" || equal_label s "_transfer" || equal_label s "_notify") 62 | in 63 | let amount = match Domain_name.find_label ~rev:true name is_op with 64 | | None -> 0 65 | | Some x -> succ x 66 | in 67 | let* zone = Domain_name.drop_label ~amount name in 68 | let* zone = Domain_name.host zone in 69 | Ok (name, zone, key) 70 | in 71 | let pp ppf (name, zone, key) = 72 | Fmt.pf ppf "key name %a zone %a dnskey %a" 73 | Domain_name.pp name Domain_name.pp zone Dns.Dnskey.pp key 74 | in 75 | Arg.conv (parse, pp) 76 | 77 | let name_c = 78 | Arg.conv 79 | ((fun s -> Result.bind (Domain_name.of_string s) Domain_name.host), 80 | Domain_name.pp) 81 | 82 | let domain_name_c = 83 | Arg.conv (Domain_name.of_string, Domain_name.pp) 84 | -------------------------------------------------------------------------------- /vendor/letsencrypt/test/jwk_test.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | open Letsencrypt__Acme_common 4 | 5 | let n64 = 6 | "0vx7agoebGcQSuuPiLJXZptN9nndrQmbXEps2aiAFbWhM78LhWx4cbbfAAtVT86" ^ 7 | "zwu1RK7aPFFxuhDR1L6tSoc_BJECPebWKRXjBZCiFV4n3oknjhMstn64tZ_2W-5" ^ 8 | "JsGY4Hc5n9yBXArwl93lqt7_RN5w6Cf0h4QyQ5v-65YGjQR0_FDW2QvzqY368QQ" ^ 9 | "MicAtaSqzs8KJZgnYb9c7d0zgdAZHzu6qMQvRL5hajrn1n91CbOpbISD08qNLyr" ^ 10 | "dkt-bFTWhAI4vMQFh6WeZu0fM4lFd2NcRwr3XPksINHaQ-G_xBniIqbw0Ls1jF4" ^ 11 | "4-csFCur-kEgU8awapJzKnqDKgw" 12 | let n = match Letsencrypt__B64u.urldecodez n64 with 13 | Error (`Msg e) -> invalid_arg e | Ok n -> n 14 | 15 | let e64 = "AQAB" 16 | let e = match Letsencrypt__B64u.urldecodez e64 with 17 | Error (`Msg e) -> invalid_arg e | Ok e -> e 18 | 19 | let pub_key = match Letsencrypt__Primitives.pub_of_z ~e ~n with 20 | Error (`Msg e) -> invalid_arg e | Ok p -> `RSA p 21 | 22 | let test_encode _ctx = 23 | let got = json_to_string (Jwk.encode pub_key) in 24 | let expected = Printf.sprintf {|{"e":"%s","kty":"RSA","n":"%s"}|} e64 n64 in 25 | assert_equal got expected 26 | 27 | let test_thumbprint _ctx = 28 | let got = Jwk.thumbprint pub_key in 29 | let expected = "NzbLsXh8uDCcd-6MNwXF4W_7noWXFZAfHkxZsRGC9Xs" in 30 | assert_equal got expected 31 | 32 | let decode_example = 33 | let maybe_pub = Printf.sprintf {|{"e":"%s","kty":"RSA","n":"%s"}|} e64 n64 34 | |> Jwk.decode in 35 | match maybe_pub with 36 | | Ok (`RSA pub) -> pub 37 | | Ok _ -> assert false 38 | | Error (`Msg e) -> assert_failure e 39 | 40 | let test_decode _ctx = 41 | let pub = decode_example in 42 | assert_equal (Letsencrypt__Primitives.pub_to_z pub) (e, n) 43 | 44 | let test_decode_badformed _ctx = 45 | let s = "{" in 46 | assert_equal (Jwk.decode s) (Error (`Msg "Line 1, bytes 0-1:\nUnexpected end of input")) 47 | 48 | let test_decode_invalid_n _ctx = 49 | let s = {|{"kty": "RSA", "e": "AQAB"}|} in 50 | assert_equal (Jwk.decode s) (Error (`Msg {|couldn't find string n in {"kty":"RSA","e":"AQAB"}|})) 51 | 52 | let test_decode_invalid_e _ctx = 53 | let s = {|{"kty": "RSA", "e": 1}|} in 54 | assert_equal (Jwk.decode s) (Error (`Msg {|couldn't find string e in {"kty":"RSA","e":1}|})) 55 | 56 | let test_decode_invalid_kty _ctx = 57 | let s = {|{"kty": "invalid"}|} in 58 | assert_equal (Jwk.decode s) (Error (`Msg "unknown key type invalid")) 59 | 60 | let all_tests = [ 61 | "test_encode" >:: test_encode; 62 | "test_thumbprint" >:: test_thumbprint; 63 | "test_decode" >:: test_decode; 64 | "test_decode_badformed" >:: test_decode_badformed; 65 | "test_decode_invalid_kty" >:: test_decode_invalid_kty; 66 | "test_decode_invalid_e" >:: test_decode_invalid_e; 67 | "test_decode_invalid_n" >:: test_decode_invalid_n; 68 | ] 69 | -------------------------------------------------------------------------------- /vendor/dns/mirage/client/dns_client_mirage.mli: -------------------------------------------------------------------------------- 1 | module type S = sig 2 | type happy_eyeballs 3 | 4 | module Transport : 5 | sig 6 | include Dns_client.S 7 | with type +'a io = 'a Lwt.t 8 | and type io_addr = [ 9 | | `Plaintext of Ipaddr.t * int 10 | | `Tls of Tls.Config.client * Ipaddr.t * int 11 | ] 12 | val happy_eyeballs : t -> happy_eyeballs 13 | end 14 | 15 | include module type of Dns_client.Make(Transport) 16 | 17 | val nameserver_of_string : string -> 18 | (Dns.proto * Transport.io_addr, [> `Msg of string ]) result 19 | (** [nameserver_of_string authenticators str] returns a {!Transport.io_addr} 20 | from the given string. The format is: 21 | - [udp:(:port)?] for a plain nameserver and we will communicate 22 | with it {i via} the UDP protocol 23 | - [tcp:(:port)?] for a plain nameserver and we will communicate 24 | with it {i via} the TCP protocol 25 | - [tls:(:port)?((!hostname)?!authenticator)?] for a nameserver and 26 | we will communicate with it {i via} the TCP protocol plus the TLS 27 | encrypted layer. The user can verify the nameserver {i via} an 28 | {i authenticator} (see {!X509.Authenticator.of_string} for the format 29 | of it). The {i hostname} can be provided to be used as peer name by the 30 | authenticator. By default, {!Ca_certs_nss.authenticator} is used. 31 | *) 32 | 33 | val connect : 34 | ?cache_size:int -> 35 | ?edns:[ `None | `Auto | `Manual of Dns.Edns.t ] -> 36 | ?nameservers:string list -> 37 | ?timeout:int64 -> 38 | Transport.stack -> t Lwt.t 39 | (** [connect ?cache_size ?edns ?nameservers ?timeout (stack, happy_eyeballs)] 40 | creates a DNS entity which is able to resolve domain-name. It expects 41 | few optional arguments: 42 | - [cache_size] the size of the LRU cache, 43 | - [edns] the behaviour of whether or not to send edns in queries, 44 | - [nameservers] a list of {i nameservers} used to resolve domain-names, 45 | - [timeout] (in nanoseconds), passed to {create}. 46 | 47 | The provided [happy_eyeballs] will use [t] for resolving hostnames. 48 | 49 | @raise [Invalid_argument] if given strings don't respect formats explained 50 | by {!nameserver_of_string}. 51 | *) 52 | end 53 | 54 | module Make 55 | (R : Mirage_crypto_rng_mirage.S) 56 | (T : Mirage_time.S) 57 | (M : Mirage_clock.MCLOCK) 58 | (P : Mirage_clock.PCLOCK) 59 | (S : Tcpip.Stack.V4V6) 60 | (H : Happy_eyeballs_mirage.S with type stack = S.t 61 | and type flow = S.TCP.flow) 62 | : S with type Transport.stack = S.t * H.t 63 | and type happy_eyeballs = H.t 64 | -------------------------------------------------------------------------------- /eon.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | synopsis: "Effects-based OCaml Nameserver" 3 | description: "Effects-based OCaml Nameserver" 4 | maintainer: ["Ryan Gibb"] 5 | authors: ["Ryan Gibb"] 6 | license: "MIT" 7 | homepage: "https://github.com/RyanGibb/eon" 8 | doc: "https://url/to/documentation" 9 | bug-reports: "https://github.com/RyanGibb/eon/issues" 10 | depends: [ 11 | "ocaml" {>= "5.0.0"} 12 | "dune" {>= "3.4"} 13 | "eio_main" {>= "0.12"} 14 | "dns" 15 | "dns-server" {>= "6.2.2"} 16 | "dns-resolver" 17 | "dns-tsig" 18 | "cmdliner" 19 | "fmt" 20 | # tun 21 | "tuntap" 22 | # acme 23 | "letsencrypt" {= "dev"} 24 | "cohttp-eio" {= "dev"} 25 | "mirage-crypto-rng-eio" 26 | # cap 27 | "capnp-rpc-unix" {>= "2.0"} 28 | # hibernia 29 | "wol" {= "dev"} 30 | "wol-eio" {= "dev"} 31 | ] 32 | build: [ 33 | [ 34 | "dune" 35 | "build" 36 | "-p" 37 | name 38 | "-j" 39 | jobs 40 | "@install" 41 | "@runtest" {with-test} 42 | "@doc" {with-doc} 43 | ] 44 | ] 45 | dev-repo: "git+https://github.com/RyanGibb/eon.git" 46 | pin-depends: [ 47 | ["dns-certify.dev" "vendor/dns"] 48 | ["dns-client-lwt.dev" "vendor/dns"] 49 | ["dns-client-mirage.dev" "vendor/dns"] 50 | ["dns-client.dev" "vendor/dns"] 51 | ["dns-cli.dev" "vendor/dns"] 52 | ["dns-mirage.dev" "vendor/dns"] 53 | ["dns.dev" "vendor/dns"] 54 | ["dns-resolver.dev" "vendor/dns"] 55 | ["dnssec.dev" "vendor/dns"] 56 | ["dns-server.dev" "vendor/dns"] 57 | ["dns-stub.dev" "vendor/dns"] 58 | ["dns-tsig.dev" "vendor/dns"] 59 | # Eio port 60 | ["letsencrypt.dev" "vendor/letsencrypt"] 61 | ["letsencrypt-app.dev" "vendor/letsencrypt"] 62 | # unreleased Eio 12.0 port 63 | ["http.dev" "git+https://github.com/mirage/ocaml-cohttp#e5a66f1c1e7c2e5051723e09260222994dff40cf"] 64 | ["cohttp.dev" "git+https://github.com/mirage/ocaml-cohttp#e5a66f1c1e7c2e5051723e09260222994dff40cf"] 65 | ["cohttp-eio.dev" "git+https://github.com/mirage/ocaml-cohttp#e5a66f1c1e7c2e5051723e09260222994dff40cf"] 66 | ["cohttp-lwt.dev" "git+https://github.com/mirage/ocaml-cohttp#e5a66f1c1e7c2e5051723e09260222994dff40cf"] 67 | ["cohttp-lwt-unix.dev" "git+https://github.com/mirage/ocaml-cohttp#e5a66f1c1e7c2e5051723e09260222994dff40cf"] 68 | # Eio port https://github.com/mirage/capnp-rpc/ 69 | ["capnp-rpc.dev" "git+https://github.com/mirage/capnp-rpc#252fd9b064367270a48d6bc73cbcd8f188f353d9"] 70 | ["capnp-rpc-net.dev" "git+https://github.com/mirage/capnp-rpc#252fd9b064367270a48d6bc73cbcd8f188f353d9"] 71 | ["capnp-rpc-unix.dev" "git+https://github.com/mirage/capnp-rpc#252fd9b064367270a48d6bc73cbcd8f188f353d9"] 72 | ["wol.dev" "git+https://github.com/RyanGibb/ocaml-wake-on-lan#dd5f5e5d29900d7a2e0b884d3105037d2bb00df3"] 73 | ["wol-eio.dev" "git+https://github.com/RyanGibb/ocaml-wake-on-lan#dd5f5e5d29900d7a2e0b884d3105037d2bb00df3"] 74 | ] 75 | -------------------------------------------------------------------------------- /lib/cap/secondary.ml: -------------------------------------------------------------------------------- 1 | open Raw 2 | open Capnp_rpc 3 | 4 | let local sr env domain server_state = 5 | let module Secondary = Api.Service.Secondary in 6 | Persistence.with_sturdy_ref sr Secondary.local 7 | @@ object 8 | inherit Secondary.service 9 | 10 | method get_name_impl _params release_param_caps = 11 | let open Secondary.GetName in 12 | release_param_caps (); 13 | let response, results = Service.Response.create Results.init_pointer in 14 | Results.name_set results (Domain_name.to_string domain); 15 | Service.return response 16 | 17 | method update_impl params release_param_caps = 18 | let open Secondary.Update in 19 | let prereqs = Params.prereqs_get params in 20 | let updates = Params.updates_get params in 21 | release_param_caps (); 22 | let response, results = Service.Response.create Results.init_pointer in 23 | let prereqs = Update.decode_prereqs domain prereqs in 24 | let updates = Update.decode_updates domain updates in 25 | (match Update.update_trie env server_state domain prereqs updates with 26 | | exception Invalid_argument msg -> 27 | Results.success_set results false; 28 | Results.error_set results msg 29 | | exception e -> 30 | let msg = Printexc.to_string e in 31 | Results.success_set results false; 32 | Results.error_set results msg 33 | | _ -> Results.success_set results true); 34 | Service.return response 35 | end 36 | 37 | let get_name t = 38 | let open Api.Client.Secondary.GetName in 39 | let request = Capability.Request.create_no_args () in 40 | match Capability.call_for_value t method_id request with 41 | | Ok results -> Ok (Results.name_get results) 42 | | Error e -> Error e 43 | 44 | let update t prereqs updates = 45 | let open Api.Client.Secondary.Update in 46 | let request, params = Capability.Request.create Params.init_pointer in 47 | let prereqs = 48 | Domain_name.Map.fold 49 | (fun name name_prereq acc -> 50 | List.fold_left (fun acc prereq -> (name, prereq) :: acc) acc name_prereq) 51 | prereqs [] 52 | in 53 | ignore @@ Params.prereqs_set_list params (Update.encode_prereqs prereqs); 54 | let updates = 55 | Domain_name.Map.fold 56 | (fun name name_update acc -> 57 | List.fold_left (fun acc update -> (name, update) :: acc) acc name_update) 58 | updates [] 59 | in 60 | ignore @@ Params.updates_set_list params (Update.encode_updates updates); 61 | let ( let* ) = Result.bind in 62 | let* results = Capability.call_for_value t method_id request in 63 | match Results.success_get results with 64 | | true -> Ok () 65 | | false -> 66 | let error = Results.error_get results in 67 | Error (`Remote error) 68 | -------------------------------------------------------------------------------- /lib/cap/db.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | open Capnp_rpc 3 | open Capnp_rpc_net 4 | module File_store = Capnp_rpc_unix.File_store 5 | module Store = Store.Make (Capnp.BytesMessage) 6 | 7 | type t = { 8 | store : Store.Reader.SavedService.struct_t File_store.t; 9 | domain_loader : 10 | ([ `Domain_debb01f25d5fee15 ] Sturdy_ref.t -> 11 | name:[ `raw ] Domain_name.t -> 12 | primary:string -> 13 | Restorer.resolution) 14 | Promise.t; 15 | secondary_loader : 16 | ([ `Secondary_88493aa33efcf56f ] Sturdy_ref.t -> 17 | name:[ `raw ] Domain_name.t -> 18 | Restorer.resolution) 19 | Promise.t; 20 | make_sturdy : Restorer.Id.t -> Uri.t; 21 | } 22 | 23 | let hash _ = `SHA256 24 | let make_sturdy t = t.make_sturdy 25 | 26 | let save_new_domain t ~name primary = 27 | let id = Restorer.Id.generate () in 28 | let digest = Restorer.Id.digest (hash t) id in 29 | let open Store.Builder in 30 | let service = SavedService.init_root () in 31 | let domain = SavedService.domain_init service in 32 | SavedDomain.name_set domain (Domain_name.to_string name); 33 | SavedDomain.primary_set domain (Result.get_ok @@ Primary.get_name primary); 34 | File_store.save t.store ~digest @@ SavedService.to_reader service; 35 | id 36 | 37 | let save_new_secondary t ~name = 38 | let id = Restorer.Id.generate () in 39 | let digest = Restorer.Id.digest (hash t) id in 40 | let open Store.Builder in 41 | let service = SavedService.init_root () in 42 | let secondary = SavedService.secondary_init service in 43 | SavedSecondary.name_set secondary name; 44 | File_store.save t.store ~digest @@ SavedService.to_reader service; 45 | id 46 | 47 | let load t sr digest = 48 | match File_store.load t.store ~digest with 49 | | None -> Restorer.unknown_service_id 50 | | Some saved_service -> ( 51 | let open Store.Reader in 52 | match SavedService.get saved_service with 53 | | SavedService.Domain domain -> 54 | let name = Domain_name.of_string_exn (SavedDomain.name_get domain) in 55 | let primary = SavedDomain.primary_get domain in 56 | let sr = Capnp_rpc.Sturdy_ref.cast sr in 57 | let loader = Promise.await t.domain_loader in 58 | loader sr ~name ~primary 59 | | SavedService.Secondary secondary -> 60 | let name = 61 | Domain_name.of_string_exn (SavedSecondary.name_get secondary) 62 | in 63 | let sr = Capnp_rpc.Sturdy_ref.cast sr in 64 | let loader = Promise.await t.secondary_loader in 65 | loader sr ~name 66 | | SavedService.Undefined _ -> Restorer.unknown_service_id) 67 | 68 | let create ~make_sturdy dir = 69 | let domain_loader, set_domain_loader = Promise.create () in 70 | let secondary_loader, set_secondary_loader = Promise.create () in 71 | if not (Eio.Path.is_directory dir) then Eio.Path.mkdir dir ~perm:0o755; 72 | let store = File_store.create dir in 73 | ( { store; domain_loader; secondary_loader; make_sturdy }, 74 | set_domain_loader, 75 | set_secondary_loader ) 76 | -------------------------------------------------------------------------------- /bin/hibernia/hibernia.ml: -------------------------------------------------------------------------------- 1 | let packet_callback ~net wake (question : Dns.Packet.Question.t) : 2 | Dns.Packet.reply option = 3 | let qname, _qtype = question in 4 | let ( let* ) = Option.bind in 5 | let* _, mac, address = 6 | List.find_opt (fun (name, _, _) -> Domain_name.equal name qname) wake 7 | in 8 | Format.fprintf Format.std_formatter "Resolution on %a wakes %a/%a\n" 9 | Domain_name.pp qname Macaddr.pp mac Ipaddr.V4.pp address; 10 | Format.print_flush (); 11 | Wol_eio.send ~net ~address ~broadcast:false mac; 12 | None 13 | 14 | let run zonefiles log_level address_strings port proto wake = 15 | Eio_main.run @@ fun env -> 16 | let addresses = Server_args.parse_addresses port address_strings in 17 | let log = Dns_log.get log_level Format.std_formatter in 18 | let rng ?_g length = 19 | let buf = Cstruct.create length in 20 | Eio.Flow.read_exact env#secure_random buf; 21 | Cstruct.to_string buf 22 | in 23 | let server_state = 24 | let trie, keys, _ = Zonefile.parse_zonefiles ~fs:env#fs zonefiles in 25 | Dns_server.Primary.create ~keys ~rng ~tsig_verify:Dns_tsig.verify 26 | ~tsig_sign:Dns_tsig.sign trie 27 | in 28 | let packet_callback = packet_callback ~net:env#net wake in 29 | Dns_server_eio.primary env proto (ref server_state) log addresses 30 | ~packet_callback 31 | 32 | let () = 33 | let open Cmdliner in 34 | let open Server_args in 35 | let wake = 36 | let name_mac_of_string str = 37 | try 38 | match String.split_on_char '/' str with 39 | | [ name; mac; addr ] -> 40 | (* TODO better error handling *) 41 | Ok 42 | ( Domain_name.of_string_exn name, 43 | Macaddr.of_string_exn mac, 44 | Ipaddr.V4.of_string_exn addr ) 45 | | _ -> 46 | Error 47 | (`Msg 48 | "Invalid domain name and MAC address pair, should be of form \ 49 | DOMAIN_NAME/MAC_ADDR/IP_ADDR.") 50 | with 51 | | Invalid_argument e -> 52 | Error (`Msg (Printf.sprintf "Error parsing domain name: %s" e)) 53 | | Macaddr.Parse_error (e, _s) -> 54 | Error (`Msg (Printf.sprintf "Error parsing MAC address: %s" e)) 55 | in 56 | let name_mac_to_string fmt (name, mac, addr) = 57 | Format.fprintf fmt "%s/%s/%s" 58 | (Domain_name.to_string name) 59 | (Macaddr.to_string mac) (Ipaddr.V4.to_string addr) 60 | in 61 | let doc = 62 | "Specify a MAC address to wake on a resolution of a domain name via \ 63 | Wake-on-LAN. Format should be of the form DOMAIN_NAME/MAC_ADDR." 64 | in 65 | Arg.( 66 | value 67 | & opt_all (Cmdliner.Arg.conv (name_mac_of_string, name_mac_to_string)) [] 68 | & info [ "w"; "wake" ] ~docv:"WAKE" ~doc) 69 | in 70 | let cmd = 71 | let term = 72 | Term.( 73 | const run $ zonefiles $ log_level Dns_log.Level0 $ addresses $ port 74 | $ proto $ wake) 75 | in 76 | let info = Cmd.info "hibernia" ~man in 77 | Cmd.v info term 78 | in 79 | exit (Cmd.eval cmd) 80 | -------------------------------------------------------------------------------- /vendor/dns/mirage/dns_mirage.ml: -------------------------------------------------------------------------------- 1 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | open Lwt.Infix 4 | 5 | let src = Logs.Src.create "dns_mirage" ~doc:"effectful DNS layer" 6 | module Log = (val Logs.src_log src : Logs.LOG) 7 | 8 | module Make (S : Tcpip.Stack.V4V6) = struct 9 | 10 | module IPM = struct 11 | include Map.Make(struct 12 | type t = Ipaddr.t * int 13 | let compare (ip, p) (ip', p') = match Ipaddr.compare ip ip' with 14 | | 0 -> compare p p' 15 | | x -> x 16 | end) 17 | let find k t = try Some (find k t) with Not_found -> None 18 | end 19 | 20 | module U = S.UDP 21 | module T = S.TCP 22 | 23 | type f = { 24 | flow : T.flow ; 25 | mutable linger : Cstruct.t ; 26 | } 27 | 28 | let of_flow flow = { flow ; linger = Cstruct.empty } 29 | 30 | let flow { flow ; _ } = flow 31 | 32 | let rec read_exactly f length = 33 | let dst_ip, dst_port = T.dst f.flow in 34 | if Cstruct.length f.linger >= length then 35 | let a, b = Cstruct.split f.linger length in 36 | f.linger <- b ; 37 | Lwt.return (Ok a) 38 | else 39 | T.read f.flow >>= function 40 | | Ok `Eof -> 41 | Log.debug (fun m -> m "end of file on flow %a:%d" Ipaddr.pp dst_ip dst_port) ; 42 | T.close f.flow >>= fun () -> 43 | Lwt.return (Error ()) 44 | | Error e -> 45 | Log.err (fun m -> m "error %a reading flow %a:%d" T.pp_error e Ipaddr.pp dst_ip dst_port) ; 46 | T.close f.flow >>= fun () -> 47 | Lwt.return (Error ()) 48 | | Ok (`Data b) -> 49 | f.linger <- Cstruct.append f.linger b ; 50 | read_exactly f length 51 | 52 | let send_udp stack src_port dst dst_port data = 53 | Log.debug (fun m -> m "udp: sending %d bytes from %d to %a:%d" 54 | (Cstruct.length data) src_port Ipaddr.pp dst dst_port) ; 55 | U.write ~src_port ~dst ~dst_port (S.udp stack) data >|= function 56 | | Error e -> Log.warn (fun m -> m "udp: failure %a while sending from %d to %a:%d" 57 | U.pp_error e src_port Ipaddr.pp dst dst_port) 58 | | Ok () -> () 59 | 60 | let send_tcp flow answer = 61 | let dst_ip, dst_port = T.dst flow in 62 | Log.debug (fun m -> m "tcp: sending %d bytes to %a:%d" (Cstruct.length answer) Ipaddr.pp dst_ip dst_port) ; 63 | let len = Cstruct.create 2 in 64 | Cstruct.BE.set_uint16 len 0 (Cstruct.length answer) ; 65 | T.write flow (Cstruct.append len answer) >>= function 66 | | Ok () -> Lwt.return (Ok ()) 67 | | Error e -> 68 | Log.err (fun m -> m "tcp: error %a while writing to %a:%d" T.pp_write_error e Ipaddr.pp dst_ip dst_port) ; 69 | T.close flow >|= fun () -> 70 | Error () 71 | 72 | let send_tcp_multiple flow datas = 73 | Lwt_list.fold_left_s (fun acc d -> 74 | match acc with 75 | | Error () -> Lwt.return (Error ()) 76 | | Ok () -> send_tcp flow d) 77 | (Ok ()) datas 78 | 79 | let read_tcp flow = 80 | read_exactly flow 2 >>= function 81 | | Error () -> Lwt.return (Error ()) 82 | | Ok l -> 83 | let len = Cstruct.BE.get_uint16 l 0 in 84 | read_exactly flow len 85 | end 86 | -------------------------------------------------------------------------------- /vendor/dns/test/tsig.ml: -------------------------------------------------------------------------------- 1 | (* (c) 2017 Hannes Mehnert, all rights reserved *) 2 | 3 | let cs = 4 | let module M = struct 5 | type t = string 6 | let pp = Ohex.pp 7 | let equal = String.equal 8 | end in 9 | (module M: Alcotest.TESTABLE with type t = M.t) 10 | 11 | let msg = 12 | let module M = struct 13 | type t = [ `Msg of string ] 14 | let pp ppf = function `Msg str -> Fmt.string ppf str 15 | let equal _ _ = true 16 | end in 17 | (module M: Alcotest.TESTABLE with type t = M.t) 18 | 19 | let key = 20 | match Base64.decode "GSnQJ+fHuzwj5yKzCOkXdISyGQXBUxMrjEjL4Kr1WIs=" with 21 | | Error _ -> assert false 22 | | Ok x -> x 23 | 24 | let key_name = Domain_name.of_string_exn "mykey.bla.example" 25 | 26 | let of_h = Ohex.decode 27 | 28 | let tsig ?(fudge = 300) algorithm signed = 29 | let fudge = Ptime.Span.of_int_s fudge in 30 | let signed = 31 | match Ptime.of_float_s signed with 32 | | None -> assert false 33 | | Some x -> x 34 | in 35 | match Dns.Tsig.tsig ~algorithm ~signed ~fudge () with 36 | | None -> assert false 37 | | Some x -> x 38 | 39 | let example0 () = 40 | let buf = of_h {__|62 d7 28 00 00 01 00 00 00 02 00 00 07 65 78 61 41 | 6d 70 6c 65 03 63 6f 6d 00 00 06 00 01 03 66 6f 42 | 6f c0 0c 00 ff 00 ff 00 00 00 00 00 00 03 62 61 43 | 72 c0 0c 00 01 00 01 00 00 01 2c 00 04 01 02 03 44 | 04|__} 45 | and now = 1506887417. 46 | and mac = of_h {__|bf 5d 77 ba 97 ba 7b 95 9e 1b 0d 95 64 a7 5b a6 47 | 95 bf 24 15 3b 9d a2 1b bf 6f ae 61 9d 0f 28 a1|__} 48 | in 49 | Alcotest.(check cs "tsig is the same" mac 50 | (Dns_tsig.compute_tsig key_name (tsig Dns.Tsig.SHA256 now) ~key buf)) 51 | 52 | let example1 () = 53 | let buf = of_h {__|4c 56 28 00 00 01 00 00 00 01 00 00 07 45 78 41 54 | 6d 50 6c 45 03 63 6f 6d 00 00 06 00 01 03 66 6f 55 | 6f 07 65 78 61 6d 70 6c 65 c0 14 00 ff 00 ff 00 56 | 00 00 00 00 00|__} 57 | and now = 1506887742. 58 | and mac = of_h {__|70 67 ae 70 9e fd 22 9e ce d9 65 25 8a db 8c 96 59 | 10 95 80 89 a7 ee 4f bb 13 81 e7 38 e3 a0 78 80|__} 60 | in 61 | Alcotest.(check cs "tsig is the same" mac 62 | (Dns_tsig.compute_tsig key_name (tsig Dns.Tsig.SHA256 now) ~key buf)) 63 | 64 | let example2 () = 65 | let buf = of_h {__|76 8a 28 00 00 01 00 00 00 01 00 00 07 65 78 61 66 | 6d 70 6c 65 00 00 06 00 01 03 66 6f 6f c0 0c 00 67 | ff 00 ff 00 00 00 00 00 00|__} 68 | and now = 1506888104. 69 | and mac = of_h {__|e7 76 e6 df 4e 73 14 c8 eb ba 4c c7 a5 39 b3 93 70 | a7 df 6d de 47 b6 fa cc 81 c8 47 29 20 77 40 44|__} 71 | in 72 | Alcotest.(check cs "tsig is the same" mac 73 | (Dns_tsig.compute_tsig key_name (tsig Dns.Tsig.SHA256 now) ~key buf)) 74 | 75 | 76 | let tsig_tests = [ 77 | "example0", `Quick, example0 ; 78 | "example1", `Quick, example1 ; 79 | "example2", `Quick, example2 ; 80 | ] 81 | 82 | 83 | let tests = [ 84 | "Tsig example", tsig_tests ; 85 | ] 86 | 87 | let () = Alcotest.run "DNS name tests" tests 88 | -------------------------------------------------------------------------------- /vendor/letsencrypt/mirage/lE_http_server.mli: -------------------------------------------------------------------------------- 1 | (** A simple ALPN server which already resolve Let's encrypt certificates. 2 | 3 | This module is to help the user to launch an ALPN server (and be able to 4 | handle [http/1.1] and [h2] requests) through a TLS certificate provided by 5 | Let's encrypt. The challenge is done {i via} HTTP (unlike the ALPN challenge 6 | offered by Let's encrypt). The [.well-known/*] path is therefore used and 7 | the user {b should not} define such a route. *) 8 | 9 | module Make 10 | (Time : Mirage_time.S) 11 | (Stack : Tcpip.Stack.V4V6) 12 | (Random : Mirage_crypto_rng_mirage.S) 13 | (Mclock : Mirage_clock.MCLOCK) 14 | (Pclock : Mirage_clock.PCLOCK) : sig 15 | val get_certificates : 16 | yes_my_port_80_is_reachable_and_unused:Stack.t -> 17 | production:bool -> 18 | LE.configuration -> 19 | Http_mirage_client.t -> 20 | (Tls.Config.own_cert, [> `Msg of string ]) result Lwt.t 21 | (** [get_certificates ~yes_my_port_80_is_reachable_and_unused ~production cfg client] 22 | tries to resolve the Let's encrypt challenge by initiating an HTTP server 23 | on port 80 and handling requests from it with [ocaml-letsencrypt]. 24 | 25 | This resolution requires that your domain name (requested in the given 26 | [cfg.hostname]) redirects Let's encrypt to this HTTP server. You probably 27 | need to check your DNS configuration. 28 | 29 | The [client] value can be made by {!val:Http_mirage_client.Make.connect} 30 | to be able to launch HTTP requests to Let's encrypt. *) 31 | 32 | module Paf : module type of Paf_mirage.Make (Stack.TCP) 33 | 34 | val with_lets_encrypt_certificates : 35 | ?port:int -> 36 | ?alpn_protocols:string list -> 37 | Stack.t -> 38 | production:bool -> 39 | LE.configuration -> 40 | Http_mirage_client.t -> 41 | (Paf.TLS.flow, Ipaddr.t * int) Alpn.server_handler -> 42 | (unit, [> `Msg of string ]) result Lwt.t 43 | (** [with_lets_encrypt_certificates ?port ?alpn_protocols stackv4v6 ~production cfg client handler] 44 | launches 2 servers: 45 | - An HTTP/1.1 server which handles let's encrypt challenges and 46 | redirections 47 | - An ALPN server (which handles HTTP/1.1 and H2 by default, otherwise you 48 | can specify protocols via the [alpn_protocol] argument) which run the 49 | user's request handler 50 | 51 | The [client] value can be made by {!val:Http_mirage_client.Make.connect} 52 | to be able to launch HTTP requests to Let's encrypt. 53 | 54 | Every 80 days, the fiber re-askes a new certificate from let's encrypt and 55 | re-update the ALPN server with this new certificate. The HTTP/1.1 server 56 | does the redirection to the hostname defined into the given [cfg]. 57 | 58 | {b NOTE}: For the [alpn_protocols] argument, only ["h2"], ["http/1.1"] and 59 | ["http/1.0"] are handled. Any others protocols will be {b ignored}! The 60 | order of protocols matters. If ["h2"] is the first one and the client 61 | handles the ["h2"] protocol, server and client agree to use this protocol 62 | (even if both handle ["http/1.1"]). 63 | 64 | The default value of [alpn_protocols] prioritises ["http/1.1"] as the 65 | protocol which should be picked by the client. *) 66 | end 67 | -------------------------------------------------------------------------------- /bin/transport/tunnel/tund.ml: -------------------------------------------------------------------------------- 1 | let run zonefiles log_level address_strings subdomain authorative port proto 2 | netmask tunnel_ip = 3 | Eio_main.run @@ fun env -> 4 | Eio.Switch.run @@ fun sw -> 5 | let log = Dns_log.get log_level Format.std_formatter in 6 | let addresses = Server_args.parse_addresses port address_strings in 7 | let rng ?_g length = 8 | let buf = Cstruct.create length in 9 | Eio.Flow.read_exact env#secure_random buf; 10 | Cstruct.to_string buf 11 | in 12 | let server_state = 13 | let trie, keys, _ = Zonefile.parse_zonefiles ~fs:env#fs zonefiles in 14 | ref 15 | @@ Dns_server.Primary.create ~keys ~rng ~tsig_verify:Dns_tsig.verify 16 | ~tsig_sign:Dns_tsig.sign trie 17 | in 18 | let authorative = Domain_name.to_string authorative in 19 | let server = 20 | Transport.Datagram_server.run ~sw env proto ~subdomain ~authorative 21 | server_state log addresses 22 | in 23 | let tun_fd, tun_name = Tuntap.opentun ~devname:"tun-dnsd" () in 24 | let tun = Eio_unix.Net.import_socket_stream ~sw ~close_unix:false tun_fd in 25 | Tuntap.set_ipv4 tun_name 26 | ~netmask:(Ipaddr.V4.Prefix.of_string_exn netmask) 27 | (Ipaddr.V4.of_string_exn tunnel_ip); 28 | Eio.Fiber.both 29 | (fun () -> 30 | let buf = Cstruct.create (Tuntap.get_mtu tun_name) in 31 | while true do 32 | let got = server.recv buf in 33 | Eio.Flow.write tun [ Cstruct.sub buf 0 got ] 34 | done) 35 | (fun () -> 36 | let buf = Cstruct.create (Tuntap.get_mtu tun_name) in 37 | while true do 38 | let got = Eio.Flow.single_read tun buf in 39 | server.send (Cstruct.sub buf 0 got) 40 | done) 41 | 42 | let () = 43 | let open Cmdliner in 44 | let open Server_args in 45 | let cmd = 46 | let subdomain = 47 | let doc = 48 | "Sudomain to use custom processing on. This will be combined with the \ 49 | root DOMAIN to form ., e.g. rpc.example.org. Data \ 50 | will be encoded as a base 64 string as a sudomain of this domain \ 51 | giving .., e.g. aGVsbG8K.rpc.example.org." 52 | in 53 | Arg.( 54 | value & opt string "rpc" 55 | & info [ "sd"; "subdomain" ] ~docv:"SUBDOMAIN" ~doc) 56 | in 57 | let authorative = 58 | let doc = 59 | "Domain for which the server is authorative and that we will use to \ 60 | tunnel data at the SUBDOMAIN." 61 | in 62 | Arg.( 63 | required 64 | & opt (some (conv (Domain_name.of_string, Domain_name.pp))) None 65 | & info [ "a"; "authorative" ] ~docv:"AUTHORATIVE" ~doc) 66 | in 67 | let netmask = 68 | Arg.( 69 | value & opt string "10.0.0.0/24" 70 | & info [ "m"; "netmask" ] ~docv:"NETMASK") 71 | in 72 | let tunnel_ip = 73 | Arg.( 74 | value & opt string "10.0.0.1" 75 | & info [ "i"; "tunnel_ip" ] ~docv:"TUNNEL_IP") 76 | in 77 | let term = 78 | Term.( 79 | const run $ zonefiles $ log_level Dns_log.Level1 $ addresses $ subdomain 80 | $ authorative $ port $ proto $ netmask $ tunnel_ip) 81 | in 82 | let doc = "An authorative nameserver using OCaml 5 effects-based IO" in 83 | let info = Cmd.info "tund" ~man ~doc in 84 | Cmd.v info term 85 | in 86 | exit (Cmdliner.Cmd.eval cmd) 87 | -------------------------------------------------------------------------------- /bin/transport/dodo/dodo_resolver.ml: -------------------------------------------------------------------------------- 1 | let run log_level address_strings port connectPort proto domain subdomain 2 | nameserver timeout = 3 | Eio_main.run @@ fun env -> 4 | Eio.Switch.run @@ fun sw -> 5 | let log = Dns_log.get log_level Format.std_formatter in 6 | let addresses = Server_args.parse_addresses port address_strings in 7 | 8 | let client = 9 | (* todo use open resolver... *) 10 | Transport.Datagram_client.run ~sw env ~nameserver ~subdomain 11 | ~authorative:domain connectPort log timeout 12 | in 13 | 14 | let handle_dns _proto (addr : Eio.Net.Sockaddr.t) buf = 15 | client.send (Cstruct.of_string buf); 16 | (* todo out of order delivery? *) 17 | (* https://github.com/mirage/ocaml-dns/issues/345 *) 18 | let addr, recv = 19 | let buf = Cstruct.create 4096 in 20 | let got = client.recv buf in 21 | let trimmedBuf = Cstruct.sub buf 0 got in 22 | (addr, Cstruct.to_string trimmedBuf) 23 | in 24 | [ recv ] 25 | in 26 | Dns_server_eio.with_handler env proto handle_dns 27 | (Dns_log.get Dns_log.Level1 Format.std_formatter) 28 | addresses 29 | 30 | let () = 31 | let open Cmdliner in 32 | let open Server_args in 33 | let cmd = 34 | let subdomain = 35 | let doc = 36 | "Sudomain to use custom processing on. This will be combined with the \ 37 | root DOMAIN to form ., e.g. rpc.example.org. Data \ 38 | will be encoded as a base 64 string as a sudomain of this domain \ 39 | giving .., e.g. aGVsbG8K.rpc.example.org." 40 | in 41 | Arg.( 42 | value & opt string "rpc" 43 | & info [ "sd"; "subdomain" ] ~docv:"SUBDOMAIN" ~doc) 44 | in 45 | let domain = 46 | let doc = "Domain that the NAMESERVER is authorative for." in 47 | Arg.( 48 | value & opt string "example.org" 49 | & info [ "d"; "domain" ] ~docv:"DOMAIN" ~doc) 50 | in 51 | let nameserver = 52 | let doc = 53 | "The address of the nameserver to query. The first result returned by \ 54 | getaddrinfo will be used. If this may return multiple values, e.g. an \ 55 | IPv4 and IPv6 address for a host, and a specific one is desired it \ 56 | should be specified." 57 | in 58 | Arg.( 59 | value & opt string "127.0.0.1" 60 | & info [ "n"; "nameserver" ] ~docv:"NAMESERVER" ~doc) 61 | in 62 | let connectPort = 63 | let doc = 64 | "The port to connect to the nameserver with. By default 53 is used. \ 65 | See the BINDING section." 66 | in 67 | Arg.( 68 | value & opt int 53 69 | & info [ ""; "connect-port" ] ~docv:"CONNECT_PORT" ~doc) 70 | in 71 | let timeout = 72 | let doc = "Seconds to wait in between sending DNS queries." in 73 | Arg.(value & opt float 1. & info [ "t"; "timeout" ] ~docv:"TIMEOUT" ~doc) 74 | in 75 | let term = 76 | Term.( 77 | const run $ log_level Dns_log.Level0 $ addresses $ port $ connectPort 78 | $ proto $ domain $ subdomain $ nameserver $ timeout) 79 | in 80 | let doc = "DNS over DNS Obliviously (DoDO) Resolver" in 81 | let info = Cmd.info "dodo_resolver" ~man ~doc in 82 | Cmd.v info term 83 | in 84 | (* this is not domain safe *) 85 | (* Logs.set_reporter (Logs_fmt.reporter ()); 86 | Logs.set_level (Some Logs.Error); *) 87 | exit (Cmdliner.Cmd.eval cmd) 88 | -------------------------------------------------------------------------------- /vendor/dns/test/resolvconf.ml: -------------------------------------------------------------------------------- 1 | 2 | let ok = 3 | let module M = struct 4 | type t = [ `Nameserver of Ipaddr.t ] list 5 | let pp = 6 | let pp_one ppf = function 7 | | `Nameserver ip -> Fmt.pf ppf "nameserver %a" Ipaddr.pp ip 8 | in 9 | Fmt.(list ~sep:(any "\n") pp_one) 10 | let equal a b = compare a b = 0 (* TODO polymorphic equality *) 11 | end in 12 | (module M: Alcotest.TESTABLE with type t = M.t) 13 | 14 | let err = 15 | let module M = struct 16 | type t = [ `Msg of string ] 17 | let pp ppf = function 18 | | `Msg m -> Fmt.string ppf m 19 | let equal _ _ = true 20 | end in 21 | (module M: Alcotest.TESTABLE with type t = M.t) 22 | 23 | let test_one test_name (data, expected) () = 24 | Alcotest.(check (result ok err) 25 | ("resolvconf " ^ test_name) expected (Dns_resolvconf.parse data)) 26 | 27 | let v4_ns = [ "8.8.8.8" ; "8.8.4.4" ] 28 | 29 | and v6_ns = [ "2001:4860:4860::8888" ; "2001:4860:4860::8844" ] 30 | 31 | let ok_result ns = 32 | Ok (List.map (fun s -> `Nameserver (Ipaddr.of_string_exn s)) ns) 33 | 34 | let linux = 35 | {| 36 | # Not all of these are supported by TRust-DNS 37 | # They are testing that they don't break parsing 38 | options ndots:8 timeout:8 attempts:8 39 | 40 | domain example.com 41 | search example.com sub.example.com 42 | 43 | nameserver 2001:4860:4860::8888 44 | nameserver 2001:4860:4860::8844 45 | nameserver 8.8.8.8 46 | nameserver 8.8.4.4 47 | 48 | # some options not supported by TRust-DNS 49 | options rotate 50 | options inet6 no-tld-query 51 | 52 | # A basic option not supported 53 | sortlist 130.155.160.0/255.255.240.0 130.155.0.0 54 | |} 55 | 56 | let macos = 57 | {| 58 | # 59 | # Mac OS X Notice 60 | # 61 | # This file is not used by the host name and address resolution 62 | # or the DNS query routing mechanisms used by most processes on 63 | # this Mac OS X system. 64 | # 65 | # This file is automatically generated. 66 | # 67 | options ndots:8 timeout:8 attempts:8 68 | domain example.com. 69 | search example.com. sub.example.com. 70 | nameserver 2001:4860:4860::8888 71 | nameserver 2001:4860:4860::8844 72 | nameserver 8.8.8.8 73 | nameserver 8.8.4.4 74 | |} 75 | 76 | let openbsd = 77 | {| 78 | # Generated by em0 dhclient 79 | nameserver 8.8.8.8 80 | nameserver 8.8.4.4 81 | lookup file bind 82 | |} 83 | 84 | let simple = 85 | {| 86 | nameserver 8.8.8.8 87 | nameserver 8.8.4.4 88 | |} 89 | 90 | let nixos = 91 | {| 92 | nameserver fe80::c2d7:aaff:fe96:8d82%wlp3s0 93 | |} 94 | 95 | let nixos2 = 96 | {| 97 | nameserver 8.8.8.8 98 | nameserver 8.8.4.4 99 | nameserver fe80::c2d7:aaff:fe96:8d82%wlp3s0 100 | nameserver 8.8.8.8 101 | nameserver 8.8.4.4 102 | |} 103 | 104 | let local_ns = [ "fe80::c2d7:aaff:fe96:8d82" ] 105 | 106 | let tests = [ 107 | "linux", `Quick, test_one "linux" (linux, ok_result (v6_ns @ v4_ns)) ; 108 | "macos", `Quick, test_one "macos" (macos, ok_result (v6_ns @ v4_ns)) ; 109 | "openbsd", `Quick, test_one "openbsd" (openbsd, ok_result v4_ns) ; 110 | "simple", `Quick, test_one "simple" (simple, ok_result v4_ns) ; 111 | "nixos", `Quick, test_one "nixos (with zone index)" 112 | (nixos, ok_result local_ns) ; 113 | "nixos 2", `Quick, test_one "nixos 2 (with zone index)" 114 | (nixos2, ok_result (v4_ns @ local_ns @ v4_ns)) ; 115 | ] 116 | 117 | let () = Alcotest.run "DNS resolvconf tests" [ "resolvconf tests", tests ] 118 | 119 | -------------------------------------------------------------------------------- /bin/transport/tunnel/tun.ml: -------------------------------------------------------------------------------- 1 | let run log_level domain subdomain port nameserver netmask tunnel_ip timeout = 2 | Eio_main.run @@ fun env -> 3 | Eio.Switch.run @@ fun sw -> 4 | let log = Dns_log.get log_level Format.std_formatter in 5 | let client = 6 | Transport.Datagram_client.run ~sw env ~nameserver ~subdomain 7 | ~authorative:domain port log timeout 8 | in 9 | let tun_fd, tun_name = Tuntap.opentun ~devname:"tun-dns" () in 10 | let tun = Eio_unix.Net.import_socket_stream ~sw ~close_unix:false tun_fd in 11 | Tuntap.set_ipv4 tun_name 12 | ~netmask:(Ipaddr.V4.Prefix.of_string_exn netmask) 13 | (Ipaddr.V4.of_string_exn tunnel_ip); 14 | let mtu = Tuntap.get_mtu tun_name in 15 | Eio.Fiber.both 16 | (fun () -> 17 | let buf = Cstruct.create mtu in 18 | while true do 19 | let got = client.recv buf in 20 | Eio.traceln "OUT %d" got; 21 | Eio.Flow.write tun [ Cstruct.sub buf 0 got ] 22 | done) 23 | (fun () -> 24 | let buf = Cstruct.create mtu in 25 | while true do 26 | let got = Eio.Flow.single_read tun buf in 27 | Eio.traceln "INC %d" got; 28 | client.send (Cstruct.sub buf 0 got) 29 | done) 30 | 31 | let () = 32 | let open Cmdliner in 33 | let open Server_args in 34 | let cmd = 35 | let subdomain = 36 | let doc = 37 | "Sudomain to use custom processing on. This will be combined with the \ 38 | root DOMAIN to form ., e.g. rpc.example.org. Data \ 39 | will be encoded as a base 64 string as a sudomain of this domain \ 40 | giving .., e.g. aGVsbG8K.rpc.example.org." 41 | in 42 | Arg.( 43 | value & opt string "rpc" 44 | & info [ "sd"; "subdomain" ] ~docv:"SUBDOMAIN" ~doc) 45 | in 46 | let domain = 47 | let doc = "Domain that the NAMESERVER is authorative for." in 48 | Arg.( 49 | value & opt string "example.org" 50 | & info [ "d"; "domain" ] ~docv:"DOMAIN" ~doc) 51 | in 52 | let nameserver = 53 | let doc = 54 | "The address of the nameserver to query. The first result returned by \ 55 | getaddrinfo will be used. If this may return multiple values, e.g. an \ 56 | IPv4 and IPv6 address for a host, and a specific one is desired it \ 57 | should be specified." 58 | in 59 | Arg.( 60 | value & opt string "127.0.0.1" 61 | & info [ "n"; "nameserver" ] ~docv:"NAMESERVER" ~doc) 62 | in 63 | let netmask = 64 | Arg.( 65 | value & opt string "10.0.0.0/24" 66 | & info [ "m"; "netmask" ] ~docv:"NETMASK") 67 | in 68 | let tunnel_ip = 69 | Arg.( 70 | value & opt string "10.0.0.2" 71 | & info [ "i"; "tunnel_ip" ] ~docv:"TUNNEL_IP") 72 | in 73 | let timeout = 74 | let doc = "Seconds to wait in between sending DNS queries." in 75 | Arg.(value & opt float 1. & info [ "t"; "timeout" ] ~docv:"TIMEOUT" ~doc) 76 | in 77 | let term = 78 | Term.( 79 | const run $ log_level Dns_log.Level0 $ domain $ subdomain $ port 80 | $ nameserver $ netmask $ tunnel_ip $ timeout) 81 | in 82 | let doc = "An authorative nameserver using OCaml 5 effects-based IO" in 83 | let info = Cmd.info "tun" ~man ~doc in 84 | Cmd.v info term 85 | in 86 | (* this is not domain safe *) 87 | (* Logs.set_reporter (Logs_fmt.reporter ()); 88 | Logs.set_level (Some Logs.Error); *) 89 | exit (Cmdliner.Cmd.eval cmd) 90 | -------------------------------------------------------------------------------- /bin/transport/netcat/netcat.ml: -------------------------------------------------------------------------------- 1 | let run log_level domain subdomain port nameserver mode timeout = 2 | Eio_main.run @@ fun env -> 3 | Eio.Switch.run @@ fun sw -> 4 | let log = Dns_log.get log_level Format.std_formatter in 5 | match mode with 6 | | `Datagram -> 7 | let client = 8 | Transport.Datagram_client.run ~sw env ~nameserver ~subdomain 9 | ~authorative:domain port log timeout 10 | in 11 | Eio.Fiber.both 12 | (fun () -> 13 | let buf = Cstruct.create 1000 in 14 | while true do 15 | let got = Eio.Flow.single_read env#stdin buf in 16 | client.send (Cstruct.sub buf 0 got) 17 | done) 18 | (fun () -> 19 | let buf = Cstruct.create 1000 in 20 | while true do 21 | let got = client.recv buf in 22 | Eio.Flow.write env#stdout [ Cstruct.sub buf 0 got ] 23 | done) 24 | | `Stream -> 25 | let client = 26 | Transport.Stream_client.run ~sw env ~nameserver ~subdomain 27 | ~authorative:domain port log timeout 28 | in 29 | Eio.Fiber.both 30 | (fun () -> Eio.Flow.copy env#stdin client) 31 | (fun () -> Eio.Flow.copy client env#stdout) 32 | 33 | let () = 34 | let open Cmdliner in 35 | let open Server_args in 36 | let cmd = 37 | let subdomain = 38 | let doc = 39 | "Sudomain to use custom processing on. This will be combined with the \ 40 | root DOMAIN to form ., e.g. rpc.example.org. Data \ 41 | will be encoded as a base 64 string as a sudomain of this domain \ 42 | giving .., e.g. aGVsbG8K.rpc.example.org." 43 | in 44 | Arg.( 45 | value & opt string "rpc" 46 | & info [ "sd"; "subdomain" ] ~docv:"SUBDOMAIN" ~doc) 47 | in 48 | let domain = 49 | let doc = "Domain that the NAMESERVER is authorative for." in 50 | Arg.( 51 | value & opt string "example.org" 52 | & info [ "d"; "domain" ] ~docv:"DOMAIN" ~doc) 53 | in 54 | let nameserver = 55 | let doc = 56 | "The address of the nameserver to query. The first result returned by \ 57 | getaddrinfo will be used. If this may return multiple values, e.g. an \ 58 | IPv4 and IPv6 address for a host, and a specific one is desired it \ 59 | should be specified." 60 | in 61 | Arg.( 62 | value & opt string "127.0.0.1" 63 | & info [ "n"; "nameserver" ] ~docv:"NAMESERVER" ~doc) 64 | in 65 | let mode = 66 | let doc = "The type of transport protocol to run over DNS." in 67 | let modes = [ ("datagram", `Datagram); ("stream", `Stream) ] in 68 | Arg.( 69 | value 70 | & opt (enum modes) `Datagram 71 | & info [ "m"; "mode" ] ~docv:"MODES" ~doc) 72 | in 73 | let timeout = 74 | let doc = "Seconds to wait in between sending DNS queries." in 75 | Arg.(value & opt float 1. & info [ "t"; "timeout" ] ~docv:"TIMEOUT" ~doc) 76 | in 77 | let term = 78 | Term.( 79 | const run $ log_level Dns_log.Level0 $ domain $ subdomain $ port 80 | $ nameserver $ mode $ timeout) 81 | in 82 | let doc = "An authorative nameserver using OCaml 5 effects-based IO" in 83 | let info = Cmd.info "netcat" ~man ~doc in 84 | Cmd.v info term 85 | in 86 | (* this is not domain safe *) 87 | (* Logs.set_reporter (Logs_fmt.reporter ()); 88 | Logs.set_level (Some Logs.Error); *) 89 | exit (Cmdliner.Cmd.eval cmd) 90 | -------------------------------------------------------------------------------- /lib/util/zonefile.ml: -------------------------------------------------------------------------------- 1 | let parse_keys keyfile filename prev_keys = 2 | try 3 | match Eio.Path.load keyfile |> Dns_zone.parse with 4 | | Error (`Msg msg) -> 5 | Format.fprintf Format.err_formatter "ignoring keyfile %s: %s\n" filename 6 | msg; 7 | Format.pp_print_flush Format.err_formatter (); 8 | prev_keys 9 | | Ok rrs -> 10 | let keys' = 11 | (* From Dns_zone.decode_keys *) 12 | Domain_name.Map.fold 13 | (fun n data acc -> 14 | match Dns.Rr_map.(find Dnskey data) with 15 | | None -> 16 | Format.fprintf Format.err_formatter 17 | "while parsing keyfile %s no dnskey found %a\n" filename 18 | Domain_name.pp n; 19 | Format.pp_print_flush Format.err_formatter (); 20 | acc 21 | | Some (_, keys) -> ( 22 | match Dns.Rr_map.Dnskey_set.elements keys with 23 | | [ x ] -> Domain_name.Map.add n x acc 24 | | xs -> 25 | Format.fprintf Format.err_formatter 26 | "while parsing keyfile %s ignoring %d dnskeys for %a \ 27 | (only one supported)\n" 28 | filename (List.length xs) Domain_name.pp n; 29 | Format.pp_print_flush Format.err_formatter (); 30 | acc)) 31 | rrs Domain_name.Map.empty 32 | in 33 | let f key a _b = 34 | Format.fprintf Format.err_formatter 35 | "while parsing keyfile %s encountered deplicate key %a\n" filename 36 | Domain_name.pp key; 37 | Format.pp_print_flush Format.err_formatter (); 38 | Some a 39 | in 40 | Domain_name.Map.union f prev_keys keys' 41 | with 42 | | Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> prev_keys 43 | | exn -> 44 | Format.fprintf Format.err_formatter "error parsing keyfile: %a\n" 45 | Eio.Exn.pp exn; 46 | Format.pp_print_flush Format.err_formatter (); 47 | prev_keys 48 | 49 | let parse_zonefiles ~fs zonefiles = 50 | let trie, keys, authorative = 51 | List.fold_left 52 | (fun (prev_trie, prev_keys, prev_authorative) zonefile -> 53 | match (Eio.Path.load @@ Eio.Path.(fs / zonefile)) |> Dns_zone.parse with 54 | | Error (`Msg msg) -> 55 | Format.fprintf Format.err_formatter "ignoring zonefile %s: %s\n" 56 | zonefile msg; 57 | Format.pp_print_flush Format.err_formatter (); 58 | (prev_trie, prev_keys, prev_authorative) 59 | | Ok rrs -> 60 | let keys = 61 | let filename = zonefile ^ "._keys" in 62 | parse_keys Eio.Path.(fs / filename) filename prev_keys 63 | in 64 | let trie = Dns_trie.insert_map rrs prev_trie in 65 | let authorative = 66 | Domain_name.Map.fold 67 | (fun domain rrmap authorative -> 68 | Dns.Rr_map.fold 69 | (fun b authorative -> 70 | match b with 71 | | B (Soa, _soa) -> domain :: authorative 72 | | _ -> authorative) 73 | rrmap authorative) 74 | rrs prev_authorative 75 | in 76 | (trie, keys, authorative)) 77 | (Dns_trie.empty, Domain_name.Map.empty, []) 78 | zonefiles 79 | in 80 | (trie, Domain_name.Map.bindings keys, authorative) 81 | -------------------------------------------------------------------------------- /vendor/dns/cache/dns_cache.mli: -------------------------------------------------------------------------------- 1 | (** DNS cache - a least recently used cache of DNS responses 2 | 3 | This data structure allows to insert and retrieve entries into a least 4 | recently used data structure. An [`Entry] weights the cardinality of the 5 | resource record map, all other entries have a weight of 1. 6 | 7 | The time to live is preserved, and when it is exceeded the entry is no 8 | longer returned. 9 | *) 10 | 11 | (* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) 12 | open Dns 13 | 14 | (** The variant of the rank in the cache. *) 15 | type rank = 16 | | ZoneFile 17 | | ZoneTransfer 18 | | AuthoritativeAnswer of bool 19 | | AuthoritativeAuthority of bool 20 | | ZoneGlue 21 | | NonAuthoritativeAnswer 22 | | Additional 23 | 24 | val pp_rank : rank Fmt.t 25 | (** [pp_rank ppf rank] pretty-prints the [rank] on [ppf]. *) 26 | 27 | val compare_rank : rank -> rank -> int 28 | (** [compare_rank a b] compares the ranks [a] with [b]. *) 29 | 30 | (** The type of a DNS cache. *) 31 | type t 32 | 33 | val empty : int -> t 34 | (** [empty maximum_size] is an empty DNS cache with the maximum size as 35 | capacity. *) 36 | 37 | val size : t -> int 38 | (** [size cache] is the number of bindings currently in the [cache]. *) 39 | 40 | val capacity : t -> int 41 | (** [capacity cache] is the used weight. *) 42 | 43 | val pp : t Fmt.t 44 | (** [pp ppf t] pretty prints the cache [t] on [ppf]. *) 45 | 46 | (** The polymorphic variant of an entry: a resource record, or no data, 47 | no domain, or a server failure. *) 48 | type 'a entry = [ 49 | | `Entry of 'a 50 | | `No_data of [ `raw ] Domain_name.t * Soa.t 51 | | `No_domain of [ `raw ] Domain_name.t * Soa.t 52 | | `Serv_fail of [ `raw ] Domain_name.t * Soa.t 53 | ] 54 | 55 | val pp_entry : 'a Rr_map.key -> 'a entry Fmt.t 56 | (** [pp_entry ppf entry] pretty-prints [entry] on [ppf]. *) 57 | 58 | val get : t -> int64 -> [ `raw ] Domain_name.t -> 'a Rr_map.key -> 59 | t * ('a entry * rank, [ `Cache_miss | `Cache_drop ]) result 60 | (** [get cache timestamp type name] retrieves the query [type, name] from the 61 | [cache] using [timestamp]. If the time to live is exceeded, a [`Cache_drop] 62 | is returned. If there is no entry in the cache, a [`Cache_miss] is 63 | returned. *) 64 | 65 | val get_or_cname : t -> int64 -> [ `raw ] Domain_name.t -> 'a Rr_map.key -> 66 | t * ([ 'a entry | `Alias of int32 * [`raw] Domain_name.t] * rank, 67 | [ `Cache_miss | `Cache_drop ]) result 68 | (** [get_or_cname cache timestamp type name] is the same as [get], but if a 69 | [`Cache_miss] is encountered, a lookup for an alias (CNAME) is done. *) 70 | 71 | val get_any : t -> int64 -> [ `raw ] Domain_name.t -> 72 | t * ([ `Entries of Rr_map.t 73 | | `No_domain of [ `raw ] Domain_name.t * Soa.t ] * rank, 74 | [ `Cache_miss | `Cache_drop ]) result 75 | (** [get_any cache timestamp name] retrieves all resource records for [name] 76 | in [cache]. *) 77 | 78 | val get_nsec3 : t -> int64 -> [ `raw ] Domain_name.t -> 79 | t * (([`raw] Domain_name.t * Nsec3.t) list, [ `Cache_miss | `Cache_drop ]) result 80 | (** [get_nsec3 cache timestamp name] retrieves all nsec3 resource records for 81 | the zone [name]. *) 82 | 83 | val set : t -> int64 -> [ `raw ] Domain_name.t -> 'a Rr_map.key -> rank -> 84 | 'a entry -> t 85 | (** [set cache timestamp type name rank value] attempts to insert 86 | [type, name, value] into the [cache] using the [timestamp] and [rank]. If 87 | an entry already exists with a higher [rank], the [cache] is unchanged. *) 88 | -------------------------------------------------------------------------------- /bin/transport/netcat/netcatd.ml: -------------------------------------------------------------------------------- 1 | let run zonefiles log_level address_strings subdomain authorative port proto 2 | mode = 3 | Eio_main.run @@ fun env -> 4 | Eio.Switch.run @@ fun sw -> 5 | let log = Dns_log.get log_level Format.std_formatter in 6 | let addresses = Server_args.parse_addresses port address_strings in 7 | let server_state = 8 | let trie', keys, parsedAuthorative = 9 | Zonefile.parse_zonefiles ~fs:env#fs zonefiles 10 | in 11 | let trie = 12 | match List.find_opt (fun a -> a == authorative) parsedAuthorative with 13 | | Some _ -> trie' 14 | | None -> 15 | Dns_trie.insert Domain_name.root Dns.Rr_map.Soa 16 | (Dns.Soa.create authorative) 17 | trie' 18 | in 19 | let rng ?_g length = 20 | let buf = Cstruct.create length in 21 | Eio.Flow.read_exact env#secure_random buf; 22 | Cstruct.to_string buf 23 | in 24 | ref 25 | @@ Dns_server.Primary.create ~keys ~rng ~tsig_verify:Dns_tsig.verify 26 | ~tsig_sign:Dns_tsig.sign trie 27 | in 28 | let authorative = Domain_name.to_string authorative in 29 | match mode with 30 | | `Datagram -> 31 | let server = 32 | (* TODO remember why datagram needs and authority, but not stream, and then remove the hardcoded value *) 33 | Transport.Datagram_server.run ~sw env proto ~subdomain ~authorative 34 | server_state log addresses 35 | in 36 | let buf = Cstruct.create 1000 in 37 | while true do 38 | let got = server.recv buf in 39 | server.send (Cstruct.sub buf 0 got) 40 | done 41 | | `Stream -> 42 | let server = 43 | Transport.Stream_server.run ~sw env proto ~subdomain ~authorative 44 | server_state log addresses 45 | in 46 | Eio.Flow.copy server server 47 | 48 | let () = 49 | let open Cmdliner in 50 | let open Server_args in 51 | let cmd = 52 | let subdomain = 53 | let doc = 54 | "Sudomain to use custom processing on. This will be combined with the \ 55 | root DOMAIN to form ., e.g. rpc.example.org. Data \ 56 | will be encoded as a base 64 string as a sudomain of this domain \ 57 | giving .., e.g. aGVsbG8K.rpc.example.org." 58 | in 59 | Arg.( 60 | value & opt string "rpc" 61 | & info [ "sd"; "subdomain" ] ~docv:"SUBDOMAIN" ~doc) 62 | in 63 | let authorative = 64 | let doc = 65 | "Domain for which the server is authorative and that we will use to \ 66 | tunnel data at the SUBDOMAIN." 67 | in 68 | Arg.( 69 | required 70 | & opt (some (conv (Domain_name.of_string, Domain_name.pp))) None 71 | & info [ "a"; "authorative" ] ~docv:"AUTHORATIVE" ~doc) 72 | in 73 | let mode = 74 | let doc = "The type of transport protocol to run over DNS." in 75 | let modes = [ ("datagram", `Datagram); ("stream", `Stream) ] in 76 | Arg.( 77 | value 78 | & opt (enum modes) `Datagram 79 | & info [ "m"; "mode" ] ~docv:"MODES" ~doc) 80 | in 81 | let term = 82 | Term.( 83 | const run $ zonefiles $ log_level Dns_log.Level1 $ addresses $ subdomain 84 | $ authorative $ port $ proto $ mode) 85 | in 86 | let doc = "An authorative nameserver using OCaml 5 effects-based IO" in 87 | let info = Cmd.info "netcatd" ~man ~doc in 88 | Cmd.v info term 89 | in 90 | (* this is not domain safe *) 91 | (* Logs.set_reporter (Logs_fmt.reporter ()); 92 | Logs.set_level (Some Logs.Error); *) 93 | exit (Cmdliner.Cmd.eval cmd) 94 | -------------------------------------------------------------------------------- /vendor/dns/app/oupdate.ml: -------------------------------------------------------------------------------- 1 | (* (c) 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | open Dns 4 | 5 | let create_update zone hostname ip_address = 6 | let zone = Packet.Question.create zone Soa 7 | and update = 8 | let up = 9 | Domain_name.Map.singleton hostname 10 | [ 11 | Packet.Update.Remove (Rr_map.K A) ; 12 | Packet.Update.Add Rr_map.(B (A, (60l, Ipaddr.V4.Set.singleton ip_address))) 13 | ] 14 | in 15 | (Domain_name.Map.empty, up) 16 | and header = Randomconv.int16 Mirage_crypto_rng.generate, Packet.Flags.empty 17 | in 18 | Packet.create header zone (`Update update) 19 | 20 | let jump _ serverip port (keyname, zone, dnskey) hostname ip_address = 21 | Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna); 22 | let now = Ptime_clock.now () in 23 | Logs.app (fun m -> m "updating to %a:%d zone %a A 600 %a %a" 24 | Ipaddr.pp serverip port 25 | Domain_name.pp zone 26 | Domain_name.pp hostname 27 | Ipaddr.V4.pp ip_address) ; 28 | Logs.debug (fun m -> m "using key %a: %a" Domain_name.pp keyname Dns.Dnskey.pp dnskey) ; 29 | let p = create_update zone hostname ip_address in 30 | match Dns_tsig.encode_and_sign ~proto:`Tcp p now dnskey keyname with 31 | | Error s -> 32 | Error (`Msg (Fmt.str "tsig sign error %a" Dns_tsig.pp_s s)) 33 | | Ok (data, mac) -> 34 | let data_len = String.length data in 35 | Logs.debug (fun m -> m "built data %d" data_len) ; 36 | let socket = Dns_cli.connect_tcp serverip port in 37 | Dns_cli.send_tcp socket data ; 38 | let read_data = Dns_cli.recv_tcp socket in 39 | (try (Unix.close socket) with _ -> ()) ; 40 | match Dns_tsig.decode_and_verify now dnskey keyname ~mac read_data with 41 | | Error e -> 42 | Error (`Msg (Fmt.str "nsupdate error %a" Dns_tsig.pp_e e)) 43 | | Ok (reply, _, _) -> 44 | match Packet.reply_matches_request ~request:p reply with 45 | | Ok `Update_ack -> 46 | Logs.app (fun m -> m "successful and signed update!") ; 47 | Ok () 48 | | Ok r -> 49 | Error (`Msg (Fmt.str "nsupdate expected update ack, received %a" Packet.pp_reply r)) 50 | | Error e -> 51 | Error (`Msg (Fmt.str "nsupdate error %a (reply %a does not match request %a)" 52 | Packet.pp_mismatch e Packet.pp reply Packet.pp p)) 53 | 54 | open Cmdliner 55 | 56 | let serverip = 57 | let doc = "IP address of DNS server" in 58 | Arg.(required & pos 0 (some Dns_cli.ip_c) None & info [] ~doc ~docv:"SERVERIP") 59 | 60 | let port = 61 | let doc = "Port to connect to" in 62 | Arg.(value & opt int 53 & info [ "port" ] ~doc) 63 | 64 | let key = 65 | let doc = "DNS HMAC secret (name:alg:b64key where name is yyy._update.zone)" in 66 | Arg.(required & pos 1 (some Dns_cli.namekey_c) None & info [] ~doc ~docv:"KEY") 67 | 68 | let hostname = 69 | let doc = "Hostname to modify" in 70 | Arg.(required & pos 2 (some Dns_cli.domain_name_c) None & info [] ~doc ~docv:"HOSTNAME") 71 | 72 | let ipv4_c = 73 | let parse s = 74 | match Ipaddr.V4.of_string s with 75 | | Ok ip -> `Ok ip 76 | | Error (`Msg m) -> `Error ("failed to parse IP address: " ^ m) 77 | in 78 | parse, Ipaddr.V4.pp 79 | 80 | let ip_address = 81 | let doc = "New IP address" in 82 | Arg.(required & pos 3 (some ipv4_c) None & info [] ~doc ~docv:"IP") 83 | 84 | let cmd = 85 | let term = 86 | Term.(term_result (const jump $ Dns_cli.setup_log $ serverip $ port $ key $ hostname $ ip_address)) 87 | and info = Cmd.info "oupdate" ~version:"%%VERSION_NUM%%" 88 | in 89 | Cmd.v info term 90 | 91 | let () = exit (Cmd.eval cmd) 92 | -------------------------------------------------------------------------------- /vendor/dns/resolver/dns_resolver_root.ml: -------------------------------------------------------------------------------- 1 | (* (c) 2018 Hannes Mehnert, all rights reserved *) 2 | open Dns 3 | 4 | let root_servers = 5 | List.map (fun (n, ip4, ip6) -> 6 | Domain_name.(host_exn (of_string_exn n)), 7 | Ipaddr.V4.of_string_exn ip4, 8 | Ipaddr.V6.of_string_exn ip6) 9 | [ 10 | "a.root-servers.net", "198.41.0.4", "2001:503:ba3e::2:30" ; (* VeriSign, Inc. *) 11 | "b.root-servers.net", "170.247.170.2", "2801:1b8:10::b" ; (* University of Southern California (ISI) *) 12 | "c.root-servers.net", "192.33.4.12", "2001:500:2::c" ; (* Cogent Communications *) 13 | "d.root-servers.net", "199.7.91.13", "2001:500:2d::d" ; (* University of Maryland *) 14 | "e.root-servers.net", "192.203.230.10", "2001:500:a8::e" ; (* NASA (Ames Research Center) *) 15 | "f.root-servers.net", "192.5.5.241", "2001:500:2f::f" ; (* Internet Systems Consortium, Inc. *) 16 | "g.root-servers.net", "192.112.36.4", "2001:500:12::d0d" ; (* US Department of Defense (NIC) *) 17 | "h.root-servers.net", "198.97.190.53", "2001:500:1::53" ; (* US Army (Research Lab) *) 18 | "i.root-servers.net", "192.36.148.17", "2001:7fe::53" ; (* Netnod *) 19 | "j.root-servers.net", "192.58.128.30", "2001:503:c27::2:30" ; (* VeriSign, Inc. *) 20 | "k.root-servers.net", "193.0.14.129", "2001:7fd::1" ; (* RIPE NCC *) 21 | "l.root-servers.net", "199.7.83.42", "2001:500:9f::42" ; (* ICANN *) 22 | "m.root-servers.net", "202.12.27.33", "2001:dc3::35" ; (* WIDE Project *) 23 | ] 24 | 25 | let a_ttl = 3600000l 26 | let ns_ttl = 518400l 27 | 28 | let ns_records = 29 | let ns = 30 | let add_to_set set (name, _, _) = Domain_name.Host_set.add name set in 31 | List.fold_left add_to_set Domain_name.Host_set.empty root_servers 32 | in 33 | (ns_ttl, ns) 34 | 35 | let a_records = 36 | List.map (fun (name, ip, _) -> 37 | Domain_name.raw name, (a_ttl, Ipaddr.V4.Set.singleton ip)) 38 | root_servers 39 | 40 | let aaaa_records = 41 | List.map (fun (name, _, ip) -> 42 | Domain_name.raw name, (a_ttl, Ipaddr.V6.Set.singleton ip)) 43 | root_servers 44 | 45 | let ips protocol = 46 | List.fold_left (fun acc (_, ip4, ip6) -> 47 | match protocol with 48 | | `Both -> Ipaddr.V4 ip4 :: Ipaddr.V6 ip6 :: acc 49 | | `Ipv4_only -> Ipaddr.V4 ip4 :: acc 50 | | `Ipv6_only -> Ipaddr.V6 ip6 :: acc) 51 | [] root_servers 52 | 53 | let reserved_zone_records = 54 | let n = Domain_name.of_string_exn in 55 | (* RFC 6761, avoid them to get out of here + multicast DNS 6762 *) 56 | let zones = 57 | Domain_name.Set.(add (n "local") (* multicast dns, RFC 6762 *) 58 | (add (n "test") (add (n "invalid") (* RFC 6761 *) 59 | (add (n "localhost") (* RFC 6761, draft let-localhost-be-localhost *) 60 | empty)))) 61 | in 62 | let local_net_name = "127.in-addr.arpa" in 63 | Domain_name.Set.add (n local_net_name) zones 64 | 65 | let stub_soa s = 66 | let nameserver = Domain_name.prepend_label_exn s "ns" 67 | and hostmaster = Domain_name.prepend_label_exn s "hostmaster" 68 | in 69 | { Soa.nameserver ; hostmaster ; serial = 0l ; refresh = 300l ; retry = 300l ; 70 | expiry = 300l ; minimum = 300l } 71 | 72 | let reserved_zones = 73 | let inv s = Rr_map.(B (Soa, stub_soa s)) in 74 | Domain_name.Set.fold (fun n acc -> (n, inv n) :: acc) reserved_zone_records [] 75 | 76 | let reserved = 77 | Domain_name.Set.fold (fun name trie -> 78 | Dns_trie.insert name Rr_map.Soa (stub_soa name) trie) 79 | reserved_zone_records Dns_trie.empty 80 | 81 | let root_servers = 82 | List.map (fun (n, ip4, ip6) -> Domain_name.raw n, ip4, ip6) root_servers 83 | -------------------------------------------------------------------------------- /vendor/letsencrypt/mirage/lE.mli: -------------------------------------------------------------------------------- 1 | (** {1:Let's encrypt challenge with [paf].} 2 | 3 | [Paf] provides a layer to be able to: 4 | 1) launch a simple HTTP server which will do the Let's encrypt challenge 5 | 2) launch a simple HTTP client to ask a new certificate 6 | 7 | The HTTP server must be behind the domain-name for which you want a 8 | certificate. 9 | 10 | The usual way to get a certificate is to prepare a {!type:configuration} 11 | value, prepare the HTTP server and launch concurrently the server and the 12 | client with an ability to stop the server when the client finish the job: 13 | 14 | {[ 15 | module LE = LE.Make (Time) (Stack) 16 | 17 | let provision ctx = 18 | Paf.init ~port:80 (Stack.tcp stackv4v6) >>= fun t -> 19 | let service = Paf.http_service 20 | ~error_handler:ignore_error 21 | (fun _ -> LE.request_handler) in 22 | let stop = Lwt_switch.create () in 23 | let `Initialized th0 = Paf.serve ~stop service in 24 | let th1 = 25 | LE.provision_certificate 26 | ~production:false 27 | configuration 28 | ctx 29 | >>= fun certificates -> 30 | Lwt_switch.turn_off stop >>= fun () -> 31 | Lwt.return certificates in 32 | Lwt.both th0 th1 >>= function 33 | | ((), Ok certificates) -> ... 34 | | ((), Error _) -> ... 35 | ]} 36 | 37 | The client requires an {!type:Http_mirage_client.t} to be able to do HTTP 38 | requests ([http/1.1] or [h2]) which can be made by 39 | {!val:Http_mirage_client.Make.connect}. *) 40 | 41 | type configuration = { 42 | email : Emile.mailbox option; 43 | certificate_seed : string option; 44 | certificate_key_type : X509.Key_type.t; 45 | certificate_key_bits : int option; 46 | hostname : [ `host ] Domain_name.t; 47 | account_seed : string option; 48 | account_key_type : X509.Key_type.t; 49 | account_key_bits : int option; 50 | } 51 | 52 | module Make (Time : Mirage_time.S) (Stack : Tcpip.Stack.V4V6) : sig 53 | type nonrec configuration = configuration = { 54 | email : Emile.mailbox option; 55 | certificate_seed : string option; 56 | certificate_key_type : X509.Key_type.t; 57 | certificate_key_bits : int option; 58 | hostname : [ `host ] Domain_name.t; 59 | account_seed : string option; 60 | account_key_type : X509.Key_type.t; 61 | account_key_bits : int option; 62 | } 63 | 64 | val request_handler : 65 | Ipaddr.t * int -> Httpaf.Server_connection.request_handler 66 | 67 | val provision_certificate : 68 | ?tries:int -> 69 | ?production:bool -> 70 | configuration -> 71 | Http_mirage_client.t -> 72 | (Tls.Config.own_cert, [> `Msg of string ]) result Lwt.t 73 | 74 | val initialise : 75 | ctx:Http_mirage_client.t -> 76 | endpoint:Uri.t -> 77 | ?email:string -> 78 | X509.Private_key.t -> 79 | (Letsencrypt.Client.t, [> `Msg of string ]) result Lwt.t 80 | (** [initialise ~ctx ~endpoint ~email priv] constructs a 81 | {!type:Letsencrypt.Client.t} by looking up the directory and account of 82 | [priv] at [endpoint]. If no account is registered yet, a new account is 83 | created with contact information of [email]. The terms of service are 84 | agreed on. *) 85 | 86 | val sign_certificate : 87 | ctx:Http_mirage_client.t -> 88 | Letsencrypt.Client.solver -> 89 | Letsencrypt.Client.t -> 90 | (int -> unit Lwt.t) -> 91 | X509.Signing_request.t -> 92 | (X509.Certificate.t list, [> `Msg of string ]) result Lwt.t 93 | (** [sign_certificate ~ctx solver t sleep csr] orders a certificate for the 94 | names in the signing request [csr], and solves the requested challenges. *) 95 | end 96 | -------------------------------------------------------------------------------- /lib/util/server_args.ml: -------------------------------------------------------------------------------- 1 | open Cmdliner 2 | 3 | let zonefiles = 4 | Arg.( 5 | value & opt_all string [] 6 | & info [ "z"; "zonefile" ] ~docv:"ZONEFILE_PATHS" ~doc:"Zonefile paths.") 7 | 8 | let log_level default = 9 | let doc = "Log level for DNS packets. See the LOGGING section." in 10 | let log_levels = 11 | Dns_log.[ ("0", Level0); ("1", Level1); ("2", Level2); ("3", Level3) ] 12 | in 13 | Arg.( 14 | value 15 | & opt (enum log_levels) default 16 | & info [ "l"; "log-level" ] ~docv:"LOG_LEVEL" ~doc) 17 | 18 | let port = 19 | let doc = 20 | "Port to bind on. By default 53 is used. See the BINDING section." 21 | in 22 | Arg.(value & opt int 53 & info [ "p"; "port" ] ~docv:"PORT" ~doc) 23 | 24 | let addresses = 25 | let doc = 26 | "Socket addresses to bind too. By default `in6addr_any` ('::') is used. \ 27 | See the BINDING section." 28 | in 29 | (* :: is IPv6 local *) 30 | Arg.(value & opt_all string [ "::" ] & info [ "b"; "bind" ] ~docv:"BIND" ~doc) 31 | 32 | let parse_addresses port address_strings = 33 | List.map 34 | (fun ip -> 35 | match Ipaddr.with_port_of_string ~default:port ip with 36 | | Ok (ip, p) -> 37 | let eioIp = Ipaddr.to_octets ip |> Eio.Net.Ipaddr.of_raw in 38 | (eioIp, p) 39 | | Error (`Msg msg) -> 40 | Format.fprintf Format.err_formatter "Error parsing address '%s': %s" 41 | ip msg; 42 | Format.pp_print_flush Format.err_formatter (); 43 | exit 1) 44 | address_strings 45 | 46 | let proto = 47 | let doc = 48 | "The protocols to use when binding to sockets, either `tcp` or `udp`. \ 49 | Defaults to both." 50 | in 51 | let protos = 52 | [ ("tcp", [ `Tcp ]); ("udp", [ `Udp ]); ("both", [ `Tcp; `Udp ]) ] 53 | in 54 | Arg.( 55 | value 56 | & opt (enum protos) [ `Tcp; `Udp ] 57 | & info [ "proto" ] ~docv:"PROTOCOL" ~doc) 58 | 59 | let resolver = 60 | let doc = "Whether to operate as a recursive resolver." in 61 | Arg.(value & flag & info [ "r"; "resolver" ] ~docv:"RESOLVER" ~doc) 62 | 63 | let man = 64 | let help_secs = 65 | [ 66 | `S Manpage.s_options; 67 | `S "LOGGING"; 68 | `Pre 69 | "Log levels are defined by the LOG_LEVEL option as one of these \ 70 | possible values:\n\ 71 | \ 0 - No logging\n\ 72 | \ 1 - Log query id, question, and anwer\n\ 73 | \ 2 - Log all fields of DNS packets\n\ 74 | \ 3 - Log hex dumps of DNS packets"; 75 | `S "BINDING"; 76 | `P 77 | "The socket(s) the server binds too can be configured with the \ 78 | ADDRESSES and PORT options. This allows different IP addresses and \ 79 | ports to be used. Specifying IP addresses can be useful for \ 80 | restricting the network interfaces to listen on, as localhost listens \ 81 | on all interfaces by default"; 82 | `P 83 | "If IPv4-mapped IPv6 (RFC3493) is not supported, e.g. on OpenBSD, the \ 84 | user will need to additionally specify an IPv4 address in order to \ 85 | serve IPv4 traffic, e.g. '-a 127.0.0.1 -a '::''."; 86 | `P 87 | "A port can be sepecified as defined in RFC4038 Section 5.1, e.g. \ 88 | '[::]:53' or '127.0.0.1::53', otherwise the default PORT is used."; 89 | `P 90 | "Note that names as might be used by `getaddrinfo`, e.g. 'localhost', \ 91 | are not supported."; 92 | `S Manpage.s_bugs; 93 | `P "Check bug reports at https://github.com/RyanGibb/eon/issues."; 94 | ] 95 | in 96 | [ 97 | `S Manpage.s_description; 98 | `P "Prints help about darcs commands and other subjects…"; 99 | `Blocks help_secs; 100 | ] 101 | -------------------------------------------------------------------------------- /docs/cap.md: -------------------------------------------------------------------------------- 1 | 2 | ### Capability Interface 3 | 4 | A [schema.capnp](../lib/cap/schema.capnp) defines a [capnproto](https://capnproto.org/) interface to interact with the nameserver. 5 | A server and client are provided in [cap](../bin/cap/cap.ml]) and [capc](../bin/cap/capc.ml]) respectively. 6 | 7 | ### Running 8 | 9 | When we run a nameserver it outputs a domain capability and primary capability for each domain name for which it is authoritative. 10 | 11 | ``` 12 | $ capd -z example.org --capnp-secret-key-file /var/lib/eon/capnp-secret.pem --capnp-listen-address tcp:example.org:7000 --state-dir /var/lib/eon 13 | $ sudo find /var/lib/eon/caps/ -type f 14 | /var/lib/eon/caps/domain/example.org.cap 15 | /var/lib/eon/caps/primary/example.org.cap 16 | ``` 17 | 18 | ### Client Operations 19 | 20 | A domain capability is used by the `capc` client. 21 | A simple example is using the `getName` method: 22 | 23 | ``` 24 | $ capc get-name example.org.cap 25 | example.org 26 | ``` 27 | 28 | The client can create a new capability for a subdomain with the 'delegate' method. 29 | Note this is persisted to disk, so it can be referenced across restarts. 30 | 31 | ``` 32 | $ capc delegate example.org.cap test 33 | Wrote capability to test.example.org.cap 34 | $ capc get-name test.example.org.cap 35 | test.example.org 36 | ``` 37 | 38 | We expose a DNS UPDATE semantic-compatible interface over Cap'N Proto, which can support arbitrarily complex pre-requisites. 39 | 40 | ``` 41 | $ capc update test.example.org.cap -u add|test.example.org|A|128.232.113.136|3600 42 | $ dig test.example.org +short 43 | 128.232.113.136 44 | ``` 45 | 46 | We also support provisioning TLS certificates with the ACME DNS-01 challenge client embedded in the nameserver, modifying the trie in-memory. 47 | 48 | ``` 49 | $ capc cert test.example.org.cap ryan@test.example.org -d test.example.org 50 | Updated certificate for test.example.org 51 | ``` 52 | 53 | Renewals are supported via forking a fiber, sleeping to the expiration date minus 30 days, and providing the new certificate to the client via a callback. 54 | 55 | ### Secondary Nameserver 56 | 57 | We can start a `capd` nameserver with a primary capability from another `capd` nameserver. 58 | The former will act as a secondary nameserver for the capability's domain, assuming the necessary `ns` records are added to the zone. 59 | For example, we could pass a primary capability for `example.org` to `example.com`, adding `example.org. 3600 IN NS ns.example.com.` to `example.org`'s zone, and if the `example.org` nameserver goes down `example.com` will keep serving it. 60 | 61 | This works by creating a secondary capability for each primary passed, and registering the secondary capability with the associated primary capability. 62 | The `capd` server will then send the initial zone to the secondary using the `Secondary.update` method. 63 | Updates done with the `Domain.update` method are propagated to all the primary's secondaries using `Secondary.update` as well. 64 | 65 | This allows zone's with secondary nameserver to provision certificates by propagating the ACME DNS-01 challenge token to all secondaries. 66 | 67 | Capabilities are persisted so if either nameserver goes down, the session will resume upon restart. 68 | We could keep track of the serial number as an optimization to reduce the size of the initial zone transfer. 69 | 70 | An example of using a primary capability, received from e.g. `/var/lib/eon/caps/primary/example.org.cap`, is: 71 | 72 | ``` 73 | $ capd -z example.org --capnp-secret-key-file /var/lib/eon/capnp-secret.pem --capnp-listen-address tcp:example.com:7000 --state-dir /var/lib/eon --primary /run/eon/primary/example.org.cap 74 | $ sudo find /var/lib/eon/caps/ -type f 75 | /var/lib/eon/caps/domain/example.com.cap 76 | /var/lib/eon/caps/secondary/example.org/example.org.cap 77 | /var/lib/eon/caps/primary/example.com.cap 78 | ``` 79 | 80 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # Effects-based OCaml Nameserver (EON) 3 | 4 | EON is an authoritative nameserver for the Domain Name System (DNS) using the functionally pure [Mirage OCaml-DNS libraries](https://github.com/mirage/ocaml-dns) and [Effects-Based Parallel IO for multicore OCaml](https://github.com/ocaml-multicore/eio), along with some experimental uses of the DNS. 5 | 6 | Read more at [https://ryan.freumh.org/eon.html](https://ryan.freumh.org/eon.html). 7 | 8 | ### Quick start 9 | 10 | ``` 11 | $ nix shell github:RyanGibb/eon 12 | $ sudo eon --zonefile 13 | ``` 14 | 15 | Or follow the instructions to manually [build from source](#building). 16 | 17 | For help: 18 | ``` 19 | $ eon --help 20 | ``` 21 | 22 | ### Building 23 | 24 | [Nix](https://nixos.org) can be used to build the project with: 25 | 26 | ``` 27 | $ git clone git@github.com:RyanGibb/eon.git 28 | $ cd eon 29 | $ nix build . 30 | ``` 31 | 32 | The binary can then be found at `result/bin/eon`. 33 | 34 | Note that this is using [Nix flakes](https://nixos.org/manual/nix/stable/command-ref/new-cli/nix3-flake.html). 35 | 36 | Alternatively, opam and dune tooling can be used: 37 | ``` 38 | $ opam install . 39 | $ dune build 40 | ``` 41 | 42 | The binary can then be found at `_build/default/src/eon.exe`. 43 | 44 | ### Running 45 | 46 | Once built, to run the project use: 47 | 48 | ``` 49 | $ ./eon --zonefile 50 | ``` 51 | 52 | For example: 53 | ``` 54 | $ ./eon --zonefile examples/example.com 55 | ``` 56 | 57 | The zonefile format is defined in [RFC1035 Section 5.1](https://datatracker.ietf.org/doc/html/rfc1035#section-5.1), but a minimal example is provided in [example.org](./example/example.org). 58 | 59 | Note root access may be required to bind to port 53. 60 | 61 | You can then query your nameserver using the [BIND](https://www.isc.org/bind/) `dig` utility: 62 | ``` 63 | $ dig example.org @localhost +short 64 | 203.0.113.0 65 | ``` 66 | 67 | The command line argument `--log-level` can be used to specify a log verbosity e.g.: 68 | ``` 69 | $ ./eon --zonefile examples/example.com --log-level 2 70 | ``` 71 | 72 | To operate as a recursive resolver: 73 | ``` 74 | $ ./eon --zonefile examples/example.com --resolver 75 | ``` 76 | 77 | Which will additionally recursively look up records for domains it is not authoritative over. 78 | Be careful of [DNS amplification attacks](https://www.cloudflare.com/learning/ddos/dns-amplification-ddos-attack/). 79 | 80 | ### Deployment 81 | 82 | A [NixOS module](https://nixos.org/manual/nixos/stable/index.html#sec-writing-modules) is provided that describes a systemd service and some configuration options. See [here](https://www.tweag.io/blog/2020-07-31-nixos-flakes/#adding-modules-from-third-party-flakes) for an example of adding a module from another flake to your NixOS configuration. 83 | 84 | It's also possible to simply run this as a binary. 85 | 86 | You'll need to configure your zonefile with an [NS](https://www.ietf.org/rfc/rfc1035.html#section-3.3.11) record, and set up a glue record with your registrar to point this domain to the IP that your nameserver is hosted on. See [example.org](./example/example.org) for an example NS record. 87 | 88 | ### Development 89 | 90 | While it's possible to continuously rebuild the Nix derivation during development, this is quite slow due to isolated builds. A nice compromise is to use Nix to provide the dependencies but to use an un-sandboxed dune to build the project benefiting from caches and incremental builds. 91 | 92 | To do this, use: 93 | ``` 94 | nix develop . -c dune build 95 | ``` 96 | 97 | Development packages [https://github.com/ocaml/ocaml-lsp](ocaml-lsp) are also provided, so one can launch an editor with: 98 | ``` 99 | nix develop . -c 100 | ``` 101 | 102 | Alternatively, opam tooling can be used to provide the development dependencies. 103 | 104 | ### Documentation 105 | 106 | See [./docs/](./docs/). 107 | -------------------------------------------------------------------------------- /bin/transport/sod/sod.ml: -------------------------------------------------------------------------------- 1 | let run log_level domain subdomain port nameserver timeout = 2 | Eio_main.run @@ fun env -> 3 | Eio.Switch.run @@ fun sw -> 4 | let log = Dns_log.get log_level Format.std_formatter in 5 | let client = 6 | Transport.Stream_client.run ~sw env ~nameserver ~subdomain 7 | ~authorative:domain port log timeout 8 | in 9 | 10 | let savedTio = Unix.tcgetattr Unix.stdin in 11 | 12 | (* set raw mode *) 13 | let tio = 14 | { 15 | savedTio with 16 | (* input modes *) 17 | c_ignpar = true; 18 | c_istrip = false; 19 | c_inlcr = false; 20 | c_igncr = false; 21 | c_ixon = false; 22 | (* c_ixany = false; *) 23 | (* c_iuclc = false; *) 24 | c_ixoff = false; 25 | (* output modes *) 26 | c_opost = false; 27 | (* control modes *) 28 | c_isig = false; 29 | c_icanon = false; 30 | c_echo = false; 31 | c_echoe = false; 32 | c_echok = false; 33 | c_echonl = false; 34 | (* c_iexten = false; *) 35 | 36 | (* special characters *) 37 | c_vmin = 1; 38 | c_vtime = 0; 39 | } 40 | in 41 | Unix.tcsetattr Unix.stdin TCSADRAIN tio; 42 | 43 | (* TODO send window size change update https://www.ietf.org/rfc/rfc4254.html#section-6.7 *) 44 | (* handle window size change *) 45 | (* match Pty.get_sigwinch () with 46 | | None -> () 47 | | Some sigwinch -> ( 48 | let handle_sigwinch (_signum : int) = 49 | let ws = Pty.tty_window_size () in 50 | ignore (Pty.set_window_size pty ws) 51 | in 52 | handle_sigwinch sigwinch; 53 | ignore (Sys.signal sigwinch (Signal_handle handle_sigwinch))); *) 54 | 55 | (* TODO detect terminated session *) 56 | (* TODO use nagle's algorithm? *) 57 | Eio.Fiber.both 58 | (fun () -> Eio.Flow.copy env#stdin client) 59 | (fun () -> Eio.Flow.copy client env#stdout); 60 | 61 | (* restore tio *) 62 | Unix.tcsetattr Unix.stdin TCSADRAIN savedTio 63 | 64 | let () = 65 | let open Cmdliner in 66 | let open Server_args in 67 | let cmd = 68 | let subdomain = 69 | let doc = 70 | "Sudomain to use custom processing on. This will be combined with the \ 71 | root DOMAIN to form ., e.g. rpc.example.org. Data \ 72 | will be encoded as a base 64 string as a sudomain of this domain \ 73 | giving .., e.g. aGVsbG8K.rpc.example.org." 74 | in 75 | Arg.( 76 | value & opt string "rpc" 77 | & info [ "sd"; "subdomain" ] ~docv:"SUBDOMAIN" ~doc) 78 | in 79 | let domain = 80 | let doc = "Domain that the NAMESERVER is authorative for." in 81 | Arg.( 82 | value & opt string "example.org" 83 | & info [ "d"; "domain" ] ~docv:"DOMAIN" ~doc) 84 | in 85 | let nameserver = 86 | let doc = 87 | "The address of the nameserver to query. The first result returned by \ 88 | getaddrinfo will be used. If this may return multiple values, e.g. an \ 89 | IPv4 and IPv6 address for a host, and a specific one is desired it \ 90 | should be specified." 91 | in 92 | Arg.( 93 | value & opt string "127.0.0.1" 94 | & info [ "n"; "nameserver" ] ~docv:"NAMESERVER" ~doc) 95 | in 96 | let timeout = 97 | let doc = "Seconds to wait in between sending DNS queries." in 98 | Arg.(value & opt float 1. & info [ "t"; "timeout" ] ~docv:"TIMEOUT" ~doc) 99 | in 100 | let term = 101 | Term.( 102 | const run $ log_level Dns_log.Level0 $ domain $ subdomain $ port 103 | $ nameserver $ timeout) 104 | in 105 | let info = Cmd.info "sod" ~man in 106 | Cmd.v info term 107 | in 108 | (* this is not domain safe *) 109 | (* Logs.set_reporter (Logs_fmt.reporter ()); 110 | Logs.set_level (Some Logs.Error); *) 111 | exit (Cmdliner.Cmd.eval cmd) 112 | -------------------------------------------------------------------------------- /vendor/letsencrypt/src/hTTP_client.ml: -------------------------------------------------------------------------------- 1 | module type S = sig 2 | type ctx 3 | (** Type of the user-defined {i context}. 4 | 5 | The context is an user-defined value which can be passed to your HTTP 6 | client implementation to be able to tweak some internal details about the 7 | underlying request/connection used to get an HTTP response. 8 | 9 | For instance, an HTTP implementation can optionally require some value 10 | such as the internal buffer size or a time-out value, etc. The interface 11 | wants to {b allow} the implementer to pass such information via the [ctx] 12 | type. 13 | 14 | In others words, anything optionnaly needed to initiate/do the HTTP 15 | request and that is not described over this interface (by arguments, 16 | types, etc.) can be passed via the user-defined [ctx] type. 17 | 18 | For instance, MirageOS uses this [ctx] as a ressource allocator to 19 | initiate a TCP/IP connection or a TLS connection - and, by this way, 20 | it fully abstracts the HTTP client implementation over the TCP/IP and 21 | the TLS stack (for more details, see [mimic]). 22 | 23 | Of course, [ctx = unit] if you don't need to pass extra-information when 24 | you want to do an HTTP request/connection. *) 25 | 26 | module Headers : sig 27 | type t 28 | (** The type of HTTP headers. *) 29 | 30 | val add : t -> string -> string -> t 31 | (** [add hdrs key value] adds a [key] and a [value] to an existing 32 | [hdrs] headers. *) 33 | 34 | val get : t -> string -> string option 35 | (** [get hdrs key] retrieves a [key] from the given [hdrs] headers. If the 36 | header is one of the set of headers defined to have list values, then 37 | all of the values are concatenated into a single string separated by 38 | commas and returned. If it is a singleton header, then the first value 39 | is returned and no concatenation is performed. *) 40 | 41 | val get_location : t -> Uri.t option 42 | (** [get_location hdrs] is [get hdrs "location"]. *) 43 | 44 | val init_with : string -> string -> t 45 | (** [init_with key value] constructs a fresh map of HTTP headers with a 46 | single key and value entry. *) 47 | 48 | (** / *) 49 | 50 | val to_string : t -> string 51 | end 52 | 53 | module Body : sig 54 | type t 55 | (** The type of HTTP body. *) 56 | 57 | val of_string : string -> t 58 | (** [of_string str] makes a body from the given [string] [str]. *) 59 | 60 | val to_string : t -> string 61 | (** [to_string body] returns the full given [body] as a [string]. *) 62 | end 63 | 64 | module Response : sig 65 | type t 66 | (** The type of HTTP response. *) 67 | 68 | val status : t -> int 69 | (** [status resp] is the HTTP status code of the response [resp]. *) 70 | 71 | val headers : t -> Headers.t 72 | (** [headers resp] is headers of the response [resp]. *) 73 | end 74 | 75 | val head : 76 | ?ctx:ctx -> ?headers:Headers.t -> Uri.t -> Response.t 77 | (** [head ?ctx ?headers uri] sends an {i HEAD} HTTP request to the given 78 | [uri] and returns its response. The returned response does not have 79 | a {i body} according to the HTTP standard. *) 80 | 81 | val get : 82 | ?ctx:ctx -> 83 | ?headers:Headers.t -> 84 | Uri.t -> 85 | (Response.t * Body.t) 86 | (** [get ?ctx ?headers uri] sends an {i GET} HTTP request to the given 87 | [uri] and returns its response with its body. *) 88 | 89 | val post : 90 | ?ctx:ctx -> 91 | ?body:Body.t -> 92 | ?chunked:bool -> 93 | ?headers:Headers.t -> 94 | Uri.t -> 95 | (Response.t * Body.t) 96 | (** [post ?ctx ?body ?chunked ?headers uri] sends an {i POST} HTTP request 97 | with the optional given [body] using chunked encoding if [chunked] is 98 | [true] (default to [false]). It returns a response and a body. *) 99 | end 100 | -------------------------------------------------------------------------------- /vendor/dns/zone/dns_zone_lexer.mll: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2006 Tim Deegan 3 | * Copyright (c) 2010-12 Anil Madhavapeddy 4 | * Copyright (c) 2017, 2018 Hannes Mehnert 5 | * 6 | * Permission to use, copy, modify, and distribute this software for any 7 | * purpose with or without fee is hereby granted, provided that the above 8 | * copyright notice and this permission notice appear in all copies. 9 | * 10 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 | * 18 | * dnslexer.mll -- ocamllex lexer for DNS "Master zone file" format 19 | * 20 | * DNS master zonefile format is defined in RFC 1035, section 5. 21 | * Escapes and octets are clarified in RFC 4343 22 | *) 23 | 24 | { 25 | 26 | open Dns_zone_state 27 | open Dns_zone_parser 28 | open Lexing 29 | 30 | (* Disambiguate keywords and generic character strings -- when updating this, 31 | please ensure to update the keyword_or_number rule in dns_zone_parser.mly 32 | and add it to the testuite in test/server.ml *) 33 | let kw_or_cs s = match (String.uppercase_ascii s) with 34 | "A" -> TYPE_A s 35 | | "NS" -> TYPE_NS s 36 | | "CNAME" -> TYPE_CNAME s 37 | | "SOA" -> TYPE_SOA s 38 | | "PTR" -> TYPE_PTR s 39 | | "MX" -> TYPE_MX s 40 | | "TXT" -> TYPE_TXT s 41 | | "AAAA" -> TYPE_AAAA s 42 | | "SRV" -> TYPE_SRV s 43 | | "DNSKEY" -> TYPE_DNSKEY s 44 | | "CAA" -> TYPE_CAA s 45 | | "TLSA" -> TYPE_TLSA s 46 | | "SSHFP" -> TYPE_SSHFP s 47 | | "DS" -> TYPE_DS s 48 | | "LOC" -> TYPE_LOC s 49 | | "IN" -> CLASS_IN s 50 | | "CS" -> CLASS_CS s 51 | | "CH" -> CLASS_CH s 52 | | "HS" -> CLASS_HS s 53 | | "N" -> LAT_DIR s 54 | | "S" -> LAT_DIR s 55 | | "E" -> LONG_DIR s 56 | | "W" -> LONG_DIR s 57 | | _ -> CHARSTRING s 58 | 59 | (* Scan an accepted token for linebreaks *) 60 | let count_linebreaks s = 61 | String.iter (function '\n' -> state.lineno <- state.lineno + 1 | _ -> ()) s 62 | 63 | } 64 | 65 | let eol = [' ''\t']* (';' [^'\n']*)? '\n' 66 | let octet = '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] 67 | let escape = '\\' _ (* Strictly \0 is not an escape, but be liberal *) 68 | let qstring = '"' ((([^'\\''"']|octet|escape)*) as contents) '"' 69 | let label = (([^'\\'' ''\t''\n''.''('')']|octet|escape)*) as contents 70 | let number = (['0'-'9']+) as contents 71 | let neg_number = ('-' ['0'-'9']+) as contents 72 | let meters = ('-'? ['0'-'9']+ ('.' ['0'-'9']? ['0'-'9']?)? as contents) 'm' 73 | let openpar = [' ''\t']* '(' ([' ''\t''\n'] | eol)* 74 | let closepar = (eol | [' ''\t''\n'])* ')' [' ''\t']* 75 | let typefoo = (['T''t']['Y''y']['P''p']['E''e'] number) as contents 76 | rule token = parse 77 | eol { state.lineno <- state.lineno + 1; 78 | if state.paren > 0 then SPACE else EOL } 79 | | openpar { state.paren <- state.paren + 1; 80 | count_linebreaks (lexeme lexbuf); SPACE } 81 | | closepar { if state.paren > 0 then state.paren <- state.paren - 1; 82 | count_linebreaks (lexeme lexbuf); SPACE } 83 | | closepar eol { if state.paren > 0 then state.paren <- state.paren - 1; 84 | count_linebreaks (lexeme lexbuf); EOL } 85 | | "\\#" { GENERIC } 86 | | "$ORIGIN" { SORIGIN } 87 | | "$TTL" { STTL } 88 | | '.' { DOT } 89 | | '@' { AT } 90 | | number { NUMBER contents } 91 | | neg_number { NEG_NUMBER contents } 92 | | meters { METERS contents } 93 | | typefoo { TYPE_GENERIC contents } 94 | | qstring { count_linebreaks contents; CHARSTRING contents } 95 | | label { count_linebreaks contents; kw_or_cs contents } 96 | | [' ''\t']+ { SPACE } 97 | | eof { EOF } 98 | --------------------------------------------------------------------------------