Merge branch 'next/kelvin/411' into desk-publisher-switcher

This commit is contained in:
tinnus-napbus 2023-09-30 13:13:47 +13:00 committed by GitHub
commit 387a780ca9
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
23 changed files with 758 additions and 194 deletions

View File

@ -45,7 +45,6 @@
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
?+ mark (on-poke:def mark vase)
%handle-http-request
=+ !<([id=@ta req=inbound-request:eyre] vase)
@ -53,6 +52,7 @@
(handle-http-request id req)
::
%azimuth-action
?> (team:title our.bowl src.bowl)
=+ !<([%disconnect bind=binding:eyre] vase)
~& >>> "disconnecting at {<bind>}"
:_ this

View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[syd=desk her=ship sud=desk approve=? ~]
~
==
kiln-approve-merge+[[syd her sud] approve]

View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[auto=? ~]
~
==
kiln-global-automerge+auto

View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[syd=desk her=ship sud=desk auto=(unit ?) ~]
~
==
kiln-sync-automerge+[[syd her sud] auto]

16
pkg/arvo/gen/updates.hoon Normal file
View File

@ -0,0 +1,16 @@
/- h=hood
:- %say
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
:- %tang
^- tang
=+ .^ upd=sync-update:h
%gx
(scot %p p.bec)
%hood
(scot %da now)
/kiln/pending/noun
==
?> ?=(%pending -.upd)
%+ turn ~(tap in pending.upd)
|= [sync-record:h rev=@ud]
leaf+"{<syd>} <- {<her>}/{(trip sud)}/{<rev>}"

View File

@ -37,9 +37,12 @@
+$ pith-11
$: rem=(map desk per-desk)
nyz=@ud
zyn=(map kiln-sync sync-state)
zyn=(map sync-record sync-state)
:: requests from publishers to switch sync source
hop=(map dock dock)
:: toggle global update auto-merge
mer=?
::
commit-timer=[way=wire nex=@da tim=@dr mon=term]
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
@ -51,11 +54,12 @@
hxs=(map desk @ud)
==
::
+$ sync-state-10 [nun=@ta kid=(unit desk) let=@ud]
::
+$ pith-10
$: rem=(map desk per-desk)
nyz=@ud
zyn=(map kiln-sync sync-state)
zyn=(map sync-record sync-state-10)
commit-timer=[way=wire nex=@da tim=@dr mon=term]
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
@ -70,7 +74,7 @@
+$ pith-9
$: wef=(unit weft)
rem=(map desk per-desk)
syn=(map kiln-sync let=@ud)
syn=(map sync-record let=@ud)
ark=(map desk arak-9)
commit-timer=[way=wire nex=@da tim=@dr mon=term]
:: map desk to the currently ongoing fuse request
@ -98,7 +102,7 @@
+$ pith-7
$: wef=(unit weft)
rem=(map desk per-desk)
syn=(map kiln-sync let=@ud)
syn=(map sync-record let=@ud)
ark=(map desk arak-7)
commit-timer=[way=wire nex=@da tim=@dr mon=term]
:: map desk to the currently ongoing fuse request
@ -141,7 +145,7 @@
+$ pith-6
$: wef=(unit weft)
rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ark=(map desk arak-6) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
@ -159,7 +163,7 @@
::
+$ pith-5
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ark=(map desk arak-6) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
@ -174,7 +178,7 @@
::
+$ pith-4 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ark=(map desk arak-4) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
@ -195,7 +199,7 @@
==
+$ pith-3 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ark=(map desk arak-3) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
@ -221,7 +225,7 @@
::
+$ pith-2 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
fus=(map desk per-fuse)
@ -229,13 +233,13 @@
== ::
+$ pith-1 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
== ::
+$ pith-0 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
syn=(map sync-record let=@ud) ::
autoload-on=? ::
cur-hoon=@uvI ::
cur-arvo=@uvI ::
@ -265,16 +269,6 @@
pot=term ::
==
+$ kiln-unmount $@(term [knot path]) ::
+$ kiln-sync ::
$: syd=desk :: local desk
her=ship :: foreign ship
sud=desk :: foreign desk
==
+$ kiln-unsync ::
$: syd=desk :: local desk
her=ship :: foreign ship
sud=desk :: foreign desk
==
+$ kiln-merge ::
$@ ~
$: syd=desk ::
@ -459,7 +453,7 @@
=^ cards-9=(list card:agent:gall) old
?. ?=(%9 -.old)
`old
=/ syn=(set kiln-sync)
=/ syn=(set sync-record)
%- ~(gas in ~(key by syn.old))
%+ murn ~(tap by ark.old)
|= [=desk =arak-9]
@ -487,8 +481,8 @@
[%pass /kiln/load-zest %arvo %c %zest desk zest]
::
%+ turn ~(tap in syn)
|= k=kiln-sync
[%pass /kiln/load-sync %agent [our %hood] %poke %kiln-sync !>(k)]
|= r=sync-record
[%pass /kiln/load-sync %agent [our %hood] %poke %kiln-sync !>(r)]
::
=/ ks ~(tap in syn)
|- ^- (list card:agent:gall)
@ -503,7 +497,14 @@
==
::
=? old ?=(%10 -.old)
old(- %11, |4 [hop=~ |4.old])
%= old
- %11
|4 [hop=~ mer=& |4.old]
zyn %- ~(run by zyn.old)
|= sync-state-10
^- sync-state
[nun kid let ~ ~ |]
==
::
?> ?=(%11 -.old)
=. state old
@ -521,9 +522,10 @@
=/ ver (mergebase-hashes our %base now (~(got by sources) %base))
``noun+!>(?~(ver 0v0 i.ver))
::
[%x %kiln %jumps ~] ``kiln-jump+!>([%all hop])
[%x %kiln %syncs ~] ``noun+!>(zyn)
[%x %kiln %sources ~] ``noun+!>(sources)
[%x %kiln %jumps ~] ``kiln-jump+!>([%all hop])
[%x %kiln %syncs ~] ``noun+!>(zyn)
[%x %kiln %sources ~] ``noun+!>(sources)
[%x %kiln %automerge ~] ``loob+!>(mer)
[%x %kiln %pikes ~]
=+ .^(=rock:tire %cx /(scot %p our)//(scot %da now)/tire)
:^ ~ ~ %kiln-pikes
@ -534,6 +536,17 @@
=+ .^(hash=@uv %cz /(scot %p our)/[desk]/(scot %da now))
=/ sync (~(get by sources) desk)
[sync hash zest wic]
::
[%x %kiln %pending ~]
:^ ~ ~ %kiln-sync-update
!> ^- sync-update
:- %pending
%- ~(gas by *(set [sync-record @ud]))
^- (list [sync-record @ud])
%+ murn ~(tap by zyn)
|= [sync-record sync-state]
?~ hav ~
(some [syd her sud] u.hav)
==
::
:: +get-germ: select merge strategy into local desk
@ -553,11 +566,13 @@
|= [=mark =vase]
?> |(=(src our) =(%kiln-jump-ask mark))
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-approve-merge =;(f (f !<(_+<.f vase)) poke-approve-merge)
%kiln-autocommit =;(f (f !<(_+<.f vase)) poke-autocommit)
%kiln-bump =;(f (f !<(_+<.f vase)) poke-bump)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-sync-automerge =;(f (f !<(_+<.f vase)) poke-sync-automerge)
%kiln-fuse =;(f (f !<(_+<.f vase)) poke-fuse)
%kiln-fuse-list =;(f (f !<(_+<.f vase)) poke-fuse-list)
%kiln-gall-sear =;(f (f !<(_+<.f vase)) poke-gall-sear)
@ -576,6 +591,7 @@
%kiln-revive =;(f (f !<(_+<.f vase)) poke-revive)
%kiln-rein =;(f (f !<(_+<.f vase)) poke-rein)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-global-automerge =;(f (f !<(_+<.f vase)) poke-global-automerge)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
%kiln-suspend =;(f (f !<(_+<.f vase)) poke-suspend)
%kiln-suspend-many =;(f (f !<(_+<.f vase)) poke-suspend-many)
@ -586,6 +602,19 @@
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
==
::
++ poke-approve-merge
|= [sync-record approve=?]
?~ got=(~(get by zyn) syd her sud)
=+ msg="kiln: no syncs from {(scow %p her)}/{(trip sud)} to {<syd>}"
((slog leaf+msg ~) abet)
?~ hav.u.got
=+ msg="kiln: no updates from {(scow %p her)}/{(trip sud)} for {<syd>}"
((slog leaf+msg ~) abet)
=< abet
?. approve
abet:drop:(sync syd her sud)
abet:(merg /main syd):(sync syd her sud)
::
++ poke-autocommit
|= [mon=kiln-commit auto=?]
=< abet
@ -706,6 +735,23 @@
|= =ship
abet:(emit %pass /kiln %arvo %g %sear ship)
::
++ poke-global-automerge
|= auto=?
=. mer auto
?. mer abet
=/ zyns=(list [sync-record sync-state]) ~(tap by zyn)
=< abet
|-
?~ zyns ..abet
?. ?& ?=(^ hav.i.zyns)
!?=([~ %.n] nit.i.zyns)
==
$(zyns t.zyns)
%= $
zyns t.zyns
..abet abet:(merg /main syd):(sync -.i.zyns)
==
::
++ poke-info
|= [mez=tape tor=(unit toro)]
?~ tor
@ -719,17 +765,20 @@
?~ got=(~(get by rock) loc)
%dead
zest.u.got
=. zyn
=. ..abet
?~ got=(~(get by sources) loc)
zyn
(~(del by zyn) loc u.got)
..abet
?: =([her rem] u.got)
..abet
=. ..abet abet:drop:(sync loc u.got)
..abet(zyn (~(del by zyn) loc u.got))
=? ..abet ?=(%dead zest)
(emit %pass /kiln/install %arvo %c %zest loc ?:(=(our her) %live %held))
?: (~(has by zyn) loc her rem)
abet:(spam (render "already syncing" loc her rem ~) ~)
?: =([our loc] [her rem])
abet
=/ sun (sync loc her rem)
=/ sun okay:(sync loc her rem)
~> %slog.(fmt "beginning install into {here:sun}")
=< abet:abet:init
?: =(%base loc)
@ -737,7 +786,7 @@
sun
::
++ poke-kids
|= [hos=kiln-sync nex=(unit desk)]
|= [hos=sync-record nex=(unit desk)]
abet:abet:(apex:(sync hos) nex)
::
++ poke-label
@ -788,7 +837,7 @@
abet
=. hop (~(del by hop) old)
abet:(emit %give %fact ~[/jumps] %kiln-jump !>([%nay old u.had]))
?~ (skim ~(tap by sources) |=(kiln-sync =(old [her sud])))
?~ (skim ~(tap by sources) |=(sync-record =(old [her sud])))
~> %slog.(fmt "no syncs from {(scow %p p.old)}/{(trip q.old)}")
abet
=. hop (~(put by hop) old new)
@ -810,16 +859,20 @@
~> %slog.(fmt "denied jump from {txt-old} to {txt-new}")
=. hop (~(del by hop) old)
abet:(emit %give %fact ~[/jumps] %kiln-jump !>([%nay old new]))
=/ old-sources=(list kiln-sync)
(skim ~(tap by sources) |=(kiln-sync =(old [her sud])))
=/ new-sources=(list kiln-sync)
(turn old-sources |=(kiln-sync [syd new]))
=. zyn
=/ old-sources=(list sync-record)
(skim ~(tap by sources) |=(sync-record =(old [her sud])))
=/ new-sources=(list sync-record)
(turn old-sources |=(sync-record [syd new]))
=. ..abet
(emit %give %fact ~[/jumps] %kiln-jump !>([%yea old new]))
=. ..abet
|-
?~ old-sources zyn
$(old-sources t.old-sources, zyn (~(del by zyn) i.old-sources))
?~ old-sources
..abet
=. ..abet abet:drop:(sync i.old-sources)
=. zyn (~(del by zyn) i.old-sources)
$(old-sources t.old-sources, ..abet ..abet)
=. hop (~(del by hop) old)
=. ..abet (emit %give %fact ~[/jumps] %kiln-jump !>([%yea old new]))
=< abet
|- ^+ ..abet
?~ new-sources ..abet
@ -902,11 +955,28 @@
|=(=desk [%pass /kiln/suspend %arvo %c %zest desk %dead])
::
++ poke-sync
|= hos=kiln-sync
?: (~(has by zyn) hos)
abet:(spam (render "already syncing" [sud her syd ~]:hos) ~)
~> %slog.(fmt "beginning sync into {<syd.hos>} from {<her.hos>}/{<sud.hos>}")
abet:abet:init:(sync hos)
|= sync-record
?: (~(has by zyn) sud her syd)
abet:(spam (render "already syncing" [sud her syd ~]) ~)
=. ..abet
?~ got=(~(get by sources) syd)
..abet
=. ..abet abet:drop:(sync syd u.got)
..abet(zyn (~(del by zyn) syd u.got))
~> %slog.(fmt "beginning sync into {<syd>} from {<her>}/{<sud>}")
abet:abet:init:(sync syd her sud)
::
++ poke-sync-automerge
|= [sync-record auto=(unit ?)]
?~ got=(~(get by zyn) syd her sud)
=+ msg="kiln: no syncs from {(scow %p her)}/{(trip sud)} to {<syd>}"
((slog leaf+msg ~) abet)
=. zyn (~(put by zyn) [syd her sud] u.got(nit auto))
?~ hav.u.got
abet
?. |(?=([~ %.y] auto) &(mer ?=(~ auto)))
abet
abet:abet:(merg /main syd):(sync [syd her sud])
::
++ poke-syncs :: print sync config
|= ~
@ -914,7 +984,7 @@
?: =(0 ~(wyt by zyn))
[%leaf "no syncs configured"]~
%+ turn ~(tap by zyn)
|= [kiln-sync sync-state]
|= [sync-record sync-state]
(render "sync configured" sud her syd kid)
::
++ poke-uninstall
@ -942,9 +1012,10 @@
:: Don't need to cancel anything because new syncs will get a new nonce
::
++ poke-unsync
|= hus=kiln-unsync
|= hus=sync-record
?~ got=(~(get by zyn) hus)
abet:(spam (render "not syncing" [sud her syd ~]:hus) ~)
=. ..abet abet:drop:(sync hus)
=. zyn (~(del by zyn) hus)
abet:(spam (render "cancelling sync" sud.hus her.hus syd.hus kid.u.got) ~)
:: +peer: handle %watch
@ -958,6 +1029,20 @@
::
[%jumps ~]
abet:(emit %give %fact ~ %kiln-jump !>([%all hop]))
::
[%updates ~]
=< abet
%- emit
:^ %give %fact ~
:- %kiln-sync-update
!> ^- sync-update
:- %pending
%- ~(gas by *(set [sync-record @ud]))
^- (list [sync-record @ud])
%+ murn ~(tap by zyn)
|= [sync-record sync-state]
?~ hav ~
(some [syd her sud] u.hav)
==
::
++ take-agent
@ -1183,15 +1268,30 @@
abet:abet:(take:(sync syd her sud) t.t.t.wire sign-arvo)
::
++ sync
|= kiln-sync
|= sync-record
=/ got (~(get by zyn) syd her sud)
=+ `sync-state`(fall got [(scot %uv nyz) ~ *@ud])
=+ `sync-state`(fall got [(scot %uv nyz) ~ *@ud ~ ~ |])
=? nyz ?=(~ got) +(nyz)
|%
++ abet ..sync(zyn (~(put by zyn) [syd her sud] nun kid let))
++ abet ..sync(zyn (~(put by zyn) [syd her sud] nun kid let nit hav yea))
++ apex |=(nex=(unit desk) ..abet(kid nex))
++ emit |=(card:agent:gall ..abet(kiln (^emit +<)))
++ emil |=((list card:agent:gall) ..abet(kiln (^emil +<)))
++ okay ..abet(yea &)
++ gain
=. hav `(dec let)
=/ upd=sync-update [%new [syd her sud] (dec let)]
(emit %give %fact ~[/update] %kiln-sync-update !>(upd))
++ drop
=? ..abet ?=(^ hav)
=/ upd=sync-update [%drop [syd her sud] u.hav]
(emit %give %fact ~[/updates] %kiln-sync-update !>(upd))
..abet(hav ~, yea |)
++ tada
=? ..abet ?=(^ hav)
=/ upd=sync-update [%done [syd her sud] u.hav]
(emit %give %fact ~[/updates] %kiln-sync-update !>(upd))
..abet(hav ~, yea |)
++ here "{<syd>} from {<her>}/{<sud>}"
++ ware
|= =wire
@ -1206,7 +1306,6 @@
%merg desk her sud
ud+(dec let) (get-germ desk)
==
::
:: (re)Start a sync from scratch by finding what version the source
:: desk is at
::
@ -1234,8 +1333,8 @@
?> ?=(^ riot)
:: The syncs may have changed, so get the latest
::
;< zyx=(map kiln-sync sync-state) bind:m
(scry:strandio (map kiln-sync sync-state) /gx/hood/kiln/syncs/noun)
;< zyx=(map sync-record sync-state) bind:m
(scry:strandio (map sync-record sync-state) /gx/hood/kiln/syncs/noun)
?. (~(has by zyx) syd her sud)
(pure:m !>(%done))
~> %slog.(fmt "downloading update for {here}")
@ -1280,6 +1379,7 @@
?: ?=(%| -.p.sign-arvo)
:: ~> %slog.(fmt "download failed into {here}; retrying sync")
:: %- (slog p.p.sign-arvo)
=. ..abet drop
init
::
~> %slog.(fmt "finished downloading update for {here}")
@ -1287,7 +1387,7 @@
:: If nothing changed, just ensure %kids is up-to-date and advance
::
?. (get-remote-diff our syd now [her sud (dec let)])
=< next
=< next:drop
?~ kid
~> %slog.(fmt "remote is identical to {here}, skipping")
..abet
@ -1296,15 +1396,22 @@
..abet
~> %slog.(fmt "remote is identical to {here}, merging into {<u.kid>}")
(merg /kids u.kid)
:: wait for approval if can't automerge & signal available update
::
?. |(=(our her) yea =([~ &] nit) &(=(~ nit) mer))
=. ..abet gain
next
:: Else start merging, but also immediately start listening to
:: the next revision. Now, all errors should no-op -- we're
:: already waiting for the next revision.
::
=. yea |
=. ..abet (merg /main syd)
next
::
%main
%main
?> ?=(%mere +<.sign-arvo)
=< tada
?: ?=(%| -.p.sign-arvo)
=+ "kiln: merge into {here} failed, waiting for next revision"
%- (slog leaf/- p.p.sign-arvo)

View File

@ -0,0 +1 @@
../../../base-dev/mar/kiln/approve-merge.hoon

View File

@ -1,22 +0,0 @@
::
:::: /hoon/jump-opt/kiln/mar
::
|_ req=[old=dock new=dock yea=?]
::
++ grow
|%
++ noun req
--
++ grab
|%
++ noun ,[dock dock ?]
++ json
=, dejs:format
%- ot
:~ [%old (ot ship+(se %p) desk+so ~)]
[%new (ot ship+(se %p) desk+so ~)]
[%yea bo]
==
--
++ grad %noun
--

View File

@ -0,0 +1 @@
../../../base-dev/mar/kiln/jump-opt.hoon

View File

@ -0,0 +1 @@
../../../base-dev/mar/kiln/sync-update.hoon

View File

@ -9238,21 +9238,21 @@
::
++ mint
|= gol=type
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
^- (pair type nock)
=+ lug=(find %read hyp)
?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.lug))
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
(ergo p.lug rig)
::
++ mull
|= [gol=type dox=type]
^- [type type]
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
^- (pair type type)
=+ lug=[p=(find %read hyp) q=(find(sut dox) %read hyp)]
?: ?=(%| -.p.lug)
?> &(?=(%| -.q.lug) ?=(~ rig))
[p.p.p.lug p.p.q.lug]
?> ?=(%& -.q.lug)
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
(endo [p.p.lug p.q.lug] dox rig)
--
::

View File

@ -764,6 +764,7 @@
:: Messaging Tasks
::
:: %hear: packet from unix
:: %dear: lane from unix
:: %heed: track peer's responsiveness; gives %clog if slow
:: %jilt: stop tracking peer's responsiveness
:: %cork: request to delete message flow
@ -787,13 +788,14 @@
:: %snub: set packet blocklist to .ships
:: %spew: set verbosity toggles
:: %cong: adjust congestion control parameters
:: %stir: recover from timer desync
:: %stir: recover from timer desync and assorted debug commands
:: %trim: release memory
:: %vega: kernel reload notification
::
+$ task
$+ ames-task
$% [%hear =lane =blob]
[%dear =ship =lane]
[%heed =ship]
[%jilt =ship]
[%cork =ship]

View File

@ -556,7 +556,7 @@
:: bug: debug printing configuration
:: snub: blocklist for incoming packets
:: cong: parameters for marking a flow as clogged
:: dead: dead flow consolidation timer, if set
:: dead: dead flow consolidation timer and recork timer, if set
::
+$ ames-state
$+ ames-state
@ -1786,8 +1786,6 @@
=^ moz u.cached-state
?. ?=(%16 -.u.cached-state) [~ u.cached-state]
:_ 17+(state-16-to-17:load:adult-core +.u.cached-state)
~> %slog.0^leaf/"ames: init dead flow consolidation timer"
:- [[/ames]~ %pass /dead-flow %b %wait `@da`(add now ~m2)]
?^ moz moz :: if we have just added the timer in state-7-to-8, skip
=; recork-timer=(list [@da duct])
?^ recork-timer ~
@ -2009,15 +2007,44 @@
event-core
:: +on-stir: recover from timer desync, setting new timers as needed
::
:: .arg is unused, meant to ease future debug commands
:: .arg can be %rift or %dead
::
++ on-stir
|= arg=@t
^+ event-core
|^ ?+ arg do-stir
%rift do-rift
%dead do-dead
==
::
++ do-dead
=/ ded=(unit dead-timer) +.flow.dead.ames-state
?^ ded
%- (slog leaf+"ames: turning off dead flow consolidation" ~)
=. event-core
(emit:event-core duct.u.ded %pass wire.u.ded %b %rest date.u.ded)
(wake-dead-flows:event-core %.n ~)
::
%- (slog leaf+"ames: switching to dead flow consolidation" ~)
=; cor=event-core
(wake-dead-flows:cor %.y ~)
%- ~(rep by peers.ames-state:event-core)
|= [[=ship =ship-state] core=_event-core]
^+ event-core
=/ peer-state=(unit peer-state) (get-peer-state:core ship)
?~ peer-state core
%- ~(rep by snd.u.peer-state)
|= [[=bone =message-pump-state] cor=_core]
^+ event-core
=/ next-wake next-wake.packet-pump-state.message-pump-state
?. ?& =(~m2 rto.metrics.packet-pump-state.message-pump-state)
?=(^ next-wake)
==
cor
=/ peer-core (abed-peer:pe:cor ship u.peer-state)
=/ message-pump (abed:mu:peer-core bone)
abet:(pu-emit:packet-pump:message-pump %b %rest u.next-wake)
::
++ do-rift
=/ =rift
=- ~|(%no-rift (,@ q.q:(need (need -))))
@ -2092,6 +2119,27 @@
%^ enqueue-alien-todo ship ship-state
|= todos=alien-agenda
todos(heeds (~(del in heeds.todos) duct))
:: +on-dear: handle lane from unix
::
++ on-dear
|= [=ship =lane]
^+ event-core
?: ?=(%.y -.lane)
event-core
=/ ip=@if (end [0 32] p.lane)
=/ pt=@ud (cut 0 [32 16] p.lane)
?: =(%czar (clan:title ship))
%- %^ ev-trace odd.veb ship
|.("ignoring %dear lane {(scow %if ip)}:{(scow %ud pt)} for galaxy")
event-core
=/ peer-state=(unit peer-state) (get-peer-state ship)
?~ peer-state
%- %^ ev-trace odd.veb ship
|.("no peer-state for ship, ignoring %dear")
event-core
%- %^ ev-trace rcv.veb ship
|.("incoming %dear lane {(scow %if ip)}:{(scow %ud pt)}")
abet:(on-dear:(abed-peer:pe ship u.peer-state) lane)
:: +on-hear: handle raw packet receipt
::
++ on-hear
@ -2433,6 +2481,35 @@
++ cork-bone |=(=bone abet:(on-cork-flow:peer-core bone))
++ kill-bone |=(=bone abet:(on-kill-flow:peer-core bone))
--
:: +wake-dead-flow: call on-wake on all dead flows, optionally setting new
:: dead flow timer
::
++ wake-dead-flows
|= [set-new-timer=? error=(unit tang)]
^+ event-core
=. flow.dead.ames-state.event-core
?. set-new-timer
flow/~
flow/`[~[/ames] /dead-flow `@da`(add now ~m2)]
=. event-core
?. set-new-timer
event-core
(emit:event-core ~[/ames] %pass /dead-flow %b %wait `@da`(add now ~m2))
%- ~(rep by peers.ames-state:event-core)
|= [[=ship =ship-state] core=_event-core]
^+ event-core
=/ peer-state=(unit peer-state) (get-peer-state:core ship)
?~ peer-state core
=/ peer-core (abed-peer:pe:core ship u.peer-state)
=< abet
^+ peer-core
%- ~(rep by snd.u.peer-state)
|= [[=bone =message-pump-state] cor=_peer-core]
?. ?& =(~m2 rto.metrics.packet-pump-state.message-pump-state)
?=(^ next-wake.packet-pump-state.message-pump-state)
==
cor
(on-wake:cor bone error)
:: +on-take-wake: receive wakeup or error notification from behn
::
++ on-take-wake
@ -2453,22 +2530,7 @@
(request-attestation u.ship)
::
?: ?=([%dead-flow ~] wire)
=; cor=event-core
=. flow.dead.ames-state.cor
flow/`[~[/ames] /dead-flow `@da`(add now ~m2)]
(emit:cor duct %pass /dead-flow %b %wait `@da`(add now ~m2))
%- ~(rep by peers.ames-state)
|= [[=ship =ship-state] core=_event-core]
^+ event-core
=/ peer-state=(unit peer-state) (get-peer-state:core ship)
?~ peer-state core
%- ~(rep by snd.u.peer-state)
|= [[=bone =message-pump-state] cor=_core]
?. ?& =(~m2 rto.metrics.packet-pump-state.message-pump-state)
?=(^ next-wake.packet-pump-state.message-pump-state)
==
cor
abet:(on-wake:(abed-peer:pe:cor ship u.peer-state) bone error)
(wake-dead-flows %.y error)
::
?. ?=([%recork ~] wire)
=/ res=(unit ?([%fine her=ship =^wire] [%pump her=ship =bone]))
@ -2837,17 +2899,15 @@
::
=* duct unix-duct.ames-state
::
=^ dead-moves dead.ames-state
?. ?=([~ ~] [+.flow +.cork]:dead.ames-state)
`dead.ames-state
:- :- [~[/ames] %pass /dead-flow %b %wait `@da`(add now ~m2)]
[~[/ames] %pass /recork %b %wait `@da`(add now ~d1)]~
:- flow/`[~[/ames] /dead-flow `@da`(add now ~m2)]
cork/`[~[/ames] /recork `@da`(add now ~d1)]
=^ cork-moves cork.dead.ames-state
?. ?=(~ +.cork.dead.ames-state)
`cork.dead.ames-state
:- [~[/ames] %pass /recork %b %wait `@da`(add now ~d1)]~
cork/`[~[/ames] /recork `@da`(add now ~d1)]
::
%- emil
%+ weld
dead-moves
cork-moves
^- (list move)
:~ [duct %give %turf turfs]
[duct %pass /ping %g %deal [our our /ames] %ping %poke %noun !>(%kick)]
@ -3273,6 +3333,11 @@
=. keens (~(put by keens) path *keen-state)
fi-abet:(fi-start:(abed:fi path) duct)
::
++ on-dear
|= =lane
^+ peer-core
peer-core(route.peer-state `[%.y lane])
::
++ on-tame
^+ peer-core
peer-core(route.peer-state ~)
@ -4071,7 +4136,7 @@
:: and we don't want to consolidate that
::
=? peer-core ?=(^ new-wake)
?: =(~m2 rto.metrics.state)
?: ?&(?=(^ +.flow.dead.ames-state) =(~m2 rto.metrics.state))
peer-core
(pu-emit %b %wait u.new-wake)
::
@ -4934,6 +4999,7 @@
?- -.task
%born on-born:event-core
%hear (on-hear:event-core [lane blob ~]:task)
%dear (on-dear:event-core +.task)
%heed (on-heed:event-core ship.task)
%init on-init:event-core
%jilt (on-jilt:event-core ship.task)
@ -5173,7 +5239,7 @@
%= old
cong
:+ cong.old
flow/`[~[/ames] /dead-flow `@da`(add now ~m2)]
flow/~
cork/`[~[/ames] /recork `@da`(add now ~d1)]
::
peers

View File

@ -4315,8 +4315,12 @@
:- -:!>(*(map lobe page))
^- (map lobe page)
%- %~ rep in
%- reachable-takos
(~(got by hit.dom) let.dom)
|- ^- (set tako)
=/ ts=(set tako)
%- reachable-takos
(~(got by hit.dom) let.dom)
?: (lte let.dom 1) ts
(~(uni in ts) $(let.dom (dec let.dom)))
|= [t=tako o=(map lobe page)]
%- ~(gas by o)
%+ turn
@ -4533,7 +4537,12 @@
?. ?| =(0v0 tak)
?& (~(has by hut.ran) tak)
?| (~(any by hit.dom) |=(=tako =(tak tako))) :: fast-path
(~(has in (reachable-takos (aeon-to-tako:ze let.dom))) tak)
|- ^- ?
?: (lte let.dom 1)
%.n
?| (~(has in (reachable-takos (aeon-to-tako:ze let.dom))) tak)
$(let.dom (dec let.dom))
==
==
|(?=(~ for) (may-read u.for care.mun tak path.mun))
== ==

View File

@ -789,8 +789,7 @@
%. (~(put by connections.state) duct connection)
(trace 2 |.("{<duct>} creating local"))
::
:_ state
(subscribe-to-app [%ours ~] app.act inbound-request.connection)
(request-to-app [%ours ~] app.act inbound-request.connection)
:: +request: starts handling an inbound http request
::
++ request
@ -899,6 +898,15 @@
=- (fall - '*')
(get-header:http 'access-control-request-headers' headers)
==
:: handle HTTP scries
::
:: TODO: ideally this would look more like:
::
:: ?^ p=(parse-http-scry url.request)
:: (handle-http-scry authenticated p request)
::
?: =('/_~_/' (end [3 5] url.request))
(handle-http-scry authenticated request)
:: handle requests to the cache
::
=/ entry (~(get by cache.state) url.request)
@ -964,8 +972,7 @@
==
::
%app
:_ state
(subscribe-to-app identity app.action inbound-request.connection)
(request-to-app identity app.action inbound-request.connection)
::
%authentication
(handle-request:authentication secure host address [suv identity] request)
@ -1005,6 +1012,44 @@
=/ nom=@p
?+(-.identity who.identity %ours our)
(as-octs:mimes:html (scot %p nom))
:: +handle-http-scry: respond with scry result
::
++ handle-http-scry
|= [authenticated=? =request:http]
|^ ^- (quip move server-state)
?. authenticated (error-response 403 ~)
?. =(%'GET' method.request)
(error-response 405 "may only GET scries")
=/ req (parse-request-line url.request)
=/ fqp (fully-qualified site.req)
=/ mym (scry-mime now rof ext.req site.req)
?: ?=(%| -.mym) (error-response 500 p.mym)
=* mime p.mym
%- handle-response
:* %start
:- status-code=200
^= headers
:~ ['content-type' (rsh 3 (spat p.mime))]
['content-length' (crip (format-ud-as-integer p.q.mime))]
['cache-control' ?:(fqp 'max-age=31536000' 'no-cache')]
==
data=[~ q.mime]
complete=%.y
==
::
++ fully-qualified
|= a=path
^- ?
?. ?=([%'_~_' @ @ @ *] a) %.n
=/ vez (vang | (en-beam [our %base da+now] ~))
?= [~ [^ ^ ^ *]] (rush (spat t.t.a) ;~(pfix fas gash:vez))
::
++ error-response
|= [status=@ud =tape]
^- (quip move server-state)
%^ return-static-data-on-duct status 'text/html'
(error-page status authenticated url.request tape)
--
:: +handle-cache-req: respond with cached value, 404 or 500
::
++ handle-cache-req
@ -1100,11 +1145,24 @@
%^ return-static-data-on-duct status 'text/html'
(error-page status authenticated url.request tape)
--
:: +subscribe-to-app: subscribe to app and poke it with request data
:: +request-to-app: subscribe to app and poke it with request data
::
++ subscribe-to-app
++ request-to-app
|= [=identity app=term =inbound-request:eyre]
^- (list move)
^- (quip move server-state)
:: if the agent isn't running, we synchronously serve a 503
::
?. !<(? q:(need (need (rof ~ /eyre %gu [our app da+now] /$))))
%^ return-static-data-on-duct 503 'text/html'
%: error-page
503
?=(%ours -.identity)
url.request.inbound-request
"%{(trip app)} not running"
==
:: otherwise, subscribe to the agent and poke it with the request
::
:_ state
:~ %+ deal-as
/watch-response/[eyre-id]
[identity our app %watch /http-response/[eyre-id]]
@ -1347,14 +1405,15 @@
^- (unit @uv)
:: are there cookies passed with this request?
::
:: TODO: In HTTP2, the client is allowed to put multiple 'Cookie'
:: headers.
=/ cookie-header=@t
%+ roll header-list.request
|= [[key=@t value=@t] c=@t]
?. =(key 'cookie')
c
(cat 3 (cat 3 c ?~(c 0 '; ')) value)
:: is the cookie line valid?
::
?~ cookie-header=(get-header:http 'cookie' header-list.request)
~
:: is the cookie line is valid?
::
?~ cookies=(rush u.cookie-header cock:de-purl:html)
?~ cookies=(rush cookie-header cock:de-purl:html)
~
:: is there an urbauth cookie?
::
@ -2111,7 +2170,7 @@
duct-to-key.channel-state
(~(del by duct-to-key.channel-state.state) duct)
==
:: +set-timeout-timer-for: sets a timeout timer on a channel
:: +update-timeout-timer-for: sets a timeout timer on a channel
::
:: This creates a channel if it doesn't exist, cancels existing timers
:: if they're already set (we cannot have duplicate timers), and (if
@ -2185,53 +2244,76 @@
++ on-get-request
|= [channel-id=@t [session-id=@uv =identity] =request:http]
^- [(list move) server-state]
:: if there's no channel-id, we must 404
::TODO but arm description says otherwise?
::
?~ maybe-channel=(~(get by session.channel-state.state) channel-id)
%^ return-static-data-on-duct 404 'text/html'
(error-page 404 | url.request ~)
:: find the channel creator's identity, make sure it matches
::
?. =(identity identity.u.maybe-channel)
%^ return-static-data-on-duct 403 'text/html'
(error-page 403 | url.request ~)
:: find the requested "mode" and make sure it doesn't conflict
::
=/ mode=?(%json %jam)
(find-channel-mode %'GET' header-list.request)
?. =(mode mode.u.maybe-channel)
%^ return-static-data-on-duct 406 'text/html'
=; msg=tape (error-page 406 %.y url.request msg)
"channel already established in {(trip mode.u.maybe-channel)} mode"
:: when opening an event-stream, we must cancel our timeout timer
:: if there's no duct already bound. Else, kill the old request
:: and replace it
::
=^ cancel-moves state
?. ?=([%| *] state.u.maybe-channel)
:_ state
(cancel-timeout-move channel-id p.state.u.maybe-channel)^~
=/ cancel-heartbeat
?~ heartbeat.u.maybe-channel ~
:_ ~
%+ cancel-heartbeat-move channel-id
[date duct]:u.heartbeat.u.maybe-channel
=- [(weld cancel-heartbeat -<) ->]
(handle-response(duct p.state.u.maybe-channel) [%cancel ~])
:: the request may include a 'Last-Event-Id' header
::
=/ maybe-last-event-id=(unit @ud)
?~ maybe-raw-header=(get-header:http 'last-event-id' header-list.request)
~
(rush u.maybe-raw-header dum:ag)
:: flush events older than the passed in 'Last-Event-ID'
::
=? state ?=(^ maybe-last-event-id)
(acknowledge-events channel-id u.maybe-last-event-id)
:: combine the remaining queued events to send to the client
::
=/ event-replay=wall
=^ [exit=? =wall moves=(list move)] state
:: the request may include a 'Last-Event-Id' header
::
=/ maybe-last-event-id=(unit @ud)
?~ maybe-raw-header=(get-header:http 'last-event-id' header-list.request)
~
(rush u.maybe-raw-header dum:ag)
:: if the channel doesn't exist yet, simply instantiate it here
::
?~ maybe-channel=(~(get by session.channel-state.state) channel-id)
=- [[| ~ ~] state(session.channel-state -)]
%+ ~(put by session.channel-state.state) channel-id
::NOTE some other fields initialized at the end of this arm
%* . *channel
identity identity
next-id (fall maybe-last-event-id 0)
last-ack now
==
:: if the channel does exist, we put some demands on the get request,
:: and may need to do some cleanup for prior requests.
::
:: find the channel creator's identity, make sure it matches
::
?. =(identity identity.u.maybe-channel)
=^ mos state
%^ return-static-data-on-duct 403 'text/html'
(error-page 403 | url.request ~)
[[& ~ mos] state]
:: make sure the request "mode" doesn't conflict with a prior request
::
::TODO or could we change that on the spot, given that only a single
:: request will ever be listening to this channel?
?. =(mode mode.u.maybe-channel)
=^ mos state
%^ return-static-data-on-duct 406 'text/html'
=; msg=tape (error-page 406 %.y url.request msg)
"channel already established in {(trip mode.u.maybe-channel)} mode"
[[& ~ mos] state]
:: when opening an event-stream, we must cancel our timeout timer
:: if there's no duct already bound. else, kill the old request,
:: we will replace its duct at the end of this arm
::
=^ cancel-moves state
?: ?=([%& *] state.u.maybe-channel)
:_ state
(cancel-timeout-move channel-id p.state.u.maybe-channel)^~
=. duct-to-key.channel-state.state
(~(del by duct-to-key.channel-state.state) p.state.u.maybe-channel)
=/ cancel-heartbeat
?~ heartbeat.u.maybe-channel ~
:_ ~
%+ cancel-heartbeat-move channel-id
[date duct]:u.heartbeat.u.maybe-channel
=- [(weld cancel-heartbeat -<) ->]
(handle-response(duct p.state.u.maybe-channel) [%cancel ~])
:: flush events older than the passed in 'Last-Event-ID'
::
=? state ?=(^ maybe-last-event-id)
(acknowledge-events channel-id u.maybe-last-event-id)
::TODO that did not remove them from the u.maybe-channel queue though!
:: we may want to account for maybe-last-event-id, for efficiency.
:: (the client _should_ ignore events it heard previously if we do
:: end up re-sending them, but _requiring_ that feels kinda risky)
::
:: combine the remaining queued events to send to the client
::
=; event-replay=wall
[[| - cancel-moves] state]
%- zing
%- flop
=/ queue events.u.maybe-channel
@ -2249,6 +2331,7 @@
(channel-event-to-tape u.maybe-channel request-id channel-event)
?~ said $
$(events [(event-tape-to-wall id +.u.said) events])
?: exit [moves state]
:: send the start event to the client
::
=^ http-moves state
@ -2259,7 +2342,7 @@
['cache-control' 'no-cache']
['connection' 'keep-alive']
==
(wall-to-octs event-replay)
(wall-to-octs wall)
complete=%.n
==
:: associate this duct with this session key
@ -2289,7 +2372,7 @@
heartbeat (some [heartbeat-time duct])
==
::
[[heartbeat :(weld http-moves cancel-moves moves)] state]
[[heartbeat :(weld http-moves moves)] state]
:: +acknowledge-events: removes events before :last-event-id on :channel-id
::
++ acknowledge-events
@ -2337,11 +2420,6 @@
?: ?=(%| -.maybe-requests)
%^ return-static-data-on-duct 400 'text/html'
(error-page 400 & url.request (trip p.maybe-requests))
:: while weird, the request list could be empty
::
?: =(~ p.maybe-requests)
%^ return-static-data-on-duct 400 'text/html'
(error-page 400 %.y url.request "empty list of actions")
:: check for the existence of the channel-id
::
:: if we have no session, create a new one set to expire in
@ -3020,6 +3098,7 @@
::
?: ?| ?=([%'~' *] path.binding) :: eyre
?=([%'~_~' *] path.binding) :: runtime
?=([%'_~_' *] path.binding) :: scries
==
[| bindings.state]
[& (insert-binding [binding duct action] bindings.state)]
@ -3220,6 +3299,69 @@
:: need to issue a %leave after we've forgotten the identity with
:: which the subscription was opened.
/(scot %p ship)/[app]/(scot %p from)
::
++ scry-mime
|= [now=@da rof=roof ext=(unit @ta) pax=path]
|^ ^- (each mime tape)
:: parse
::
=/ u=(unit [view=term bem=beam])
?. ?=([@ @ @ @ *] pax) ~
?~ view=(slaw %tas i.t.pax) ~
?~ path=(expand-path t.t.pax) ~
?~ beam=(de-beam u.path) ~
`[u.view u.beam]
?~ u [%| "invalid scry path"]
:: perform scry
::
?~ res=(rof ~ /eyre u.u) [%| "failed scry"]
?~ u.res [%| "no scry result"]
=* mark p.u.u.res
=* vase q.u.u.res
:: convert to mime via ext
::
=/ dysk (conversion-desk u.u)
?: ?=(%| -.dysk) [%| p.dysk]
=/ ext (fall ext %mime)
=/ mym (convert vase mark ext p.dysk)
?: ?=(%| -.mym) [%| p.mym]
=/ mym (convert p.mym ext %mime p.dysk)
?: ?=(%| -.mym) [%| p.mym]
[%& !<(mime p.mym)]
::
++ expand-path
|= a=path
^- (unit path)
=/ vez (vang | (en-beam [our %base da+now] ~))
(rush (spat a) (sear plex:vez (stag %clsg ;~(pfix fas poor:vez))))
::
++ conversion-desk
|= [view=term =beam]
^- (each desk tape)
?: =(%$ q.beam) [%& %base]
?+ (end 3 view) [%& %base]
%c
[%& q.beam]
%g
=/ res (rof ~ /eyre %gd [our q.beam da+now] /$)
?. ?=([~ ~ *] res)
[%| "no desk for app {<q.beam>}"]
[%& !<(=desk q.u.u.res)]
==
::
++ convert
|= [=vase from=mark to=mark =desk]
^- (each ^vase tape)
?: =(from to) [%& vase]
=/ tub (rof ~ /eyre %cc [our desk da+now] /[from]/[to])
?. ?=([~ ~ %tube *] tub)
[%| "no tube from {(trip from)} to {(trip to)}"]
=/ tube !<(tube:clay q.u.u.tub)
=/ res (mule |.((tube vase)))
?: ?=(%| -.res)
[%| "failed tube from {(trip from)} to {(trip to)}"]
[%& +.res]
--
--
:: end the =~
::
@ -4044,6 +4186,11 @@
?. =(u.aeon aeon.u.entry) [~ ~]
?~ val=val.u.entry [~ ~]
``noun+!>(u.val)
::
[%'_~_' *]
=/ mym (scry-mime now rof (deft:de-purl:html tyl))
?: ?=(%| -.mym) [~ ~]
``noun+!>(p.mym)
==
?. ?=(%$ ren)
[~ ~]

View File

@ -11,7 +11,7 @@
::
+$ lick-state
$: %0
unix-duct=duct
unix-duct=_`duct`[//lick ~]
owners=(map name duct)
==
::

View File

@ -0,0 +1,22 @@
::
:::: /hoon/approve-merge/kiln/mar
::
/- h=hood
|_ req=[sync-record:h approve=?]
::
++ grow
|%
++ noun req
--
++ grab
|%
++ noun ,[sync-record:h approve=?]
++ json
=, dejs:format
%- ot
:~ [%sync (ot syd+so her+(se %p) sud+so ~)]
[%approve bo]
==
--
++ grad %noun
--

View File

@ -0,0 +1,16 @@
::
:::: /hoon/jump-ask/kiln/mar
::
/? 310
|_ req=[old=dock new=dock]
::
++ grow
|%
++ noun req
--
++ grab
|%
++ noun ,[dock dock]
--
++ grad %noun
--

View File

@ -0,0 +1,22 @@
::
:::: /hoon/jump-opt/kiln/mar
::
|_ req=[old=dock new=dock yea=?]
::
++ grow
|%
++ noun req
--
++ grab
|%
++ noun ,[dock dock ?]
++ json
=, dejs:format
%- ot
:~ [%old (ot ship+(se %p) desk+so ~)]
[%new (ot ship+(se %p) desk+so ~)]
[%yea bo]
==
--
++ grad %noun
--

View File

@ -0,0 +1,43 @@
::
:::: /hoon/jump/kiln/mar
::
/- h=hood
|_ jum=jump:h
::
++ grow
|%
++ noun jum
++ json
=, enjs:format
|^ ^- ^json
?- -.jum
%add
%+ frond 'add'
(pairs ['old' (en-dock old.jum)] ['new' (en-dock new.jum)] ~)
::
%yea
%+ frond 'yea'
(pairs ['old' (en-dock old.jum)] ['new' (en-dock new.jum)] ~)
::
%nay
%+ frond 'nay'
(pairs ['old' (en-dock old.jum)] ['new' (en-dock new.jum)] ~)
::
%all
%+ frond 'all'
:- %a
%+ turn ~(tap by all.jum)
|= [old=dock new=dock]
(pairs ['old' (en-dock old)] ['new' (en-dock new)] ~)
==
++ en-dock
|= =dock
(pairs ['ship' s+(scot %p p.dock)] ['desk' s+q.dock] ~)
--
--
++ grab
|%
++ noun jump:h
--
++ grad %noun
--

View File

@ -0,0 +1,50 @@
::
:::: /hoon/sync-update/kiln/mar
::
/- h=hood
|_ upd=sync-update:h
::
++ grow
|%
++ noun upd
++ json
=, enjs:format
|^ ^- ^json
?- -.upd
%new
%+ frond 'new'
(pairs ['for' (en-sync-record for.upd)] ['rev' (numb rev.upd)] ~)
::
%done
%+ frond 'done'
(pairs ['for' (en-sync-record for.upd)] ['rev' (numb rev.upd)] ~)
::
%drop
%+ frond 'drop'
(pairs ['for' (en-sync-record for.upd)] ['rev' (numb rev.upd)] ~)
::
%pending
%+ frond 'pending'
:- %a
%+ turn ~(tap by pending.upd)
|= [for=sync-record:h rev=@ud]
%- pairs
:~ ['for' (en-sync-record for)]
['rev' (numb rev)]
==
==
++ en-sync-record
|= sync-record:h
%- pairs
:~ ['syd' s+syd]
['her' s+(scot %p her)]
['sud' s+sud]
==
--
--
++ grab
|%
++ noun sync-update:h
--
++ grad %noun
--

View File

@ -21,8 +21,30 @@
:: $rung: reference to upstream commit
::
+$ rung [=aeon =weft]
:: #sync-record: source and destination of a kiln sync
::
+$ sync-record ::
$: syd=desk :: local desk
her=ship :: foreign ship
sud=desk :: foreign desk
==
::
+$ sync-state ::
$: nun=@ta :: nonce
kid=(unit desk) :: has kids desk too?
let=@ud :: next revision
nit=(unit ?) :: automerge or default
hav=(unit @ud) :: update available
yea=? :: update approved
==
::
+$ sync-update
$% [%new for=sync-record rev=@ud]
[%done for=sync-record rev=@ud]
[%drop for=sync-record rev=@ud]
[%pending pending=(set [for=sync-record rev=@ud])]
==
::
+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
:: +truncate-hash: get last 5 digits of hash and convert to tape
::
@ -108,7 +130,7 @@
:: +report-vat: report on a single desk installation
::
++ report-vat
|= $: $: tyr=rock:tire =cone sor=(map desk [ship desk])
|= $: $: tyr=rock:tire =cone sor=(map desk (pair ship desk))
zyn=(map [desk ship desk] sync-state)
==
our=ship now=@da syd=desk verb=?
@ -144,7 +166,7 @@
~
?~ z=(~(get by zyn) syd u.s)
~
`[-.u.s +.u.s +.u.z]
`[p.u.s q.u.s [kid let]:u.z]
=/ meb=(list @uv)
?~ sink [hash]~
(mergebase-hashes our syd now her.u.sink sud.u.sink)

View File

@ -306,6 +306,7 @@
0xb.130c.ab37.ca24.49cd.aecb.23ba.70f1.6f1c.4d00.124e.c9a5.
3413.3843.d81c.47c4.7040.6e62.3700.0200.0132.e1ab.9000
==
:- ~[/ames] [%pass /pump/~bud/0 %b %wait ~1111.1.5..00.02.00]
==
==
:: publisher ames hears %kick ack

View File

@ -262,7 +262,7 @@
==
::
++ ex-channel-response
|= body=@t
|= body=(unit @t)
|= mov=move
^- tang
?. ?=([[[%http-blah ~] ~] %give %response %start * * %.n] mov)
@ -273,7 +273,7 @@
['connection' 'keep-alive']
['set-cookie' cookie-string]
==
=/ body `(as-octs:mimes:html body)
=/ body (bind body as-octs:mimes:html)
;: weld
(expect-eq !>(200) !>(status-code.response-header.http-event.p.card.mov))
(expect-eq !>(body) !>(data.http-event.p.card.mov))
@ -375,6 +375,7 @@
|= [gang pov=path =view =beam]
^- (unit (unit cage))
?: =(%gd view) ``noun+!>(%base)
?: =(%gu view) ``noun+!>(=(%app1 q.beam))
?: &(=(%ca view) =(/gen/handler/hoon s.beam))
:+ ~ ~
vase+!>(!>(|=(* |=(* [[%404 ~] ~]))))
@ -553,6 +554,21 @@
(take /watch-response/[eyre-id] ~[/http-blah] sign)
=/ headers ['content-type' 'text/html']~
(expect-moves mos (ex-continue-response `[3 'ya!'] %.n) ~)
::
++ test-dead-app-request
%- eval-mare
=/ m (mare ,~)
;< ~ bind:m perform-init-wo-timer
;< ~ bind:m (wait ~d1)
:: dead-app binds successfully
::
;< ~ bind:m (connect %dead-app /)
;< ~ bind:m (wait ~d1)
:: outside requests a path that dead-app has bound to
::
;< mos=(list move) bind:m (get '/' ~)
=/ body `(error-page:eyre-gate 503 %.n '/' "%dead-app not running")
(expect-moves mos (ex-response 503 ['content-type' 'text/html']~ body) ~)
:: tests an app redirecting to the login handler, which then receives a post
:: and redirects back to app
::
@ -727,6 +743,32 @@
=/ wire /channel/subscription/'0123456789abcdef'/1/~nul/two/~nul
(expect-moves mos (ex-gall-deal wire ~nul %two %leave ~) ~)
::
++ test-channel-open-with-get
%- eval-mare
=/ m (mare ,~)
;< ~ bind:m perform-init-wo-timer
;< ~ bind:m perform-born
;< ~ bind:m (wait ~d1)
;< ~ bind:m perform-authentication-2
;< mos=(list move) bind:m
(get '/~/channel/0123456789abcdef' cookie)
;< now=@da bind:m get-now
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' (add now ~s20))
=/ mov-2 (ex-channel-response ~)
(expect-moves mos mov-1 mov-2 ~)
::
++ test-channel-put-zero-requests
%- eval-mare
=/ m (mare ,~)
;< ~ bind:m perform-init-start-channel-2
;< ~ bind:m (wait ~m1)
;< mos=(list move) bind:m
(put '/~/channel/0123456789abcdef' cookie '[]')
=/ mov-1 ex-204
=/ mov-2 (ex-rest /channel/timeout/'0123456789abcdef' ~1111.1.2..12.00.00)
=/ mov-3 (ex-wait /channel/timeout/'0123456789abcdef' ~1111.1.2..12.01.00)
(expect-moves mos mov-1 mov-2 mov-3 ~)
::
++ test-channel-results-before-open
%- eval-mare
=/ m (mare ,~)
@ -760,7 +802,7 @@
;< now=@da bind:m get-now
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' (add now ~s20))
=/ mov-2
%- ex-channel-response
%+ ex-channel-response ~
'''
id: 0
data: {"ok":"ok","id":0,"response":"poke"}
@ -904,7 +946,7 @@
;< now=@da bind:m get-now
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' (add now ~s20))
=/ mov-2
%- ex-channel-response
%+ ex-channel-response ~
'''
id: 0
data: {"ok":"ok","id":0,"response":"poke"}
@ -1006,7 +1048,7 @@
=/ heartbeat (add now ~s20)
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' heartbeat)
=/ mov-2
%- ex-channel-response
%+ ex-channel-response ~
'''
id: 0
data: {"ok":"ok","id":0,"response":"poke"}
@ -1076,7 +1118,7 @@
=/ heartbeat (add now ~s20)
=/ mov-1 (ex-wait /channel/heartbeat/'0123456789abcdef' heartbeat)
=/ mov-2
%- ex-channel-response
%+ ex-channel-response ~
'''
id: 2
data: {"json":[1],"id":1,"response":"diff"}