Merge branch 'lukechampine/per-ship-drum' (#2867)

* lukechampine/per-ship-drum:
  dojo: rename remote access generators
  gall: fix handling of empty path list
  dojo: remove unused %json poke
  dojo: add remote access controls
  drum: switch to per-ship /sole/drum duct

Signed-off-by: Philip Monk <phil@pcmonk.me>
This commit is contained in:
Philip Monk 2020-05-08 15:55:17 -07:00
commit 6178ae88fc
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
7 changed files with 82 additions and 37 deletions

View File

@ -1127,9 +1127,9 @@
::
++ effect
|= fec=sole-effect:sole-sur
=/ =path /sole/(cat 3 'drum_' (scot %p our.bowl))
^- card
::TODO don't hard-code session id 'drum' here
[%give %fact ~[/sole/drum] %sole-effect !>(fec)]
[%give %fact ~[path] %sole-effect !>(fec)]
:: +tab: print tab-complete list
::
++ tab

View File

@ -12,9 +12,10 @@
=> |% :: external structures
++ id @tasession :: session id
++ house :: all state
$: $5
$: $6
egg/@u :: command count
hoc/(map id session) :: conversations
acl/(set ship) :: remote access whitelist
== ::
++ session :: per conversation
$: say/sole-share :: command-line state
@ -1349,9 +1350,12 @@
!>(state)
::
++ on-load
|= =old-state=vase
=/ old-state !<(house old-state-vase)
`..on-init(state old-state)
|= old=vase
?: ?=(%6 +<.old)
`..on-init(state !<(house old))
=/ old-5 !<([%5 egg=@u hoc=(map id session)] old)
=/ =house [%6 egg.old-5 hoc.old-5 *(set ship)]
`..on-init(state house)
::
++ on-poke
|= [=mark =vase]
@ -1359,6 +1363,7 @@
=^ moves state
^- (quip card:agent:gall house)
?+ mark ~|([%dojo-poke-bad-mark mark] !!)
::
%sole-action
=/ act !<(sole-action vase)
he-abet:(~(he-type he hid id.act ~ (~(got by hoc) id.act)) act)
@ -1367,8 +1372,17 @@
=+ !<([=id =command:lens] vase)
he-abet:(~(he-lens he hid id ~ (~(got by hoc) id)) command)
::
%json
~& jon=!<(json vase)
%allow-remote-login
=/ who !<(@p vase)
`state(acl (~(put in acl) who))
::
%revoke-remote-login
=/ who !<(@p vase)
:_ state(acl (~(del in acl) who))
[%give %kick ~ `who]~
::
%list-remote-logins
~& acl
`state
::
%wipe
@ -1390,8 +1404,9 @@
++ on-watch
|= =path
^- (quip card:agent:gall _..on-init)
~? !=(our.hid src.hid) [%dojo-peer-stranger src.hid]
?> (team:title our.hid src.hid)
?> ?| (team:title our.hid src.hid)
(~(has in acl) src.hid)
==
?> ?=([%sole @ ~] path)
=/ id i.t.path
=? hoc (~(has by hoc) id)

View File

@ -0,0 +1,9 @@
:: acl: list the ships that are allowed to link to dojo
::
/? 310
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[~ ~]
==
[%list-remote-logins ~]

View File

@ -0,0 +1,9 @@
:: allow-remote-login: allow a ship to link to dojo
::
/? 310
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=ship ~] ~]
==
[%allow-remote-login ship]

View File

@ -0,0 +1,10 @@
:: revoke-remote-login: revoke a ship's right to link to dojo,
:: kicking the ship if it is currently linked
::
/? 310
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=ship ~] ~]
==
[%revoke-remote-login ship]

View File

@ -633,8 +633,9 @@
::
++ se-peer :: send a peer
|= gyl/gill:gall
=/ =path /sole/(cat 3 'drum_' (scot %p our.hid))
%- se-emit(fug (~(put by fug) gyl ~))
[%pass (en-gill gyl) %agent gyl %watch /sole/drum]
[%pass (en-gill gyl) %agent gyl %watch path]
::
++ se-pull :: cancel subscription
|= gyl/gill:gall
@ -663,6 +664,8 @@
^+ +>
(ta-poke %sole-action !>(act))
::
++ ta-id (cat 3 'drum_' (scot %p our.hid)) :: per-ship duct id
::
++ ta-aro :: hear arrow
|= key/?($d $l $r $u)
^+ +>
@ -703,7 +706,7 @@
|= ted/sole-edit
^+ +>
%^ ta-act
%drum
ta-id
%det
[[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted]
::
@ -715,7 +718,7 @@
.(str.u.ris (scag (dec (lent str.u.ris)) str.u.ris))
?: =(0 pos.inp)
?~ buf.say.inp
(ta-act %drum %clr ~)
(ta-act ta-id %clr ~)
ta-bel
(ta-hom %del (dec pos.inp))
::
@ -1003,10 +1006,10 @@
==
::
++ ta-ret :: hear return
(ta-act %drum %ret ~)
(ta-act ta-id %ret ~)
::
++ ta-tab :: hear tab
(ta-act %drum %tab pos.inp)
(ta-act ta-id %tab pos.inp)
::
++ ta-ser :: reverse search
|= ext/(list @c)

View File

@ -1110,31 +1110,30 @@
++ ap-ducts-from-paths
|= [target-paths=(list path) target-ship=(unit ship)]
^- (list duct)
?: &(?=(~ target-paths) ?=(~ target-ship))
~[agent-duct]
%- zing
%+ turn target-paths
|= =path
(ap-ducts-from-path `path target-ship)
:: +ap-ducts-from-path: get ducts subscribed to path
::
++ ap-ducts-from-path
|= [target-path=(unit path) target-ship=(unit ship)]
^- (list duct)
?: &(?=(~ target-path) ?=(~ target-ship))
~[agent-duct]
%+ murn ~(tap by incoming.subscribers.current-agent)
|= [=duct =ship =path]
^- (unit ^duct)
?~ target-ship
?: =(target-path `path)
`duct
~
?~ target-path
?~ target-paths
?~ target-ship
~[agent-duct]
%+ murn ~(tap by incoming.subscribers.current-agent)
|= [=duct =ship =path]
^- (unit ^duct)
?: =(target-ship `ship)
`duct
~
?: &(=(target-path `path) =(target-ship `ship))
%- zing
%+ turn target-paths
|= =path
(ap-ducts-from-path path target-ship)
:: +ap-ducts-from-path: get ducts subscribed to path
::
++ ap-ducts-from-path
|= [target-path=path target-ship=(unit ship)]
^- (list duct)
%+ murn ~(tap by incoming.subscribers.current-agent)
|= [=duct =ship =path]
^- (unit ^duct)
?: ?& =(target-path path)
|(=(target-ship ~) =(target-ship `ship))
==
`duct
~
:: +ap-apply: apply effect.