Merge branch 'master' into release/next-userspace

This commit is contained in:
Matilde Park 2020-10-05 20:56:57 -04:00
commit 77b1db2d16
8 changed files with 147 additions and 10 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:b1ae413b0ac4cc6ddd4f4e7e380852171a4b28436e1c4bff693425c3acbca473
size 6229799
oid sha256:367e7f494465e6c4709254bb69dbb6ef71edea483d2efcbf9fc1b27ff4f36020
size 6246822

View File

@ -65,7 +65,7 @@
=^ d drum.state (on-load:drum-core -.old drum.tup)
=^ h helm.state (on-load:helm-core -.old helm.tup)
=^ k kiln.state (on-load:kiln-core -.old kiln.tup)
[:(weld d h k) this]
[:(welp d h k) this]
::
++ on-poke
|= [=mark =vase]

View File

@ -0,0 +1,6 @@
:: eyre: give cors configuration
::
:- %say
|= [[now=@da eny=@uvJ =beak] ~ ~]
:- %noun
.^(cors-registry:eyre %ex /(scot %p p.beak)//(scot %da now)/cors)

View File

@ -0,0 +1,5 @@
:: eyre: allow cors requests from origin
::
:- %say
|= [^ [=origin:eyre ~] ~]
[%helm-cors-approve origin]

View File

@ -0,0 +1,5 @@
:: eyre: disallow cors requests from origin
::
:- %say
|= [^ [=origin:eyre ~] ~]
[%helm-cors-reject origin]

View File

@ -204,6 +204,16 @@
|= [=binding:eyre =generator:eyre] =< abet
(emit %pass /helm/serv %arvo %e %serve binding generator)
::
++ poke-cors-approve
|= =origin:eyre
=< abet
(emit %pass /helm/cors/approve %arvo %e %approve-origin origin)
::
++ poke-cors-reject
|= =origin:eyre
=< abet
(emit %pass /helm/cors/reject %arvo %e %reject-origin origin)
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-helm-bad-mark mark] !!)
@ -213,6 +223,8 @@
%helm-atom =;(f (f !<(_+<.f vase)) poke-atom)
%helm-automass =;(f (f !<(_+<.f vase)) poke-automass)
%helm-cancel-automass =;(f (f !<(_+<.f vase)) poke-cancel-automass)
%helm-cors-approve =;(f (f !<(_+<.f vase)) poke-cors-approve)
%helm-cors-reject =;(f (f !<(_+<.f vase)) poke-cors-reject)
%helm-hi =;(f (f !<(_+<.f vase)) poke-hi)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)
%helm-mass =;(f (f !<(_+<.f vase)) poke-mass)

View File

@ -69,7 +69,7 @@
++ axle
$: :: date: date at which http-server's state was updated to this data structure
::
date=%~2020.5.29
date=%~2020.9.30
:: server-state: state of inbound requests
::
=server-state
@ -87,6 +87,9 @@
:: the :binding into a (map (unit @t) (trie knot =action)).
::
bindings=(list [=binding =duct =action])
:: cors-registry: state used and managed by the +cors core
::
=cors-registry
:: connections: open http connections not fully complete
::
connections=(map duct outstanding-connection)
@ -571,6 +574,29 @@
[action [authenticated secure address request] ~ 0]
=. connections.state
(~(put by connections.state) duct connection)
:: figure out whether this is a cors request,
:: whether the origin is approved or not,
:: and maybe add it to the "pending approval" set
::
=/ origin=(unit origin)
(get-header:http 'origin' header-list.request)
=^ cors-approved requests.cors-registry.state
=, cors-registry.state
?~ origin [| requests]
?: (~(has in approved) u.origin) [& requests]
?: (~(has in rejected) u.origin) [| requests]
[| (~(put in requests) u.origin)]
:: if this is a cors preflight request from an approved origin
:: handle it synchronously
::
?: &(?=(^ origin) cors-approved ?=(%'OPTIONS' method.request))
%- handle-response
=; =header-list:http
[%start [204 header-list] ~ &]
::NOTE +handle-response will add the rest of the headers
:~ 'Access-Control-Allow-Methods'^'*'
'Access-Control-Allow-Headers'^'*'
==
::
?- -.action
%gen
@ -1632,10 +1658,25 @@
(session-cookie-string u.session-id &)
headers.response-header.http-event
::
=/ connection=outstanding-connection
(~(got by connections.state) duct)
:: if the request was a simple cors request from an approved origin
:: append the necessary cors headers to the response
::
=/ origin=(unit origin)
%+ get-header:http 'origin'
header-list.request.inbound-request.connection
=? headers.response-header
?& ?=(^ origin)
(~(has in approved.cors-registry.state) u.origin)
==
%^ set-header:http 'Access-Control-Allow-Origin' u.origin
%^ set-header:http 'Access-Control-Allow-Credentials' 'true'
headers.response-header
::
=. response-header.http-event response-header
=. connections.state
%+ ~(jab by connections.state) duct
|= connection=outstanding-connection
%+ ~(put by connections.state) duct
%_ connection
response-header `response-header
bytes-sent ?~(data.http-event 0 p.u.data.http-event)
@ -2030,6 +2071,22 @@
%disconnect
=. server-state.ax (remove-binding:server binding.task)
[~ http-server-gate]
::
%approve-origin
=. cors-registry.server-state.ax
=, cors-registry.server-state.ax
:+ (~(del in requests) origin.task)
(~(put in approved) origin.task)
(~(del in rejected) origin.task)
[~ http-server-gate]
::
%reject-origin
=. cors-registry.server-state.ax
=, cors-registry.server-state.ax
:+ (~(del in requests) origin.task)
(~(del in approved) origin.task)
(~(put in rejected) origin.task)
[~ http-server-gate]
==
::
++ take
@ -2210,6 +2267,19 @@
::
++ load
=> |%
+$ axle-2020-5-29
[date=%~2020.5.29 server-state=server-state-2020-5-29]
::
+$ server-state-2020-5-29
$: bindings=(list [=binding =duct =action])
connections=(map duct outstanding-connection)
=authentication-state
=channel-state
domains=(set turf)
=http-config
ports=[insecure=@ud secure=(unit @ud)]
outgoing-duct=duct
==
+$ axle-2019-10-6
[date=%~2019.10.6 server-state=server-state-2019-10-6]
::
@ -2224,12 +2294,18 @@
outgoing-duct=duct
==
--
|= old=$%(axle axle-2019-10-6)
|= old=$%(axle axle-2019-10-6 axle-2020-5-29)
^+ ..^$
::
~! %loading
?- -.old
%~2020.5.29 ..^$(ax old)
%~2020.9.30 ..^$(ax old)
::
%~2020.5.29
%_ $
date.old %~2020.9.30
server-state.old [-.server-state.old *cors-registry +.server-state.old]
==
::
%~2019.10.6
=^ success bindings.server-state.old
@ -2258,8 +2334,6 @@
?. ?=(%& -.why)
~
=* who p.why
?. ?=(%$ ren)
[~ ~]
?: =(tyl /whey)
=/ maz=(list mass)
:~ bindings+&+bindings.server-state.ax
@ -2276,6 +2350,25 @@
[~ ~]
~& [%r %scry-foreign-host who]
~
?: &(?=(%x ren) ?=(~ syd))
=, server-state.ax
?+ tyl [~ ~]
[%cors ~] ``noun+!>(cors-registry)
[%cors %requests ~] ``noun+!>(requests.cors-registry)
[%cors %approved ~] ``noun+!>(approved.cors-registry)
[%cors %rejected ~] ``noun+!>(rejected.cors-registry)
::
[%cors ?(%approved %rejected) @ ~]
=* kind i.t.tyl
=* orig i.t.t.tyl
?~ origin=(slaw %t orig) [~ ~]
?- kind
%approved ``noun+!>((~(has in approved.cors-registry) u.origin))
%rejected ``noun+!>((~(has in rejected.cors-registry) u.origin))
==
==
?. ?=(%$ ren)
[~ ~]
?+ syd [~ ~]
%bindings ``noun+!>(bindings.server-state.ax)
%connections ``noun+!>(connections.server-state.ax)

View File

@ -1271,9 +1271,25 @@
:: the first place.
::
[%disconnect =binding]
:: start responding positively to cors requests from origin
::
[%approve-origin =origin]
:: start responding negatively to cors requests from origin
::
[%reject-origin =origin]
==
::
--
:: +origin: request origin as specified in an Origin header
::
+$ origin @torigin
:: +cors-registry: origins categorized by approval status
::
+$ cors-registry
$: requests=(set origin)
approved=(set origin)
rejected=(set origin)
==
:: +outstanding-connection: open http connections not fully complete:
::
:: This refers to outstanding connections where the connection to