Merge pull request #6836 from urbit/yu/stun-response

ames: add STUN response handling

pkg/arvo/app/ping.hoon

@@ -36,21 +36,23 @@
       [%http until=@da]
       [%waiting until=@da]
   ==
-+$  state-1
++$  state-2
-  $:  %1
+  $:  %2
       ships=(set ship)
       nonce=@ud
       $=  plan
       $~  [%nat ~]
       $%  [%nat ~]
           [%pub ip=(unit @t)]
+          [%off ~]
+          [%one ~]
       ==
   ==
 --
 ::
 %-  agent:dbug
 ::
-=|  state=state-1
+=|  state=state-2
 =>  |%
     ::  Bind for the the writer monad on (quip effect state)
     ::
@@ -73,6 +75,7 @@
     ::  and sponsorship changes
     ::
     ++  ships
+      =|  force=_|
       |%
       ++  rind  (^rind card state)
       ++  kick
@@ -88,8 +91,8 @@
         ::  behavior here.
         ::
         =/  new-ships  (~(gas in *(set ship)) (saxo:title our now our))
-        =/  removed  (~(dif in ships.state) new-ships)
+        =/    removed  (~(dif in ships.state) new-ships)
-        =/  added    (~(dif in new-ships) ships.state)
+        =/      added  (~(dif in new-ships) ships.state)
         ;<  new-state=_state  rind
           ?~  removed  `state
           [[%pass /jael %arvo %j %nuke removed]~ state]
@@ -102,7 +105,7 @@
         ::
         ::  Kick even if ships weren't added or removed
         ::
-        (kick-pings our now new-ships)
+        (kick-pings our now new-ships force)
       ::
       ::  Kick whenever we get a response.  We really care about
       ::  breaches and sponsorship changes.
@@ -115,24 +118,28 @@
         ^-  (quip card _state)
         [[%pass /jael/delay %arvo %b %wait now]~ state]
       ::
-      ++  take-delay  kick
+      ++  take-delay  %*(kick ships force %.y)
       --
     ::
     ::  Starts pinging a new set of `ships`.
     ::
     ++  kick-pings
-      |=  [our=@p now=@da ships=(set ship)]
+      |=  [our=@p now=@da ships=(set ship) force=?]
       ^-  (quip card _state)
       =:  nonce.state  +(nonce.state)
           ships.state  ships
         ==
       ::
-      ?:  ?=(%nat -.plan.state)
+      ?:  force  (kick:nat our)
-        (kick:nat our)
+      ?-  -.plan.state
-      (kick:pub our now)
+        %off  `state
+        %nat  (kick:nat our)
+        %one  (kick:one our)
+        %pub  (kick:pub our now)
+      ==
     ::
     ::  Subsystem for pinging our sponsors when we might be behind a NAT
-    ::
+    ::    XX  no longer true if using STUN-enabled vere 2.XX
     ::    Ping each ship every 25 seconds to keep the pinhole open.
     ::    This is expensive, but if you don't do it and you are behind a
     ::    NAT, you will stop receiving packets from other ships except
@@ -270,6 +277,26 @@
         ::
         (set-timer now)
       --
+    ::  Subsystem for formally acknowledging a change in our IP:PORT
+    ::
+    ::    If our sponsor sends a STUN response, with an IP different than what
+    ::    we had previously cached, we formally acknowledge this change by
+    ::    sending one %poke to every ship in the sponsorship chain.
+    ::
+    ++  one
+      ?>  ?=(%one -.plan.state)
+      |%
+      ++  kick
+        |=  our=@p
+        ^-  (quip card _state)
+        :_  state
+        %-  ~(rep in ships.state)
+        |=  [=ship cards=(list card)]
+        ?:  =(our ship)  cards
+        =/  wire  /one/(scot %uw nonce.state)/ping/(scot %p ship)
+        :_  cards  ^-  card
+        [%pass wire %agent [ship %ping] %poke %noun !>(~)]
+      --
     --
 %+  verb  |
 ^-  agent:gall
@@ -291,18 +318,33 @@
   |^
   =/  old  !<(state-any old-vase)
   =?  old  ?=(%0 -.old)  (state-0-to-1 old)
-  ?>  ?=(%1 -.old)
+  =?  old  ?=(%1 -.old)  (state-1-to-2 old)
+  ?>  ?=(%2 -.old)
   =.  state  old
   =^  cards  state  (kick:ships our.bowl now.bowl)
   [cards this]
   ::
-  +$  state-any  $%(state-0 state-1)
+  +$  state-any  $%(state-0 state-1 state-2)
-  +$  state-0  [%0 ships=(map ship [=rift =ship-state])]
+  +$  state-0    [%0 ships=(map ship [=rift =ship-state])]
+  +$  state-1
+    $:  %1
+        ships=(set ship)
+        nonce=@ud
+        $=  plan
+        $~  [%nat ~]
+        $%  [%nat ~]
+            [%pub ip=(unit @t)]
+    ==  ==
   ::
   ++  state-0-to-1
     |=  old=state-0
     ^-  state-1
     [%1 ~ 0 %nat ~]
+  ::
+  ++  state-1-to-2
+    |=  old=state-1
+    ^-  state-2
+    old(- %2)
   --
 ::  +on-poke: positively acknowledge pokes
 ::
@@ -311,8 +353,39 @@
   ?.  =(our src):bowl    :: don't crash, this is where pings are handled
     `this
   ::
+  ~&  mark^vase
   =^  cards  state
-    ?:  =(q.vase %kick)  :: NB: ames calls this on %born
+    ?:  ?=([%kick ?] q.vase)
+      :: NB: ames calls this on %born (with fail=%.n) and after not hearing STUN
+      ::  responses for more than ~s5 (with fail=%.y)
+      ::
+      ::  if %ping was turned off (due to a successfull STUN) but we failed
+      ::  to get a STUN response in time switch to %nat and start a ~s25 timer
+      ::
+      ::  if the %kick has fail=%.n (e.g. for every %born), the plan will remain
+      ::  unchanged, but we will innitiate a new round of %poke pings with
+      ::  increasing nonce.
+      ::
+      ::  if we get repeated [%stun fail=&], but we are already in either %nat
+      ::  or %pub, do nothing, since there are already timers in place to %ping
+      ::  repeatedly.
+      ::
+      =/  stun-failed=?  &(?=([%off ~] plan.state) =(+.q.vase %.y))
+      ?:  &(?=([%off ~] plan.state) =(+.q.vase %.n))
+        ::  ignore restarts if we were already STUNning, if ip:port changed
+        ::  %once will trigger one formal %ping
+        ::
+        `state
+      =?  plan.state  stun-failed
+        [%nat ~]
+      ?:  &(!stun-failed =(+.q.vase %.y))
+        `state
+      (kick:ships our.bowl now.bowl)
+    ?:  =(q.vase %stop)  :: NB: ames calls this on [%stun fail=%.n]
+      =.  plan.state  [%off ~]
+      (kick:ships our.bowl now.bowl)
+    ?:  &(=(q.vase %once) =(%off -.plan.state))  :: NB: ames calls this on %once
+      =.  plan.state  [%one ~]
       (kick:ships our.bowl now.bowl)
     ?:  =(q.vase %nat)
       =.  plan.state  [%nat ~]
@@ -345,6 +418,12 @@
       ?.  ?=(%pub -.plan.state)  `state
       ?.  ?=(%poke-ack -.sign)   `state
       (take-pings:pub wire p.sign)
+    ::
+        [%one *]
+      ?.  ?=(%one -.plan.state)  `state
+      ?:  ?=(%poke-ack -.sign)   `state
+      :: XX handle error?
+      `state
     ==
   [cards this]
 ::  +on-arvo: handle timer firing

pkg/arvo/sys/lull.hoon

@@ -772,6 +772,7 @@
   ::    %kroc: request to delete specific message flows, from their bones
   ::    %plea: request to send message
   ::    %deep: deferred calls to %ames, from itself
+  ::    %stun: STUN response (or failure), from unix
   ::
   ::    Remote Scry Tasks
   ::
@@ -803,6 +804,7 @@
         [%kroc bones=(list [ship bone])]
         $>(%plea vane-task)
         [%deep =deep]
+        [%stun =stun]
     ::
         [%keen spar]
         [%yawn spar]
@@ -837,6 +839,7 @@
   ::    System and Lifecycle Gifts
   ::
   ::    %turf: domain report, relayed from jael
+  ::    %saxo: our sponsor list report
   ::
   +$  gift
     $%  [%boon payload=*]
@@ -849,6 +852,7 @@
         [%tune spar roar=(unit roar)]
     ::
         [%turf turfs=(list turf)]
+        [%saxo sponsors=(list ship)]
     ==
   ::
   ::::                                                  ::  (1a2)
@@ -927,6 +931,15 @@
         [%cork =ship =bone]
         [%kill =ship =bone]
     ==
+  ::  $stun: STUN notifications, from unix
+  ::
+  ::    .lane is the latest cached lane in vere, from the point of view of .ship
+  ::
+  +$  stun
+    $%  [%stop =ship =lane]  :: succesful STUN response, stop %ping app
+        [%fail =ship =lane]  :: failure to STUN, re-enable %ping app
+        [%once =ship =lane]  :: new lane discovered, notify ping %app
+    ==
   :: +|  %atomics
   ::
   +$  bone           @udbone

pkg/arvo/sys/vane/ames.hoon

@@ -496,6 +496,11 @@
     peer-state
   peer-state(direct.u.route %.n)
 ::
+++  poke-ping-app
+  |=  [=duct our=ship poke=?(%stop %once [%kick fail=?])]
+  ^-  move
+  [duct %pass /ping %g %deal [our our /ames] %ping %poke noun+!>(poke)]
+::
 +|  %atomics
 ::
 +$  private-key    @uwprivatekey
@@ -1653,9 +1658,9 @@
               $:  %18
               $%  $:  %larva
                       events=(qeu queued-event-17)
-                      state=ames-state-17
+                      state=ames-state-18
                   ==
-                  [%adult state=ames-state-17]
+                  [%adult state=ames-state-18]
               ==  ==
               $:  %19
               $%  $:  %larva
@@ -2006,6 +2011,11 @@
           *peer-state
         +.u.ship-state
       ::
+      ++  get-sponsors
+        ;;  (list ship)
+        =<  q.q  %-  need  %-  need
+        (rof ~ /ames %j `beam`[[our %saxo %da now] /(scot %p our)])
+      ::
       +|  %tasks
       ::  +on-take-flub: vane not ready to process message, pretend it
       ::                 was never delivered
@@ -2415,7 +2425,7 @@
         =.  peers.ames-state
           (~(put by peers.ames-state) sndr.shot %known peer-state)
         ::
-        =.  event-core  
+        =.  event-core
           %-  emit
           :*  unix-duct.ames-state  %give  %nail  sndr.shot
               (get-forward-lanes our peer-state peers.ames-state)
@@ -2645,13 +2655,22 @@
         ++  cork-bone  |=(=bone abet:(on-cork-flow:peer-core bone))
         ++  kill-bone  |=(=bone abet:(on-kill-flow:peer-core bone))
         --
+      ::  +on-stun: poke %ping app when hearing a STUN response
+      ::
+      ++  on-stun
+        |=  =stun
+        ^+  event-core
+        %-  emit
+        %^  poke-ping-app  unix-duct.ames-state  our
+        ?.  ?=(%fail -.stun)  -.stun
+        [%kick fail=%.y]
       :: +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))
+        (emit ~[/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
       ::
@@ -2863,6 +2882,11 @@
             :*  unix-duct.ames-state  %give  %nail  ship
                 (get-forward-lanes our peer-state peers.ames-state)
             ==
+          ::  if one of our sponsors breached, give the updated list to vere
+          ::
+          =/  sponsors  (~(gas in *(set ^ship)) get-sponsors)
+          =?  event-core  (~(has in sponsors) ship)
+            (emit unix-duct.ames-state %give %saxo ~(tap in sponsors))
           ::
           event-core
         ::  +on-publ-rekey: handle new key for peer
@@ -2906,6 +2930,10 @@
         ++  on-publ-sponsor
           |=  [=ship sponsor=(unit ship)]
           ^+  event-core
+          ::
+          ?:  =(our ship)
+            (emit unix-duct.ames-state %give %saxo get-sponsors)
+          ::
           ?~  sponsor
             %-  (slog leaf+"ames: {(scow %p ship)} lost sponsor, ignoring" ~)
             event-core
@@ -2938,6 +2966,9 @@
               =?  rift.ames-state  =(our ship)
                 rift.point
               ::
+              ::  XX not needed?
+              :: =?  event-core  =(our ship)
+              ::   (emit unix-duct.ames-state %give %saxo get-sponsors)
               ?.  (~(has by keys.point) life.point)
                 $(points t.points)
               ::
@@ -3084,7 +3115,8 @@
           cork-moves
         ^-  (list move)
         :~  [duct %give %turf turfs]
-            [duct %pass /ping %g %deal [our our /ames] %ping %poke %noun !>(%kick)]
+            [duct %give %saxo get-sponsors]
+            (poke-ping-app duct our %kick fail=%.n)
         ==
       ::  +on-vega: handle kernel reload
       ::
@@ -5173,6 +5205,7 @@
       %tame  (on-tame:event-core ship.task)
       %kroc  (on-kroc:event-core bones.task)
       %deep  (on-deep:event-core deep.task)
+      %stun  (on-stun:event-core stun.task)
     ::
       %keen  (on-keen:event-core +.task)
       %yawn  (on-cancel-scry:event-core | +.task)