Merge branch 'develop' into ted/ping

This commit is contained in:
yosoyubik 2023-10-20 09:17:22 +02:00
commit 080c5a65df
15 changed files with 87433 additions and 218 deletions

View File

@ -628,6 +628,8 @@
:: duct: ['/paths', ...],
:: message-num: 123
:: }, ...],
:: closing: [bone, ..., bone],
:: corked: [bone, ..., bone],
:: heeds: [['/paths', ...] ...]
:: scries:
:: -> { =path
@ -706,8 +708,8 @@
|^ =/ mix=(list flow)
=- (sort - dor)
%+ welp
(turn ~(tap by snd) (tack %snd))
(turn ~(tap by rcv) (tack %rcv))
(turn ~(tap by snd) (tack %snd closing corked))
(turn ~(tap by rcv) (tack %rcv closing corked))
=/ [forward=(list flow) backward=(list flow)]
%+ skid mix
|= [=bone *]
@ -719,6 +721,8 @@
::
+$ flow
$: =bone
closing=?
corked=?
::
$= state
$% [%snd message-pump-state]
@ -727,17 +731,17 @@
==
::
++ tack
|* =term
|* [=term closing=(set bone) corked=(set bone)]
|* [=bone =noun]
[bone [term noun]]
[bone (~(has in closing) bone) (~(has in corked) bone) [term noun]]
::
++ build
|= flow
^- json
%+ frond -.state
?- -.state
%snd (snd-with-bone ossuary bone +.state)
%rcv (rcv-with-bone ossuary bone +.state)
%snd (snd-with-bone ossuary bone closing corked +.state)
%rcv (rcv-with-bone ossuary bone closing corked +.state)
==
--
::
@ -749,6 +753,10 @@
:* 'message-num'^(numb message-num)
(bone-to-pairs bone ossuary)
==
::
'closing'^(set-array closing numb)
::
'corked'^(set-array corked numb)
::
'heeds'^(set-array heeds from-duct)
::
@ -756,10 +764,12 @@
==
::
++ snd-with-bone
|= [=ossuary =bone message-pump-state]
|= [=ossuary =bone closing=? corked=? message-pump-state]
^- json
%- pairs
:* 'current'^(numb current)
:* 'closing'^b+closing
'corked'^b+corked
'current'^(numb current)
'next'^(numb next)
::
:- 'unsent-messages' :: as byte sizes
@ -811,10 +821,12 @@
==
::
++ rcv-with-bone
|= [=ossuary =bone message-sink-state]
|= [=ossuary =bone closing=? corked=? message-sink-state]
^- json
%- pairs
:* 'last-acked'^(numb last-acked)
:* 'closing'^b+closing
'corked'^b+corked
'last-acked'^(numb last-acked)
'last-heard'^(numb last-heard)
::
:- 'pending-vane-ack'

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

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

@ -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]
@ -2727,6 +2729,34 @@
+$ bitt (map duct (pair ship path)) :: incoming subs
+$ boat (map [=wire =ship =term] [acked=? =path]) :: outgoing subs
+$ boar (map [=wire =ship =term] nonce=@) :: and their nonces
::
+$ path-state
$: bob=(unit @ud)
fan=((mop @ud (pair @da (each page @uvI))) lte)
==
+$ stats :: statistics
$: change=@ud :: processed move count
eny=@uvJ :: entropy
time=@da :: current event time
==
+$ egg :: migratory agent state
$% [%nuke sky=(map spur @ud)] :: see /sys/gall $yoke
$: %live
control-duct=duct
run-nonce=@t
sub-nonce=@
=stats
=bitt
=boat
=boar
code=~
old-state=[%| vase]
=beak
marks=(map duct mark)
sky=(map spur path-state)
ken=(jug spar:ames wire)
== ==
+$ egg-any $%([%15 egg])
+$ bowl :: standard app state
$: $: our=ship :: host
src=ship :: guest

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 ~
@ -2014,15 +2012,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 ~)
::
%- (slog leaf+"ames: switching to dead flow consolidation" ~)
=; cor=event-core
set-dead-flow-timer:(wake-dead-flows:cor ~)
%- ~(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 -))))
@ -2097,6 +2124,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
@ -2438,6 +2486,34 @@
++ cork-bone |=(=bone abet:(on-cork-flow:peer-core bone))
++ kill-bone |=(=bone abet:(on-kill-flow:peer-core bone))
--
:: +set-dead-flow-timer: set dead flow timer and corresponding ames state
::
++ set-dead-flow-timer
^+ event-core
=. flow.dead.ames-state.event-core
flow/`[~[/ames] /dead-flow `@da`(add now ~m2)]
(emit:event-core ~[/ames] %pass /dead-flow %b %wait `@da`(add now ~m2))
:: +wake-dead-flows: call on-wake on all dead flows, discarding any
:: ames-state changes
::
++ wake-dead-flows
|= [error=(unit tang)]
^+ event-core
%- ~(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)
=< abort
^+ 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
@ -2458,22 +2534,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)
set-dead-flow-timer:(wake-dead-flows error)
::
?. ?=([%recork ~] wire)
=/ res=(unit ?([%fine her=ship =^wire] [%pump her=ship =bone]))
@ -2843,17 +2904,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 %give %saxo get-sponsors]
@ -3069,6 +3128,7 @@
channel [[our ship] now channel-state -.peer]
==
::
++ abort event-core :: keeps moves, discards state changes
++ abet
^+ event-core
=. peers.ames-state
@ -3280,6 +3340,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 ~)
@ -4078,7 +4143,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)
::
@ -4941,6 +5006,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)
@ -5180,7 +5246,7 @@
%= old
cong
:+ cong.old
flow/`[~[/ames] /dead-flow `@da`(add now ~m2)]
flow/~
cork/`[~[/ames] /recork `@da`(add now ~d1)]
::
peers
@ -5267,6 +5333,9 @@
:: /ax/snubbed (?(%allow %deny) (list ship))
:: /ax/fine/hunk/[path/...] (list @ux) scry response fragments
:: /ax/fine/ducts/[path/] (list duct)
:: /ax/rift @
:: /ax/corked/[ship] (set bone)
:: /ax/closing/[ship] (set bone)
::
?. ?=(%x ren) ~
=> .(tyl `(pole knot)`tyl)
@ -5439,5 +5508,19 @@
::
[%rift ~]
``noun+!>(rift.ames-state)
::
[%corked her=@ ~]
=/ who (slaw %p her.tyl)
?~ who [~ ~]
=/ per (~(get by peers.ames-state) u.who)
?. ?=([~ %known *] per) [~ ~]
``noun+!>(corked.u.per)
::
[%closing her=@ ~]
=/ who (slaw %p her.tyl)
?~ who [~ ~]
=/ per (~(get by peers.ames-state) u.who)
?. ?=([~ %known *] per) [~ ~]
``noun+!>(closing.u.per)
==
--

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

@ -366,6 +366,8 @@
}
button[type=submit] {
margin-top: 1rem;
}
button[type=submit], a.button {
font-size: 1rem;
padding: 0.5rem 1rem;
border-radius: 0.5rem;
@ -373,6 +375,7 @@
color: var(--white);
border: none;
font-weight: 600;
text-decoration: none;
}
input:invalid ~ button[type=submit] {
border-color: currentColor;
@ -380,7 +383,7 @@
color: var(--gray-400);
pointer-events: none;
}
span.guest {
span.guest, span.guest a {
color: var(--gray-400);
}
span.failed {
@ -475,8 +478,13 @@
;div#local
;p:"Urbit ID"
;input(value "{(scow %p our)}", disabled "true", class "mono");
;p:"Access Key"
;+ ?: =(%ours -.identity)
;div
;p:"Already authenticated"
;a.button/"{(trip (fall redirect-url '/'))}":"Continue"
==
;form(action "/~/login", method "post", enctype "application/x-www-form-urlencoded")
;p:"Access Key"
;input
=type "password"
=name "password"
@ -519,10 +527,13 @@
;button(name "eauth", type "submit"):"Continue"
==
==
;* ?. ?=(%fake -.identity) ~
;* ?: ?=(%ours -.identity) ~
=+ id=(trim 29 (scow %p who.identity))
=+ as="proceed as{?:(?=(%fake -.identity) " guest" "")}"
;+ ;span.guest.mono
; Current guest identity:
; Or
;a/"{(trip (fall redirect-url '/'))}":"{as}"
; :
;br;
; {p.id}
;br;
@ -789,8 +800,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
@ -964,8 +974,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)
@ -1100,11 +1109,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]]
@ -1184,33 +1206,14 @@
=/ with-eauth=(unit ?)
?: =(~ eauth-url:eauth) ~
`?=(^ (get-header:http 'eauth' args.request-line))
:: if we received a simple get: redirect if logged in, otherwise
:: show login page
:: if we received a simple get: show the login page
::
::NOTE we never auto-redirect, to avoid redirect loops with apps that
:: send unprivileged users to the login screen
::
?: =('GET' method.request)
?. (request-is-logged-in request)
%^ return-static-data-on-duct 200 'text/html'
(login-page redirect our identity with-eauth %.n)
=/ session-id (session-id-from-request request)
:: session-id should always be populated here since we are logged in
?~ session-id
%^ return-static-data-on-duct 200 'text/html'
(login-page redirect our identity with-eauth %.n)
=/ cookie-line=@t
(session-cookie-string u.session-id &)
=/ actual-redirect
?~ redirect '/'
?:(=(u.redirect '') '/' u.redirect)
%- handle-response
:* %start
:- status-code=303
^= headers
:~ ['location' actual-redirect]
['set-cookie' cookie-line]
==
data=~
complete=%.y
==
%^ return-static-data-on-duct 200 'text/html'
(login-page redirect our identity with-eauth %.n)
:: if we are not a post, return an error
::
?. =('POST' method.request)
@ -1347,14 +1350,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 +2115,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
@ -2179,62 +2183,84 @@
[%b %rest expiration-time]
:: +on-get-request: handles a GET request
::
:: GET requests open a channel for the server to send events to the
:: client in text/event-stream format.
:: GET requests connect to a channel for the server to send events to
:: the client in text/event-stream format.
::
++ 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?
:: if the channel doesn't exist, we cannot serve it.
:: this 404 also lets clients know if their channel was reaped since
:: they last connected to it.
::
?~ maybe-channel=(~(get by session.channel-state.state) channel-id)
?. (~(has 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)
=/ channel
(~(got by session.channel-state.state) channel-id)
:: 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.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.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.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.channel)
:_ state
(cancel-timeout-move channel-id p.state.channel)^~
=. duct-to-key.channel-state.state
(~(del by duct-to-key.channel-state.state) p.state.channel)
=/ cancel-heartbeat
?~ heartbeat.channel ~
:_ ~
%+ cancel-heartbeat-move channel-id
[date duct]:u.heartbeat.channel
=- [(weld cancel-heartbeat -<) ->]
(handle-response(duct p.state.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 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
=/ queue events.channel
=| events=(list wall)
|-
^+ events
@ -2246,9 +2272,10 @@
:: since conversion failure also gets caught during first receive.
:: we can't do anything about this, so consider it unsupported.
=/ said
(channel-event-to-tape u.maybe-channel request-id channel-event)
(channel-event-to-tape 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 +2286,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 +2316,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
@ -2310,6 +2337,8 @@
::
:: PUT requests send commands from the client to the server. We receive
:: a set of commands in JSON format in the body of the message.
:: channels don't exist until a PUT request is sent. it's valid for
:: this request to contain an empty list of commands.
::
++ on-put-request
|= [channel-id=@t =identity =request:http]
@ -2337,11 +2366,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

View File

@ -42,9 +42,9 @@
:: $move: Arvo-level move
::
+$ move [=duct move=(wind note-arvo gift-arvo)]
:: $state-13: overall gall state, versioned
:: $state-15: overall gall state, versioned
::
+$ state-14 [%14 state]
+$ state-15 [%15 state]
:: $state: overall gall state
::
:: system-duct: TODO document
@ -53,6 +53,7 @@
:: yokes: running agents
:: blocked: moves to agents that haven't been started yet
:: bug: debug printing configuration
:: leaves: retry nacked %leaves timer, if set
::
+$ state
$: system-duct=duct
@ -61,6 +62,7 @@
yokes=(map term yoke)
blocked=(map term (qeu blocked-move))
=bug
leaves=(unit [=duct =wire date=@da])
==
:: $routes: new cuff; TODO: document
::
@ -102,26 +104,10 @@
ken=(jug spar:ames wire)
== ==
::
+$ path-state
$: bob=(unit @ud)
fan=((mop @ud (pair @da (each page @uvI))) lte)
==
::
++ on-path ((on @ud (pair @da (each page @uvI))) lte)
:: $blocked-move: enqueued move to an agent
::
+$ blocked-move [=duct =routes move=(each deal unto)]
:: $stats: statistics
::
:: change: how many moves this agent has processed
:: eny: entropy
:: time: date of current event processing
::
+$ stats [change=@ud eny=@uvJ time=@da]
:: $ames-response: network response message (%boon)
::
:: %d: fact
:: %x: quit
::
+$ ames-response
$% [%d =mark noun=*]
@ -161,38 +147,22 @@
::
:: $spore: structures for update, produced by +stay
::
:: remember to duplicate version tag changes here to $egg-any:gall in lull
::
+$ spore
$: %14
$: %15
system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
eggs=(map term egg)
blocked=(map term (qeu blocked-move))
=bug
leaves=(unit [=duct =wire date=@da])
==
:: $egg: migratory agent state; $yoke with .old-state instead of .agent
::
+$ egg
$% [%nuke sky=(map spur @ud)]
$: %live
control-duct=duct
run-nonce=@t
sub-nonce=@
=stats
=bitt
=boat
=boar
code=~
old-state=[%| vase]
=beak
marks=(map duct mark)
sky=(map spur path-state)
ken=(jug spar:ames wire)
== ==
--
:: adult gall vane interface, for type compatibility with pupa
::
=| state=state-14
=| state=state-15
|= [now=@da eny=@uvJ rof=roof]
=* gall-payload .
~% %gall-top ..part ~
@ -220,7 +190,8 @@
++ mo-core .
++ mo-abed |=(hun=duct mo-core(hen hun))
++ mo-abet [(flop moves) gall-payload]
++ mo-give |=(g=gift mo-core(moves [[hen give+g] moves]))
++ mo-emit |=(=move mo-core(moves [move moves]))
++ mo-give |=(=gift (mo-emit hen give+gift))
++ mo-talk
|= rup=(each suss tang)
^- [wire note-arvo]
@ -230,8 +201,8 @@
%& [%text "gall: {(t q)}ed %{(t p)}":[t=trip p.rup]]
%| [%talk leaf+"gall: failed" (flop p.rup)]
==
++ mo-pass |=(p=[wire note-arvo] mo-core(moves [[hen pass+p] moves]))
++ mo-slip |=(p=note-arvo mo-core(moves [[hen slip+p] moves]))
++ mo-pass |=(p=[wire note-arvo] (mo-emit hen pass+p))
++ mo-slip |=(p=note-arvo (mo-emit hen slip+p))
++ mo-past
|= =(list [wire note-arvo])
?~ list
@ -370,12 +341,8 @@
=. outstanding.state
=/ stand
(~(gut by outstanding.state) [wire hen] *(qeu remote-request))
%+ ~(put by outstanding.state) [wire hen]
(~(gas to stand) ?.(?=(%leave -.deal) ~[-.deal] ~[%leave]))
=. mo-core (mo-pass wire note-arvo)
?. ?=(%leave -.deal)
mo-core
(mo-pass wire [%a [%cork ship]])
(~(put by outstanding.state) [wire hen] (~(put to stand) -.deal))
(mo-pass wire note-arvo)
:: +mo-track-ship: subscribe to ames and jael for notices about .ship
::
++ mo-track-ship
@ -529,6 +496,10 @@
::
?+ sign-arvo !!
[%ames %done *]
=/ err=(unit tang)
?~ error=error.sign-arvo
~
`[[%leaf (trip tag.u.error)] tang.u.error]
=^ remote-request outstanding.state
?~ t.t.t.wire
=/ full-wire sys+wire
@ -545,29 +516,42 @@
=^ rr stand ~(get to stand)
:- rr
?: =(~ stand)
:: outstanding leaves are only deleted when acked
::
?: &(?=(^ err) ?=(%leave rr))
outstanding.state
(~(del by outstanding.state) [full-wire hen])
(~(put by outstanding.state) [full-wire hen] stand)
:: non-null case of wire is old, remove on next breach after
:: 2019/12
::
[;;(remote-request i.t.t.t.wire) outstanding.state]
::
=/ err=(unit tang)
?~ error=error.sign-arvo
~
`[[%leaf (trip tag.u.error)] tang.u.error]
:: send a %cork if we get a nack upon initial subscription
:: send a %cork if we get a %nack upon initial subscription
::
=? mo-core
&(?=(^ err) |(?=(%watch-as remote-request) ?=(%watch remote-request)))
(mo-pass [%sys wire] %a %cork ship)
(mo-pass sys+wire %a %cork ship)
::
?- remote-request
%watch-as (mo-give %unto %watch-ack err)
%watch (mo-give %unto %watch-ack err)
%poke (mo-give %unto %poke-ack err)
%leave mo-core
%missing ~>(%slog.[3 'gall: missing'] mo-core)
::
%leave
:: if we get an %ack for a %leave, send %cork. otherwise,
:: the /nacked-leaves timer will re-send the %leave eventually.
::
?~ err
(mo-pass sys+wire %a %cork ship)
:: if first time hearing a %nack for a %leave, after upgrade
:: or if all outstanding %leaves have been handled, set up timer
::
=? mo-core ?=(~ leaves.state)
(mo-emit [/gall]~ %pass /nacked-leaves %b %wait `@da`(add now ~m2))
=? leaves.state ?=(~ leaves.state)
`[[/gall]~ /nacked-leaves `@da`(add now ~m2)]
mo-core
==
::
[%ames %boon *]
@ -905,6 +889,13 @@
^+ mo-core
=. dudes.bug.state (sy dudes)
mo-core
::
++ mo-handle-nacked-leaves
|= =wire
^+ mo-core
?> ?=([%sys %way @ @ ~] wire)
(mo-pass wire %a %plea (slav %p &3.wire) %g /ge/[&4.wire] %0 %u ~)
::
:: +ap: agent engine
::
:: An inner, agent-level core. The sample refers to the agent we're
@ -1546,7 +1537,7 @@
++ on-bad-nonce
|= stored-nonce=@
%. ap-core
%- slog :~
%+ trace odd.veb.bug.state :~
=/ nonces [expected=stored-nonce got=nonce]
=/ ok |(?=(?(%fact %kick) -.sign) =(~ p.sign))
leaf+"{<agent-name>}: stale {<-.sign>} {<nonces>} ok={<ok>}"
@ -1955,18 +1946,37 @@
::
++ load
|^ |= old=spore-any
=? old ?=(%7 -.old) (spore-7-to-8 old)
=? old ?=(%8 -.old) (spore-8-to-9 old)
=? old ?=(%9 -.old) (spore-9-to-10 old)
=? old ?=(%7 -.old) (spore-7-to-8 old)
=? old ?=(%8 -.old) (spore-8-to-9 old)
=? old ?=(%9 -.old) (spore-9-to-10 old)
=? old ?=(%10 -.old) (spore-10-to-11 old)
=? old ?=(%11 -.old) (spore-11-to-12 old)
=? old ?=(%12 -.old) (spore-12-to-13 old)
=? old ?=(%13 -.old) (spore-13-to-14 old)
?> ?=(%14 -.old)
=? old ?=(%14 -.old) (spore-14-to-15 old)
?> ?=(%15 -.old)
gall-payload(state old)
::
+$ spore-any
$%(spore spore-7 spore-8 spore-9 spore-10 spore-11 spore-12 spore-13)
$% spore
spore-7
spore-8
spore-9
spore-10
spore-11
spore-12
spore-13
spore-14
==
+$ spore-14
$: %14
system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
eggs=(map term egg)
blocked=(map term (qeu blocked-move))
=bug
==
+$ spore-13
$: %13
system-duct=duct
@ -2185,9 +2195,10 @@
::
++ spore-13-to-14
|= old=spore-13
^- spore
^- spore-14
%= old
- %14
::
blocked
^- (map term (qeu blocked-move))
%- ~(run by blocked.old)
@ -2200,6 +2211,12 @@
attributing.routes [ship=attributing.routes.blocked path=/]
==
==
:: added nacked-leaves timer
::
++ spore-14-to-15
|= old=spore-14
^- spore
old(- %15, bug [bug.old ~])
--
:: +scry: standard scry
::
@ -2290,6 +2307,24 @@
[~ ~]
[~ ~ atom+!>(u.nonce)]
::
?: ?& =(%v care)
=([%$ %da now] coin)
=(our ship)
==
=/ yok (~(get by yokes.state) dap)
?. ?=([~ %live *] yok)
[~ ~]
=/ =egg
%= u.yok
code ~
agent
:- %|
?: ?=(%| -.agent.u.yok)
p.agent.u.yok
on-save:p.agent.u.yok
==
``noun+!>([-:*spore egg])
::
?: ?& =(%w care)
=([%$ %da now] coin)
=(our ship)
@ -2412,6 +2447,24 @@
=/ =gift ?>(?=([%behn %heck %gall *] syn) +>+.syn)
[[duct %give gift]~ gall-payload]
::
?: ?=([%nacked-leaves ~] wire)
=; core=_mo-core:mo
:: next time a %leave gets nacked, the state and timer will be set again.
::
mo-abet:core(leaves.state ~)
%- ~(rep by outstanding.state)
|= [[[=^wire =^duct] stand=(qeu remote-request)] core=_mo-core:mo]
?: =(~ stand) core
=^ rr stand ~(get to stand)
:: sanity check in the outstanding queue:
:: if there's a %leave, that should be the only request
::
~? >>> &(?=(%leave rr) =(^ stand))
"outstanding queue not empty [{<wire>} {<duct>} {<stand>}]"
=? core &(?=(%leave rr) =(~ stand))
(mo-handle-nacked-leaves:(mo-abed:core duct) wire)
core
::
~| [%gall-take-failed wire]
?> ?=([?(%sys %use) *] wire)
=< mo-abet

View File

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

View File

@ -4298,8 +4298,11 @@
~&(%base-64-padding-err-two ~)
=/ len (sub (mul 3 (div (add lat dif) 4)) dif)
:+ ~ len
%+ swp 3
(rep [0 6] (flop (weld dat (reap dif 0))))
=/ res (rsh [1 dif] (rep [0 6] (flop dat)))
=/ amt (met 3 res)
:: left shift trailing zeroes in after byte swap
=/ trl ?: (lth len amt) 0 (sub len amt)
(lsh [3 trl] (swp 3 res))
--
--
::

View File

@ -12,7 +12,7 @@
++ parse-current-version
|= current=vere
^- @t
(rear rev.current)
(slav %ta (rear rev.current))
::
++ is-equal-version
|= [latest=@t current=vere]

View File

@ -153,8 +153,12 @@ export class Ames extends Component {
snd['packet-pump-state'].live.length > 0 )
? 'active, '
: '';
const color = snd['closing'] ? 'lightyellow': snd['corked'] ? 'lightred' : 'transparent';
return {key: 'snd ' + active + snd.bone + ', ' + renderDuct(snd.duct), jsx: (
<Summary summary={summary} details={details} />
<div style={{backgroundColor: color}}>
<Summary summary={summary} details={details} />
</div>
)};
}
@ -198,8 +202,12 @@ export class Ames extends Component {
{nax}<br/>
{liveMessages}
</>);
const color = rcv['closing'] ? 'ligthyellow': rcv['corked'] ? 'lightred' : 'transparent';
return {key: 'rcv ' + rcv.bone + ', ' + renderDuct(rcv.duct), jsx: (
<Summary summary={summary} details={details} />
<div style={{backgroundColor: color}}>
<Summary summary={summary} details={details} />
</div>
)};
}
@ -330,6 +338,13 @@ export class Ames extends Component {
last contact {msToDa(p.qos['last-contact'])}
</td>
</tr>
<tr>
<td class="inter">Bones </td>
<td>
closing: {p.closing.length},
corked: {p.corked.length}
</td>
</tr>
</tbody></table>
</>);

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,31 @@
=/ 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)
;< mos=(list move) bind:m
(get '/~/channel/0123456789abcdef' cookie)
;< now=@da bind:m get-now
=/ headers ['content-type' 'text/html']~
=/ body `(error-page:eyre-gate 404 %.n '/~/channel/0123456789abcdef' ~)
(expect-moves mos (ex-response 404 headers body) ~)
::
++ 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 +801,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 +945,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 +1047,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 +1117,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"}