mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-01 11:33:41 +03:00
Merge pull request #1194 from urbit/de-dns
rewrites dynamic dns, disabling indirection, proxying, and automation
This commit is contained in:
Joe Bryan
GitHub
commit
74a05a7782
@ -1 +1 @@
|
||||
https://ci-piers.urbit.org/zod-e35c639b161799faad2fb55cde89c150e68b804f.tgz
|
||||
https://ci-piers.urbit.org/zod-d71780001aed3ba464d8b24f223f6bc597236718.tgz
|
||||
|
||||
@ -12,6 +12,14 @@
|
||||
::
|
||||
++ de-base64url
|
||||
~(de base64 | &)
|
||||
:: +join-turf
|
||||
::
|
||||
++ join-turf
|
||||
|= hot=(list turf)
|
||||
^- cord
|
||||
%+ rap 3
|
||||
%- (bake join ,[cord wain])
|
||||
[', ' (turn hot en-turf:html)]
|
||||
:: |octn: encode/decode unsigned atoms as big-endian octet stream
|
||||
::
|
||||
++ octn
|
||||
@ -23,7 +31,7 @@
|
||||
::
|
||||
++ body
|
||||
|%
|
||||
+$ acct [id=@t wen=@t sas=@t]
|
||||
+$ acct [wen=@t sas=@t]
|
||||
::
|
||||
+$ order
|
||||
$: exp=@t
|
||||
@ -74,7 +82,7 @@
|
||||
^- $-(json acct:body)
|
||||
:: ignoring key, contact, initialIp
|
||||
::
|
||||
(ot 'id'^no 'createdAt'^json-date 'status'^so ~)
|
||||
(ot 'createdAt'^json-date 'status'^so ~)
|
||||
:: +order: parse certificate order
|
||||
::
|
||||
++ order
|
||||
@ -457,8 +465,8 @@
|
||||
?~ rod
|
||||
:: XX shouldn't happen
|
||||
::
|
||||
(join '.' /network/arvo/(crip +:(scow %p our.bow)))
|
||||
(join ', ' (turn ~(tap in dom.u.rod) |=(a=turf (join '.' a))))
|
||||
(en-turf:html /network/arvo/(crip +:(scow %p our.bow)))
|
||||
(join-turf ~(tap in dom.u.rod))
|
||||
'. retrying in ~d7.'
|
||||
==
|
||||
(emit (notify msg ~))
|
||||
@ -474,7 +482,7 @@
|
||||
' too many certificates issued for '
|
||||
:: XX get from detail
|
||||
::
|
||||
(join '.' /network/arvo)
|
||||
(en-turf:html /network/arvo)
|
||||
'. retrying in '
|
||||
(scot %dr lul) '.'
|
||||
==
|
||||
@ -588,7 +596,7 @@
|
||||
:- %a
|
||||
%+ turn
|
||||
~(tap in ~(key by `(map turf *)`u.next-order))
|
||||
|=(a=turf [%o (my type+s+'dns' value+s+(join '.' a) ~)])
|
||||
|=(a=turf [%o (my type+s+'dns' value+s+(en-turf:html a) ~)])
|
||||
==
|
||||
=/ wire-params [try %new-order /(scot %da now.bow)]
|
||||
(stateful-request wire-params new-order.dir json)
|
||||
@ -762,7 +770,7 @@
|
||||
=/ msg=cord
|
||||
%+ rap 3
|
||||
:~ 'unable to reach ' (scot %p our.bow)
|
||||
' via http at ' (join '.' turf.i.item) ':80'
|
||||
' via http at ' (en-turf:html turf.i.item) ':80'
|
||||
==
|
||||
(emit(next-order ~) (notify msg [(sell !>(rep)) ~]))
|
||||
?: ?=(~ (skip ~(val by u.next-order) |=([@ud valid=?] valid)))
|
||||
@ -957,7 +965,7 @@
|
||||
=> =/ msg=cord
|
||||
%+ rap 3
|
||||
:~ 'received https certificate for '
|
||||
(join ', ' (turn ~(tap in dom.u.liv) |=(a=turf (join '.' a))))
|
||||
(join-turf ~(tap in dom.u.liv))
|
||||
==
|
||||
(emit (notify msg ~))
|
||||
:: set renewal timer, install certificate in %eyre
|
||||
@ -1029,7 +1037,7 @@
|
||||
=/ msg=cord
|
||||
%+ rap 3
|
||||
:~ 'unable to retrieve self-hosted domain validation token '
|
||||
'via ' (join '.' dom.aut) '. '
|
||||
'via ' (en-turf:html dom.aut) '. '
|
||||
'please confirm your urbit has network connectivity.'
|
||||
==
|
||||
(emit (notify msg [(sell !>(rep)) ~]))
|
||||
@ -1260,7 +1268,7 @@
|
||||
~& [%cert `wain`cer.u.liv]
|
||||
~& [%expires exp.u.liv]
|
||||
~& :- %domains
|
||||
(join ', ' (turn ~(tap in dom.u.liv) |=(a=turf (join '.' a))))
|
||||
(join-turf ~(tap in dom.u.liv))
|
||||
this
|
||||
::
|
||||
%dbug-history
|
||||
@ -1382,7 +1390,7 @@
|
||||
=/ msg=cord
|
||||
%+ rap 3
|
||||
:~ 'requesting an https certificate for '
|
||||
(join ', ' (turn ~(tap in dom) |=(a=turf (join '.' a))))
|
||||
(join-turf ~(tap in dom))
|
||||
==
|
||||
(emit (notify msg ~))
|
||||
:: if registered, create order
|
||||
|
||||
895
app/dns-bind.hoon
Normal file
895
app/dns-bind.hoon
Normal file
@ -0,0 +1,895 @@
|
||||
/- *dns-bind, dns, hall
|
||||
/+ tapp, stdio
|
||||
::
|
||||
:: tapp types and boilerplate
|
||||
::
|
||||
=> |%
|
||||
++ collector-app `dock`[~zod %dns-collector]
|
||||
+$ app-state
|
||||
$: %0
|
||||
:: nem: authoritative state
|
||||
::
|
||||
nem=(unit nameserver)
|
||||
==
|
||||
+$ peek-data _!!
|
||||
+$ in-poke-data
|
||||
$% [%dns-authority =authority]
|
||||
[%dns-bind =ship =target]
|
||||
[%handle-http-request =inbound-request:http-server]
|
||||
==
|
||||
+$ out-poke-data
|
||||
$% [%dns-bind =ship =target]
|
||||
[%dns-complete =ship =binding:dns]
|
||||
[%drum-unlink =dock]
|
||||
==
|
||||
+$ in-peer-data
|
||||
$% [%dns-request =request:dns]
|
||||
==
|
||||
+$ out-peer-data ~
|
||||
++ tapp
|
||||
%: ^tapp
|
||||
app-state
|
||||
peek-data
|
||||
in-poke-data
|
||||
out-poke-data
|
||||
in-peer-data
|
||||
out-peer-data
|
||||
==
|
||||
++ tapp-async tapp-async:tapp
|
||||
++ stdio (^stdio out-poke-data out-peer-data)
|
||||
--
|
||||
::
|
||||
:: oauth2 implementation
|
||||
::
|
||||
=> |%
|
||||
:: +oauth2-config: as one would expect
|
||||
::
|
||||
+$ oauth2-config
|
||||
$: auth-url=@t
|
||||
exchange-url=@t
|
||||
domain=turf
|
||||
initial-path=path
|
||||
redirect-path=path
|
||||
scopes=(list @t)
|
||||
==
|
||||
:: +oauth2: library core
|
||||
::
|
||||
++ oauth2
|
||||
|_ [our=@p now=@da config=oauth2-config code=@t =hart:eyre secrets=@t]
|
||||
::
|
||||
++ local-uri
|
||||
|= [our=ship =path]
|
||||
^- @t
|
||||
:: XX can't scry in +mule
|
||||
::
|
||||
:: =/ =hart:eyre .^(hart:eyre %r /(scot %p our)/host/real)
|
||||
(crip (en-purl:html [hart [~ path] ~]))
|
||||
::
|
||||
:: XX can't scry in +mule
|
||||
::
|
||||
:: ++ code
|
||||
:: ^- @t
|
||||
:: %- crip
|
||||
:: +:(scow %p .^(@p %j /(scot %p our)/code/(scot %da now)/(scot %p our)))
|
||||
::
|
||||
:: to initialize these values: |init-oauth2 /com/googleapis
|
||||
::
|
||||
++ oauth2-secrets
|
||||
^- [client-id=@t client-secret=@t]
|
||||
=; =wain
|
||||
?> ?=([@t @t ~] wain)
|
||||
[i.wain i.t.wain]
|
||||
::
|
||||
%- to-wain:format
|
||||
%- need
|
||||
%+ de:crub:crypto code
|
||||
%+ slav %uw
|
||||
:: XX can't scry in +mule
|
||||
::
|
||||
:: .^(@ %cx :(weld /(scot %p our)/home/(scot %da now)/sec domain.config /atom))
|
||||
secrets
|
||||
::
|
||||
++ initial-uri (local-uri our initial-path.config)
|
||||
++ redirect-uri (local-uri our redirect-path.config)
|
||||
::
|
||||
++ redirect-to-provider
|
||||
^- @t
|
||||
=/ url (need (de-purl:html auth-url.config))
|
||||
=. r.url
|
||||
:* ['access_type' 'offline']
|
||||
['response_type' 'code']
|
||||
['prompt' 'consent']
|
||||
['client_id' client-id:oauth2-secrets]
|
||||
['redirect_uri' redirect-uri]
|
||||
['scope' (rap 3 (join ' ' scopes.config))]
|
||||
r.url
|
||||
==
|
||||
(crip (en-purl:html url))
|
||||
::
|
||||
++ retrieve-access-token
|
||||
|= code=@t
|
||||
^- request:http
|
||||
=/ hed
|
||||
:~ ['Accept' 'application/json']
|
||||
['Content-Type' 'application/x-www-form-urlencoded']
|
||||
==
|
||||
=/ bod
|
||||
%- some %- as-octt:mimes:html
|
||||
%- tail %- tail:en-purl:html
|
||||
:~ ['client_id' client-id:oauth2-secrets]
|
||||
:: note: required, unused parameter
|
||||
::
|
||||
['redirect_uri' redirect-uri]
|
||||
['client_secret' client-secret:oauth2-secrets]
|
||||
['grant_type' 'authorization_code']
|
||||
['code' code]
|
||||
==
|
||||
[%'POST' exchange-url.config hed bod]
|
||||
::
|
||||
++ parse-token-response
|
||||
|= =octs
|
||||
^- (unit [access=@t expires=@u refresh=@t])
|
||||
%. q.octs
|
||||
;~ biff
|
||||
de-json:html
|
||||
=, dejs-soft:format
|
||||
(ot 'access_token'^so 'expires_in'^ni 'refresh_token'^so ~)
|
||||
==
|
||||
:: XX implement
|
||||
::
|
||||
++ refresh-token !!
|
||||
--
|
||||
--
|
||||
::
|
||||
:: helpers
|
||||
::
|
||||
=> |%
|
||||
:: +name: fully-qualified domain name for :ship
|
||||
::
|
||||
++ name
|
||||
|= [=ship =turf]
|
||||
(cat 3 (en-turf:html (weld turf /(crip +:(scow %p ship)))) '.')
|
||||
:: +lame: domain name for :ship (without trailing '.')
|
||||
::
|
||||
++ lame
|
||||
|= [=ship =turf]
|
||||
(en-turf:html (weld turf /(crip +:(scow %p ship))))
|
||||
:: +endpoint: append :path to :purl
|
||||
::
|
||||
++ endpoint
|
||||
|= [=purl:eyre =path]
|
||||
^+ purl
|
||||
purl(q.q (weld q.q.purl path))
|
||||
:: +params: append :params to :purl
|
||||
::
|
||||
++ params
|
||||
|= [=purl:eyre =quay:eyre]
|
||||
^+ purl
|
||||
purl(r (weld r.purl quay))
|
||||
:: +json-octs: deserialize json and apply reparser
|
||||
::
|
||||
++ json-octs
|
||||
|* [bod=octs wit=fist:dejs:format]
|
||||
=/ jon (de-json:html q.bod)
|
||||
?~ jon ~
|
||||
(wit u.jon)
|
||||
:: +ship-turf: parse ship from first subdomain
|
||||
::
|
||||
++ ship-turf
|
||||
|= [nam=@t aut-dom=turf]
|
||||
^- (unit ship)
|
||||
=/ dom=(unit host:eyre)
|
||||
(rush nam ;~(sfix thos:de-purl:html dot))
|
||||
?: ?| ?=(~ dom)
|
||||
?=(%| -.u.dom)
|
||||
?=(~ p.u.dom)
|
||||
==
|
||||
~
|
||||
=/ who
|
||||
(rush (head (flop p.u.dom)) fed:ag)
|
||||
?~ who ~
|
||||
?. =(aut-dom (flop (tail (flop p.u.dom))))
|
||||
~
|
||||
:: galaxies always excluded
|
||||
::
|
||||
?: ?=(%czar (clan:title u.who))
|
||||
~
|
||||
who
|
||||
--
|
||||
::
|
||||
:: service providers
|
||||
::
|
||||
=> |%
|
||||
:: +provider: initialize provider-specific core
|
||||
::
|
||||
++ provider
|
||||
|= aut=authority
|
||||
?- -.pro.aut
|
||||
%fcloud ~(. fcloud aut)
|
||||
%gcloud ~(. gcloud aut)
|
||||
==
|
||||
:: |fcloud: Cloudflare provider
|
||||
::
|
||||
++ fcloud
|
||||
=> |%
|
||||
++ parse-raw-record
|
||||
|= aut-dom=turf
|
||||
^- $- json
|
||||
(unit [=ship id=@ta tar=target])
|
||||
=, dejs:format
|
||||
%+ cu
|
||||
|= [id=@t typ=@t nam=@t dat=@t]
|
||||
^- (unit [=ship id=@ta tar=target])
|
||||
:: XX fix this
|
||||
::
|
||||
=/ him (ship-turf (cat 3 nam '.') aut-dom)
|
||||
?: ?=(~ him)
|
||||
~
|
||||
?+ typ
|
||||
~
|
||||
::
|
||||
%'A'
|
||||
=/ adr (rush dat lip:ag)
|
||||
?~ adr ~
|
||||
`[u.him `@ta`id %direct %if u.adr]
|
||||
::
|
||||
%'CNAME'
|
||||
:: XX fix this
|
||||
::
|
||||
=/ for (ship-turf (cat 3 dat '.') aut-dom)
|
||||
?~ for ~
|
||||
`[u.him `@ta`id %indirect u.for]
|
||||
==
|
||||
:: XX parse dates, proxied, ttl?
|
||||
::
|
||||
%- ot :~
|
||||
'id'^so
|
||||
'type'^so
|
||||
'name'^so
|
||||
'content'^so
|
||||
==
|
||||
--
|
||||
::
|
||||
|_ aut=authority
|
||||
:: +base: provider service endpoint
|
||||
::
|
||||
++ base
|
||||
^- purl:eyre
|
||||
(need (de-purl:html 'https://api.cloudflare.com/client/v4'))
|
||||
:: +headers: standard HTTP headers for all |fcloud requests
|
||||
::
|
||||
++ headers
|
||||
|= aut=authority
|
||||
?> ?=(%fcloud -.pro.aut)
|
||||
%- ~(gas by *math:eyre)
|
||||
:~ ['Content-Type' ['application/json' ~]]
|
||||
['X-Auth-Email' [email.auth.pro.aut ~]]
|
||||
['X-Auth-Key' [key.auth.pro.aut ~]]
|
||||
==
|
||||
:: +zone: provider-specific zone info request
|
||||
::
|
||||
++ zone
|
||||
^- hiss:eyre
|
||||
?> ?=(%fcloud -.pro.aut)
|
||||
[(endpoint base /zones/[zone.pro.aut]) %get (headers aut) ~]
|
||||
:: +record: JSON-formatted provider-specific dns record
|
||||
::
|
||||
++ record
|
||||
|= [him=ship tar=target]
|
||||
^- json
|
||||
?> ?=(%fcloud -.pro.aut)
|
||||
=/ type
|
||||
?:(?=(%direct -.tar) 'A' 'CNAME')
|
||||
=/ data
|
||||
?: ?=(%direct -.tar)
|
||||
(crip +:(scow %if p.tar))
|
||||
(lame p.tar dom.aut)
|
||||
:- %o
|
||||
%- ~(gas by *(map @t json))
|
||||
:~ ['name' %s (lame him dom.aut)]
|
||||
['type' %s type]
|
||||
['content' %s data]
|
||||
:: XX make configureable?
|
||||
::
|
||||
['ttl' %n ~.1]
|
||||
['proxied' %b %.n]
|
||||
==
|
||||
:: +create: provider-specific record-creation request
|
||||
::
|
||||
++ create
|
||||
|= [him=ship tar=target pre=(unit [id=@ta tar=target])]
|
||||
^- hiss:eyre
|
||||
?> ?=(%fcloud -.pro.aut)
|
||||
=/ bod=octs
|
||||
%- as-octt:mimes:html
|
||||
%- en-json:html
|
||||
(record him tar)
|
||||
?~ pre
|
||||
:- (endpoint base /zones/[zone.pro.aut]/['dns_records'])
|
||||
[%post (headers aut) `bod]
|
||||
:- (endpoint base /zones/[zone.pro.aut]/['dns_records']/[id.u.pre])
|
||||
[%put (headers aut) `bod]
|
||||
:: +existing: list existing records stored by provider
|
||||
::
|
||||
++ existing
|
||||
|= page=(unit @t)
|
||||
^- hiss:eyre
|
||||
?> ?=(%fcloud -.pro.aut)
|
||||
:: XX more url params:
|
||||
:: ?type ?per-page ?order ?direction
|
||||
::
|
||||
:- %+ params
|
||||
(endpoint base /zones/[zone.pro.aut]/['dns_records'])
|
||||
?~(page ~ ['page' u.page]~)
|
||||
[%get (headers aut) ~]
|
||||
:: +parse-list: existing records stored by provider
|
||||
::
|
||||
++ parse-list
|
||||
^- $- json
|
||||
(pair (list [=ship id=@ta tar=target]) (unit @t))
|
||||
?> ?=(%fcloud -.pro.aut)
|
||||
=, dejs:format
|
||||
%+ cu
|
||||
|= $: success=?
|
||||
response=(list (unit [=ship id=@ta tar=target]))
|
||||
paginate=[page=@ud per-page=@ud count=@ud total-count=@ud]
|
||||
==
|
||||
^- (pair (list [=ship id=@ta tar=target]) (unit @t))
|
||||
?. success [~ ~]
|
||||
:- (murn response same)
|
||||
:: XX calculate next page number if applicable
|
||||
::
|
||||
~
|
||||
:: XX parse errors and messages?
|
||||
::
|
||||
%- ot :~
|
||||
'success'^bo
|
||||
'result'^(ar (parse-raw-record dom.aut))
|
||||
:- 'result_info'
|
||||
%- ot :~
|
||||
'page'^ni
|
||||
'per_page'^ni
|
||||
'count'^ni
|
||||
'total_count'^ni
|
||||
==
|
||||
==
|
||||
:: +parse-record: single record stored by provider
|
||||
::
|
||||
++ parse-record
|
||||
^- $- json
|
||||
(unit [=ship id=@ta tar=target])
|
||||
?> ?=(%fcloud -.pro.aut)
|
||||
=, dejs:format
|
||||
%+ cu
|
||||
|= [success=? response=(unit [=ship id=@ta tar=target])]
|
||||
^- (unit [=ship id=@ta tar=target])
|
||||
?. success ~
|
||||
response
|
||||
:: XX parse errors and messages?
|
||||
::
|
||||
%- ot :~
|
||||
'success'^bo
|
||||
'result'^(parse-raw-record dom.aut)
|
||||
==
|
||||
--
|
||||
:: |gcloud: GCP provider
|
||||
::
|
||||
++ gcloud
|
||||
|_ aut=authority
|
||||
:: +base: provider service endpoint
|
||||
::
|
||||
++ base
|
||||
^- purl:eyre
|
||||
(need (de-purl:html 'https://www.googleapis.com/dns/v1/projects'))
|
||||
:: +headers: standard HTTP headers for all |gcloud requests
|
||||
::
|
||||
++ headers
|
||||
|= aut=authority
|
||||
?> ?=(%gcloud -.pro.aut)
|
||||
?. ?=(^ auth.pro.aut)
|
||||
~| %gcloud-missing-auth !!
|
||||
%- ~(gas by *math:eyre)
|
||||
:~ ['Content-Type' ['application/json' ~]]
|
||||
['Authorization' [`@t`(cat 3 'Bearer ' access.u.auth.pro.aut) ~]]
|
||||
==
|
||||
:: +zone: provider-specific zone info request
|
||||
::
|
||||
++ zone
|
||||
^- hiss:eyre
|
||||
?> ?=(%gcloud -.pro.aut)
|
||||
:- (endpoint base /[project.pro.aut]/['managedZones']/[zone.pro.aut])
|
||||
[%get (headers aut) ~]
|
||||
:: +record: JSON-formatted provider-specific dns record
|
||||
::
|
||||
++ record
|
||||
|= [him=ship tar=target]
|
||||
^- json
|
||||
?> ?=(%gcloud -.pro.aut)
|
||||
=/ type
|
||||
?:(?=(%direct -.tar) 'A' 'CNAME')
|
||||
=/ data
|
||||
?: ?=(%direct -.tar)
|
||||
[%s (crip +:(scow %if p.tar))]
|
||||
[%s (name p.tar dom.aut)]
|
||||
:- %o
|
||||
%- ~(gas by *(map @t json))
|
||||
:~ ['name' %s (name him dom.aut)]
|
||||
['type' %s type]
|
||||
:: XX make configureable?
|
||||
::
|
||||
['ttl' %n ~.300]
|
||||
['rrdatas' %a data ~]
|
||||
==
|
||||
:: +create: provider-specific record-creation request
|
||||
::
|
||||
++ create
|
||||
=, eyre
|
||||
|= [him=ship tar=target pre=(unit [id=@ta tar=target])]
|
||||
^- hiss
|
||||
?> ?=(%gcloud -.pro.aut)
|
||||
=/ url=purl
|
||||
%+ endpoint base
|
||||
/[project.pro.aut]/['managedZones']/[zone.pro.aut]/changes
|
||||
=/ bod=octs
|
||||
%- as-octt:mimes:html
|
||||
%- en-json:html
|
||||
:- %o
|
||||
%- ~(gas by *(map @t json))
|
||||
:- ['additions' %a (record him tar) ~]
|
||||
?~ pre ~
|
||||
[['deletions' %a (record him tar.u.pre) ~] ~]
|
||||
[url %post (headers aut) `bod]
|
||||
:: +existing: list existing records stored by provider
|
||||
::
|
||||
++ existing
|
||||
=, eyre
|
||||
|= page=(unit @t)
|
||||
^- hiss
|
||||
?> ?=(%gcloud -.pro.aut)
|
||||
=/ url=purl
|
||||
%+ endpoint base
|
||||
/[project.pro.aut]/['managedZones']/[zone.pro.aut]/rrsets
|
||||
=/ hed=math (headers aut)
|
||||
=? hed ?=(^ page)
|
||||
(~(put by hed) 'pageToken' [u.page]~)
|
||||
[url %get hed ~]
|
||||
:: +parse-list: existing records stored by provider
|
||||
::
|
||||
++ parse-list
|
||||
^- $- json
|
||||
(pair (list [=ship id=@ta tar=target]) (unit @t))
|
||||
?> ?=(%gcloud -.pro.aut)
|
||||
=, dejs:format
|
||||
=> |%
|
||||
++ page (uf ~ (mu so))
|
||||
++ records
|
||||
%+ uf ~
|
||||
%+ cu
|
||||
|*(a=(list (unit)) (murn a same))
|
||||
(ar parse-record)
|
||||
--
|
||||
:: XX parse but don't produce
|
||||
:: 'kind'^(su (jest "dns#resourceRecordSetsListResponse'))
|
||||
::
|
||||
(ou 'rrsets'^records 'nextPageToken'^page ~)
|
||||
:: +parse-record: single record stored by provider
|
||||
::
|
||||
++ parse-record
|
||||
^- $- json
|
||||
(unit [=ship id=@ta tar=target])
|
||||
?> ?=(%gcloud -.pro.aut)
|
||||
=, dejs:format
|
||||
%+ cu
|
||||
|= [typ=@t nam=@t dat=(list @t)]
|
||||
^- (unit [=ship id=@ta tar=target])
|
||||
:: gcloud doesn't expose UUIDs for bindings
|
||||
::
|
||||
=/ id %$
|
||||
=/ him (ship-turf nam dom.aut)
|
||||
?: |(?=(~ him) ?=(~ dat) ?=(^ t.dat))
|
||||
~
|
||||
?+ typ
|
||||
~
|
||||
::
|
||||
%'A'
|
||||
=/ adr (rush i.dat lip:ag)
|
||||
?~ adr ~
|
||||
`[u.him id %direct %if u.adr]
|
||||
::
|
||||
%'CNAME'
|
||||
=/ for (ship-turf i.dat dom.aut)
|
||||
?~ for ~
|
||||
`[u.him id %indirect u.for]
|
||||
==
|
||||
::
|
||||
%- ot :~
|
||||
:: 'kind'^(su (jest "dns#resourceRecordSet'))
|
||||
::
|
||||
'type'^so
|
||||
'name'^so
|
||||
'rrdatas'^(ar so)
|
||||
==
|
||||
--
|
||||
--
|
||||
::
|
||||
:: monadic helpers (XX move to stdio?)
|
||||
::
|
||||
=> |%
|
||||
:: +backoff: exponential backoff timer
|
||||
::
|
||||
++ backoff
|
||||
|= [try=@ud limit=@dr]
|
||||
=/ m (async:stdio ,~)
|
||||
^- form:m
|
||||
;< eny=@uvJ bind:m get-entropy:stdio
|
||||
;< now=@da bind:m get-time:stdio
|
||||
%- wait:stdio
|
||||
%+ add now
|
||||
%+ min limit
|
||||
?: =(0 try) ~s0
|
||||
%+ add
|
||||
(mul ~s1 (bex (dec try)))
|
||||
(mul ~s0..0001 (~(rad og eny) 1.000))
|
||||
::
|
||||
++ request
|
||||
|= =hiss:eyre
|
||||
=/ m (async:stdio (unit httr:eyre))
|
||||
^- form:m
|
||||
;< ~ bind:m (send-hiss:stdio hiss)
|
||||
take-maybe-sigh:stdio
|
||||
::
|
||||
++ request-retry
|
||||
|= [=hiss:eyre max=@ud limit=@dr]
|
||||
=/ m (async:stdio (unit httr:eyre))
|
||||
=/ try=@ud 0
|
||||
|- ^- form:m
|
||||
=* loop $
|
||||
?: =(try max)
|
||||
(pure:m ~)
|
||||
;< ~ bind:m (backoff try limit)
|
||||
;< rep=(unit httr:eyre) bind:m (request hiss)
|
||||
:: XX needs a better predicate. LTE will make this easier
|
||||
::
|
||||
?: &(?=(^ rep) =(200 p.u.rep))
|
||||
(pure:m (some u.rep))
|
||||
loop(try +(try))
|
||||
--
|
||||
::
|
||||
:: application actions
|
||||
::
|
||||
=> |%
|
||||
++ confirm-authority
|
||||
|= =authority
|
||||
=/ m (async:stdio ?)
|
||||
^- form:m
|
||||
;< rep=(unit httr:eyre) bind:m
|
||||
(request-retry zone:(provider authority) 5 ~m10)
|
||||
(pure:m &(?=(^ rep) =(200 p.u.rep)))
|
||||
::
|
||||
++ retrieve-existing
|
||||
|= =authority
|
||||
=/ m (async:stdio (map ship bound))
|
||||
^- form:m
|
||||
=| existing=(map ship bound)
|
||||
=| next-page=(unit @t)
|
||||
;< now=@da bind:m get-time:stdio
|
||||
|- ^- form:m
|
||||
=* loop $
|
||||
;< rep=(unit httr:eyre) bind:m
|
||||
(request-retry (existing:(provider authority) next-page) 5 ~m10)
|
||||
?: ?| ?=(~ rep)
|
||||
?=(~ r.u.rep)
|
||||
==
|
||||
(pure:m existing)
|
||||
::
|
||||
=* octs u.r.u.rep
|
||||
=+ ^- [dat=(list [=ship id=@ta =target]) page=(unit @t)]
|
||||
:: XX gross
|
||||
::
|
||||
=- ?~(- [~ ~] -)
|
||||
(json-octs octs parse-list:(provider authority))
|
||||
=. existing
|
||||
|- ^+ existing
|
||||
?~ dat
|
||||
existing
|
||||
=/ =bound [now id.i.dat target.i.dat ~]
|
||||
$(dat t.dat, existing (~(put by existing) ship.i.dat bound))
|
||||
?~ page
|
||||
(pure:m existing)
|
||||
loop(next-page page)
|
||||
::
|
||||
++ create-binding
|
||||
|= [=authority =ship =target existing=(unit bound)]
|
||||
=/ m (async:stdio (unit bound))
|
||||
^- form:m
|
||||
?: &(?=(^ existing) =(target cur.u.existing))
|
||||
~| %bind-duplicate-wat-do !!
|
||||
::
|
||||
=/ pre=(unit [@ta ^target])
|
||||
?~(existing ~ (some [id cur]:u.existing))
|
||||
;< rep=(unit httr:eyre) bind:m
|
||||
(request (create:(provider authority) ship target pre))
|
||||
:: XX retryable?
|
||||
::
|
||||
?. &(?=(^ rep) =(200 p.u.rep))
|
||||
(pure:m ~)
|
||||
::
|
||||
=* httr u.rep
|
||||
=/ id=@ta
|
||||
?. ?=(%fcloud -.pro.authority) ~.
|
||||
?. ?=(^ r.httr)
|
||||
~| [%authority-create-confirm-id rep] !!
|
||||
=/ dat=(unit [^ship id=@ta ^target])
|
||||
(json-octs u.r.httr parse-record:(provider authority))
|
||||
?~(dat ~. id.u.dat)
|
||||
::
|
||||
=/ =address:dns
|
||||
?>(?=(%direct -.target) +.target)
|
||||
=/ =turf
|
||||
(weld dom.authority /(crip +:(scow %p ship)))
|
||||
;< ~ bind:m (poke-app:stdio collector-app [%dns-complete ship address turf])
|
||||
;< now=@da bind:m get-time:stdio
|
||||
=/ =bound
|
||||
[now id target ?~(existing ~ [[wen cur] hit]:u.existing)]
|
||||
(pure:m (some bound))
|
||||
::
|
||||
++ initialize-authority
|
||||
|= [aut=authority state=app-state]
|
||||
=/ m tapp-async
|
||||
^- form:m
|
||||
?> ?=(^ nem.state)
|
||||
=* nam u.nem.state
|
||||
;< good=? bind:m (confirm-authority aut)
|
||||
?. good
|
||||
~& %dns-authority-failed
|
||||
(pure:m state(nem ~))
|
||||
::
|
||||
:: XX wait-effect
|
||||
::
|
||||
;< existing=(map ship bound) bind:m (retrieve-existing aut)
|
||||
=. bon.nam (~(uni by bon.nam) existing)
|
||||
=. nem.state (some nam)
|
||||
::
|
||||
:: XX wait-effect
|
||||
::
|
||||
;< ~ bind:m (peer-app:stdio collector-app /requests)
|
||||
(pure:m state)
|
||||
--
|
||||
::
|
||||
:: |oauth2-core: configured oauth functionality (for |gcloud only)
|
||||
::
|
||||
=> |%
|
||||
++ oauth2-core
|
||||
|= [=bowl:gall code=@t =hart:eyre secrets=@t]
|
||||
=/ =oauth2-config
|
||||
:* auth-url='https://accounts.google.com/o/oauth2/v2/auth'
|
||||
exchange-url='https://www.googleapis.com/oauth2/v4/token'
|
||||
domain=/com/googleapis
|
||||
redirect-path=/dns/oauth
|
||||
initial-path=/dns/oauth/result
|
||||
:~ 'https://www.googleapis.com/auth/ndev.clouddns.readwrite'
|
||||
'https://www.googleapis.com/auth/cloud-platform.read-only'
|
||||
== ==
|
||||
~(. oauth2 our.bowl now.bowl oauth2-config code hart secrets)
|
||||
--
|
||||
::
|
||||
:: the app itself
|
||||
::
|
||||
=* default-tapp default-tapp:tapp
|
||||
%- create-tapp-all:tapp
|
||||
^- tapp-core-all:tapp
|
||||
|_ [=bowl:gall state=app-state]
|
||||
::
|
||||
++ handle-peek handle-peek:default-tapp
|
||||
++ handle-peer handle-peer:default-tapp
|
||||
::
|
||||
++ handle-init
|
||||
=/ m tapp-async
|
||||
^- form:m
|
||||
;< success=? bind:m (bind-route:stdio [~ /dns/oauth] dap.bowl)
|
||||
~| %dns-unable-to-bind-route
|
||||
?> success
|
||||
;< ~ bind:m (poke-app:stdio [[our %hood] [%drum-unlink our dap]]:bowl)
|
||||
(pure:m state)
|
||||
::
|
||||
++ handle-poke
|
||||
|= =in-poke-data
|
||||
=/ m tapp-async
|
||||
^- form:m
|
||||
?. (team:title [our src]:bowl)
|
||||
~| %bind-yoself !!
|
||||
?- -.in-poke-data
|
||||
::
|
||||
%dns-authority
|
||||
?. =(~ nem.state)
|
||||
~| %authority-reset-wat-do !!
|
||||
=* aut authority.in-poke-data
|
||||
=/ nam=nameserver [aut ~ ~]
|
||||
=. nem.state (some nam)
|
||||
:: XX move this into the provider interface
|
||||
::
|
||||
?: ?& ?=(%gcloud -.pro.aut)
|
||||
?=(~ auth.pro.aut)
|
||||
==
|
||||
~& %do-the-oauth-thing
|
||||
~& initial-uri:(oauth2-core bowl scry.pro.aut)
|
||||
(pure:m state)
|
||||
::
|
||||
(initialize-authority aut state)
|
||||
::
|
||||
%dns-bind
|
||||
?~ nem.state
|
||||
~| %bind-not-authority !!
|
||||
=* nam u.nem.state
|
||||
=* who ship.in-poke-data
|
||||
=* tar target.in-poke-data
|
||||
?. ?=(%indirect -.tar)
|
||||
~| %indirect-unsupported !!
|
||||
:: defer %indirect where target isn't yet bound
|
||||
::
|
||||
:: ?: ?& ?=(%indirect -.tar)
|
||||
:: !(~(has by bon.nam) p.tar)
|
||||
:: ==
|
||||
:: =. dep.nam (~(put ju dep.nam) p.tar [who tar])
|
||||
:: =. nem.state (some nam)
|
||||
:: (pure:m state)
|
||||
=/ existing (~(get by bon.nam) who)
|
||||
;< new=(unit bound) bind:m (create-binding aut.nam who tar existing)
|
||||
?~ new
|
||||
~& [%bind-failed in-poke-data]
|
||||
(pure:m state)
|
||||
=. bon.nam (~(put by bon.nam) who u.new)
|
||||
=. nem.state (some nam)
|
||||
::
|
||||
:: XX wait-effect
|
||||
::
|
||||
=/ dep=(list [=ship =target])
|
||||
~(tap in (~(get ju dep.nam) who))
|
||||
|- ^- form:m
|
||||
=* loop $
|
||||
?~ dep
|
||||
=. dep.nam (~(del by dep.nam) who)
|
||||
=. nem.state (some nam)
|
||||
(pure:m state)
|
||||
;< ~ bind:m (poke-app:stdio [our dap]:bowl [%dns-bind ship target]:i.dep)
|
||||
loop(dep t.dep)
|
||||
::
|
||||
:: XX need to %handle-http-cancel as well
|
||||
::
|
||||
%handle-http-request
|
||||
:: always stash request bone for giving response
|
||||
::
|
||||
=/ =bone ost.bowl
|
||||
:: XX maybe always (set-raw-contract %request) so transaction failure is captured?
|
||||
::
|
||||
=* inbound-request inbound-request.in-poke-data
|
||||
?~ nem.state
|
||||
~& :* %not-an-authority
|
||||
%http-request
|
||||
=> inbound-request
|
||||
[authenticated secure address [method url]:request]
|
||||
==
|
||||
;< ~ bind:m
|
||||
(send-effect-on-bone:stdio bone [%http-response %start [%403 ~] ~ %.y])
|
||||
(pure:m state)
|
||||
::
|
||||
=* nam u.nem.state
|
||||
?> ?=(%gcloud -.pro.aut.nam)
|
||||
::
|
||||
=/ parsed=(unit (pair pork:eyre quay:eyre))
|
||||
%+ rush
|
||||
url.request.inbound-request
|
||||
;~(plug ;~(pose apat:de-purl:html (easy *pork:eyre)) yque:de-purl:html)
|
||||
::
|
||||
?. ?=(^ parsed)
|
||||
~| [%invalid-url url.request.inbound-request] !!
|
||||
=* url q.p.u.parsed
|
||||
=* ext p.p.u.parsed
|
||||
=* params q.u.parsed
|
||||
::
|
||||
?+ url
|
||||
;< ~ bind:m
|
||||
(send-effect-on-bone:stdio bone [%http-response %start [%404 ~] ~ %.y])
|
||||
(pure:m state)
|
||||
::
|
||||
[%dns %oauth ~]
|
||||
=/ link (trip redirect-to-provider:(oauth2-core bowl scry.pro.aut.nam))
|
||||
=/ bod=(unit octs)
|
||||
%- some
|
||||
%- as-octt:mimes:html
|
||||
%- en-xml:html
|
||||
;html
|
||||
;head
|
||||
;title: :dns oauth
|
||||
==
|
||||
;body
|
||||
;p make sure that the oauth credential is configured
|
||||
with a redirect uri of {(trip redirect-uri:(oauth2-core bowl scry.pro.aut.nam))}
|
||||
==
|
||||
;a(href link): {link}
|
||||
==
|
||||
==
|
||||
;< ~ bind:m
|
||||
(send-effect-on-bone:stdio bone [%http-response %start [%200 ~] bod %.y])
|
||||
(pure:m state)
|
||||
::
|
||||
[%dns %oauth %result ~]
|
||||
=/ code (~(got by (my params)) %code)
|
||||
:: XX make path configurable
|
||||
::
|
||||
=/ hed [['Location' '/dns/oauth/success'] ~]
|
||||
::
|
||||
;< ~ bind:m
|
||||
(send-request:stdio (retrieve-access-token:(oauth2-core bowl scry.pro.aut.nam) code))
|
||||
;< rep=(unit client-response:http-client) bind:m
|
||||
take-maybe-response:stdio
|
||||
:: XX retry
|
||||
::
|
||||
?> ?& ?=(^ rep)
|
||||
?=(%finished -.u.rep)
|
||||
?=(^ full-file.u.rep)
|
||||
==
|
||||
=/ data (parse-token-response:oauth2 data.u.full-file.u.rep)
|
||||
=. auth.pro.aut.nam (some [access refresh]:(need data))
|
||||
=. nem.state (some nam)
|
||||
:: XX use expiry to set refresh timer
|
||||
::
|
||||
:: XX may need to send this as a card so we don't wait
|
||||
::
|
||||
;< ~ bind:m
|
||||
(send-effect-on-bone:stdio bone [%http-response %start [%301 hed] ~ %.y])
|
||||
(initialize-authority aut.nam state)
|
||||
::
|
||||
[%dns %oauth %success ~]
|
||||
=/ bod=(unit octs)
|
||||
%- some
|
||||
%- as-octt:mimes:html
|
||||
%- en-xml:html
|
||||
;html
|
||||
;head
|
||||
;title: :dns oauth
|
||||
==
|
||||
;body
|
||||
;p: you may close the browser window
|
||||
;p
|
||||
;span: XX remove me
|
||||
:: XX make path configurable
|
||||
::
|
||||
;a(href "/dns/oauth"): again
|
||||
==
|
||||
==
|
||||
==
|
||||
;< ~ bind:m (send-effect:stdio %http-response %start [%201 ~] bod %.y)
|
||||
(pure:m state)
|
||||
==
|
||||
==
|
||||
::
|
||||
++ handle-diff
|
||||
|= [=dock =path =in-peer-data]
|
||||
=/ m tapp-async
|
||||
^- form:m
|
||||
?. =(dock collector-app)
|
||||
(pure:m state)
|
||||
=* req request.in-peer-data
|
||||
=/ =target [%direct address.req]
|
||||
;< ~ bind:m (poke-app:stdio [our dap]:bowl [%dns-bind ship.req target])
|
||||
(pure:m state)
|
||||
::
|
||||
++ handle-take
|
||||
|= =sign:tapp
|
||||
=/ m tapp-async
|
||||
^- form:m
|
||||
?. ?=(%quit -.sign)
|
||||
:: XX handle stuff
|
||||
::
|
||||
(pure:m state)
|
||||
::
|
||||
?. ?& =(dock.sign collector-app)
|
||||
=(path.sign /requests)
|
||||
==
|
||||
~& [%unexpected-quit-wat-do [dock path]:sign]
|
||||
(pure:m state)
|
||||
::
|
||||
;< ~ bind:m (peer-app:stdio collector-app /requests)
|
||||
(pure:m state)
|
||||
--
|
||||
158
app/dns-collector.hoon
Normal file
158
app/dns-collector.hoon
Normal file
@ -0,0 +1,158 @@
|
||||
/- dns
|
||||
::
|
||||
:: app types and boilerplate
|
||||
::
|
||||
=> |%
|
||||
+$ app-state
|
||||
$: %0
|
||||
requested=(map ship address:dns)
|
||||
completed=(map ship binding:dns)
|
||||
==
|
||||
+$ peek-data [%noun (list (pair ship address:dns))]
|
||||
+$ in-poke-data
|
||||
$% [%dns-address =address:dns]
|
||||
[%dns-complete =ship =binding:dns]
|
||||
==
|
||||
+$ out-poke-data
|
||||
$% [%drum-unlink =dock]
|
||||
==
|
||||
+$ out-peer-data
|
||||
$% [%dns-binding =binding:dns]
|
||||
[%dns-request =request:dns]
|
||||
==
|
||||
+$ card
|
||||
$% [%diff out-peer-data]
|
||||
[%poke wire =dock out-poke-data]
|
||||
==
|
||||
+$ move [bone card]
|
||||
--
|
||||
::
|
||||
=| moves=(list move)
|
||||
|_ [=bowl:gall state=app-state]
|
||||
::
|
||||
++ this .
|
||||
::
|
||||
++ abet
|
||||
^- (quip move _this)
|
||||
[(flop moves) this(moves ~)]
|
||||
::
|
||||
++ emit
|
||||
|= mov=move
|
||||
^+ this
|
||||
this(moves [mov moves])
|
||||
::
|
||||
++ emil
|
||||
|= moz=(list move)
|
||||
|- ^+ this
|
||||
?~ moz
|
||||
this
|
||||
$(moz t.moz, ..this (emit i.moz))
|
||||
::
|
||||
++ poke-app
|
||||
|= [=wire =dock =out-poke-data]
|
||||
^+ this
|
||||
(emit [ost.bowl %poke wire dock out-poke-data])
|
||||
::
|
||||
++ give-result
|
||||
|= [=the=path =out-peer-data]
|
||||
^+ this
|
||||
%- emil
|
||||
%+ turn
|
||||
^- (list bone)
|
||||
%+ murn ~(tap by sup.bowl)
|
||||
|= [ost=bone =ship =sub=path]
|
||||
`(unit bone)`?.(=(the-path sub-path) ~ (some ost))
|
||||
|= =bone
|
||||
[bone %diff out-peer-data]
|
||||
::
|
||||
++ prep
|
||||
|= old=(unit app-state)
|
||||
^- (quip move _this)
|
||||
=< abet
|
||||
?~ old
|
||||
(poke-app /unlink [[our %hood] [%drum-unlink our dap]]:bowl)
|
||||
this(state u.old)
|
||||
::
|
||||
++ poke
|
||||
|= =in-poke-data
|
||||
^- (quip move _this)
|
||||
=< abet
|
||||
?- -.in-poke-data
|
||||
%dns-address
|
||||
=* who src.bowl
|
||||
=* adr address.in-poke-data
|
||||
=/ rac (clan:title who)
|
||||
?. ?=(?(%king %duke) rac)
|
||||
~| [%dns-collector-bind-invalid who] !!
|
||||
?: (reserved:eyre if.adr)
|
||||
~| [%dns-collector-reserved-address who if.adr] !!
|
||||
::
|
||||
=/ req=(unit address:dns) (~(get by requested.state) who)
|
||||
=/ dun=(unit binding:dns) (~(get by completed.state) who)
|
||||
?: &(?=(^ dun) =(adr address.u.dun))
|
||||
=. requested.state (~(del by requested.state) who)
|
||||
(give-result /(scot %p who) %dns-binding u.dun)
|
||||
::
|
||||
?: &(?=(^ req) =(adr u.req))
|
||||
this
|
||||
:: XX check address?
|
||||
=/ =request:dns [who adr]
|
||||
=. requested.state (~(put by requested.state) request)
|
||||
(give-result /requests %dns-request request)
|
||||
::
|
||||
%dns-complete
|
||||
:: XX or confirm valid binding?
|
||||
::
|
||||
?. (team:title [our src]:bowl)
|
||||
~| %complete-yoself !!
|
||||
=* who ship.in-poke-data
|
||||
=* adr address.binding.in-poke-data
|
||||
=* tuf turf.binding.in-poke-data
|
||||
=/ req=(unit address:dns) (~(get by requested.state) who)
|
||||
:: ignore established bindings that don't match requested
|
||||
::
|
||||
?: ?& ?=(^ req)
|
||||
!=(adr u.req)
|
||||
==
|
||||
this
|
||||
=: requested.state (~(del by requested.state) who)
|
||||
completed.state (~(put by completed.state) who [adr tuf])
|
||||
==
|
||||
(give-result /(scot %p who) %dns-binding adr tuf)
|
||||
==
|
||||
::
|
||||
++ peek
|
||||
|= =path
|
||||
^- (unit (unit peek-data))
|
||||
~& path
|
||||
?+ path [~ ~]
|
||||
[%x %requested ~]
|
||||
[~ ~ %noun ~(tap by requested.state)]
|
||||
==
|
||||
::
|
||||
++ peer
|
||||
|= =path
|
||||
^- (quip move _this)
|
||||
=< abet
|
||||
:: will be immediately unlinked, see +prep
|
||||
::
|
||||
?: ?=([%sole *] path)
|
||||
this
|
||||
?. ?=([@ ~] path)
|
||||
~| %invalid-path !!
|
||||
?: ?=(%requests i.path)
|
||||
=/ requests ~(tap by requested.state)
|
||||
|- ^+ this
|
||||
=* loop $
|
||||
?~ requests
|
||||
this
|
||||
=. ..this (give-result path %dns-request i.requests)
|
||||
loop(requests t.requests)
|
||||
::
|
||||
=/ who (slaw %p i.path)
|
||||
?~ who
|
||||
~| %invalid-path !!
|
||||
?~ dun=(~(get by completed.state) who)
|
||||
this
|
||||
(give-result path %dns-binding u.dun)
|
||||
--
|
||||
1636
app/dns.hoon
1636
app/dns.hoon
File diff suppressed because it is too large
Load Diff
@ -2,14 +2,26 @@
|
||||
::
|
||||
:::: /hoon/authority/dns/gen
|
||||
::
|
||||
/- *dns, *sole
|
||||
/- *dns-bind, *sole
|
||||
/+ *generators
|
||||
:- %ask
|
||||
|= $: [now=@da eny=@uvJ bec=beak]
|
||||
[arg=$@(~ [dom=turf ~])]
|
||||
~
|
||||
==
|
||||
^- (sole-result [%dns-command %authority authority])
|
||||
^- (sole-result [%dns-authority authority])
|
||||
=* our p.bec
|
||||
:: XX must be evaluated outside tapp core due to +mule
|
||||
::
|
||||
=/ =hart:eyre .^(hart:eyre %r /(scot %p our)/host/real)
|
||||
:: XX terrible
|
||||
=/ domain /com/googleapis
|
||||
=/ code
|
||||
%- crip
|
||||
+:(scow %p .^(@p %j /(scot %p our)/code/(scot %da now)/(scot %p our)))
|
||||
=/ secrets
|
||||
.^(@t %cx :(weld /(scot %p our)/home/(scot %da now)/sec domain /atom))
|
||||
::
|
||||
=- ?~ arg -
|
||||
(fun.q.q [%& dom.arg])
|
||||
%+ prompt
|
||||
@ -27,4 +39,4 @@
|
||||
%+ parse urs:ab
|
||||
|= zone=@ta
|
||||
%- produce
|
||||
[%dns-command %authority [p.hot %gcloud project zone ~]]
|
||||
[%dns-authority [p.hot %gcloud project zone [code hart secrets] ~]]
|
||||
26
gen/dns/auto.hoon
Normal file
26
gen/dns/auto.hoon
Normal file
@ -0,0 +1,26 @@
|
||||
:: DNS: configure automatically
|
||||
::
|
||||
:::: /hoon/auto/dns/gen
|
||||
::
|
||||
/- *sole
|
||||
/+ *generators
|
||||
:- %ask
|
||||
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
|
||||
^- (sole-result [%dns-auto ~])
|
||||
=* our p.bec
|
||||
=/ rac (clan:title our)
|
||||
::
|
||||
?: ?=(?(%earl %pawn) rac)
|
||||
=/ msg1 "domain names are not provided for comets and moons"
|
||||
=/ msg2 "see XX for BYOD"
|
||||
%+ print leaf+msg2
|
||||
(print leaf+msg1 no-product)
|
||||
::
|
||||
?. ?=(%czar rac)
|
||||
=/ msg1 ":dns|auto is only supported for galaxies"
|
||||
=/ msg2 "use :dns|request with your ship's public IP address"
|
||||
=/ msg3 "see XX for more details, or to BYOD"
|
||||
%+ print leaf+msg3
|
||||
%+ print leaf+msg2
|
||||
(print leaf+msg1 no-product)
|
||||
(produce [%dns-auto ~])
|
||||
@ -1,25 +0,0 @@
|
||||
:: DNS: configure ip address
|
||||
::
|
||||
:::: /hoon/authority/dns/gen
|
||||
::
|
||||
/- *dns, *sole
|
||||
/+ *generators
|
||||
:- %ask
|
||||
|= $: [now=@da eny=@uvJ bec=beak]
|
||||
[arg=$@(~ [addr=@if ~])]
|
||||
~
|
||||
==
|
||||
^- (sole-result [%dns-command command])
|
||||
=* our p.bec
|
||||
=- ?~ arg -
|
||||
(fun.q.q addr.arg)
|
||||
%+ prompt
|
||||
[%& %dns-address "ipv4 address: "]
|
||||
%+ parse
|
||||
`$-(nail (like @if))`;~(pfix ;~(pose dot (easy ~)) lip:ag)
|
||||
|= addr=@if
|
||||
?: (reserved:eyre addr)
|
||||
=/ msg "unable to bind reserved ipv4 address {(scow %if addr)}"
|
||||
(print leaf+msg no-product)
|
||||
%- produce
|
||||
[%dns-command %ip %if addr]
|
||||
43
gen/dns/request.hoon
Normal file
43
gen/dns/request.hoon
Normal file
@ -0,0 +1,43 @@
|
||||
:: DNS: configure ip address
|
||||
::
|
||||
:::: /hoon/request/dns/gen
|
||||
::
|
||||
/- *dns, *sole
|
||||
/+ *generators
|
||||
:- %ask
|
||||
|= $: [now=@da eny=@uvJ bec=beak]
|
||||
[arg=$@(~ [addr=@if ~])]
|
||||
~
|
||||
==
|
||||
^- (sole-result [%dns-address address])
|
||||
=* our p.bec
|
||||
=/ rac (clan:title our)
|
||||
::
|
||||
?: ?=(%czar rac)
|
||||
=/ msg1 "galaxy domain requests must be made out-of-band"
|
||||
=/ msg2 "use :dns|auto if you already have an urbit domain"
|
||||
=/ msg3 "see XX for more details or to BYOD"
|
||||
%+ print leaf+msg3
|
||||
%+ print leaf+msg2
|
||||
(print leaf+msg1 no-product)
|
||||
::
|
||||
?: ?=(?(%earl %pawn) rac)
|
||||
=/ msg1 "domain names are not provided for comets and moons"
|
||||
=/ msg2 "see XX for BYOD"
|
||||
%+ print leaf+msg2
|
||||
(print leaf+msg1 no-product)
|
||||
:: invoke parser with arg if present
|
||||
::
|
||||
=- ?~ arg -
|
||||
(fun.q.q addr.arg)
|
||||
%+ prompt
|
||||
[%& %dns-address "ipv4 address: "]
|
||||
%+ parse
|
||||
^- $-(nail (like @if))
|
||||
;~(pfix ;~(pose dot (easy ~)) lip:ag)
|
||||
|= addr=@if
|
||||
?: (reserved:eyre addr)
|
||||
=/ msg "unable to bind reserved ipv4 address {(scow %if addr)}"
|
||||
(print leaf+msg no-product)
|
||||
%- produce
|
||||
[%dns-address %if addr]
|
||||
@ -3,20 +3,6 @@
|
||||
=* rsa primitive-rsa
|
||||
:::: %/lib/pkcs
|
||||
|%
|
||||
:: +join: join list of cords with separator
|
||||
::
|
||||
:: XX move to zuse?
|
||||
::
|
||||
++ join
|
||||
|= [sep=@t hot=(list @t)]
|
||||
^- @t
|
||||
=| out=(list @t)
|
||||
?> ?=(^ hot)
|
||||
|- ^- @t
|
||||
?~ t.hot
|
||||
(rap 3 [i.hot out])
|
||||
$(out [sep i.hot out], hot t.hot)
|
||||
::
|
||||
:: +rs256: RSA signatures over a sha-256 digest
|
||||
::
|
||||
++ rs256
|
||||
@ -312,7 +298,7 @@
|
||||
=> |%
|
||||
:: +csr:pkcs10: certificate request
|
||||
::
|
||||
+= csr [key=key:rsa hot=(list (list @t))]
|
||||
+$ csr [key=key:rsa hot=(list turf)]
|
||||
--
|
||||
|%
|
||||
:: |spec:pkcs10: ASN.1 specs for certificate signing requests
|
||||
@ -362,13 +348,13 @@
|
||||
:: +san:en:spec:pkcs10: subject-alternate-names
|
||||
::
|
||||
++ san
|
||||
|= hot=(list (list @t))
|
||||
|= hot=(list turf)
|
||||
^- spec:asn1
|
||||
:- %seq
|
||||
%+ turn hot
|
||||
:: implicit, context-specific tag #2 (IA5String)
|
||||
:: XX sanitize string?
|
||||
|=(h=(list @t) [%con `bespoke:asn1`[& 2] (rip 3 (join '.' h))])
|
||||
|=(=turf [%con `bespoke:asn1`[& 2] (trip (en-turf:html turf))])
|
||||
--
|
||||
:: |de:spec:pkcs10: ASN.1 decoding for certificate signing requests
|
||||
++ de !!
|
||||
|
||||
103
lib/stdio.hoon
103
lib/stdio.hoon
@ -62,21 +62,27 @@
|
||||
::
|
||||
:: ----
|
||||
::
|
||||
:: HTTP requests
|
||||
:: Outgoing HTTP requests
|
||||
::
|
||||
++ send-request
|
||||
|= =request:http
|
||||
=/ m (async ,~)
|
||||
^- form:m
|
||||
=/ =card
|
||||
[%request / request *outbound-config:http-client]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
(set-raw-contract & %request ~)
|
||||
::
|
||||
++ send-hiss
|
||||
|= =hiss:eyre
|
||||
=/ m (async ,~)
|
||||
^- form:m
|
||||
=/ =card
|
||||
[%request / (hiss-to-request:html hiss) *outbound-config:http-client]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
(set-raw-contract & %request ~)
|
||||
(send-request (hiss-to-request:html hiss))
|
||||
::
|
||||
:: Wait until we get an HTTP response or cancelation
|
||||
::
|
||||
++ take-sigh-raw
|
||||
=/ m (async (unit httr:eyre))
|
||||
++ take-response-raw
|
||||
=/ m (async (unit client-response:http-client))
|
||||
^- form:m
|
||||
|= =async-input
|
||||
:^ ~ ~ ~
|
||||
@ -97,18 +103,27 @@
|
||||
[%done ~]
|
||||
::
|
||||
%finished
|
||||
[%done (some (to-httr:http-client +.response.sign))]
|
||||
[%done (some response.sign)]
|
||||
==
|
||||
:: Wait until we get an HTTP response or cancelation and unset contract
|
||||
::
|
||||
++ take-maybe-response
|
||||
=/ m (async (unit client-response:http-client))
|
||||
^- form:m
|
||||
;< rep=(unit client-response:http-client) bind:m
|
||||
take-response-raw
|
||||
;< ~ bind:m (set-raw-contract | %request ~)
|
||||
(pure:m rep)
|
||||
::
|
||||
:: Wait until we get an HTTP response and unset contract
|
||||
::
|
||||
++ take-sigh
|
||||
=/ m (async ,httr:eyre)
|
||||
++ take-response
|
||||
=/ m (async (unit client-response:http-client))
|
||||
^- form:m
|
||||
;< rep=(unit httr:eyre) bind:m take-sigh-raw
|
||||
;< ~ bind:m (set-raw-contract | %request ~)
|
||||
;< rep=(unit client-response:http-client) bind:m
|
||||
take-maybe-response
|
||||
?^ rep
|
||||
(pure:m u.rep)
|
||||
(pure:m rep)
|
||||
|= =async-input
|
||||
[~ ~ ~ %fail %http-canceled ~]
|
||||
::
|
||||
@ -117,9 +132,26 @@
|
||||
++ take-maybe-sigh
|
||||
=/ m (async (unit httr:eyre))
|
||||
^- form:m
|
||||
;< rep=(unit httr:eyre) bind:m take-sigh-raw
|
||||
;< ~ bind:m (set-raw-contract | %request ~)
|
||||
(pure:m rep)
|
||||
;< rep=(unit client-response:http-client) bind:m
|
||||
take-maybe-response
|
||||
?~ rep
|
||||
(pure:m ~)
|
||||
:: XX s/b impossible
|
||||
::
|
||||
?. ?=(%finished -.u.rep)
|
||||
(pure:m ~)
|
||||
(pure:m (some (to-httr:http-client +.u.rep)))
|
||||
::
|
||||
:: Wait until we get an HTTP response and unset contract
|
||||
::
|
||||
++ take-sigh
|
||||
=/ m (async ,httr:eyre)
|
||||
^- form:m
|
||||
;< rep=(unit httr:eyre) bind:m take-maybe-sigh
|
||||
?^ rep
|
||||
(pure:m u.rep)
|
||||
|= =async-input
|
||||
[~ ~ ~ %fail %http-canceled ~]
|
||||
::
|
||||
:: Extract body from raw httr
|
||||
::
|
||||
@ -163,6 +195,35 @@
|
||||
::
|
||||
:: ----
|
||||
::
|
||||
:: Incoming HTTP requests
|
||||
::
|
||||
++ bind-route-raw
|
||||
|= [=binding:http-server =term]
|
||||
=/ m (async ,~)
|
||||
^- form:m
|
||||
(send-raw-card [%connect / binding term])
|
||||
::
|
||||
++ take-bound
|
||||
=/ m (async ?)
|
||||
^- form:m
|
||||
|= =async-input
|
||||
:^ ~ ~ ~
|
||||
?~ in.async-input
|
||||
[%wait ~]
|
||||
=* sign sign.u.in.async-input
|
||||
?. ?=(%bound -.sign)
|
||||
[%fail %expected-bound >got=-.sign< ~]
|
||||
[%done success.sign]
|
||||
::
|
||||
++ bind-route
|
||||
|= [=binding:http-server =term]
|
||||
=/ m (async ?)
|
||||
^- form:m
|
||||
;< ~ bind:m (bind-route-raw binding term)
|
||||
take-bound
|
||||
::
|
||||
:: ----
|
||||
::
|
||||
:: Identity is immutable
|
||||
::
|
||||
:: XX should be statefully cycled
|
||||
@ -320,4 +381,14 @@
|
||||
(pure:m ~)
|
||||
;< ~ bind:m (send-effect-on-bone i.bones %diff out-peer-data)
|
||||
loop(bones t.bones)
|
||||
::
|
||||
:: ----
|
||||
::
|
||||
:: Handle domains
|
||||
::
|
||||
++ install-domain
|
||||
|= =turf
|
||||
=/ m (async ,~)
|
||||
^- form:m
|
||||
(send-effect %rule / %turf %put turf)
|
||||
--
|
||||
|
||||
@ -32,7 +32,7 @@
|
||||
+$ move (pair bone card)
|
||||
++ tapp-async (async state-type)
|
||||
+$ tapp-state
|
||||
$: waiting=(qeu command)
|
||||
$: waiting=(qeu [=bone command])
|
||||
active=(unit eval-form:eval:tapp-async)
|
||||
app-state=state-type
|
||||
==
|
||||
@ -246,7 +246,7 @@
|
||||
^- (quip move _this-tapp)
|
||||
?~ old-state
|
||||
~& [%tapp-init dap.bowl]
|
||||
=. waiting (~(put to waiting) %init ~)
|
||||
=. waiting (~(put to waiting) ost.bowl [%init ~])
|
||||
start-async
|
||||
::
|
||||
=/ old ((soft tapp-state) u.old-state)
|
||||
@ -285,7 +285,7 @@
|
||||
(oob-fail-async %tapp-admin-restart ~)
|
||||
==
|
||||
::
|
||||
=. waiting (~(put to waiting) %poke tapp-in-poke-data)
|
||||
=. waiting (~(put to waiting) ost.bowl [%poke tapp-in-poke-data])
|
||||
?^ active
|
||||
~& [%waiting-until-current-async-finishes waiting]
|
||||
`this-tapp
|
||||
@ -304,7 +304,7 @@
|
||||
?> ?=([@ @ *] wire)
|
||||
=/ her (slav %p i.wire)
|
||||
=* app i.t.wire
|
||||
=. waiting (~(put to waiting) %take %coup [her app] error)
|
||||
=. waiting (~(put to waiting) ost.bowl [%take %coup [her app] error])
|
||||
?^ active
|
||||
`this-tapp
|
||||
start-async
|
||||
@ -330,7 +330,7 @@
|
||||
++ peer
|
||||
|= =path
|
||||
^- (quip move _this-tapp)
|
||||
=. waiting (~(put to waiting) %peer path)
|
||||
=. waiting (~(put to waiting) ost.bowl [%peer path])
|
||||
?^ active
|
||||
`this-tapp
|
||||
start-async
|
||||
@ -344,7 +344,7 @@
|
||||
=/ her (slav %p i.wire)
|
||||
=* app i.t.wire
|
||||
=* pax t.t.wire
|
||||
=. waiting (~(put to waiting) %take %quit [her app] pax)
|
||||
=. waiting (~(put to waiting) ost.bowl [%take %quit [her app] pax])
|
||||
?^ active
|
||||
`this-tapp
|
||||
start-async
|
||||
@ -358,7 +358,7 @@
|
||||
=/ her (slav %p i.wire)
|
||||
=* app i.t.wire
|
||||
=* pax t.t.wire
|
||||
=. waiting (~(put to waiting) %take %reap [her app] pax error)
|
||||
=. waiting (~(put to waiting) ost.bowl [%take %reap [her app] pax error])
|
||||
?^ active
|
||||
`this-tapp
|
||||
start-async
|
||||
@ -372,7 +372,7 @@
|
||||
=/ her (slav %p i.wire)
|
||||
=* app i.t.wire
|
||||
=* pax t.t.wire
|
||||
=. waiting (~(put to waiting) %diff [her app] pax in-peer-data)
|
||||
=. waiting (~(put to waiting) ost.bowl [%diff [her app] pax in-peer-data])
|
||||
?^ active
|
||||
`this-tapp
|
||||
start-async
|
||||
@ -398,11 +398,18 @@
|
||||
++ wake-effect
|
||||
|= [=wire error=(unit tang)]
|
||||
^- (quip move _this-tapp)
|
||||
=. waiting (~(put to waiting) %take %wake error)
|
||||
=. waiting (~(put to waiting) ost.bowl [%take %wake error])
|
||||
?^ active
|
||||
`this-tapp
|
||||
start-async
|
||||
::
|
||||
:: Receive route binding notification
|
||||
::
|
||||
++ bound
|
||||
|= [=wire success=? =binding:http-server]
|
||||
^- (quip move _this-tapp)
|
||||
(take-async bowl `[wire %bound success binding])
|
||||
::
|
||||
:: Continue computing async
|
||||
::
|
||||
++ take-async
|
||||
@ -474,7 +481,7 @@
|
||||
^- (quip move _this-tapp)
|
||||
?. =(~ active)
|
||||
~| %async-already-active !!
|
||||
=/ next=(unit command) ~(top to waiting)
|
||||
=/ next=(unit [=bone =command]) ~(top to waiting)
|
||||
?~ next
|
||||
`this-tapp
|
||||
=. active
|
||||
@ -483,12 +490,14 @@
|
||||
^- form:tapp-async
|
||||
=/ out
|
||||
%- mule |.
|
||||
?- -.u.next
|
||||
=. ost.bowl bone.u.next
|
||||
=* input +.command.u.next
|
||||
?- -.command.u.next
|
||||
%init ~(handle-init handler bowl app-state)
|
||||
%poke (~(handle-poke handler bowl app-state) +.u.next)
|
||||
%peer (~(handle-peer handler bowl app-state) +.u.next)
|
||||
%diff (~(handle-diff handler bowl app-state) +.u.next)
|
||||
%take (~(handle-take handler bowl app-state) +.u.next)
|
||||
%poke (~(handle-poke handler bowl app-state) input)
|
||||
%peer (~(handle-peer handler bowl app-state) input)
|
||||
%diff (~(handle-diff handler bowl app-state) input)
|
||||
%take (~(handle-take handler bowl app-state) input)
|
||||
==
|
||||
?- -.out
|
||||
%& p.out
|
||||
|
||||
7
mar/dns/address.hoon
Normal file
7
mar/dns/address.hoon
Normal file
@ -0,0 +1,7 @@
|
||||
/- *dns
|
||||
|_ address
|
||||
++ grab
|
||||
|%
|
||||
++ noun address
|
||||
--
|
||||
--
|
||||
7
mar/dns/binding.hoon
Normal file
7
mar/dns/binding.hoon
Normal file
@ -0,0 +1,7 @@
|
||||
/- *dns
|
||||
|_ binding
|
||||
++ grab
|
||||
|%
|
||||
++ noun binding
|
||||
--
|
||||
--
|
||||
@ -1,10 +0,0 @@
|
||||
::
|
||||
:::: /mar/dns/bind/hoon
|
||||
::
|
||||
/- *dns
|
||||
|_ command
|
||||
++ grab
|
||||
|%
|
||||
++ noun command
|
||||
--
|
||||
--
|
||||
7
mar/dns/complete.hoon
Normal file
7
mar/dns/complete.hoon
Normal file
@ -0,0 +1,7 @@
|
||||
/- *dns
|
||||
|_ [ship binding]
|
||||
++ grab
|
||||
|%
|
||||
+$ noun [ship binding]
|
||||
--
|
||||
--
|
||||
58
sur/dns-bind.hoon
Normal file
58
sur/dns-bind.hoon
Normal file
@ -0,0 +1,58 @@
|
||||
|%
|
||||
:: +provider: DNS service provider (gcloud only for now)
|
||||
::
|
||||
+$ provider
|
||||
$% [%fcloud zone=@ta auth=[email=@t key=@t]]
|
||||
$: %gcloud
|
||||
project=@ta
|
||||
zone=@ta
|
||||
:: XX passed as params since we can't scry in +mule
|
||||
::
|
||||
scry=[code=@t =hart:eyre secrets=@t]
|
||||
auth=(unit [access=@t refresh=@t])
|
||||
==
|
||||
==
|
||||
:: +authority: responsibility for a DNS zone
|
||||
::
|
||||
+$ authority
|
||||
$: :: dom: authority over a fully-qualified domain
|
||||
::
|
||||
dom=turf
|
||||
:: pro: DNS service provider
|
||||
::
|
||||
pro=provider
|
||||
==
|
||||
:: +target: a ship is bound to a ...
|
||||
::
|
||||
+$ target
|
||||
$% :: %direct: an A record
|
||||
::
|
||||
[%direct %if p=@if]
|
||||
:: %indirect: a CNAME record
|
||||
::
|
||||
[%indirect p=ship]
|
||||
==
|
||||
:: +bound: an established binding, plus history
|
||||
::
|
||||
+$ bound
|
||||
$: :: wen: established
|
||||
::
|
||||
wen=@da
|
||||
:: id: binding UUID (unused by gcloud)
|
||||
::
|
||||
id=@ta
|
||||
:: cur: current target
|
||||
::
|
||||
cur=target
|
||||
:: hit: historical targets
|
||||
::
|
||||
hit=(list (pair @da target))
|
||||
==
|
||||
:: +nameserver: a b s o l u t e p o w e r
|
||||
::
|
||||
+$ nameserver
|
||||
$: aut=authority
|
||||
bon=(map ship bound)
|
||||
dep=(jug ship (pair ship target))
|
||||
==
|
||||
--
|
||||
72
sur/dns.hoon
72
sur/dns.hoon
@ -1,71 +1,5 @@
|
||||
|%
|
||||
:: +provider: DNS service provider (gcloud only for now)
|
||||
::
|
||||
+$ provider
|
||||
$% [%fcloud zone=@ta auth=[email=@t key=@t]]
|
||||
[%gcloud project=@ta zone=@ta auth=(unit [access=@t refresh=@t])]
|
||||
==
|
||||
:: +authority: responsibility for a DNS zone
|
||||
::
|
||||
+$ authority
|
||||
$: :: dom: authority over a fully-qualified domain
|
||||
::
|
||||
dom=turf
|
||||
:: pro: DNS service provider
|
||||
::
|
||||
pro=provider
|
||||
==
|
||||
:: +target: a ship is bound to a ...
|
||||
::
|
||||
+$ target
|
||||
$% :: %direct: an A record
|
||||
::
|
||||
[%direct %if p=@if]
|
||||
:: %indirect: a CNAME record
|
||||
::
|
||||
[%indirect p=ship]
|
||||
==
|
||||
:: +bound: an established binding, plus history
|
||||
::
|
||||
+$ bound
|
||||
$: :: wen: established
|
||||
::
|
||||
wen=@da
|
||||
:: id: binding UUID (unused by gcloud)
|
||||
::
|
||||
id=@ta
|
||||
:: cur: current target
|
||||
::
|
||||
cur=target
|
||||
:: hit: historical targets
|
||||
::
|
||||
hit=(list (pair @da target))
|
||||
==
|
||||
:: +nameserver: a b s o l u t e p o w e r
|
||||
::
|
||||
+$ nameserver
|
||||
$: aut=authority
|
||||
bon=(map ship bound)
|
||||
dep=(jar ship (pair ship target))
|
||||
pen=(map ship target)
|
||||
==
|
||||
:: +relay: a good parent keeps track
|
||||
::
|
||||
+$ relay
|
||||
$: wen=@da
|
||||
wer=(unit @if)
|
||||
:: XX track bound state per domain
|
||||
::
|
||||
dom=(unit turf)
|
||||
tar=target
|
||||
==
|
||||
:: +command: top-level app actions
|
||||
::
|
||||
+$ command
|
||||
$% [%authority aut=authority]
|
||||
[%bind for=ship him=ship tar=target]
|
||||
[%bond for=ship him=ship dom=turf]
|
||||
[%ip %if addr=@if]
|
||||
[%meet him=ship]
|
||||
==
|
||||
+$ address [%if if=@if]
|
||||
+$ binding [=address =turf]
|
||||
+$ request [=ship =address]
|
||||
--
|
||||
|
||||
@ -12,6 +12,9 @@
|
||||
[%diff out-peer-data]
|
||||
[%request wire request:http outbound-config:http-client]
|
||||
[%cancel-request wire ~]
|
||||
[%connect wire binding:http-server term]
|
||||
[%http-response =http-event:http]
|
||||
[%rule wire %turf %put turf]
|
||||
==
|
||||
::
|
||||
:: Possible async responses
|
||||
@ -21,6 +24,7 @@
|
||||
[%coup =dock error=(unit tang)]
|
||||
[%quit =dock =path]
|
||||
[%reap =dock =path error=(unit tang)]
|
||||
[%bound success=? =binding:http-server]
|
||||
[%http-response response=client-response:http-client]
|
||||
==
|
||||
::
|
||||
|
||||
@ -555,6 +555,17 @@
|
||||
|@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$])
|
||||
--
|
||||
a
|
||||
:: +join: construct a new list, placing .sep between every pair in .lit
|
||||
::
|
||||
++ join
|
||||
|* [sep=* lit=(list)]
|
||||
=. sep `_?>(?=(^ lit) i.lit)`sep
|
||||
?~ lit ~
|
||||
=| out=(list _?>(?=(^ lit) i.lit))
|
||||
|- ^+ out
|
||||
?~ t.lit
|
||||
(flop [i.lit out])
|
||||
$(out [sep i.lit out], lit t.lit)
|
||||
::
|
||||
:: +bake: convert wet gate to dry gate by specifying argument mold
|
||||
::
|
||||
|
||||
@ -6786,6 +6786,23 @@
|
||||
(stag %| ;~(plug apat yque))
|
||||
==
|
||||
-- ::de-purl
|
||||
:: +en-turf: encode +turf as a TLD-last domain string
|
||||
::
|
||||
++ en-turf
|
||||
|= =turf
|
||||
^- @t
|
||||
(rap 3 (flop (join '.' turf)))
|
||||
:: +de-turf: parse a TLD-last domain string into a TLD first +turf
|
||||
::
|
||||
++ de-turf
|
||||
|= host=@t
|
||||
^- (unit turf)
|
||||
%+ rush host
|
||||
%+ sear
|
||||
|= =host:eyre
|
||||
?.(?=(%& -.host) ~ (some p.host))
|
||||
thos:de-purl:html
|
||||
::
|
||||
:: MOVEME
|
||||
:: :: ++fuel:html
|
||||
++ fuel :: parse urbit fcgi
|
||||
|
||||
@ -1,20 +0,0 @@
|
||||
/+ *test
|
||||
::
|
||||
/= app /: /===/app/dns
|
||||
/!noun/
|
||||
::
|
||||
|%
|
||||
:: tests that :dns preps without moves
|
||||
::
|
||||
++ test-prep
|
||||
:: .our explicitly set to not-a-galaxy to avoid failing %jael scry
|
||||
:: (can't control the scry product without virtualizing)
|
||||
::
|
||||
=/ bow=bowl:gall =>(*bowl:gall .(our ~marzod))
|
||||
=^ moves app (~(prep app bow *state:app) ~)
|
||||
%+ expect-eq
|
||||
!> ^- (list move:app)
|
||||
:~ [ost.bow %connect /dns/oauth [~ /dns/oauth] %dns]
|
||||
==
|
||||
!> moves
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user