├── .cirrus.yml ├── README.md ├── config.ml └── unikernel.ml /.cirrus.yml: -------------------------------------------------------------------------------- 1 | freebsd_instance: 2 | image_family: freebsd-14-2 3 | 4 | freebsd_task: 5 | pkg_install_script: pkg install -y ocaml-opam gmake bash 6 | ocaml_script: opam init -a --comp=4.14.2 7 | mirage_script: eval `opam env` && opam install --confirm-level=unsafe-yes "mirage>=4.9.0" 8 | configure_script: eval `opam env` && mirage configure -t hvt 9 | depend_script: eval `opam env` && gmake depend 10 | build_script: eval `opam env` && gmake build 11 | letsencrypt_artifacts: 12 | path: dist/letsencrypt.hvt 13 | 14 | freebsd_monitoring_task: 15 | pkg_install_script: pkg install -y ocaml-opam gmake bash 16 | ocaml_script: opam init -a --comp=4.14.2 17 | mirage_script: eval `opam env` && opam install --confirm-level=unsafe-yes "mirage>=4.9.0" 18 | configure_script: eval `opam env` && mirage configure -t hvt --enable-monitoring 19 | depend_script: eval `opam env` && gmake depend 20 | build_script: eval `opam env` && gmake build 21 | letsencrypt_artifacts: 22 | path: dist/letsencrypt.hvt 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Let's encrypt DNS provisioning 2 | 3 | This is a MirageOS unikernel which provisions TLS certificates using 4 | [let's encrypt](https://letsencrypt.org/). It looks for certificate signing 5 | requests, stored as TLSA records in DNS zones, and uses the let's encrypt 6 | ACME DNS challenge to retrieve certificates. The certificate chain is stored 7 | in DNS as TLSA record as well. This unikernel also ensures that certificates 8 | are valid for at least two weeks. 9 | 10 | This can be used with [dns-primary-git](https://github.com/robur-coop/dns-primary-git). 11 | 12 | ## Installation from source 13 | 14 | To install this unikernel from source, you need to have 15 | [opam](https://opam.ocaml.org) (>= 2.1.0) and 16 | [ocaml](https://ocaml.org) (>= 4.08.0) installed. Also, 17 | [mirage](https://mirageos.org) is required (>= 4.5.0). Please follow the 18 | [installation instructions](https://mirageos.org/wiki/install). 19 | 20 | The following steps will clone this git repository and compile the unikernel: 21 | 22 | ```bash 23 | $ git clone https://github.com/robur-coop/dns-letsencrypt-secondary.git 24 | $ mirage configure -t 25 | $ make depend 26 | $ make build 27 | ``` 28 | 29 | ## Installing as binary 30 | 31 | Binaries are available at [Reproducible OPAM 32 | builds](https://builds.robur.coop/), see [Deploying binary MirageOS 33 | unikernels](https://hannes.robur.coop/Posts/Deploy) and [Reproducible MirageOS 34 | unikernel builds](https://hannes.robur.coop/Posts/ReproducibleOPAM) for details. 35 | 36 | ## Questions? 37 | 38 | Please open an issue if you have questions, feature requests, or comments. 39 | -------------------------------------------------------------------------------- /config.ml: -------------------------------------------------------------------------------- 1 | (* mirage >= 4.9.0 & < 4.10.0 *) 2 | (* (c) 2018 Hannes Mehnert, all rights reserved *) 3 | 4 | open Mirage 5 | 6 | let packages = 7 | [ 8 | package ~min:"0.15.2" "x509"; 9 | package "duration"; 10 | package "logs"; 11 | package ~min:"0.4.0" "letsencrypt" ; 12 | package ~min:"0.4.0" "letsencrypt-dns" ; 13 | package "dns-tsig"; 14 | package ~min:"9.1.0" "dns-certify"; 15 | package ~min:"9.1.0" ~sublibs:[ "mirage" ] "dns-server"; 16 | package ~min:"9.1.0" "dns-client-mirage"; 17 | package "randomconv"; 18 | package ~min:"0.3.0" "domain-name"; 19 | package ~min:"4.3.2" "mirage-runtime"; 20 | package "letsencrypt-mirage"; 21 | ] 22 | 23 | let client = 24 | main ~packages ~pos:__POS__ "Unikernel.Client" 25 | (stackv4v6 @-> alpn_client @-> job) 26 | 27 | let enable_monitoring = 28 | let doc = Key.Arg.info 29 | ~doc:"Enable monitoring (syslog, metrics to influx, log level, statmemprof tracing)" 30 | [ "enable-monitoring" ] 31 | in 32 | Key.(create "enable-monitoring" Arg.(flag doc)) 33 | 34 | let stack = generic_stackv4v6 default_network 35 | 36 | let alpn_client = 37 | let happy_eyeballs = generic_happy_eyeballs stack in 38 | let dns = generic_dns_client stack happy_eyeballs in 39 | let mimic = mimic_happy_eyeballs stack happy_eyeballs dns in 40 | paf_client (tcpv4v6_of_stackv4v6 stack) mimic 41 | 42 | let management_stack = 43 | if_impl 44 | (Key.value enable_monitoring) 45 | (generic_stackv4v6 ~group:"management" (netif ~group:"management" "management")) 46 | stack 47 | 48 | let name = 49 | runtime_arg ~pos:__POS__ 50 | {|let doc = Cmdliner.Arg.info ~doc:"Name of the unikernel" 51 | ~docs:Mirage_runtime.s_log [ "name" ] 52 | in 53 | Cmdliner.Arg.(value & opt string "a.ns.robur.coop" doc)|} 54 | 55 | let monitoring = 56 | let monitor = Runtime_arg.(v (monitor None)) in 57 | let connect _ modname = function 58 | | [ stack ; name ; monitor ] -> 59 | code ~pos:__POS__ 60 | "Lwt.return (match %s with\ 61 | | None -> Logs.warn (fun m -> m \"no monitor specified, not outputting statistics\")\ 62 | | Some ip -> %s.create ip ~hostname:%s %s)" 63 | monitor modname name stack 64 | | _ -> assert false 65 | in 66 | impl 67 | ~packages:[ package ~min:"0.0.6" "mirage-monitoring" ] 68 | ~runtime_args:[ name ; monitor ] 69 | ~connect "Mirage_monitoring.Make" 70 | (stackv4v6 @-> job) 71 | 72 | let syslog = 73 | let syslog = Runtime_arg.(v (syslog None)) in 74 | let connect _ modname = function 75 | | [ stack ; name ; syslog ] -> 76 | code ~pos:__POS__ 77 | "Lwt.return (match %s with\ 78 | | None -> Logs.warn (fun m -> m \"no syslog specified, dumping on stdout\")\ 79 | | Some ip -> Logs.set_reporter (%s.create %s ip ~hostname:%s ()))" 80 | syslog modname stack name 81 | | _ -> assert false 82 | in 83 | impl 84 | ~packages:[ package ~sublibs:["mirage"] ~min:"0.5.0" "logs-syslog" ] 85 | ~runtime_args:[ name ; syslog ] 86 | ~connect "Logs_syslog_mirage.Udp" 87 | (stackv4v6 @-> job) 88 | 89 | let optional_monitoring stack = 90 | if_impl (Key.value enable_monitoring) 91 | (monitoring $ stack) 92 | noop 93 | 94 | let optional_syslog stack = 95 | if_impl (Key.value enable_monitoring) 96 | (syslog $ stack) 97 | noop 98 | 99 | let () = 100 | register "letsencrypt" 101 | [ 102 | optional_syslog management_stack ; 103 | optional_monitoring management_stack ; 104 | client $ stack $ alpn_client 105 | ] 106 | -------------------------------------------------------------------------------- /unikernel.ml: -------------------------------------------------------------------------------- 1 | (* (c) 2018 Hannes Mehnert, all rights reserved *) 2 | 3 | module K = struct 4 | open Cmdliner 5 | 6 | let key = 7 | Arg.conv ~docv:"HOST:HASH:DATA" 8 | Dns.Dnskey.(name_key_of_string, 9 | (fun ppf v -> Fmt.string ppf (name_key_to_string v))) 10 | 11 | let ip = 12 | Arg.conv ~docv:"IP" (Ipaddr.of_string, Ipaddr.pp) 13 | 14 | let dns_key = 15 | let doc = Arg.info ~doc:"nsupdate key (name:type:value,...)" ["dns-key"] in 16 | Mirage_runtime.register_arg Arg.(required & opt (some key) None doc) 17 | 18 | let dns_server = 19 | let doc = Arg.info ~doc:"dns server IP" ["dns-server"] in 20 | Mirage_runtime.register_arg Arg.(required & opt (some ip) None doc) 21 | 22 | let port = 23 | let doc = Arg.info ~doc:"dns server port" ["port"] in 24 | Mirage_runtime.register_arg Arg.(value & opt int 53 doc) 25 | 26 | let production = 27 | let doc = Arg.info ~doc:"Use the production let's encrypt servers" ["production"] in 28 | Mirage_runtime.register_arg Arg.(value & flag doc) 29 | 30 | let account_key_seed = 31 | let doc = Arg.info ~doc:"account key seed" ["account-key-seed"] in 32 | Mirage_runtime.register_arg Arg.(required & opt (some string) None doc) 33 | 34 | let account_key_type = 35 | let doc = Arg.info ~doc:"account key type" ["account-key-type"] in 36 | Mirage_runtime.register_arg Arg.(value & opt (enum X509.Key_type.strings) `RSA doc) 37 | 38 | let account_bits = 39 | let doc = Arg.info ~doc:"account public key bits" ["account-bits"] in 40 | Mirage_runtime.register_arg Arg.(value & opt int 4096 doc) 41 | 42 | let email = 43 | let doc = Arg.info ~doc:"Contact eMail address for let's encrypt" ["email"] in 44 | Mirage_runtime.register_arg Arg.(value & opt (some string) None doc) 45 | end 46 | 47 | open Lwt.Infix 48 | 49 | open Dns 50 | 51 | let err_to_exit ~prefix = function 52 | | Ok x -> x 53 | | Error `Msg msg -> 54 | Logs.err (fun m -> m "error in %s: %s" prefix msg); 55 | exit Mirage_runtime.argument_error 56 | 57 | module Client (S : Tcpip.Stack.V4V6) (HTTP : Http_mirage_client.S) = struct 58 | module Acme = LE.Make(S) 59 | 60 | module DNS = Dns_client_mirage.Make(S) 61 | 62 | module D = Dns_mirage.Make(S) 63 | module DS = Dns_server_mirage.Make(S) 64 | 65 | let inc = 66 | let create ~f = 67 | let data : (string, int) Hashtbl.t = Hashtbl.create 7 in 68 | (fun x -> 69 | let key = f x in 70 | let cur = match Hashtbl.find_opt data key with 71 | | None -> 0 72 | | Some x -> x 73 | in 74 | Hashtbl.replace data key (succ cur)), 75 | (fun () -> 76 | let data, total = 77 | Hashtbl.fold (fun key value (acc, total) -> 78 | (Metrics.uint key value :: acc), value + total) 79 | data ([], 0) 80 | in 81 | Metrics.uint "total" total :: data) 82 | in 83 | let src = 84 | let open Metrics in 85 | let doc = "Counter metrics" in 86 | let incr, get = create ~f:Fun.id in 87 | let data thing = incr thing; Data.v (get ()) in 88 | Src.v ~doc ~tags:Metrics.Tags.[] ~data "letsencrypt" 89 | in 90 | (fun r -> Metrics.add src (fun x -> x) (fun d -> d r)) 91 | 92 | (* act as a hidden dns secondary and receive notifies, sweep through the zone for signing requests without corresponding (non-expired) certificate 93 | 94 | requires transfer and update keys 95 | 96 | on startup or when a notify is received, we fold over all TLSA records 97 | if there's a single csr and no valid and public-key matching cert get a cert from let's encrypt 98 | let's encrypt (http[s]) and dns challenge is used 99 | resulting certificate is nsupdated to primary dns 100 | 101 | Acme.initialise is done just at boottime 102 | 103 | then zone transfer and notifies is acted upon 104 | 105 | for each new tlsa record where selector = private and the content can be 106 | parsed as csr with a domain name we have keys for (or update uses the 107 | right key) 108 | *) 109 | 110 | let valid_and_matches_csr csr cert = 111 | (* parse csr, parse cert: match public keys, match validity of cert *) 112 | match 113 | X509.Signing_request.decode_der csr.Tlsa.data, 114 | X509.Certificate.decode_der cert.Tlsa.data 115 | with 116 | | Ok csr, Ok cert -> 117 | let now_plus_two_weeks = 118 | let (days, ps) = Mirage_ptime.now_d_ps () in 119 | Ptime.v (days + 14, ps) 120 | and now = Mirage_ptime.now () 121 | in 122 | if Dns_certify.cert_matches_csr ~until:now_plus_two_weeks now csr cert then 123 | None 124 | else 125 | Some csr 126 | | Ok csr, Error `Msg e -> 127 | Logs.err (fun m -> m "couldn't parse certificate %s, requesting new one" e); 128 | Some csr 129 | | Error `Msg e, _ -> 130 | Logs.err (fun m -> m "couldn't parse csr %s, nothing to see here" e) ; 131 | None 132 | 133 | let contains_csr_without_certificate name tlsas = 134 | let csrs = Rr_map.Tlsa_set.filter Dns_certify.is_csr tlsas in 135 | if Rr_map.Tlsa_set.cardinal csrs <> 1 then begin 136 | Logs.warn (fun m -> m "no or multiple signing requests found for %a (skipping)" 137 | Domain_name.pp name); 138 | None 139 | end else 140 | let csr = Rr_map.Tlsa_set.choose csrs in 141 | let certs = Rr_map.Tlsa_set.filter Dns_certify.is_certificate tlsas in 142 | match Rr_map.Tlsa_set.cardinal certs with 143 | | 0 -> 144 | Logs.warn (fun m -> m "no certificate found for %a, requesting" 145 | Domain_name.pp name); 146 | begin match X509.Signing_request.decode_der csr.Tlsa.data with 147 | | Ok csr -> Some csr 148 | | Error `Msg e -> 149 | Logs.warn (fun m -> m "couldn't parse CSR %s" e); 150 | None 151 | end 152 | | 1 -> 153 | begin 154 | let cert = Rr_map.Tlsa_set.choose certs in 155 | match valid_and_matches_csr csr cert with 156 | | None -> 157 | Logs.debug (fun m -> m "certificate already exists for signing request %a, skipping" 158 | Domain_name.pp name); 159 | None 160 | | Some csr -> 161 | Logs.warn (fun m -> m "certificate not valid or doesn't match signing request %a, requesting" 162 | Domain_name.pp name); 163 | Some csr 164 | end 165 | | _ -> 166 | Logs.err (fun m -> m "multiple certificates found for %a, skipping" 167 | Domain_name.pp name); 168 | None 169 | 170 | let mem_flight, add_flight, remove_flight = 171 | (* TODO use a map with number of attempts *) 172 | let in_flight = ref Domain_name.Set.empty in 173 | (fun x -> Domain_name.Set.mem x !in_flight), 174 | (fun n -> 175 | Logs.info (fun m -> m "adding %a to in_flight" Domain_name.pp n); 176 | in_flight := Domain_name.Set.add n !in_flight), 177 | (fun n -> 178 | Logs.info (fun m -> m "removing %a from in_flight" Domain_name.pp n); 179 | in_flight := Domain_name.Set.remove n !in_flight) 180 | 181 | let dns_pipe dns_server port = 182 | let flow = ref None in 183 | (fun stack data -> 184 | Logs.debug (fun m -> m "writing to %a" Ipaddr.pp dns_server) ; 185 | let tcp = S.tcp stack in 186 | let rec send again = 187 | match !flow with 188 | | None -> 189 | if again then 190 | S.TCP.create_connection tcp (dns_server, port) >>= function 191 | | Error e -> 192 | Logs.err (fun m -> m "failed to create connection to NS: %a" S.TCP.pp_error e) ; 193 | Lwt.return (Error (`Msg (Fmt.to_to_string S.TCP.pp_error e))) 194 | | Ok f -> flow := Some (D.of_flow f) ; send false 195 | else 196 | Lwt.return_error (`Msg "couldn't reach authoritative nameserver") 197 | | Some f -> 198 | D.send_tcp (D.flow f) (Cstruct.of_string data) >>= function 199 | | Error () -> flow := None ; send again 200 | | Ok () -> Lwt.return_ok () 201 | in 202 | send true), 203 | (fun () -> 204 | (* we expect a single reply! *) 205 | match !flow with 206 | | None -> Lwt.return_error (`Msg "no TCP flow") 207 | | Some f -> 208 | D.read_tcp f >|= function 209 | | Ok data -> Ok (Cstruct.to_string data) 210 | | Error () -> Error (`Msg "error while reading from flow")) 211 | 212 | module String_set = Set.Make(String) 213 | 214 | let request_certificate stack (keyname, keyzone, dnskey) (send_dns, recv_dns) 215 | server le ctx ~tlsa_name csr = 216 | inc "requesting certificate"; 217 | if mem_flight tlsa_name then 218 | Logs.err (fun m -> m "request with %a already in-flight" 219 | Domain_name.pp tlsa_name) 220 | else begin 221 | Logs.info (fun m -> m "running let's encrypt service for %a" 222 | Domain_name.pp tlsa_name); 223 | add_flight tlsa_name; 224 | (* request new cert in async *) 225 | Lwt.async (fun () -> 226 | let sleep n = Mirage_sleep.ns (Duration.of_sec n) in 227 | let now () = Mirage_ptime.now () in 228 | let id = Randomconv.int16 Mirage_crypto_rng.generate in 229 | let solver = Letsencrypt_dns.nsupdate ~proto:`Tcp id now (send_dns stack) ~recv:recv_dns ~zone:keyzone ~keyname dnskey in 230 | Acme.sign_certificate ~ctx solver le sleep csr >>= function 231 | | Error (`Msg e) -> 232 | Logs.err (fun m -> m "error %s while signing %a" e Domain_name.pp tlsa_name); 233 | remove_flight tlsa_name; 234 | Lwt.return_unit 235 | | Ok [] -> 236 | Logs.err (fun m -> m "received an empty certificate chain for %a" Domain_name.pp tlsa_name); 237 | remove_flight tlsa_name; 238 | Lwt.return_unit 239 | | Ok (cert::cas) -> 240 | inc "provisioned certificate"; 241 | Logs.info (fun m -> m "certificate received for %a" Domain_name.pp tlsa_name); 242 | match Dns_trie.lookup tlsa_name Rr_map.Tlsa (Dns_server.Secondary.data server) with 243 | | Error e -> 244 | Logs.err (fun m -> m "lookup error for tlsa %a: %a (expected the signing request!)" 245 | Domain_name.pp tlsa_name Dns_trie.pp_e e); 246 | remove_flight tlsa_name; 247 | Lwt.return_unit 248 | | Ok (_, tlsas) -> 249 | (* from tlsas, we need to remove the end entity certificates *) 250 | (* also potentially all CAs that are not part of cas *) 251 | (* we should add the new certificate and potentially CAs *) 252 | let ca_set = String_set.of_list (List.map X509.Certificate.encode_der cas) in 253 | let to_remove, cas_to_add = 254 | Rr_map.Tlsa_set.fold (fun tlsa (to_rm, to_add) -> 255 | if Dns_certify.is_ca_certificate tlsa then 256 | if String_set.mem tlsa.Tlsa.data to_add then 257 | to_rm, String_set.remove tlsa.Tlsa.data to_add 258 | else 259 | tlsa :: to_rm, to_add 260 | else if Dns_certify.is_certificate tlsa then 261 | tlsa :: to_rm, to_add 262 | else 263 | to_rm, to_add) 264 | tlsas ([], ca_set) 265 | in 266 | let update = 267 | let add = 268 | let tlsas = 269 | let cas = List.map Dns_certify.ca_certificate (String_set.elements cas_to_add) in 270 | Rr_map.Tlsa_set.of_list (Dns_certify.certificate cert :: cas) 271 | in 272 | Packet.Update.Add Rr_map.(B (Tlsa, (3600l, tlsas))) 273 | and remove = 274 | List.map (fun tlsa -> 275 | Packet.Update.Remove_single Rr_map.(B (Tlsa, (0l, Tlsa_set.singleton tlsa)))) 276 | to_remove 277 | in 278 | let update = Domain_name.Map.singleton tlsa_name (remove @ [ add ]) in 279 | (Domain_name.Map.empty, update) 280 | and zone = Packet.Question.create keyzone Rr_map.Soa 281 | and header = (Randomconv.int16 Mirage_crypto_rng.generate, Packet.Flags.empty) 282 | in 283 | let packet = Packet.create header zone (`Update update) in 284 | match Dns_tsig.encode_and_sign ~proto:`Tcp packet (now ()) dnskey keyname with 285 | | Error s -> 286 | remove_flight tlsa_name; 287 | Logs.err (fun m -> m "Error %a while encoding and signing %a" 288 | Dns_tsig.pp_s s Domain_name.pp tlsa_name); 289 | Lwt.return_unit 290 | | Ok (data, mac) -> 291 | send_dns stack data >>= function 292 | | Error (`Msg e) -> 293 | remove_flight tlsa_name; 294 | Logs.err (fun m -> m "error %s while sending nsupdate %a" 295 | e Domain_name.pp tlsa_name); 296 | Lwt.return_unit 297 | | Ok () -> 298 | recv_dns () >|= function 299 | | Error (`Msg e) -> 300 | remove_flight tlsa_name; 301 | Logs.err (fun m -> m "error %s while reading DNS %a" 302 | e Domain_name.pp tlsa_name) 303 | | Ok data -> 304 | remove_flight tlsa_name; 305 | match Dns_tsig.decode_and_verify (now ()) dnskey keyname ~mac data with 306 | | Error e -> 307 | Logs.err (fun m -> m "error %a while decoding nsupdate answer %a" 308 | Dns_tsig.pp_e e Domain_name.pp tlsa_name) 309 | | Ok (res, _, _) -> 310 | match Packet.reply_matches_request ~request:packet res with 311 | | Ok _ -> inc "uploaded certificate" 312 | | Error e -> 313 | (* TODO: if badtime, adjust our time (to the other time) and resend ;) *) 314 | Logs.err (fun m -> m "invalid reply %a for %a, got %a" 315 | Packet.pp_mismatch e Packet.pp packet 316 | Packet.pp res)) 317 | end 318 | 319 | let start stack http_client = 320 | let keyname, keyzone, dnskey = 321 | let keyname, dnskey = K.dns_key () in 322 | let idx = 323 | err_to_exit ~prefix:"dnskey is not an update key" 324 | (Option.to_result 325 | ~none:(`Msg "couldn't find _update label") 326 | (Domain_name.find_label keyname (function "_update" -> true | _ -> false))) 327 | in 328 | let amount = succ idx in 329 | let zone = Domain_name.(host_exn (drop_label_exn ~amount keyname)) in 330 | Logs.app (fun m -> m "using key %a for zone %a" Domain_name.pp keyname Domain_name.pp zone); 331 | keyname, zone, dnskey 332 | in 333 | let dns_state = ref 334 | (Dns_server.Secondary.create ~primary:(K.dns_server ()) ~rng:Mirage_crypto_rng.generate 335 | ~tsig_verify:Dns_tsig.verify ~tsig_sign:Dns_tsig.sign [ keyname, dnskey ]) 336 | in 337 | let account_key = 338 | err_to_exit 339 | ~prefix:"couldn't generate account key" 340 | (X509.Private_key.of_string ~bits:(K.account_bits ()) 341 | (K.account_key_type ()) (K.account_key_seed ())) 342 | in 343 | let endpoint = 344 | if K.production () then begin 345 | Logs.warn (fun m -> m "production environment - take care what you do"); 346 | Letsencrypt.letsencrypt_production_url 347 | end else begin 348 | Logs.warn (fun m -> m "staging environment - test use only"); 349 | Letsencrypt.letsencrypt_staging_url 350 | end 351 | in 352 | Acme.initialise ~ctx:http_client ~endpoint ?email:(K.email ()) account_key >>= fun r -> 353 | let le = err_to_exit ~prefix:"couldn't initialize ACME" r in 354 | Logs.info (fun m -> m "initialised lets encrypt"); 355 | let on_update ~old:_ t = 356 | inc "on update"; 357 | dns_state := t; 358 | (* what to do here? 359 | foreach TLSA record (can as well just do all for now), check whether 360 | there is a CSR without a valid certificate: if not, request a certificate *) 361 | let trie = Dns_server.Secondary.data t in 362 | Dns_trie.fold Dns.Rr_map.Tlsa trie 363 | (fun name (_, tlsas) () -> 364 | if Dns_certify.is_name name then 365 | match contains_csr_without_certificate name tlsas with 366 | | None -> Logs.debug (fun m -> m "not interesting (does not contain CSR without valid certificate) %a" Domain_name.pp name) 367 | | Some csr -> request_certificate stack 368 | (keyname, keyzone, dnskey) 369 | (dns_pipe (K.dns_server ()) (K.port ())) 370 | t le http_client ~tlsa_name:name csr 371 | else 372 | Logs.debug (fun m -> m "name not interesting %a" Domain_name.pp name)) (); 373 | Lwt.return_unit 374 | in 375 | Lwt.async (fun () -> 376 | let rec forever () = 377 | Mirage_sleep.ns (Duration.of_day 1) >>= fun () -> 378 | on_update ~old:(Dns_server.Secondary.data !dns_state) !dns_state >>= fun () -> 379 | forever () 380 | in 381 | forever ()); 382 | DS.secondary ~on_update stack !dns_state ; 383 | S.listen stack 384 | end 385 | --------------------------------------------------------------------------------