/- *dns !: :: :: moves and state :: => |% +$ move (pair bone card) +$ poke $% [%dns-command command] :: XX find some other notification channel? :: [%helm-send-hi ship (unit tape)] == +$ card $% [%hiss wire [~ ~] %httr %hiss hiss:eyre] [%poke wire dock poke] [%rule wire %turf %put turf] [%wait wire @da] == :: +state: complete app state :: +$ state $: :: dom: the set of our bindings :: dom=(set turf) :: per: per-dependent ips &c :: per=(map ship relay) :: nem: authoritative state :: nem=(unit nameserver) == -- :: :: helpers :: => |% :: +join: dedup with :acme :: ++ join |= [sep=@t hot=(list @t)] ^- @t ?> ?=(^ hot) %+ rap 3 |- ^- (list @t) ?~ t.hot hot [i.hot sep $(hot t.hot)] :: +name: fully-qualified domain name :: ++ name |= [him=ship dom=turf] (cat 3 (join '.' [(crip +:(scow %p him)) (flop dom)]) '.') :: +endpoint: append path to purl :: ++ endpoint |= [bas=purl:eyre pat=path] ^+ bas bas(q.q (weld q.q.bas pat)) :: +reserved: check if an ipv4 address is in a reserved range :: ++ reserved |= a=@if ^- ? =/ b (flop (rip 3 a)) :: 0.0.0.0/8 (software) :: ?. ?=([@ @ @ @ ~] b) & ?| :: 10.0.0.0/8 (private) :: =(10 i.b) :: 100.64.0.0/10 (carrier-grade NAT) :: &(=(100 i.b) (gte i.t.b 64) (lte i.t.b 127)) :: 127.0.0.0/8 (localhost) :: =(127 i.b) :: 169.254.0.0/16 (link-local) :: &(=(169 i.b) =(254 i.t.b)) :: 172.16.0.0/12 (private) :: &(=(172 i.b) (gte i.t.b 16) (lte i.t.b 31)) :: 192.0.0.0/24 (protocol assignment) :: &(=(192 i.b) =(0 i.t.b) =(0 i.t.t.b)) :: 192.0.2.0/24 (documentation) :: &(=(192 i.b) =(0 i.t.b) =(2 i.t.t.b)) :: 192.18.0.0/15 (reserved, benchmark) :: &(=(192 i.b) |(=(18 i.t.b) =(19 i.t.b))) :: 192.51.100.0/24 (documentation) :: &(=(192 i.b) =(51 i.t.b) =(100 i.t.t.b)) :: 192.88.99.0/24 (reserved, ex-anycast) :: &(=(192 i.b) =(88 i.t.b) =(99 i.t.t.b)) :: 192.168.0.0/16 (private) :: &(=(192 i.b) =(168 i.t.b)) :: 203.0.113/24 (documentation) :: &(=(203 i.b) =(0 i.t.b) =(113 i.t.t.b)) :: 224.0.0.0/8 (multicast) :: 240.0.0.0/4 (reserved, future) :: 255.255.255.255/32 (broadcast) :: (gte i.b 224) == -- :: :: service providers :: => |% :: |gcloud: provider-specific functions :: ++ gcloud |_ aut=authority :: +base: provider service endpoint :: ++ base (need (de-purl:html 'https://www.googleapis.com/dns/v1/projects')) :: +record: JSON-formatted provider-specific dns record :: ++ record |= [him=ship tar=target] ^- json :: ?> ?=([%gcloud *] pro.aut) =+ ^- [typ=cord dat=cord] ?: ?=(%direct -.tar) ['A' (crip +:(scow %if p.tar))] ['CNAME' (name p.tar dom.aut)] :- %o %- my :~ name+s+(name him dom.aut) type+s+typ :: XX make configureable? ttl+n+~.300 rrdatas+a+[s+dat ~] == :: +request: provider-specific record-creation request :: ++ request =, eyre |= [him=ship tar=target pre=(unit target)] ^- hiss :: ?> ?=([%gcloud *] pro.aut) =/ url=purl %+ endpoint base /[project.pro.aut]/['managedZones']/[zone.pro.aut]/changes =/ hed=math (my content-type+['application/json' ~] ~) =/ bod=octs %- as-octt:mimes:html %- en-json:html :- %o %- my :- additions+a+[(record him tar) ~] ?~ pre ~ [deletions+a+[(record him u.pre) ~] ~] [url %post hed `bod] -- -- :: :: the app itself :: |_ [bow=bowl:gall state] :: +this: is sparta :: ++ this . :: +poke-noun: debugging :: ++ poke-noun |= a=* ^- (quip move _this) ~& +<+:this [~ this] :: +sigh-httr: accept http response :: ++ sigh-httr |= [wir=wire rep=httr:eyre] ^- (quip move _this) :: at least two segments in every wire :: ?. ?=([@ @ *] wir) ~& [%strange-http-response wire=wir response=rep] [~ this] ?+ i.wir :: print and ignore unrecognized responses :: ~& +< [~ this] :: responses for a nameserver :: %authority ?~ nem ~& [%strange-authority wire=wir response=rep] [~ this] ?+ i.t.wir !! :: response confirming a valid nameserver config :: XX attempt to download existing ship.domain bindings for a breach? :: %confirm ?. =(200 p.rep) ~& [%authority-confirm-fail rep] [~ this(nem ~)] :: XX anything to do here? parse body? :: [~ this] :: response to a binding creation request :: %create ?> ?=([@ %for @ ~] t.t.wir) ?. =(200 p.rep) :: XX set a retry timeout? :: ~& [%authority-create-fail wire=wir response=rep] [~ this] =/ him=ship (slav %p i.t.t.wir) =/ for=ship (slav %p i.t.t.t.t.wir) abet:(~(confirm bind u.nem) for him) == :: responses for a relay validating a binding target :: %check =/ him=ship (slav %p i.t.wir) ?: =(200 p.rep) abet:bind:(tell him) :: cttp timeout :: XX backoff, refactor :: ?: =(504 p.rep) :_ this :_ ~ [ost.bow %wait wir (add now.bow ~m10)] :: XX specific messages per status code :: ~& %direct-confirm-fail abet:(fail:(tell him) %failed-request) :: responses for a relay validating an established binding :: %check-bond =/ him=ship (slav %p i.t.wir) ?: =(200 p.rep) abet:bake:(tell him) :: XX backoff, refactor :: :_ this :_ ~ [ost.bow %wait wir (add now.bow ~m5)] == :: +sigh-tang: failed to make http request :: ++ sigh-tang |= [wir=wire saw=tang] ^- (quip move _this) ~& [%sigh-tang wir] ?+ wir [((slog saw) ~) this] :: [%authority %confirm ~] ~& %authority-confirm-fail [((slog saw) ~) this(nem ~)] :: [%check @ ~] ~& %direct-confirm-fail =/ him=ship (slav %p i.t.wir) %- (slog saw) abet:(fail:(tell him) %crash) :: [%check-bond @ ~] ~& check-bond-fail+wir :: XX backoff, refactor :: :_ this :_ ~ [ost.bow %wait wir (add now.bow ~m10)] == :: +wake: timer callback :: ++ wake |= [wir=wire ~] ^- (quip move _this) ?+ wir ~& [%strange-wake wir] [~ this] :: [%check @ ~] =/ him=ship (slav %p i.t.wir) abet:check:(tell him) :: [%check-bond @ ~] =/ him=ship (slav %p i.t.wir) abet:recheck-bond:(tell him) == :: +poke-dns-command: act on command :: ++ poke-dns-command |= com=command ^- (quip move _this) ?- -.com :: configure self as an authority :: :: [%authority authority] :: %authority ~| %authority-reset-wat-do ?< ?=(^ nem) ~! com abet:(init:bind aut.com) :: create binding (if authority) and forward request :: :: [%bind for=ship him=ship target] :: %bind ~& [%bind src=src.bow +<.$] =/ rac (clan:title him.com) ?: ?=(%czar rac) ~|(%bind-galazy !!) ?: ?& ?=(%king rac) ?=(%indirect -.tar.com) == ~|(%bind-indirect-star !!) :: always forward, there may be multiple authorities :: =^ zom=(list move) ..this abet:(forward:(tell him.com) [for tar]:com) =^ zam=(list move) ..this ?~ nem [~ this] abet:(~(create bind u.nem) [for him tar]:com) [(weld zom zam) this] :: process established dns binding :: :: [%bond for=ship him=ship turf] :: %bond ?: ?& =(our.bow for.com) !=(our.bow src.bow) == ~& [%bound-him him.com dom.com] abet:(check-bond:(tell him.com) dom.com) ?: =(our.bow him.com) ~& [%bound-us dom.com] :- [[ost.bow %rule /bound %turf %put dom.com] ~] this(dom (~(put in dom) dom.com)) ~& [%strange-bond com] [~ this] :: manually set our ip, request direct binding :: :: [%ip %if addr=@if] :: %ip ?. =(our.bow src.bow) ~& %dns-ip-no-foreign [~ this] abet:(hear:(tell our.bow) `addr.com) :: meet sponsee, request indirect binding :: :: [%meet him=ship] :: %meet ?. =(our.bow (sein:title our.bow now.bow him.com)) ~& %dns-meet-not-sponsored [~ this] abet:(hear:(tell him.com) ~) == :: +coup: general poke acknowledgement or error :: ++ coup |= [wir=wire saw=(unit tang)] ?~ saw [~ this] ~& [%coup-fallthru wir] [((slog u.saw) ~) this] :: +prep: adapt state :: :: ++ prep _[~ this] ++ prep |= old=(unit state) ^- (quip move _this) ?^ old [~ this(+<+ u.old)] :: XX print :dns|ip config instructions for stars? :: [~ this] :: |bind: acting as zone authority :: ++ bind =| moz=(list move) |_ nam=nameserver ++ this . :: +abet: finalize state changes, produce moves :: ++ abet ^- (quip move _^this) [(flop moz) ^this(nem `nam)] :: +emit: emit a move :: ++ emit |= car=card ^+ this this(moz [[ost.bow car] moz]) :: +init: establish zone authority (request confirmation) :: ++ init |= aut=authority :: ?> ?=(%gcloud pro.aut) =/ wir=wire /authority/confirm =/ url=purl:eyre %+ endpoint base:gcloud /[project.pro.aut]/['managedZones']/[zone.pro.aut] ~& url %- emit(nam [aut ~ ~]) [%hiss wir [~ ~] %httr %hiss url %get ~ ~] :: +create: bind :him, on behalf of :for :: ++ create |= [for=ship him=ship tar=target] :: XX defer %indirect where target isn't yet bound :: ?> ?| ?=(%direct -.tar) (~(has by bon.nam) p.tar) == :: ignore if binding is pending :: =/ pending (~(get by pen.nam) him) ?: ?& ?=(^ pending) =(tar u.pending) == this :: re-notify if binding already exists :: :: XX deduplicate with +confirm :: =/ existing (~(get by bon.nam) him) ?: ?& ?=(^ existing) =(tar cur.u.existing) == =/ wir=wire /bound/(scot %p him)/for/(scot %p for) =/ dom=turf (weld dom.aut.nam /(crip +:(scow %p him))) %- emit [%poke wir [for dap.bow] %dns-command %bond for him dom] :: create new or replace existing binding :: =/ wir=wire /authority/create/(scot %p him)/for/(scot %p for) =/ pre=(unit target) =/ bon=(unit bound) (~(get by bon.nam) him) ?~(bon ~ `cur.u.bon) :: ?> ?=(%gcloud pro.aut.nam) =/ req=hiss:eyre (~(request gcloud aut.nam) him tar pre) %- emit(pen.nam (~(put by pen.nam) him tar)) :: XX save for [%hiss wir [~ ~] %httr %hiss req] :: +confirm: successfully bound :: ++ confirm |= [for=ship him=ship] =/ tar=target (~(got by pen.nam) him) =/ bon=(unit bound) (~(get by bon.nam) him) =/ nob=bound [now.bow tar ?~(bon ~ [[wen.u.bon cur.u.bon] hit.u.bon])] =. pen.nam (~(del by pen.nam) him) =. bon.nam (~(put by bon.nam) him nob) =/ wir=wire /bound/(scot %p him)/for/(scot %p for) =/ dom=turf (weld dom.aut.nam /(crip +:(scow %p him))) %- emit [%poke wir [for dap.bow] %dns-command %bond for him dom] -- :: |tell: acting as planet parent or relay :: ++ tell |= him=ship =| moz=(list move) =/ rel=(unit relay) (~(get by per) him) |% ++ this . :: +abet: finalize state changes, produce moves :: ++ abet ^- (quip move _^this) :- (flop moz) =? per ?=(^ rel) (~(put by per) him u.rel) ^this :: +emit: emit a move :: ++ emit |= car=card ^+ this this(moz [[ost.bow car] moz]) :: +hear: hear ip address, maybe emit binding request :: ++ hear |= addr=(unit @if) ^+ this =/ tar=target ?: |(?=(~ addr) ?=(%duke (clan:title him))) [%indirect our.bow] [%direct %if u.addr] :: re-notify if binding already exists :: :: XX deduplicate with +confirm :: ?: ?& ?=(^ rel) ?=(^ dom.u.rel) =(tar tar.u.rel) == =/ wir=wire /bound/(scot %p him)/for/(scot %p our.bow) %- emit [%poke wir [him dap.bow] %dns-command %bond our.bow him u.dom.u.rel] :: check binding target validity, store and forward :: =. rel `[wen=now.bow addr dom=~ try=0 tar] ?:(?=(%indirect -.tar) bind check) :: +check: confirm %direct target is accessible :: ++ check ^+ this ?> ?=(^ rel) ?> ?=(%direct -.tar.u.rel) ?: (reserved p.tar.u.rel) (fail %reserved-ip) ?: (gth try.u.rel 2) (fail %unreachable) =. try.u.rel +(try.u.rel) =/ wir=wire /check/(scot %p him) =/ url=purl:eyre :- [sec=| por=~ host=[%| `@if`p.tar.u.rel]] [[ext=`~.umd path=/static] query=~] :: XX state mgmt :: %- emit [%hiss wir [~ ~] %httr %hiss url %get ~ ~] :: +fail: %direct target is invalid or inaccessible :: ++ fail |= err=@tas ^+ this ?> ?=(^ rel) ~& [%fail err him tar.u.rel] =/ wir=wire /fail/(scot %p him) =/ msg=tape ?+ err "dns binding failed" :: %reserved-ip ?> ?=(%direct -.tar.u.rel) "unable to create dns binding reserved address {(scow %if p.tar.u.rel)}" == :: XX state mgmt :: %- emit [%poke wir [our.bow %hood] %helm-send-hi him `msg] :: +bind: request binding for target :: :: Since we may be an authority, we poke ourselves. :: ++ bind ^+ this ?> ?=(^ rel) :: XX state mgmt =/ wir=wire /bind/(scot %p him)/for/(scot %p our.bow) %- emit [%poke wir [our.bow dap.bow] %dns-command %bind our.bow him tar.u.rel] :: +check-bond: confirm binding propagation :: ++ check-bond |= dom=turf ^+ this ?> ?=(^ rel) =/ wir=wire /check-bond/(scot %p him) =/ url=purl:eyre :- [sec=| por=~ host=[%& dom]] [[ext=`~.umd path=/static] query=~] :: XX track bound-state per-domain :: %- emit(dom.u.rel `dom) [%hiss wir [~ ~] %httr %hiss url %get ~ ~] :: +recheck-bond: re-attempt to confirm binding propagation :: ++ recheck-bond ^+ this ?> ?& ?=(^ rel) ?=(^ dom.u.rel) == (check-bond u.dom.u.rel) :: +bake: successfully bound :: ++ bake ^+ this ?> ?=(^ rel) ?> ?=(^ dom.u.rel) ~& [%bake u.dom.u.rel] =/ wir=wire /forward/bound/(scot %p him)/for/(scot %p our.bow) :: XX state mgmt :: %- emit [%poke wir [him dap.bow] %dns-command %bond our.bow him u.dom.u.rel] :: +forward: sending binding request up the network :: ++ forward |= [for=ship tar=target] ~& [%forward tar] ^+ this ?: ?=(%~zod our.bow) :: ~zod don't forward ~& [%zod-no-forward him tar] this =/ to=ship ?- (clan:title our.bow) %czar ~zod * (sein:title [our now our]:bow) == =/ wir=wire /forward/bind/(scot %p him)/for/(scot %p for) %- emit :: XX for [%poke wir [to dap.bow] %dns-command %bind for him tar] -- --