From a52aca28a6dffe0b67d7dccf3c1ef9b6567a12f8 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Mon, 23 Mar 2020 13:15:13 -0700 Subject: [PATCH 001/257] urbit-king: Library for getting current terminal size (SIGWINCH). --- pkg/hs/stack.yaml | 1 + pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 2 +- pkg/hs/urbit-termsize/.gitignore | 3 ++ pkg/hs/urbit-termsize/LICENSE | 21 +++++++++++ pkg/hs/urbit-termsize/app/Main.hs | 13 +++++++ pkg/hs/urbit-termsize/lib/Urbit/TermSize.hs | 40 +++++++++++++++++++++ pkg/hs/urbit-termsize/package.yaml | 26 ++++++++++++++ 7 files changed, 105 insertions(+), 1 deletion(-) create mode 100644 pkg/hs/urbit-termsize/.gitignore create mode 100644 pkg/hs/urbit-termsize/LICENSE create mode 100644 pkg/hs/urbit-termsize/app/Main.hs create mode 100644 pkg/hs/urbit-termsize/lib/Urbit/TermSize.hs create mode 100644 pkg/hs/urbit-termsize/package.yaml diff --git a/pkg/hs/stack.yaml b/pkg/hs/stack.yaml index c18632ee3..4ab81adbb 100644 --- a/pkg/hs/stack.yaml +++ b/pkg/hs/stack.yaml @@ -7,6 +7,7 @@ packages: - urbit-atom - urbit-azimuth - urbit-king + - urbit-termsize extra-deps: - flat-0.3.4@sha256:002a0e0ae656ea8cc02a772d0bcb6ea7dbd7f2e79070959cc748ad1e7138eb38 diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index dc85580b3..1e316cb5f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -505,7 +505,7 @@ term (tsize, Client{..}) shutdownSTM king enqueueEv = where T.TSize wi hi = tsize - initialEvents = [(initialBlew wi hi), initialHail] + initialEvents = [initialBlew wi hi, initialHail] runTerm :: RAcquire e (EffCb e TermEf) runTerm = do diff --git a/pkg/hs/urbit-termsize/.gitignore b/pkg/hs/urbit-termsize/.gitignore new file mode 100644 index 000000000..e5904eabe --- /dev/null +++ b/pkg/hs/urbit-termsize/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +urbit-termsize.cabal +*~ diff --git a/pkg/hs/urbit-termsize/LICENSE b/pkg/hs/urbit-termsize/LICENSE new file mode 100644 index 000000000..bf9294e05 --- /dev/null +++ b/pkg/hs/urbit-termsize/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 urbit + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/pkg/hs/urbit-termsize/app/Main.hs b/pkg/hs/urbit-termsize/app/Main.hs new file mode 100644 index 000000000..798ece23f --- /dev/null +++ b/pkg/hs/urbit-termsize/app/Main.hs @@ -0,0 +1,13 @@ +module Main where + +import Prelude + +import Urbit.TermSize (liveTermSize) +import System.IO (getLine) + +main :: IO () +main = do + init <- liveTermSize (putStrLn . ("New Size: " <>) . show) + putStrLn ("Initial Size: " <> show init) + _ <- getLine + pure () diff --git a/pkg/hs/urbit-termsize/lib/Urbit/TermSize.hs b/pkg/hs/urbit-termsize/lib/Urbit/TermSize.hs new file mode 100644 index 000000000..33f2d78cf --- /dev/null +++ b/pkg/hs/urbit-termsize/lib/Urbit/TermSize.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} + +module Urbit.TermSize + ( TermSize(..) + , termSize + , liveTermSize + ) +where + +import Prelude + +import Data.Functor ((<&>)) +import System.Console.Terminal.Size (Window(..), size) + +import qualified System.Posix.Signals as Sys +import qualified System.Posix.Signals.Exts as Sys + + +-- Types ----------------------------------------------------------------------- + +data TermSize = TermSize + { tsWide :: !Word + , tsTall :: !Word + } + deriving (Eq, Ord, Show) + + +-- Utilities ------------------------------------------------------------------- + +termSize :: IO TermSize +termSize = size <&> \case + Nothing -> TermSize 80 24 + Just (Window {..}) -> TermSize width height + +liveTermSize :: (TermSize -> IO ()) -> IO TermSize +liveTermSize cb = do + Sys.installHandler Sys.sigWINCH (Sys.Catch (termSize >>= cb)) Nothing + termSize diff --git a/pkg/hs/urbit-termsize/package.yaml b/pkg/hs/urbit-termsize/package.yaml new file mode 100644 index 000000000..843a0bbb5 --- /dev/null +++ b/pkg/hs/urbit-termsize/package.yaml @@ -0,0 +1,26 @@ +name: urbit-termsize +version: 0.1.0 +license: MIT +license-file: LICENSE + +dependencies: + - base + - terminal-size + - unix + +ghc-options: + - -fwarn-incomplete-patterns + - -fwarn-unused-binds + - -fwarn-unused-imports + - -O2 + +library: + source-dirs: lib + +executables: + live-termsize: + main: Main.hs + source-dirs: app + dependencies: + - urbit-termsize + ghc-options: "-threaded -rtsopts -with-rtsopts=-N" From 4d95cf77788a94dd4824821e66d7299f15ef4c3e Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Mon, 23 Mar 2020 13:35:50 -0700 Subject: [PATCH 002/257] urbit-king: urbit `urbit-termsize` library. --- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 22 ++++++++--------- pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 14 ++++++----- .../urbit-king/lib/Urbit/Vere/Term/Render.hs | 24 ++----------------- pkg/hs/urbit-king/package.yaml | 2 +- 4 files changed, 22 insertions(+), 40 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 06b2baeab..805aad9a8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -20,6 +20,7 @@ import Control.Monad.Trans.Maybe import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) +import Urbit.TermSize (TermSize(..)) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -28,15 +29,14 @@ import Urbit.Vere.Http.Server (serv) import Urbit.Vere.Log (EventLog) import Urbit.Vere.Serf (Serf, SerfState(..), doJob, sStderr) -import qualified System.Entropy as Ent -import qualified Urbit.King.API as King -import qualified Urbit.Time as Time -import qualified Urbit.Vere.Log as Log -import qualified Urbit.Vere.Serf as Serf -import qualified Urbit.Vere.Term as Term -import qualified Urbit.Vere.Term.API as Term -import qualified Urbit.Vere.Term.Demux as Term -import qualified Urbit.Vere.Term.Render as Term +import qualified System.Entropy as Ent +import qualified Urbit.King.API as King +import qualified Urbit.Time as Time +import qualified Urbit.Vere.Log as Log +import qualified Urbit.Vere.Serf as Serf +import qualified Urbit.Vere.Term as Term +import qualified Urbit.Vere.Term.API as Term +import qualified Urbit.Vere.Term.Demux as Term -------------------------------------------------------------------------------- @@ -225,7 +225,7 @@ pier (serf, log, ss) mStart = do drivers inst ship (isFake logId) (writeTQueue computeQ) shutdownEvent - (Term.TSize{tsWide=80, tsTall=24}, muxed) + (TermSize{tsWide=80, tsTall=24}, muxed) showErr io $ atomically $ for_ bootEvents (writeTQueue computeQ) @@ -286,7 +286,7 @@ data Drivers e = Drivers drivers :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e) => KingId -> Ship -> Bool -> (Ev -> STM ()) -> STM() - -> (Term.TSize, Term.Client) + -> (TermSize, Term.Client) -> (Text -> RIO e ()) -> ([Ev], RAcquire e (Drivers e)) drivers inst who isFake plan shutdownSTM termSys stderr = diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index 1e316cb5f..e6c2b32cc 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -27,10 +27,12 @@ import Data.List ((!!)) import RIO.Directory (createDirectoryIfMissing) import Urbit.King.API (readPortsFile) import Urbit.King.App (HasConfigDir(..)) +import Urbit.TermSize (TermSize(TermSize)) import Urbit.Vere.Term.API (Client(Client)) import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.UTF8 as BS +import qualified Urbit.TermSize as T import qualified Urbit.Vere.NounServ as Serv import qualified Urbit.Vere.Term.API as Term import qualified Urbit.Vere.Term.Render as T @@ -158,10 +160,10 @@ runTerminalClient pier = runRAcquire $ do -} localClient :: ∀e. HasLogFunc e => STM () - -> RAcquire e (T.TSize, Client) + -> RAcquire e (TermSize, Client) localClient doneSignal = fst <$> mkRAcquire start stop where - start :: HasLogFunc e => RIO e ((T.TSize, Client), Private) + start :: HasLogFunc e => RIO e ((TermSize, Client), Private) start = do tsWriteQueue <- newTQueueIO spinnerMVar <- newEmptyTMVarIO @@ -187,12 +189,12 @@ localClient doneSignal = fst <$> mkRAcquire start stop , give = writeTQueue tsWriteQueue } - tsize <- io $ T.tsize + tsize <- io $ T.termSize pure ((tsize, client), Private{..}) stop :: HasLogFunc e - => ((T.TSize, Client), Private) -> RIO e () + => ((TermSize, Client), Private) -> RIO e () stop ((_, Client{..}), Private{..}) = do -- Note that we don't `cancel pReaderThread` here. This is a deliberate -- decision because fdRead calls into a native function which the runtime @@ -495,7 +497,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop Terminal Driver -} term :: forall e. (HasPierConfig e, HasLogFunc e) - => (T.TSize, Client) + => (TermSize, Client) -> (STM ()) -> KingId -> QueueEv @@ -503,7 +505,7 @@ term :: forall e. (HasPierConfig e, HasLogFunc e) term (tsize, Client{..}) shutdownSTM king enqueueEv = (initialEvents, runTerm) where - T.TSize wi hi = tsize + TermSize wi hi = tsize initialEvents = [initialBlew wi hi, initialHail] diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term/Render.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term/Render.hs index 9b805e7b5..a7751a005 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term/Render.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term/Render.hs @@ -2,9 +2,7 @@ Terminal Driver -} module Urbit.Vere.Term.Render - ( TSize(..) - , tsize - , clearScreen + ( clearScreen , clearLine , cursorRight , cursorLeft @@ -13,29 +11,11 @@ module Urbit.Vere.Term.Render import ClassyPrelude -import qualified System.Console.Terminal.Size as TSize -import qualified System.Console.ANSI as ANSI +import qualified System.Console.ANSI as ANSI -- Types ----------------------------------------------------------------------- -data TSize = TSize - { tsWide ∷ Word - , tsTall ∷ Word - } - - --------------------------------------------------------------------------------- - -{- | - Get terminal size. Produces 80x24 as a fallback if unable to figure - out terminal size. --} -tsize ∷ IO TSize -tsize = do - TSize.Window wi hi <- TSize.size <&> fromMaybe (TSize.Window 80 24) - pure $ TSize { tsWide = wi, tsTall = hi } - clearScreen ∷ MonadIO m ⇒ m () clearScreen = liftIO $ ANSI.clearScreen diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml index 93b2f9e61..a081d2091 100644 --- a/pkg/hs/urbit-king/package.yaml +++ b/pkg/hs/urbit-king/package.yaml @@ -87,7 +87,6 @@ dependencies: - tasty-th - template-haskell - terminal-progress-bar - - terminal-size - text - these - time @@ -99,6 +98,7 @@ dependencies: - urbit-atom - urbit-azimuth - urbit-hob + - urbit-termsize - utf8-string - vector - wai From 14df4d016c9455f6f7f19b14b5e303604dddaf11 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 2 Apr 2020 14:25:09 -0700 Subject: [PATCH 003/257] vere: WIP serf --- pkg/urbit/include/c/motes.h | 3 + pkg/urbit/worker/serf.c | 1210 +++++++++++++++++++++++++++++++++++ 2 files changed, 1213 insertions(+) create mode 100644 pkg/urbit/worker/serf.c diff --git a/pkg/urbit/include/c/motes.h b/pkg/urbit/include/c/motes.h index e980e99ae..7560127e5 100644 --- a/pkg/urbit/include/c/motes.h +++ b/pkg/urbit/include/c/motes.h @@ -928,6 +928,7 @@ # define c3__revo c3_s4('r','e','v','o') # define c3__rin c3_s3('r','i','n') # define c3__ring c3_s4('r','i','n','g') +# define c3__ripe c3_s4('r','i','p','e') # define c3__rite c3_s4('r','i','t','e') # define c3__rock c3_s4('r','o','c','k') # define c3__roll c3_s4('r','o','l','l') @@ -1062,6 +1063,7 @@ # define c3__sunt c3_s4('s','u','n','t') # define c3__sure c3_s4('s','u','r','e') # define c3__susp c3_s4('s','u','s','p') +# define c3__swap c3_s4('s','w','a','p') # define c3__sym c3_s3('s','y','m') # define c3__sync c3_s4('s','y','n','c') # define c3__sys c3_s3('s','y','s') @@ -1206,6 +1208,7 @@ # define c3__wack c3_s4('w','a','c','k') # define c3__wail c3_s4('w','a','i','l') # define c3__wake c3_s4('w','a','k','e') +# define c3__walk c3_s4('w','a','l','k') # define c3__wamp c3_s4('w','a','m','p') # define c3__want c3_s4('w','a','n','t') # define c3__warm c3_s4('w','a','r','m') diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c new file mode 100644 index 000000000..18ca85778 --- /dev/null +++ b/pkg/urbit/worker/serf.c @@ -0,0 +1,1210 @@ +/* worker/main.c +** +** the main loop of a serf process. +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include + + typedef struct _u3_serf { + c3_d sen_d; // last event requested + c3_d dun_d; // last event processed + c3_l mug_l; // hash of state + u3_noun sac; // space measurement + c3_o pac_o; // pack kernel + c3_o rec_o; // reclaim cash + c3_d key_d[4]; // disk key + u3_moat inn_u; // message input + u3_mojo out_u; // message output + c3_c* dir_c; // execution directory (pier) + } u3_serf; + static u3_serf u3V; + +/* +|% +:: +writ: from king to serf +:: ++$ writ + $% $: %live + $% [%exit cod=@] + [%save eve=@] + [%walk eve=@] + == == + [%peek now=date lyc=gang pat=path] + [%play eve=@ lit=(list $?((pair date ovum) *))] + [%work eve=@ job=(pair date ovum)] + == +:: +plea: from serf to king +:: ++$ plea + $% [%ripe pro=@ kel=(list (pair term @ud)) eve=@ mug=@] + [%slog pri=@ =tank] + [%peek pat=path dat=(unit (cask))] + $: %play + eve=@ + $% [%done mug=@] + [%bail dud=goof] + == == + $: %work + eve=@ + $% [%done mug=@ fec=(list ovum)] + [%swap mug=@ job=(pair date ovum) fec=(list ovum)] + [%bail dud=(list goof)] + == == + == +-- + +questions: + +- %peek + - persistent dates? (in arvo or serf) + - response on block/unit? +- %play + - expect lifecycle on [%ripe ... eve=0 mug=0] + - eve identifies failed event on [%play @ %bail ...] +- %live unacknowledged, crash on failure + - %walk resyncs eve + - %save both %fast and %full? (save to where? ack? continue after?) +- %pack + - could just be [%save %full ...] followed by a restart +- %mass + - is technically a query of the serf directly +- milliseconds + - in $writ for timeouts + - in $plea for measurement +- duct or vane stack for spinner +- slog back to toplevel? +*/ + +/* _serf_space(): print n spaces. +*/ +static void +_serf_space(FILE* fil_u, c3_w n) +{ + for (; n > 0; n--) + (fprintf(fil_u," ")); +} + +/* _serf_print_memory(): print memory amount. +** +** Helper for _serf_prof(), just an un-captioned u3a_print_memory(). +*/ +static void +_serf_print_memory(FILE* fil_u, c3_w wor_w) +{ + c3_w byt_w = (wor_w * 4); + c3_w gib_w = (byt_w / 1000000000); + c3_w mib_w = (byt_w % 1000000000) / 1000000; + c3_w kib_w = (byt_w % 1000000) / 1000; + c3_w bib_w = (byt_w % 1000); + + if ( gib_w ) { + (fprintf(fil_u, "GB/%d.%03d.%03d.%03d\r\n", + gib_w, mib_w, kib_w, bib_w)); + } + else if ( mib_w ) { + (fprintf(fil_u, "MB/%d.%03d.%03d\r\n", mib_w, kib_w, bib_w)); + } + else if ( kib_w ) { + (fprintf(fil_u, "KB/%d.%03d\r\n", kib_w, bib_w)); + } + else { + (fprintf(fil_u, "B/%d\r\n", bib_w)); + } +} + +/* _serf_prof(): print memory profile. RETAIN. +*/ +c3_w +_serf_prof(FILE* fil_u, c3_w den, u3_noun mas) +{ + c3_w tot_w = 0; + u3_noun h_mas, t_mas; + + if ( c3n == u3r_cell(mas, &h_mas, &t_mas) ) { + _serf_space(fil_u, den); + fprintf(fil_u, "mistyped mass\r\n"); + return tot_w; + } + else if ( _(u3du(h_mas)) ) { + _serf_space(fil_u, den); + fprintf(fil_u, "mistyped mass head\r\n"); + { + c3_c* lab_c = u3m_pretty(h_mas); + fprintf(fil_u, "h_mas: %s", lab_c); + c3_free(lab_c); + } + return tot_w; + } + else { + _serf_space(fil_u, den); + + { + c3_c* lab_c = u3m_pretty(h_mas); + fprintf(fil_u, "%s: ", lab_c); + c3_free(lab_c); + } + + u3_noun it_mas, tt_mas; + + if ( c3n == u3r_cell(t_mas, &it_mas, &tt_mas) ) { + fprintf(fil_u, "mistyped mass tail\r\n"); + return tot_w; + } + else if ( c3y == it_mas ) { + tot_w += u3a_mark_noun(tt_mas); + _serf_print_memory(fil_u, tot_w); + +#if 1 + /* The basic issue here is that tt_mas is included in .sac + * (the whole profile), so they can't both be roots in the + * normal sense. When we mark .sac later on, we want tt_mas + * to appear unmarked, but its children should be already + * marked. + */ + if ( _(u3a_is_dog(tt_mas)) ) { + u3a_box* box_u = u3a_botox(u3a_to_ptr(tt_mas)); +#ifdef U3_MEMORY_DEBUG + if ( 1 == box_u->eus_w ) { + box_u->eus_w = 0xffffffff; + } + else { + box_u->eus_w -= 1; + } +#else + if ( -1 == (c3_w)box_u->use_w ) { + box_u->use_w = 0x80000000; + } + else { + box_u->use_w += 1; + } +#endif + } +#endif + + return tot_w; + } + else if ( c3n == it_mas ) { + fprintf(fil_u, "\r\n"); + + while ( _(u3du(tt_mas)) ) { + tot_w += _serf_prof(fil_u, den+2, u3h(tt_mas)); + tt_mas = u3t(tt_mas); + } + + _serf_space(fil_u, den); + fprintf(fil_u, "--"); + _serf_print_memory(fil_u, tot_w); + + return tot_w; + + } + else { + _serf_space(fil_u, den); + fprintf(fil_u, "mistyped (strange) mass tail\r\n"); + return tot_w; + } + } +} + +/* _serf_grab(): garbage collect, checking for profiling. RETAIN. +*/ +static void +_serf_grab(void) +{ + if ( u3_nul == u3V.sac) { + if ( u3C.wag_w & (u3o_debug_ram | u3o_check_corrupt) ) { + u3m_grab(u3V.sac, u3_none); + } + } + else { + c3_w tot_w = 0; + FILE* fil_u; + +#ifdef U3_MEMORY_LOG + { + u3_noun wen = u3dc("scot", c3__da, u3k(u3A->now)); + c3_c* wen_c = u3r_string(wen); + + c3_c nam_c[2048]; + snprintf(nam_c, 2048, "%s/.urb/put/mass", u3P.dir_c); + + struct stat st; + if ( -1 == stat(nam_c, &st) ) { + mkdir(nam_c, 0700); + } + + c3_c man_c[2048]; + snprintf(man_c, 2048, "%s/%s-serf.txt", nam_c, wen_c); + + fil_u = fopen(man_c, "w"); + fprintf(fil_u, "%s\r\n", wen_c); + + c3_free(wen_c); + u3z(wen); + } +#else + { + fil_u = stderr; + } +#endif + + c3_assert( u3R == &(u3H->rod_u) ); + fprintf(fil_u, "\r\n"); + + tot_w += u3a_maid(fil_u, "total userspace", _serf_prof(fil_u, 0, u3V.sac)); + tot_w += u3m_mark(fil_u); + tot_w += u3a_maid(fil_u, "space profile", u3a_mark_noun(u3V.sac)); + + u3a_print_memory(fil_u, "total marked", tot_w); + u3a_print_memory(fil_u, "free lists", u3a_idle(u3R)); + u3a_print_memory(fil_u, "sweep", u3a_sweep()); + + fflush(fil_u); + +#ifdef U3_MEMORY_LOG + { + fclose(fil_u); + } +#endif + + u3z(u3V.sac); + u3V.sac = u3_nul; + } +} + +/* _serf_static_grab(): garbage collect, checking for profiling. RETAIN. +*/ +static void +_serf_static_grab(void) +{ + c3_assert( u3R == &(u3H->rod_u) ); + + fprintf(stderr, "serf: measuring memory:\r\n"); + u3a_print_memory(stderr, "total marked", u3m_mark(stderr)); + u3a_print_memory(stderr, "free lists", u3a_idle(u3R)); + u3a_print_memory(stderr, "sweep", u3a_sweep()); + fprintf(stderr, "\r\n"); + fflush(stderr); +} + +/* _serf_pack(): deduplicate and compact memory +*/ +static void +_serf_pack(void) +{ + _serf_static_grab(); + u3l_log("serf: compacting loom\r\n"); + + if ( c3n == u3m_rock_stay(u3V.dir_c, u3V.dun_d) ) { + u3l_log("serf: unable to jam state\r\n"); + return; + } + + if ( c3n == u3e_hold() ) { + u3l_log("serf: unable to backup checkpoint\r\n"); + return; + } + + u3m_wipe(); + + if ( c3n == u3m_rock_load(u3V.dir_c, u3V.dun_d) ) { + u3l_log("serf: compaction failed, restoring checkpoint\r\n"); + + if ( c3n == u3e_fall() ) { + fprintf(stderr, "serf: unable to restore checkpoint\r\n"); + c3_assert(0); + } + } + + if ( c3n == u3e_drop() ) { + u3l_log("serf: warning: orphaned backup checkpoint file\r\n"); + } + + if ( c3n == u3m_rock_drop(u3V.dir_c, u3V.dun_d) ) { + u3l_log("serf: warning: orphaned state file\r\n"); + } + + u3l_log("serf: compacted loom\r\n"); + _serf_static_grab(); +} + +/* _serf_newt_fail(): failure stub. +*/ +static void +_serf_newt_fail(void* vod_p, const c3_c* wut_c) +{ + fprintf(stderr, "serf: fail: %s\r\n", wut_c); + exit(1); +} + +/* _serf_send(): send result back to daemon. +*/ +static void +_serf_send(u3_noun job) +{ + u3_newt_write(&u3V.out_u, u3ke_jam(job), 0); +} + +/* _serf_send_slog(): send hint output (hod is [priority tank]). +*/ +static void +_serf_send_slog(u3_noun hod) +{ + _serf_send(u3nc(c3__slog, hod)); +} + +/* _serf_send_stdr(): send stderr output +*/ +static void +_serf_send_stdr(c3_c* str_c) +{ + _serf_send_slog(u3nc(c3__leaf, u3i_string(str_c))); +} + +static void +_serf_sure_post(void) +{ + if ( c3y == u3V.rec_o ) { + u3m_reclaim(); + } + + // XX this runs on replay too + // + _serf_grab(); + + if ( c3y == u3V.pac_o ) { + _serf_pack(); + } +} + +/* _serf_sure_feck(): event succeeded, send effects. +*/ +static u3_noun +_serf_sure_feck(c3_w pre_w, u3_noun vir) +{ + // intercept |mass, observe |reset + // + { + u3_noun riv = vir; + c3_w i_w = 0; + + while ( u3_nul != riv ) { + u3_noun fec = u3t(u3h(riv)); + + // assumes a max of one %mass effect per event + // + if ( c3__mass == u3h(fec) ) { + // save a copy of the %mass data + // + u3V.sac = u3k(u3t(fec)); + // replace the %mass data with ~ + // + // For efficient transmission to daemon. + // + riv = u3kb_weld(u3qb_scag(i_w, vir), + u3nc(u3nt(u3k(u3h(u3h(riv))), c3__mass, u3_nul), + u3qb_slag(1 + i_w, vir))); + u3z(vir); + vir = riv; + break; + } + + // reclaim memory from persistent caches on |reset + // + if ( c3__vega == u3h(fec) ) { + u3V.rec_o = c3y; + } + + // pack memory on |pack + // + if ( c3__pack == u3h(fec) ) { + u3V.pac_o = c3y; + } + + riv = u3t(riv); + i_w++; + } + } + + // after a successful event, we check for memory pressure. + // + // if we've exceeded either of two thresholds, we reclaim + // from our persistent caches, and notify the daemon + // (via a "fake" effect) that arvo should trim state + // (trusting that the daemon will enqueue an appropriate event). + // For future flexibility, the urgency of the notification is represented + // by a *decreasing* number: 0 is maximally urgent, 1 less so, &c. + // + // high-priority: 2^22 contiguous words remaining (~8 MB) + // low-priority: 2^27 contiguous words remaining (~536 MB) + // XX maybe use 2^23 (~16 MB) and 2^26 (~268 MB? + // + { + u3_noun pri = u3_none; + c3_w pos_w = u3a_open(u3R); + c3_w low_w = (1 << 27); + c3_w hig_w = (1 << 22); + + if ( (pre_w > low_w) && !(pos_w > low_w) ) { + // XX set flag(s) in u3V so we don't repeat endlessly? + // XX pack here too? + // + u3V.pac_o = c3y; + u3V.rec_o = c3y; + pri = 1; + } + else if ( (pre_w > hig_w) && !(pos_w > hig_w) ) { + u3V.pac_o = c3y; + u3V.rec_o = c3y; + pri = 0; + } + // reclaim memory from persistent caches periodically + // + // XX this is a hack to work two things + // - bytecode caches grow rapidly and can't be simply capped + // - we don't make very effective use of our free lists + // + else { + u3V.rec_o = _(0 == (u3V.dun_d % 1000ULL)); + } + + // notify daemon of memory pressure via "fake" effect + // + if ( u3_none != pri ) { + u3_noun cad = u3nc(u3nt(u3_blip, c3__arvo, u3_nul), + u3nc(c3__trim, pri)); + vir = u3nc(cad, vir); + } + } + + return vir; +} + +/* _serf_sure_core(): event succeeded, save state. +*/ +static void +_serf_sure_core(u3_noun cor) +{ + u3V.dun_d = u3V.sen_d; + + u3z(u3A->roc); + u3A->roc = cor; + u3A->ent_d = u3V.dun_d; + u3V.mug_l = u3r_mug(u3A->roc); +} + +#ifdef U3_EVENT_TIME_DEBUG +static void +_serf_poke_time(c3_d evt_d, c3_c* txt_c, struct timeval b4) +{ + struct timeval f2, d0; + c3_w ms_w; + c3_w clr_w; + + gettimeofday(&f2, 0); + timersub(&f2, &b4, &d0); + + ms_w = (d0.tv_sec * 1000) + (d0.tv_usec / 1000); + clr_w = ms_w > 1000 ? 1 : ms_w < 100 ? 2 : 3; // red, green, yellow + + if ( clr_w != 2 ) { + u3l_log("\x1b[3%dm%%%s (%" PRIu64 ") %4d.%02dms\x1b[0m\n", + clr_w, txt_c, evt_d, ms_w, + (int) (d0.tv_usec % 1000) / 10); + } +} +#endif + +/* _serf_work(): apply event, capture effects. +*/ +static u3_noun +_serf_work(c3_d evt_d, u3_noun job) +{ + u3_noun now, ovo, gon, last_date; + c3_w pre_w = u3a_open(u3R); + + // %work must be performed against an extant kernel + // + c3_assert( 0 != u3V.mug_l); + + // event numbers must be continuous (see [%live %walk @]) + // + c3_assert(evt_d == u3V.dun_d + 1ULL); + u3V.sen_d = evt_d; + + u3x_cell(job, &now, &ovo); + + last_date = u3A->now; + u3A->now = u3k(now); + +#ifdef U3_EVENT_TIME_DEBUG + struct timeval b4; + c3_t bug_t = c3__belt != u3h(u3t(ovo)); + c3_c* txt_c = 0; + + if ( bug_t ) { + gettimeofday(&b4, 0); + txt_c = u3r_string(u3h(u3t(ovo))); + + u3l_log("serf: %s (%" PRIu64 ") live\r\n", txt_c, evt_d); + } +#endif + + gon = u3m_soft(0, u3v_poke, u3k(ovo)); + +#ifdef U3_EVENT_TIME_DEBUG + if ( bug_t { + _serf_poke_time(evt_d, txt_c, b4); + c3_free(txt_c); + } +#endif + + // event accepted + // + if ( u3_blip == u3h(gon) ) { + // vir/(list ovum) list of effects + // cor/arvo arvo core + // + u3_noun vir, cor; + u3x_trel(gon, 0, &vir, &cor); + + _serf_sure_core(u3k(cor)); + vir = _serf_sure_feck(pre_w, u3k(vir)); + + u3z(gon); u3z(job); u3z(last_date); + + return u3nt(c3__done, u3i_words(1, &u3V.mug_l), vir); + } + + // event rejected + // + { + // stash $goof from first crash + // + u3_noun dud = u3k(u3t(gon)); + + // replace [ovo] with error notification + // + { + u3_noun wir, cad, dud; + u3x_cell(ovo, &wir, &cad); + ovo = u3nq(u3k(wir), c3__crud, u3k(dud), u3k(cad)); + } + + // XX reclaim/pack on %meme first? + // + + // XX u3i_vint(u3A->now) ?? + // + +#ifdef U3_EVENT_TIME_DEBUG + if ( bug_t ) { + gettimeofday(&b4, 0); + u3l_log("serf: crud (%" PRIu64 ") live\r\n", evt_d); + } +#endif + + u3z(gon); + gon = u3m_soft(0, u3v_poke, u3k(ovo)); + +#ifdef U3_EVENT_TIME_DEBUG + if ( bug_t { + _serf_poke_time(evt_d, "crud", b4); + } +#endif + + // error notification accepted + // + if ( u3_blip == u3h(gon) ) { + // vir/(list ovum) list of effects + // cor/arvo arvo core + // + u3_noun vir, cor; + u3x_trel(gon, 0, &vir, &cor); + + _serf_sure_core(u3k(cor)); + vir = _serf_sure_feck(pre_w, u3k(vir)); + + u3z(gon); u3z(job); u3z(last_date); u3z(dud); + + return u3nq(c3__swap, u3i_words(1, &u3V.mug_l), + u3nc(u3k(u3A->now), ovo), + vir); + } + + // error notification rejected + // + { + // stash $goof from second crash + // + u3_noun dud = u3k(u3t(gon)); + + // restore previous time + // + u3z(u3A->now); + u3A->now = last_date; + + u3V.sen_d = u3V.dun_d; + + u3z(gon); u3z(job); u3z(ovo); + + // XX reclaim/pack on %meme ? + // + + return u3nq(c3__bail, u3k(u3t(gon)), dud, u3_nul); + } + } +} + +/* _serf_work_trace(): %work, with trace +*/ +static u3_noun +_serf_work_trace(c3_d evt_d, u3_noun job) +{ + c3_t tac_t = ( 0 != u3_Host.tra_u.fil_u ); + c3_c lab_c[2048]; + u3_noun pro; + + // XX refactor tracing + // + if ( tac_t ) { + u3_noun wir = u3h(u3t(job)); + u3_noun cad = u3h(u3t(u3t(job))); + + { + c3_c* cad_c = u3m_pretty(cad); + c3_c* wir_c = u3m_pretty_path(wir); + snprintf(lab_c, 2048, "event %" PRIu64 ": [%s %s]", + evt_d, wir_c, cad_c); + c3_free(cad_c); + c3_free(wir_c); + } + + u3t_event_trace(lab_c, 'B'); + } + + pro = _serf_work(evt_d, job); + + if ( tac_t ) { + u3t_event_trace(lab_c, 'E'); + } + + return pro; +} + +static u3_noun +_serf_play_life(u3_noun eve) +{ + c3_d len_d; + { + u3_noun len = u3qb_lent(eve); + + c3_assert( 1 == u3r_met(6, len) ); + len_d = u3r_chub(1, len); + } + + // XX set evt_d forall lit so that %slog is accurate? + // XX capture bail instead of exit + // + if ( c3n == u3v_boot(eve) ) { + fprintf(stderr, "serf: boot failed: invalid sequence (from pill)\r\n"); + exit(1); + } + + u3V.dun_d = u3V.sen_d = u3A->ent_d = len_d; + u3V.mug_l = u3r_mug(u3A->roc); + + u3l_log("serf: (%" PRIu64 ")| core: %x\r\n", u3V.dun_d, u3V.mug_l); + + return u3nc(c3__done, u3V.mug_l); +} + +static u3_noun +_serf_play_list(u3_noun eve) +{ + c3_w pre_w = u3a_open(u3R); + u3_noun vev = eve; + u3_noun job, now, ovo, gon, last_date; + + while ( u3_nul != eve ) { + job = u3h(eve); + u3x_cell(job, &now, &ovo); + + last_date = u3A->now; + u3A->now = u3k(now); + u3V.sen_d++; + + gon = u3m_soft(0, u3v_poke, u3k(ovo)); + + if ( u3_blip != u3h(gon) ) { + u3_noun dud = u3k(u3t(gon)); + u3z(gon); + + // restore previous time + // + u3z(u3A->now); + u3A->now = last_date; + + u3V.sen_d = u3V.dun_d; + u3z(vev); + + // XX reclaim/pack on meme + // XX retry? + // + + return u3nc(c3__bail, dud); + } + else { + // vir/(list ovum) list of effects + // cor/arvo arvo core + // + u3_noun vir, cor; + u3x_trel(gon, 0, &vir, &cor); + + _serf_sure_core(u3k(cor)); + + // process effects to set pack/reclaim flags + // + u3z(_serf_sure_feck(pre_w, u3k(vir))); + u3z(gon); + + // skip |mass on replay + u3z(u3V.sac); + u3V.sac = u3_nul; + + eve = u3t(eve); + } + } + + u3z(vev); + return u3nc(c3__done, u3V.mug_l); +} + +/* _serf_play(): apply events. +*/ +static u3_noun +_serf_play(c3_d evt_d, u3_noun lit) +{ + c3_assert( evt_d == 1ULL + u3V.sen_d ); + + // XX better condition for no kernel? + // + u3_noun pro = ( 0ULL == u3V.dun_d ) + ? _serf_play_life(lit) + : _serf_play_list(lit); + + return u3nt(c3__play, u3i_chubs(1, &u3V.dun_d), pro); +} + +// /* _serf_poke_peek(): dereference namespace. +// */ +// static void +// _serf_poke_peek(u3_noun now, u3_noun pat) +// { +// // XX u3v_peek +// } + +/* _serf_live_exit(): exit on command. +*/ +static void +_serf_live_exit(c3_w cod_w) +{ + if ( u3C.wag_w & u3o_debug_cpu ) { + FILE* fil_u; + + { + u3_noun wen = u3dc("scot", c3__da, u3k(u3A->now)); + c3_c* wen_c = u3r_string(wen); + + c3_c nam_c[2048]; + snprintf(nam_c, 2048, "%s/.urb/put/profile", u3P.dir_c); + + struct stat st; + if ( -1 == stat(nam_c, &st) ) { + mkdir(nam_c, 0700); + } + + c3_c man_c[2048]; + snprintf(man_c, 2048, "%s/%s.txt", nam_c, wen_c); + + fil_u = fopen(man_c, "w"); + + c3_free(wen_c); + u3z(wen); + } + + u3t_damp(fil_u); + + { + fclose(fil_u); + } + } + + // XX move to jets.c + // + c3_free(u3D.ray_u); + + exit(cod_w); +} + +/* _serf_live_save(): save snapshot. +*/ +static void +_serf_live_save(c3_d evt_d) +{ + c3_assert( evt_d == u3V.dun_d ); + u3e_save(); +} + +/* _serf_live_walk(): bump event number. +*/ +static void +_serf_live_walk(c3_d evt_d) +{ + u3l_log("serf: bump %" PRIu64 " to %" PRIu64 "\r\n", u3V.dun_d, evt_d); + u3V.sen_d = u3V.dun_d = evt_d; +} + +// XX move to u3r +// + +static c3_o +_r_safe_byte(u3_noun dat, c3_y* out_y) { + if ( (c3n == u3a_is_atom(dat)) || + (1 < u3r_met(3, dat)) ) + { + return c3n; + } + + *out_y = u3r_byte(0, dat); + return c3y; +} + +static c3_o +_r_safe_word(u3_noun dat, c3_w* out_w) { + if ( (c3n == u3a_is_atom(dat)) || + (1 < u3r_met(5, dat)) ) + { + return c3n; + } + + *out_w = u3r_word(0, dat); + return c3y; +} + +static c3_o +_r_safe_chub(u3_noun dat, c3_d* out_d) { + if ( (c3n == u3a_is_atom(dat)) || + (1 < u3r_met(6, dat)) ) + { + return c3n; + } + + *out_d = u3r_chub(0, dat); + return c3y; +} + +/* _serf_step_trace(): initialize or rotate trace file. +*/ +static void +_serf_step_trace(void) +{ + if ( u3C.wag_w & u3o_trace ) { + if ( u3_Host.tra_u.con_w == 0 && u3_Host.tra_u.fun_w == 0 ) { + u3t_trace_open(u3V.dir_c); + } + else if ( u3_Host.tra_u.con_w >= 100000 ) { + u3t_trace_close(); + u3t_trace_open(u3V.dir_c); + } + } +} + +/* _serf_poke(): +*/ +void +_serf_newt_poke(void* vod_p, u3_noun mat) +{ + u3_noun jar = u3ke_cue(mat); + + if ( c3n == u3a_is_cell(jar) ) { + goto error; + } + + _serf_step_trace(); + + switch ( u3h(jar) ) { + default: { + goto error; + } + + case c3__live: { + u3_noun com, dat; + + if ( c3n == u3r_trel(jar, 0, &com, &dat) ) { + goto error; + } + + switch (com) { + default: { + goto error; + } + + case c3__exit: { + c3_y cod_y; + + if ( c3n == _r_safe_byte(dat, &cod_y) ) { + goto error; + } + + u3z(jar); + _serf_live_exit(cod_y); + return; + } + + case c3__save: { + c3_d evt_d; + + if ( c3n == _r_safe_chub(dat, &evt_d) ) { + goto error; + } + + u3z(jar); + _serf_live_save(evt_d); + return; + } + + case c3__walk: { + c3_d evt_d; + + if ( c3n == _r_safe_chub(dat, &evt_d) ) { + goto error; + } + + u3z(jar); + _serf_live_walk(evt_d); + return; + } + } + } + + // case c3__peek: { + // u3_noun now, pat; + + // if ( (c3n == u3r_trel(jar, 0, &now, &pat)) || + // (c3n == u3a_is_cell(pat)) || + // (c3n == u3a_is_atom(now)) || + // (1 != u3r_met(8, now)) ) + // { + // goto error; + // } + + // u3k(now); u3k(pat); + // u3z(jar); + + // return _serf_poke_peek(now, pat); + // } + + case c3__play: { + u3_noun evt, lit; + c3_d evt_d; + + if ( (c3n == u3r_trel(jar, 0, &evt, &lit)) || + (c3n == u3a_is_cell(lit)) || + (c3n == _r_safe_chub(evt, &evt_d)) ) + { + goto error; + } + + u3k(lit); + u3z(jar); + _serf_send(_serf_play(evt_d, lit)); + _serf_sure_post(); + return; + } + + case c3__work: { + u3_noun evt, job; + c3_d evt_d; + + if ( (c3n == u3r_trel(jar, 0, &evt, &job)) || + (c3n == u3a_is_cell(job)) || + (c3n == _r_safe_chub(evt, &evt_d)) ) + { + goto error; + } + + u3k(job); + u3z(jar); + _serf_send(_serf_work_trace(evt_d, job)); + _serf_sure_post(); + return; + } + } + + error: { + u3z(jar); + _serf_newt_fail(0, "bad jar"); + } +} + +/* _serf_ripe(): produce initial serf state as [eve=@ mug=@] +*/ +static u3_noun +_serf_ripe(void) +{ + u3l_log("serf: ripe %" PRIu64 "\r\n", u3V.dun_d); + + u3V.mug_l = ( 0 == u3V.dun_d ) ? 0 : u3r_mug(u3A->roc); + return u3nc(u3i_chubs(1, &u3V.dun_d), u3i_words(1, &u3V.mug_l)); +} + +/* u3_serf_boot(): send startup message to manager. +*/ +void +u3_serf_boot(void) +{ + c3_w pro_w = 1; + u3_noun kel = u3nt(u3nc(c3__hoon, 141), + u3nc(c3__nock, 4), + u3_nul); + + _serf_send(u3nq(c3__ripe, pro_w, kel, _serf_ripe())); + + // measure/print static memory usage if < 1/2 of the loom is available + // + { + c3_w pen_w = u3a_open(u3R); + + if ( !(pen_w > (1 << 28)) ) { + fprintf(stderr, "\r\n"); + u3a_print_memory(stderr, "serf: contiguous free space", pen_w); + _serf_static_grab(); + } + } + + u3V.pac_o = c3n; + u3V.rec_o = c3n; + u3V.sac = u3_nul; +} + +/* main(): main() when run as urbit-worker +*/ +c3_i +mmain(c3_i argc, c3_c* argv[]) +{ + // the serf is spawned with [FD 0] = events and [FD 1] = effects + // we dup [FD 0 & 1] so we don't accidently use them for something else + // we replace [FD 0] (stdin) with a fd pointing to /dev/null + // we replace [FD 1] (stdout) with a dup of [FD 2] (stderr) + // + c3_i nul_i = open("/dev/null", O_RDWR, 0); + c3_i inn_i = dup(0); + c3_i out_i = dup(1); + dup2(nul_i, 0); + dup2(2, 1); + close(nul_i); + + uv_loop_t* lup_u = uv_default_loop(); + c3_c* dir_c = argv[1]; + c3_c* key_c = argv[2]; + c3_c* wag_c = argv[3]; + + c3_assert(4 == argc); + + memset(&u3V, 0, sizeof(u3V)); + memset(&u3_Host.tra_u, 0, sizeof(u3_Host.tra_u)); + + /* load passkey + */ + { + sscanf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", + &u3V.key_d[0], + &u3V.key_d[1], + &u3V.key_d[2], + &u3V.key_d[3]); + } + + /* load runtime config + */ + { + sscanf(wag_c, "%" SCNu32, &u3C.wag_w); + } + + /* load pier directory + */ + { + u3V.dir_c = strdup(dir_c); + } + + /* boot image + */ + { + u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); + u3C.stderr_log_f = _serf_send_stdr; + u3C.slog_f = _serf_send_slog; + } + + // Ignore SIGPIPE signals. + // + { + struct sigaction sig_s = {{0}}; + sigemptyset(&(sig_s.sa_mask)); + sig_s.sa_handler = SIG_IGN; + sigaction(SIGPIPE, &sig_s, 0); + } + + /* configure pipe to daemon process + */ + { + c3_i err_i; + + err_i = uv_pipe_init(lup_u, &u3V.inn_u.pyp_u, 0); + c3_assert(!err_i); + uv_pipe_open(&u3V.inn_u.pyp_u, inn_i); + + err_i = uv_pipe_init(lup_u, &u3V.out_u.pyp_u, 0); + c3_assert(!err_i); + uv_pipe_open(&u3V.out_u.pyp_u, out_i); + } + + /* set up writing + */ + u3V.out_u.bal_f = _serf_newt_fail; + + /* start reading + */ + u3V.inn_u.vod_p = &u3V; + u3V.inn_u.pok_f = _serf_newt_poke; + u3V.inn_u.bal_f = _serf_newt_fail; + + u3_newt_read(&u3V.inn_u); + + /* send start request + */ + u3_serf_boot(); + + /* enter loop + */ + uv_run(lup_u, UV_RUN_DEFAULT); + return 0; +} From 43118dbae371bd4e5ed75b5a3740e962c5963aca Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Thu, 30 Apr 2020 14:21:24 -0700 Subject: [PATCH 004/257] king: Command Line Parsing for multi-tenet king. --- pkg/hs/urbit-king/lib/Urbit/King/CLI.hs | 16 +++++++--------- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 8 +++++++- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs index 78f3a7a85..b7c394278 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs @@ -93,7 +93,7 @@ data Bug data Cmd = CmdNew New Opts - | CmdRun Run Opts Bool + | CmdRun [(Run, Opts, Bool)] | CmdBug Bug | CmdCon FilePath deriving (Show) @@ -307,15 +307,13 @@ opts = do newShip :: Parser Cmd newShip = CmdNew <$> new <*> opts +runOneShip :: Parser (Run, Opts, Bool) +runOneShip = (,,) <$> fmap Run pierPath <*> opts <*> df + where + df = switch (short 'd' <> long "daemon" <> help "Daemon mode" <> hidden) + runShip :: Parser Cmd -runShip = do - rPierPath <- pierPath - o <- opts - daemon <- switch $ short 'd' - <> long "daemon" - <> help "Daemon mode" - <> hidden - pure (CmdRun (Run{..}) o daemon) +runShip = CmdRun <$> some runOneShip valPill :: Parser Bug valPill = do diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index f8e40e099..52103ed68 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -549,7 +549,7 @@ main = do Sys.installHandler Sys.sigTERM (Sys.Catch onTermSig) Nothing CLI.parseArgs >>= \case - CLI.CmdRun r o d -> runShip r o d + CLI.CmdRun ships -> runShips ships CLI.CmdNew n o -> runApp $ newShip n o CLI.CmdBug (CLI.CollectAllFX pax) -> runApp $ collectAllFx pax CLI.CmdBug (CLI.EventBrowser pax) -> runApp $ startBrowser pax @@ -561,6 +561,12 @@ main = do CLI.CmdBug CLI.CheckComet -> runApp $ checkComet CLI.CmdCon pier -> runAppLogFile $ connTerm pier +runShips :: [(CLI.Run, CLI.Opts, Bool)] -> IO () +runShips [] = pure () +runShips [(r,o,b)] = runShip r o b +runShips ships = + error ("TODO: Support multiple ships: " <> ppShow ships) + -------------------------------------------------------------------------------- From 5bc5819a6260c308cb3b1f6db484ec9fe1e64082 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Thu, 30 Apr 2020 14:51:28 -0700 Subject: [PATCH 005/257] king: Support running multiple ships at the same time. --- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 11 +++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 2 +- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 52103ed68..eeb4b806e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -562,10 +562,13 @@ main = do CLI.CmdCon pier -> runAppLogFile $ connTerm pier runShips :: [(CLI.Run, CLI.Opts, Bool)] -> IO () -runShips [] = pure () -runShips [(r,o,b)] = runShip r o b -runShips ships = - error ("TODO: Support multiple ships: " <> ppShow ships) +runShips = \case + [] -> pure () + [(r, o, d)] -> runShip r o d + ships -> do + threads <- for ships $ \(r, o, _) -> asyncBound (runShip r o True) + atomically $ asum (void . waitCatchSTM <$> threads) + for_ threads cancel -------------------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 06b2baeab..2b0174e62 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -253,7 +253,7 @@ pier (serf, log, ss) mStart = do atomically ded >>= \case Left (txt, exn) -> logError $ displayShow ("Somthing died", txt, exn) - Right tag -> logError $ displayShow ("something simply exited", tag) + Right tag -> logError $ displayShow ("Something simply exited", tag) atomically $ (Term.spin muxed) (Just "shutdown") From 13c51e2fe6d381e908d070813d28145c1140eaae Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 2 Apr 2020 14:40:38 -0700 Subject: [PATCH 006/257] u3: adds u3r_safe_* accessors --- pkg/urbit/include/noun/retrieve.h | 15 ++++++++++ pkg/urbit/noun/retrieve.c | 45 ++++++++++++++++++++++++++++ pkg/urbit/worker/serf.c | 49 ++++--------------------------- 3 files changed, 65 insertions(+), 44 deletions(-) diff --git a/pkg/urbit/include/noun/retrieve.h b/pkg/urbit/include/noun/retrieve.h index dffb3759f..eed2bcc91 100644 --- a/pkg/urbit/include/noun/retrieve.h +++ b/pkg/urbit/include/noun/retrieve.h @@ -404,6 +404,21 @@ c3_d* c_d, u3_atom d); + /* u3r_safe_byte(): validate and retrieve byte. + */ + c3_o + u3r_safe_byte(u3_noun dat, c3_y* out_y); + + /* u3r_safe_word(): validate and retrieve word. + */ + c3_o + u3r_safe_word(u3_noun dat, c3_w* out_w); + + /* u3r_safe_chub(): validate and retrieve chub. + */ + c3_o + u3r_safe_chub(u3_noun dat, c3_d* out_d); + /* u3r_string(): `a`, a text atom, as malloced C string. */ c3_c* diff --git a/pkg/urbit/noun/retrieve.c b/pkg/urbit/noun/retrieve.c index 1316896b2..cd01e2ba8 100644 --- a/pkg/urbit/noun/retrieve.c +++ b/pkg/urbit/noun/retrieve.c @@ -1198,6 +1198,51 @@ u3r_chubs(c3_w a_w, u3r_words(a_w * 2, b_w * 2, (c3_w *)c_d, d); } +/* u3r_safe_byte(): validate and retrieve byte. +*/ +c3_o +u3r_safe_byte(u3_noun dat, c3_y* out_y) +{ + if ( (c3n == u3a_is_atom(dat)) + || (1 < u3r_met(3, dat)) ) + { + return c3n; + } + + *out_y = u3r_byte(0, dat); + return c3y; +} + +/* u3r_safe_word(): validate and retrieve word. +*/ +c3_o +u3r_safe_word(u3_noun dat, c3_w* out_w) +{ + if ( (c3n == u3a_is_atom(dat)) + || (1 < u3r_met(5, dat)) ) + { + return c3n; + } + + *out_w = u3r_word(0, dat); + return c3y; +} + +/* u3r_safe_chub(): validate and retrieve chub. +*/ +c3_o +u3r_safe_chub(u3_noun dat, c3_d* out_d) +{ + if ( (c3n == u3a_is_atom(dat)) + || (1 < u3r_met(6, dat)) ) + { + return c3n; + } + + *out_d = u3r_chub(0, dat); + return c3y; +} + /* u3r_chop(): ** ** Into the bloq space of `met`, from position `fum` for a diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 18ca85778..02fd66269 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -884,45 +884,6 @@ _serf_live_walk(c3_d evt_d) u3V.sen_d = u3V.dun_d = evt_d; } -// XX move to u3r -// - -static c3_o -_r_safe_byte(u3_noun dat, c3_y* out_y) { - if ( (c3n == u3a_is_atom(dat)) || - (1 < u3r_met(3, dat)) ) - { - return c3n; - } - - *out_y = u3r_byte(0, dat); - return c3y; -} - -static c3_o -_r_safe_word(u3_noun dat, c3_w* out_w) { - if ( (c3n == u3a_is_atom(dat)) || - (1 < u3r_met(5, dat)) ) - { - return c3n; - } - - *out_w = u3r_word(0, dat); - return c3y; -} - -static c3_o -_r_safe_chub(u3_noun dat, c3_d* out_d) { - if ( (c3n == u3a_is_atom(dat)) || - (1 < u3r_met(6, dat)) ) - { - return c3n; - } - - *out_d = u3r_chub(0, dat); - return c3y; -} - /* _serf_step_trace(): initialize or rotate trace file. */ static void @@ -972,7 +933,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) case c3__exit: { c3_y cod_y; - if ( c3n == _r_safe_byte(dat, &cod_y) ) { + if ( c3n == u3r_safe_byte(dat, &cod_y) ) { goto error; } @@ -984,7 +945,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) case c3__save: { c3_d evt_d; - if ( c3n == _r_safe_chub(dat, &evt_d) ) { + if ( c3n == u3r_safe_chub(dat, &evt_d) ) { goto error; } @@ -996,7 +957,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) case c3__walk: { c3_d evt_d; - if ( c3n == _r_safe_chub(dat, &evt_d) ) { + if ( c3n == u3r_safe_chub(dat, &evt_d) ) { goto error; } @@ -1030,7 +991,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) if ( (c3n == u3r_trel(jar, 0, &evt, &lit)) || (c3n == u3a_is_cell(lit)) || - (c3n == _r_safe_chub(evt, &evt_d)) ) + (c3n == u3r_safe_chub(evt, &evt_d)) ) { goto error; } @@ -1048,7 +1009,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) if ( (c3n == u3r_trel(jar, 0, &evt, &job)) || (c3n == u3a_is_cell(job)) || - (c3n == _r_safe_chub(evt, &evt_d)) ) + (c3n == u3r_safe_chub(evt, &evt_d)) ) { goto error; } From 7226b7b21dbe64e1914e62382d15002a4a8f005f Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 8 Apr 2020 14:41:51 -0700 Subject: [PATCH 007/257] vere: WIP adds auto.c (i/o driver abstraction) --- pkg/urbit/vere/auto.c | 221 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 221 insertions(+) create mode 100644 pkg/urbit/vere/auto.c diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c new file mode 100644 index 000000000..e92684493 --- /dev/null +++ b/pkg/urbit/vere/auto.c @@ -0,0 +1,221 @@ +/* vere/auto.c +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +typedef struct _u3_ovum { + struct _u3_auto* car_u; // backpointer to i/o driver + void* vod_p; // context + c3_l msc_l; // ms to timeout + u3_noun tag; // target + u3_noun pax; // wire + u3_noun fav; // card + struct _u3_ovum* pre_u; // previous ovum + struct _u3_ovum* nex_u; // next ovum +} u3_ovum; + +typedef struct _u3_auto { + c3_m nam_m; + c3_o liv_o; + struct { + void (*init_f)(struct _u3_auto*); + void (*talk_f)(struct _u3_auto*); + c3_o (*fete_f)(struct _u3_auto*, u3_noun pax, u3_noun fav); // RETAIN + void (*exit_f)(struct _u3_auto*); // XX close_cb? + } io; + struct { + void (*drop_f)(struct _u3_auto*, void*); + void (*work_f)(struct _u3_auto*, void*); + void (*done_f)(struct _u3_auto*, void*); + void (*swap_f)(struct _u3_auto*, void*); + void (*bail_f)(struct _u3_auto*, void*); + } ev; + struct _u3_ovum* ent_u; + struct _u3_ovum* ext_u; + struct _u3_auto* nex_u; +} u3_auto; + +/* u3_auto_init(): initialize all drivers +*/ +void +u3_auto_init(u3_auto* car_u) +{ + while ( car_u ) { + car_u->io.init_f(car_u); + car_u = car_u->nex_u; + } +} + +/* u3_auto_talk(): start all drivers +*/ +void +u3_auto_talk(u3_auto* car_u) +{ + while ( car_u ) { + car_u->io.talk_f(car_u); + car_u = car_u->nex_u; + } +} + +/* u3_auto_exit(): close all drivers +*/ +void +u3_auto_exit(u3_auto* car_u) +{ + while ( car_u ) { + car_u->io.exit_f(car_u); + car_u = car_u->nex_u; + } +} + +/* u3_auto_live(): check if all drivers are live. +*/ +c3_o +u3_auto_live(u3_auto* car_u) +{ + while ( car_u ) { + if ( c3n == car_u->liv_o ) { + return c3n; + } + + car_u = car_u->nex_u; + } + + return c3y; +} + +/* u3_auto_plan(): create and enqueue an ovum +*/ +u3_ovum* +u3_auto_plan(u3_auto* car_u, + void* vod_p, + c3_l msc_l, + u3_noun tag, + u3_noun pax, + u3_noun fav) +{ + u3_ovum* egg_u = c3_malloc(sizeof(*egg_u)); + egg_u->car_u = car_u; + egg_u->vod_p = vod_p; + egg_u->msc_l = msc_l; + egg_u->tag = tag; + egg_u->pax = pax; + egg_u->fav = fav; + + if ( !car_u->ent_u ) { + c3_assert(!car_u->ext_u); + + egg_u->pre_u = egg_u->nex_u = 0; + car_u->ent_u = car_u->ext_u = egg_u; + } + else { + egg_u->nex_u = 0; + egg_u->pre_u = car_u->ent_u; + + car_u->ent_u->nex_u = egg_u; + car_u->ent_u = egg_u; + } + + return egg_u; +} + + +/* u3_auto_drop(): dequeue and dispose an ovum. +*/ +void +u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) +{ + if ( egg_u->pre_u ) { + egg_u->pre_u->nex_u = egg_u->nex_u; + } + + if ( egg_u->nex_u ) { + egg_u->nex_u->pre_u = egg_u->pre_u; + } + + // notify driver if not self-caused + // + if ( egg_u->car_u && ( car_u != egg_u->car_u ) ) { + egg_u->car_u->ev.drop_f(egg_u->car_u, egg_u->vod_p); + } + + u3z(egg_u->tag); + u3z(egg_u->pax); + u3z(egg_u->fav); + c3_free(egg_u); +} + +/* u3_auto_next(): select an ovum and dequeue. +*/ +u3_ovum* +u3_auto_next(u3_auto* car_u) +{ + u3_ovum* egg_u = 0; + + while ( car_u ) { + if ( car_u->ext_u ) { + egg_u = car_u->ext_u; + + c3_assert( !egg_u->pre_u ); + c3_assert( egg_u->nex_u ); + + egg_u->nex_u->pre_u = 0; + car_u->ext_u = egg_u->nex_u; + egg_u->nex_u = 0; + + // XX better name? + // + egg_u->car_u->ev.work_f(egg_u->car_u, egg_u->vod_p); + + return egg_u; + } + + car_u = car_u->nex_u; + } + + return egg_u; +} + +/* u3_auto_fete(): route effects to a linked driver +*/ +void +u3_auto_fete(u3_auto* car_u, u3_noun act) +{ + u3_noun pax, fav, fec; + u3_auto* rac_u = car_u; + + while ( u3_nul != act ) { + fec = u3h(act); + u3x_cell(fec, &pax, &fav); + + while ( c3n == car_u->io.fete_f(car_u, pax, fav) ) { + if ( !car_u->nex_u ) { + // reck_kick_norm + // "kick: lost" + break; + } + else { + car_u = car_u->nex_u; + } + } + + car_u = rac_u; + act = u3t(act); + } +} From a4fa434bca3cdf33f37373f8080b682b3a54cdb9 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 10 Apr 2020 00:08:56 -0700 Subject: [PATCH 008/257] vere: WIP adds lord.c (serf controller) --- pkg/urbit/vere/lord.c | 834 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 834 insertions(+) create mode 100644 pkg/urbit/vere/lord.c diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c new file mode 100644 index 000000000..7ca29e6c0 --- /dev/null +++ b/pkg/urbit/vere/lord.c @@ -0,0 +1,834 @@ +/* vere/lord.c +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* +:: +writ: from king to serf +:: ++$ writ + $% $: %live + $% [%exit cod=@] + [%save eve=@] + [%snap eve=@] + == == + [%peek now=date lyc=gang pat=path] + [%play eve=@ lit=(list ?((pair date ovum) *))] + [%work job=(pair date ovum)] + == +:: +plea: from serf to king +:: ++$ plea + $% [%live ~] + [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] + [%slog pri=@ =tank] + [%peek dat=(unit (cask))] + $: %play + $% [%done mug=@] + [%bail eve=@ mug=@ dud=goof] + == == + $: %work + $% [%done eve=@ mug=@ fec=(list ovum)] + [%swap eve=@ mug=@ job=(pair date ovum) fec=(list ovum)] + [%bail lud=(list goof)] + == == + == +-- +*/ + +typedef struct _u3_fact { + c3_d eve_d; // event number + c3_l bug_l; // kernel mug before + c3_l mug_l; // kernel mug after + u3_noun job; // (pair date ovum) (XX or 0?) + struct _u3_fact* nex_u; // next in queue +} u3_fact; + +typedef struct _u3_peek { + u3_noun now; // date + u3_noun gan; // (unit (set ship)) + u3_noun pat; // path (serialized beam) +} u3_peek; + +typedef struct _u3_play { + struct _u3_fact* ent_u; // queue entry + struct _u3_fact* ext_u; // queue exit +} u3_play; + +typedef struct _u3_work { + struct _u3_ovum* egg_u; // unlinked ovum + c3_l bug_l; // kernel mug before + u3_noun job; // (pair date ovum) + c3_d eve_d; // event number + c3_l mug_l; // kernel mug after + u3_noun act; // action list +} u3_work; + +typedef struct _u3_rrit { + struct timeval tim_tv; // time enqueued + u3_atom mat; // serialized + c3_o sen_o; // sent + struct _u3_rrit* nex_u; // next in queue, or 0 + c3_m typ_m; // tag + union { // + c3_w xit_w; // exit code + c3_d eve_d; // for %save or %snap + struct _u3_peek* pek_u; // read + struct _u3_play* pay_u; // recompute + struct _u3_work* wok_u; // compute + }; +} u3_rrit; + +typedef struct _u3_lord_cb { + void* vod_p; + void (*live_f)(void*); + void (*slog_f)(void*, c3_w, u3_noun); + void (*peek_f)(void*, u3_noun gan, u3_noun pat, u3_noun dat); + void (*play_done_f)(void*, u3_play*, c3_l mug_l); + void (*play_bail_f)(void*, u3_play*, c3_l mug_l, u3_play*, u3_noun dud); + void (*work_done_f)(void*, u3_work*); + void (*work_swap_f)(void*, u3_work*); + void (*work_bail_f)(void*, u3_work*, u3_noun lud); + void (*snap_f)(void*, c3_d eve_d); + void (*save_f)(void*, c3_d eve_d); + void (*exit_f)(void*, c3_o); +} u3_lord_cb; + +typedef struct _u3_lord { + uv_process_t cub_u; // process handle + uv_process_options_t ops_u; // process configuration + uv_stdio_container_t cod_u[3]; // process options + time_t wen_t; // process creation time + u3_mojo inn_u; // client's stdin + u3_moat out_u; // client's stdout + u3_lord_cb cb_u; // callbacks + c3_o liv_o; // live + c3_y hon_y; // hoon kelvin + c3_y noc_y; // hoon kelvin + c3_o hol_o; // on hold + c3_d eve_d; // last event completed + c3_l mug_l; // mug at eve_d + struct _u3_rrit* ent_u; // queue entry + struct _u3_rrit* ext_u; // queue exit +} u3_lord; + +static void +_lord_writ_spin(u3_lord* god_u); + +/* _lord_writ_pop(): pop the writ stack +*/ +static u3_rrit* +_lord_writ_pop(u3_lord* god_u) +{ + u3_rrit* wit_u = god_u->ext_u; + + c3_assert( wit_u ); + + if ( !wit_u->nex_u ) { + god_u->ent_u = god_u->ext_u = 0; + } + else { + god_u->ext_u = wit_u->nex_u; + wit_u->nex_u = 0; + } + + return wit_u; +} + +/* _lord_writ_need(): require mote +*/ +static u3_rrit* +_lord_writ_need(u3_lord* god_u, c3_m ned_m) +{ + u3_rrit* wit_u = _lord_writ_pop(god_u); + + if ( ned_m != wit_u->typ_m ) { + fprintf(stderr, "lord: unexpected %%%.4s, expected %%%.4s\r\n", + (c3_c*)&wit_u->typ_m, + (c3_c*)&ned_m); + u3_pier_bail(); + exit(1); + } + + return wit_u; +} + +/* _lord_on_exit(): handle subprocess exit. +*/ +static void +_lord_on_exit(uv_process_t* req_u, + c3_ds sas_i, + c3_i sig_i) +{ + u3_lord* god_u = (void*)req_u; + c3_w xit_w; + { + u3_rrit* wit_u =_lord_writ_need(god_u, c3__exit); + xit_w = wit_u->xit_w; + c3_free(wit_u); + } + + { + void (*exit_f)(void*, c3_o) = god_u->cb_u.exit_f; + void* vod_p = god_u->cb_u.vod_p; + // XX correct comparison? + // + c3_o ret_o = ( xit_w == sas_i ) ? c3y : c3n; + + // XX dispose god_u + // + exit_f(vod_p, c3y); + } +} + +/* _lord_bail(): handle subprocess error. +*/ +static void +_lord_bail(void* vod_p, + const c3_c* err_c) +{ + // XX + fprintf(stderr, "\rpier: work error: %s\r\n", err_c); +} + +static void +_lord_plea_foul(u3_lord* god_u, c3_m mot_m, u3_noun dat) +{ + if ( u3_blip == mot_m ) { + fprintf(stderr, "lord: received invalid $plea\r\n"); + } + else { + fprintf(stderr, "lord: received invalid %%%.4s $plea\r\n", (c3_c*)&mot_m); + } + + u3m_p("plea", dat); + u3_pier_bail(); + exit(1); +} + +/* _lord_plea_live(): hear serf %live ack +*/ +static void +_lord_plea_live(u3_lord* god_u, u3_noun dat) +{ + u3_rrit* wit_u = _lord_writ_pop(god_u); + + if( u3_nul != dat ) { + return _lord_plea_foul(god_u, c3__live, dat); + } + + switch ( wit_u->typ_m ) { + default: { + fprintf(stderr, "lord: unexpected %%live, expected %%%.4s\r\n", + (c3_c*)&wit_u->typ_m); + u3_pier_bail(); + exit(1); + } + + case c3__save: { + god_u->cb_u.save_f(god_u->cb_u.vod_p, wit_u->eve_d); + god_u->hol_o = c3n; + _lord_writ_spin(god_u); + break; + } + + case c3__snap: { + god_u->cb_u.snap_f(god_u->cb_u.vod_p, wit_u->eve_d); + god_u->hol_o = c3n; + _lord_writ_spin(god_u); + break; + } + } + + c3_free(wit_u); +} + +/* _lord_plea_ripe(): hear serf startup state +*/ +static void +_lord_plea_ripe(u3_lord* god_u, u3_noun dat) +{ + if ( c3y == god_u->liv_o ) { + fprintf(stderr, "lord: received unexpected %%ripe\n"); + u3_pier_bail(); + exit(1); + } + + { + u3_noun ver, pro, hon, noc, eve, mug; + c3_y pro_y, hon_y, noc_y; + c3_d eve_d; + c3_l mug_l; + + if ( (c3n == u3r_trel(dat, &ver, &eve, &mug)) + || (c3n == u3r_trel(ver, &pro, &hon, &noc)) + || (c3n == u3r_safe_byte(pro, &pro_y)) + || (c3n == u3r_safe_byte(hon, &hon_y)) + || (c3n == u3r_safe_byte(noc, &noc_y)) + || (c3n == u3r_safe_chub(eve, &eve_d)) + || (c3n == u3r_safe_word(mug, &mug_l)) ) + { + return _lord_plea_foul(god_u, c3__ripe, dat); + } + + if ( 1 != pro_y ) { + fprintf(stderr, "pier: unsupported ipc protocol version %u\r\n", pro_y); + u3_pier_bail(); + exit(1); + } + +#ifdef VERBOSE_EVENTS + fprintf(stderr, "pier: (%" PRIu64 "): ripe at mug %x\r\n", eve_d, mug_l); +#endif + + god_u->eve_d = eve_d; + god_u->mug_l = mug_l; + god_u->hon_y = hon_y; + god_u->noc_y = noc_y; + } + + god_u->liv_o = c3y; + god_u->cb_u.live_f(god_u->cb_u.vod_p); + + u3z(dat); +} + +/* _lord_plea_slog(): hear serf debug output +*/ +static void +_lord_plea_slog(u3_lord* god_u, u3_noun dat) +{ + u3_noun pri, tan; + c3_w pri_w; + + if ( (c3n == u3r_cell(dat, &pri, &tan)) + || (c3n == u3r_safe_word(pri, &pri_w)) ) + { + return _lord_plea_foul(god_u, c3__slog, dat); + } + + // XX per-writ slog_f? + // + + god_u->cb_u.slog_f(god_u->cb_u.vod_p, pri_w, u3k(tan)); + u3z(dat); +} + +/* _lord_plea_peek(): hear serf %peek response +*/ +static void +_lord_plea_peek(u3_lord* god_u, u3_noun dat) +{ + u3_peek* pek_u; + { + u3_rrit* wit_u = _lord_writ_need(god_u, c3__peek); + pek_u = wit_u->pek_u; + c3_free(wit_u); + } + + god_u->cb_u.peek_f(god_u->cb_u.vod_p, pek_u->gan, pek_u->pat, dat); +} + +/* _lord_plea_play(): hear serf %play response +*/ +static void +_lord_plea_play(u3_lord* god_u, u3_noun dat) +{ + u3_play* pay_u; + { + u3_rrit* wit_u = _lord_writ_need(god_u, c3__play); + pay_u = wit_u->pay_u; + c3_free(wit_u); + } + + if ( c3n == u3a_is_cell(dat) ) { + return _lord_plea_foul(god_u, c3__play, dat); + } + + switch ( u3h(dat) ) { + default: { + return _lord_plea_foul(god_u, c3__play, dat); + } + + case c3__bail: { + u3_noun eve, mug, dud; + c3_d eve_d; + c3_l mug_l; + + if ( (c3n == u3r_trel(u3t(dat), &eve, &mug, &dud)) + || (c3n == u3r_safe_chub(eve, &eve_d)) + || (c3n == u3r_safe_word(mug, &mug_l)) + || (c3n == u3a_is_cell(dud)) ) + { + return _lord_plea_foul(god_u, c3__play, dat); + } + + { + u3_play* yap_u = c3_malloc(sizeof(*yap_u)); + u3_fact* fac_u = pay_u->ext_u; + + while ( fac_u->eve_d < eve_d ) { + fac_u = fac_u->nex_u; + } + + yap_u->ext_u = fac_u->nex_u; + yap_u->ent_u = pay_u->ent_u; + pay_u->ent_u = fac_u; + + god_u->cb_u.play_bail_f(god_u->cb_u.vod_p, + pay_u, mug_l, yap_u, u3k(dud)); + } + break; + } + + case c3__done: { + c3_l mug_l; + + if ( c3n == u3r_safe_word(u3t(dat), &mug_l) ) { + return _lord_plea_foul(god_u, c3__play, dat); + } + + god_u->cb_u.play_done_f(god_u->cb_u.vod_p, pay_u, mug_l); + break; + } + } + + u3z(dat); +} + +/* _lord_plea_work(): hear serf %work response +*/ +static void +_lord_plea_work(u3_lord* god_u, u3_noun dat) +{ + u3_work* wok_u; + { + u3_rrit* wit_u = _lord_writ_need(god_u, c3__work); + wok_u = wit_u->wok_u; + c3_free(wit_u); + } + + if ( c3n == u3a_is_cell(dat) ) { + return _lord_plea_foul(god_u, c3__work, dat); + } + + switch ( u3h(dat) ) { + default: { + return _lord_plea_foul(god_u, c3__work, dat); + } + + case c3__bail: { + u3_noun lud = u3t(dat); + + if ( god_u->ext_u + && wok_u->bug_l + && ( c3__work == god_u->ext_u->typ_m ) ) + { + god_u->ext_u->wok_u->bug_l = wok_u->bug_l; + } + + god_u->cb_u.work_bail_f(god_u->cb_u.vod_p, wok_u, u3k(lud)); + break; + } + + case c3__swap: { + u3_noun eve, mug, job, fec; + c3_d eve_d; + c3_l mug_l; + + if ( (c3n == u3r_qual(u3t(dat), &eve, &mug, &job, &fec)) + || (c3n == u3r_safe_chub(eve, &eve_d)) + || (c3n == u3r_safe_word(mug, &mug_l)) + || (c3n == u3a_is_cell(job)) ) + { + return _lord_plea_foul(god_u, c3__work, dat); + } + + wok_u->eve_d = god_u->mug_l = eve_d; + wok_u->mug_l = god_u->mug_l = mug_l; + u3z(wok_u->job); + wok_u->job = job; + wok_u->act = fec; + + if ( god_u->ext_u && ( c3__work == god_u->ext_u->typ_m ) ) { + god_u->ext_u->wok_u->bug_l = mug_l; + } + + god_u->cb_u.work_swap_f(god_u->cb_u.vod_p, wok_u); + break; + } + + case c3__done: { + u3_noun eve, mug, fec; + c3_d eve_d; + c3_l mug_l; + + if ( (c3n == u3r_trel(u3t(dat), &eve, &mug, &fec)) + || (c3n == u3r_safe_chub(eve, &eve_d)) + || (c3n == u3r_safe_word(mug, &mug_l)) ) + { + return _lord_plea_foul(god_u, c3__work, dat); + } + + wok_u->eve_d = god_u->mug_l = eve_d; + wok_u->mug_l = god_u->mug_l = mug_l; + wok_u->act = fec; + + if ( god_u->ext_u && ( c3__work == god_u->ext_u->typ_m ) ) { + god_u->ext_u->wok_u->bug_l = mug_l; + } + + god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u); + break; + } + } + + u3z(dat); +} + +/* _lord_poke(): handle subprocess result. transfer nouns. +*/ +static void +_lord_poke(void* vod_p, + u3_noun mat) +{ + u3_lord* god_u = vod_p; + u3_noun jar = u3ke_cue(mat); + u3_noun tag, dat; + + if ( c3n == u3r_cell(jar, &tag, &dat) ) { + goto error; + } + + switch ( tag ) { + default: goto error; + + case c3__live: { + _lord_plea_live(god_u, u3k(dat)); + break; + } + + case c3__ripe: { + _lord_plea_ripe(god_u, u3k(dat)); + break; + } + + case c3__slog: { + _lord_plea_slog(god_u, u3k(dat)); + break; + } + + case c3__peek: { + _lord_plea_peek(god_u, u3k(dat)); + break; + } + + case c3__play: { + _lord_plea_play(god_u, u3k(dat)); + break; + } + + case c3__work: { + _lord_plea_work(god_u, u3k(dat)); + break; + } + } + + u3z(jar); + return; + + error: { + u3m_p("jar", jar); + u3z(jar); + _lord_bail(0, "bad jar"); + } +} + +/* u3_lord_init(): instantiate child process. +*/ +u3_lord* +u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) +{ + u3_lord* god_u = c3_calloc(sizeof *god_u); + // XX wag_w, key_d? + // + god_u->hol_o = c3n; + god_u->liv_o = c3n; + + // spawn new process and connect to it + // + { + c3_c* arg_c[5]; + c3_c* bin_c = u3_Host.wrk_c; + c3_c* pax_c = pax_c; + c3_c key_c[256]; + c3_c wag_c[11]; + c3_i err_i; + + sprintf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", + key_d[0], + key_d[1], + key_d[2], + key_d[3]); + + sprintf(wag_c, "%u", wag_w); + + arg_c[0] = bin_c; // executable + arg_c[1] = pax_c; // path to checkpoint directory + arg_c[2] = key_c; // disk key + arg_c[3] = wag_c; // runtime config + arg_c[4] = 0; + + uv_pipe_init(u3L, &god_u->inn_u.pyp_u, 0); + uv_pipe_init(u3L, &god_u->out_u.pyp_u, 0); + + god_u->cod_u[0].flags = UV_CREATE_PIPE | UV_READABLE_PIPE; + god_u->cod_u[0].data.stream = (uv_stream_t *)&god_u->inn_u; + + god_u->cod_u[1].flags = UV_CREATE_PIPE | UV_WRITABLE_PIPE; + god_u->cod_u[1].data.stream = (uv_stream_t *)&god_u->out_u; + + god_u->cod_u[2].flags = UV_INHERIT_FD; + god_u->cod_u[2].data.fd = 2; + + god_u->ops_u.stdio = god_u->cod_u; + god_u->ops_u.stdio_count = 3; + + god_u->ops_u.exit_cb = _lord_on_exit; + god_u->ops_u.file = arg_c[0]; + god_u->ops_u.args = arg_c; + + if ( (err_i = uv_spawn(u3L, &god_u->cub_u, &god_u->ops_u)) ) { + fprintf(stderr, "spawn: %s: %s\r\n", arg_c[0], uv_strerror(err_i)); + + return 0; + } + } + + /* start reading from proc + */ + { + god_u->out_u.vod_p = god_u; + god_u->out_u.pok_f = _lord_poke; + god_u->out_u.bal_f = _lord_bail; + + // XX distinguish from out_u.bal_f ? + // + god_u->inn_u.bal_f = _lord_bail; + + u3_newt_read(&god_u->out_u); + } + return god_u; +} + +/* _lord_writ_new(); +*/ +static u3_rrit* +_lord_writ_new(u3_lord* god_u) +{ + u3_rrit* wit_u = c3_malloc(sizeof(*wit_u)); + wit_u->sen_o = c3n; + wit_u->mat = 0; + wit_u->nex_u = 0; + gettimeofday(&wit_u->tim_tv, 0); + + return wit_u; +} + +/* _lord_writ_jam(); +*/ +static void +_lord_writ_jam(u3_lord* god_u, u3_rrit* wit_u) +{ + if ( 0 == wit_u->mat ) { + u3_noun msg; + + switch ( wit_u->typ_m ) { + default: c3_assert(0); + + case c3__exit: { + msg = u3nt(c3__live, c3__exit, u3i_words(1, &wit_u->xit_w)); + break; + } + + case c3__save: { + wit_u->eve_d = god_u->eve_d; + msg = u3nt(c3__live, c3__save, u3i_chubs(1, &wit_u->eve_d)); + break; + } + + case c3__snap: { + wit_u->eve_d = god_u->eve_d; + msg = u3nt(c3__live, c3__snap, u3i_chubs(1, &wit_u->eve_d)); + break; + } + + case c3__peek: { + c3_assert(0); + } + + case c3__play: { + u3_fact* tac_u = wit_u->pay_u->ext_u; + u3_noun lit = u3_nul; + + while ( tac_u ) { + lit = u3nc(u3k(tac_u->job), lit); + tac_u = tac_u->nex_u; + } + + msg = u3nt(c3__play, u3i_chubs(1, &wit_u->pay_u->ext_u->eve_d), lit); + } + + case c3__work: { + msg = u3nc(c3__work, wit_u->wok_u->job); + } + } + + wit_u->mat = u3ke_jam(msg); + } +} + +/* _lord_writ_send(); +*/ +static void +_lord_writ_send(u3_lord* god_u, u3_rrit* wit_u) +{ + if ( c3n == wit_u->sen_o ) { + _lord_writ_jam(god_u, wit_u); + u3_newt_write(&god_u->inn_u, wit_u->mat, 0); + wit_u->sen_o = c3y; + } +} + +/* _lord_writ_spin(); +*/ +static void +_lord_writ_spin(u3_lord* god_u) +{ + u3_rrit* wit_u = god_u->ext_u; + + while ( wit_u ) { + _lord_writ_send(god_u, wit_u); + wit_u = wit_u->nex_u; + } +} + +/* _lord_writ_plan(); +*/ +static void +_lord_writ_plan(u3_lord* god_u, u3_rrit* wit_u) +{ + if ( !god_u->ent_u ) { + c3_assert( !god_u->ext_u ); + god_u->ent_u = god_u->ext_u = wit_u; + } + else { + god_u->ent_u->nex_u = wit_u; + god_u->ent_u = wit_u; + } + + if ( c3n == god_u->hol_o ) { + _lord_writ_send(god_u, wit_u); + } +} + +/* u3_lord_exit(); +*/ +void +u3_lord_exit(u3_lord* god_u, c3_w cod_w) +{ + u3_rrit* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__exit; + wit_u->xit_w = cod_w; + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_save(); +*/ +void +u3_lord_save(u3_lord* god_u) +{ + u3_rrit* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__save; + + god_u->hol_o = c3y; + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_snap(); +*/ +void +u3_lord_snap(u3_lord* god_u) +{ + u3_rrit* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__snap; + + god_u->hol_o = c3y; + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_peek(); +*/ +void +u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun pat) +{ + u3_rrit* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__peek; + wit_u->pek_u = c3_malloc(sizeof(*wit_u->pek_u)); + wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_tv); + wit_u->pek_u->gan = gan; + wit_u->pek_u->pat = pat; + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_play(); +*/ +void +u3_lord_play(u3_lord* god_u, u3_play* pay_u) +{ + u3_rrit* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__play; + wit_u->pay_u = pay_u; + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_work(); +*/ +void +u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo) +{ + u3_rrit* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__work; + wit_u->wok_u = c3_malloc(sizeof(*wit_u->wok_u)); + wit_u->wok_u->egg_u = egg_u; + + { + u3_noun now = u3_time_in_tv(&wit_u->tim_tv); + wit_u->wok_u->job = u3nc(now, ovo); + } + + if ( !god_u->ent_u ) { + wit_u->wok_u->bug_l = god_u->mug_l; + } + + _lord_writ_plan(god_u, wit_u); +} From 3e8d8e7795545c277f1da903e56c76e34f724c26 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 15 Apr 2020 18:30:36 -0700 Subject: [PATCH 009/257] u3: properly disables stack-overflow handling via NO_OVERFLOW --- pkg/urbit/noun/manage.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/pkg/urbit/noun/manage.c b/pkg/urbit/noun/manage.c index 64a6621f1..6098a042f 100644 --- a/pkg/urbit/noun/manage.c +++ b/pkg/urbit/noun/manage.c @@ -369,7 +369,9 @@ _cm_signal_done() signal(SIGTERM, SIG_IGN); signal(SIGVTALRM, SIG_IGN); +#ifndef NO_OVERFLOW stackoverflow_deinstall_handler(); +#endif { struct itimerval itm_u; From f912d7eaf89c2a269fef38b88ddf377e87f18dd4 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 15 Apr 2020 18:35:42 -0700 Subject: [PATCH 010/257] vere: WIP serf protocol tweaks --- pkg/urbit/worker/serf.c | 151 ++++++++++++++++------------------------ 1 file changed, 61 insertions(+), 90 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 02fd66269..0c64acc05 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -46,28 +46,27 @@ $% $: %live $% [%exit cod=@] [%save eve=@] - [%walk eve=@] + [%snap eve=@] == == [%peek now=date lyc=gang pat=path] - [%play eve=@ lit=(list $?((pair date ovum) *))] - [%work eve=@ job=(pair date ovum)] + [%play eve=@ lit=(list ?((pair date ovum) *))] + [%work job=(pair date ovum)] == :: +plea: from serf to king :: +$ plea - $% [%ripe pro=@ kel=(list (pair term @ud)) eve=@ mug=@] + $% [%live ~] + [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] [%slog pri=@ =tank] - [%peek pat=path dat=(unit (cask))] + [%peek dat=(unit (cask))] $: %play - eve=@ $% [%done mug=@] - [%bail dud=goof] + [%bail eve=@ mug=@ dud=goof] == == $: %work - eve=@ - $% [%done mug=@ fec=(list ovum)] - [%swap mug=@ job=(pair date ovum) fec=(list ovum)] - [%bail dud=(list goof)] + $% [%done eve=@ mug=@ fec=(list ovum)] + [%swap eve=@ mug=@ job=(pair date ovum) fec=(list ovum)] + [%bail lud=(list goof)] == == == -- @@ -76,13 +75,9 @@ questions: - %peek - persistent dates? (in arvo or serf) - - response on block/unit? - %play - expect lifecycle on [%ripe ... eve=0 mug=0] - eve identifies failed event on [%play @ %bail ...] -- %live unacknowledged, crash on failure - - %walk resyncs eve - - %save both %fast and %full? (save to where? ack? continue after?) - %pack - could just be [%save %full ...] followed by a restart - %mass @@ -91,7 +86,6 @@ questions: - in $writ for timeouts - in $plea for measurement - duct or vane stack for spinner -- slog back to toplevel? */ /* _serf_space(): print n spaces. @@ -377,7 +371,7 @@ _serf_send_slog(u3_noun hod) static void _serf_send_stdr(c3_c* str_c) { - _serf_send_slog(u3nc(c3__leaf, u3i_string(str_c))); + _serf_send_slog(u3nt(0, c3__leaf, u3i_tape(str_c))); } static void @@ -537,7 +531,7 @@ _serf_poke_time(c3_d evt_d, c3_c* txt_c, struct timeval b4) /* _serf_work(): apply event, capture effects. */ static u3_noun -_serf_work(c3_d evt_d, u3_noun job) +_serf_work(u3_noun job) { u3_noun now, ovo, gon, last_date; c3_w pre_w = u3a_open(u3R); @@ -548,8 +542,8 @@ _serf_work(c3_d evt_d, u3_noun job) // event numbers must be continuous (see [%live %walk @]) // - c3_assert(evt_d == u3V.dun_d + 1ULL); - u3V.sen_d = evt_d; + c3_assert( u3V.sen_d == u3V.dun_d); + u3V.sen_d++; u3x_cell(job, &now, &ovo); @@ -565,15 +559,15 @@ _serf_work(c3_d evt_d, u3_noun job) gettimeofday(&b4, 0); txt_c = u3r_string(u3h(u3t(ovo))); - u3l_log("serf: %s (%" PRIu64 ") live\r\n", txt_c, evt_d); + u3l_log("serf: work (%" PRIu64 ") %s\r\n", txt_c, u3V.sen_d); } #endif gon = u3m_soft(0, u3v_poke, u3k(ovo)); #ifdef U3_EVENT_TIME_DEBUG - if ( bug_t { - _serf_poke_time(evt_d, txt_c, b4); + if ( bug_t ) { + _serf_poke_time(u3V.sen_d, txt_c, b4); c3_free(txt_c); } #endif @@ -592,7 +586,9 @@ _serf_work(c3_d evt_d, u3_noun job) u3z(gon); u3z(job); u3z(last_date); - return u3nt(c3__done, u3i_words(1, &u3V.mug_l), vir); + return u3nc(c3__done, u3nt(u3i_chubs(1, &u3V.dun_d), + u3i_words(1, &u3V.mug_l), + vir)); } // event rejected @@ -619,7 +615,7 @@ _serf_work(c3_d evt_d, u3_noun job) #ifdef U3_EVENT_TIME_DEBUG if ( bug_t ) { gettimeofday(&b4, 0); - u3l_log("serf: crud (%" PRIu64 ") live\r\n", evt_d); + u3l_log("serf: crud (%" PRIu64 ") live\r\n", u3V.sen_d); } #endif @@ -627,8 +623,8 @@ _serf_work(c3_d evt_d, u3_noun job) gon = u3m_soft(0, u3v_poke, u3k(ovo)); #ifdef U3_EVENT_TIME_DEBUG - if ( bug_t { - _serf_poke_time(evt_d, "crud", b4); + if ( bug_t ) { + _serf_poke_time(u3V.sen_d, "crud", b4); } #endif @@ -646,9 +642,11 @@ _serf_work(c3_d evt_d, u3_noun job) u3z(gon); u3z(job); u3z(last_date); u3z(dud); - return u3nq(c3__swap, u3i_words(1, &u3V.mug_l), - u3nc(u3k(u3A->now), ovo), - vir); + + return u3nc(c3__swap, u3nq(u3i_chubs(1, &u3V.dun_d), + u3i_words(1, &u3V.mug_l), + u3nc(u3k(u3A->now), ovo), + vir)); } // error notification rejected @@ -678,7 +676,7 @@ _serf_work(c3_d evt_d, u3_noun job) /* _serf_work_trace(): %work, with trace */ static u3_noun -_serf_work_trace(c3_d evt_d, u3_noun job) +_serf_work_trace(u3_noun job) { c3_t tac_t = ( 0 != u3_Host.tra_u.fil_u ); c3_c lab_c[2048]; @@ -693,8 +691,7 @@ _serf_work_trace(c3_d evt_d, u3_noun job) { c3_c* cad_c = u3m_pretty(cad); c3_c* wir_c = u3m_pretty_path(wir); - snprintf(lab_c, 2048, "event %" PRIu64 ": [%s %s]", - evt_d, wir_c, cad_c); + snprintf(lab_c, 2048, "work [%s %s]", wir_c, cad_c); c3_free(cad_c); c3_free(wir_c); } @@ -702,7 +699,7 @@ _serf_work_trace(c3_d evt_d, u3_noun job) u3t_event_trace(lab_c, 'B'); } - pro = _serf_work(evt_d, job); + pro = u3nc(c3__work, _serf_work(job)); if ( tac_t ) { u3t_event_trace(lab_c, 'E'); @@ -717,11 +714,13 @@ _serf_play_life(u3_noun eve) c3_d len_d; { u3_noun len = u3qb_lent(eve); - - c3_assert( 1 == u3r_met(6, len) ); - len_d = u3r_chub(1, len); + c3_assert( c3y == u3r_safe_chub(len, &len_d) ); + u3z(len); } + c3_assert( 0ULL == u3V.sen_d ); + u3V.sen_d = len_d; + // XX set evt_d forall lit so that %slog is accurate? // XX capture bail instead of exit // @@ -730,11 +729,11 @@ _serf_play_life(u3_noun eve) exit(1); } - u3V.dun_d = u3V.sen_d = u3A->ent_d = len_d; + // XX refactor to use _serf_sure_core() + // + u3V.dun_d = u3A->ent_d = u3V.sen_d; u3V.mug_l = u3r_mug(u3A->roc); - u3l_log("serf: (%" PRIu64 ")| core: %x\r\n", u3V.dun_d, u3V.mug_l); - return u3nc(c3__done, u3V.mug_l); } @@ -757,6 +756,7 @@ _serf_play_list(u3_noun eve) if ( u3_blip != u3h(gon) ) { u3_noun dud = u3k(u3t(gon)); + c3_d eve_d = u3V.sen_d; u3z(gon); // restore previous time @@ -770,8 +770,7 @@ _serf_play_list(u3_noun eve) // XX reclaim/pack on meme // XX retry? // - - return u3nc(c3__bail, dud); + return u3nq(c3__bail, eve_d, u3V.mug_l, dud); } else { // vir/(list ovum) list of effects @@ -808,11 +807,9 @@ _serf_play(c3_d evt_d, u3_noun lit) // XX better condition for no kernel? // - u3_noun pro = ( 0ULL == u3V.dun_d ) - ? _serf_play_life(lit) - : _serf_play_list(lit); - - return u3nt(c3__play, u3i_chubs(1, &u3V.dun_d), pro); + return u3nc(c3__play, ( 0ULL == u3V.dun_d ) + ? _serf_play_life(lit) + : _serf_play_list(lit)); } // /* _serf_poke_peek(): dereference namespace. @@ -868,20 +865,12 @@ _serf_live_exit(c3_w cod_w) /* _serf_live_save(): save snapshot. */ -static void +static u3_noun _serf_live_save(c3_d evt_d) { c3_assert( evt_d == u3V.dun_d ); u3e_save(); -} - -/* _serf_live_walk(): bump event number. -*/ -static void -_serf_live_walk(c3_d evt_d) -{ - u3l_log("serf: bump %" PRIu64 " to %" PRIu64 "\r\n", u3V.dun_d, evt_d); - u3V.sen_d = u3V.dun_d = evt_d; + return u3nc(c3__live, u3_nul); } /* _serf_step_trace(): initialize or rotate trace file. @@ -900,9 +889,9 @@ _serf_step_trace(void) } } -/* _serf_poke(): +/* _serf_newt_poke(): */ -void +static void _serf_newt_poke(void* vod_p, u3_noun mat) { u3_noun jar = u3ke_cue(mat); @@ -942,7 +931,10 @@ _serf_newt_poke(void* vod_p, u3_noun mat) return; } - case c3__save: { + // XX + // + case c3__save: + case c3__snap: { c3_d evt_d; if ( c3n == u3r_safe_chub(dat, &evt_d) ) { @@ -950,19 +942,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) } u3z(jar); - _serf_live_save(evt_d); - return; - } - - case c3__walk: { - c3_d evt_d; - - if ( c3n == u3r_safe_chub(dat, &evt_d) ) { - goto error; - } - - u3z(jar); - _serf_live_walk(evt_d); + _serf_send(_serf_live_save(evt_d)); return; } } @@ -1004,25 +984,16 @@ _serf_newt_poke(void* vod_p, u3_noun mat) } case c3__work: { - u3_noun evt, job; - c3_d evt_d; - - if ( (c3n == u3r_trel(jar, 0, &evt, &job)) || - (c3n == u3a_is_cell(job)) || - (c3n == u3r_safe_chub(evt, &evt_d)) ) - { - goto error; - } - - u3k(job); + u3_noun job = u3k(u3t(jar)); u3z(jar); - _serf_send(_serf_work_trace(evt_d, job)); + _serf_send(_serf_work_trace(job)); _serf_sure_post(); return; } } error: { + // u3m_p("jar", jar); u3z(jar); _serf_newt_fail(0, "bad jar"); } @@ -1033,7 +1004,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) static u3_noun _serf_ripe(void) { - u3l_log("serf: ripe %" PRIu64 "\r\n", u3V.dun_d); + // u3l_log("serf: ripe %" PRIu64 "\r\n", u3V.dun_d); u3V.mug_l = ( 0 == u3V.dun_d ) ? 0 : u3r_mug(u3A->roc); return u3nc(u3i_chubs(1, &u3V.dun_d), u3i_words(1, &u3V.mug_l)); @@ -1045,11 +1016,11 @@ void u3_serf_boot(void) { c3_w pro_w = 1; - u3_noun kel = u3nt(u3nc(c3__hoon, 141), - u3nc(c3__nock, 4), - u3_nul); + c3_y hon_y = 141; + c3_y noc_y = 4; + u3_noun ver = u3nt(pro_w, hon_y, noc_y); - _serf_send(u3nq(c3__ripe, pro_w, kel, _serf_ripe())); + _serf_send(u3nt(c3__ripe, ver, _serf_ripe())); // measure/print static memory usage if < 1/2 of the loom is available // From 8c982a0f03d9d397197a4994acdf9bb0dfdddab5 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 16 Apr 2020 16:41:05 -0700 Subject: [PATCH 011/257] vere: WIP pier/serf rewrite --- pkg/urbit/daemon/main.c | 2 +- pkg/urbit/include/vere/vere.h | 325 +++- pkg/urbit/vere/auto.c | 53 +- pkg/urbit/vere/disk.c | 454 ++++++ pkg/urbit/vere/lmdb.c | 24 +- pkg/urbit/vere/lord.c | 228 ++- pkg/urbit/vere/pier.c | 2802 +++++++++++++-------------------- pkg/urbit/worker/main.c | 1100 ------------- pkg/urbit/worker/serf.c | 2 +- 9 files changed, 1928 insertions(+), 3062 deletions(-) create mode 100644 pkg/urbit/vere/disk.c delete mode 100644 pkg/urbit/worker/main.c diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 02f69acf8..32290dfd0 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -478,7 +478,7 @@ _stop_signal(c3_i int_i) // if we have a pier, unmap the event log before dumping core // if ( 0 != u3K.len_w ) { - u3_pier_db_shutdown(u3_pier_stub()); + u3_disk_exit(u3_pier_stub()->log_u); } } diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index f8e545219..b25e65377 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -615,86 +615,225 @@ struct _u3_writ* nex_u; // next in queue, or 0 } u3_writ; - /* u3_controller: working process controller. + /* u3_ovum: potential event */ - typedef struct _u3_controller { + typedef struct _u3_ovum { + struct _u3_auto* car_u; // backpointer to i/o driver + void* vod_p; // context + c3_l msc_l; // ms to timeout + u3_noun tar; // target + u3_noun pax; // wire + u3_noun fav; // card + struct _u3_ovum* pre_u; // previous ovum + struct _u3_ovum* nex_u; // next ovum + } u3_ovum; + + /* u3_fact: logged event + */ + typedef struct _u3_fact { + c3_d eve_d; // event number + c3_l bug_l; // kernel mug before + c3_l mug_l; // kernel mug after + u3_noun job; // (pair date ovum) (XX or 0?) + struct _u3_fact* nex_u; // next in queue + } u3_fact; + + /* u3_play: batch of logged events + */ + typedef struct _u3_play { + struct _u3_fact* ent_u; // queue entry + struct _u3_fact* ext_u; // queue exit + } u3_play; + + /* u3_work: new event, while processsing + */ + typedef struct _u3_work { + struct _u3_ovum* egg_u; // unlinked ovum + c3_l bug_l; // kernel mug before + u3_noun job; // (pair date ovum) + c3_d eve_d; // event number + c3_l mug_l; // kernel mug after + u3_noun act; // action list + struct _u3_work* nex_u; + } u3_work; + + /* u3_peek: namespace read request + */ + typedef struct _u3_peek { + u3_noun now; // date + u3_noun gan; // (unit (set ship)) + u3_noun pat; // path (serialized beam) + } u3_peek; + + /* u3_rrit: new u3_writ + */ + typedef struct _u3_rrit { + struct timeval tim_tv; // time enqueued + u3_atom mat; // serialized + c3_o sen_o; // sent + struct _u3_rrit* nex_u; // next in queue, or 0 + c3_m typ_m; // tag + union { // + c3_w xit_w; // exit code + c3_d eve_d; // for %save or %snap + struct _u3_peek* pek_u; // read + struct _u3_play pay_u; // recompute + struct _u3_work* wok_u; // compute + }; + } u3_rrit; + + /* u3_lord_cb: u3_lord callbacks + */ + typedef struct _u3_lord_cb { + void* vod_p; + void (*live_f)(void*); + void (*slog_f)(void*, c3_w, u3_noun); + void (*peek_f)(void*, u3_noun gan, u3_noun pat, u3_noun dat); + void (*play_done_f)(void*, u3_play, c3_l mug_l); + void (*play_bail_f)(void*, u3_play, c3_l mug_l, c3_d eve_d, u3_noun dud); + void (*work_done_f)(void*, u3_work*, c3_o wap_o); + void (*work_bail_f)(void*, u3_work*, u3_noun lud); + void (*save_f)(void*, c3_d eve_d); + void (*snap_f)(void*, c3_d eve_d); + void (*exit_f)(void*, c3_o); + } u3_lord_cb; + + /* u3_lord: serf controller. + */ + typedef struct _u3_lord { uv_process_t cub_u; // process handle uv_process_options_t ops_u; // process configuration uv_stdio_container_t cod_u[3]; // process options time_t wen_t; // process creation time u3_mojo inn_u; // client's stdin u3_moat out_u; // client's stdout + c3_w wag_w; // config flags + c3_c* bin_c; // binary path + c3_c* pax_c; // directory + c3_d key_d[4]; // image key + u3_lord_cb cb_u; // callbacks c3_o liv_o; // live - c3_d sen_d; // last event dispatched - c3_d dun_d; // last event completed - c3_d rel_d; // last event released - c3_l mug_l; // mug after last completion - struct _u3_pier* pir_u; // pier backpointer - } u3_controller; + c3_y hon_y; // hoon kelvin + c3_y noc_y; // hoon kelvin + c3_d eve_d; // last event completed + c3_l mug_l; // mug at eve_d + c3_w dep_w; // queue depth + c3_o hol_o; // on hold + struct _u3_rrit* ent_u; // queue entry + struct _u3_rrit* ext_u; // queue exit + } u3_lord; - /* u3_disk: manage events on disk. - ** - ** any event once discovered should be in one of these sets. - ** at present, all sets are ordered and can be defined by a - ** simple counter. any events <= the counter is in the set. + /* u3_disk_cb: u3_disk callbacks + */ + typedef struct _u3_disk_cb { + void* vod_p; + void (*read_done_f)(void*, u3_play); + void (*read_bail_f)(void*, c3_d eve_d); + void (*write_done_f)(void*, c3_d eve_d); + void (*write_bail_f)(void*, c3_d eve_d); + } u3_disk_cb; + + /* u3_disk: manage event persistence. */ typedef struct _u3_disk { u3_dire* dir_u; // main pier directory u3_dire* urb_u; // urbit system data u3_dire* com_u; // log directory c3_o liv_o; // live - c3_d end_d; // byte end of file MDB_env* db_u; // lmdb environment. - c3_d moc_d; // commit requested - c3_d com_d; // committed - struct _u3_pier* pir_u; // pier backpointer + c3_d sen_d; // commit requested + c3_d dun_d; // committed + u3_disk_cb cb_u; // callbacks + uv_timer_t tim_u; // read timer + c3_o hol_o; // on hold + u3_play put_u; // write queue } u3_disk; - /* u3_boot: startup controller. + /* u3_boot: bootstrap event sequence */ typedef struct _u3_boot { - u3_noun pil; // pill - u3_noun ven; // boot event - struct _u3_pier* pir_u; // pier backpointer + u3_noun bot; // boot formulas + u3_noun mod; // module ova + u3_noun use; // userpace ova } u3_boot; - /* u3_psat: pier state. + /* u3_peat: pier state. // XX rename to u3_psat */ typedef enum { - u3_psat_init = 0, // initialized - u3_psat_boot = 1, // booting - u3_psat_pace = 2, // replaying - u3_psat_play = 3, // full operation - u3_psat_done = 4 // shutting down - } u3_psat; + u3_peat_init = 0, // initialized + u3_peat_boot = 1, // bootstrap + u3_peat_play = 2, // replaying + u3_peat_work = 3, // working + u3_peat_done = 4 // shutting down + } u3_peat; + + /* u3_wall: pier barrier + */ + typedef struct _u3_wall { + void* vod_p; + c3_d eve_d; + void (*wal_f)(void*, c3_d); + struct _u3_wall* nex_u; + } u3_wall; + + /* u3_auto: abstract i/o driver + */ + typedef struct _u3_auto { + c3_m nam_m; + c3_o liv_o; + struct { + void (*init_f)(struct _u3_auto*); + void (*talk_f)(struct _u3_auto*); + c3_o (*fete_f)(struct _u3_auto*, u3_noun pax, u3_noun fav); // RETAIN + void (*exit_f)(struct _u3_auto*); // XX close_cb? + } io; + struct { + void (*drop_f)(struct _u3_auto*, void*); + void (*work_f)(struct _u3_auto*, void*); + void (*done_f)(struct _u3_auto*, void*); + void (*swap_f)(struct _u3_auto*, void*); + void (*bail_f)(struct _u3_auto*, void*); + } ev; + struct _u3_ovum* ent_u; + struct _u3_ovum* ext_u; + struct _u3_auto* nex_u; + struct _u3_pier* pir_u; + } u3_auto; /* u3_pier: ship controller. */ typedef struct _u3_pier { c3_c* pax_c; // pier directory - c3_w wag_w; // config flags - c3_d gen_d; // last event discovered - c3_d lif_d; // lifecycle barrier - u3_boot* bot_u; // boot state - c3_d but_d; // boot/restart barrier - c3_d tic_d[1]; // ticket (unstretched) - c3_d sec_d[1]; // generator (unstretched) - c3_d key_d[4]; // secret (stretched) + c3_w lif_w; // lifecycle barrier c3_d who_d[2]; // identity c3_c* who_c; // identity as C string - c3_s por_s; // UDP port c3_o fak_o; // yes iff fake security - u3_psat sat_e; // pier state + c3_o liv_o; // fully live + u3_peat sat_e; // pier state u3_disk* log_u; // event log - u3_controller* god_u; // computer + u3_lord* god_u; // computer + u3_wall* wal_u; // barriers + u3_auto* car_u; // i/o drivers + struct { // replay queue + c3_d sen_d; // last sent + c3_d req_d; // last requested + u3_fact* ent_u; // entry + u3_fact* ext_u; // exit + } pay_u; // + struct { // finished event queue: + c3_d rel_d; // last released + u3_work* ent_u; // entry + u3_work* ext_u; // exit + } wok_u; // + uv_prepare_t pep_u; // preloop registration + uv_check_t cek_u; // postloop registration + uv_idle_t idl_u; // postloop registration + // XX remove + c3_s por_s; // UDP port u3_ames* sam_u; // packet interface u3_behn* teh_u; // behn timer u3_unix* unx_u; // sync and clay u3_save* sav_u; // autosave - u3_writ* ent_u; // entry of queue - u3_writ* ext_u; // exit of queue - uv_prepare_t pep_u; // preloop registration - uv_idle_t idl_u; // postloop registration } u3_pier; /* u3_king: all executing piers. @@ -710,6 +849,94 @@ uv_timer_t tim_u; // gc timer } u3_daemon; + u3_ovum* + u3_auto_next(u3_auto* car_u); + void + u3_auto_fete(u3_auto* car_u, u3_noun act); + + /* u3_auto_init(): initialize all drivers + */ + void + u3_auto_init(u3_auto* car_u); + + /* u3_auto_talk(): start all drivers + */ + void + u3_auto_talk(u3_auto* car_u); + + /* u3_auto_plan(): create and enqueue an ovum + */ + u3_ovum* + u3_auto_plan(u3_auto* car_u, + void* vod_p, + c3_l msc_l, + u3_noun tar, + u3_noun pax, + u3_noun fav); + + /* u3_auto_exit(): close all drivers + */ + void + u3_auto_exit(u3_auto* car_u); + + /* u3_auto_live(): check if all drivers are live. + */ + c3_o + u3_auto_live(u3_auto* car_u); + + u3_lord* + u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u); + + /* u3_lord_work(); + */ + void + u3_lord_play(u3_lord* god_u, u3_play pay_u); + + /* u3_lord_work(); + */ + void + u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo); + + void + u3_lord_save(u3_lord* god_u, c3_d eve_d); + + /* u3_lord_exit(); + */ + void + u3_lord_exit(u3_lord* god_u, c3_w cod_w); + + /* u3_lord_snap(); + */ + void + u3_lord_snap(u3_lord* god_u, c3_d eve_d); + + u3_disk* + u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u); + c3_o + u3_disk_read_header(u3_disk* log_u, c3_d who_d[2], c3_o* fak_o, c3_w* lif_w); + c3_o + u3_disk_write_header(u3_disk* log_u, c3_d who_d[2], c3_o fak_o, c3_w lif_w); + void + u3_disk_boot_plan(u3_disk* log_u, u3_noun job); + void + u3_disk_plan(u3_disk* log_u, + c3_d eve_d, + c3_l bug_l, + c3_l mug_l, + u3_noun job); + void + u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d); + + /* u3_pier_spin(): (re-)activate idle handler + */ + void + u3_pier_spin(u3_pier* pir_u); + + /* u3_disk_exit(): close the log. + */ + void + u3_disk_exit(u3_disk* log_u); + # define u3L u3_Host.lup_u // global event loop # define u3Z (&(u3_Raft)) # define u3K u3_Daemon @@ -1354,12 +1581,12 @@ ** ** Returns c3y on complete success; c3n on any error. */ - c3_o u3_lmdb_read_events(u3_pier* pir_u, - c3_d first_event_d, - c3_d len_d, - c3_o(*on_event_read)(u3_pier* pir_u, - c3_d id, - u3_noun mat)); + c3_o + u3_lmdb_read_events(MDB_env* db_u, + c3_d first_event_d, + c3_d len_d, + void* vod_p, + c3_o(*on_event_read)(void*, c3_d, u3_atom)); /* u3_lmdb_write_identity(): Writes log identity ** diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index e92684493..aea5c897e 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -19,38 +19,6 @@ #include "all.h" #include "vere/vere.h" -typedef struct _u3_ovum { - struct _u3_auto* car_u; // backpointer to i/o driver - void* vod_p; // context - c3_l msc_l; // ms to timeout - u3_noun tag; // target - u3_noun pax; // wire - u3_noun fav; // card - struct _u3_ovum* pre_u; // previous ovum - struct _u3_ovum* nex_u; // next ovum -} u3_ovum; - -typedef struct _u3_auto { - c3_m nam_m; - c3_o liv_o; - struct { - void (*init_f)(struct _u3_auto*); - void (*talk_f)(struct _u3_auto*); - c3_o (*fete_f)(struct _u3_auto*, u3_noun pax, u3_noun fav); // RETAIN - void (*exit_f)(struct _u3_auto*); // XX close_cb? - } io; - struct { - void (*drop_f)(struct _u3_auto*, void*); - void (*work_f)(struct _u3_auto*, void*); - void (*done_f)(struct _u3_auto*, void*); - void (*swap_f)(struct _u3_auto*, void*); - void (*bail_f)(struct _u3_auto*, void*); - } ev; - struct _u3_ovum* ent_u; - struct _u3_ovum* ext_u; - struct _u3_auto* nex_u; -} u3_auto; - /* u3_auto_init(): initialize all drivers */ void @@ -106,7 +74,7 @@ u3_ovum* u3_auto_plan(u3_auto* car_u, void* vod_p, c3_l msc_l, - u3_noun tag, + u3_noun tar, u3_noun pax, u3_noun fav) { @@ -114,7 +82,7 @@ u3_auto_plan(u3_auto* car_u, egg_u->car_u = car_u; egg_u->vod_p = vod_p; egg_u->msc_l = msc_l; - egg_u->tag = tag; + egg_u->tar = tar; egg_u->pax = pax; egg_u->fav = fav; @@ -132,6 +100,8 @@ u3_auto_plan(u3_auto* car_u, car_u->ent_u = egg_u; } + u3_pier_spin(car_u->pir_u); + return egg_u; } @@ -155,7 +125,7 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) egg_u->car_u->ev.drop_f(egg_u->car_u, egg_u->vod_p); } - u3z(egg_u->tag); + u3z(egg_u->tar); u3z(egg_u->pax); u3z(egg_u->fav); c3_free(egg_u); @@ -173,10 +143,15 @@ u3_auto_next(u3_auto* car_u) egg_u = car_u->ext_u; c3_assert( !egg_u->pre_u ); - c3_assert( egg_u->nex_u ); - egg_u->nex_u->pre_u = 0; - car_u->ext_u = egg_u->nex_u; + if ( egg_u->nex_u ) { + egg_u->nex_u->pre_u = 0; + car_u->ext_u = egg_u->nex_u; + } + else { + car_u->ent_u = car_u->ext_u = 0; + } + egg_u->nex_u = 0; // XX better name? @@ -204,7 +179,7 @@ u3_auto_fete(u3_auto* car_u, u3_noun act) fec = u3h(act); u3x_cell(fec, &pax, &fav); - while ( c3n == car_u->io.fete_f(car_u, pax, fav) ) { + while ( c3n == car_u->io.fete_f(car_u, u3k(pax), u3k(fav)) ) { if ( !car_u->nex_u ) { // reck_kick_norm // "kick: lost" diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c new file mode 100644 index 000000000..5bc322c91 --- /dev/null +++ b/pkg/urbit/vere/disk.c @@ -0,0 +1,454 @@ +/* vere/disk.c +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +struct _cd_read { + c3_d eve_d; + c3_d len_d; + struct _u3_fact* ent_u; // queue entry + struct _u3_fact* ext_u; // queue exit + struct _u3_disk* log_u; +}; + +typedef struct _u3_db_batch { + c3_d eve_d; // first event + c3_d len_d; // number of events + void** byt_p; // array of bytes + size_t* siz_i; // array of lengths +} u3_db_batch; + +#undef VERBOSE_DISK + +static void +_disk_commit(u3_disk* log_u); + +/* u3_disk_init(): load or create pier and log. +*/ +u3_disk* +u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) +{ + u3_disk* log_u = c3_calloc(sizeof(*log_u)); + log_u->liv_o = c3n; + log_u->hol_o = c3n; + log_u->cb_u = cb_u; + + uv_timer_init(u3L, &log_u->tim_u); + + // create/load pier directory + // + { + if ( 0 == (log_u->dir_u = u3_foil_folder(pax_c)) ) { + fprintf(stderr, "disk: failed to load pier at %s", pax_c); + c3_free(log_u); + return 0; + } + } + + // create/load $pier/.urb + // + { + c3_c* urb_c = c3_malloc(6 + strlen(pax_c)); + + strcpy(urb_c, pax_c); + strcat(urb_c, "/.urb"); + + if ( 0 == (log_u->urb_u = u3_foil_folder(urb_c)) ) { + fprintf(stderr, "disk: failed to load /.urb in %s", pax_c); + c3_free(urb_c); + c3_free(log_u); + return 0; + } + c3_free(urb_c); + } + + // create/load $pier/.urb/put and $pier/.urb/get + // + { + c3_c* dir_c = c3_malloc(10 + strlen(pax_c)); + + strcpy(dir_c, pax_c); + strcat(dir_c, "/.urb/put"); + mkdir(dir_c, 0700); + + strcpy(dir_c, pax_c); + strcat(dir_c, "/.urb/get"); + mkdir(dir_c, 0700); + + c3_free(dir_c); + } + + // create/load $pier/.urb/log, initialize db + // + { + c3_c* log_c = c3_malloc(10 + strlen(pax_c)); + + strcpy(log_c, pax_c); + strcat(log_c, "/.urb/log"); + + if ( 0 == (log_u->com_u = u3_foil_folder(log_c)) ) { + fprintf(stderr, "disk: failed to load /.urb/log in %s", pax_c); + c3_free(log_c); + c3_free(log_u); + return 0; + } + + if ( 0 == (log_u->db_u = u3_lmdb_init(log_c)) ) { + fprintf(stderr, "disk: failed to initialize database"); + c3_free(log_c); + c3_free(log_u); + return 0; + } + + c3_free(log_c); + } + + // get the latest event number from the db + // + { + log_u->dun_d = 0; + + if ( c3n == u3_lmdb_get_latest_event_number(log_u->db_u, &log_u->dun_d) ) { + fprintf(stderr, "disk: failed to load latest event from database"); + c3_free(log_u); + return 0; + } + + log_u->sen_d = log_u->dun_d; + } + + log_u->liv_o = c3y; + + return log_u; +} + +c3_o +u3_disk_read_header(u3_disk* log_u, c3_d* who_d, c3_o* fak_o, c3_w* lif_w) +{ + u3_noun who, fak, lif; + + if ( c3n == u3_lmdb_read_identity(log_u->db_u, &who, &fak, &lif) ) { + return c3n; + } + + if ( (c3n == u3a_is_cat(lif)) + || !((c3y == fak ) || (c3n == fak )) ) + { + u3z(who); u3z(fak); u3z(lif); + return c3n; + } + + if ( who_d ) { + u3r_chubs(0, 2, who_d, who); + } + + if ( fak_o ) { + *fak_o = fak; + } + + if ( lif_w ) { + *lif_w = lif; + } + + u3z(who); + + return c3y; +} + +c3_o +u3_disk_write_header(u3_disk* log_u, c3_d who_d[2], c3_o fak_o, c3_w lif_w) +{ + c3_assert( c3y == u3a_is_cat(lif_w) ); + u3_noun who = u3i_chubs(2, who_d); + return u3_lmdb_write_identity(log_u->db_u, who, fak_o, lif_w); +} + + +/* _disk_commit_done(): commit complete. + */ +static void +_disk_commit_done(c3_o ret_o, void* vod_p, c3_d eve_d, c3_d len_d) +{ + u3_disk* log_u = vod_p; + + if ( c3n == ret_o ) { + log_u->cb_u.write_bail_f(log_u->cb_u.vod_p, eve_d + (len_d - 1ULL)); + +#ifdef VERBOSE_DISK + if ( 1ULL == len_d ) { + fprintf(stderr, "disk: (%" PRIu64 "): commit: failed\r\n", eve_d); + } + else { + fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: failed\r\n", + eve_d, + eve_d + (len_d - 1ULL)); + } +#endif + } + else { + log_u->dun_d = eve_d + (len_d - 1ULL); + log_u->cb_u.write_done_f(log_u->cb_u.vod_p, log_u->dun_d); + +#ifdef VERBOSE_DISK + if ( 1ULL == len_d ) { + fprintf(stderr, "disk: (%" PRIu64 "): commit: complete\r\n", eve_d); + } + else { + fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: complete\r\n", + eve_d, + eve_d + (len_d - 1ULL)); + } +#endif + } + + { + u3_fact* tac_u = log_u->put_u.ext_u; + + while ( tac_u && (tac_u->eve_d <= log_u->dun_d) ) { + log_u->put_u.ext_u = tac_u->nex_u; + u3z(tac_u->job); + c3_free(tac_u); + tac_u = log_u->put_u.ext_u; + } + } + + if ( !log_u->put_u.ext_u ) { + log_u->put_u.ent_u = 0; + } + + log_u->hol_o = c3n; + _disk_commit(log_u); +} + +static void +_disk_commit(u3_disk* log_u) +{ + if ( (c3n == log_u->hol_o) + && (log_u->sen_d > log_u->dun_d) ) + { + c3_d len_d = log_u->sen_d - log_u->dun_d; + u3_fact* tac_u = log_u->put_u.ext_u; + + c3_assert( (1ULL + log_u->dun_d) == tac_u->eve_d ); + c3_assert( log_u->sen_d == log_u->put_u.ent_u->eve_d ); + + u3_db_batch* bat_u = c3_malloc(sizeof(*bat_u)); + bat_u->eve_d = tac_u->eve_d; + bat_u->len_d = len_d; + bat_u->byt_p = c3_malloc(len_d * sizeof(void*)); + bat_u->siz_i = c3_malloc(len_d * sizeof(size_t)); + + for ( c3_d i_d = 0ULL; i_d < len_d; ++i_d) { + c3_assert( (bat_u->eve_d + i_d) == tac_u->eve_d ); + + u3_atom mat = u3ke_jam(u3nc(tac_u->bug_l, u3k(tac_u->job))); + c3_w len_w = u3r_met(3, mat); + c3_y* dat_y = c3_malloc(len_w); + u3r_bytes(0, len_w, dat_y, mat); + + bat_u->byt_p[i_d] = dat_y; + bat_u->siz_i[i_d] = len_w; + + tac_u = tac_u->nex_u; + u3z(mat); + } + +#ifdef VERBOSE_DISK + if ( 1ULL == len_d ) { + fprintf(stderr, "disk: (%" PRIu64 "): commit: request\r\n", + bat_u->eve_d); + } + else { + fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: request\r\n", + bat_u->eve_d, + (bat_u->eve_d + len_d - 1ULL)); + } +#endif + + u3_lmdb_write_event(log_u->db_u, (u3_pier*)log_u, + (struct u3_lmdb_write_request*)bat_u, + (void(*)(c3_o, u3_pier*, c3_d, c3_d))_disk_commit_done); + + log_u->hol_o = c3y; + } +} + +/* u3_disk_plan(): +*/ +void +u3_disk_plan(u3_disk* log_u, + c3_d eve_d, + c3_l bug_l, + c3_l mug_l, + u3_noun job) +{ + u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); + tac_u->bug_l = bug_l; + tac_u->mug_l = mug_l; + tac_u->eve_d = eve_d; + tac_u->nex_u = 0; + tac_u->job = job; + + c3_assert( (1ULL + log_u->sen_d) == eve_d ); + log_u->sen_d++; + + if ( !log_u->put_u.ent_u ) { + c3_assert( !log_u->put_u.ext_u ); + log_u->put_u.ent_u = log_u->put_u.ext_u = tac_u; + } + else { + log_u->put_u.ent_u->nex_u = tac_u; + log_u->put_u.ent_u = tac_u; + } + + _disk_commit(log_u); +} + +/* u3_disk_boot_plan(): +*/ +void +u3_disk_boot_plan(u3_disk* log_u, u3_noun job) +{ + u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); + tac_u->mug_l = 0; //u3r_mug(job); XX + tac_u->eve_d = ++log_u->sen_d; + tac_u->nex_u = 0; + tac_u->job = job; + + if ( !log_u->put_u.ent_u ) { + c3_assert( !log_u->put_u.ext_u ); + c3_assert( 1ULL == log_u->sen_d ); + + tac_u->bug_l = 0; // XX + log_u->put_u.ent_u = log_u->put_u.ext_u = tac_u; + } + else { + tac_u->bug_l = log_u->put_u.ent_u->mug_l; // XX + log_u->put_u.ent_u->nex_u = tac_u; + log_u->put_u.ent_u = tac_u; + } + +#ifdef VERBOSE_DISK + fprintf(stderr, "disk: (%" PRIu64 "): db boot plan\r\n", tac_u->eve_d); +#endif + + _disk_commit(log_u); +} + +static void +_disk_read_done_cb(uv_timer_t* tim_u) +{ + struct _cd_read* red_u = tim_u->data; + u3_disk* log_u = red_u->log_u; + u3_play pay_u = { + .ent_u = red_u->ent_u, + .ext_u = red_u->ext_u + }; + + c3_assert( red_u->ent_u ); + c3_assert( red_u->ext_u ); + + log_u->cb_u.read_done_f(log_u->cb_u.vod_p, pay_u); + c3_free(red_u); +} + +static c3_o +_disk_read_one_cb(void* vod_p, c3_d eve_d, u3_atom mat) +{ + struct _cd_read* red_u = vod_p; + u3_disk* log_u = red_u->log_u; + u3_fact* tac_u = c3_calloc(sizeof(*tac_u)); + tac_u->eve_d = eve_d; + + { + // xx soft? + // + u3_noun dat = u3ke_cue(mat); + u3_noun mug, job; + + if ( (c3n == u3r_cell(dat, &mug, &job)) + || (c3n == u3r_safe_word(mug, &tac_u->bug_l)) ) // XX + { + c3_free(tac_u); + // XX dispose get_u; + log_u->cb_u.read_bail_f(log_u->cb_u.vod_p, eve_d); + return c3n; + } + + tac_u->job = u3k(job); + u3z(dat); + } + + if ( !red_u->ent_u ) { + c3_assert( !red_u->ext_u ); + + c3_assert( red_u->eve_d == eve_d ); + // tac_u->mug_l = 0; // XX + red_u->ent_u = red_u->ext_u = tac_u; + } + else { + c3_assert( (1ULL + red_u->ent_u->eve_d) == eve_d ); + // log_u->get_u.ent_u->mug_l = tac_u->bug_l; // XX + red_u->ent_u->nex_u = tac_u; + red_u->ent_u = tac_u; + } + + return c3y; +} + +static void +_disk_read_start_cb(uv_timer_t* tim_u) +{ + struct _cd_read* red_u = tim_u->data; + u3_disk* log_u = red_u->log_u; + + uv_timer_start(&log_u->tim_u, _disk_read_done_cb, 0, 0); + + if ( c3n == u3_lmdb_read_events(log_u->db_u, + red_u->eve_d, + red_u->len_d, + red_u, + _disk_read_one_cb) ) + { + log_u->cb_u.read_bail_f(log_u->cb_u.vod_p, red_u->eve_d); + } +} + +void +u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d) +{ + struct _cd_read* red_u = c3_malloc(sizeof(*red_u)); + red_u->log_u = log_u; + red_u->eve_d = eve_d; + red_u->len_d = len_d; + red_u->ent_u = red_u->ext_u = 0; + + log_u->tim_u.data = red_u; + uv_timer_start(&log_u->tim_u, _disk_read_start_cb, 0, 0); +} + +/* u3_disk_exit(): close the log. +*/ +void +u3_disk_exit(u3_disk* log_u) +{ + u3_lmdb_shutdown(log_u->db_u); + // XX dispose + // +} diff --git a/pkg/urbit/vere/lmdb.c b/pkg/urbit/vere/lmdb.c index 41027bc0e..d3835d364 100644 --- a/pkg/urbit/vere/lmdb.c +++ b/pkg/urbit/vere/lmdb.c @@ -390,15 +390,16 @@ void u3_lmdb_write_event(MDB_env* environment, ** ** Returns c3y on complete success; c3n on any error. */ -c3_o u3_lmdb_read_events(u3_pier* pir_u, - c3_d first_event_d, - c3_d len_d, - c3_o(*on_event_read)(u3_pier* pir_u, c3_d id, - u3_noun mat)) +c3_o +u3_lmdb_read_events(MDB_env* db_u, + c3_d first_event_d, + c3_d len_d, + void* vod_p, + c3_o(*on_event_read)(void*, c3_d, u3_atom)) { // Creates the read transaction. MDB_txn* transaction_u; - c3_w ret_w = mdb_txn_begin(pir_u->log_u->db_u, + c3_w ret_w = mdb_txn_begin(db_u, //environment, (MDB_txn *) NULL, MDB_RDONLY, /* flags */ @@ -460,16 +461,13 @@ c3_o u3_lmdb_read_events(u3_pier* pir_u, } // Now build the atom version and then the cued version from the raw data - u3_noun mat = u3i_bytes(val.mv_size, val.mv_data); - - if (on_event_read(pir_u, current_id, mat) == c3n) { - u3z(mat); - u3l_log("lmdb: aborting replay due to error.\r\n"); + if ( c3n == on_event_read(vod_p, current_id, u3i_bytes(val.mv_size, val.mv_data)) ) { + // XX remove + // + u3l_log("lmdb: read: aborting replay due to error.\r\n"); return c3n; } - u3z(mat); - ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_NEXT); if (ret_w != 0 && ret_w != MDB_NOTFOUND) { u3l_log("lmdb: error while loading events: %s\r\n", diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 7ca29e6c0..26820954e 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -20,6 +20,7 @@ #include "vere/vere.h" /* +|% :: +writ: from king to serf :: +$ writ @@ -52,81 +53,7 @@ -- */ -typedef struct _u3_fact { - c3_d eve_d; // event number - c3_l bug_l; // kernel mug before - c3_l mug_l; // kernel mug after - u3_noun job; // (pair date ovum) (XX or 0?) - struct _u3_fact* nex_u; // next in queue -} u3_fact; - -typedef struct _u3_peek { - u3_noun now; // date - u3_noun gan; // (unit (set ship)) - u3_noun pat; // path (serialized beam) -} u3_peek; - -typedef struct _u3_play { - struct _u3_fact* ent_u; // queue entry - struct _u3_fact* ext_u; // queue exit -} u3_play; - -typedef struct _u3_work { - struct _u3_ovum* egg_u; // unlinked ovum - c3_l bug_l; // kernel mug before - u3_noun job; // (pair date ovum) - c3_d eve_d; // event number - c3_l mug_l; // kernel mug after - u3_noun act; // action list -} u3_work; - -typedef struct _u3_rrit { - struct timeval tim_tv; // time enqueued - u3_atom mat; // serialized - c3_o sen_o; // sent - struct _u3_rrit* nex_u; // next in queue, or 0 - c3_m typ_m; // tag - union { // - c3_w xit_w; // exit code - c3_d eve_d; // for %save or %snap - struct _u3_peek* pek_u; // read - struct _u3_play* pay_u; // recompute - struct _u3_work* wok_u; // compute - }; -} u3_rrit; - -typedef struct _u3_lord_cb { - void* vod_p; - void (*live_f)(void*); - void (*slog_f)(void*, c3_w, u3_noun); - void (*peek_f)(void*, u3_noun gan, u3_noun pat, u3_noun dat); - void (*play_done_f)(void*, u3_play*, c3_l mug_l); - void (*play_bail_f)(void*, u3_play*, c3_l mug_l, u3_play*, u3_noun dud); - void (*work_done_f)(void*, u3_work*); - void (*work_swap_f)(void*, u3_work*); - void (*work_bail_f)(void*, u3_work*, u3_noun lud); - void (*snap_f)(void*, c3_d eve_d); - void (*save_f)(void*, c3_d eve_d); - void (*exit_f)(void*, c3_o); -} u3_lord_cb; - -typedef struct _u3_lord { - uv_process_t cub_u; // process handle - uv_process_options_t ops_u; // process configuration - uv_stdio_container_t cod_u[3]; // process options - time_t wen_t; // process creation time - u3_mojo inn_u; // client's stdin - u3_moat out_u; // client's stdout - u3_lord_cb cb_u; // callbacks - c3_o liv_o; // live - c3_y hon_y; // hoon kelvin - c3_y noc_y; // hoon kelvin - c3_o hol_o; // on hold - c3_d eve_d; // last event completed - c3_l mug_l; // mug at eve_d - struct _u3_rrit* ent_u; // queue entry - struct _u3_rrit* ext_u; // queue exit -} u3_lord; +#undef VERBOSE_LORD static void _lord_writ_spin(u3_lord* god_u); @@ -148,6 +75,8 @@ _lord_writ_pop(u3_lord* god_u) wit_u->nex_u = 0; } + god_u->dep_w--; + return wit_u; } @@ -169,7 +98,7 @@ _lord_writ_need(u3_lord* god_u, c3_m ned_m) return wit_u; } -/* _lord_on_exit(): handle subprocess exit. +/* _lord_on_k(): handle subprocess exit. */ static void _lord_on_exit(uv_process_t* req_u, @@ -203,7 +132,8 @@ static void _lord_bail(void* vod_p, const c3_c* err_c) { - // XX + // XX ignore if shutting down + // fprintf(stderr, "\rpier: work error: %s\r\n", err_c); } @@ -240,6 +170,7 @@ _lord_plea_live(u3_lord* god_u, u3_noun dat) u3_pier_bail(); exit(1); } + c3_assert(!"unreachable"); case c3__save: { god_u->cb_u.save_f(god_u->cb_u.vod_p, wit_u->eve_d); @@ -247,6 +178,7 @@ _lord_plea_live(u3_lord* god_u, u3_noun dat) _lord_writ_spin(god_u); break; } + c3_assert(!"unreachable"); case c3__snap: { god_u->cb_u.snap_f(god_u->cb_u.vod_p, wit_u->eve_d); @@ -254,6 +186,7 @@ _lord_plea_live(u3_lord* god_u, u3_noun dat) _lord_writ_spin(god_u); break; } + c3_assert(!"unreachable"); } c3_free(wit_u); @@ -293,7 +226,7 @@ _lord_plea_ripe(u3_lord* god_u, u3_noun dat) exit(1); } -#ifdef VERBOSE_EVENTS +#ifdef VERBOSE_LORD fprintf(stderr, "pier: (%" PRIu64 "): ripe at mug %x\r\n", eve_d, mug_l); #endif @@ -350,7 +283,7 @@ _lord_plea_peek(u3_lord* god_u, u3_noun dat) static void _lord_plea_play(u3_lord* god_u, u3_noun dat) { - u3_play* pay_u; + u3_play pay_u; { u3_rrit* wit_u = _lord_writ_need(god_u, c3__play); pay_u = wit_u->pay_u; @@ -365,6 +298,7 @@ _lord_plea_play(u3_lord* god_u, u3_noun dat) default: { return _lord_plea_foul(god_u, c3__play, dat); } + c3_assert(!"unreachable"); case c3__bail: { u3_noun eve, mug, dud; @@ -379,23 +313,14 @@ _lord_plea_play(u3_lord* god_u, u3_noun dat) return _lord_plea_foul(god_u, c3__play, dat); } - { - u3_play* yap_u = c3_malloc(sizeof(*yap_u)); - u3_fact* fac_u = pay_u->ext_u; + god_u->eve_d = (eve_d - 1ULL); + god_u->mug_l = mug_l; - while ( fac_u->eve_d < eve_d ) { - fac_u = fac_u->nex_u; - } - - yap_u->ext_u = fac_u->nex_u; - yap_u->ent_u = pay_u->ent_u; - pay_u->ent_u = fac_u; - - god_u->cb_u.play_bail_f(god_u->cb_u.vod_p, - pay_u, mug_l, yap_u, u3k(dud)); - } + god_u->cb_u.play_bail_f(god_u->cb_u.vod_p, + pay_u, mug_l, eve_d, u3k(dud)); break; } + c3_assert(!"unreachable"); case c3__done: { c3_l mug_l; @@ -404,9 +329,13 @@ _lord_plea_play(u3_lord* god_u, u3_noun dat) return _lord_plea_foul(god_u, c3__play, dat); } + god_u->eve_d = pay_u.ent_u->eve_d; + god_u->mug_l = mug_l; + god_u->cb_u.play_done_f(god_u->cb_u.vod_p, pay_u, mug_l); break; } + c3_assert(!"unreachable"); } u3z(dat); @@ -432,6 +361,7 @@ _lord_plea_work(u3_lord* god_u, u3_noun dat) default: { return _lord_plea_foul(god_u, c3__work, dat); } + c3_assert(!"unreachable"); case c3__bail: { u3_noun lud = u3t(dat); @@ -446,6 +376,7 @@ _lord_plea_work(u3_lord* god_u, u3_noun dat) god_u->cb_u.work_bail_f(god_u->cb_u.vod_p, wok_u, u3k(lud)); break; } + c3_assert(!"unreachable"); case c3__swap: { u3_noun eve, mug, job, fec; @@ -460,19 +391,20 @@ _lord_plea_work(u3_lord* god_u, u3_noun dat) return _lord_plea_foul(god_u, c3__work, dat); } - wok_u->eve_d = god_u->mug_l = eve_d; + wok_u->eve_d = god_u->eve_d = eve_d; wok_u->mug_l = god_u->mug_l = mug_l; u3z(wok_u->job); - wok_u->job = job; - wok_u->act = fec; + wok_u->job = u3k(job); + wok_u->act = u3k(fec); if ( god_u->ext_u && ( c3__work == god_u->ext_u->typ_m ) ) { god_u->ext_u->wok_u->bug_l = mug_l; } - god_u->cb_u.work_swap_f(god_u->cb_u.vod_p, wok_u); + god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u, c3y); break; } + c3_assert(!"unreachable"); case c3__done: { u3_noun eve, mug, fec; @@ -486,23 +418,24 @@ _lord_plea_work(u3_lord* god_u, u3_noun dat) return _lord_plea_foul(god_u, c3__work, dat); } - wok_u->eve_d = god_u->mug_l = eve_d; + wok_u->eve_d = god_u->eve_d = eve_d; wok_u->mug_l = god_u->mug_l = mug_l; - wok_u->act = fec; + wok_u->act = u3k(fec); if ( god_u->ext_u && ( c3__work == god_u->ext_u->typ_m ) ) { god_u->ext_u->wok_u->bug_l = mug_l; } - god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u); + god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u, c3n); break; } + c3_assert(!"unreachable"); } u3z(dat); } -/* _lord_poke(): handle subprocess result. transfer nouns. +/* _lord_poke(): handle subprocess result. */ static void _lord_poke(void* vod_p, @@ -523,31 +456,37 @@ _lord_poke(void* vod_p, _lord_plea_live(god_u, u3k(dat)); break; } + c3_assert(!"unreachable"); case c3__ripe: { _lord_plea_ripe(god_u, u3k(dat)); break; } + c3_assert(!"unreachable"); case c3__slog: { _lord_plea_slog(god_u, u3k(dat)); break; } + c3_assert(!"unreachable"); case c3__peek: { _lord_plea_peek(god_u, u3k(dat)); break; } + c3_assert(!"unreachable"); case c3__play: { _lord_plea_play(god_u, u3k(dat)); break; } + c3_assert(!"unreachable"); case c3__work: { _lord_plea_work(god_u, u3k(dat)); break; } + c3_assert(!"unreachable"); } u3z(jar); @@ -566,31 +505,36 @@ u3_lord* u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) { u3_lord* god_u = c3_calloc(sizeof *god_u); - // XX wag_w, key_d? - // god_u->hol_o = c3n; god_u->liv_o = c3n; + god_u->wag_w = wag_w; + god_u->bin_c = u3_Host.wrk_c; // XX strcopy + god_u->pax_c = pax_c; // XX strcopy + god_u->cb_u = cb_u; + + god_u->key_d[0] = key_d[0]; + god_u->key_d[1] = key_d[1]; + god_u->key_d[2] = key_d[2]; + god_u->key_d[3] = key_d[3]; // spawn new process and connect to it // { c3_c* arg_c[5]; - c3_c* bin_c = u3_Host.wrk_c; - c3_c* pax_c = pax_c; c3_c key_c[256]; c3_c wag_c[11]; c3_i err_i; sprintf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", - key_d[0], - key_d[1], - key_d[2], - key_d[3]); + god_u->key_d[0], + god_u->key_d[1], + god_u->key_d[2], + god_u->key_d[3]); - sprintf(wag_c, "%u", wag_w); + sprintf(wag_c, "%u", god_u->wag_w); - arg_c[0] = bin_c; // executable - arg_c[1] = pax_c; // path to checkpoint directory + arg_c[0] = god_u->bin_c; // executable + arg_c[1] = god_u->pax_c; // path to checkpoint directory arg_c[2] = key_c; // disk key arg_c[3] = wag_c; // runtime config arg_c[4] = 0; @@ -621,8 +565,8 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) } } - /* start reading from proc - */ + // start reading from proc + // { god_u->out_u.vod_p = god_u; god_u->out_u.pok_f = _lord_poke; @@ -642,7 +586,7 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) static u3_rrit* _lord_writ_new(u3_lord* god_u) { - u3_rrit* wit_u = c3_malloc(sizeof(*wit_u)); + u3_rrit* wit_u = c3_calloc(sizeof(*wit_u)); wit_u->sen_o = c3n; wit_u->mat = 0; wit_u->nex_u = 0; @@ -663,28 +607,49 @@ _lord_writ_jam(u3_lord* god_u, u3_rrit* wit_u) default: c3_assert(0); case c3__exit: { + // XX u3_newt_close on send + // msg = u3nt(c3__live, c3__exit, u3i_words(1, &wit_u->xit_w)); break; } + c3_assert(!"unreachable"); case c3__save: { - wit_u->eve_d = god_u->eve_d; + if ( !wit_u->eve_d ) { + wit_u->eve_d = god_u->eve_d; + } + +#ifdef VERBOSE_LORD + fprintf(stderr, "lord: (%" PRIu64 "): send save\r\n", wit_u->eve_d); +#endif + msg = u3nt(c3__live, c3__save, u3i_chubs(1, &wit_u->eve_d)); break; } + c3_assert(!"unreachable"); case c3__snap: { - wit_u->eve_d = god_u->eve_d; + if ( !wit_u->eve_d ) { + wit_u->eve_d = god_u->eve_d; + } + +#ifdef VERBOSE_LORD + fprintf(stderr, "lord: (%" PRIu64 "): send save\r\n", wit_u->eve_d); +#endif + msg = u3nt(c3__live, c3__snap, u3i_chubs(1, &wit_u->eve_d)); break; } + c3_assert(!"unreachable"); case c3__peek: { c3_assert(0); } + c3_assert(!"unreachable"); case c3__play: { - u3_fact* tac_u = wit_u->pay_u->ext_u; + u3_fact* tac_u = wit_u->pay_u.ext_u; + c3_d eve_d = tac_u->eve_d; u3_noun lit = u3_nul; while ( tac_u ) { @@ -692,12 +657,16 @@ _lord_writ_jam(u3_lord* god_u, u3_rrit* wit_u) tac_u = tac_u->nex_u; } - msg = u3nt(c3__play, u3i_chubs(1, &wit_u->pay_u->ext_u->eve_d), lit); + msg = u3nt(c3__play, u3i_chubs(1, &eve_d), u3kb_flop(lit)); + break; } + c3_assert(!"unreachable"); case c3__work: { - msg = u3nc(c3__work, wit_u->wok_u->job); + msg = u3nc(c3__work, u3k(wit_u->wok_u->job)); + break; } + c3_assert(!"unreachable"); } wit_u->mat = u3ke_jam(msg); @@ -736,9 +705,12 @@ _lord_writ_plan(u3_lord* god_u, u3_rrit* wit_u) { if ( !god_u->ent_u ) { c3_assert( !god_u->ext_u ); + c3_assert( !god_u->dep_w ); + god_u->dep_w = 1; god_u->ent_u = god_u->ext_u = wit_u; } else { + god_u->dep_w++; god_u->ent_u->nex_u = wit_u; god_u->ent_u = wit_u; } @@ -763,25 +735,27 @@ u3_lord_exit(u3_lord* god_u, c3_w cod_w) /* u3_lord_save(); */ void -u3_lord_save(u3_lord* god_u) +u3_lord_save(u3_lord* god_u, c3_d eve_d) { u3_rrit* wit_u = _lord_writ_new(god_u); wit_u->typ_m = c3__save; + wit_u->eve_d = eve_d; - god_u->hol_o = c3y; _lord_writ_plan(god_u, wit_u); + god_u->hol_o = c3y; } /* u3_lord_snap(); */ void -u3_lord_snap(u3_lord* god_u) +u3_lord_snap(u3_lord* god_u, c3_d eve_d) { u3_rrit* wit_u = _lord_writ_new(god_u); wit_u->typ_m = c3__snap; + wit_u->eve_d = eve_d; - god_u->hol_o = c3y; _lord_writ_plan(god_u, wit_u); + god_u->hol_o = c3y; } /* u3_lord_peek(); @@ -802,12 +776,14 @@ u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun pat) /* u3_lord_play(); */ void -u3_lord_play(u3_lord* god_u, u3_play* pay_u) +u3_lord_play(u3_lord* god_u, u3_play pay_u) { u3_rrit* wit_u = _lord_writ_new(god_u); wit_u->typ_m = c3__play; wit_u->pay_u = pay_u; + c3_assert( !pay_u.ent_u->nex_u ); + _lord_writ_plan(god_u, wit_u); } @@ -818,7 +794,7 @@ u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo) { u3_rrit* wit_u = _lord_writ_new(god_u); wit_u->typ_m = c3__work; - wit_u->wok_u = c3_malloc(sizeof(*wit_u->wok_u)); + wit_u->wok_u = c3_calloc(sizeof(*wit_u->wok_u)); wit_u->wok_u->egg_u = egg_u; { diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index fff3f1558..90f90dc0c 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -16,1138 +16,1192 @@ #include #include #include -#include -#include -#include #include "all.h" #include "vere/vere.h" -#undef VERBOSE_EVENTS +#define PIER_READ_BATCH 100ULL +#define PIER_PLAY_BATCH 10ULL +#define PIER_WORK_BATCH 10ULL - /* event handling proceeds on a single path. across both the - ** child worker process (worker) and parent i/o process (daemon). - ** state transitions are as follows: - ** - ** generated (event numbered and queued) - ** dispatched (sent to worker) - ** computed (completed by worker) - ** commit requested (sent to storage subsystem) - ** commit complete (daemon notified) - ** released (output actions allowed) - ** - ** we dispatch one event at a time to the worker. we don't do - ** anything in parallel. - ** - ** the sanity constraints that constrain this path: - ** - ** - an event can't request a commit until it's computed. - ** - an event can't be released until it, and all events - ** preceding it, are computed and committed. - ** - ** event numbers are uint64 (c3_d) which start with 1. we order - ** events as we receive them. - ** - ** events are executed in order by the working process, and - ** (at present) committed in strict order. - ** - ** the result of computing an event can be completion (in which - ** case we go directly to commit) or replacement (in which we - ** replace the input event with a different event). - ** - ** after crash recovery, events committed but not in the snapshot - ** (the state of the worker) are replayed (re-computed), but their - ** output effects are ignored. it is possible that effects of - ** (only the last of ?) these events are not completely released to - ** the outside world -- but they should never be released more than once. - ** - ** XX analyze replay more comprehensively - */ +#undef VERBOSE_PIER -static void _pier_apply(u3_pier* pir_u); -static void _pier_boot_complete(u3_pier* pir_u); -static void _pier_boot_ready(u3_pier* pir_u); -static void _pier_boot_set_ship(u3_pier* pir_u, u3_noun who, u3_noun fak); -static void _pier_exit_done(u3_pier* pir_u); -static void _pier_inject(u3_pier* pir_u, c3_c* pax_c); -static void _pier_loop_resume(u3_pier* pir_u); +// XX snapshot timer -/* _pier_db_bail(): bail from disk i/o. +/* _pier_work_init(): begin processing new events */ static void -_pier_db_bail(void* vod_p, const c3_c* err_c) +_pier_work_init(u3_pier* pir_u) { - u3l_log("disk error: %s\r\n", err_c); + pir_u->sat_e = u3_peat_work; + u3_auto_talk(pir_u->car_u); } -/* u3_pier_db_shutdown(): close the log. +#define SUB_FLOOR(a, b) ( (a <= b) ? 0 : a - b ) + +/* _pier_work_send(): send new events for processing */ -void -u3_pier_db_shutdown(u3_pier* pir_u) +static void +_pier_work_send(u3_pier* pir_u) { - u3_lmdb_shutdown(pir_u->log_u->db_u); + u3_lord* god_u = pir_u->god_u; + u3_auto* car_u = pir_u->car_u; + u3_wall* wal_u = pir_u->wal_u; + c3_w len_w = ( wal_u ) + ? SUB_FLOOR(wal_u->eve_d, god_u->eve_d) + : SUB_FLOOR(PIER_WORK_BATCH, god_u->dep_w); + c3_w i_w = 0; + u3_ovum* egg_u; + + while ( (i_w < len_w) + && car_u + && (egg_u = u3_auto_next(car_u)) ) + { + // XX cons [tar] route onto wire + // + u3_noun ovo = u3nc(u3k(egg_u->pax), u3k(egg_u->fav)); + u3_lord_work(pir_u->god_u, egg_u, ovo); + + // queue events depth first + // + car_u = egg_u->car_u; + i_w++; + } } -/* _pier_db_commit_complete(): commit complete. - */ +/* _pier_work_plan(): enqueue computed events, send to disk. +*/ static void -_pier_db_commit_complete(c3_o success, - u3_pier* pir_u, - c3_d first_event_d, - c3_d event_count_d) +_pier_work_plan(u3_pier* pir_u, u3_work* wok_u) +{ + c3_assert( wok_u->eve_d > pir_u->wok_u.rel_d ); + c3_assert( wok_u->eve_d > pir_u->log_u->sen_d ); + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): compute: complete\r\n", wok_u->eve_d); +#endif + + wok_u->nex_u = 0; + + if ( !pir_u->wok_u.ent_u ) { + c3_assert( !pir_u->wok_u.ext_u ); + pir_u->wok_u.ent_u = pir_u->wok_u.ext_u = wok_u; + } + else { + pir_u->wok_u.ent_u->nex_u = wok_u; + pir_u->wok_u.ent_u = wok_u; + } + + // XX this is a departure from the general organization of this file + // + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): disk: plan\r\n", wok_u->eve_d); +#endif + u3_disk_plan(pir_u->log_u, + wok_u->eve_d, + wok_u->bug_l, + wok_u->mug_l, + u3k(wok_u->job)); +} + +/* _pier_work_next(): dequeue finished events for effect application +*/ +static u3_work* +_pier_work_next(u3_pier* pir_u) { u3_disk* log_u = pir_u->log_u; + u3_work* wok_u = pir_u->wok_u.ext_u; - if (success == c3n) { - u3l_log("Failed to persist event. Exiting to prevent corruption."); - u3_pier_bail(); + if ( !wok_u || (wok_u->eve_d > log_u->dun_d) ) { + return 0; } + else { + pir_u->wok_u.ext_u = wok_u->nex_u; -#ifdef VERBOSE_EVENTS - if (event_count_d != 1) { - u3l_log("pier: (%" PRIu64 "-%" PRIu64 "): db commit: complete\r\n", - first_event_d, first_event_d + event_count_d - 1ULL); - } else { - u3l_log("pier: (%" PRIu64 "): db commit: complete\r\n", first_event_d); + if ( !pir_u->wok_u.ext_u ) { + pir_u->wok_u.ent_u = 0; + } + + c3_assert( (1ULL + pir_u->wok_u.rel_d) == wok_u->eve_d ); + pir_u->wok_u.rel_d = wok_u->eve_d; + + return wok_u; } -#endif - - /* advance commit counter - */ - { - c3_assert((first_event_d + event_count_d - 1ULL) == log_u->moc_d); - c3_assert(first_event_d == (1ULL + log_u->com_d)); - log_u->com_d += event_count_d; - } - - _pier_loop_resume(pir_u); } -/* _pier_db_commit_request(): start commit. +/* _pier_work_fete(): apply effects. */ static void -_pier_db_commit_request(u3_pier* pir_u, - struct u3_lmdb_write_request* request_u, - c3_d first_event_d, - c3_d count_d) +_pier_work_fete(u3_pier* pir_u) { + u3_work* wok_u; + + while ( (wok_u = _pier_work_next(pir_u)) ) { +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", wok_u->eve_d); +#endif + u3_auto_fete(pir_u->car_u, wok_u->act); + // XX dispose wok_u->egg_u + // + c3_free(wok_u); + } +} + +/* _pier_work(): advance event processing. +*/ +static void +_pier_work(u3_pier* pir_u) +{ + + if ( c3n == pir_u->liv_o ) { + pir_u->liv_o = u3_auto_live(pir_u->car_u); + + if ( c3y == pir_u->liv_o ) { + // XX print + // XX bot_f ? + } + } + + _pier_work_send(pir_u); + _pier_work_fete(pir_u); +} + +/* _pier_play_plan(): enqueue events for replay. +*/ +static void +_pier_play_plan(u3_pier* pir_u, u3_play pay_u) +{ + u3_fact** ent_u = &pay_u.ent_u; + u3_fact** ext_u; + c3_d old_d; + + if ( !pir_u->pay_u.ent_u ) { + c3_assert( !pir_u->pay_u.ent_u ); + ext_u = &pir_u->pay_u.ext_u; + old_d = pir_u->pay_u.sen_d; + } + else { + ext_u = &pir_u->pay_u.ent_u->nex_u; + old_d = pir_u->pay_u.ent_u->eve_d; + } + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: play plan %" PRIu64 "-%" PRIu64 " at %" PRIu64 "\r\n", + pay_u.ext_u->eve_d, + pay_u.ent_u->eve_d, + old_d); +#endif + + c3_assert( (1ULL + old_d) == pay_u.ext_u->eve_d ); + + *ent_u = pay_u.ent_u; + *ext_u = pay_u.ext_u; +} + +static u3_play +_pier_play_next(u3_pier* pir_u) +{ + u3_fact* tac_u = pir_u->pay_u.ext_u; + // the first batch must be >= the lifecycle barrier + // + c3_w len_d = ( !pir_u->pay_u.sen_d ) + ? c3_max(pir_u->lif_w, PIER_PLAY_BATCH) + : PIER_PLAY_BATCH; + u3_play pay_u; + + // set batch entry and exit pointers + // + { + pay_u.ext_u = tac_u; + c3_assert( tac_u ); + + while ( len_d-- ) { + if ( !tac_u->nex_u ) { + break; + } + tac_u = tac_u->nex_u; + } + + pay_u.ent_u = tac_u; + c3_assert( tac_u ); + } + + // detatch batch from queue + // + if ( tac_u->nex_u ) { + pir_u->pay_u.ext_u = tac_u->nex_u; + tac_u->nex_u = 0; + } + else { + pir_u->pay_u.ent_u = pir_u->pay_u.ext_u = 0; + } + + return pay_u; +} + +/* _pier_play_send(): send a batch of events to the worker for replay. +*/ +static void +_pier_play_send(u3_pier* pir_u) +{ + // XX fill the pipe how much? + // (god_u->dep_w > PIER_WORK_BATCH) ) + // + if ( pir_u->pay_u.ext_u ) { + u3_play pay_u = _pier_play_next(pir_u); + + // bump sent counter + // + pir_u->pay_u.sen_d = pay_u.ent_u->eve_d; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: play send %" PRIu64 "-%" PRIu64 "\r\n", pay_u.ext_u->eve_d, pay_u.ent_u->eve_d); +#endif + + u3_lord_play(pir_u->god_u, pay_u); + } +} + +/* _pier_play_read(): read events from disk for replay. +*/ +static void +_pier_play_read(u3_pier* pir_u) +{ + c3_d las_d, len_d; + + if ( pir_u->pay_u.ent_u ) { + las_d = pir_u->pay_u.ent_u->eve_d; + + if ( (las_d - pir_u->pay_u.ext_u->eve_d) >= PIER_PLAY_BATCH ) { + return; + } + } + else { + las_d = pir_u->pay_u.sen_d; + } + + if ( (1ULL + las_d) == pir_u->pay_u.req_d ) { + return; + } + + pir_u->pay_u.req_d = (1ULL + las_d); + + len_d = c3_min(pir_u->log_u->dun_d - las_d, PIER_READ_BATCH); + + if ( len_d ) { + u3_disk_read(pir_u->log_u, (1ULL + las_d), len_d); + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: play read %" PRIu64 " at %" PRIu64 "\r\n", len_d, (1ULL + las_d)); +#endif + } +} + +/* _pier_play(): send a batch of events to the worker for log replay. +*/ +static void +_pier_play(u3_pier* pir_u) +{ + u3_lord* god_u = pir_u->god_u; u3_disk* log_u = pir_u->log_u; -#ifdef VERBOSE_EVENTS - if (count_d != 1) { - u3l_log("pier: (%" PRIu64 "-%" PRIu64 "): db commit: request\r\n", - first_event_d, first_event_d + count_d - 1ULL); - } else { - u3l_log("pier: (%" PRIu64 "): db commit: request\r\n", first_event_d); + if ( log_u->sen_d > log_u->dun_d ) { + // wait if we're still committing the boot sequence + // + c3_assert( u3_peat_boot == pir_u->sat_e ); + // XX + // + u3l_log("pier: play boot\r\n"); } -#endif - - /* put it in the database - */ - { - u3_lmdb_write_event(log_u->db_u, - pir_u, - request_u, - _pier_db_commit_complete); - } - - /* advance commit-request counter - */ - { - c3_assert(first_event_d == (1ULL + log_u->moc_d)); - log_u->moc_d += count_d; - } -} - - -static void -_pier_db_write_header(u3_pier* pir_u, - u3_noun who, - u3_noun is_fake, - u3_noun life) -{ - c3_o ret = u3_lmdb_write_identity(pir_u->log_u->db_u, - who, is_fake, life); - if (ret == c3n) { - u3_pier_bail(); - } -} - -/* _pier_db_read_header(): reads the ships metadata from lmdb - */ -static void -_pier_db_read_header(u3_pier* pir_u) -{ - u3_noun who, is_fake, life; - c3_o ret = u3_lmdb_read_identity(pir_u->log_u->db_u, - &who, &is_fake, &life); - if (ret == c3n) { - u3l_log("Failed to load identity. Exiting..."); - u3_pier_bail(); - } - - _pier_boot_set_ship(pir_u, u3k(who), u3k(is_fake)); - pir_u->lif_d = u3r_chub(0, life); - - u3z(who); - u3z(is_fake); - u3z(life); -} - -/* _pier_db_on_commit_loaded(): lmdb read callback -** RETAIN mat -*/ -static c3_o -_pier_db_on_commit_loaded(u3_pier* pir_u, - c3_d id, - u3_noun mat) -{ - // Need to grab references to the nouns above. - u3_writ* wit_u = c3_calloc(sizeof(u3_writ)); - wit_u->pir_u = pir_u; - wit_u->evt_d = id; - wit_u->mat = u3k(mat); - - // Parse the expected mug_l and job out of mat. - u3_noun entry = u3ke_cue(u3k(mat)); - u3_noun mug, job; - if ( (c3y != u3du(entry)) || - (c3n == u3r_cell(entry, &mug, &job)) || - (c3n == u3ud(mug)) || - (1 < u3r_met(5, mug)) ) { - u3l_log("pier: load: event %" PRIu64 " malformed.\r\n", id); - return c3n; - } - - wit_u->mug_l = u3r_word(0, mug); - wit_u->job = u3k(job); - - u3z(entry); - - // Insert at queue front since we're loading events in order - if ( !pir_u->ent_u ) { - c3_assert(!pir_u->ext_u); - - pir_u->ent_u = pir_u->ext_u = wit_u; + else if ( god_u->eve_d == log_u->dun_d ) { + u3l_log("---------------- playback complete----------------\r\n"); + u3_term_stop_spinner(); + _pier_work_init(pir_u); + // XX _pier_next(pir_u); } else { - if ( wit_u->evt_d != (1ULL + pir_u->ent_u->evt_d) ) { - fprintf(stderr, "pier: load: commit: event gap: %" PRIx64 ", %" - PRIx64 "\r\n", - wit_u->evt_d, - pir_u->ent_u->evt_d); - _pier_db_bail(0, "pier: load: comit: event gap"); - return c3n; - } - - pir_u->ent_u->nex_u = wit_u; - pir_u->ent_u = wit_u; + c3_assert( god_u->eve_d < log_u->dun_d ); + _pier_play_send(pir_u); + _pier_play_read(pir_u); } - - return c3y; } -/* _pier_db_load_commit(): load len_d commits >= lav_d; enqueue for replay +/* _pier_wall_plan(): enqueue a barrier. */ static void -_pier_db_load_commits(u3_pier* pir_u, - c3_d lav_d, - c3_d len_d) +_pier_wall_plan(u3_pier* pir_u, c3_d eve_d, + void* vod_p, void (*wal_f)(void*, c3_d)) { - if ( c3n == u3_lmdb_read_events(pir_u, lav_d, len_d, - _pier_db_on_commit_loaded) ) - { - u3l_log("Failed to read event log for replay. Exiting..."); - u3_pier_bail(); - } -} + u3_wall* wal_u = c3_malloc(sizeof(*wal_u)); + wal_u->vod_p = vod_p; + wal_u->eve_d = eve_d; + wal_u->wal_f = wal_f; -/* _pier_db_init(): -*/ -static c3_o -_pier_db_init(u3_disk* log_u) -{ - c3_d evt_d = 0; - c3_d pos_d = 0; - - c3_assert( c3n == log_u->liv_o ); - - // Request from the database the last event - if ( c3n == u3_lmdb_get_latest_event_number(log_u->db_u, &evt_d) ) { - u3l_log("disk init from lmdb failed."); - return c3n; - } - - log_u->liv_o = c3y; - log_u->com_d = log_u->moc_d = evt_d; - - _pier_boot_ready(log_u->pir_u); - - return c3y; -} - -/* _pier_disk_create(): load log for given point. -*/ -static c3_o -_pier_disk_create(u3_pier* pir_u) -{ - u3_disk* log_u = c3_calloc(sizeof(*log_u)); - - pir_u->log_u = log_u; - log_u->pir_u = pir_u; - log_u->liv_o = c3n; - - /* create/load pier, urbit directory, log directory. - */ - { - /* pier directory - */ - { - if ( 0 == (log_u->dir_u = u3_foil_folder(pir_u->pax_c)) ) { - return c3n; - } - } - - /* pier/.urb - */ - { - c3_c* urb_c = c3_malloc(6 + strlen(pir_u->pax_c)); - - strcpy(urb_c, pir_u->pax_c); - strcat(urb_c, "/.urb"); - - if ( 0 == (log_u->urb_u = u3_foil_folder(urb_c)) ) { - c3_free(urb_c); - return c3n; - } - c3_free(urb_c); - } - - /* pier/.urb/log - */ - { - c3_c* log_c = c3_malloc(10 + strlen(pir_u->pax_c)); - - strcpy(log_c, pir_u->pax_c); - strcat(log_c, "/.urb/log"); - - // Creates the folder - if ( 0 == (log_u->com_u = u3_foil_folder(log_c)) ) { - c3_free(log_c); - return c3n; - } - - // Inits the database - if ( 0 == (log_u->db_u = u3_lmdb_init(log_c)) ) { - c3_free(log_c); - return c3n; - } - - c3_free(log_c); - } - - /* pier/.urb/put and pier/.urb/get - */ - { - c3_c* dir_c = c3_malloc(10 + strlen(pir_u->pax_c)); - - strcpy(dir_c, pir_u->pax_c); - strcat(dir_c, "/.urb/put"); - mkdir(dir_c, 0700); - - strcpy(dir_c, pir_u->pax_c); - strcat(dir_c, "/.urb/get"); - mkdir(dir_c, 0700); - - c3_free(dir_c); - } - } - - // create/load event log + // insert into [pir_u->wal_u], preserving stable sort by [eve_d] // - if ( c3n == _pier_db_init(log_u) ) { - return c3n; - } + { + u3_wall** las_u = &pir_u->wal_u; - return c3y; -} - -/* _pier_writ_insert(): insert raw event. -*/ -static void -_pier_writ_insert(u3_pier* pir_u, - c3_l msc_l, - u3_noun job) -{ - u3_writ* wit_u = c3_calloc(sizeof(u3_writ)); - wit_u->pir_u = pir_u; - - wit_u->evt_d = pir_u->gen_d; - pir_u->gen_d++; - - wit_u->msc_l = msc_l; - - wit_u->job = job; - - if ( !pir_u->ent_u ) { - c3_assert(!pir_u->ext_u); - - pir_u->ent_u = pir_u->ext_u = wit_u; - } - else { - pir_u->ent_u->nex_u = wit_u; - pir_u->ent_u = wit_u; - } -} - -/* _pier_writ_insert_ovum(): insert raw ovum - for boot sequence. -*/ -static void -_pier_writ_insert_ovum(u3_pier* pir_u, - c3_l msc_l, - u3_noun ovo) -{ - u3_noun now; - struct timeval tim_tv; - - gettimeofday(&tim_tv, 0); - now = u3_time_in_tv(&tim_tv); - - _pier_writ_insert(pir_u, msc_l, u3nc(now, ovo)); -} - -/* _pier_writ_find(): find writ by event number. -*/ -static u3_writ* -_pier_writ_find(u3_pier* pir_u, - c3_d evt_d) -{ - u3_writ* wit_u; - - /* very unlikely to be O(n) and n is small - */ - for ( wit_u = pir_u->ext_u; wit_u; wit_u = wit_u->nex_u ) { - if ( evt_d == wit_u->evt_d ) { - return wit_u; + while ( *las_u && (eve_d <= (*las_u)->eve_d) ) { + las_u = &(*las_u)->nex_u; } - } - return 0; -} -/* _pier_writ_unlink(): unlink writ from queue. -*/ -static void -_pier_writ_unlink(u3_writ* wit_u) -{ - u3_pier* pir_u = wit_u->pir_u; - -#ifdef VERBOSE_EVENTS - fprintf(stderr, "pier: (%" PRIu64 "): delete\r\n", wit_u->evt_d); -#endif - - pir_u->ext_u = wit_u->nex_u; - - if ( wit_u == pir_u->ent_u ) { - c3_assert(pir_u->ext_u == 0); - pir_u->ent_u = 0; + wal_u->nex_u = *las_u; + *las_u = wal_u; } } -/* _pier_writ_dispose(): dispose of writ. +/* _pier_wall(): process a barrier if possible. */ static void -_pier_writ_dispose(u3_writ* wit_u) +_pier_wall(u3_pier* pir_u) { - /* free contents - */ - u3z(wit_u->job); - u3z(wit_u->mat); - u3z(wit_u->act); - - c3_free(wit_u); -} - -/* _pier_work_bail(): handle subprocess error. -*/ -static void -_pier_work_bail(void* vod_p, - const c3_c* err_c) -{ - fprintf(stderr, "\rpier: work error: %s\r\n", err_c); -} - -/* _pier_work_boot(): prepare for boot. -*/ -static void -_pier_work_boot(u3_pier* pir_u, c3_o sav_o) -{ - u3_controller* god_u = pir_u->god_u; - - c3_assert( 0 != pir_u->lif_d ); - - u3_noun len = u3i_chubs(1, &pir_u->lif_d); - - if ( c3y == sav_o ) { - _pier_db_write_header(pir_u, - u3i_chubs(2, pir_u->who_d), - pir_u->fak_o, - u3k(len)); - } - - u3_noun msg = u3nc(c3__boot, len); - u3_atom mat = u3ke_jam(msg); - u3_newt_write(&god_u->inn_u, mat, 0); -} - -/* _pier_work_shutdown(): stop the worker process. -*/ -static void -_pier_work_shutdown(u3_pier* pir_u) -{ - u3_controller* god_u = pir_u->god_u; - - u3_newt_write(&god_u->inn_u, u3ke_jam(u3nc(c3__exit, 0)), 0); -} - -/* _pier_work_build(): build atomic action. -*/ -static void -_pier_work_build(u3_writ* wit_u) -{ - /* marshal into atom - */ - if ( 0 == wit_u->mat ) { - c3_assert(0 != wit_u->job); - - wit_u->mat = u3ke_jam(u3nc(wit_u->mug_l, - u3k(wit_u->job))); - } -} - -/* _pier_work_send(): send to worker. -*/ -static void -_pier_work_send(u3_writ* wit_u) -{ - u3_pier* pir_u = wit_u->pir_u; - u3_controller* god_u = pir_u->god_u; - - c3_assert(0 != wit_u->mat); - - u3_noun msg = u3ke_jam(u3nt(c3__work, - u3i_chubs(1, &wit_u->evt_d), - u3k(wit_u->mat))); - - u3_newt_write(&god_u->inn_u, msg, wit_u); -} - -/* _pier_work_save(): tell worker to save checkpoint. -*/ -static void -_pier_work_save(u3_pier* pir_u) -{ - u3_controller* god_u = pir_u->god_u; + u3_lord* god_u = pir_u->god_u; u3_disk* log_u = pir_u->log_u; - u3_save* sav_u = pir_u->sav_u; - c3_assert( god_u->dun_d == sav_u->req_d ); - c3_assert( log_u->com_d >= god_u->dun_d ); + if ( god_u->eve_d == log_u->dun_d ) { + u3_wall* wal_u; - { - u3_noun mat = u3ke_jam(u3nc(c3__save, u3i_chubs(1, &god_u->dun_d))); - u3_newt_write(&god_u->inn_u, mat, 0); - - // XX wait on some report of success before updating? - // - sav_u->dun_d = sav_u->req_d; - } - - // if we're gracefully shutting down, do so now - // - if ( u3_psat_done == pir_u->sat_e ) { - _pier_exit_done(pir_u); - } -} - -/* _pier_work_release(): apply side effects. -*/ -static void -_pier_work_release(u3_writ* wit_u) -{ - u3_pier* pir_u = wit_u->pir_u; - u3_controller* god_u = pir_u->god_u; - u3_noun vir = wit_u->act; - - if ( u3_psat_pace == pir_u->sat_e ) { - fputc('.', stderr); - - // enqueue another batch of events for replay + // XX check god_u->dep_w // + while ( (wal_u = pir_u->wal_u) + && (wal_u->eve_d <= god_u->eve_d) ) { - u3_disk* log_u = pir_u->log_u; - - // XX requires that writs be unlinked before effects are released - // - if ( (0 == pir_u->ent_u) && - (wit_u->evt_d < log_u->com_d) ) - { - _pier_db_load_commits(pir_u, (1ULL + god_u->dun_d), 1000ULL); - } - } - } - else { -#ifdef VERBOSE_EVENTS - fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", wit_u->evt_d); -#endif - - // advance release counter - // - { - c3_assert(wit_u->evt_d == (1ULL + god_u->rel_d)); - god_u->rel_d += 1ULL; - } - - // apply actions - // - while ( u3_nul != vir ) { - u3_noun ovo, nex; - u3x_cell(vir, &ovo, &nex); - - u3_reck_kick(pir_u, u3k(ovo)); - vir = nex; - } - } - - // if we have completed the boot sequence, activate system events. - // - if ( wit_u->evt_d == pir_u->but_d ) { - _pier_boot_complete(pir_u); - } - - // take snapshot, if requested (and awaiting the commit of this event) - // - { - u3_save* sav_u = pir_u->sav_u; - - if ( (sav_u->req_d > sav_u->dun_d) && - (wit_u->evt_d == sav_u->req_d) ) - { - _pier_work_save(pir_u); + pir_u->wal_u = wal_u->nex_u; + wal_u->wal_f(wal_u->vod_p, god_u->eve_d); + c3_free(wal_u); } } } -/* _pier_work_spin_start(): activate spinner. +/* _pier_next(): advance the pier state machine. */ static void -_pier_work_spin_start(u3_writ* wit_u) +_pier_next(u3_pier* pir_u) { - u3_pier* pir_u = wit_u->pir_u; - c3_o now_o = c3n; - u3_noun say = u3_blip; + switch ( pir_u->sat_e ) { + default: c3_assert(0); - if ( wit_u->evt_d <= pir_u->lif_d ) { - say = c3__nock; - } - else { - u3_noun why; + case u3_peat_work: + case u3_peat_done: { + _pier_work(pir_u); + break; + } - // second item of the event wire - // - // i.t.p.q:*(pair @da ovum) - // - if ( u3_none != (why = u3r_at(26, wit_u->job)) ) { - u3_noun cad, tag, lag; - - - if ( c3__term != why ) { - say = why; - } - else if ( ( u3_none != (cad = u3r_at(7, wit_u->job)) ) && - ( u3_none != (tag = u3r_at(2, cad)) ) && - ( u3_none != (lag = u3r_at(6, cad)) ) && - ( c3__belt == tag ) && - ( c3__ret == lag ) ) - { - now_o = c3y; - } + case u3_peat_play: + case u3_peat_boot: { + _pier_play(pir_u); + break; + } + + case u3_peat_init: { + break; } } - u3_term_start_spinner(say, now_o); + _pier_wall(pir_u); } -/* _pier_work_spin_stop(): deactivate spinner. +/* _pier_on_lord_slog(): debug printf from worker. */ static void -_pier_work_spin_stop(u3_writ* wit_u) +_pier_on_lord_slog(void* vod_p, c3_w pri_w, u3_noun tan) { - u3_term_stop_spinner(); -} - -/* _pier_work_complete(): worker reported completion. -*/ -static void -_pier_work_complete(u3_writ* wit_u, - c3_l mug_l, - u3_noun act) -{ - u3_pier* pir_u = wit_u->pir_u; - u3_controller* god_u = pir_u->god_u; - -#ifdef VERBOSE_EVENTS - fprintf(stderr, "pier: (%" PRIu64 "): compute: complete\r\n", wit_u->evt_d); -#endif - - god_u->dun_d += 1; - c3_assert(god_u->dun_d == wit_u->evt_d); - - god_u->mug_l = mug_l; - - c3_assert(wit_u->act == 0); - wit_u->act = act; - - _pier_work_spin_stop(wit_u); -} - -/* _pier_work_replace(): worker reported replacement. -*/ -static void -_pier_work_replace(u3_writ* wit_u, - u3_noun job) -{ - u3_pier* pir_u = wit_u->pir_u; - u3_controller* god_u = pir_u->god_u; - -#ifdef VERBOSE_EVENTS - fprintf(stderr, "pier: (%" PRIu64 "): compute: replace\r\n", wit_u->evt_d); -#endif - - c3_assert(god_u->sen_d == wit_u->evt_d); - - // something has gone very wrong, we should probably stop now - // - if ( wit_u->rep_d >= 3ULL ) { - u3_pier_bail(); - } - - // move backward in work processing - // - { - u3z(wit_u->job); - u3z(wit_u->mat); - wit_u->mat = 0; - wit_u->job = job; - - _pier_work_build(wit_u); - - wit_u->rep_d += 1ULL; - god_u->sen_d -= 1ULL; - } - - _pier_work_spin_stop(wit_u); -} - -/* _pier_work_compute(): dispatch for processing. -*/ -static void -_pier_work_compute(u3_writ* wit_u) -{ - u3_pier* pir_u = wit_u->pir_u; - u3_controller* god_u = pir_u->god_u; - -#ifdef VERBOSE_EVENTS - fprintf(stderr, "pier: (%" PRIu64 "): compute: request\r\n", wit_u->evt_d); -#endif - - c3_assert(wit_u->evt_d == (1 + god_u->sen_d)); - - wit_u->mug_l = god_u->mug_l; - - _pier_work_build(wit_u); - _pier_work_send(wit_u); - - god_u->sen_d += 1; - - _pier_work_spin_start(wit_u); -} - -/* _pier_work_play(): with active worker, create or load log. -*/ -static void -_pier_work_play(u3_pier* pir_u, - c3_d lav_d, - c3_l mug_l) -{ - u3_controller* god_u = pir_u->god_u; - -#ifdef VERBOSE_EVENTS - fprintf(stderr, "pier: (%" PRIu64 "): boot at mug %x\r\n", lav_d, mug_l); -#endif - - c3_assert( c3n == god_u->liv_o ); - god_u->liv_o = c3y; - - // all events in the worker are complete - // - god_u->rel_d = god_u->dun_d = god_u->sen_d = (lav_d - 1ULL); - god_u->mug_l = mug_l; - - _pier_boot_ready(pir_u); -} - -/* _pier_work_stdr(): prints an error message to stderr - */ -static void -_pier_work_stdr(u3_writ* wit_u, u3_noun cord) -{ - c3_c* str = u3r_string(cord); - u3C.stderr_log_f(str); - c3_free(str); -} - -/* _pier_work_slog(): print directly. -*/ -static void -_pier_work_slog(u3_writ* wit_u, c3_w pri_w, u3_noun tan) -{ -#ifdef U3_EVENT_TIME_DEBUG - { - static int old; - static struct timeval b4, f2, d0; - static c3_d b4_d; - c3_w ms_w; - - if ( old ) { - gettimeofday(&f2, 0); - timersub(&f2, &b4, &d0); - ms_w = (d0.tv_sec * 1000) + (d0.tv_usec / 1000); - if (ms_w > 1) { - #if 0 - fprintf(stderr, "%6d.%02dms: %9d ", - ms_w, (int) (d0.tv_usec % 1000) / 10, - ((int) (u3R->pro.nox_d - b4_d))); - #else - fprintf(stderr, "%6d.%02dms ", - ms_w, (int) (d0.tv_usec % 1000) / 10); - #endif - gettimeofday(&b4, 0); - b4_d = u3R->pro.nox_d; - } - else { - fprintf(stderr, " "); - } - } - else { - gettimeofday(&b4, 0); - b4_d = u3R->pro.nox_d; - } - old = 1; - } -#endif - + u3_pier* pir_u = vod_p; u3_pier_tank(0, pri_w, tan); + _pier_next(pir_u); } -/* _pier_work_exit(): handle subprocess exit. +/* _pier_on_lord_peek(): namespace read response from worker. */ static void -_pier_work_exit(uv_process_t* req_u, - c3_ds sas_i, - c3_i sig_i) +_pier_on_lord_peek(void* vod_p, u3_noun gan, u3_noun pat, u3_noun dat); + +/* _pier_on_lord_play_done(): log replay batch completion from worker. +*/ +static void +_pier_on_lord_play_done(void* vod_p, u3_play pay_u, c3_l mug_l) { - u3_controller* god_u = (void *) req_u; - u3_pier* pir_u = god_u->pir_u; + u3_pier* pir_u = vod_p; + c3_d las_d = pay_u.ent_u->eve_d; - fprintf(stderr, "\rpier: work exit: status %" PRId64 ", signal %d\r\n", - sas_i, sig_i); - uv_close((uv_handle_t*) req_u, 0); +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): play: done\r\n", las_d); +#endif - // XX dispose + // XX optional // - pir_u->god_u = 0; + if ( pay_u.ent_u->mug_l + && (pay_u.ent_u->mug_l != mug_l) ) + { + // XX printf + // + u3l_log("pier: (%" PRIu64 "): play: mug mismatch %x %x\r\n", las_d, pay_u.ent_u->mug_l, mug_l); + // u3_pier_bail(); + } + + { + u3_fact* tac_u = pay_u.ext_u; + u3_fact* nex_u; + + while ( tac_u ) { + nex_u = tac_u->nex_u; + u3z(tac_u->job); + c3_free(tac_u); + tac_u = nex_u; + } + } + + _pier_next(pir_u); +} + +/* _pier_on_lord_play_bail(): log replay batch failure from worker. +*/ +static void +_pier_on_lord_play_bail(void* vod_p, u3_play pay_u, + c3_l mug_l, c3_d eve_d, u3_noun dud) +{ +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): play: bail\r\n", eve_d); +#endif + // XX verify pay_u mug_l + // XX check dud mote, retry yap_u or shutdown + + // { + // u3_play* yap_u = c3_malloc(sizeof(*yap_u)); + // u3_fact* fac_u = pay_u->ext_u; + + // while ( fac_u->eve_d < eve_d ) { + // fac_u = fac_u->nex_u; + // } + + // yap_u->ext_u = fac_u->nex_u; + // yap_u->ent_u = pay_u->ent_u; + // pay_u->ent_u = fac_u; + // } u3_pier_bail(); } -/* _pier_work_poke(): handle subprocess result. transfer nouns. +/* _pier_on_lord_work_done(): event completion from worker. */ static void -_pier_work_poke(void* vod_p, - u3_noun mat) +_pier_on_lord_work_done(void* vod_p, u3_work* wok_u, c3_o wap_o) { u3_pier* pir_u = vod_p; - u3_noun jar = u3ke_cue(u3k(mat)); - u3_noun p_jar, q_jar, r_jar; - if ( c3y != u3du(jar) ) { - goto error; - } + { + u3_ovum* egg_u = wok_u->egg_u; - switch ( u3h(jar) ) { - default: goto error; - - // the worker process starts with a %play task, - // which tells us where to start playback - // - case c3__play: { - c3_d lav_d; - c3_l mug_l; - - if ( (c3n == u3r_trel(jar, 0, &p_jar, &q_jar)) || - (c3n == u3ud(p_jar)) || - (u3r_met(6, p_jar) != 1) || - (c3n == u3ud(q_jar)) || - (1 < u3r_met(5, q_jar)) ) - { - goto error; - } - - lav_d = u3r_chub(0, p_jar); - mug_l = u3r_word(0, q_jar); - - _pier_work_play(pir_u, lav_d, mug_l); - break; - } - - case c3__work: { - if ( (c3n == u3r_trel(jar, 0, &p_jar, &q_jar)) || - (c3n == u3ud(p_jar)) || - (u3r_met(6, p_jar) != 1) ) - { - u3l_log("failed to parse replacement atom"); - goto error; + if ( egg_u ) { + if ( c3y == wap_o ) { + egg_u->car_u->ev.swap_f(egg_u->car_u, egg_u->vod_p); } else { - c3_d evt_d = u3r_chub(0, p_jar); - u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); + egg_u->car_u->ev.done_f(egg_u->car_u, egg_u->vod_p); + } + } + } - u3_noun mug, job; - u3_noun entry = u3ke_cue(u3k(q_jar)); - if ( (c3y != u3du(entry)) || - (c3n == u3r_cell(entry, &mug, &job)) || - (c3n == u3ud(mug)) || - (1 < u3r_met(5, mug)) ) { - u3z(entry); - goto error; - } + _pier_work_plan(pir_u, wok_u); - c3_l mug_l = u3r_word(0, mug); - if ( !wit_u || (mug_l && (mug_l != wit_u->mug_l)) ) { - u3z(entry); - goto error; - } -#ifdef VERBOSE_EVENTS - fprintf(stderr, "pier: replace: %" PRIu64 "\r\n", evt_d); + + _pier_next(pir_u); +} + +/* _pier_on_lord_work_bail(): event failure from worker. +*/ +static void +_pier_on_lord_work_bail(void* vod_p, u3_work* wok_u, u3_noun lud) +{ + u3_pier* pir_u = vod_p; + + { + u3_ovum* egg_u = wok_u->egg_u; + + if ( egg_u ) { + egg_u->car_u->ev.bail_f(egg_u->car_u, egg_u->vod_p); + } + } + + // XX print lud + // XX dispose + // + fprintf(stderr, "pier: work: bail\r\n"); + + _pier_next(pir_u); +} + +/* _pier_on_lord_save(): worker state-export complete (portable snapshot). +*/ +static void +_pier_on_lord_save(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): lord: snap\r\n", eve_d); #endif - _pier_work_replace(wit_u, u3k(job)); - u3z(entry); - } - break; - } + _pier_next(pir_u); +} - case c3__done: { - if ( (c3n == u3r_qual(jar, 0, &p_jar, &q_jar, &r_jar)) || - (c3n == u3ud(p_jar)) || - (u3r_met(6, p_jar) != 1) || - (c3n == u3ud(q_jar)) || - (u3r_met(5, q_jar) > 1) ) - { - goto error; - } - else { - c3_d evt_d = u3r_chub(0, p_jar); - c3_l mug_l = u3r_word(0, q_jar); - u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); +/* _pier_on_lord_snap(): worker (non-portable) snapshot complete. +*/ +static void +_pier_on_lord_snap(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; - if ( !wit_u ) { - u3l_log("poke: no writ: %" PRIu64 "\r\n", evt_d); - goto error; - } - _pier_work_complete(wit_u, mug_l, u3k(r_jar)); - } - break; - } +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): lord: snap\r\n", eve_d); +#endif - case c3__stdr: { - if ( (c3n == u3r_trel(jar, 0, &p_jar, &q_jar)) || - (c3n == u3ud(p_jar)) || - (u3r_met(6, p_jar) > 1) || - (c3n == u3ud(q_jar)) ) - { - goto error; - } - else { - c3_d evt_d = u3r_chub(0, p_jar); - u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); + _pier_next(pir_u); +} - // Unlike slog, we always reprint interpreter errors during replay. - _pier_work_stdr(wit_u, q_jar); - } - break; - } +/* _pier_on_lord_exit(): worker shutdown. +*/ +static void +_pier_on_lord_exit(void* vod_p, c3_o ret_o) +{ + u3_pier* pir_u = vod_p; - case c3__slog: { - if ( (c3n == u3r_qual(jar, 0, &p_jar, &q_jar, &r_jar)) || - (c3n == u3ud(p_jar)) || - (u3r_met(6, p_jar) != 1) || - (c3n == u3ud(q_jar)) || - (u3r_met(3, q_jar) > 1) ) - { - goto error; - } - else { - c3_d evt_d = u3r_chub(0, p_jar); - c3_w pri_w = u3r_word(0, q_jar); - u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); - - // skip slog during replay - // - // XX also update the worker to skip *sending* the slog during replay - // - if ( u3_psat_pace != pir_u->sat_e ) { - _pier_work_slog(wit_u, pri_w, u3k(r_jar)); - } - } - break; - } + if ( u3_peat_done == pir_u->sat_e ) { + // XX dispose + // + // exit(0); + uv_stop(u3L); } - - u3z(jar); u3z(mat); - _pier_loop_resume(pir_u); - return; - - error: { - u3m_p("jar", jar); - u3z(jar); u3z(mat); - _pier_work_bail(0, "bad jar"); + else { + // XX print error + // XX dispose + u3_pier_bail(); } } -/* pier_work_create(): instantiate child process. +/* _pier_on_lord_live(): worker is ready. */ -static u3_controller* -_pier_work_create(u3_pier* pir_u) +static void +_pier_on_lord_live(void* vod_p) { - u3_controller* god_u = c3_calloc(sizeof *god_u); + u3_pier* pir_u = vod_p; + u3_lord* god_u = pir_u->god_u; + u3_disk* log_u = pir_u->log_u; - pir_u->god_u = god_u; - god_u->pir_u = pir_u; - god_u->liv_o = c3n; +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): boot at mug %x\r\n", god_u->eve_d, god_u->mug_l); +#endif - /* spawn new process and connect to it - */ - { - c3_c* arg_c[5]; - c3_c* bin_c = u3_Host.wrk_c; - c3_c* pax_c = pir_u->pax_c; - c3_c key_c[256]; - c3_c wag_c[11]; - c3_i err_i; + if ( log_u->sen_d > log_u->dun_d ) { + c3_assert( u3_peat_boot == pir_u->sat_e ); + } + else { + c3_assert( (u3_peat_boot == pir_u->sat_e) + || (u3_peat_init == pir_u->sat_e) ); - sprintf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", - pir_u->key_d[0], - pir_u->key_d[1], - pir_u->key_d[2], - pir_u->key_d[3]); + c3_assert( god_u->eve_d <= log_u->dun_d ); - sprintf(wag_c, "%u", pir_u->wag_w); + if ( god_u->eve_d < log_u->dun_d ) { + pir_u->sat_e = u3_peat_play; + pir_u->pay_u.sen_d = god_u->eve_d; - arg_c[0] = bin_c; // executable - arg_c[1] = pax_c; // path to checkpoint directory - arg_c[2] = key_c; // disk key - arg_c[3] = wag_c; // runtime config - arg_c[4] = 0; + u3l_log("---------------- playback starting----------------\r\n"); + if ( (1ULL + god_u->eve_d) == log_u->dun_d ) { + u3l_log("pier: replaying event %" PRIu64 "\r\n", log_u->dun_d); + } + else { + u3l_log("pier: replaying events %" PRIu64 "-%" PRIu64 "\r\n", + (1ULL + god_u->eve_d), + log_u->dun_d); + } - uv_pipe_init(u3L, &god_u->inn_u.pyp_u, 0); - uv_pipe_init(u3L, &god_u->out_u.pyp_u, 0); - - god_u->cod_u[0].flags = UV_CREATE_PIPE | UV_READABLE_PIPE; - god_u->cod_u[0].data.stream = (uv_stream_t *)&god_u->inn_u; - - god_u->cod_u[1].flags = UV_CREATE_PIPE | UV_WRITABLE_PIPE; - god_u->cod_u[1].data.stream = (uv_stream_t *)&god_u->out_u; - - god_u->cod_u[2].flags = UV_INHERIT_FD; - god_u->cod_u[2].data.fd = 2; - - god_u->ops_u.stdio = god_u->cod_u; - god_u->ops_u.stdio_count = 3; - - god_u->ops_u.exit_cb = _pier_work_exit; - god_u->ops_u.file = arg_c[0]; - god_u->ops_u.args = arg_c; - - if ( (err_i = uv_spawn(u3L, &god_u->cub_u, &god_u->ops_u)) ) { - fprintf(stderr, "spawn: %s: %s\r\n", arg_c[0], uv_strerror(err_i)); - - return 0; + u3_term_start_spinner(c3__play, c3y); + } + else { + _pier_work_init(pir_u); } } - /* start reading from proc - */ - { - god_u->out_u.vod_p = pir_u; - god_u->out_u.pok_f = _pier_work_poke; - god_u->out_u.bal_f = _pier_work_bail; + _pier_next(pir_u); +} - god_u->inn_u.bal_f = _pier_work_bail; +/* _pier_on_disk_read_done(): event log read success. +*/ +static void +_pier_on_disk_read_done(void* vod_p, u3_play pay_u) +{ + u3_pier* pir_u = vod_p; - u3_newt_read(&god_u->out_u); + c3_assert( (u3_peat_boot == pir_u->sat_e) + || (u3_peat_play == pir_u->sat_e) ); + + _pier_play_plan(pir_u, pay_u); + + _pier_next(pir_u); +} + +/* _pier_on_disk_read_bail(): event log read failure. +*/ +static void +_pier_on_disk_read_bail(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; + + // XX + // + fprintf(stderr, "pier: disk read bail\r\n"); + u3_term_stop_spinner(); + u3_pier_bail(); +} + +/* _pier_on_disk_write_done(): event log write success. +*/ +static void +_pier_on_disk_write_done(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): db commit: complete\r\n", eve_d); +#endif + + if ( u3_peat_boot == pir_u->sat_e ) { + pir_u->wok_u.rel_d = eve_d; } - return god_u; + else { + c3_assert( u3_peat_work == pir_u->sat_e ); + } + + _pier_next(pir_u); +} + +/* _pier_on_disk_write_bail(): event log write failure. +*/ +static void +_pier_on_disk_write_bail(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; + + // XX + // + fprintf(stderr, "pier: disk write bail\r\n"); + u3_pier_bail(); } /* _pier_loop_time(): set time. */ static void -_pier_loop_time(void) +_pier_loop_time(u3_pier* pir_u) { struct timeval tim_tv; - gettimeofday(&tim_tv, 0); + + // XX save to pier + // u3v_time(u3_time_in_tv(&tim_tv)); } -/* _pier_loop_prepare(): run on every loop iteration before i/o polling. +/* _pier_loop_before_cb(): run on every loop iteration before i/o polling. */ static void -_pier_loop_prepare(uv_prepare_t* pep_u) +_pier_loop_fore_cb(uv_prepare_t* pep_u) { - _pier_loop_time(); + u3_pier* pir_u = pep_u->data; + _pier_loop_time(pir_u); } -/* _pier_loop_idle_cb(): run on every loop iteration after i/o polling. +/* _pier_loop_afte_cb(): run on every loop iteration after i/o polling. +*/ +static void +_pier_loop_afte_cb(uv_check_t* cek_u) +{ + u3_pier* pir_u = cek_u->data; + _pier_next(pir_u); +} + +/* _pier_loop_idle_cb(): run on next loop iteration. */ static void _pier_loop_idle_cb(uv_idle_t* idl_u) { u3_pier* pir_u = idl_u->data; - _pier_apply(pir_u); - + _pier_next(pir_u); uv_idle_stop(idl_u); } -/* _pier_loop_resume(): (re-)activate idle handler +/* u3_pier_spin(): (re-)activate idle handler */ -static void -_pier_loop_resume(u3_pier* pir_u) +void +u3_pier_spin(u3_pier* pir_u) { if ( !uv_is_active((uv_handle_t*)&pir_u->idl_u) ) { uv_idle_start(&pir_u->idl_u, _pier_loop_idle_cb); } } +static void +_pier_loop_init(u3_auto* car_u); +static void +_pier_loop_wake(u3_auto* car_u); +static void +_pier_loop_exit(u3_auto* car_u); +static c3_o +_pier_loop_fete(u3_auto* car_u, u3_noun pax, u3_noun fav); + +static void +_pier_auto_noop(u3_auto* car_u, void* vod_p) +{ +} +/* _pier_init(): create a pier, loading existing. +*/ +static u3_pier* +_pier_init(c3_w wag_w, c3_c* pax_c) +{ + // create pier + // + u3_pier* pir_u = c3_calloc(sizeof(*pir_u)); + + pir_u->pax_c = pax_c; + pir_u->sat_e = u3_peat_init; + + // XX remove + // + pir_u->sam_u = c3_calloc(sizeof(u3_ames)); + pir_u->por_s = u3_Host.ops_u.por_s; + pir_u->teh_u = c3_calloc(sizeof(u3_behn)); + pir_u->unx_u = c3_calloc(sizeof(u3_unix)); + pir_u->sav_u = c3_calloc(sizeof(u3_save)); + + // initialize pre i/o polling handle + // + uv_prepare_init(u3L, &pir_u->pep_u); + pir_u->pep_u.data = pir_u; + uv_prepare_start(&pir_u->pep_u, _pier_loop_fore_cb); + + // initialize post i/o polling handle + // + uv_check_init(u3L, &pir_u->cek_u); + pir_u->cek_u.data = pir_u; + uv_check_start(&pir_u->cek_u, _pier_loop_afte_cb); + + // NB, not started + // + uv_idle_init(u3L, &pir_u->idl_u); + pir_u->idl_u.data = pir_u; + + // initialize persistence + // + { + // XX load/set secrets + // + u3_disk_cb cb_u = { + .vod_p = pir_u, + .read_done_f = _pier_on_disk_read_done, + .read_bail_f = _pier_on_disk_read_bail, + .write_done_f = _pier_on_disk_write_done, + .write_bail_f = _pier_on_disk_write_bail + }; + + if ( !(pir_u->log_u = u3_disk_init(pax_c, cb_u)) ) { + c3_free(pir_u); + return 0; + } + + pir_u->wok_u.rel_d = pir_u->log_u->dun_d; + } + + // start the worker process + // + { + // XX load/set secrets + // + c3_d tic_d[1]; // ticket (unstretched) + c3_d sec_d[1]; // generator (unstretched) + c3_d key_d[4]; // secret (stretched) + + key_d[0] = key_d[1] = key_d[2] = key_d[3] = 0; + + u3_lord_cb cb_u = { + .vod_p = pir_u, + .live_f = _pier_on_lord_live, + .slog_f = _pier_on_lord_slog, + // .peek_f = _pier_on_lord_peek, + .play_done_f = _pier_on_lord_play_done, + .play_bail_f = _pier_on_lord_play_bail, + .work_done_f = _pier_on_lord_work_done, + .work_bail_f = _pier_on_lord_work_bail, + .save_f = _pier_on_lord_save, + .snap_f = _pier_on_lord_snap, + .exit_f = _pier_on_lord_exit + }; + + if ( !(pir_u->god_u = u3_lord_init(pax_c, wag_w, key_d, cb_u)) ) + { + // u3_disk_exit(pir_u->log_u) + c3_free(pir_u); + return 0; + } + } + + // encapsulate all i/o drivers in one u3_auto (temporary) + { + u3_auto* car_u = c3_calloc(sizeof(*car_u)); + car_u->nam_m = u3_blip; + car_u->liv_o = c3y; + car_u->pir_u = pir_u; + car_u->io.init_f = _pier_loop_init; + car_u->io.talk_f = _pier_loop_wake; + car_u->io.fete_f = _pier_loop_fete; + car_u->io.exit_f = _pier_loop_exit; + car_u->ev.drop_f = _pier_auto_noop; + car_u->ev.work_f = _pier_auto_noop; + car_u->ev.done_f = _pier_auto_noop; + car_u->ev.swap_f = _pier_auto_noop; + car_u->ev.bail_f = _pier_auto_noop; + + pir_u->car_u = car_u; + } + + // install in the pier table + // + // XX u3_king_plan + // + if ( 0 == u3K.all_w ) { + u3K.all_w = 16; + u3K.tab_u = c3_malloc(16 * sizeof(u3_pier*)); + } + if ( u3K.len_w == u3K.all_w ) { + u3K.all_w = 2 * u3K.all_w; + u3K.tab_u = c3_realloc(u3K.tab_u, u3K.all_w * sizeof(u3_pier*)); + } + u3K.tab_u[u3K.len_w++] = pir_u; + + u3_auto_init(pir_u->car_u); + + return pir_u; +} + +/* u3_pier_stay(): restart an existing pier. +*/ +void +u3_pier_stay(c3_w wag_w, u3_noun pax) +{ + u3_pier* pir_u = _pier_init(wag_w, u3r_string(pax)); + + if ( c3n == u3_disk_read_header(pir_u->log_u, pir_u->who_d, + &pir_u->fak_o, &pir_u->lif_w) ) + { + // xx dispose + exit(1); + } + + u3z(pax); +} + +/* _pier_pill_parse(): extract boot formulas and module/userspace ova from pill +*/ +static u3_boot +_pier_pill_parse(u3_noun pil) +{ + u3_boot bot_u; + u3_noun pil_p, pil_q, pil_r; + u3_noun pro; + + c3_assert( c3y == u3du(pil) ); + + if ( c3y == u3h(pil) ) { + u3x_trel(pil, 0, &pil_p, &pil_q); + } + else { + u3x_qual(pil, 0, &pil_p, &pil_q, &pil_r); + } + + pro = u3m_soft(0, u3ke_cue, u3k(pil_p)); + + if ( 0 != u3h(pro) ) { + fprintf(stderr, "boot: failed: unable to parse pill\r\n"); + exit(1); + } + + u3x_trel(u3t(pro), &bot_u.bot, &bot_u.mod, &bot_u.use); + u3k(bot_u.bot); u3k(bot_u.mod); u3k(bot_u.use); + + // optionally replace filesystem in userspace + // + if ( c3y == u3h(pil) ) { + if ( u3_nul != pil_q ) { + c3_w len_w = 0; + u3_noun ova = bot_u.use; + u3_noun new = u3_nul; + u3_noun ovo; + + while ( u3_nul != ova ) { + ovo = u3h(ova); + + if ( c3__into == u3h(u3t(ovo)) ) { + c3_assert( 0 == len_w ); + len_w++; + ovo = u3t(pil_q); + } + + new = u3nc(u3k(ovo), new); + ova = u3t(ova); + } + + c3_assert( 1 == len_w ); + + u3z(bot_u.use); + bot_u.use = u3kb_flop(new); + } + } + // prepend %lite module and userspace ova + // + else { + bot_u.mod = u3kb_weld(u3k(pil_q), bot_u.mod); + bot_u.use = u3kb_weld(u3k(pil_r), bot_u.use); + } + + u3z(pro); u3z(pil); + + return bot_u; +} + +/* _pier_boot_make(): construct boot sequence +*/ +static u3_boot +_pier_boot_make(u3_noun who, u3_noun ven, u3_noun pil) +{ + u3_boot bot_u = _pier_pill_parse(pil); // transfer + + // prepend entropy and identity to the module sequence + // + { + u3_noun wir, cad; + c3_w eny_w[16]; + + c3_rand(eny_w); + wir = u3nt(u3_blip, c3__arvo, u3_nul); + cad = u3nc(c3__wack, u3i_words(16, eny_w)); + bot_u.mod = u3nc(u3nc(wir, cad), bot_u.mod); + + wir = u3nt(u3_blip, c3__arvo, u3_nul); + cad = u3nc(c3__whom, who); // transfer + bot_u.mod = u3nc(u3nc(wir, cad), bot_u.mod); + } + + // prepend legacy boot event to the userspace sequence + // + { + // XX do something about this wire + // XX route directly to %jael? + // + c3_assert( c3y == u3a_is_cell(ven) ); + + u3_noun wir = u3nq(u3_blip, c3__term, '1', u3_nul); + u3_noun cad = u3nt(c3__boot, u3_Host.ops_u.lit, ven); // transfer + + bot_u.use = u3nc(u3nc(wir, cad), bot_u.use); + } + + return bot_u; +} + +/* _pier_boot_plan(): construct and commit boot sequence +*/ +static c3_o +_pier_boot_plan(u3_pier* pir_u, u3_noun who, u3_noun ven, u3_noun pil) +{ + u3_boot bot_u; + { + pir_u->sat_e = u3_peat_boot; + pir_u->fak_o = ( c3__fake == u3h(ven) ) ? c3y : c3n; + u3r_chubs(0, 2, pir_u->who_d, who); + + bot_u = _pier_boot_make(who, ven, pil); + pir_u->lif_w = u3qb_lent(bot_u.bot); + } + + if ( c3n == u3_disk_write_header(pir_u->log_u, pir_u->who_d, + pir_u->fak_o, pir_u->lif_w) ) + { + // XX dispose bot_u + // + return c3n; + } + + // insert boot sequence directly + // + // Note that these are not ovum or (pair @da ovum) events, + // but raw nock formulas to be directly evaluated as the + // subject of the lifecycle formula [%2 [%0 3] %0 2]. + // All subsequent events will be (pair date ovum). + // + { + u3_noun fol = bot_u.bot; + + while ( u3_nul != fol ) { + u3_disk_boot_plan(pir_u->log_u, u3k(u3h(fol))); + fol = u3t(fol); + } + } + + // insert module and userspace events + // + // XX increment [now] deterministically? + // + { + struct timeval tim_tv; + u3_noun ova = bot_u.mod; + u3_noun now; + + while ( u3_nul != ova ) { + gettimeofday(&tim_tv, 0); + u3_disk_boot_plan(pir_u->log_u, + u3nc(u3_time_in_tv(&tim_tv), + u3k(u3h(ova)))); + ova = u3t(ova); + } + + ova = bot_u.use; + + while ( u3_nul != ova ) { + gettimeofday(&tim_tv, 0); + u3_disk_boot_plan(pir_u->log_u, + u3nc(u3_time_in_tv(&tim_tv), + u3k(u3h(ova)))); + ova = u3t(ova); + } + } + + u3z(bot_u.bot); + u3z(bot_u.mod); + u3z(bot_u.use); + + return c3y; +} + +/* u3_pier_boot(): start a new pier. +*/ +void +u3_pier_boot(c3_w wag_w, // config flags + u3_noun who, // identity + u3_noun ven, // boot event + u3_noun pil, // type-of/path-to pill + u3_noun pax) // path to pier +{ + u3_pier* pir_u = _pier_init(wag_w, u3r_string(pax)); + + if ( c3n == _pier_boot_plan(pir_u, who, ven, pil) ) { + // xx dispose + // + exit(1); + } + + u3z(pax); +} + +static void +_pier_save_cb(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; + u3_lord_save(pir_u->god_u, eve_d); +} + +/* u3_pier_save(): save a portable snapshot. +*/ +void +u3_pier_save(u3_pier* pir_u) +{ + _pier_wall_plan(pir_u, 0, pir_u, _pier_save_cb); +} + +static void +_pier_snap_cb(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; + u3_lord_snap(pir_u->god_u, eve_d); +} + +/* u3_pier_snap(): save a non-portable snapshot +*/ +void +u3_pier_snap(u3_pier* pir_u) +{ + _pier_wall_plan(pir_u, 0, pir_u, _pier_snap_cb); +} + +static void +_pier_exit_cb(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; + u3_lord_exit(pir_u->god_u, 0); +} + +/* u3_pier_exit(): shutdown. +*/ +void +u3_pier_exit(u3_pier* pir_u) +{ + pir_u->sat_e = u3_peat_done; + + u3_pier_snap(pir_u); + u3_disk_exit(pir_u->log_u); + u3_auto_exit(pir_u->car_u); + _pier_wall_plan(pir_u, 0, pir_u, _pier_exit_cb); +} + +// play loop: +// +// _lord_live state = play +// _disk_read batch +// disk_cb lord_play, disk_read +// lord_cb lord_play, disk_read ... +// lord_cb state = work + + +// work loop: +// +// _lord_live state = work || play_done +// _auto_init +// _auto_next loop, fill queue +// lord_cb check until all live, pir_u->liv_o, "boot" cb +// + +// boot loop: +// +// construct a boot sequence, commit part, enqueue part ("boot" driver, or direct?) +// play loop +// work loop +// + + +// startup validation +// +// replay the log +// init all the i/o drivers +// + + +// boot validation +// +// play the (pill / boot-sequence) +// init all the i/o drivers +// neighbor with sponsor +// + + + /* _pier_loop_init_pier(): initialize loop handlers. */ static void -_pier_loop_init(u3_pier* pir_u) +_pier_loop_init(u3_auto* car_u) { + u3_pier* pir_u = car_u->pir_u; c3_l cod_l; - _pier_loop_time(); + _pier_loop_time(pir_u); // for i/o drivers that still use u3A->sen // @@ -1189,8 +1243,9 @@ _pier_loop_init(u3_pier* pir_u) /* _pier_loop_wake(): initialize listeners and send initial events. */ static void -_pier_loop_wake(u3_pier* pir_u) +_pier_loop_wake(u3_auto* car_u) { + u3_pier* pir_u = car_u->pir_u; c3_l cod_l; // inject fresh entropy @@ -1238,8 +1293,9 @@ _pier_loop_wake(u3_pier* pir_u) /* _pier_loop_exit(): terminate I/O across the process. */ static void -_pier_loop_exit(u3_pier* pir_u) +_pier_loop_exit(u3_auto* car_u) { + u3_pier* pir_u = car_u->pir_u; c3_l cod_l; cod_l = u3a_lush(c3__unix); @@ -1275,627 +1331,11 @@ _pier_loop_exit(u3_pier* pir_u) } } -/* _pier_boot_set_ship(): -*/ -static void -_pier_boot_set_ship(u3_pier* pir_u, u3_noun who, u3_noun fak) -{ - c3_assert( c3y == u3ud(who) ); - c3_assert( (c3y == fak) || (c3n == fak) ); - - c3_o fak_o = fak; - c3_d who_d[2]; - - u3r_chubs(0, 2, who_d, who); - - c3_assert( ( (0 == pir_u->fak_o) && - (0 == pir_u->who_d[0]) && - (0 == pir_u->who_d[1]) ) || - ( (fak_o == pir_u->fak_o) && - (who_d[0] == pir_u->who_d[0]) && - (who_d[1] == pir_u->who_d[1]) ) ); - - pir_u->fak_o = fak_o; - pir_u->who_d[0] = who_d[0]; - pir_u->who_d[1] = who_d[1]; - - { - u3_noun how = u3dc("scot", 'p', u3k(who)); - - c3_free(pir_u->who_c); - pir_u->who_c = u3r_string(how); - u3z(how); - } - - // Disable networking for fake ships - // - if ( c3y == pir_u->fak_o ) { - u3_Host.ops_u.net = c3n; - } - - u3z(who); u3z(fak); -} - -/* _pier_boot_create(): create boot controller -*/ -static u3_boot* -_pier_boot_create(u3_pier* pir_u, u3_noun pil, u3_noun ven) -{ - u3_boot* bot_u = c3_calloc(sizeof(u3_boot)); - bot_u->pil = u3k(pil); - bot_u->ven = u3k(ven); - bot_u->pir_u = pir_u; - - return bot_u; -} - -/* _pier_boot_dispose(): dispose of boot controller -*/ -static void -_pier_boot_dispose(u3_boot* bot_u) -{ - u3_pier* pir_u = bot_u->pir_u; - - u3z(bot_u->pil); - u3z(bot_u->ven); - c3_free(bot_u); - pir_u->bot_u = 0; -} - -/* _pier_boot_vent(): create and enqueue boot sequence -** -** per cgy: -** this new boot sequence is almost, but not quite, -** the right thing. see new arvo. -*/ -static void -_pier_boot_vent(u3_boot* bot_u) -{ - // bot: boot formulas - // mod: module ova - // use: userpace ova - // - u3_noun bot, mod, use; - u3_pier* pir_u = bot_u->pir_u; - - // extract boot formulas and module/userspace ova from pill - // - { - u3_noun pil_p, pil_q, pil_r; - u3_noun pro; - - c3_assert( c3y == u3du(bot_u->pil) ); - - if ( c3y == u3h(bot_u->pil) ) { - u3x_trel(bot_u->pil, 0, &pil_p, &pil_q); - } - else { - u3x_qual(bot_u->pil, 0, &pil_p, &pil_q, &pil_r); - } - - pro = u3m_soft(0, u3ke_cue, u3k(pil_p)); - - if ( 0 != u3h(pro) ) { - fprintf(stderr, "boot: failed: unable to parse pill\r\n"); - exit(1); - } - - u3x_trel(u3t(pro), &bot, &mod, &use); - u3k(bot); u3k(mod); u3k(use); - - // optionally replace filesystem in userspace - // - if ( c3y == u3h(bot_u->pil) ) { - if ( u3_nul != pil_q ) { - c3_w len_w = 0; - u3_noun ova = use; - u3_noun new = u3_nul; - u3_noun ovo; - - while ( u3_nul != ova ) { - ovo = u3h(ova); - - if ( c3__into == u3h(u3t(ovo)) ) { - c3_assert( 0 == len_w ); - len_w++; - ovo = u3t(pil_q); - } - - new = u3nc(u3k(ovo), new); - ova = u3t(ova); - } - - c3_assert( 1 == len_w ); - - u3z(use); - use = u3kb_flop(new); - } - } - // prepend %lite module and userspace ova - // - else { - mod = u3kb_weld(u3k(pil_q), mod); - use = u3kb_weld(u3k(pil_r), use); - } - - u3z(pro); - } - - // prepend entropy to the module sequence - // - { - c3_w eny_w[16]; - c3_rand(eny_w); - - u3_noun wir = u3nt(u3_blip, c3__arvo, u3_nul); - u3_noun car = u3nc(c3__wack, u3i_words(16, eny_w)); - - mod = u3nc(u3nc(wir, car), mod); - } - - // prepend identity to the module sequence, setting single-home - // - { - u3_noun wir = u3nt(u3_blip, c3__arvo, u3_nul); - u3_noun car = u3nc(c3__whom, u3i_chubs(2, pir_u->who_d)); - - mod = u3nc(u3nc(wir, car), mod); - } - - // insert boot sequence directly - // - // Note that these are not ovum or (pair @da ovum) events, - // but raw nock formulas to be directly evaluated as the - // subject of the lifecycle formula [%2 [%0 3] %0 2]. - // All subsequent events will be (pair @da ovum). - // - { - u3_noun fol = bot; - - // initialize the boot barrier - // - // And the initial lifecycle boot barrier. - // - pir_u->but_d = u3kb_lent(u3k(fol)); - pir_u->lif_d = pir_u->but_d; - - while ( u3_nul != fol ) { - _pier_writ_insert(pir_u, 0, u3k(u3h(fol))); - fol = u3t(fol); - } - } - - // insert module events - // - { - u3_noun ova = mod; - // add to the boot barrier - // - pir_u->but_d += u3kb_lent(u3k(ova)); - - while ( u3_nul != ova ) { - _pier_writ_insert_ovum(pir_u, 0, u3k(u3h(ova))); - ova = u3t(ova); - } - } - - // insert legacy boot event - // - { - // XX do something about this wire - // XX route directly to %jael? - // - c3_assert( c3y == u3du(bot_u->ven) ); - - u3_noun wir = u3nq(u3_blip, c3__term, '1', u3_nul); - u3_noun car = u3nt(c3__boot, u3_Host.ops_u.lit, u3k(bot_u->ven)); - u3_noun ovo = u3nc(wir, car); - - _pier_writ_insert_ovum(pir_u, 0, ovo); - } - - // insert userspace events - // - // Currently just the initial filesystem - // - { - u3_noun ova = use; - - while ( u3_nul != ova ) { - _pier_writ_insert_ovum(pir_u, 0, u3k(u3h(ova))); - ova = u3t(ova); - } - } - - u3z(bot); u3z(mod); u3z(use); -} - -/* _pier_boot_complete(): start organic event flow on boot/reboot. -*/ -static void -_pier_boot_complete(u3_pier* pir_u) -{ - if ( u3_psat_init != pir_u->sat_e ) { - u3_pier_snap(pir_u); - } - - if ( u3_psat_boot == pir_u->sat_e ) { - fprintf(stderr, "pier: boot complete\r\n"); - } - else if ( u3_psat_pace == pir_u->sat_e ) { - fprintf(stderr, "\n\r---------------- playback complete----------------\r\n"); - } - - pir_u->sat_e = u3_psat_play; - - // the main course - // - _pier_loop_wake(pir_u); - - // XX where should this go? - // - { - if ( c3y == u3_Host.ops_u.veb ) { - u3_term_ef_verb(); - } - } - - { - if ( 0 != u3_Host.ops_u.jin_c ) { - _pier_inject(pir_u, u3_Host.ops_u.jin_c); - } - } -} - -/* _pier_boot_ready(): -*/ -static void -_pier_boot_ready(u3_pier* pir_u) -{ - u3_controller* god_u = pir_u->god_u; - u3_disk* log_u = pir_u->log_u; - - c3_assert( u3_psat_init == pir_u->sat_e ); - - if ( ( 0 == god_u) || - ( 0 == log_u) || - (c3y != god_u->liv_o) || - (c3y != log_u->liv_o) ) - { - return; - } - - // mark all commits as released - // - god_u->rel_d = log_u->com_d; - - // set next expected event number - // - pir_u->gen_d = (1ULL + log_u->com_d); - - // boot - // - if ( 0 != pir_u->bot_u ) { - c3_assert( 0 == log_u->com_d ); - c3_assert( 0 == god_u->dun_d ); - - // construct/enqueue boot sequence - // - _pier_boot_vent(pir_u->bot_u); - _pier_boot_dispose(pir_u->bot_u); - - // prepare worker for boot sequence, write log header - // - _pier_work_boot(pir_u, c3y); - - fprintf(stderr, "boot: ship: %s%s\r\n", - pir_u->who_c, - (c3y == pir_u->fak_o) ? " (fake)" : ""); - - pir_u->sat_e = u3_psat_boot; - } - // replay - // - else if ( god_u->dun_d < log_u->com_d ) { - c3_assert( 0 != log_u->com_d ); - - fprintf(stderr, "---------------- playback starting----------------\r\n"); - - // set the boot barrier to the last committed event - // - pir_u->but_d = log_u->com_d; - - // read the header, setting identity - // - _pier_db_read_header(pir_u); - - // begin queuing batches of committed events - // - _pier_db_load_commits(pir_u, (1ULL + god_u->dun_d), 1000ULL); - - if ( 0 == god_u->dun_d ) { - fprintf(stderr, "pier: replaying events 1 through %" PRIu64 "\r\n", - log_u->com_d); - - // prepare worker for replay of boot sequence, don't write log header - // - _pier_work_boot(pir_u, c3n); - } - else if ( (1ULL + god_u->dun_d) == log_u->com_d ) { - fprintf(stderr, "pier: replaying event %" PRIu64 "\r\n", - log_u->com_d); - } - else { - fprintf(stderr, "pier: replaying events %" PRIu64 - " through %" PRIu64 "\r\n", - (c3_d)(1ULL + god_u->dun_d), - log_u->com_d); - } - - pir_u->sat_e = u3_psat_pace; - } - // resume - // - else { - c3_assert( 0 != log_u->com_d ); - c3_assert( 0 != god_u->dun_d ); - - // set the boot barrier to the last computed event - // - pir_u->but_d = god_u->dun_d; - - // read the header, setting identity - // - _pier_db_read_header(pir_u); - - // resume normal operation - // - _pier_boot_complete(pir_u); - } -} - -/* _pier_apply(): react to i/o, inbound or outbound. -*/ -static void -_pier_apply(u3_pier* pir_u) -{ - u3_disk* log_u = pir_u->log_u; - u3_controller* god_u = pir_u->god_u; - u3_save* sav_u = pir_u->sav_u; - - if ( (0 == log_u) || - (0 == god_u) || - (c3n == god_u->liv_o) || - (u3_psat_init == pir_u->sat_e) ) - { - return; - } - - u3_writ* wit_u; - c3_o act_o = c3n; - -start: - - /* iterate from queue exit, advancing any writs that can advance - */ - wit_u = pir_u->ext_u; - while ( wit_u ) { - /* if writ is (a) next in line to compute, (b) worker is inactive, - ** and (c) a snapshot has not been requested, request computation - */ - if ( (wit_u->evt_d == (1 + god_u->sen_d)) && - (god_u->sen_d == god_u->dun_d) && - (sav_u->dun_d == sav_u->req_d) ) - { - _pier_work_compute(wit_u); - act_o = c3y; - } - - /* if writ is (a) computed and (b) next in line to commit, - ** and (c) no commit is in progress and (d) we've booted, - ** request commit. - */ - if ( (wit_u->evt_d <= god_u->dun_d) && - (wit_u->evt_d == (1 + log_u->moc_d)) && - (wit_u->evt_d == (1 + log_u->com_d)) ) - { - c3_d count = 1 + (god_u->dun_d - wit_u->evt_d); - struct u3_lmdb_write_request* request = - u3_lmdb_build_write_request(wit_u, count); - c3_assert(request != 0); - - _pier_db_commit_request(pir_u, - request, - wit_u->evt_d, - count); - act_o = c3y; - } - - /* if writ is (a) committed and (b) computed, - ** release effects and delete from queue - */ - if ( (wit_u->evt_d <= log_u->com_d) && - (wit_u->evt_d <= god_u->dun_d) ) - { - // effects must be released in order - // - c3_assert(wit_u == pir_u->ext_u); - - // remove from queue - // - // Must be done before releasing effects - // - _pier_writ_unlink(wit_u); - - // release effects - // - _pier_work_release(wit_u); - - // free writ - // - _pier_writ_dispose(wit_u); - - wit_u = pir_u->ext_u; - act_o = c3y; - } - else { - /* otherwise, continue backward - */ - wit_u = wit_u->nex_u; - } - } - - /* if we did anything to the queue, make another pass. - */ - if ( c3y == act_o ) { - act_o = c3n; - goto start; - } -} - -/* _pier_create(): create a pier, loading existing. -*/ -static u3_pier* -_pier_create(c3_w wag_w, c3_c* pax_c) -{ - // create pier - // - u3_pier* pir_u = c3_calloc(sizeof *pir_u); - - pir_u->pax_c = pax_c; - pir_u->wag_w = wag_w; - pir_u->sat_e = u3_psat_init; - - pir_u->sam_u = c3_calloc(sizeof(u3_ames)); - pir_u->por_s = u3_Host.ops_u.por_s; - pir_u->teh_u = c3_calloc(sizeof(u3_behn)); - pir_u->unx_u = c3_calloc(sizeof(u3_unix)); - pir_u->sav_u = c3_calloc(sizeof(u3_save)); - - // initialize persistence - // - if ( c3n == _pier_disk_create(pir_u) ) { - return 0; - } - - // start the worker process - // - if ( !(pir_u->god_u = _pier_work_create(pir_u)) ) { - return 0; - } - - // install in the pier table - // - if ( 0 == u3K.all_w ) { - u3K.all_w = 16; - u3K.tab_u = c3_malloc(16 * sizeof(u3_pier*)); - } - if ( u3K.len_w == u3K.all_w ) { - u3K.all_w = 2 * u3K.all_w; - u3K.tab_u = c3_realloc(u3K.tab_u, u3K.all_w * sizeof(u3_pier*)); - } - u3K.tab_u[u3K.len_w++] = pir_u; - - return pir_u; -} - -/* _pier_inject(): inject raw event at filename -*/ -static void -_pier_inject(u3_pier* pir_u, c3_c* pax_c) -{ - u3_noun ovo = u3ke_cue(u3m_file(pax_c)); - u3m_p("injecting event", u3h(ovo)); - u3_pier_work(pir_u, u3k(u3h(ovo)), u3k(u3t(ovo))); - u3z(ovo); -} - -/* u3_pier_interrupt(): interrupt running process. -*/ -void -u3_pier_interrupt(u3_pier* pir_u) -{ - uv_process_kill(&pir_u->god_u->cub_u, SIGINT); -} - -/* _pier_exit_done(): synchronously shutting down -*/ -static void -_pier_exit_done(u3_pier* pir_u) -{ - u3_pier_db_shutdown(pir_u); - - if ( 0 != pir_u->god_u ) { - _pier_work_shutdown(pir_u); - } - - _pier_loop_exit(pir_u); - - // XX uninstall pier from u3K.tab_u, dispose - - // XX no can do - // - uv_stop(u3L); -} - -/* u3_pier_exit(): trigger a gentle shutdown. -*/ -void -u3_pier_exit(u3_pier* pir_u) -{ - pir_u->sat_e = u3_psat_done; - - // XX must wait for callback confirming - // - u3_pier_snap(pir_u); -} - -/* u3_pier_snap(): request snapshot -*/ -void -u3_pier_snap(u3_pier* pir_u) -{ - u3_controller* god_u = pir_u->god_u; - u3_disk* log_u = pir_u->log_u; - u3_save* sav_u = pir_u->sav_u; - - c3_d top_d = c3_max(god_u->sen_d, god_u->dun_d); - - // no-op if there are no un-snapshot'ed events - // - if ( top_d > sav_u->dun_d ) { - sav_u->req_d = top_d; - - // save eagerly if all computed events are already committed - // - if ( (log_u->com_d >= top_d) && - (god_u->dun_d == top_d) ) { - _pier_work_save(pir_u); - } - } - // if we're gracefully shutting down, do so now - // - else if ( u3_psat_done == pir_u->sat_e ) { - _pier_exit_done(pir_u); - } -} - -/* u3_pier_discover(): insert task into process controller. -*/ -void -u3_pier_discover(u3_pier* pir_u, - c3_l msc_l, - u3_noun job) -{ - _pier_writ_insert(pir_u, msc_l, job); - _pier_loop_resume(pir_u); -} - -/* u3_pier_send(): modern send with target and path. -*/ -void -u3_pier_send(u3_pier* pir_u, u3_noun pax, u3_noun tag, u3_noun fav) +static c3_o +_pier_loop_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) { + u3_reck_kick(car_u->pir_u, u3nc(pax, fav)); + return c3y; } /* u3_pier_work(): send event; real pier pointer. @@ -1905,15 +1345,7 @@ u3_pier_send(u3_pier* pir_u, u3_noun pax, u3_noun tag, u3_noun fav) void u3_pier_work(u3_pier* pir_u, u3_noun pax, u3_noun fav) { - u3_noun now; - struct timeval tim_tv; - - gettimeofday(&tim_tv, 0); - // XX use wit_u->now (currently unused) - // - now = u3_time_in_tv(&tim_tv); - - u3_pier_discover(pir_u, 0, u3nt(now, pax, fav)); + u3_auto_plan(pir_u->car_u, 0, 0, u3_blip, pax, fav); } /* u3_pier_plan(): send event; fake pier pointer @@ -1932,13 +1364,35 @@ void c3_rand(c3_w* rad_w) { if ( 0 != ent_getentropy(rad_w, 64) ) { - u3l_log("c3_rand getentropy: %s\n", strerror(errno)); + fprintf(stderr, "c3_rand getentropy: %s\n", strerror(errno)); // XX review // u3_pier_bail(); } } +/* _pier_exit_done(): synchronously shutting down +*/ +static void +_pier_exit_done(u3_pier* pir_u) +{ + u3_disk_exit(pir_u->log_u); + + if ( 0 != pir_u->god_u ) { + u3_lord_exit(pir_u->god_u, 0); + } + + // XX + // + _pier_loop_exit(pir_u->car_u); + + // XX uninstall pier from u3K.tab_u, dispose + + // XX no can do + // + uv_stop(u3L); +} + /* u3_pier_bail(): immediately shutdown. */ void @@ -1952,10 +1406,10 @@ u3_pier_bail(void) exit(1); } -/* _pier_tape(): dump a tape, old style. Don't do this. +/* _pier_dump_tape(): dump a tape, old style. Don't do this. */ static void -_pier_tape(FILE* fil_u, u3_noun tep) +_pier_dump_tape(FILE* fil_u, u3_noun tep) { u3_noun tap = tep; @@ -1978,15 +1432,15 @@ _pier_tape(FILE* fil_u, u3_noun tep) u3z(tep); } -/* _pier_wall(): dump a wall, old style. Don't do this. +/* _pier_dump_wall(): dump a wall, old style. Don't do this. */ static void -_pier_wall(FILE* fil_u, u3_noun wol) +_pier_dump_wall(FILE* fil_u, u3_noun wol) { u3_noun wal = wol; while ( u3_nul != wal ) { - _pier_tape(fil_u, u3k(u3h(wal))); + _pier_dump_tape(fil_u, u3k(u3h(wal))); putc(13, fil_u); putc(10, fil_u); @@ -2032,7 +1486,7 @@ u3_pier_tank(c3_l tab_l, c3_w pri_w, u3_noun tac) // if ( 0 == u3A->roc ) { if ( c3__leaf == u3h(tac) ) { - _pier_tape(fil_u, u3k(u3t(tac))); + _pier_dump_tape(fil_u, u3k(u3t(tac))); putc(13, fil_u); putc(10, fil_u); } @@ -2042,7 +1496,7 @@ u3_pier_tank(c3_l tab_l, c3_w pri_w, u3_noun tac) else { u3_noun wol = u3dc("wash", u3nc(tab_l, col_l), u3k(tac)); - _pier_wall(fil_u, wol); + _pier_dump_wall(fil_u, wol); } if ( c3n == u3_Host.ops_u.tem ) { @@ -2095,128 +1549,10 @@ u3_pier_stub(void) } } -/* _pier_init(): initialize pier i/o handles -*/ -static void -_pier_init(u3_pier* pir_u) -{ - // initialize i/o handlers - // - _pier_loop_init(pir_u); - - // initialize pre i/o polling handle - // - uv_prepare_init(u3_Host.lup_u, &pir_u->pep_u); - pir_u->pep_u.data = pir_u; - uv_prepare_start(&pir_u->pep_u, _pier_loop_prepare); - - // initialize post i/o polling handle - // - uv_idle_init(u3_Host.lup_u, &pir_u->idl_u); - pir_u->idl_u.data = pir_u; - - _pier_loop_resume(pir_u); -} - -/* u3_pier_boot(): start the new pier system. -*/ -void -u3_pier_boot(c3_w wag_w, // config flags - u3_noun who, // identity - u3_noun ven, // boot event - u3_noun pil, // type-of/path-to pill - u3_noun pax) // path to pier -{ - // make/load pier - // - u3_pier* pir_u = _pier_create(wag_w, u3r_string(pax)); - - if ( 0 == pir_u ) { - u3l_log("pier: failed to create\r\n"); - u3_daemon_bail(); - exit(1); - } - - // set boot params - // - { - pir_u->bot_u = _pier_boot_create(pir_u, pil, ven); - - _pier_boot_set_ship(pir_u, u3k(who), ( c3__fake == u3h(ven) ) ? c3y : c3n); - } - - _pier_init(pir_u); - - u3z(who); u3z(ven); u3z(pil); u3z(pax); -} - -/* u3_pier_stay(): resume the new pier system. -*/ -void -u3_pier_stay(c3_w wag_w, u3_noun pax) -{ - // make/load pier - // - u3_pier* pir_u = _pier_create(wag_w, u3r_string(pax)); - - if ( 0 == pir_u ) { - u3l_log("pier: failed to create\r\n"); - u3_daemon_bail(); - exit(1); - } - - _pier_init(pir_u); - - u3z(pax); -} - /* u3_pier_mark(): mark all Loom allocations in all u3_pier structs. */ c3_w u3_pier_mark(FILE* fil_u) { - c3_w len_w = u3K.len_w; - c3_w tot_w = 0, pir_w = 0; - u3_pier* pir_u; - - while ( 0 < len_w ) { - pir_u = u3K.tab_u[--len_w]; - pir_w = 0; - - if ( 1 < u3K.len_w ) { - fprintf(fil_u, "pier: %u\r\n", len_w); - } - - if ( 0 != pir_u->bot_u ) { - pir_w += u3a_maid(fil_u, " boot event", u3a_mark_noun(pir_u->bot_u->ven)); - pir_w += u3a_maid(fil_u, " pill", u3a_mark_noun(pir_u->bot_u->pil)); - } - - { - u3_writ* wit_u = pir_u->ext_u; - c3_w len_w = 0, tim_w = 0, job_w = 0, mat_w = 0, act_w =0; - - while ( 0 != wit_u ) { - tim_w += u3a_mark_noun(wit_u->now); - job_w += u3a_mark_noun(wit_u->job); - mat_w += u3a_mark_noun(wit_u->mat); - act_w += u3a_mark_noun(wit_u->act); - len_w++; - wit_u = wit_u->nex_u; - } - - if ( 0 < len_w ) { - fprintf(fil_u, " marked %u writs\r\n", len_w); - } - - pir_w += u3a_maid(fil_u, " timestamps", tim_w); - pir_w += u3a_maid(fil_u, " events", job_w); - pir_w += u3a_maid(fil_u, " encoded events", mat_w); - pir_w += u3a_maid(fil_u, " pending effects", act_w); - - tot_w += u3a_maid(fil_u, "total pier stuff", pir_w); - } - } - - return tot_w; + return 0; } diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c deleted file mode 100644 index 245203e53..000000000 --- a/pkg/urbit/worker/main.c +++ /dev/null @@ -1,1100 +0,0 @@ -/* worker/main.c -** -** the main loop of a worker process. -*/ -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "all.h" -#include - - typedef struct _u3_worker { - c3_w len_w; // boot sequence length - u3_noun roe; // lifecycle formulas - c3_d sen_d; // last event requested - c3_d dun_d; // last event processed - c3_l mug_l; // hash of state - c3_d key_d[4]; // disk key - u3_moat inn_u; // message input - u3_mojo out_u; // message output - c3_c* dir_c; // execution directory (pier) - } u3_worker; - static u3_worker u3V; - -/* -:: worker to daemon protocol -:: -|% -:: +plea: from worker to daemon -:: -+$ plea - $% :: status on startup - :: - :: p: event number expected - :: q: mug of kernel (or 0) - :: - [%play p=@ q=@] - :: event executed unchanged (in response to %work) - :: - $: %done - :: p: event number - :: q: mug of kernel - :: r: effects - :: - [p=@ q=@ r=(list ovum)] - == - :: replace event and retry (in response to %work) - :: - $: %work - :: p: event number - :: q: mug of kernel - :: r: replacement event (at date) - :: - [p=@ q=@ r=(pair date ovum)] - == - :: sends a line to stderr while computing event - :: - $: %stdr - :: p: event number - :: q: output cord - :: - [p=@ q=cord] - == - :: send slog hint while computing event - :: - $: %slog - :: p: event number - :: q: priority - :: r: output tank - :: - [p=@ q=@ r=tank] - == == -:: +writ: from daemon to worker -:: -+$ writ - $% :: prepare to boot - :: - :: p: length of lifecycle sequence - :: - [%boot p=@] - :: exit immediately - :: - :: p: exit code - :: - [%exit p=@] - :: save snapshot to disk - :: - :: p: event number - :: - [%save p=@] - :: execute event - :: - $: %work - :: p: event number - :: q: a jammed noun [mug [date ovum]] - :: - [p=@ q=@] - == == --- -*/ - -/* _worker_space(): print n spaces. -*/ -void _worker_space(FILE* fil_u, c3_w n) -{ - for (; n > 0; n--) - (fprintf(fil_u," ")); -} - -/* _worker_print_memory(): print memory amount. -** -** Helper for _worker_prof(), just an un-captioned u3a_print_memory(). -*/ -void -_worker_print_memory(FILE* fil_u, c3_w wor_w) -{ - c3_w byt_w = (wor_w * 4); - c3_w gib_w = (byt_w / 1000000000); - c3_w mib_w = (byt_w % 1000000000) / 1000000; - c3_w kib_w = (byt_w % 1000000) / 1000; - c3_w bib_w = (byt_w % 1000); - - if ( gib_w ) { - (fprintf(fil_u, "GB/%d.%03d.%03d.%03d\r\n", - gib_w, mib_w, kib_w, bib_w)); - } - else if ( mib_w ) { - (fprintf(fil_u, "MB/%d.%03d.%03d\r\n", mib_w, kib_w, bib_w)); - } - else if ( kib_w ) { - (fprintf(fil_u, "KB/%d.%03d\r\n", kib_w, bib_w)); - } - else { - (fprintf(fil_u, "B/%d\r\n", bib_w)); - } -} - -/* _worker_prof(): print memory profile. RETAIN. -*/ -c3_w -_worker_prof(FILE* fil_u, c3_w den, u3_noun mas) -{ - c3_w tot_w = 0; - u3_noun h_mas, t_mas; - - if ( c3n == u3r_cell(mas, &h_mas, &t_mas) ) { - _worker_space(fil_u, den); - fprintf(fil_u, "mistyped mass\r\n"); - return tot_w; - } - else if ( _(u3du(h_mas)) ) { - _worker_space(fil_u, den); - fprintf(fil_u, "mistyped mass head\r\n"); - { - c3_c* lab_c = u3m_pretty(h_mas); - fprintf(fil_u, "h_mas: %s", lab_c); - c3_free(lab_c); - } - return tot_w; - } - else { - _worker_space(fil_u, den); - - { - c3_c* lab_c = u3m_pretty(h_mas); - fprintf(fil_u, "%s: ", lab_c); - c3_free(lab_c); - } - - u3_noun it_mas, tt_mas; - - if ( c3n == u3r_cell(t_mas, &it_mas, &tt_mas) ) { - fprintf(fil_u, "mistyped mass tail\r\n"); - return tot_w; - } - else if ( c3y == it_mas ) { - tot_w += u3a_mark_noun(tt_mas); - _worker_print_memory(fil_u, tot_w); - -#if 1 - /* The basic issue here is that tt_mas is included in .sac - * (the whole profile), so they can't both be roots in the - * normal sense. When we mark .sac later on, we want tt_mas - * to appear unmarked, but its children should be already - * marked. - */ - if ( _(u3a_is_dog(tt_mas)) ) { - u3a_box* box_u = u3a_botox(u3a_to_ptr(tt_mas)); -#ifdef U3_MEMORY_DEBUG - if ( 1 == box_u->eus_w ) { - box_u->eus_w = 0xffffffff; - } - else { - box_u->eus_w -= 1; - } -#else - if ( -1 == (c3_w)box_u->use_w ) { - box_u->use_w = 0x80000000; - } - else { - box_u->use_w += 1; - } -#endif - } -#endif - - return tot_w; - } - else if ( c3n == it_mas ) { - fprintf(fil_u, "\r\n"); - - while ( _(u3du(tt_mas)) ) { - tot_w += _worker_prof(fil_u, den+2, u3h(tt_mas)); - tt_mas = u3t(tt_mas); - } - - _worker_space(fil_u, den); - fprintf(fil_u, "--"); - _worker_print_memory(fil_u, tot_w); - - return tot_w; - - } - else { - _worker_space(fil_u, den); - fprintf(fil_u, "mistyped (strange) mass tail\r\n"); - return tot_w; - } - } -} - -/* _worker_grab(): garbage collect, checking for profiling. RETAIN. -*/ -static void -_worker_grab(u3_noun sac, u3_noun ovo, u3_noun vir) -{ - if ( u3_nul == sac) { - if ( u3C.wag_w & (u3o_debug_ram | u3o_check_corrupt) ) { - u3m_grab(sac, ovo, vir, u3_none); - } - } - else { - c3_w tot_w = 0; - FILE* fil_u; - -#ifdef U3_MEMORY_LOG - { - u3_noun wen = u3dc("scot", c3__da, u3k(u3A->now)); - c3_c* wen_c = u3r_string(wen); - - c3_c nam_c[2048]; - snprintf(nam_c, 2048, "%s/.urb/put/mass", u3P.dir_c); - - struct stat st; - if ( -1 == stat(nam_c, &st) ) { - mkdir(nam_c, 0700); - } - - c3_c man_c[2048]; - snprintf(man_c, 2048, "%s/%s-worker.txt", nam_c, wen_c); - - fil_u = fopen(man_c, "w"); - fprintf(fil_u, "%s\r\n", wen_c); - - c3_free(wen_c); - u3z(wen); - } -#else - { - fil_u = stderr; - } -#endif - - c3_assert( u3R == &(u3H->rod_u) ); - fprintf(fil_u, "\r\n"); - - tot_w += u3a_maid(fil_u, "total userspace", _worker_prof(fil_u, 0, sac)); - tot_w += u3m_mark(fil_u); - tot_w += u3a_maid(fil_u, "space profile", u3a_mark_noun(sac)); - tot_w += u3a_maid(fil_u, "event", u3a_mark_noun(ovo)); - tot_w += u3a_maid(fil_u, "lifecycle events", u3a_mark_noun(u3V.roe)); - tot_w += u3a_maid(fil_u, "effects", u3a_mark_noun(vir)); - - u3a_print_memory(fil_u, "total marked", tot_w); - u3a_print_memory(fil_u, "free lists", u3a_idle(u3R)); - u3a_print_memory(fil_u, "sweep", u3a_sweep()); - - fflush(fil_u); - -#ifdef U3_MEMORY_LOG - { - fclose(fil_u); - } -#endif - } -} - -/* _worker_static_grab(): garbage collect, checking for profiling. RETAIN. -*/ -static void -_worker_static_grab(void) -{ - c3_assert( u3R == &(u3H->rod_u) ); - - fprintf(stderr, "work: measuring memory:\r\n"); - u3a_print_memory(stderr, "total marked", u3m_mark(stderr)); - u3a_print_memory(stderr, "free lists", u3a_idle(u3R)); - u3a_print_memory(stderr, "sweep", u3a_sweep()); - fprintf(stderr, "\r\n"); - fflush(stderr); -} - -/* _worker_pack(): deduplicate and compact memory -*/ -static void -_worker_pack(void) -{ - _worker_static_grab(); - u3l_log("work: compacting loom\r\n"); - - if ( c3n == u3m_rock_stay(u3V.dir_c, u3V.dun_d) ) { - u3l_log("work: unable to jam state\r\n"); - return; - } - - if ( c3n == u3e_hold() ) { - u3l_log("work: unable to backup checkpoint\r\n"); - return; - } - - u3m_wipe(); - - if ( c3n == u3m_rock_load(u3V.dir_c, u3V.dun_d) ) { - u3l_log("work: compaction failed, restoring checkpoint\r\n"); - - if ( c3n == u3e_fall() ) { - fprintf(stderr, "work: unable to restore checkpoint\r\n"); - c3_assert(0); - } - } - - if ( c3n == u3e_drop() ) { - u3l_log("work: warning: orphaned backup checkpoint file\r\n"); - } - - if ( c3n == u3m_rock_drop(u3V.dir_c, u3V.dun_d) ) { - u3l_log("work: warning: orphaned state file\r\n"); - } - - u3l_log("work: compacted loom\r\n"); - _worker_static_grab(); -} - -/* _worker_fail(): failure stub. -*/ -static void -_worker_fail(void* vod_p, const c3_c* wut_c) -{ - fprintf(stderr, "work: fail: %s\r\n", wut_c); - exit(1); -} - -/* _worker_send(): send result back to daemon. -*/ -static void -_worker_send(u3_noun job) -{ - u3_newt_write(&u3V.out_u, u3ke_jam(job), 0); -} - -/* _worker_send_replace(): send replacement job back to daemon. -*/ -static void -_worker_send_replace(c3_d evt_d, u3_noun job) -{ - _worker_send(u3nt(c3__work, - u3i_chubs(1, &evt_d), - u3ke_jam(u3nc(u3V.mug_l, job)))); -} - -/* _worker_send_complete(): report completion. -*/ -static void -_worker_send_complete(u3_noun vir) -{ - _worker_send(u3nq(c3__done, - u3i_chubs(1, &u3V.dun_d), - u3V.mug_l, - vir)); -} - -/* _worker_send_stdr(): send stderr output -*/ -static void -_worker_send_stdr(c3_c* str_c) -{ - _worker_send(u3nt(c3__stdr, u3i_chubs(1, &u3V.sen_d), u3i_string(str_c))); -} - -/* _worker_send_slog(): send hint output (hod is [priority tank]). -*/ -static void -_worker_send_slog(u3_noun hod) -{ - _worker_send(u3nt(c3__slog, u3i_chubs(1, &u3V.sen_d), hod)); -} - -/* _worker_lame(): event failed, replace with error event. -*/ -static void -_worker_lame(u3_noun now, u3_noun ovo, u3_noun why, u3_noun tan) -{ - u3_noun rep; - u3_noun wir, tag, cad; - c3_o pac_o = c3n; - c3_d evt_d = u3V.sen_d; - - u3V.sen_d = u3V.dun_d; - - u3x_trel(ovo, &wir, &tag, &cad); - - // failed event notifications (%crud) are replaced with - // an even more generic notifications, on a generic arvo wire. - // N.B this must not be allowed to fail! - // - // [%warn original-event-tag=@tas combined-trace=(list tank)] - // - if ( c3__crud == tag ) { - u3_noun lef = u3nc(c3__leaf, u3i_tape("crude crashed!")); - u3_noun nat = u3kb_weld(u3k(u3t(u3h(cad))), u3nc(lef, u3k(tan))); - rep = u3nc(u3nt(u3_blip, c3__arvo, u3_nul), - u3nt(c3__warn, u3k(u3h(u3t(cad))), nat)); - } - // failed failure failing fails - // - else if ( c3__warn == tag ) { - _worker_fail(0, "%warn replacement event failed"); - c3_assert(0); - } - // failure notifications are sent on the same wire - // - // [%crud =goof =ovum] - // - else { - // prepend failure mote to tank - // - u3_noun lef = u3nc(c3__leaf, u3kb_weld(u3i_tape("bail: "), - u3qc_rip(3, why))); - u3_noun nat = u3kb_weld(u3k(tan), u3nc(lef, u3_nul)); - rep = u3nc(u3k(wir), u3nt(c3__crud, - u3nc(u3k(why), nat), - u3nc(u3k(tag), u3k(cad)))); - } - - pac_o = _(c3__meme == why); - - _worker_send_replace(evt_d, u3nc(now, rep)); - - u3z(ovo); u3z(why); u3z(tan); - - // XX review, always pack on meme? - // - if ( c3y == pac_o ) { - _worker_pack(); - } -} - -/* _worker_sure_feck(): event succeeded, send effects. -*/ -static void -_worker_sure_feck(u3_noun ovo, u3_noun vir, c3_w pre_w) -{ - u3_noun sac = u3_nul; - c3_o pac_o = c3n; - c3_o rec_o = c3n; - - // intercept |mass, observe |reset - // - { - u3_noun riv = vir; - c3_w i_w = 0; - - while ( u3_nul != riv ) { - u3_noun fec = u3t(u3h(riv)); - - // assumes a max of one %mass effect per event - // - if ( c3__mass == u3h(fec) ) { - // save a copy of the %mass data - // - sac = u3k(u3t(fec)); - // replace the %mass data with ~ - // - // For efficient transmission to daemon. - // - riv = u3kb_weld(u3qb_scag(i_w, vir), - u3nc(u3nt(u3k(u3h(u3h(riv))), c3__mass, u3_nul), - u3qb_slag(1 + i_w, vir))); - u3z(vir); - vir = riv; - break; - } - - // reclaim memory from persistent caches on |reset - // - if ( c3__vega == u3h(fec) ) { - rec_o = c3y; - } - - // pack memory on |pack - // - if ( c3__pack == u3h(fec) ) { - pac_o = c3y; - } - - riv = u3t(riv); - i_w++; - } - } - - // after a successful event, we check for memory pressure. - // - // if we've exceeded either of two thresholds, we reclaim - // from our persistent caches, and notify the daemon - // (via a "fake" effect) that arvo should trim state - // (trusting that the daemon will enqueue an appropriate event). - // For future flexibility, the urgency of the notification is represented - // by a *decreasing* number: 0 is maximally urgent, 1 less so, &c. - // - // high-priority: 2^22 contiguous words remaining (~8 MB) - // low-priority: 2^27 contiguous words remaining (~536 MB) - // XX maybe use 2^23 (~16 MB) and 2^26 (~268 MB? - // - { - u3_noun pri = u3_none; - c3_w pos_w = u3a_open(u3R); - c3_w low_w = (1 << 27); - c3_w hig_w = (1 << 22); - - if ( (pre_w > low_w) && !(pos_w > low_w) ) { - // XX set flag(s) in u3V so we don't repeat endlessly? - // XX pack here too? - // - pac_o = c3y; - rec_o = c3y; - pri = 1; - } - else if ( (pre_w > hig_w) && !(pos_w > hig_w) ) { - // XX we should probably jam/cue our entire state at this point - // - pac_o = c3y; - rec_o = c3y; - pri = 0; - } - // reclaim memory from persistent caches periodically - // - // XX this is a hack to work two things - // - bytecode caches grow rapidly and can't be simply capped - // - we don't make very effective use of our free lists - // - else { - rec_o = _(0 == (u3V.dun_d % 1000ULL)); - } - - // notify daemon of memory pressure via "fake" effect - // - if ( u3_none != pri ) { - u3_noun cad = u3nc(u3nt(u3_blip, c3__arvo, u3_nul), - u3nc(c3__trim, pri)); - vir = u3nc(cad, vir); - } - } - - if ( c3y == rec_o ) { - u3m_reclaim(); - } - - // XX this runs on replay too - // - _worker_grab(sac, ovo, vir); - _worker_send_complete(vir); - - u3z(sac); u3z(ovo); - - if ( c3y == pac_o ) { - _worker_pack(); - } -} - -/* _worker_sure_core(): event succeeded, save state. -*/ -static void -_worker_sure_core(u3_noun cor) -{ - u3V.dun_d = u3V.sen_d; - - u3z(u3A->roc); - u3A->roc = cor; - u3A->ent_d = u3V.dun_d; - u3V.mug_l = u3r_mug(u3A->roc); -} - -/* _worker_work_live(): apply event. -*/ -static void -_worker_work_live(c3_d evt_d, u3_noun job) -{ - u3_noun now, ovo, gon, last_date; - c3_w pre_w = u3a_open(u3R); - - c3_assert(evt_d == u3V.dun_d + 1ULL); - u3V.sen_d = evt_d; - - u3x_cell(job, &now, &ovo); - - last_date = u3A->now; - u3A->now = u3k(now); - -#ifdef U3_EVENT_TIME_DEBUG - struct timeval b4, f2, d0; - gettimeofday(&b4, 0); - - if ( c3__belt != u3h(u3t(ovo)) ) { - c3_c* txt_c = u3r_string(u3h(u3t(ovo))); - - u3l_log("work: %s (%" PRIu64 ") live\r\n", txt_c, evt_d); - } -#endif - - gon = u3m_soft(0, u3v_poke, u3k(ovo)); - -#ifdef U3_EVENT_TIME_DEBUG - { - c3_c* txt_c = u3r_string(u3h(u3t(ovo))); - c3_w ms_w; - c3_w clr_w; - - gettimeofday(&f2, 0); - timersub(&f2, &b4, &d0); - ms_w = (d0.tv_sec * 1000) + (d0.tv_usec / 1000); - clr_w = ms_w > 1000 ? 1 : ms_w < 100 ? 2 : 3; // red, green, yellow - if (c3__belt != u3h(u3t(ovo)) || clr_w != 2) { - u3l_log("\x1b[3%dm%%%s (%" PRIu64 ") %4d.%02dms\x1b[0m\n", - clr_w, txt_c, evt_d, ms_w, - (int) (d0.tv_usec % 1000) / 10); - } - c3_free(txt_c); - } -#endif - - // event rejected - // - if ( u3_blip != u3h(gon) ) { - // restore previous time - // - u3_noun nex = u3A->now; - u3A->now = last_date; - - u3_noun why, tan; - u3x_cell(gon, &why, &tan); - - u3k(ovo); u3k(why); u3k(tan); - u3z(gon); u3z(job); - - _worker_lame(nex, ovo, why, tan); - } - // event accepted - // - else { - // vir/(list ovum) list of effects - // cor/arvo arvo core - // - u3_noun vir, cor; - u3x_trel(gon, 0, &vir, &cor); - - u3k(ovo); u3k(vir); u3k(cor); - u3z(gon); u3z(job); u3z(last_date); - - _worker_sure_core(cor); - _worker_sure_feck(ovo, vir, pre_w); - } -} - -/* _worker_work_boot(): apply initial-stage event. -*/ -static void -_worker_work_boot(c3_d evt_d, u3_noun job) -{ - // here we asset on u3V.sen_d, because u3V.dun_d isn't set until - // after u3V.sen_d == u3V.len_w (ie, after the lifecycle evaluation) - // - c3_assert(evt_d == u3V.sen_d + 1ULL); - u3V.sen_d = evt_d; - - u3V.roe = u3nc(job, u3V.roe); - - u3l_log("work: (%" PRIu64 ")| boot\r\n", evt_d); - - if ( u3V.len_w == evt_d ) { - u3_noun eve = u3kb_flop(u3V.roe); - u3V.roe = u3_nul; - - u3l_log("work: (%" PRIu64 ")| pill: %x\r\n", evt_d, u3r_mug(eve)); - - if ( c3n == u3v_boot(eve) ) { - u3l_log("work: boot failed: invalid sequence (from pill)\r\n"); - exit(1); - } - - u3V.dun_d = evt_d; - u3V.mug_l = u3r_mug(u3A->roc); - u3A->ent_d = u3V.dun_d; - - u3l_log("work: (%" PRIu64 ")| core: %x\r\n", evt_d, u3V.mug_l); - } - else { - // prior to the evaluation of the entire lifecycle sequence, - // we simply use the mug of the formula as the kernel mug - // - u3V.mug_l = u3r_mug(job); - } - - _worker_send(u3nq(c3__done, - u3i_chubs(1, &evt_d), - u3V.mug_l, - u3_nul)); -} - -/* _worker_poke_work(): apply event. -*/ -static void -_worker_poke_work(c3_d evt_d, // event number - c3_l mug_l, // mug of state - u3_noun job) // full event -{ - if ( u3C.wag_w & u3o_trace ) { - if ( u3_Host.tra_u.con_w == 0 && u3_Host.tra_u.fun_w == 0 ) { - u3t_trace_open(u3V.dir_c); - } - else if ( u3_Host.tra_u.con_w >= 100000 ) { - u3t_trace_close(); - u3t_trace_open(u3V.dir_c); - } - } - - // Require mugs to match - // - // We use mugs to enforce that %work is always performed against - // the exact kernel we expect it to be. If it isn't, we have either - // event-log corruption or non-determism on replay, or programmer error - // in normal operation. In either case, we immediately exit. - // - if ( u3V.mug_l != mug_l ) { - u3l_log("work: invalid %%work for event %" PRIu64 ".\r\n", evt_d); - u3l_log("work: computed mug is %x but event %" PRIu64 " expected %x.\r\n", - u3V.mug_l, - evt_d, - mug_l); - _worker_fail(0, "bad jar"); - return; - } - - if ( evt_d <= u3V.len_w ) { - c3_c lab_c[8]; - snprintf(lab_c, 8, "boot: %" PRIu64 "", evt_d); - - u3t_event_trace(lab_c, 'B'); - _worker_work_boot(evt_d, job); - u3t_event_trace(lab_c, 'E'); - } - else { - u3_noun wir = u3h(u3t(job)); - u3_noun cad = u3h(u3t(u3t(job))); - - // XX these allocations should only be performed if tracing is enabled - // - c3_c lab_c[2048]; - { - c3_c* cad_c = u3m_pretty(cad); - c3_c* wir_c = u3m_pretty_path(wir); - snprintf(lab_c, 2048, "event %" PRIu64 ": [%s %s]", - evt_d, wir_c, cad_c); - c3_free(cad_c); - c3_free(wir_c); - } - - u3t_event_trace(lab_c, 'B'); - _worker_work_live(evt_d, job); - u3t_event_trace(lab_c, 'E'); - } -} - -/* _worker_poke_exit(): exit on command. -*/ -static void -_worker_poke_exit(c3_w cod_w) // exit code -{ - if ( u3C.wag_w & u3o_debug_cpu ) { - FILE* fil_u; - - { - u3_noun wen = u3dc("scot", c3__da, u3k(u3A->now)); - c3_c* wen_c = u3r_string(wen); - - c3_c nam_c[2048]; - snprintf(nam_c, 2048, "%s/.urb/put/profile", u3P.dir_c); - - struct stat st; - if ( -1 == stat(nam_c, &st) ) { - mkdir(nam_c, 0700); - } - - c3_c man_c[2048]; - snprintf(man_c, 2048, "%s/%s.txt", nam_c, wen_c); - - fil_u = fopen(man_c, "w"); - - c3_free(wen_c); - u3z(wen); - } - - u3t_damp(fil_u); - - { - fclose(fil_u); - } - } - - // XX move to jets.c - // - c3_free(u3D.ray_u); - - exit(cod_w); -} - -/* _worker_poke_boot(): prepare to boot. -*/ -static void -_worker_poke_boot(c3_w len_w) -{ - c3_assert( 0 != len_w ); - u3V.len_w = len_w; -} - -/* _worker_poke(): -*/ -void -_worker_poke(void* vod_p, u3_noun mat) -{ - u3_noun jar = u3ke_cue(mat); - - if ( c3y != u3du(jar) ) { - goto error; - } - else { - switch ( u3h(jar) ) { - default: { - goto error; - } - - case c3__boot: { - u3_noun len; - c3_w len_w; - - if ( (c3n == u3r_cell(jar, 0, &len)) || - (c3n == u3ud(len)) || - (1 < u3r_met(3, len)) ) - { - goto error; - } - - len_w = u3r_word(0, len); - u3z(jar); - return _worker_poke_boot(len_w); - } - - case c3__work: { - u3_noun evt, jammed_entry, mug, job; - c3_d evt_d; - c3_l mug_l; - - if ( (c3n == u3r_trel(jar, 0, &evt, &jammed_entry)) || - (c3n == u3ud(evt)) || - (1 != u3r_met(6, evt)) ) - { - goto error; - } - - u3_noun entry = u3qe_cue(jammed_entry); - if ( (c3y != u3du(entry)) || - (c3n == u3r_cell(entry, &mug, &job)) || - (c3n == u3ud(mug)) || - (1 < u3r_met(5, mug)) ) { - goto error; - } - - evt_d = u3r_chub(0, evt); - mug_l = u3r_word(0, mug); - u3k(job); - u3z(entry); - u3z(jar); - - return _worker_poke_work(evt_d, mug_l, job); - } - - case c3__exit: { - u3_noun cod; - c3_w cod_w; - - if ( (c3n == u3r_cell(jar, 0, &cod)) || - (c3n == u3ud(cod)) || - (1 < u3r_met(3, cod)) ) - { - goto error; - } - - cod_w = u3r_word(0, cod); - u3z(jar); - - return _worker_poke_exit(cod_w); - } - - case c3__save: { - u3_noun evt; - c3_d evt_d; - - if ( (c3n == u3r_cell(jar, 0, &evt)) || - (c3n == u3ud(evt)) ) - { - goto error; - } - - evt_d = u3r_chub(0, evt); - u3z(jar); - - c3_assert( evt_d == u3V.dun_d ); - - return u3e_save(); - } - } - } - - error: { - u3z(jar); - _worker_fail(0, "bad jar"); - } -} - -/* u3_worker_boot(): send startup message to manager. -*/ -void -u3_worker_boot(void) -{ - c3_d nex_d = 1ULL; - - // if a lifecycle sequence is needed, [len_w] will be set on %boot - // - u3V.len_w = 0; - - if ( 0 != u3V.dun_d ) { - u3V.mug_l = u3r_mug(u3A->roc); - nex_d += u3V.dun_d; - } - else { - u3V.mug_l = 0; - } - - u3l_log("work: play %" PRIu64 "\r\n", nex_d); - - _worker_send(u3nt(c3__play, u3i_chubs(1, &nex_d), u3V.mug_l)); - - // measure/print static memory usage if < 1/2 of the loom is available - // - { - c3_w pen_w = u3a_open(u3R); - - if ( !(pen_w > (1 << 28)) ) { - fprintf(stderr, "\r\n"); - u3a_print_memory(stderr, "work: contiguous free space", pen_w); - _worker_static_grab(); - } - } -} - -/* main(): main() when run as urbit-worker -*/ -c3_i -main(c3_i argc, c3_c* argv[]) -{ - // the worker is spawned with [FD 0] = events and [FD 1] = effects - // we dup [FD 0 & 1] so we don't accidently use them for something else - // we replace [FD 0] (stdin) with a fd pointing to /dev/null - // we replace [FD 1] (stdout) with a dup of [FD 2] (stderr) - // - c3_i nul_i = open("/dev/null", O_RDWR, 0); - c3_i inn_i = dup(0); - c3_i out_i = dup(1); - dup2(nul_i, 0); - dup2(2, 1); - close(nul_i); - - uv_loop_t* lup_u = uv_default_loop(); - c3_c* dir_c = argv[1]; - c3_c* key_c = argv[2]; - c3_c* wag_c = argv[3]; - - c3_assert(4 == argc); - - memset(&u3V, 0, sizeof(u3V)); - memset(&u3_Host.tra_u, 0, sizeof(u3_Host.tra_u)); - - /* load passkey - */ - { - sscanf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", - &u3V.key_d[0], - &u3V.key_d[1], - &u3V.key_d[2], - &u3V.key_d[3]); - } - - /* load runtime config - */ - { - sscanf(wag_c, "%" SCNu32, &u3C.wag_w); - } - - /* load pier directory - */ - { - u3V.dir_c = strdup(dir_c); - } - - /* boot image - */ - { - u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); - u3C.stderr_log_f = _worker_send_stdr; - u3C.slog_f = _worker_send_slog; - } - - // Ignore SIGPIPE signals. - // - { - struct sigaction sig_s = {{0}}; - sigemptyset(&(sig_s.sa_mask)); - sig_s.sa_handler = SIG_IGN; - sigaction(SIGPIPE, &sig_s, 0); - } - - /* configure pipe to daemon process - */ - { - c3_i err_i; - - err_i = uv_pipe_init(lup_u, &u3V.inn_u.pyp_u, 0); - c3_assert(!err_i); - uv_pipe_open(&u3V.inn_u.pyp_u, inn_i); - - err_i = uv_pipe_init(lup_u, &u3V.out_u.pyp_u, 0); - c3_assert(!err_i); - uv_pipe_open(&u3V.out_u.pyp_u, out_i); - } - - /* set up writing - */ - u3V.out_u.bal_f = _worker_fail; - - /* start reading - */ - u3V.inn_u.vod_p = &u3V; - u3V.inn_u.pok_f = _worker_poke; - u3V.inn_u.bal_f = _worker_fail; - - u3_newt_read(&u3V.inn_u); - - /* send start request - */ - u3_worker_boot(); - - /* enter loop - */ - uv_run(lup_u, UV_RUN_DEFAULT); - return 0; -} diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 0c64acc05..9f8d9b956 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -1042,7 +1042,7 @@ u3_serf_boot(void) /* main(): main() when run as urbit-worker */ c3_i -mmain(c3_i argc, c3_c* argv[]) +main(c3_i argc, c3_c* argv[]) { // the serf is spawned with [FD 0] = events and [FD 1] = effects // we dup [FD 0 & 1] so we don't accidently use them for something else From 33a98d1e2eefe868a6a7535c766fd34cc09a160e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 16 Apr 2020 16:41:48 -0700 Subject: [PATCH 012/257] vere: distinguishes lmdb error messages --- pkg/urbit/vere/lmdb.c | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/pkg/urbit/vere/lmdb.c b/pkg/urbit/vere/lmdb.c index d3835d364..0d766d3da 100644 --- a/pkg/urbit/vere/lmdb.c +++ b/pkg/urbit/vere/lmdb.c @@ -277,7 +277,7 @@ static void _u3_lmdb_write_event_cb(uv_work_t* req) { 0, /* flags */ &transaction_u); if (0 != ret_w) { - u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: write: txn_begin fail: %s\n", mdb_strerror(ret_w)); return; } @@ -289,7 +289,7 @@ static void _u3_lmdb_write_event_cb(uv_work_t* req) { flags_w, &database_u); if (0 != ret_w) { - u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: write: dbi_open fail: %s\n", mdb_strerror(ret_w)); return; } @@ -405,7 +405,7 @@ u3_lmdb_read_events(MDB_env* db_u, MDB_RDONLY, /* flags */ &transaction_u); if (0 != ret_w) { - u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: read txn_begin fail: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -417,7 +417,7 @@ u3_lmdb_read_events(MDB_env* db_u, flags_w, &database_u); if (0 != ret_w) { - u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: read: dbi_open fail: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -425,7 +425,7 @@ u3_lmdb_read_events(MDB_env* db_u, MDB_cursor* cursor_u; ret_w = mdb_cursor_open(transaction_u, database_u, &cursor_u); if (0 != ret_w) { - u3l_log("lmdb: cursor_open fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: read: cursor_open fail: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -437,7 +437,7 @@ u3_lmdb_read_events(MDB_env* db_u, ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_SET_KEY); if (0 != ret_w) { - u3l_log("lmdb: could not find initial event %" PRIu64 ": %s\r\n", + u3l_log("lmdb: read: could not find initial event %" PRIu64 ": %s\r\n", first_event_d, mdb_strerror(ret_w)); mdb_cursor_close(cursor_u); return c3n; @@ -449,11 +449,11 @@ u3_lmdb_read_events(MDB_env* db_u, // the sequence of loaded events. c3_d current_id = first_event_d + loaded; if (key.mv_size != sizeof(c3_d)) { - u3l_log("lmdb: invalid cursor key\r\n"); + u3l_log("lmdb: read: invalid cursor key\r\n"); return c3n; } if (*(c3_d*)key.mv_data != current_id) { - u3l_log("lmdb: missing event in database. Expected %" PRIu64 ", received %" + u3l_log("lmdb: read: missing event in database. Expected %" PRIu64 ", received %" PRIu64 "\r\n", current_id, *(c3_d*)key.mv_data); @@ -470,7 +470,7 @@ u3_lmdb_read_events(MDB_env* db_u, ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_NEXT); if (ret_w != 0 && ret_w != MDB_NOTFOUND) { - u3l_log("lmdb: error while loading events: %s\r\n", + u3l_log("lmdb: read: error while loading events: %s\r\n", mdb_strerror(ret_w)); return c3n; } @@ -499,7 +499,7 @@ c3_o u3_lmdb_get_latest_event_number(MDB_env* environment, c3_d* event_number) 0, /* flags */ &transaction_u); if (0 != ret_w) { - u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: last: txn_begin fail: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -511,7 +511,7 @@ c3_o u3_lmdb_get_latest_event_number(MDB_env* environment, c3_d* event_number) flags_w, &database_u); if (0 != ret_w) { - u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: last: dbi_open fail: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -519,7 +519,7 @@ c3_o u3_lmdb_get_latest_event_number(MDB_env* environment, c3_d* event_number) MDB_cursor* cursor_u; ret_w = mdb_cursor_open(transaction_u, database_u, &cursor_u); if (0 != ret_w) { - u3l_log("lmdb: cursor_open fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: last: cursor_open fail: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -569,7 +569,7 @@ c3_o u3_lmdb_write_identity(MDB_env* environment, 0, /* flags */ &transaction_u); if (0 != ret_w) { - u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: meta write: txn_begin fail: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -581,7 +581,7 @@ c3_o u3_lmdb_write_identity(MDB_env* environment, flags_w, &database_u); if (0 != ret_w) { - u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: meta write: dbi_open fail: %s\n", mdb_strerror(ret_w)); mdb_txn_abort(transaction_u); return c3n; } @@ -608,7 +608,7 @@ c3_o u3_lmdb_write_identity(MDB_env* environment, ret_w = mdb_txn_commit(transaction_u); if (0 != ret_w) { - u3l_log("lmdb: failed to commit transaction: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: meta write: failed to commit transaction: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -629,7 +629,7 @@ c3_o u3_lmdb_read_identity(MDB_env* environment, MDB_RDONLY, /* flags */ &transaction_u); if (0 != ret_w) { - u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: meta read: txn_begin fail: %s\n", mdb_strerror(ret_w)); return c3n; } @@ -640,7 +640,7 @@ c3_o u3_lmdb_read_identity(MDB_env* environment, 0, &database_u); if (0 != ret_w) { - u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + u3l_log("lmdb: meta read: dbi_open fail: %s\n", mdb_strerror(ret_w)); mdb_txn_abort(transaction_u); return c3n; } From 12c70311e701f977133903b5a7b3bb6dd8e7ea7e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 17 Apr 2020 11:28:52 -0700 Subject: [PATCH 013/257] vere: refactors event replay, fixing bugs --- pkg/urbit/vere/pier.c | 66 +++++++++++++++++++++++-------------------- 1 file changed, 36 insertions(+), 30 deletions(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 90f90dc0c..6e97e0923 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -172,11 +172,10 @@ _pier_work(u3_pier* pir_u) static void _pier_play_plan(u3_pier* pir_u, u3_play pay_u) { - u3_fact** ent_u = &pay_u.ent_u; u3_fact** ext_u; c3_d old_d; - if ( !pir_u->pay_u.ent_u ) { + if ( !pir_u->pay_u.ext_u ) { c3_assert( !pir_u->pay_u.ent_u ); ext_u = &pir_u->pay_u.ext_u; old_d = pir_u->pay_u.sen_d; @@ -195,36 +194,28 @@ _pier_play_plan(u3_pier* pir_u, u3_play pay_u) c3_assert( (1ULL + old_d) == pay_u.ext_u->eve_d ); - *ent_u = pay_u.ent_u; *ext_u = pay_u.ext_u; + pir_u->pay_u.ent_u = pay_u.ent_u; } +/* _pier_play_send(): detach a batch of up to [len_d] events from queue. +*/ static u3_play -_pier_play_next(u3_pier* pir_u) +_pier_play_next(u3_pier* pir_u, c3_d len_d) { u3_fact* tac_u = pir_u->pay_u.ext_u; - // the first batch must be >= the lifecycle barrier - // - c3_w len_d = ( !pir_u->pay_u.sen_d ) - ? c3_max(pir_u->lif_w, PIER_PLAY_BATCH) - : PIER_PLAY_BATCH; u3_play pay_u; // set batch entry and exit pointers // { pay_u.ext_u = tac_u; - c3_assert( tac_u ); - while ( len_d-- ) { - if ( !tac_u->nex_u ) { - break; - } + while ( len_d-- && tac_u->nex_u ) { tac_u = tac_u->nex_u; } pay_u.ent_u = tac_u; - c3_assert( tac_u ); } // detatch batch from queue @@ -249,7 +240,12 @@ _pier_play_send(u3_pier* pir_u) // (god_u->dep_w > PIER_WORK_BATCH) ) // if ( pir_u->pay_u.ext_u ) { - u3_play pay_u = _pier_play_next(pir_u); + // the first batch must be >= the lifecycle barrier + // + c3_d len_d = ( !pir_u->pay_u.sen_d ) + ? c3_max(pir_u->lif_w, PIER_PLAY_BATCH) + : PIER_PLAY_BATCH; + u3_play pay_u = _pier_play_next(pir_u, len_d); // bump sent counter // @@ -268,11 +264,13 @@ _pier_play_send(u3_pier* pir_u) static void _pier_play_read(u3_pier* pir_u) { - c3_d las_d, len_d; + c3_d las_d; if ( pir_u->pay_u.ent_u ) { las_d = pir_u->pay_u.ent_u->eve_d; + // cap the pir_u->pay_u queue depth + // if ( (las_d - pir_u->pay_u.ext_u->eve_d) >= PIER_PLAY_BATCH ) { return; } @@ -281,20 +279,20 @@ _pier_play_read(u3_pier* pir_u) las_d = pir_u->pay_u.sen_d; } - if ( (1ULL + las_d) == pir_u->pay_u.req_d ) { - return; - } + { + c3_d nex_d = (1ULL + las_d); + c3_d len_d = c3_min(pir_u->log_u->dun_d - las_d, PIER_READ_BATCH); - pir_u->pay_u.req_d = (1ULL + las_d); - - len_d = c3_min(pir_u->log_u->dun_d - las_d, PIER_READ_BATCH); - - if ( len_d ) { - u3_disk_read(pir_u->log_u, (1ULL + las_d), len_d); + if ( len_d + && (nex_d > pir_u->pay_u.req_d) ) + { + u3_disk_read(pir_u->log_u, nex_d, len_d); + pir_u->pay_u.req_d = nex_d; #ifdef VERBOSE_PIER - fprintf(stderr, "pier: play read %" PRIu64 " at %" PRIu64 "\r\n", len_d, (1ULL + las_d)); + fprintf(stderr, "pier: play read %" PRIu64 " at %" PRIu64 "\r\n", len_d, nex_d); #endif + } } } @@ -315,7 +313,8 @@ _pier_play(u3_pier* pir_u) u3l_log("pier: play boot\r\n"); } else if ( god_u->eve_d == log_u->dun_d ) { - u3l_log("---------------- playback complete----------------\r\n"); + u3l_log("---------------- %s complete ----------------\r\n", + ( u3_peat_boot == pir_u->sat_e ) ? "boot" : "playback"); u3_term_stop_spinner(); _pier_work_init(pir_u); // XX _pier_next(pir_u); @@ -529,6 +528,8 @@ _pier_on_lord_work_bail(void* vod_p, u3_work* wok_u, u3_noun lud) // XX dispose // fprintf(stderr, "pier: work: bail\r\n"); + u3m_p("wir", u3h(u3t(wok_u->job))); + u3m_p("tag", u3h(u3t(u3t(wok_u->job)))); _pier_next(pir_u); } @@ -607,7 +608,9 @@ _pier_on_lord_live(void* vod_p) pir_u->sat_e = u3_peat_play; pir_u->pay_u.sen_d = god_u->eve_d; - u3l_log("---------------- playback starting----------------\r\n"); + u3l_log("---------------- %s starting ----------------\r\n", + ( u3_peat_boot == pir_u->sat_e ) ? "boot" : "playback"); + if ( (1ULL + god_u->eve_d) == log_u->dun_d ) { u3l_log("pier: replaying event %" PRIu64 "\r\n", log_u->dun_d); } @@ -617,7 +620,10 @@ _pier_on_lord_live(void* vod_p) log_u->dun_d); } - u3_term_start_spinner(c3__play, c3y); + { + c3_m mot_m = ( u3_peat_boot == pir_u->sat_e ) ? c3__boot : c3__play; + u3_term_start_spinner(mot_m, c3y); + } } else { _pier_work_init(pir_u); From 65a8ce4e10d078cfc5eaaf770fcb92350265212d Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 17 Apr 2020 11:29:17 -0700 Subject: [PATCH 014/257] vere: improves lord's graceful serf shutdown --- pkg/urbit/vere/lord.c | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 26820954e..d3c7bfaab 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -126,13 +126,21 @@ _lord_on_exit(uv_process_t* req_u, } } +/* _lord_bail_noop(): ignore subprocess error on shutdown +*/ +static void +_lord_bail_noop(void* vod_p, + const c3_c* err_c) +{ +} + /* _lord_bail(): handle subprocess error. */ static void _lord_bail(void* vod_p, const c3_c* err_c) { - // XX ignore if shutting down + // XX exit? // fprintf(stderr, "\rpier: work error: %s\r\n", err_c); } @@ -682,6 +690,13 @@ _lord_writ_send(u3_lord* god_u, u3_rrit* wit_u) _lord_writ_jam(god_u, wit_u); u3_newt_write(&god_u->inn_u, wit_u->mat, 0); wit_u->sen_o = c3y; + + // ignore subprocess error on shutdown + // + if ( c3__exit == wit_u->typ_m ) { + god_u->out_u.bal_f = _lord_bail_noop; + god_u->inn_u.bal_f = _lord_bail_noop; + } } } From 73d509bcf9284f8296eb082409d8cef452a2a58e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 17 Apr 2020 15:30:22 -0700 Subject: [PATCH 015/257] vere: WIP moves behn.c to u3_auto --- pkg/urbit/include/vere/vere.h | 33 +----- pkg/urbit/vere/auto.c | 11 +- pkg/urbit/vere/behn.c | 135 ++++++++++++++++----- pkg/urbit/vere/pier.c | 213 ++++++++++++++++------------------ pkg/urbit/vere/reck.c | 34 +++--- 5 files changed, 228 insertions(+), 198 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index b25e65377..72e898552 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -469,13 +469,6 @@ #endif } u3_unix; - /* u3_behn: just a timer for ever - */ - typedef struct _u3_behn { - uv_timer_t tim_u; // behn timer - c3_o alm; // alarm - } u3_behn; - /* u2_utfo: unix terminfo strings. */ typedef struct { @@ -782,7 +775,6 @@ c3_m nam_m; c3_o liv_o; struct { - void (*init_f)(struct _u3_auto*); void (*talk_f)(struct _u3_auto*); c3_o (*fete_f)(struct _u3_auto*, u3_noun pax, u3_noun fav); // RETAIN void (*exit_f)(struct _u3_auto*); // XX close_cb? @@ -831,7 +823,6 @@ // XX remove c3_s por_s; // UDP port u3_ames* sam_u; // packet interface - u3_behn* teh_u; // behn timer u3_unix* unx_u; // sync and clay u3_save* sav_u; // autosave } u3_pier; @@ -856,8 +847,8 @@ /* u3_auto_init(): initialize all drivers */ - void - u3_auto_init(u3_auto* car_u); + u3_auto* + u3_auto_init(void); /* u3_auto_talk(): start all drivers */ @@ -1313,24 +1304,8 @@ **/ /* u3_behn_io_init(): initialize behn timer. */ - void - u3_behn_io_init(u3_pier *pir_u); - - /* u3_behn_io_exit(): terminate timer. - */ - void - u3_behn_io_exit(u3_pier *pir_u); - - /* u3_behn_ef_bake(): notify %behn that we're live - */ - void - u3_behn_ef_bake(u3_pier *pir_u); - - /* u3_behn_ef_doze(): set or cancel timer - */ - void - u3_behn_ef_doze(u3_pier *pir_u, u3_noun wen); - + u3_auto* + u3_behn_io_init(u3_pier* pir_u); /** HTTP server. **/ diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index aea5c897e..d93e9bee0 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -21,13 +21,12 @@ /* u3_auto_init(): initialize all drivers */ -void -u3_auto_init(u3_auto* car_u) +u3_auto* +u3_auto_init(void) { - while ( car_u ) { - car_u->io.init_f(car_u); - car_u = car_u->nex_u; - } + // XX initialize i/o drivers here + // + return 0; } /* u3_auto_talk(): start all drivers diff --git a/pkg/urbit/vere/behn.c b/pkg/urbit/vere/behn.c index 96b9a0b9d..45f589fd3 100644 --- a/pkg/urbit/vere/behn.c +++ b/pkg/urbit/vere/behn.c @@ -14,34 +14,20 @@ #include "all.h" #include "vere/vere.h" -/* u3_behn(): initialize time timer. +/* u3_behn: just a timer for ever */ -void -u3_behn_io_init(u3_pier *pir_u) -{ - u3_behn* teh_u = pir_u->teh_u; - teh_u->alm = c3n; - - uv_timer_init(u3L, &teh_u->tim_u); - teh_u->tim_u.data = pir_u; -} - -/* u3_behn_io_exit(): terminate timer. -*/ -void -u3_behn_io_exit(u3_pier *pir_u) -{ - u3_behn* teh_u = pir_u->teh_u; - uv_close((uv_handle_t*)&teh_u->tim_u, 0); -} + typedef struct _u3_behn { + u3_auto car_u; // driver + uv_timer_t tim_u; // behn timer + c3_o alm; // alarm + } u3_behn; /* _behn_time_cb(): timer callback. */ static void _behn_time_cb(uv_timer_t* tim_u) { - u3_pier *pir_u = tim_u->data; - u3_behn* teh_u = pir_u->teh_u; + u3_behn* teh_u = tim_u->data; teh_u->alm = c3n; // start another timer for 10 minutes @@ -60,19 +46,21 @@ _behn_time_cb(uv_timer_t* tim_u) // send timer event // { - u3_pier_work - (pir_u, - u3nt(u3_blip, c3__behn, u3_nul), - u3nc(c3__wake, u3_nul)); + u3_noun pax = u3nt(u3_blip, c3__behn, u3_nul); + u3_noun fav = u3nc(c3__wake, u3_nul); + + u3_auto_plan(&teh_u->car_u, 0, 0, u3_blip, pax, fav); } } /* u3_behn_ef_doze(): set or cancel timer */ -void -u3_behn_ef_doze(u3_pier *pir_u, u3_noun wen) +static void +_behn_ef_doze(u3_behn* teh_u, u3_noun wen) { - u3_behn* teh_u = pir_u->teh_u; + if ( c3n == teh_u->car_u.liv_o ) { + teh_u->car_u.liv_o = c3y; + } if ( c3y == teh_u->alm ) { uv_timer_stop(&teh_u->tim_u); @@ -96,12 +84,95 @@ u3_behn_ef_doze(u3_pier *pir_u, u3_noun wen) u3z(wen); } -/* u3_behn_ef_bake(): notify %behn that we're live +/* _behn_io_talk(): notify %behn that we're live */ -void -u3_behn_ef_bake(u3_pier *pir_u) +static void +_behn_io_talk(u3_auto* car_u) { + // XX remove u3A->sen + // u3_noun pax = u3nq(u3_blip, c3__behn, u3k(u3A->sen), u3_nul); + u3_noun fav = u3nc(c3__born, u3_nul); - u3_pier_work(pir_u, pax, u3nc(c3__born, u3_nul)); + u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); +} + +/* _behn_io_fete(): +*/ +static c3_o +_behn_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +{ + u3_behn* teh_u = (u3_behn*)car_u; + + u3_noun i_pax, it_pax, tag, dat; + c3_o ret_o; + + if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, 0)) + || (c3n == u3r_cell(fav, &tag, &dat)) + || (u3_blip != i_pax ) + || (c3__behn != it_pax) ) + { + ret_o = c3n; + } + else { + ret_o = c3y; + _behn_ef_doze(teh_u, u3k(dat)); + } + + u3z(pax); u3z(fav); + return ret_o; +} + +/* _behn_exit_cb(); +*/ +static void +_behn_exit_cb(uv_timer_t* tim_u) +{ + u3_behn* teh_u = tim_u->data; + c3_free(teh_u); +} + +/* _behn_io_exit(): terminate timer. +*/ +static void +_behn_io_exit(u3_auto* car_u) +{ + u3_behn* teh_u = (u3_behn*)car_u; + uv_close((uv_handle_t*)&teh_u->tim_u, (uv_close_cb)_behn_exit_cb); +} + +static void +_behn_ev_noop(u3_auto* car_u, void* vod_p) +{ +} + +/* u3_behn(): initialize time timer. +*/ +u3_auto* +u3_behn_io_init(u3_pier* pir_u) +{ + u3_behn* teh_u = c3_calloc(sizeof(*teh_u)); + teh_u->alm = c3n; + + uv_timer_init(u3L, &teh_u->tim_u); + teh_u->tim_u.data = teh_u; + + u3_auto* car_u = &teh_u->car_u; + car_u->nam_m = c3__behn; + // XX factor out + // + car_u->liv_o = c3n; + car_u->io.talk_f = _behn_io_talk; + car_u->io.fete_f = _behn_io_fete; + car_u->io.exit_f = _behn_io_exit; + + car_u->ev.drop_f = _behn_ev_noop; + car_u->ev.work_f = _behn_ev_noop; + car_u->ev.done_f = _behn_ev_noop; + car_u->ev.swap_f = _behn_ev_noop; + // XX important + // + car_u->ev.bail_f = _behn_ev_noop; + + return car_u; } diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 6e97e0923..8d03793b6 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -747,19 +747,9 @@ u3_pier_spin(u3_pier* pir_u) } } -static void -_pier_loop_init(u3_auto* car_u); -static void -_pier_loop_wake(u3_auto* car_u); -static void -_pier_loop_exit(u3_auto* car_u); -static c3_o -_pier_loop_fete(u3_auto* car_u, u3_noun pax, u3_noun fav); +static u3_auto* +_pier_loop_init(u3_pier* pir_u); -static void -_pier_auto_noop(u3_auto* car_u, void* vod_p) -{ -} /* _pier_init(): create a pier, loading existing. */ static u3_pier* @@ -776,7 +766,6 @@ _pier_init(c3_w wag_w, c3_c* pax_c) // pir_u->sam_u = c3_calloc(sizeof(u3_ames)); pir_u->por_s = u3_Host.ops_u.por_s; - pir_u->teh_u = c3_calloc(sizeof(u3_behn)); pir_u->unx_u = c3_calloc(sizeof(u3_unix)); pir_u->sav_u = c3_calloc(sizeof(u3_save)); @@ -851,25 +840,6 @@ _pier_init(c3_w wag_w, c3_c* pax_c) } } - // encapsulate all i/o drivers in one u3_auto (temporary) - { - u3_auto* car_u = c3_calloc(sizeof(*car_u)); - car_u->nam_m = u3_blip; - car_u->liv_o = c3y; - car_u->pir_u = pir_u; - car_u->io.init_f = _pier_loop_init; - car_u->io.talk_f = _pier_loop_wake; - car_u->io.fete_f = _pier_loop_fete; - car_u->io.exit_f = _pier_loop_exit; - car_u->ev.drop_f = _pier_auto_noop; - car_u->ev.work_f = _pier_auto_noop; - car_u->ev.done_f = _pier_auto_noop; - car_u->ev.swap_f = _pier_auto_noop; - car_u->ev.bail_f = _pier_auto_noop; - - pir_u->car_u = car_u; - } - // install in the pier table // // XX u3_king_plan @@ -884,8 +854,6 @@ _pier_init(c3_w wag_w, c3_c* pax_c) } u3K.tab_u[u3K.len_w++] = pir_u; - u3_auto_init(pir_u->car_u); - return pir_u; } @@ -903,6 +871,8 @@ u3_pier_stay(c3_w wag_w, u3_noun pax) exit(1); } + pir_u->car_u = _pier_loop_init(pir_u); + u3z(pax); } @@ -1105,6 +1075,8 @@ u3_pier_boot(c3_w wag_w, // config flags exit(1); } + pir_u->car_u = _pier_loop_init(pir_u); + u3z(pax); } @@ -1158,31 +1130,6 @@ u3_pier_exit(u3_pier* pir_u) _pier_wall_plan(pir_u, 0, pir_u, _pier_exit_cb); } -// play loop: -// -// _lord_live state = play -// _disk_read batch -// disk_cb lord_play, disk_read -// lord_cb lord_play, disk_read ... -// lord_cb state = work - - -// work loop: -// -// _lord_live state = work || play_done -// _auto_init -// _auto_next loop, fill queue -// lord_cb check until all live, pir_u->liv_o, "boot" cb -// - -// boot loop: -// -// construct a boot sequence, commit part, enqueue part ("boot" driver, or direct?) -// play loop -// work loop -// - - // startup validation // // replay the log @@ -1197,55 +1144,6 @@ u3_pier_exit(u3_pier* pir_u) // neighbor with sponsor // - - -/* _pier_loop_init_pier(): initialize loop handlers. -*/ -static void -_pier_loop_init(u3_auto* car_u) -{ - u3_pier* pir_u = car_u->pir_u; - c3_l cod_l; - - _pier_loop_time(pir_u); - - // for i/o drivers that still use u3A->sen - // - u3v_numb(); - - cod_l = u3a_lush(c3__ames); - u3_ames_io_init(pir_u); - u3a_lop(cod_l); - - cod_l = u3a_lush(c3__behn); - u3_behn_io_init(pir_u); - u3a_lop(cod_l); - - cod_l = u3a_lush(c3__unix); - u3_unix_io_init(pir_u); - u3a_lop(cod_l); - - cod_l = u3a_lush(c3__save); - u3_save_io_init(pir_u); - u3a_lop(cod_l); - - // XX legacy handlers, not yet scoped to a pier - // - { - cod_l = u3a_lush(c3__term); - u3_term_io_init(); - u3a_lop(cod_l); - - cod_l = u3a_lush(c3__http); - u3_http_io_init(); - u3a_lop(cod_l); - - cod_l = u3a_lush(c3__cttp); - u3_cttp_io_init(); - u3a_lop(cod_l); - } -} - /* _pier_loop_wake(): initialize listeners and send initial events. */ static void @@ -1276,9 +1174,9 @@ _pier_loop_wake(u3_auto* car_u) u3_ames_ef_bake(pir_u); u3a_lop(cod_l); - cod_l = u3a_lush(c3__behn); - u3_behn_ef_bake(pir_u); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__behn); + // u3_behn_ef_bake(pir_u); + // u3a_lop(cod_l); // XX legacy handlers, not yet scoped to a pier // @@ -1316,9 +1214,9 @@ _pier_loop_exit(u3_auto* car_u) u3_save_io_exit(pir_u); u3a_lop(cod_l); - cod_l = u3a_lush(c3__behn); - u3_behn_io_exit(pir_u); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__behn); + // u3_behn_io_exit(pir_u); + // u3a_lop(cod_l); // XX legacy handlers, not yet scoped to a pier // @@ -1344,6 +1242,93 @@ _pier_loop_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) return c3y; } +static void +_pier_auto_noop(u3_auto* car_u, void* vod_p) +{ +} + +/* _pier_loop_init_pier(): initialize loop handlers. +*/ +static u3_auto* +_pier_loop_init(u3_pier* pir_u) +{ + // encapsulate all i/o drivers in one u3_auto (temporary) + // + // XX move to u3_auto_init(pir_u->car_u); + // + + u3_auto* car_u; + u3_auto** las_u = &car_u; + + { + u3_auto* rac_u = u3_behn_io_init(pir_u); + rac_u->pir_u = pir_u; + + *las_u = rac_u; + las_u = &rac_u->nex_u; + } + + { + u3_auto* rac_u = c3_calloc(sizeof(*rac_u)); + rac_u->nam_m = u3_blip; + rac_u->liv_o = c3y; + rac_u->pir_u = pir_u; + rac_u->io.talk_f = _pier_loop_wake; + rac_u->io.fete_f = _pier_loop_fete; + rac_u->io.exit_f = _pier_loop_exit; + rac_u->ev.drop_f = _pier_auto_noop; + rac_u->ev.work_f = _pier_auto_noop; + rac_u->ev.done_f = _pier_auto_noop; + rac_u->ev.swap_f = _pier_auto_noop; + rac_u->ev.bail_f = _pier_auto_noop; + + *las_u = rac_u; + las_u = &rac_u->nex_u; + } + + c3_l cod_l; + + _pier_loop_time(pir_u); + + // for i/o drivers that still use u3A->sen + // + u3v_numb(); + + cod_l = u3a_lush(c3__ames); + u3_ames_io_init(pir_u); + u3a_lop(cod_l); + + // cod_l = u3a_lush(c3__behn); + // u3_behn_io_init(pir_u); + // u3a_lop(cod_l); + + cod_l = u3a_lush(c3__unix); + u3_unix_io_init(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__save); + u3_save_io_init(pir_u); + u3a_lop(cod_l); + + // XX legacy handlers, not yet scoped to a pier + // + { + cod_l = u3a_lush(c3__term); + u3_term_io_init(); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__http); + u3_http_io_init(); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__cttp); + u3_cttp_io_init(); + u3a_lop(cod_l); + } + + return car_u; +} + /* u3_pier_work(): send event; real pier pointer. ** ** XX: u3_pier_work() is for legacy events sent to a real pier. diff --git a/pkg/urbit/vere/reck.c b/pkg/urbit/vere/reck.c index 9f8d63dae..f3d4169d1 100644 --- a/pkg/urbit/vere/reck.c +++ b/pkg/urbit/vere/reck.c @@ -165,21 +165,21 @@ _reck_kick_arvo(u3_pier* pir_u, u3_noun pox, u3_noun fav) u3z(pox); u3z(fav); return c3n; } -/* _reck_kick_behn(): apply packet network outputs. -*/ -static u3_noun -_reck_kick_behn(u3_pier* pir_u, u3_noun pox, u3_noun fav) -{ - switch ( u3h(fav) ) { - default: break; +// /* _reck_kick_behn(): apply packet network outputs. +// */ +// static u3_noun +// _reck_kick_behn(u3_pier* pir_u, u3_noun pox, u3_noun fav) +// { +// switch ( u3h(fav) ) { +// default: break; - case c3__doze: { - u3_behn_ef_doze(pir_u, u3k(u3t(fav))); - u3z(pox); u3z(fav); return c3y; - } break; - } - u3z(pox); u3z(fav); return c3n; -} +// case c3__doze: { +// u3_behn_ef_doze(pir_u, u3k(u3t(fav))); +// u3z(pox); u3z(fav); return c3y; +// } break; +// } +// u3z(pox); u3z(fav); return c3n; +// } /* _reck_kick_sync(): apply sync outputs. */ @@ -353,9 +353,9 @@ _reck_kick_spec(u3_pier* pir_u, u3_noun pox, u3_noun fav) return _reck_kick_arvo(pir_u, pox, fav); } break; - case c3__behn: { - return _reck_kick_behn(pir_u, pox, fav); - } break; + // case c3__behn: { + // return _reck_kick_behn(pir_u, pox, fav); + // } break; case c3__clay: case c3__boat: From d3b99f26f4f6729adcc3d4188e9d98dccbdfdbb0 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 17 Apr 2020 18:32:46 -0700 Subject: [PATCH 016/257] vere: WIP moves ames.c to u3_auto --- pkg/urbit/include/vere/vere.h | 64 +------ pkg/urbit/vere/ames.c | 314 +++++++++++++++++++++++++--------- pkg/urbit/vere/pier.c | 29 ++-- pkg/urbit/vere/reck.c | 154 ++++++++--------- 4 files changed, 328 insertions(+), 233 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 72e898552..f019a6f7c 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -237,18 +237,6 @@ void* tls_u; // client SSL_CTX* } u3_cttp; - /* u3_pact: ames packet, coming or going. - */ - typedef struct _u3_pact { - uv_udp_send_t snd_u; // udp send request - c3_w pip_w; // target IPv4 address - c3_s por_s; // target port - c3_w len_w; // length in bytes - c3_y* hun_y; // packet buffer - c3_y imp_y; // galaxy number (optional) - c3_c* dns_c; // galaxy fqdn (optional) - } u3_pact; - /* u3_lane: ames lane (IP address and port) */ typedef struct _u3_lane { @@ -331,22 +319,6 @@ u3_dent* all_u; // file list } u3_dire; - /* u3_ames: ames networking. - */ - typedef struct _u3_ames { // packet network state - union { - uv_udp_t wax_u; - uv_handle_t had_u; - }; - c3_o liv; // listener on - c3_o alm; // alarm on - c3_s por_s; // public IPv4 port - c3_c* dns_c; // domain XX multiple/fallback - c3_w imp_w[256]; // imperial IPs - time_t imp_t[256]; // imperial IP timestamps - c3_o imp_o[256]; // imperial print status - } u3_ames; - /* u3_save: checkpoint control. */ typedef struct _u3_save { @@ -822,7 +794,6 @@ uv_idle_t idl_u; // postloop registration // XX remove c3_s por_s; // UDP port - u3_ames* sam_u; // packet interface u3_unix* unx_u; // sync and clay u3_save* sav_u; // autosave } u3_pier; @@ -1166,44 +1137,11 @@ /** Ames, packet networking. **/ - /* u3_ames_ef_bake(): create ames duct. - */ - void - u3_ames_ef_bake(u3_pier* pir_u); - - /* u3_ames_ef_send(): send packet to network. - */ - void - u3_ames_ef_send(u3_pier* pir_u, - u3_noun lan, - u3_noun pac); - - /* u3_ames_ef_turf(): initialize ames I/O on domain(s). - */ - void - u3_ames_ef_turf(u3_pier* pir_u, - u3_noun tuf); - /* u3_ames_io_init(): initialize ames I/O. */ - void + u3_auto* u3_ames_io_init(u3_pier* pir_u); - /* u3_ames_io_talk(): bring up listener. - */ - void - u3_ames_io_talk(u3_pier* pir_u); - - /* u3_ames_ef_bake(): send initial events. - */ - void - u3_ames_io_bake(u3_pier* pir_u); - - /* u3_ames_io_exit(): terminate ames I/O. - */ - void - u3_ames_io_exit(u3_pier* pir_u); - /* u3_ames_decode_lane(): destructure lane from noun */ u3_lane diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/ames.c index 371ac95da..57093b0b2 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/ames.c @@ -16,6 +16,38 @@ #include "all.h" #include "vere/vere.h" +/* u3_pact: ames packet, coming or going. +*/ + typedef struct _u3_pact { + uv_udp_send_t snd_u; // udp send request + c3_w pip_w; // target IPv4 address + c3_s por_s; // target port + c3_w len_w; // length in bytes + c3_y* hun_y; // packet buffer + c3_y imp_y; // galaxy number (optional) + c3_c* dns_c; // galaxy fqdn (optional) + struct _u3_ames* sam_u; // ames backpointer + } u3_pact; + +/* u3_ames: ames networking. +*/ + typedef struct _u3_ames { // packet network state + u3_auto car_u; // driver + union { // + uv_udp_t wax_u; // + uv_handle_t had_u; // + }; // + c3_d who_d[2]; // identity + c3_o fak_o; // fake keys + c3_o liv; // listener on + c3_o alm; // alarm on + c3_s por_s; // public IPv4 port + c3_c* dns_c; // domain XX multiple/fallback + c3_w imp_w[256]; // imperial IPs + time_t imp_t[256]; // imperial IP timestamps + c3_o imp_o[256]; // imperial print status + } u3_ames; + /* _ames_alloc(): libuv buffer allocator. */ static void @@ -48,11 +80,9 @@ _ames_send_cb(uv_udp_send_t* req_u, c3_i sas_i) { u3_pact* pac_u = (u3_pact*)req_u; -#if 0 if ( 0 != sas_i ) { - u3l_log("ames: send_cb: %s\n", uv_strerror(sas_i)); + u3l_log("ames: send fail: %s\n", uv_strerror(sas_i)); } -#endif _ames_pact_free(pac_u); } @@ -62,9 +92,7 @@ _ames_send_cb(uv_udp_send_t* req_u, c3_i sas_i) static void _ames_send(u3_pact* pac_u) { - // XX revisit - u3_pier* pir_u = u3_pier_stub(); - u3_ames* sam_u = pir_u->sam_u; + u3_ames* sam_u = pac_u->sam_u; if ( !pac_u->hun_y ) { _ames_pact_free(pac_u); @@ -108,9 +136,7 @@ _ames_czar_port(c3_y imp_y) static void _ames_czar_gone(u3_pact* pac_u, time_t now) { - // XX revisit - u3_pier* pir_u = u3_pier_stub(); - u3_ames* sam_u = pir_u->sam_u; + u3_ames* sam_u = pac_u->sam_u; if ( c3y == sam_u->imp_o[pac_u->imp_y] ) { u3l_log("ames: czar at %s: not found (b)\n", pac_u->dns_c); @@ -137,12 +163,9 @@ _ames_czar_cb(uv_getaddrinfo_t* adr_u, c3_i sas_i, struct addrinfo* aif_u) { - // XX revisit - u3_pier* pir_u = u3_pier_stub(); - u3_ames* sam_u = pir_u->sam_u; - u3_pact* pac_u = (u3_pact*)adr_u->data; - time_t now = time(0); + u3_ames* sam_u = pac_u->sam_u; + time_t now = time(0); struct addrinfo* rai_u = aif_u; @@ -217,9 +240,7 @@ u3_ames_encode_lane(u3_lane lan) { static void _ames_czar(u3_pact* pac_u, c3_c* bos_c) { - // XX revisit - u3_pier* pir_u = u3_pier_stub(); - u3_ames* sam_u = pir_u->sam_u; + u3_ames* sam_u = pac_u->sam_u; pac_u->por_s = _ames_czar_port(pac_u->imp_y); @@ -285,23 +306,11 @@ _ames_czar(u3_pact* pac_u, c3_c* bos_c) } } -/* u3_ames_ef_bake(): notify %ames that we're live. +/* _ames_ef_send(): send packet to network (v4). */ -void -u3_ames_ef_bake(u3_pier* pir_u) +static void +_ames_ef_send(u3_ames* sam_u, u3_noun lan, u3_noun pac) { - u3_noun pax = u3nq(u3_blip, c3__newt, u3k(u3A->sen), u3_nul); - - u3_pier_plan(pax, u3nc(c3__born, u3_nul)); -} - -/* u3_ames_ef_send(): send packet to network (v4). -*/ -void -u3_ames_ef_send(u3_pier* pir_u, u3_noun lan, u3_noun pac) -{ - u3_ames* sam_u = pir_u->sam_u; - if ( c3n == sam_u->liv ) { u3l_log("ames: not yet live, dropping outbound\r\n"); u3z(lan); u3z(pac); @@ -309,8 +318,9 @@ u3_ames_ef_send(u3_pier* pir_u, u3_noun lan, u3_noun pac) } u3_pact* pac_u = c3_calloc(sizeof(*pac_u)); - pac_u->len_w = u3r_met(3, pac); - pac_u->hun_y = c3_malloc(pac_u->len_w); + pac_u->sam_u = sam_u; + pac_u->len_w = u3r_met(3, pac); + pac_u->hun_y = c3_malloc(pac_u->len_w); u3r_bytes(0, pac_u->len_w, pac_u->hun_y, pac); @@ -360,52 +370,52 @@ _ames_recv_cb(uv_udp_t* wax_u, const struct sockaddr* adr_u, unsigned flg_i) { - // u3l_log("ames: rx %p\r\n", buf_u.base); + u3_ames* sam_u = wax_u->data; - if ( 0 == nrd_i ) { - c3_free(buf_u->base); - } - // check protocol version in header matches 0 + // data present, and protocol version in header matches 0 // - else if ( 0 != (0x7 & *((c3_w*)buf_u->base)) ) { - c3_free(buf_u->base); - } - else { + // XX inflexible, scry version out of ames + // + if ( (0 < nrd_i) + && (0 == (0x7 & *((c3_w*)buf_u->base))) ) + { + u3_noun pax = u3nt(u3_blip, c3__ames, u3_nul); + u3_noun fav; + { u3_noun msg = u3i_bytes((c3_w)nrd_i, (c3_y*)buf_u->base); + u3_noun lan; - // u3l_log("ames: plan\r\n"); -#if 0 - u3z(msg); -#else - u3_lane lan_u; - struct sockaddr_in* add_u = (struct sockaddr_in *)adr_u; + { + struct sockaddr_in* add_u = (struct sockaddr_in *)adr_u; + u3_lane lan_u; - lan_u.por_s = ntohs(add_u->sin_port); - lan_u.pip_w = ntohl(add_u->sin_addr.s_addr); - u3_noun lan = u3_ames_encode_lane(lan_u); - u3_noun mov = u3nt(c3__hear, u3nc(c3n, lan), msg); + lan_u.por_s = ntohs(add_u->sin_port); + lan_u.pip_w = ntohl(add_u->sin_addr.s_addr); + lan = u3_ames_encode_lane(lan_u); + } - u3_pier_plan(u3nt(u3_blip, c3__ames, u3_nul), mov); -#endif + fav = u3nt(c3__hear, u3nc(c3n, lan), msg); } - c3_free(buf_u->base); + + u3_auto_plan(&sam_u->car_u, 0, 0, u3_blip, pax, fav); } + + c3_free(buf_u->base); } /* _ames_io_start(): initialize ames I/O. */ static void -_ames_io_start(u3_pier* pir_u) +_ames_io_start(u3_ames* sam_u) { - u3_ames* sam_u = pir_u->sam_u; - c3_s por_s = pir_u->por_s; - u3_noun who = u3i_chubs(2, pir_u->who_d); + c3_s por_s = sam_u->por_s; + u3_noun who = u3i_chubs(2, sam_u->who_d); u3_noun rac = u3do("clan:title", u3k(who)); c3_i ret_i; if ( c3__czar == rac ) { - c3_y num_y = (c3_y)pir_u->who_d[0]; + c3_y num_y = (c3_y)sam_u->who_d[0]; c3_s zar_s = _ames_czar_port(num_y); if ( 0 == por_s ) { @@ -422,6 +432,8 @@ _ames_io_start(u3_pier* pir_u) c3_assert(0); } + sam_u->wax_u.data = sam_u; + // Bind and stuff. { struct sockaddr_in add_u; @@ -445,7 +457,9 @@ _ames_io_start(u3_pier* pir_u) u3l_log(" ...perhaps you've got two copies of vere running?\n"); } - u3_pier_exit(pir_u); + // XX revise + // + u3_pier_exit(u3_pier_stub()); } uv_udp_getsockname(&sam_u->wax_u, (struct sockaddr *)&add_u, &add_i); @@ -524,13 +538,11 @@ _cttp_mcut_host(c3_c* buf_c, c3_w len_w, u3_noun hot) return len_w; } -/* u3_ames_ef_turf(): initialize ames I/O on domain(s). +/* _ames_ef_turf(): initialize ames I/O on domain(s). */ -void -u3_ames_ef_turf(u3_pier* pir_u, u3_noun tuf) +static void +_ames_ef_turf(u3_ames* sam_u, u3_noun tuf) { - u3_ames* sam_u = pir_u->sam_u; - if ( u3_nul != tuf ) { // XX save all for fallback, not just first u3_noun hot = u3k(u3h(tuf)); @@ -542,40 +554,178 @@ u3_ames_ef_turf(u3_pier* pir_u, u3_noun tuf) u3z(tuf); } - else if ( (c3n == pir_u->fak_o) && (0 == sam_u->dns_c) ) { + else if ( (c3n == sam_u->fak_o) && (0 == sam_u->dns_c) ) { u3l_log("ames: turf: no domains\n"); } if ( c3n == sam_u->liv ) { - _ames_io_start(pir_u); + _ames_io_start(sam_u); } } -/* u3_ames_io_init(): initialize ames I/O. +/* _ames_io_talk(): start receiving ames traffic. */ -void -u3_ames_io_init(u3_pier* pir_u) +static void +_ames_io_talk(u3_auto* car_u) { - u3_ames* sam_u = pir_u->sam_u; - sam_u->liv = c3n; + u3_ames* sam_u = (u3_ames*)car_u; + _ames_io_start(sam_u); + + // send born event + // + { + u3_noun pax = u3nq(u3_blip, c3__newt, u3k(u3A->sen), u3_nul); + u3_noun fav = u3nc(c3__born, u3_nul); + + u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + } } -/* u3_ames_io_talk(): start receiving ames traffic. +/* _ames_fete_newt(): apply packet network outputs. */ -void -u3_ames_io_talk(u3_pier* pir_u) +static c3_o +_ames_fete_newt(u3_ames* sam_u, u3_noun tag, u3_noun dat) { - _ames_io_start(pir_u); + c3_o ret_o; + + switch ( tag ) { + default: { + ret_o = c3n; + } break; + + case c3__send: { + u3_noun lan = u3k(u3h(dat)); + u3_noun pac = u3k(u3t(dat)); + _ames_ef_send(sam_u, lan, pac); + ret_o = c3y; + } break; + + case c3__turf: { + _ames_ef_turf(sam_u, u3k(dat)); + ret_o = c3y; + } break; + } + + u3z(tag); u3z(dat); + return ret_o; } -/* u3_ames_io_exit(): terminate ames I/O. +/* _ames_io_fete(): */ -void -u3_ames_io_exit(u3_pier* pir_u) +static c3_o +_ames_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) { - u3_ames* sam_u = pir_u->sam_u; + u3_ames* sam_u = (u3_ames*)car_u; + u3_noun i_pax, it_pax, tt_pax, tag, dat; + c3_o ret_o; + + if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, &tt_pax)) + || (c3n == u3r_cell(fav, &tag, &dat)) + || (u3_blip != i_pax ) ) + { + ret_o = c3n; + } + else { + switch ( it_pax ) { + default: { + ret_o = c3n; + } break; + + // XX should also be c3__ames + // + case c3__newt: { + ret_o = _ames_fete_newt(sam_u, u3k(tag), u3k(dat)); + } break; + + // XX obsolete + // + // used to also handle %west and %woot for tcp proxy setup + // + case c3__ames: { + ret_o = _( c3__init == tag); + } break; + + // this can return through dill due to our fscked up boot sequence + // + // XX s/b obsolete, verify + // + case c3__term: { + if ( c3__send != tag ) { + ret_o = c3n; + } + else { + u3l_log("kick: strange send\r\n"); + ret_o = _ames_fete_newt(sam_u, u3k(tag), u3k(dat)); + } + } break; + } + } + + u3z(pax); u3z(fav); + return ret_o; +} + +/* _ames_io_exit(): terminate ames I/O. +*/ +static void +_ames_io_exit(u3_auto* car_u) +{ + u3_ames* sam_u = (u3_ames*)car_u; + + // XX dispose + // if ( c3y == sam_u->liv ) { uv_close(&sam_u->had_u, 0); } } + +static void +_ames_ev_noop(u3_auto* car_u, void* vod_p) +{ +} + +/* u3_ames_io_init(): initialize ames I/O. +*/ +u3_auto* +u3_ames_io_init(u3_pier* pir_u) +{ + u3_ames* sam_u = c3_calloc(sizeof(*sam_u)); + // XX pass pier on init? + // + sam_u->who_d[0] = pir_u->who_d[0]; + sam_u->who_d[1] = pir_u->who_d[1]; + sam_u->por_s = pir_u->por_s; + sam_u->fak_o = pir_u->fak_o; + + // Disable networking for fake ships + // + if ( c3y == sam_u->fak_o ) { + u3_Host.ops_u.net = c3n; + } + + // XX redundant + // + sam_u->liv = c3n; + + // XX uv_udp_init + // + + u3_auto* car_u = &sam_u->car_u; + car_u->nam_m = c3__ames; + car_u->liv_o = c3n; + car_u->io.talk_f = _ames_io_talk; + car_u->io.fete_f = _ames_io_fete; + car_u->io.exit_f = _ames_io_exit; + + car_u->ev.drop_f = _ames_ev_noop; + car_u->ev.work_f = _ames_ev_noop; + car_u->ev.done_f = _ames_ev_noop; + car_u->ev.swap_f = _ames_ev_noop; + // XX track and print every N? + // + car_u->ev.bail_f = _ames_ev_noop; + + return car_u; + +} \ No newline at end of file diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 8d03793b6..da821e5e6 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -764,7 +764,6 @@ _pier_init(c3_w wag_w, c3_c* pax_c) // XX remove // - pir_u->sam_u = c3_calloc(sizeof(u3_ames)); pir_u->por_s = u3_Host.ops_u.por_s; pir_u->unx_u = c3_calloc(sizeof(u3_unix)); pir_u->sav_u = c3_calloc(sizeof(u3_save)); @@ -1169,10 +1168,10 @@ _pier_loop_wake(u3_auto* car_u) u3_unix_ef_bake(pir_u); u3a_lop(cod_l); - cod_l = u3a_lush(c3__ames); - u3_ames_io_talk(pir_u); - u3_ames_ef_bake(pir_u); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__ames); + // u3_ames_io_talk(pir_u); + // u3_ames_ef_bake(pir_u); + // u3a_lop(cod_l); // cod_l = u3a_lush(c3__behn); // u3_behn_ef_bake(pir_u); @@ -1206,9 +1205,9 @@ _pier_loop_exit(u3_auto* car_u) u3_unix_io_exit(pir_u); u3a_lop(cod_l); - cod_l = u3a_lush(c3__ames); - u3_ames_io_exit(pir_u); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__ames); + // u3_ames_io_exit(pir_u); + // u3a_lop(cod_l); cod_l = u3a_lush(c3__save); u3_save_io_exit(pir_u); @@ -1268,6 +1267,14 @@ _pier_loop_init(u3_pier* pir_u) las_u = &rac_u->nex_u; } + { + u3_auto* rac_u = u3_ames_io_init(pir_u); + rac_u->pir_u = pir_u; + + *las_u = rac_u; + las_u = &rac_u->nex_u; + } + { u3_auto* rac_u = c3_calloc(sizeof(*rac_u)); rac_u->nam_m = u3_blip; @@ -1294,9 +1301,9 @@ _pier_loop_init(u3_pier* pir_u) // u3v_numb(); - cod_l = u3a_lush(c3__ames); - u3_ames_io_init(pir_u); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__ames); + // u3_ames_io_init(pir_u); + // u3a_lop(cod_l); // cod_l = u3a_lush(c3__behn); // u3_behn_io_init(pir_u); diff --git a/pkg/urbit/vere/reck.c b/pkg/urbit/vere/reck.c index f3d4169d1..8b50107c1 100644 --- a/pkg/urbit/vere/reck.c +++ b/pkg/urbit/vere/reck.c @@ -102,16 +102,16 @@ _reck_kick_term(u3_pier* pir_u, u3_noun pox, c3_l tid_l, u3_noun fav) u3z(pox); u3z(fav); return c3y; } break; - // this can return through dill due to our fscked up boot sequence - // - case c3__send: { - u3_noun lan = u3k(u3h(u3t(fav))); - u3_noun pac = u3k(u3t(u3t(fav))); + // // this can return through dill due to our fscked up boot sequence + // // + // case c3__send: { + // u3_noun lan = u3k(u3h(u3t(fav))); + // u3_noun pac = u3k(u3t(u3t(fav))); - u3l_log("kick: strange send\r\n"); - u3_ames_ef_send(pir_u, lan, pac); - u3z(pox); u3z(fav); return c3y; - } break; + // u3l_log("kick: strange send\r\n"); + // u3_ames_ef_send(pir_u, lan, pac); + // u3z(pox); u3z(fav); return c3y; + // } break; case c3__logo: { @@ -214,74 +214,74 @@ _reck_kick_sync(u3_pier* pir_u, u3_noun pox, u3_noun fav) u3z(pox); u3z(fav); return c3n; } -/* _reck_kick_newt(): apply packet network outputs. -*/ -static u3_noun -_reck_kick_newt(u3_pier* pir_u, u3_noun pox, u3_noun fav) -{ - switch ( u3h(fav) ) { - default: break; +// /* _reck_kick_newt(): apply packet network outputs. +// */ +// static u3_noun +// _reck_kick_newt(u3_pier* pir_u, u3_noun pox, u3_noun fav) +// { +// switch ( u3h(fav) ) { +// default: break; - case c3__send: { - u3_noun lan = u3k(u3h(u3t(fav))); - u3_noun pac = u3k(u3t(u3t(fav))); +// case c3__send: { +// u3_noun lan = u3k(u3h(u3t(fav))); +// u3_noun pac = u3k(u3t(u3t(fav))); - u3_ames_ef_send(pir_u, lan, pac); - u3z(pox); u3z(fav); return c3y; - } break; +// u3_ames_ef_send(pir_u, lan, pac); +// u3z(pox); u3z(fav); return c3y; +// } break; - case c3__turf: { - u3_ames_ef_turf(pir_u, u3k(u3t(fav))); - u3z(pox); u3z(fav); return c3y; - } break; +// case c3__turf: { +// u3_ames_ef_turf(pir_u, u3k(u3t(fav))); +// u3z(pox); u3z(fav); return c3y; +// } break; - } - u3z(pox); u3z(fav); return c3n; -} +// } +// u3z(pox); u3z(fav); return c3n; +// } -/* _reck_kick_ames(): apply packet network outputs. -*/ -static u3_noun -_reck_kick_ames(u3_pier* pir_u, u3_noun pox, u3_noun fav) -{ - u3_noun p_fav; +// /* _reck_kick_ames(): apply packet network outputs. +// */ +// static u3_noun +// _reck_kick_ames(u3_pier* pir_u, u3_noun pox, u3_noun fav) +// { +// u3_noun p_fav; - switch ( u3h(fav) ) { - default: break; - case c3__init: p_fav = u3t(fav); - { - // daemon ignores %init - // u3A->own = u3nc(u3k(p_fav), u3A->own); - // u3l_log("kick: init: %d\n", p_fav); - u3z(pox); u3z(fav); return c3y; - } break; +// switch ( u3h(fav) ) { +// default: break; +// case c3__init: p_fav = u3t(fav); +// { +// // daemon ignores %init +// // u3A->own = u3nc(u3k(p_fav), u3A->own); +// // u3l_log("kick: init: %d\n", p_fav); +// u3z(pox); u3z(fav); return c3y; +// } break; - case c3__west: { - u3_noun who, cha, dat; - u3x_trel(u3t(fav), &who, &cha, &dat); +// case c3__west: { +// u3_noun who, cha, dat; +// u3x_trel(u3t(fav), &who, &cha, &dat); - // XX route by cha path? - // s/b //give/prox - // - switch ( u3h(dat) ) { - default: break; +// // XX route by cha path? +// // s/b //give/prox +// // +// switch ( u3h(dat) ) { +// default: break; - case c3__that: { - u3_http_ef_that(u3k(who), u3k(u3t(dat))); - u3z(pox); u3z(fav); return c3y; - } - } - } +// case c3__that: { +// u3_http_ef_that(u3k(who), u3k(u3t(dat))); +// u3z(pox); u3z(fav); return c3y; +// } +// } +// } - case c3__woot: { - // XX print tang if nack? - // - u3z(pox); u3z(fav); return c3y; - } - } +// case c3__woot: { +// // XX print tang if nack? +// // +// u3z(pox); u3z(fav); return c3y; +// } +// } - u3z(pox); u3z(fav); return c3n; -} +// u3z(pox); u3z(fav); return c3n; +// } /* _reck_kick_spec(): apply an effect, by path. */ @@ -363,18 +363,18 @@ _reck_kick_spec(u3_pier* pir_u, u3_noun pox, u3_noun fav) return _reck_kick_sync(pir_u, pox, fav); } break; - case c3__newt: { - return _reck_kick_newt(pir_u, pox, fav); - } break; + // case c3__newt: { + // return _reck_kick_newt(pir_u, pox, fav); + // } break; - case c3__ames: { - if ( (u3_nul != tt_pox) ) { - u3z(pox); u3z(fav); return c3n; - } - else { - return _reck_kick_ames(pir_u, pox, fav); - } - } break; + // case c3__ames: { + // if ( (u3_nul != tt_pox) ) { + // u3z(pox); u3z(fav); return c3n; + // } + // else { + // return _reck_kick_ames(pir_u, pox, fav); + // } + // } break; case c3__init: { // daemon ignores %init From 2e5b44671c9fd21ce8084428b996eb8cfa559a9a Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 17 Apr 2020 23:20:33 -0700 Subject: [PATCH 017/257] vere: WIP moves unix.c to u3_auto --- pkg/urbit/include/vere/vere.h | 123 +----------- pkg/urbit/vere/pier.c | 29 +-- pkg/urbit/vere/reck.c | 70 +++---- pkg/urbit/vere/unix.c | 352 ++++++++++++++++++++++++---------- 4 files changed, 308 insertions(+), 266 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index f019a6f7c..f0673a8c3 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -371,51 +371,6 @@ } sun_u; } u3_utat; - struct _u3_umon; - struct _u3_udir; - struct _u3_ufil; - - /* u3_unod: file or directory. - */ - typedef struct _u3_unod { - c3_o dir; // c3y if dir, c3n if file - c3_o dry; // ie, unmodified - c3_c* pax_c; // absolute path - struct _u3_udir* par_u; // parent - struct _u3_unod* nex_u; // internal list - } u3_unod; - - /* u3_ufil: synchronized file. - */ - typedef struct _u3_ufil { - c3_o dir; // c3y if dir, c3n if file - c3_o dry; // ie, unmodified - c3_c* pax_c; // absolute path - struct _u3_udir* par_u; // parent - struct _u3_unod* nex_u; // internal list - c3_w mug_w; // mug of last %into - c3_w gum_w; // mug of last %ergo - } u3_ufil; - - /* u3_ufil: synchronized directory. - */ - typedef struct _u3_udir { - c3_o dir; // c3y if dir, c3n if file - c3_o dry; // ie, unmodified - c3_c* pax_c; // absolute path - struct _u3_udir* par_u; // parent - struct _u3_unod* nex_u; // internal list - u3_unod* kid_u; // subnodes - } u3_udir; - - /* u3_ufil: synchronized mount point. - */ - typedef struct _u3_umon { - u3_udir dir_u; // root directory, must be first - c3_c* nam_c; // mount point name - struct _u3_umon* nex_u; // internal list - } u3_umon; - /* u3_usig: receive signals. */ typedef struct _u3_usig { @@ -424,23 +379,6 @@ struct _u3_usig* nex_u; } u3_usig; - /* u3_unix: clay support system, also - */ - typedef struct _u3_unix { - u3_umon* mon_u; // mount points - c3_o alm; // timer set - c3_o dyr; // ready to update -#ifdef SYNCLOG - c3_w lot_w; // sync-slot - struct _u3_sylo { - c3_o unx; // from unix - c3_m wer_m; // mote saying where - c3_m wot_m; // mote saying what - c3_c* pax_c; // path - } sylo[1024]; -#endif - } u3_unix; - /* u2_utfo: unix terminfo strings. */ typedef struct { @@ -794,7 +732,6 @@ uv_idle_t idl_u; // postloop registration // XX remove c3_s por_s; // UDP port - u3_unix* unx_u; // sync and clay u3_save* sav_u; // autosave } u3_pier; @@ -1172,71 +1109,15 @@ /** Storage, new school. **/ - /* u3_unix_ef_hold(): - */ - void - u3_unix_ef_hold(void); - - /* u3_unix_ef_boot(): boot actions - */ - void - u3_unix_ef_boot(u3_pier *pir_u); - - /* u3_unix_ef_bake(): initial effects for new process. - */ - void - u3_unix_ef_bake(u3_pier *pir_u); - - /* u3_unix_ef_move(): - */ - void - u3_unix_ef_move(void); - /* u3_unix_initial_into_card(): create initial filesystem sync card. */ u3_noun u3_unix_initial_into_card(c3_c* arv_c); - /* u3_unix_ef_look(): update filesystem from unix - */ - void - u3_unix_ef_look(u3_pier *pir_u, u3_noun all); - - /* u3_unix_ef_ergo(): update filesystem from urbit - */ - void - u3_unix_ef_ergo(u3_pier *pir_u, u3_noun mon, u3_noun can); - - /* u3_unix_ef_dirk(): mark mount dirty - */ - void - u3_unix_ef_dirk(u3_pier *pir_u, u3_noun mon); - - /* u3_unix_ef_ogre(): delete mount point - */ - void - u3_unix_ef_ogre(u3_pier *pir_u, u3_noun mon); - - /* u3_unix_ef_hill(): enumerate mount points - */ - void - u3_unix_ef_hill(u3_pier *pir_u, u3_noun hil); - /* u3_unix_io_init(): initialize storage. */ - void - u3_unix_io_init(u3_pier *pir_u); - - /* u3_unix_io_talk(): start listening for fs events. - */ - void - u3_unix_io_talk(u3_pier *pir_u); - - /* u3_unix_io_exit(): terminate storage. - */ - void - u3_unix_io_exit(u3_pier *pir_u); - + u3_auto* + u3_unix_io_init(u3_pier* pir_u); /** behn, just a timer. **/ diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index da821e5e6..a39055f51 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -765,7 +765,6 @@ _pier_init(c3_w wag_w, c3_c* pax_c) // XX remove // pir_u->por_s = u3_Host.ops_u.por_s; - pir_u->unx_u = c3_calloc(sizeof(u3_unix)); pir_u->sav_u = c3_calloc(sizeof(u3_save)); // initialize pre i/o polling handle @@ -1163,10 +1162,10 @@ _pier_loop_wake(u3_auto* car_u) u3_pier_work(pir_u, wir, car); } - cod_l = u3a_lush(c3__unix); - u3_unix_io_talk(pir_u); - u3_unix_ef_bake(pir_u); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__unix); + // u3_unix_io_talk(pir_u); + // u3_unix_ef_bake(pir_u); + // u3a_lop(cod_l); // cod_l = u3a_lush(c3__ames); // u3_ames_io_talk(pir_u); @@ -1201,9 +1200,9 @@ _pier_loop_exit(u3_auto* car_u) u3_pier* pir_u = car_u->pir_u; c3_l cod_l; - cod_l = u3a_lush(c3__unix); - u3_unix_io_exit(pir_u); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__unix); + // u3_unix_io_exit(pir_u); + // u3a_lop(cod_l); // cod_l = u3a_lush(c3__ames); // u3_ames_io_exit(pir_u); @@ -1259,6 +1258,14 @@ _pier_loop_init(u3_pier* pir_u) u3_auto* car_u; u3_auto** las_u = &car_u; + { + u3_auto* rac_u = u3_unix_io_init(pir_u); + rac_u->pir_u = pir_u; + + *las_u = rac_u; + las_u = &rac_u->nex_u; + } + { u3_auto* rac_u = u3_behn_io_init(pir_u); rac_u->pir_u = pir_u; @@ -1309,9 +1316,9 @@ _pier_loop_init(u3_pier* pir_u) // u3_behn_io_init(pir_u); // u3a_lop(cod_l); - cod_l = u3a_lush(c3__unix); - u3_unix_io_init(pir_u); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__unix); + // u3_unix_io_init(pir_u); + // u3a_lop(cod_l); cod_l = u3a_lush(c3__save); u3_save_io_init(pir_u); diff --git a/pkg/urbit/vere/reck.c b/pkg/urbit/vere/reck.c index 8b50107c1..6f682e8e7 100644 --- a/pkg/urbit/vere/reck.c +++ b/pkg/urbit/vere/reck.c @@ -181,38 +181,38 @@ _reck_kick_arvo(u3_pier* pir_u, u3_noun pox, u3_noun fav) // u3z(pox); u3z(fav); return c3n; // } -/* _reck_kick_sync(): apply sync outputs. -*/ -static u3_noun -_reck_kick_sync(u3_pier* pir_u, u3_noun pox, u3_noun fav) -{ - switch ( u3h(fav) ) { - default: break; - case c3__dirk: { - u3_unix_ef_dirk(pir_u, u3k(u3t(fav))); - u3z(pox); u3z(fav); return c3y; - } - case c3__ergo: { - u3_noun mon = u3k(u3h(u3t(fav))); - u3_noun can = u3k(u3t(u3t(fav))); +// /* _reck_kick_sync(): apply sync outputs. +// */ +// static u3_noun +// _reck_kick_sync(u3_pier* pir_u, u3_noun pox, u3_noun fav) +// { +// switch ( u3h(fav) ) { +// default: break; +// case c3__dirk: { +// u3_unix_ef_dirk(pir_u, u3k(u3t(fav))); +// u3z(pox); u3z(fav); return c3y; +// } +// case c3__ergo: { +// u3_noun mon = u3k(u3h(u3t(fav))); +// u3_noun can = u3k(u3t(u3t(fav))); - u3_unix_ef_ergo(pir_u, mon, can); - u3z(pox); u3z(fav); return c3y; - } break; - case c3__ogre: { - u3_unix_ef_ogre(pir_u, u3k(u3t(fav))); - u3z(pox); u3z(fav); return c3y; - } - case c3__hill: { - u3_unix_ef_hill(pir_u, u3k(u3t(fav))); - u3z(pox); u3z(fav); return c3y; - } - } +// u3_unix_ef_ergo(pir_u, mon, can); +// u3z(pox); u3z(fav); return c3y; +// } break; +// case c3__ogre: { +// u3_unix_ef_ogre(pir_u, u3k(u3t(fav))); +// u3z(pox); u3z(fav); return c3y; +// } +// case c3__hill: { +// u3_unix_ef_hill(pir_u, u3k(u3t(fav))); +// u3z(pox); u3z(fav); return c3y; +// } +// } - // XX obviously not right! - // ? looks fine to me - u3z(pox); u3z(fav); return c3n; -} +// // XX obviously not right! +// // ? looks fine to me +// u3z(pox); u3z(fav); return c3n; +// } // /* _reck_kick_newt(): apply packet network outputs. // */ @@ -357,11 +357,11 @@ _reck_kick_spec(u3_pier* pir_u, u3_noun pox, u3_noun fav) // return _reck_kick_behn(pir_u, pox, fav); // } break; - case c3__clay: - case c3__boat: - case c3__sync: { - return _reck_kick_sync(pir_u, pox, fav); - } break; + // case c3__clay: + // case c3__boat: + // case c3__sync: { + // return _reck_kick_sync(pir_u, pox, fav); + // } break; // case c3__newt: { // return _reck_kick_newt(pir_u, pox, fav); diff --git a/pkg/urbit/vere/unix.c b/pkg/urbit/vere/unix.c index badd5289e..0fee14cdc 100644 --- a/pkg/urbit/vere/unix.c +++ b/pkg/urbit/vere/unix.c @@ -15,7 +15,77 @@ #include "vere/vere.h" -c3_w u3_readdir_r(DIR *dirp, struct dirent *entry, struct dirent **result) +struct _u3_umon; +struct _u3_udir; +struct _u3_ufil; + +/* u3_unod: file or directory. +*/ + typedef struct _u3_unod { + c3_o dir; // c3y if dir, c3n if file + c3_o dry; // ie, unmodified + c3_c* pax_c; // absolute path + struct _u3_udir* par_u; // parent + struct _u3_unod* nex_u; // internal list + } u3_unod; + +/* u3_ufil: synchronized file. +*/ + typedef struct _u3_ufil { + c3_o dir; // c3y if dir, c3n if file + c3_o dry; // ie, unmodified + c3_c* pax_c; // absolute path + struct _u3_udir* par_u; // parent + struct _u3_unod* nex_u; // internal list + c3_w mug_w; // mug of last %into + c3_w gum_w; // mug of last %ergo + } u3_ufil; + +/* u3_ufil: synchronized directory. +*/ + typedef struct _u3_udir { + c3_o dir; // c3y if dir, c3n if file + c3_o dry; // ie, unmodified + c3_c* pax_c; // absolute path + struct _u3_udir* par_u; // parent + struct _u3_unod* nex_u; // internal list + u3_unod* kid_u; // subnodes + } u3_udir; + +/* u3_ufil: synchronized mount point. +*/ + typedef struct _u3_umon { + u3_udir dir_u; // root directory, must be first + c3_c* nam_c; // mount point name + struct _u3_umon* nex_u; // internal list + } u3_umon; + +/* u3_unix: clay support system, also +*/ + typedef struct _u3_unix { + u3_auto car_u; + u3_umon* mon_u; // mount points + c3_c* pax_c; // pier directory + c3_o alm; // timer set + c3_o dyr; // ready to update +#ifdef SYNCLOG + c3_w lot_w; // sync-slot + struct _u3_sylo { + c3_o unx; // from unix + c3_m wer_m; // mote saying where + c3_m wot_m; // mote saying what + c3_c* pax_c; // path + } sylo[1024]; +#endif + } u3_unix; + +void +u3_unix_ef_look(u3_unix* unx_u, u3_noun all); + +/* u3_readdir_r(): +*/ +c3_w +u3_readdir_r(DIR *dirp, struct dirent *entry, struct dirent **result) { errno = 0; struct dirent * tmp_u = readdir(dirp); @@ -31,7 +101,6 @@ c3_w u3_readdir_r(DIR *dirp, struct dirent *entry, struct dirent **result) return(0); } - /* _unix_down(): descend path. */ static c3_c* @@ -54,7 +123,8 @@ _unix_down(c3_c* pax_c, c3_c* sub_c) * c string must begin with the pier path plus mountpoint */ static u3_noun -_unix_string_to_path_helper(c3_c* pax_c) { +_unix_string_to_path_helper(c3_c* pax_c) +{ c3_assert(pax_c[-1] == '/'); c3_c* end_w = strchr(pax_c, '/'); if ( !end_w ) { @@ -74,8 +144,9 @@ _unix_string_to_path_helper(c3_c* pax_c) { } } static u3_noun -_unix_string_to_path(u3_pier *pir_u, c3_c* pax_c) { - pax_c += strlen(pir_u->pax_c) + 1; +_unix_string_to_path(u3_unix* unx_u, c3_c* pax_c) +{ + pax_c += strlen(unx_u->pax_c) + 1; c3_c* pox_c = strchr(pax_c, '/'); if ( !pox_c ) { pox_c = strchr(pax_c, '.'); @@ -265,12 +336,12 @@ _unix_write_file_soft_go: static void _unix_watch_dir(u3_udir* dir_u, u3_udir* par_u, c3_c* pax_c); static void -_unix_watch_file(u3_pier *pir_u, u3_ufil* fil_u, u3_udir* par_u, c3_c* pax_c); +_unix_watch_file(u3_unix* unx_u, u3_ufil* fil_u, u3_udir* par_u, c3_c* pax_c); /* _unix_get_mount_point(): retrieve or create mount point */ static u3_umon* -_unix_get_mount_point(u3_pier *pir_u, u3_noun mon) +_unix_get_mount_point(u3_unix* unx_u, u3_noun mon) { if ( c3n == u3ud(mon) ) { c3_assert(!"mount point must be an atom"); @@ -281,7 +352,7 @@ _unix_get_mount_point(u3_pier *pir_u, u3_noun mon) c3_c* nam_c = u3r_string(mon); u3_umon* mon_u; - for ( mon_u = pir_u->unx_u->mon_u; + for ( mon_u = unx_u->mon_u; mon_u && 0 != strcmp(nam_c, mon_u->nam_c); mon_u = mon_u->nex_u ) { @@ -292,13 +363,12 @@ _unix_get_mount_point(u3_pier *pir_u, u3_noun mon) mon_u->nam_c = nam_c; mon_u->dir_u.dir = c3y; mon_u->dir_u.dry = c3n; - mon_u->dir_u.pax_c = strdup(pir_u->pax_c); + mon_u->dir_u.pax_c = strdup(unx_u->pax_c); mon_u->dir_u.par_u = NULL; mon_u->dir_u.nex_u = NULL; mon_u->dir_u.kid_u = NULL; - mon_u->nex_u = pir_u->unx_u->mon_u; - pir_u->unx_u->mon_u = mon_u; - + mon_u->nex_u = unx_u->mon_u; + unx_u->mon_u = mon_u; } else { c3_free(nam_c); @@ -312,7 +382,7 @@ _unix_get_mount_point(u3_pier *pir_u, u3_noun mon) /* _unix_scan_mount_point(): scan unix for already-existing mount point */ static void -_unix_scan_mount_point(u3_pier *pir_u, u3_umon* mon_u) +_unix_scan_mount_point(u3_unix* unx_u, u3_umon* mon_u) { DIR* rid_u = opendir(mon_u->dir_u.pax_c); if ( !rid_u ) { @@ -376,7 +446,7 @@ _unix_scan_mount_point(u3_pier *pir_u, u3_umon* mon_u) } else { u3_ufil* fil_u = c3_malloc(sizeof(u3_ufil)); - _unix_watch_file(pir_u, fil_u, &mon_u->dir_u, pax_c); + _unix_watch_file(unx_u, fil_u, &mon_u->dir_u, pax_c); } } @@ -385,7 +455,7 @@ _unix_scan_mount_point(u3_pier *pir_u, u3_umon* mon_u) } } -static u3_noun _unix_free_node(u3_pier *pir_u, u3_unod* nod_u); +static u3_noun _unix_free_node(u3_unix* unx_u, u3_unod* nod_u); /* _unix_free_file(): free file, unlinking it */ @@ -426,7 +496,7 @@ _unix_free_dir(u3_udir *dir_u) * also deletes from parent list if in it */ static u3_noun -_unix_free_node(u3_pier *pir_u, u3_unod* nod_u) +_unix_free_node(u3_unix* unx_u, u3_unod* nod_u) { u3_noun can; if ( nod_u->par_u ) { @@ -451,13 +521,13 @@ _unix_free_node(u3_pier *pir_u, u3_unod* nod_u) u3_unod* nud_u = ((u3_udir*) nod_u)->kid_u; while ( nud_u ) { u3_unod* nex_u = nud_u->nex_u; - can = u3kb_weld(_unix_free_node(pir_u, nud_u), can); + can = u3kb_weld(_unix_free_node(unx_u, nud_u), can); nud_u = nex_u; } _unix_free_dir((u3_udir *)nod_u); } else { - can = u3nc(u3nc(_unix_string_to_path(pir_u, nod_u->pax_c), u3_nul), + can = u3nc(u3nc(_unix_string_to_path(unx_u, nod_u->pax_c), u3_nul), u3_nul); _unix_free_file((u3_ufil *)nod_u); } @@ -474,12 +544,12 @@ _unix_free_node(u3_pier *pir_u, u3_unod* nod_u) * tread carefully */ static void -_unix_free_mount_point(u3_pier *pir_u, u3_umon* mon_u) +_unix_free_mount_point(u3_unix* unx_u, u3_umon* mon_u) { u3_unod* nod_u; for ( nod_u = mon_u->dir_u.kid_u; nod_u; ) { u3_unod* nex_u = nod_u->nex_u; - u3z(_unix_free_node(pir_u, nod_u)); + u3z(_unix_free_node(unx_u, nod_u)); nod_u = nex_u; } @@ -491,7 +561,7 @@ _unix_free_mount_point(u3_pier *pir_u, u3_umon* mon_u) /* _unix_delete_mount_point(): remove mount point from list and free */ static void -_unix_delete_mount_point(u3_pier *pir_u, u3_noun mon) +_unix_delete_mount_point(u3_unix* unx_u, u3_noun mon) { if ( c3n == u3ud(mon) ) { c3_assert(!"mount point must be an atom"); @@ -503,14 +573,14 @@ _unix_delete_mount_point(u3_pier *pir_u, u3_noun mon) u3_umon* mon_u; u3_umon* tem_u; - mon_u = pir_u->unx_u->mon_u; + mon_u = unx_u->mon_u; if ( !mon_u ) { u3l_log("mount point already gone: %s\r\n", nam_c); goto _delete_mount_point_out; } if ( 0 == strcmp(nam_c, mon_u->nam_c) ) { - pir_u->unx_u->mon_u = mon_u->nex_u; - _unix_free_mount_point(pir_u, mon_u); + unx_u->mon_u = mon_u->nex_u; + _unix_free_mount_point(unx_u, mon_u); goto _delete_mount_point_out; } @@ -527,7 +597,7 @@ _unix_delete_mount_point(u3_pier *pir_u, u3_noun mon) tem_u = mon_u->nex_u; mon_u->nex_u = mon_u->nex_u->nex_u; - _unix_free_mount_point(pir_u, tem_u); + _unix_free_mount_point(unx_u, tem_u); _delete_mount_point_out: c3_free(nam_c); @@ -537,18 +607,18 @@ _delete_mount_point_out: /* _unix_commit_mount_point: commit from mount point */ static void -_unix_commit_mount_point(u3_pier *pir_u, u3_noun mon) +_unix_commit_mount_point(u3_unix* unx_u, u3_noun mon) { - pir_u->unx_u->dyr = c3y; + unx_u->dyr = c3y; u3z(mon); - u3_unix_ef_look(pir_u, c3n); + u3_unix_ef_look(unx_u, c3n); return; } /* _unix_watch_file(): initialize file */ static void -_unix_watch_file(u3_pier *pir_u, u3_ufil* fil_u, u3_udir* par_u, c3_c* pax_c) +_unix_watch_file(u3_unix* unx_u, u3_ufil* fil_u, u3_udir* par_u, c3_c* pax_c) { // initialize fil_u @@ -610,7 +680,7 @@ _unix_create_dir(u3_udir* dir_u, u3_udir* par_u, u3_noun nam) _unix_watch_dir(dir_u, par_u, pax_c); } -static u3_noun _unix_update_node(u3_pier *pir_u, u3_unod* nod_u); +static u3_noun _unix_update_node(u3_unix* unx_u, u3_unod* nod_u); /* _unix_update_file(): update file, producing list of changes * @@ -621,7 +691,7 @@ static u3_noun _unix_update_node(u3_pier *pir_u, u3_unod* nod_u); * mug_w with new mug and add path plus data to %into event. */ static u3_noun -_unix_update_file(u3_pier *pir_u, u3_ufil* fil_u) +_unix_update_file(u3_unix* unx_u, u3_ufil* fil_u) { c3_assert( c3n == fil_u->dir ); @@ -638,7 +708,7 @@ _unix_update_file(u3_pier *pir_u, u3_ufil* fil_u) if ( fid_i < 0 || fstat(fid_i, &buf_u) < 0 ) { if ( ENOENT == errno ) { - return u3nc(u3nc(_unix_string_to_path(pir_u, fil_u->pax_c), u3_nul), u3_nul); + return u3nc(u3nc(_unix_string_to_path(unx_u, fil_u->pax_c), u3_nul), u3_nul); } else { u3l_log("error opening file %s: %s\r\n", @@ -683,7 +753,7 @@ _unix_update_file(u3_pier *pir_u, u3_ufil* fil_u) else { fil_u->mug_w = mug_w; - u3_noun pax = _unix_string_to_path(pir_u, fil_u->pax_c); + u3_noun pax = _unix_string_to_path(unx_u, fil_u->pax_c); u3_noun mim = u3nt(c3__text, u3i_string("plain"), u3_nul); u3_noun dat = u3nt(mim, len_ws, u3i_bytes(len_ws, dat_y)); @@ -699,7 +769,7 @@ _unix_update_file(u3_pier *pir_u, u3_ufil* fil_u) * _unix_initial_update_dir() */ static u3_noun -_unix_update_dir(u3_pier *pir_u, u3_udir* dir_u) +_unix_update_dir(u3_unix* unx_u, u3_udir* dir_u) { u3_noun can = u3_nul; @@ -725,7 +795,7 @@ _unix_update_dir(u3_pier *pir_u, u3_udir* dir_u) DIR* red_u = opendir(nod_u->pax_c); if ( 0 == red_u ) { u3_unod* nex_u = nod_u->nex_u; - can = u3kb_weld(_unix_free_node(pir_u, nod_u), can); + can = u3kb_weld(_unix_free_node(unx_u, nod_u), can); nod_u = nex_u; } else { @@ -744,7 +814,7 @@ _unix_update_dir(u3_pier *pir_u, u3_udir* dir_u) } u3_unod* nex_u = nod_u->nex_u; - can = u3kb_weld(_unix_free_node(pir_u, nod_u), can); + can = u3kb_weld(_unix_free_node(unx_u, nod_u), can); nod_u = nex_u; } else { @@ -828,12 +898,12 @@ _unix_update_dir(u3_pier *pir_u, u3_udir* dir_u) } u3_ufil* fil_u = c3_malloc(sizeof(u3_ufil)); - _unix_watch_file(pir_u, fil_u, dir_u, pax_c); + _unix_watch_file(unx_u, fil_u, dir_u, pax_c); } else { u3_udir* dis_u = c3_malloc(sizeof(u3_udir)); _unix_watch_dir(dis_u, dir_u, pax_c); - can = u3kb_weld(_unix_update_dir(pir_u, dis_u), can); // XXX unnecessary? + can = u3kb_weld(_unix_update_dir(unx_u, dis_u), can); // XXX unnecessary? } } } @@ -848,13 +918,13 @@ _unix_update_dir(u3_pier *pir_u, u3_udir* dir_u) } if ( !dir_u->kid_u ) { - return u3kb_weld(_unix_free_node(pir_u, (u3_unod*) dir_u), can); + return u3kb_weld(_unix_free_node(unx_u, (u3_unod*) dir_u), can); } // get change list for ( nod_u = dir_u->kid_u; nod_u; nod_u = nod_u->nex_u ) { - can = u3kb_weld(_unix_update_node(pir_u, nod_u), can); + can = u3kb_weld(_unix_update_node(unx_u, nod_u), can); } return can; @@ -863,31 +933,35 @@ _unix_update_dir(u3_pier *pir_u, u3_udir* dir_u) /* _unix_update_node(): update node, producing list of changes */ static u3_noun -_unix_update_node(u3_pier *pir_u, u3_unod* nod_u) +_unix_update_node(u3_unix* unx_u, u3_unod* nod_u) { if ( c3y == nod_u->dir ) { - return _unix_update_dir(pir_u, (void*)nod_u); + return _unix_update_dir(unx_u, (void*)nod_u); } else { - return _unix_update_file(pir_u, (void*)nod_u); + return _unix_update_file(unx_u, (void*)nod_u); } } /* _unix_update_mount(): update mount point */ static void -_unix_update_mount(u3_pier *pir_u, u3_umon* mon_u, u3_noun all) +_unix_update_mount(u3_unix* unx_u, u3_umon* mon_u, u3_noun all) { if ( c3n == mon_u->dir_u.dry ) { u3_noun can = u3_nul; u3_unod* nod_u; for ( nod_u = mon_u->dir_u.kid_u; nod_u; nod_u = nod_u->nex_u ) { - can = u3kb_weld(_unix_update_node(pir_u, nod_u), can); + can = u3kb_weld(_unix_update_node(unx_u, nod_u), can); } - u3_pier_work(pir_u, - u3nq(u3_blip, c3__sync, u3k(u3A->sen), u3_nul), - u3nq(c3__into, u3i_string(mon_u->nam_c), all, can)); + { + + u3_noun pax = u3nq(u3_blip, c3__sync, u3k(u3A->sen), u3_nul); + u3_noun fav = u3nq(c3__into, u3i_string(mon_u->nam_c), all, can); + + u3_auto_plan(&unx_u->car_u, 0, 0, u3_blip, pax, fav); + } } } @@ -1024,7 +1098,7 @@ u3_unix_initial_into_card(c3_c* arv_c) /* _unix_sync_file(): sync file to unix */ static void -_unix_sync_file(u3_pier *pir_u, u3_udir* par_u, u3_noun nam, u3_noun ext, u3_noun mim) +_unix_sync_file(u3_unix* unx_u, u3_udir* par_u, u3_noun nam, u3_noun ext, u3_noun mim) { c3_assert( par_u ); c3_assert( c3y == par_u->dir ); @@ -1062,7 +1136,7 @@ _unix_sync_file(u3_pier *pir_u, u3_udir* par_u, u3_noun nam, u3_noun ext, u3_nou if ( u3_nul == mim ) { if ( nod_u ) { - u3z(_unix_free_node(pir_u, nod_u)); + u3z(_unix_free_node(unx_u, nod_u)); } } else { @@ -1070,7 +1144,7 @@ _unix_sync_file(u3_pier *pir_u, u3_udir* par_u, u3_noun nam, u3_noun ext, u3_nou if ( !nod_u ) { c3_w gum_w = _unix_write_file_hard(pax_c, u3k(u3t(mim))); u3_ufil* fil_u = c3_malloc(sizeof(u3_ufil)); - _unix_watch_file(pir_u, fil_u, par_u, pax_c); + _unix_watch_file(unx_u, fil_u, par_u, pax_c); fil_u->gum_w = gum_w; goto _unix_sync_file_out; } @@ -1088,7 +1162,7 @@ _unix_sync_file_out: /* _unix_sync_change(): sync single change to unix */ static void -_unix_sync_change(u3_pier *pir_u, u3_udir* dir_u, u3_noun pax, u3_noun mim) +_unix_sync_change(u3_unix* unx_u, u3_udir* dir_u, u3_noun pax, u3_noun mim) { c3_assert( c3y == dir_u->dir ); @@ -1113,7 +1187,7 @@ _unix_sync_change(u3_pier *pir_u, u3_udir* dir_u, u3_noun pax, u3_noun mim) u3_noun tt_pax = u3t(t_pax); if ( u3_nul == tt_pax ) { - _unix_sync_file(pir_u, dir_u, u3k(i_pax), u3k(it_pax), mim); + _unix_sync_file(unx_u, dir_u, u3k(i_pax), u3k(it_pax), mim); } else { c3_c* nam_c = u3r_string(i_pax); @@ -1137,7 +1211,7 @@ _unix_sync_change(u3_pier *pir_u, u3_udir* dir_u, u3_noun pax, u3_noun mim) c3_assert(0); } - _unix_sync_change(pir_u, (u3_udir*) nod_u, u3k(t_pax), mim); + _unix_sync_change(unx_u, (u3_udir*) nod_u, u3k(t_pax), mim); } } u3z(pax); @@ -1146,13 +1220,13 @@ _unix_sync_change(u3_pier *pir_u, u3_udir* dir_u, u3_noun pax, u3_noun mim) /* _unix_sync_ergo(): sync list of changes to unix */ static void -_unix_sync_ergo(u3_pier *pir_u, u3_umon* mon_u, u3_noun can) +_unix_sync_ergo(u3_unix* unx_u, u3_umon* mon_u, u3_noun can) { u3_noun nac = can; u3_noun nam = u3i_string(mon_u->nam_c); while ( u3_nul != nac) { - _unix_sync_change(pir_u, &mon_u->dir_u, + _unix_sync_change(unx_u, &mon_u->dir_u, u3nc(u3k(nam), u3k(u3h(u3h(nac)))), u3k(u3t(u3h(nac)))); nac = u3t(nac); @@ -1165,38 +1239,40 @@ _unix_sync_ergo(u3_pier *pir_u, u3_umon* mon_u, u3_noun can) /* u3_unix_ef_dirk(): commit mount point */ void -u3_unix_ef_dirk(u3_pier *pir_u, u3_noun mon) +u3_unix_ef_dirk(u3_unix* unx_u, u3_noun mon) { - _unix_commit_mount_point(pir_u, mon); + _unix_commit_mount_point(unx_u, mon); } /* u3_unix_ef_ergo(): update filesystem from urbit */ void -u3_unix_ef_ergo(u3_pier *pir_u, u3_noun mon, u3_noun can) +u3_unix_ef_ergo(u3_unix* unx_u, u3_noun mon, u3_noun can) { - u3_umon* mon_u = _unix_get_mount_point(pir_u, mon); + u3_umon* mon_u = _unix_get_mount_point(unx_u, mon); - _unix_sync_ergo(pir_u, mon_u, can); + _unix_sync_ergo(unx_u, mon_u, can); } /* u3_unix_ef_ogre(): delete mount point */ void -u3_unix_ef_ogre(u3_pier *pir_u, u3_noun mon) +u3_unix_ef_ogre(u3_unix* unx_u, u3_noun mon) { - _unix_delete_mount_point(pir_u, mon); + _unix_delete_mount_point(unx_u, mon); } /* u3_unix_ef_hill(): enumerate mount points */ void -u3_unix_ef_hill(u3_pier *pir_u, u3_noun hil) +u3_unix_ef_hill(u3_unix* unx_u, u3_noun hil) { + // XX set car_u->liv_o + // u3_noun mon; for ( mon = hil; c3y == u3du(mon); mon = u3t(mon) ) { - u3_umon* mon_u = _unix_get_mount_point(pir_u, u3k(u3h(mon))); - _unix_scan_mount_point(pir_u, mon_u); + u3_umon* mon_u = _unix_get_mount_point(unx_u, u3k(u3h(mon))); + _unix_scan_mount_point(unx_u, mon_u); } u3z(hil); } @@ -1275,55 +1351,133 @@ u3_unix_release(c3_c* pax_c) c3_free(paf_c); } -/* u3_unix_ef_bake(): initial effects for new process. -*/ -void -u3_unix_ef_bake(u3_pier *pir_u) -{ - u3_pier_work(pir_u, - u3nt(u3_blip, c3__boat, u3_nul), - u3nc(c3__boat, u3_nul)); -} - /* u3_unix_ef_look(): update the root. */ void -u3_unix_ef_look(u3_pier *pir_u, u3_noun all) +u3_unix_ef_look(u3_unix* unx_u, u3_noun all) { - if ( c3y == pir_u->unx_u->dyr ) { - pir_u->unx_u->dyr = c3n; + if ( c3y == unx_u->dyr ) { + unx_u->dyr = c3n; u3_umon* mon_u; - for ( mon_u = pir_u->unx_u->mon_u; mon_u; mon_u = mon_u->nex_u ) { - _unix_update_mount(pir_u, mon_u, all); + for ( mon_u = unx_u->mon_u; mon_u; mon_u = mon_u->nex_u ) { + _unix_update_mount(unx_u, mon_u, all); } } } +/* _unix_io_talk(): start listening for fs events. +*/ +static void +_unix_io_talk(u3_auto* car_u) +{ + u3_noun pax = u3nt(u3_blip, c3__boat, u3_nul); + u3_noun fav = u3nc(c3__boat, u3_nul); + + u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); +} + +/* _unix_io_fete(): +*/ +static c3_o +_unix_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +{ + u3_unix* unx_u = (u3_unix*)car_u; + + u3_noun i_pax, it_pax, tag, dat; + c3_o ret_o; + + if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, 0)) + || (c3n == u3r_cell(fav, &tag, &dat)) + || (u3_blip != i_pax ) + || ( (c3__clay != it_pax) + && (c3__boat != it_pax) + && (c3__sync != it_pax) ) ) + { + ret_o = c3n; + } + else { + switch ( tag ) { + default: { + ret_o = c3n; + } break; + + case c3__dirk: { + u3_unix_ef_dirk(unx_u, u3k(dat)); + ret_o = c3y; + } break; + + case c3__ergo: { + u3_noun mon = u3k(u3h(dat)); + u3_noun can = u3k(u3t(dat)); + u3_unix_ef_ergo(unx_u, mon, can); + + ret_o = c3y; + } break; + + case c3__ogre: { + u3_unix_ef_ogre(unx_u, u3k(dat)); + ret_o = c3y; + } break; + + case c3__hill: { + u3_unix_ef_hill(unx_u, u3k(dat)); + ret_o = c3y; + } break; + } + } + + u3z(pax); u3z(fav); + return ret_o; +} + +/* _unix_io_exit(): terminate unix I/O. +*/ +static void +_unix_io_exit(u3_auto* car_u) +{ + u3_unix* unx_u = (u3_unix*)car_u; + + // XX move to disk.c? + // + u3_unix_release(unx_u->pax_c); + + c3_free(unx_u->pax_c); + c3_free(unx_u); +} + +static void +_unix_ev_noop(u3_auto* car_u, void* vod_p) +{ +} + /* u3_unix_io_init(): initialize unix sync. */ -void -u3_unix_io_init(u3_pier *pir_u) +u3_auto* +u3_unix_io_init(u3_pier* pir_u) { - u3_unix* unx_u = pir_u->unx_u; - unx_u->mon_u = NULL; + u3_unix* unx_u = c3_calloc(sizeof(*unx_u)); + unx_u->mon_u = 0; + unx_u->pax_c = strdup(pir_u->pax_c); unx_u->alm = c3n; unx_u->dyr = c3n; - u3_unix_acquire(pir_u->pax_c); -} + // XX move to disk.c? + // + u3_unix_acquire(unx_u->pax_c); -/* u3_unix_io_talk(): start listening for fs events. -*/ -void -u3_unix_io_talk(u3_pier *pir_u) -{ -} + u3_auto* car_u = &unx_u->car_u; + car_u->nam_m = c3__unix; + car_u->liv_o = c3n; + car_u->io.talk_f = _unix_io_talk; + car_u->io.fete_f = _unix_io_fete; + car_u->io.exit_f = _unix_io_exit; -/* u3_unix_io_exit(): terminate unix I/O. -*/ -void -u3_unix_io_exit(u3_pier *pir_u) -{ - u3_unix_release(pir_u->pax_c); + car_u->ev.drop_f = _unix_ev_noop; + car_u->ev.work_f = _unix_ev_noop; + car_u->ev.done_f = _unix_ev_noop; + car_u->ev.swap_f = _unix_ev_noop; + car_u->ev.bail_f = _unix_ev_noop; + + return car_u; } From 3a711c2052ec83ed70477d3d67b613e69b4c03c4 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 18 Apr 2020 13:32:23 -0700 Subject: [PATCH 018/257] vere: WIP moves cttp.c to u3_auto --- pkg/urbit/include/vere/vere.h | 75 +--------- pkg/urbit/vere/cttp.c | 255 +++++++++++++++++++++++++--------- pkg/urbit/vere/pier.c | 22 ++- pkg/urbit/vere/reck.c | 10 +- 4 files changed, 211 insertions(+), 151 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index f0673a8c3..aa59ca808 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -176,48 +176,6 @@ struct _u3_ward* rev_u; // active reverse listeners } u3_prox; - /* u3_csat: client connection state. - */ - typedef enum { - u3_csat_init = 0, // initialized - u3_csat_addr = 1, // address resolution begun - u3_csat_quit = 2, // cancellation requested - u3_csat_ripe = 3 // passed to libh2o - } u3_csat; - - /* u3_cres: response to http client. - */ - typedef struct _u3_cres { - c3_w sas_w; // status code - u3_noun hed; // headers - u3_hbod* bod_u; // exit of body queue - u3_hbod* dob_u; // entry of body queue - } u3_cres; - - /* u3_creq: outgoing http request. - */ - typedef struct _u3_creq { // client request - c3_l num_l; // request number - h2o_http1client_t* cli_u; // h2o client - u3_csat sat_e; // connection state - c3_o sec; // yes == https - c3_w ipf_w; // IP - c3_c* ipf_c; // IP (string) - c3_c* hot_c; // host - c3_s por_s; // port - c3_c* por_c; // port (string) - c3_c* met_c; // method - c3_c* url_c; // url - u3_hhed* hed_u; // headers - u3_hbod* bod_u; // body - u3_hbod* rub_u; // exit of send queue - u3_hbod* bur_u; // entry of send queue - h2o_iovec_t* vec_u; // send-buffer array - u3_cres* res_u; // nascent response - struct _u3_creq* nex_u; // next in list - struct _u3_creq* pre_u; // previous in list - } u3_creq; - /* u3_chot: foreign host (not yet used). */ typedef struct _u3_chot { @@ -227,16 +185,6 @@ void* sec_u; // secure connection (or 0) } u3_chot; - /* u3_cttp: http client. - */ - typedef struct _u3_cttp { - u3_creq* ceq_u; // request list - h2o_timeout_t tim_u; // request timeout - h2o_http1client_ctx_t // - ctx_u; // h2o client ctx - void* tls_u; // client SSL_CTX* - } u3_cttp; - /* u3_lane: ames lane (IP address and port) */ typedef struct _u3_lane { @@ -492,7 +440,6 @@ u3_usig* sig_u; // signal list u3_hfig fig_u; // http configuration u3_http* htp_u; // http servers - u3_cttp ctp_u; // http clients u3_utty* uty_u; // linked terminal list u3_opts ops_u; // commandline options c3_i xit_i; // exit code for shutdown @@ -1169,28 +1116,10 @@ /** HTTP client. **/ - /** HTTP client. - **/ - /* u3_cttp_ef_http_client(): send %http-client effect to cttp. - */ - void - u3_cttp_ef_http_client(u3_noun fav); - - /* u3_cttp_ef_back(): initialization event on restart. - */ - void - u3_cttp_ef_bake(); - /* u3_cttp_io_init(): initialize cttp I/O. */ - void - u3_cttp_io_init(void); - - /* u3_cttp_io_exit(): terminate cttp I/O. - */ - void - u3_cttp_io_exit(void); - + u3_auto* + u3_cttp_io_init(u3_pier* pir_u); /** Stream messages. **/ diff --git a/pkg/urbit/vere/cttp.c b/pkg/urbit/vere/cttp.c index c541b9cf1..ffdc59e50 100644 --- a/pkg/urbit/vere/cttp.c +++ b/pkg/urbit/vere/cttp.c @@ -14,6 +14,59 @@ #include "all.h" #include "vere/vere.h" +/* u3_csat: client connection state. +*/ + typedef enum { + u3_csat_init = 0, // initialized + u3_csat_addr = 1, // address resolution begun + u3_csat_quit = 2, // cancellation requested + u3_csat_ripe = 3 // passed to libh2o + } u3_csat; + +/* u3_cres: response to http client. +*/ + typedef struct _u3_cres { + c3_w sas_w; // status code + u3_noun hed; // headers + u3_hbod* bod_u; // exit of body queue + u3_hbod* dob_u; // entry of body queue + } u3_cres; + +/* u3_creq: outgoing http request. +*/ + typedef struct _u3_creq { // client request + c3_l num_l; // request number + h2o_http1client_t* cli_u; // h2o client + u3_csat sat_e; // connection state + c3_o sec; // yes == https + c3_w ipf_w; // IP + c3_c* ipf_c; // IP (string) + c3_c* hot_c; // host + c3_s por_s; // port + c3_c* por_c; // port (string) + c3_c* met_c; // method + c3_c* url_c; // url + u3_hhed* hed_u; // headers + u3_hbod* bod_u; // body + u3_hbod* rub_u; // exit of send queue + u3_hbod* bur_u; // entry of send queue + h2o_iovec_t* vec_u; // send-buffer array + u3_cres* res_u; // nascent response + struct _u3_creq* nex_u; // next in list + struct _u3_creq* pre_u; // previous in list + struct _u3_cttp* ctp_u; // cttp backpointer + } u3_creq; + +/* u3_cttp: http client. +*/ + typedef struct _u3_cttp { + u3_auto car_u; // driver + u3_creq* ceq_u; // request list + h2o_timeout_t tim_u; // request timeout + h2o_http1client_ctx_t // + ctx_u; // h2o client ctx + void* tls_u; // client SSL_CTX* + } u3_cttp; // XX deduplicate with _http_vec_to_atom /* _cttp_vec_to_atom(): convert h2o_iovec_t to atom (cord) @@ -457,9 +510,9 @@ _cttp_creq_ip(c3_w ipf_w) /* _cttp_creq_find(): find a request by number in the client */ static u3_creq* -_cttp_creq_find(c3_l num_l) +_cttp_creq_find(u3_cttp* ctp_u, c3_l num_l) { - u3_creq* ceq_u = u3_Host.ctp_u.ceq_u; + u3_creq* ceq_u = ctp_u->ceq_u; // XX glories of linear search // @@ -475,14 +528,16 @@ _cttp_creq_find(c3_l num_l) /* _cttp_creq_link(): link request to client */ static void -_cttp_creq_link(u3_creq* ceq_u) +_cttp_creq_link(u3_cttp* ctp_u, u3_creq* ceq_u) { - ceq_u->nex_u = u3_Host.ctp_u.ceq_u; + ceq_u->nex_u = ctp_u->ceq_u; if ( 0 != ceq_u->nex_u ) { ceq_u->nex_u->pre_u = ceq_u; } - u3_Host.ctp_u.ceq_u = ceq_u; + + ceq_u->ctp_u = ctp_u; + ctp_u->ceq_u = ceq_u; } /* _cttp_creq_unlink(): unlink request from client @@ -490,6 +545,8 @@ _cttp_creq_link(u3_creq* ceq_u) static void _cttp_creq_unlink(u3_creq* ceq_u) { + u3_cttp* ctp_u = ceq_u->ctp_u; + if ( ceq_u->pre_u ) { ceq_u->pre_u->nex_u = ceq_u->nex_u; @@ -498,7 +555,7 @@ _cttp_creq_unlink(u3_creq* ceq_u) } } else { - u3_Host.ctp_u.ceq_u = ceq_u->nex_u; + ctp_u->ceq_u = ceq_u->nex_u; if ( 0 != ceq_u->nex_u ) { ceq_u->nex_u->pre_u = 0; @@ -536,7 +593,7 @@ _cttp_creq_free(u3_creq* ceq_u) * We start with the (?? - JB) */ static u3_creq* -_cttp_creq_new(c3_l num_l, u3_noun hes) +_cttp_creq_new(u3_cttp* ctp_u, c3_l num_l, u3_noun hes) { u3_creq* ceq_u = c3_calloc(sizeof(*ceq_u)); @@ -588,7 +645,7 @@ _cttp_creq_new(c3_l num_l, u3_noun hes) ceq_u->bod_u = _cttp_bod_from_octs(u3k(u3t(body))); } - _cttp_creq_link(ceq_u); + _cttp_creq_link(ctp_u, ceq_u); u3z(unit_pul); u3z(hes); @@ -699,19 +756,16 @@ _cttp_creq_quit(u3_creq* ceq_u) } static void -_cttp_http_client_receive(c3_l num_l, c3_w sas_w, u3_noun mes, u3_noun uct) +_cttp_http_client_receive(u3_creq* ceq_u, c3_w sas_w, u3_noun mes, u3_noun uct) { // TODO: We want to eventually deal with partial responses, but I don't know // how to get that working right now. - u3_noun pox = u3nq(u3_blip, u3i_string("http-client"), u3k(u3A->sen), u3_nul); + u3_noun pax = u3nq(u3_blip, u3i_string("http-client"), u3k(u3A->sen), u3_nul); + u3_noun fav = u3nt(u3i_string("receive"), + ceq_u->num_l, + u3nq(u3i_string("start"), u3nc(sas_w, mes), uct, c3y)); - u3_pier_plan(pox, - u3nt(u3i_string("receive"), - num_l, - u3nq(u3i_string("start"), - u3nc(sas_w, mes), - uct, - c3y))); + u3_auto_plan(&ceq_u->ctp_u->car_u, 0, 0, u3_blip, pax, fav); } /* _cttp_creq_fail(): dispatch error response @@ -725,7 +779,7 @@ _cttp_creq_fail(u3_creq* ceq_u, const c3_c* err_c) u3l_log("http: fail (%d, %d): %s\r\n", ceq_u->num_l, cod_w, err_c); // XX include err_c as response body? - _cttp_http_client_receive(ceq_u->num_l, cod_w, u3_nul, u3_nul); + _cttp_http_client_receive(ceq_u, cod_w, u3_nul, u3_nul); _cttp_creq_free(ceq_u); } @@ -736,7 +790,7 @@ _cttp_creq_respond(u3_creq* ceq_u) { u3_cres* res_u = ceq_u->res_u; - _cttp_http_client_receive(ceq_u->num_l, res_u->sas_w, res_u->hed, + _cttp_http_client_receive(ceq_u, res_u->sas_w, res_u->hed, ( !res_u->bod_u ) ? u3_nul : u3nc(u3_nul, _cttp_bods_to_octs(res_u->bod_u))); @@ -835,7 +889,7 @@ _cttp_creq_connect(u3_creq* ceq_u) ( c3y == ceq_u->sec ) ? 443 : 80; // connect by IP - h2o_http1client_connect(&ceq_u->cli_u, ceq_u, &u3_Host.ctp_u.ctx_u, ipf_u, + h2o_http1client_connect(&ceq_u->cli_u, ceq_u, &ceq_u->ctp_u->ctx_u, ipf_u, por_s, c3y == ceq_u->sec, _cttp_creq_on_connect); // set hostname for TLS handshake @@ -926,7 +980,7 @@ _cttp_creq_start(u3_creq* ceq_u) /* _cttp_init_tls: initialize OpenSSL context */ static SSL_CTX* -_cttp_init_tls() +_cttp_init_tls(void) { // XX require 1.1.0 and use TLS_client_method() SSL_CTX* tls_u = SSL_CTX_new(SSLv23_client_method()); @@ -947,86 +1001,108 @@ _cttp_init_tls() return tls_u; } -/* u3_cttp_ef_http_client(): send an %http-client (outgoing request) to cttp. +/* _cttp_ef_http_client(): send an %http-client (outgoing request) to cttp. */ -void -u3_cttp_ef_http_client(u3_noun fav) +static c3_o +_cttp_ef_http_client(u3_cttp* ctp_u, u3_noun tag, u3_noun dat) { u3_creq* ceq_u; + c3_o ret_o; - if ( c3y == u3r_sing_c("request", u3h(fav)) ) { - u3_noun p_fav, q_fav; - u3x_cell(u3t(fav), &p_fav, &q_fav); + if ( c3y == u3r_sing_c("request", tag) ) { + u3_noun num, req; + c3_l num_l; - ceq_u = _cttp_creq_new(u3r_word(0, p_fav), u3k(q_fav)); - - if ( ceq_u ) { + if ( (c3n == u3r_cell(dat, &num, &req)) + || (c3n == u3r_safe_word(num, &num_l)) ) + { + u3l_log("cttp: strange request\n"); + ret_o = c3n; + } + else if ( (ceq_u = _cttp_creq_new(ctp_u, num_l, u3k(req))) ) { _cttp_creq_start(ceq_u); + ret_o = c3y; } else { u3l_log("cttp: strange request (unparsable url)\n"); + ret_o = c3n; } } - else if ( c3y == u3r_sing_c("cancel-request", u3h(fav)) ) { - ceq_u =_cttp_creq_find(u3r_word(0, u3t(fav))); + else if ( c3y == u3r_sing_c("cancel-request", tag) ) { + c3_l num_l; - if ( ceq_u ) { + if ( c3n == u3r_safe_word(dat, &num_l) ) { + u3l_log("cttp: strange cancel-request\n"); + ret_o = c3n; + } + else if ( (ceq_u =_cttp_creq_find(ctp_u, num_l)) ) { _cttp_creq_quit(ceq_u); + ret_o = c3y; + } + else { + // accepted whether or not request exists + // + ret_o = c3y; } } else { - u3l_log("cttp: strange request (unknown type)\n"); + u3l_log("cttp: strange effect (unknown type)\n"); + ret_o = c3n; } - u3z(fav); + u3z(tag); u3z(dat); + return ret_o; } -/* u3_cttp_ef_bake(): notify that we're live. +/* _cttp_io_talk(): notify that we're live. */ -void -u3_cttp_ef_bake() +static void +_cttp_io_talk(u3_auto* car_u) { + // XX remove u3A->sen + // u3_noun pax = u3nq(u3_blip, u3i_string("http-client"), u3k(u3A->sen), u3_nul); - u3_pier_plan(pax, u3nc(c3__born, u3_nul)); + u3_noun fav = u3nc(c3__born, u3_nul); + + u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); } -/* u3_cttp_io_init(): initialize http client I/O. +/* _cttp_io_fete(): */ -void -u3_cttp_io_init() +static c3_o +_cttp_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) { - // zero-initialize h2o ctx - // - memset(&u3_Host.ctp_u.ctx_u, 0, sizeof(u3_Host.ctp_u.ctx_u)); + u3_cttp* ctp_u = (u3_cttp*)car_u; - // link to event loop - // - u3_Host.ctp_u.ctx_u.loop = u3L; + u3_noun i_pax, it_pax, tag, dat; + c3_o ret_o; - // link to initialized request timeout - // - h2o_timeout_init(u3L, &u3_Host.ctp_u.tim_u, 300 * 1000); - u3_Host.ctp_u.ctx_u.io_timeout = &u3_Host.ctp_u.tim_u; + if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, 0)) + || (c3n == u3r_cell(fav, &tag, &dat)) + || (u3_blip != i_pax ) + || (c3n == u3r_sing_c("http-client", it_pax)) ) + { + ret_o = c3n; + } + else { + ret_o = _cttp_ef_http_client(ctp_u, u3k(tag), u3k(dat)); + } - // link to initialized tls ctx - // - u3_Host.ctp_u.tls_u = _cttp_init_tls(); - u3_Host.ctp_u.ctx_u.ssl_ctx = u3_Host.ctp_u.tls_u; - - // zero-initialize request list - // - u3_Host.ctp_u.ceq_u = 0; + u3z(pax); u3z(fav); + return ret_o; } -/* u3_cttp_io_exit(): shut down cttp. +/* _cttp_io_exit(): shut down cttp. */ -void -u3_cttp_io_exit(void) +static void +_cttp_io_exit(u3_auto* car_u) { + u3_cttp* ctp_u = (u3_cttp*)car_u; + // cancel requests // { - u3_creq* ceq_u = u3_Host.ctp_u.ceq_u; + u3_creq* ceq_u = ctp_u->ceq_u; while ( ceq_u ) { _cttp_creq_quit(ceq_u); @@ -1036,6 +1112,53 @@ u3_cttp_io_exit(void) // dispose of global resources // - h2o_timeout_dispose(u3L, &u3_Host.ctp_u.tim_u); - SSL_CTX_free(u3_Host.ctp_u.tls_u); + h2o_timeout_dispose(u3L, &ctp_u->tim_u); + SSL_CTX_free(ctp_u->tls_u); + + // XX dispose ctp_u + // +} + +static void +_cttp_ev_noop(u3_auto* car_u, void* vod_p) +{ +} + +/* u3_cttp_io_init(): initialize http client I/O. +*/ +u3_auto* +u3_cttp_io_init(u3_pier* pir_u) +{ + u3_cttp* ctp_u = c3_calloc(sizeof(*ctp_u)); + + // link to event loop + // + ctp_u->ctx_u.loop = u3L; + + // link to initialized request timeout + // + h2o_timeout_init(u3L, &ctp_u->tim_u, 300 * 1000); + ctp_u->ctx_u.io_timeout = &ctp_u->tim_u; + + // link to initialized tls ctx + // + ctp_u->tls_u = _cttp_init_tls(); + ctp_u->ctx_u.ssl_ctx = ctp_u->tls_u; + + u3_auto* car_u = &ctp_u->car_u; + car_u->nam_m = c3__cttp; + // XX post born + // + car_u->liv_o = c3n; + car_u->io.talk_f = _cttp_io_talk; + car_u->io.fete_f = _cttp_io_fete; + car_u->io.exit_f = _cttp_io_exit; + + car_u->ev.drop_f = _cttp_ev_noop; + car_u->ev.work_f = _cttp_ev_noop; + car_u->ev.done_f = _cttp_ev_noop; + car_u->ev.swap_f = _cttp_ev_noop; + car_u->ev.bail_f = _cttp_ev_noop; + + return car_u; } diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index a39055f51..8241c5f4d 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -1182,7 +1182,7 @@ _pier_loop_wake(u3_auto* car_u) cod_l = u3a_lush(c3__http); u3_http_io_talk(); u3_http_ef_bake(); - u3_cttp_ef_bake(); + // u3_cttp_ef_bake(); u3a_lop(cod_l); cod_l = u3a_lush(c3__term); @@ -1223,9 +1223,9 @@ _pier_loop_exit(u3_auto* car_u) u3_http_io_exit(); u3a_lop(cod_l); - cod_l = u3a_lush(c3__cttp); - u3_cttp_io_exit(); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__cttp); + // u3_cttp_io_exit(); + // u3a_lop(cod_l); cod_l = u3a_lush(c3__term); u3_term_io_exit(); @@ -1274,6 +1274,14 @@ _pier_loop_init(u3_pier* pir_u) las_u = &rac_u->nex_u; } + { + u3_auto* rac_u = u3_cttp_io_init(pir_u); + rac_u->pir_u = pir_u; + + *las_u = rac_u; + las_u = &rac_u->nex_u; + } + { u3_auto* rac_u = u3_ames_io_init(pir_u); rac_u->pir_u = pir_u; @@ -1335,9 +1343,9 @@ _pier_loop_init(u3_pier* pir_u) u3_http_io_init(); u3a_lop(cod_l); - cod_l = u3a_lush(c3__cttp); - u3_cttp_io_init(); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__cttp); + // u3_cttp_io_init(); + // u3a_lop(cod_l); } return car_u; diff --git a/pkg/urbit/vere/reck.c b/pkg/urbit/vere/reck.c index 6f682e8e7..c3a731dd4 100644 --- a/pkg/urbit/vere/reck.c +++ b/pkg/urbit/vere/reck.c @@ -340,12 +340,12 @@ _reck_kick_spec(u3_pier* pir_u, u3_noun pox, u3_noun fav) u3z(pox); u3z(fav); return c3y; } - else if ( c3y == u3r_sing_c("http-client", it_pox) ) { - u3_cttp_ef_http_client(u3k(fav)); + // else if ( c3y == u3r_sing_c("http-client", it_pox) ) { + // u3_cttp_ef_http_client(u3k(fav)); - u3z(pox); u3z(fav); - return c3y; - } + // u3z(pox); u3z(fav); + // return c3y; + // } else switch ( it_pox ) { default: u3z(pox); u3z(fav); return c3n; From e3cae2ee115acaa03a3eddf43e4b0d0edb105da7 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 18 Apr 2020 18:07:00 -0700 Subject: [PATCH 019/257] vere: removes reverse, reverse tcp proxy --- pkg/urbit/vere/http.c | 1366 +---------------------------------------- 1 file changed, 1 insertion(+), 1365 deletions(-) diff --git a/pkg/urbit/vere/http.c b/pkg/urbit/vere/http.c index 5ca88a7e6..9f9072903 100644 --- a/pkg/urbit/vere/http.c +++ b/pkg/urbit/vere/http.c @@ -26,11 +26,6 @@ typedef struct _u3_h2o_serv { h2o_handler_t* han_u; // h2o request handler } u3_h2o_serv; -static void _proxy_serv_free(u3_prox* lis_u); -static void _proxy_serv_close(u3_prox* lis_u); -static u3_prox* _proxy_serv_new(u3_http* htp_u, c3_s por_s, c3_o sec); -static u3_prox* _proxy_serv_start(u3_prox* lis_u); - static void _http_serv_free(u3_http* htp_u); static void _http_serv_start_all(void); static void _http_form_free(void); @@ -1064,12 +1059,6 @@ _http_serv_close(u3_http* htp_u) #endif uv_close((uv_handle_t*)&htp_u->wax_u, _http_serv_close_cb); - - if ( 0 != htp_u->rox_u ) { - // XX close soft - _proxy_serv_close(htp_u->rox_u); - htp_u->rox_u = 0; - } } /* _http_serv_new(): create new http server. @@ -1247,18 +1236,10 @@ _http_serv_start(u3_http* htp_u) u3l_log("http: listen: %s\n", uv_strerror(sas_i)); - if ( 0 != htp_u->rox_u ) { - _proxy_serv_free(htp_u->rox_u); - } _http_serv_free(htp_u); return; } - // XX this is weird - if ( 0 != htp_u->rox_u ) { - htp_u->rox_u = _proxy_serv_start(htp_u->rox_u); - } - if ( 0 != htp_u->rox_u ) { u3l_log("http: live (%s, %s) on %d (proxied on %d)\n", (c3y == htp_u->sec) ? "secure" : "insecure", @@ -1431,7 +1412,6 @@ _http_write_ports_file(c3_c *pax_c) u3_http* htp_u = u3_Host.htp_u; while ( 0 != htp_u ) { - // XX write proxy ports instead? if ( 0 < htp_u->por_s ) { dprintf(por_i, "%u %s %s\n", htp_u->por_s, (c3y == htp_u->sec) ? "secure" : "insecure", @@ -1592,10 +1572,6 @@ _http_serv_start_all(void) htp_u = _http_serv_new(por_s, c3y, c3n); htp_u->h2o_u = _http_serv_init_h2o(u3_Host.tls_u, for_u->log, for_u->red); - if ( c3y == for_u->pro ) { - htp_u->rox_u = _proxy_serv_new(htp_u, 443, c3y); - } - _http_serv_start(htp_u); sec = u3nc(u3_nul, htp_u->por_s); } @@ -1607,10 +1583,6 @@ _http_serv_start_all(void) htp_u = _http_serv_new(por_s, c3n, c3n); htp_u->h2o_u = _http_serv_init_h2o(0, for_u->log, for_u->red); - if ( c3y == for_u->pro ) { - htp_u->rox_u = _proxy_serv_new(htp_u, 80, c3n); - } - _http_serv_start(htp_u); non = htp_u->por_s; } @@ -1620,7 +1592,6 @@ _http_serv_start_all(void) por_s = 12321; htp_u = _http_serv_new(por_s, c3n, c3y); htp_u->h2o_u = _http_serv_init_h2o(0, for_u->log, for_u->red); - // never proxied _http_serv_start(htp_u); } @@ -1779,1345 +1750,10 @@ u3_http_io_exit(void) _http_release_ports_file(u3_Host.dir_c); } -/////////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////////////////////////////////////// - -typedef enum { - u3_pars_good = 0, // success - u3_pars_fail = 1, // failure - u3_pars_moar = 2 // incomplete -} u3_proxy_pars; - -/* _proxy_alloc(): libuv buffer allocator -*/ -static void -_proxy_alloc(uv_handle_t* had_u, - size_t len_i, - uv_buf_t* buf) -{ - // len_i is always 64k, so we're ignoring it - // using fixed size 4K buffer for - // XX consider h2o_buffer_t, a pool, or something XX - void* ptr_v = c3_malloc(4096); - *buf = uv_buf_init(ptr_v, 4096); -} - -/* _proxy_warc_link(): link warc to global state. -*/ -static void -_proxy_warc_link(u3_warc* cli_u) -{ - cli_u->nex_u = u3_Host.fig_u.cli_u; - - if ( 0 != cli_u->nex_u ) { - cli_u->nex_u->pre_u = cli_u; - } - u3_Host.fig_u.cli_u = cli_u; -} - -/* _proxy_warc_unlink(): unlink warc from global state. -*/ -static void -_proxy_warc_unlink(u3_warc* cli_u) -{ - if ( 0 != cli_u->pre_u ) { - cli_u->pre_u->nex_u = cli_u->nex_u; - - if ( 0 != cli_u->nex_u ) { - cli_u->nex_u->pre_u = cli_u->pre_u; - } - } - else { - u3_Host.fig_u.cli_u = cli_u->nex_u; - - if ( 0 != cli_u->nex_u ) { - cli_u->nex_u->pre_u = 0; - } - } -} - -/* _proxy_warc_free(): free ward client -*/ -static void -_proxy_warc_free(u3_warc* cli_u) -{ - _proxy_warc_unlink(cli_u); - c3_free(cli_u->non_u.base); - c3_free(cli_u->hot_c); - c3_free(cli_u); -} - -/* _proxy_warc_new(): allocate ship-specific proxy client -*/ -static u3_warc* -_proxy_warc_new(u3_http* htp_u, u3_atom sip, u3_atom non, c3_s por_s, c3_o sec) -{ - u3_warc* cli_u = c3_calloc(sizeof(*cli_u)); - cli_u->htp_u = htp_u; - cli_u->por_s = por_s; - cli_u->sec = sec; - - u3r_chubs(0, 2, cli_u->who_d, sip); - _proxy_warc_link(cli_u); - - { - c3_w len_w = u3r_met(3, non); - - c3_assert( 256 > len_w ); - - c3_y* non_y = c3_malloc(1 + len_w); - non_y[0] = (c3_y)len_w; - - u3r_bytes(0, len_w, non_y + 1, non); - - cli_u->non_u = uv_buf_init((c3_c*)non_y, 1 + len_w); - } - - u3z(non); - u3z(sip); - - return cli_u; -} - -/* _proxy_conn_link(): link con to listener or global state. -*/ -static void -_proxy_conn_link(u3_pcon* con_u) -{ - switch ( con_u->typ_e ) { - default: c3_assert(0); - - case u3_ptyp_ward: { - con_u->nex_u = u3_Host.fig_u.con_u; - - if ( 0 != con_u->nex_u ) { - con_u->nex_u->pre_u = con_u; - } - u3_Host.fig_u.con_u = con_u; - break; - } - - case u3_ptyp_prox: { - u3_prox* lis_u = con_u->src_u.lis_u; - con_u->nex_u = lis_u->con_u; - - if ( 0 != con_u->nex_u ) { - con_u->nex_u->pre_u = con_u; - } - lis_u->con_u = con_u; - break; - } - } -} - -/* _proxy_conn_unlink(): unlink con from listener or global state. -*/ -static void -_proxy_conn_unlink(u3_pcon* con_u) -{ - if ( 0 != con_u->pre_u ) { - con_u->pre_u->nex_u = con_u->nex_u; - - if ( 0 != con_u->nex_u ) { - con_u->nex_u->pre_u = con_u->pre_u; - } - } - else { - switch ( con_u->typ_e ) { - default: c3_assert(0); - - case u3_ptyp_ward: { - u3_Host.fig_u.con_u = con_u->nex_u; - - if ( 0 != con_u->nex_u ) { - con_u->nex_u->pre_u = 0; - } - break; - } - - case u3_ptyp_prox: { - u3_prox* lis_u = con_u->src_u.lis_u; - lis_u->con_u = con_u->nex_u; - - if ( 0 != con_u->nex_u ) { - con_u->nex_u->pre_u = 0; - } - break; - } - } - } -} - -/* _proxy_conn_free(): free proxy connection -*/ -static void -_proxy_conn_free(uv_handle_t* han_u) -{ - u3_pcon* con_u = han_u->data; - - if ( 0 != con_u->buf_u.base ) { - c3_free(con_u->buf_u.base); - } - - if ( u3_ptyp_ward == con_u->typ_e ) { - _proxy_warc_free(con_u->src_u.cli_u); - } - - _proxy_conn_unlink(con_u); - - c3_free(con_u); -} - -/* _proxy_conn_close(): close both sides of proxy connection -*/ -static void -_proxy_conn_close(u3_pcon* con_u) -{ - // XX revisit, this is called twice when con_u - // is a loopback connection and we're restarting - if ( uv_is_closing((uv_handle_t*)&con_u->don_u) ){ - return; - } - - if ( 0 != con_u->upt_u ) { - uv_close((uv_handle_t*)con_u->upt_u, _http_close_cb); - } - - uv_close((uv_handle_t*)&con_u->don_u, _proxy_conn_free); -} - -/* _proxy_conn_new(): allocate proxy connection -*/ -static u3_pcon* -_proxy_conn_new(u3_proxy_type typ_e, void* src_u) -{ - u3_pcon* con_u = c3_malloc(sizeof(*con_u)); - con_u->upt_u = 0; - con_u->buf_u = uv_buf_init(0, 0); - con_u->nex_u = 0; - con_u->pre_u = 0; - - switch ( typ_e ) { - default: c3_assert(0); - - case u3_ptyp_prox: { - u3_prox* lis_u = (u3_prox*)src_u; - con_u->typ_e = typ_e; - con_u->src_u.lis_u = lis_u; - con_u->sec = lis_u->sec; - break; - } - - case u3_ptyp_ward: { - u3_warc* cli_u = (u3_warc*)src_u; - con_u->typ_e = typ_e; - con_u->src_u.cli_u = cli_u; - con_u->sec = cli_u->sec; - break; - } - } - - con_u->don_u.data = con_u; - - _proxy_conn_link(con_u); - - return con_u; -} - -typedef struct _proxy_write_ctx { - u3_pcon* con_u; - uv_stream_t* str_u; - c3_c* buf_c; -} proxy_write_ctx; - -/* _proxy_write_cb(): free uv_write_t and linked buffer. -*/ -static void -_proxy_write_cb(uv_write_t* wri_u, c3_i sas_i) -{ - if ( 0 != sas_i ) { - if ( 0 != wri_u->data ) { - proxy_write_ctx* ctx_u = wri_u->data; - - if ( ctx_u->str_u == (uv_stream_t*)ctx_u->con_u->upt_u ) { - u3l_log("proxy: write upstream: %s\n", uv_strerror(sas_i)); - } - else if ( ctx_u->str_u == (uv_stream_t*)&(ctx_u->con_u->don_u) ) { - u3l_log("proxy: write downstream: %s\n", uv_strerror(sas_i)); - } - else { - u3l_log("proxy: write: %s\n", uv_strerror(sas_i)); - } - } - else { - u3l_log("proxy: write: %s\n", uv_strerror(sas_i)); - } - } - - if ( 0 != wri_u->data ) { - proxy_write_ctx* ctx_u = wri_u->data; - c3_free(ctx_u->buf_c); - c3_free(ctx_u); - } - - c3_free(wri_u); -} - -/* _proxy_write(): write buffer to proxy stream -*/ -static c3_i -_proxy_write(u3_pcon* con_u, uv_stream_t* str_u, uv_buf_t buf_u) -{ - uv_write_t* wri_u = c3_malloc(sizeof(*wri_u)); - - proxy_write_ctx* ctx_u = c3_malloc(sizeof(*ctx_u)); - ctx_u->con_u = con_u; - ctx_u->str_u = str_u; - ctx_u->buf_c = buf_u.base; - wri_u->data = ctx_u; - - c3_i sas_i; - if ( 0 != (sas_i = uv_write(wri_u, str_u, &buf_u, 1, _proxy_write_cb)) ) { - _proxy_conn_close(con_u); - _proxy_write_cb(wri_u, sas_i); - } - - return sas_i; -} - -/* _proxy_read_downstream_cb(): read from downstream, write upstream. -*/ -static void -_proxy_read_downstream_cb(uv_stream_t* don_u, - ssize_t siz_w, - const uv_buf_t* buf_u) -{ - u3_pcon* con_u = don_u->data; - - if ( 0 > siz_w ) { - if ( UV_EOF != siz_w ) { - u3l_log("proxy: read downstream: %s\n", uv_strerror(siz_w)); - } - _proxy_conn_close(con_u); - } - else { - _proxy_write(con_u, (uv_stream_t*)con_u->upt_u, - uv_buf_init(buf_u->base, siz_w)); - } -} - -/* _proxy_read_upstream_cb(): read from upstream, write downstream. -*/ -static void -_proxy_read_upstream_cb(uv_stream_t* upt_u, - ssize_t siz_w, - const uv_buf_t* buf_u) -{ - u3_pcon* con_u = upt_u->data; - - if ( 0 > siz_w ) { - if ( UV_EOF != siz_w ) { - u3l_log("proxy: read upstream: %s\n", uv_strerror(siz_w)); - } - _proxy_conn_close(con_u); - } - else { - _proxy_write(con_u, (uv_stream_t*)&(con_u->don_u), - uv_buf_init(buf_u->base, siz_w)); - } -} - -/* _proxy_fire(): send pending buffer upstream, setup full duplex. -*/ -static void -_proxy_fire(u3_pcon* con_u) -{ - if ( 0 != con_u->buf_u.base ) { - uv_buf_t fub_u = con_u->buf_u; - con_u->buf_u = uv_buf_init(0, 0); - - if ( 0 != _proxy_write(con_u, (uv_stream_t*)con_u->upt_u, fub_u) ) { - return; - } - } - - // XX set cooldown timers to close these? - - uv_read_start((uv_stream_t*)&con_u->don_u, - _proxy_alloc, _proxy_read_downstream_cb); - - uv_read_start((uv_stream_t*)con_u->upt_u, - _proxy_alloc, _proxy_read_upstream_cb); -} - -/* _proxy_loop_connect_cb(): callback for loopback proxy connect. -*/ -static void -_proxy_loop_connect_cb(uv_connect_t * upc_u, c3_i sas_i) -{ - u3_pcon* con_u = upc_u->data; - - if ( 0 != sas_i ) { - u3l_log("proxy: connect: %s\n", uv_strerror(sas_i)); - _proxy_conn_close(con_u); - } - else { - _proxy_fire(con_u); - } - - c3_free(upc_u); -} - -/* _proxy_loop_connect(): connect to loopback. -*/ -static void -_proxy_loop_connect(u3_pcon* con_u) -{ - uv_tcp_t* upt_u = c3_malloc(sizeof(*upt_u)); - - con_u->upt_u = upt_u; - upt_u->data = con_u; - - uv_tcp_init(u3L, upt_u); - - struct sockaddr_in lop_u; - - memset(&lop_u, 0, sizeof(lop_u)); - lop_u.sin_family = AF_INET; - lop_u.sin_addr.s_addr = htonl(INADDR_LOOPBACK); - - // get the loopback port from the linked server - { - u3_http* htp_u; - - switch ( con_u->typ_e ) { - default: c3_assert(0); - - case u3_ptyp_ward: { - htp_u = con_u->src_u.cli_u->htp_u; - break; - } - - case u3_ptyp_prox: { - htp_u = con_u->src_u.lis_u->htp_u; - break; - } - } - - // XX make unpossible? - c3_assert( (0 != htp_u) && (0 != htp_u->por_s) ); - - lop_u.sin_port = htons(htp_u->por_s); - } - - uv_connect_t* upc_u = c3_malloc(sizeof(*upc_u)); - upc_u->data = con_u; - - c3_i sas_i; - - if ( 0 != (sas_i = uv_tcp_connect(upc_u, upt_u, - (const struct sockaddr*)&lop_u, - _proxy_loop_connect_cb)) ) { - u3l_log("proxy: connect: %s\n", uv_strerror(sas_i)); - c3_free(upc_u); - _proxy_conn_close(con_u); - } -} - -/* _proxy_wcon_link(): link wcon to ward. -*/ -static void -_proxy_wcon_link(u3_wcon* won_u, u3_ward* rev_u) -{ - won_u->nex_u = rev_u->won_u; - rev_u->won_u = won_u; -} - -/* _proxy_wcon_unlink(): unlink wcon from ward. -*/ -static void -_proxy_wcon_unlink(u3_wcon* won_u) -{ - u3_ward* rev_u = won_u->rev_u; - - if ( rev_u->won_u == won_u ) { - rev_u->won_u = won_u->nex_u; - } - else { - u3_wcon* pre_u = rev_u->won_u; - - // XX glories of linear search - // - while ( 0 != pre_u ) { - if ( pre_u->nex_u == won_u ) { - pre_u->nex_u = won_u->nex_u; - } - else pre_u = pre_u->nex_u; - } - } -} - -/* _proxy_wcon_free(): free ward upstream candidate. -*/ -static void -_proxy_wcon_free(uv_handle_t* han_u) -{ - u3_wcon* won_u = han_u->data; - - // Note: not unlinked here, freed concurrent with u3_ward - c3_free(won_u); -} - -/* _proxy_wcon_close(): close ward upstream candidate. -*/ -static void -_proxy_wcon_close(u3_wcon* won_u) -{ - uv_read_stop((uv_stream_t*)&won_u->upt_u); - uv_close((uv_handle_t*)&won_u->upt_u, _proxy_wcon_free); -} - -/* _proxy_wcon_new(): allocate ward upstream candidate. -*/ -static u3_wcon* -_proxy_wcon_new(u3_ward* rev_u) -{ - u3_wcon* won_u = c3_malloc(sizeof(*won_u)); - won_u->upt_u.data = won_u; - won_u->rev_u = rev_u; - won_u->nex_u = 0; - - _proxy_wcon_link(won_u, rev_u); - - return won_u; -} - -/* _proxy_ward_link(): link ward to listener. -*/ -static void -_proxy_ward_link(u3_pcon* con_u, u3_ward* rev_u) -{ - // XX link also to con_u as upstream? - c3_assert( u3_ptyp_prox == con_u->typ_e ); - - u3_prox* lis_u = con_u->src_u.lis_u; - - rev_u->nex_u = lis_u->rev_u; - - if ( 0 != rev_u->nex_u ) { - rev_u->nex_u->pre_u = rev_u; - } - lis_u->rev_u = rev_u; -} - -/* _proxy_ward_unlink(): unlink ward from listener. -*/ -static void -_proxy_ward_unlink(u3_ward* rev_u) -{ - if ( 0 != rev_u->pre_u ) { - rev_u->pre_u->nex_u = rev_u->nex_u; - - if ( 0 != rev_u->nex_u ) { - rev_u->nex_u->pre_u = rev_u->pre_u; - } - } - else { - c3_assert( u3_ptyp_prox == rev_u->con_u->typ_e ); - - u3_prox* lis_u = rev_u->con_u->src_u.lis_u; - lis_u->rev_u = rev_u->nex_u; - - if ( 0 != rev_u->nex_u ) { - rev_u->nex_u->pre_u = 0; - } - } -} - -/* _proxy_ward_free(): free reverse proxy listener -*/ -static void -_proxy_ward_free(uv_handle_t* han_u) -{ - u3_ward* rev_u = han_u->data; - - c3_free(rev_u->non_u.base); - c3_free(rev_u); -} - -/* _proxy_ward_close_timer(): close ward timer -*/ -static void -_proxy_ward_close_timer(uv_handle_t* han_u) -{ - u3_ward* rev_u = han_u->data; - - uv_close((uv_handle_t*)&rev_u->tim_u, _proxy_ward_free); -} - -/* _proxy_ward_close(): close ward (ship-specific listener) -*/ -static void -_proxy_ward_close(u3_ward* rev_u) -{ - _proxy_ward_unlink(rev_u); - - while ( 0 != rev_u->won_u ) { - _proxy_wcon_close(rev_u->won_u); - rev_u->won_u = rev_u->won_u->nex_u; - } - - uv_close((uv_handle_t*)&rev_u->tcp_u, _proxy_ward_close_timer); -} - -/* _proxy_ward_new(): allocate reverse proxy listener -*/ -static u3_ward* -_proxy_ward_new(u3_pcon* con_u, u3_atom sip) -{ - u3_ward* rev_u = c3_calloc(sizeof(*rev_u)); - rev_u->tcp_u.data = rev_u; - rev_u->tim_u.data = rev_u; - rev_u->con_u = con_u; - - u3r_chubs(0, 2, rev_u->who_d, sip); - _proxy_ward_link(con_u, rev_u); - - u3z(sip); - - return rev_u; -} - -/* _proxy_wcon_peek_read_cb(): authenticate connection by checking nonce. -*/ -static void -_proxy_wcon_peek_read_cb(uv_stream_t* upt_u, - ssize_t siz_w, - const uv_buf_t* buf_u) -{ - u3_wcon* won_u = upt_u->data; - u3_ward* rev_u = won_u->rev_u; - - if ( 0 > siz_w ) { - if ( UV_EOF != siz_w ) { - u3l_log("proxy: ward peek: %s\n", uv_strerror(siz_w)); - } - _proxy_wcon_close(won_u); - } - else { - uv_read_stop(upt_u); - - c3_w len_w = rev_u->non_u.len; - - if ( ((len_w + 1) != siz_w) || - (len_w != buf_u->base[0]) || - (0 != memcmp(rev_u->non_u.base, buf_u->base + 1, len_w)) ) { - // u3l_log("proxy: ward auth fail\n"); - _proxy_wcon_unlink(won_u); - _proxy_wcon_close(won_u); - } - else { - _proxy_wcon_unlink(won_u); - - u3_pcon* con_u = rev_u->con_u; - con_u->upt_u = (uv_tcp_t*)&won_u->upt_u; - con_u->upt_u->data = con_u; - - _proxy_fire(con_u); - _proxy_ward_close(rev_u); - } - } -} - -/* _proxy_wcon_peek(): peek at a new incoming connection -*/ -static void -_proxy_wcon_peek(u3_wcon* won_u) -{ - uv_read_start((uv_stream_t*)&won_u->upt_u, - _proxy_alloc, _proxy_wcon_peek_read_cb); -} - -/* _proxy_ward_accept(): accept new connection on ward -*/ -static void -_proxy_ward_accept(u3_ward* rev_u) -{ - u3_wcon* won_u = _proxy_wcon_new(rev_u); - - uv_tcp_init(u3L, &won_u->upt_u); - - c3_i sas_i; - - if ( 0 != (sas_i = uv_accept((uv_stream_t*)&rev_u->tcp_u, - (uv_stream_t*)&won_u->upt_u)) ) { - u3l_log("proxy: accept: %s\n", uv_strerror(sas_i)); - _proxy_wcon_close(won_u); - } - else { - _proxy_wcon_peek(won_u); - } -} - -/* _proxy_ward_listen_cb(): listen callback for ward -*/ -static void -_proxy_ward_listen_cb(uv_stream_t* tcp_u, c3_i sas_i) -{ - u3_ward* rev_u = (u3_ward*)tcp_u; - - if ( 0 != sas_i ) { - u3l_log("proxy: ward: %s\n", uv_strerror(sas_i)); - } - else { - _proxy_ward_accept(rev_u); - } -} - -/* _proxy_ward_timer_cb(): expiration timer for ward -*/ -static void -_proxy_ward_timer_cb(uv_timer_t* tim_u) -{ - u3_ward* rev_u = tim_u->data; - - if ( 0 != rev_u ) { - u3l_log("proxy: ward expired: %d\n", rev_u->por_s); - _proxy_ward_close(rev_u); - _proxy_conn_close(rev_u->con_u); - } -} - -/* _proxy_ward_plan(): notify ship of new ward -*/ -static void -_proxy_ward_plan(u3_ward* rev_u) -{ - u3_noun non, cad; - - { - c3_w* non_w = c3_malloc(64); - c3_w len_w; - - c3_rand(non_w); - - non = u3i_words(16, non_w); - len_w = u3r_met(3, non); - - // the nonce is saved to authenticate u3_wcon - // and will be freed with u3_ward - // - rev_u->non_u = uv_buf_init((c3_c*)non_w, len_w); - } - - { - u3_noun who = u3i_chubs(2, rev_u->who_d); - u3_noun cha = u3nq(c3__a, c3__give, c3__prox, u3_nul); - u3_noun dat = u3nc(c3__that, u3nt(rev_u->por_s, - u3k(rev_u->con_u->sec), - non)); - - cad = u3nq(c3__want, who, cha, dat); - } - - // XX s/b c3__ames? - // - u3_pier_plan(u3nt(u3_blip, c3__newt, u3_nul), cad); -} - -/* _proxy_ward_start(): start ward (ship-specific listener). -*/ -static void -_proxy_ward_start(u3_pcon* con_u, u3_noun sip) -{ - u3_ward* rev_u = _proxy_ward_new(con_u, u3k(sip)); - - uv_tcp_init(u3L, &rev_u->tcp_u); - - struct sockaddr_in add_u; - c3_i add_i = sizeof(add_u); - memset(&add_u, 0, add_i); - add_u.sin_family = AF_INET; - add_u.sin_addr.s_addr = INADDR_ANY; - add_u.sin_port = 0; // first available - - c3_i sas_i; - - if ( 0 != (sas_i = uv_tcp_bind(&rev_u->tcp_u, - (const struct sockaddr*)&add_u, 0)) || - 0 != (sas_i = uv_listen((uv_stream_t*)&rev_u->tcp_u, - TCP_BACKLOG, _proxy_ward_listen_cb)) || - 0 != (sas_i = uv_tcp_getsockname(&rev_u->tcp_u, - (struct sockaddr*)&add_u, &add_i))) { - u3l_log("proxy: ward: %s\n", uv_strerror(sas_i)); - _proxy_ward_close(rev_u); - _proxy_conn_close(con_u); - } - else { - rev_u->por_s = ntohs(add_u.sin_port); - -#if 0 - { - u3_noun who = u3dc("scot", 'p', u3k(sip)); - c3_c* who_c = u3r_string(who); - u3l_log("\r\nward for %s started on %u\r\n", who_c, rev_u->por_s); - c3_free(who_c); - u3z(who); - } -#endif - - _proxy_ward_plan(rev_u); - - // XX how long? - // - uv_timer_init(u3L, &rev_u->tim_u); - uv_timer_start(&rev_u->tim_u, _proxy_ward_timer_cb, 600 * 1000, 0); - } - - u3z(sip); -} - -/* _proxy_ward_connect_cb(): ward connection callback -*/ -static void -_proxy_ward_connect_cb(uv_connect_t * upc_u, c3_i sas_i) -{ - u3_pcon* con_u = upc_u->data; - - if ( 0 != sas_i ) { - u3l_log("proxy: ward connect: %s\n", uv_strerror(sas_i)); - _proxy_conn_close(con_u); - } - else { - // XX can con_u close before the loopback conn is established? - _proxy_loop_connect(con_u); - - u3_warc* cli_u = con_u->src_u.cli_u; - - // send %that nonce to ward for authentication - _proxy_write(con_u, (uv_stream_t*)&(con_u->don_u), cli_u->non_u); - - cli_u->non_u = uv_buf_init(0, 0); - } - - c3_free(upc_u); -} - -/* _proxy_ward_connect(): connect to remote ward -*/ -static void -_proxy_ward_connect(u3_warc* cli_u) -{ - u3_pcon* con_u = _proxy_conn_new(u3_ptyp_ward, cli_u); - - uv_tcp_init(u3L, &con_u->don_u); - - struct sockaddr_in add_u; - - memset(&add_u, 0, sizeof(add_u)); - add_u.sin_family = AF_INET; - add_u.sin_addr.s_addr = htonl(cli_u->ipf_w); - add_u.sin_port = htons(cli_u->por_s); - - uv_connect_t* upc_u = c3_malloc(sizeof(*upc_u)); - upc_u->data = con_u; - - c3_i sas_i; - - if ( 0 != (sas_i = uv_tcp_connect(upc_u, &con_u->don_u, - (const struct sockaddr*)&add_u, - _proxy_ward_connect_cb)) ) { - u3l_log("proxy: ward connect: %s\n", uv_strerror(sas_i)); - c3_free(upc_u); - _proxy_conn_close(con_u); - } -} - -/* _proxy_ward_resolve_cb(): ward IP address resolution callback -*/ -static void -_proxy_ward_resolve_cb(uv_getaddrinfo_t* adr_u, - c3_i sas_i, - struct addrinfo* aif_u) -{ - u3_warc* cli_u = adr_u->data; - - if ( 0 != sas_i ) { - u3l_log("proxy: ward: resolve: %s\n", uv_strerror(sas_i)); - _proxy_warc_free(cli_u); - } - else { - // XX traverse struct a la _ames_czar_cb - cli_u->ipf_w = ntohl(((struct sockaddr_in *)aif_u->ai_addr)->sin_addr.s_addr); - _proxy_ward_connect(cli_u); - } - - c3_free(adr_u); - uv_freeaddrinfo(aif_u); -} - -/* _proxy_reverse_resolve(): resolve IP address of remote ward -*/ -static void -_proxy_ward_resolve(u3_warc* cli_u) -{ - uv_getaddrinfo_t* adr_u = c3_malloc(sizeof(*adr_u)); - adr_u->data = cli_u; - - struct addrinfo hin_u; - memset(&hin_u, 0, sizeof(struct addrinfo)); - - hin_u.ai_family = PF_INET; - hin_u.ai_socktype = SOCK_STREAM; - hin_u.ai_protocol = IPPROTO_TCP; - - // XX why the conditional? - // - if ( 0 == cli_u->hot_c ) { - u3_noun sip = u3dc("scot", 'p', u3i_chubs(2, cli_u->who_d)); - c3_c* sip_c = u3r_string(sip); - c3_w len_w = 1 + strlen(sip_c) + strlen(PROXY_DOMAIN); - cli_u->hot_c = c3_malloc(len_w); - // incremented to skip '~' - snprintf(cli_u->hot_c, len_w, "%s.%s", sip_c + 1, PROXY_DOMAIN); - - c3_free(sip_c); - u3z(sip); - } - - c3_i sas_i; - - if ( 0 != (sas_i = uv_getaddrinfo(u3L, adr_u, _proxy_ward_resolve_cb, - cli_u->hot_c, 0, &hin_u)) ) { - u3l_log("proxy: ward: resolve: %s\n", uv_strerror(sas_i)); - _proxy_warc_free(cli_u); - } -} - -/* _proxy_parse_host(): parse plaintext buffer for Host header -*/ -static u3_proxy_pars -_proxy_parse_host(const uv_buf_t* buf_u, c3_c** hot_c) -{ - struct phr_header hed_u[H2O_MAX_HEADERS]; - size_t hed_t = H2O_MAX_HEADERS; - - { - // unused - c3_i ver_i; - const c3_c* met_c; - size_t met_t; - const c3_c* pat_c; - size_t pat_t; - - size_t len_t = buf_u->len < H2O_MAX_REQLEN ? buf_u->len : H2O_MAX_REQLEN; - // XX slowloris? - c3_i las_i = 0; - c3_i sas_i; - - sas_i = phr_parse_request(buf_u->base, len_t, &met_c, &met_t, - &pat_c, &pat_t, &ver_i, hed_u, &hed_t, las_i); - - switch ( sas_i ) { - case -1: return u3_pars_fail; - case -2: return u3_pars_moar; - } - } - - const h2o_token_t* tok_t; - size_t i; - - for ( i = 0; i < hed_t; i++ ) { - // XX in-place, copy first - h2o_strtolower((c3_c*)hed_u[i].name, hed_u[i].name_len); - - if ( 0 != (tok_t = h2o_lookup_token(hed_u[i].name, hed_u[i].name_len)) ) { - if ( tok_t->is_init_header_special && H2O_TOKEN_HOST == tok_t ) { - c3_c* val_c; - c3_c* por_c; - - val_c = c3_malloc(1 + hed_u[i].value_len); - val_c[hed_u[i].value_len] = 0; - memcpy(val_c, hed_u[i].value, hed_u[i].value_len); - - // 'truncate' by replacing port separator ':' with 0 - if ( 0 != (por_c = strchr(val_c, ':')) ) { - por_c[0] = 0; - } - - *hot_c = val_c; - break; - } - } - } - - return u3_pars_good; -} - -/* _proxy_parse_sni(): parse clienthello buffer for SNI -*/ -static u3_proxy_pars -_proxy_parse_sni(const uv_buf_t* buf_u, c3_c** hot_c) -{ - c3_i sas_i = parse_tls_header((const uint8_t*)buf_u->base, - buf_u->len, hot_c); - - if ( 0 > sas_i ) { - switch ( sas_i ) { - case -1: return u3_pars_moar; - case -2: return u3_pars_good; // SNI not present - default: return u3_pars_fail; - } - } - - return u3_pars_good; -} - -/* _proxy_parse_ship(): determine destination (unit ship) for proxied request -*/ -static u3_noun -_proxy_parse_ship(c3_c* hot_c) -{ - if ( 0 == hot_c ) { - return u3_nul; - } - else { - c3_c* dom_c = strchr(hot_c, '.'); - - if ( 0 == dom_c ) { - return u3_nul; - } - else { - // length of the first subdomain - // - c3_w dif_w = dom_c - hot_c; - c3_w dns_w = strlen(PROXY_DOMAIN); - - // validate that everything after the first subdomain - // matches the proxy domain - // (skipped if networking is disabled) - // - if ( (c3y == u3_Host.ops_u.net) && - ( (dns_w != strlen(hot_c) - (dif_w + 1)) || - (0 != strncmp(dom_c + 1, PROXY_DOMAIN, dns_w)) ) ) - { - return u3_nul; - } - else { - // attempt to parse the first subdomain as a @p - // - u3_noun sip; - c3_c* sip_c = c3_malloc(2 + dif_w); - - strncpy(sip_c + 1, hot_c, dif_w); - sip_c[0] = '~'; - sip_c[1 + dif_w] = 0; - - sip = u3dc("slaw", 'p', u3i_string(sip_c)); - c3_free(sip_c); - - return sip; - } - } - } -} - -/* _proxy_dest(): proxy to destination -*/ -static void -_proxy_dest(u3_pcon* con_u, u3_noun sip) -{ - if ( u3_nul == sip ) { - _proxy_loop_connect(con_u); - } - else { - // XX revisit - u3_pier* pir_u = u3_pier_stub(); - u3_noun our = u3i_chubs(2, pir_u->who_d); - u3_noun hip = u3t(sip); - - if ( c3y == u3r_sing(our, hip) ) { - _proxy_loop_connect(con_u); - } - else { - // XX we should u3v_peek %j /=sein= to confirm - // that we're sponsoring this ship - // - _proxy_ward_start(con_u, u3k(hip)); - } - - u3z(our); - } - - u3z(sip); -} - -static void _proxy_peek_read(u3_pcon* con_u); - -/* _proxy_peek(): peek at proxied request for destination -*/ -static void -_proxy_peek(u3_pcon* con_u) -{ - c3_c* hot_c = 0; - - u3_proxy_pars sat_e = ( c3y == con_u->sec ) ? - _proxy_parse_sni(&con_u->buf_u, &hot_c) : - _proxy_parse_host(&con_u->buf_u, &hot_c); - - switch ( sat_e ) { - default: c3_assert(0); - - case u3_pars_fail: { - u3l_log("proxy: peek fail\n"); - _proxy_conn_close(con_u); - break; - } - - case u3_pars_moar: { - u3l_log("proxy: peek moar\n"); - // XX count retries, fail after some n - _proxy_peek_read(con_u); - break; - } - - case u3_pars_good: { - u3_noun sip = _proxy_parse_ship(hot_c); - _proxy_dest(con_u, sip); - break; - } - } - - if ( 0 != hot_c ) { - c3_free(hot_c); - } -} - -/* _proxy_peek_read_cb(): read callback for peeking at proxied request -*/ -static void -_proxy_peek_read_cb(uv_stream_t* don_u, - ssize_t siz_w, - const uv_buf_t* buf_u) -{ - u3_pcon* con_u = don_u->data; - - if ( 0 > siz_w ) { - if ( UV_EOF != siz_w ) { - u3l_log("proxy: peek: %s\n", uv_strerror(siz_w)); - } - _proxy_conn_close(con_u); - } - else { - uv_read_stop(don_u); - - if ( 0 == con_u->buf_u.base ) { - con_u->buf_u = uv_buf_init(buf_u->base, siz_w); - } - else { - c3_w len_w = siz_w + con_u->buf_u.len; - void* ptr_v = c3_realloc(con_u->buf_u.base, len_w); - - memcpy(ptr_v + con_u->buf_u.len, buf_u->base, siz_w); - con_u->buf_u = uv_buf_init(ptr_v, len_w); - - c3_free(buf_u->base); - } - - _proxy_peek(con_u); - } -} - -/* _proxy_peek_read(): start read to peek at proxied request -*/ -static void -_proxy_peek_read(u3_pcon* con_u) -{ - uv_read_start((uv_stream_t*)&con_u->don_u, - _proxy_alloc, _proxy_peek_read_cb); -} - -/* _proxy_serv_free(): free proxy listener -*/ -static void -_proxy_serv_free(u3_prox* lis_u) -{ - u3_pcon* con_u = lis_u->con_u; - - while ( con_u ) { - _proxy_conn_close(con_u); - con_u = con_u->nex_u; - } - - u3_ward* rev_u = lis_u->rev_u; - - while ( rev_u ) { - _proxy_ward_close(rev_u); - rev_u = rev_u->nex_u; - } - - // not unlinked here, owned directly by htp_u - - c3_free(lis_u); -} - -/* _proxy_serv_close(): close proxy listener -*/ -static void -_proxy_serv_close(u3_prox* lis_u) -{ - uv_close((uv_handle_t*)&lis_u->sev_u, (uv_close_cb)_proxy_serv_free); -} - -/* _proxy_serv_new(): allocate proxy listener -*/ -static u3_prox* -_proxy_serv_new(u3_http* htp_u, c3_s por_s, c3_o sec) -{ - u3_prox* lis_u = c3_malloc(sizeof(*lis_u)); - lis_u->sev_u.data = lis_u; - lis_u->por_s = por_s; - lis_u->sec = sec; - lis_u->htp_u = htp_u; - lis_u->con_u = 0; - lis_u->rev_u = 0; - - // not linked here, owned directly by htp_u - - return lis_u; -} - -/* _proxy_serv_accept(): accept new connection. -*/ -static void -_proxy_serv_accept(u3_prox* lis_u) -{ - u3_pcon* con_u = _proxy_conn_new(u3_ptyp_prox, lis_u); - - uv_tcp_init(u3L, &con_u->don_u); - - c3_i sas_i; - if ( 0 != (sas_i = uv_accept((uv_stream_t*)&lis_u->sev_u, - (uv_stream_t*)&con_u->don_u)) ) { - u3l_log("proxy: accept: %s\n", uv_strerror(sas_i)); - _proxy_conn_close(con_u); - } - else { - _proxy_peek_read(con_u); - } -} - -/* _proxy_serv_listen_cb(): listen callback for proxy server. -*/ -static void -_proxy_serv_listen_cb(uv_stream_t* sev_u, c3_i sas_i) -{ - u3_prox* lis_u = (u3_prox*)sev_u; - - if ( 0 != sas_i ) { - u3l_log("proxy: listen_cb: %s\n", uv_strerror(sas_i)); - } - else { - _proxy_serv_accept(lis_u); - } -} - -/* _proxy_serv_start(): start reverse TCP proxy server. -*/ -static u3_prox* -_proxy_serv_start(u3_prox* lis_u) -{ - uv_tcp_init(u3L, &lis_u->sev_u); - - struct sockaddr_in add_u; - - memset(&add_u, 0, sizeof(add_u)); - add_u.sin_family = AF_INET; - add_u.sin_addr.s_addr = INADDR_ANY; - - /* Try ascending ports. - */ - while ( 1 ) { - c3_i sas_i; - - add_u.sin_port = htons(lis_u->por_s); - - if ( 0 != (sas_i = uv_tcp_bind(&lis_u->sev_u, - (const struct sockaddr*)&add_u, 0)) || - 0 != (sas_i = uv_listen((uv_stream_t*)&lis_u->sev_u, - TCP_BACKLOG, _proxy_serv_listen_cb)) ) { - if ( (UV_EADDRINUSE == sas_i) || (UV_EACCES == sas_i) ) { - if ( (c3y == lis_u->sec) && (443 == lis_u->por_s) ) { - lis_u->por_s = 9443; - } - else if ( (c3n == lis_u->sec) && (80 == lis_u->por_s) ) { - lis_u->por_s = 9080; - } - else { - lis_u->por_s++; - } - - continue; - } - - u3l_log("proxy: listen: %s\n", uv_strerror(sas_i)); - _proxy_serv_free(lis_u); - return 0; - } - - return lis_u; - } -} - /* u3_http_ef_that(): reverse proxy requested connection notification. */ void u3_http_ef_that(u3_noun sip, u3_noun tat) { - u3_noun por, sec, non; - - u3x_trel(tat, &por, &sec, &non); - c3_assert( c3y == u3a_is_cat(por) ); - c3_assert( c3y == sec || c3n == sec ); - c3_assert( c3y == u3ud(non) ); - - // XX sip s/b validated -- could be *any* ship - // - - { - u3_http* htp_u; - u3_warc* cli_u; - - for ( htp_u = u3_Host.htp_u; (0 != htp_u); htp_u = htp_u->nex_u ) { - if ( c3n == htp_u->lop && sec == htp_u->sec ) { - break; - } - } - - // XX we should inform our sponsor if we aren't running a server - // so this situation can be avoided - // - if ( 0 == htp_u ) { - u3l_log("http: that: no %s server\n", - (c3y == sec) ? "secure" : "insecure"); - } - else { - cli_u = _proxy_warc_new(htp_u, (u3_atom)u3k(sip), (u3_atom)u3k(non), - (c3_s)por, (c3_o)sec); - - // resolve to loopback if networking is disabled - // - if ( c3n == u3_Host.ops_u.net ) { - cli_u->ipf_w = INADDR_LOOPBACK; - _proxy_ward_connect(cli_u); - } - else { - _proxy_ward_resolve(cli_u); - } - } - } - - u3z(sip); - u3z(tat); + c3_assert(0); } From a777a0115f25105847b8dec970150bc4ae27f6f0 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sun, 19 Apr 2020 16:30:38 -0700 Subject: [PATCH 020/257] vere: WIP moves http.c to u3_auto --- pkg/urbit/include/vere/vere.h | 181 +----------- pkg/urbit/vere/http.c | 532 +++++++++++++++++++++++----------- pkg/urbit/vere/pier.c | 28 +- pkg/urbit/vere/reck.c | 140 ++++----- 4 files changed, 457 insertions(+), 424 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index aa59ca808..88dfde91c 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -36,146 +36,6 @@ c3_y hun_y[0]; } u3_hbod; - /* u3_rsat: http request state. - */ - typedef enum { - u3_rsat_init = 0, // initialized - u3_rsat_plan = 1, // planned - u3_rsat_ripe = 2 // responded - } u3_rsat; - - /* u3_hreq: incoming http request. - */ - typedef struct _u3_hreq { - h2o_req_t* rec_u; // h2o request - c3_w seq_l; // sequence within connection - u3_rsat sat_e; // request state - uv_timer_t* tim_u; // timeout - void* gen_u; // response generator - struct _u3_hcon* hon_u; // connection backlink - struct _u3_hreq* nex_u; // next in connection's list - struct _u3_hreq* pre_u; // next in connection's list - } u3_hreq; - - /* u3_hcon: incoming http connection. - */ - typedef struct _u3_hcon { - uv_tcp_t wax_u; // client stream handler - h2o_conn_t* con_u; // h2o connection - h2o_socket_t* sok_u; // h2o connection socket - c3_w ipf_w; // client ipv4 - c3_w coq_l; // connection number - c3_w seq_l; // next request number - struct _u3_http* htp_u; // server backlink - struct _u3_hreq* req_u; // request list - struct _u3_hcon* nex_u; // next in server's list - struct _u3_hcon* pre_u; // next in server's list - } u3_hcon; - - /* u3_http: http server. - */ - typedef struct _u3_http { - uv_tcp_t wax_u; // server stream handler - void* h2o_u; // libh2o configuration - struct _u3_prox* rox_u; // maybe proxied - c3_w sev_l; // server number - c3_w coq_l; // next connection number - c3_s por_s; // running port - c3_o sec; // logically secure - c3_o lop; // loopback-only - c3_o liv; // c3n == shutdown - struct _u3_hcon* hon_u; // connection list - struct _u3_http* nex_u; // next in list - } u3_http; - - /* u3_form: http config from %eyre - */ - typedef struct _u3_form { - c3_o pro; // proxy - c3_o log; // keep access log - c3_o red; // redirect to HTTPS - uv_buf_t key_u; // PEM RSA private key - uv_buf_t cer_u; // PEM certificate chain - } u3_form; - - /* u3_hfig: general http configuration - */ - typedef struct _u3_hfig { - u3_form* for_u; // config from %eyre - struct _u3_warc* cli_u; // rev proxy clients - struct _u3_pcon* con_u; // cli_u connections - } u3_hfig; - - /* u3_proxy_type: proxy connection downstream type - */ - typedef enum { - u3_ptyp_prox = 0, // connected to us - u3_ptyp_ward = 1 // we connected back to - } u3_proxy_type; - - /* u3_pcon: established proxy connection - */ - typedef struct _u3_pcon { - uv_tcp_t don_u; // downstream handle - uv_tcp_t* upt_u; // upstream handle - uv_buf_t buf_u; // pending buffer - c3_o sec; // yes == https - u3_proxy_type typ_e; // tagged - union { // union - struct _u3_warc* cli_u; // typ_e == ward - struct _u3_prox* lis_u; // typ_e == prox - } src_u; // connection source - struct _u3_pcon* nex_u; // next in list - struct _u3_pcon* pre_u; // previous in list - } u3_pcon; - - /* u3_warc: server connecting back to u3_ward as client - */ - typedef struct _u3_warc { - c3_w ipf_w; // ward ip - c3_s por_s; // ward port - c3_o sec; // secure connection - c3_d who_d[2]; // ward ship - c3_c* hot_c; // ward hostname - uv_buf_t non_u; // nonce - struct _u3_http* htp_u; // local server backlink - struct _u3_warc* nex_u; // next in list - struct _u3_warc* pre_u; // previous in list - } u3_warc; - - /* u3_wcon: candidate u3_ward upstream connection - */ - typedef struct _u3_wcon { - uv_tcp_t upt_u; // connection handle - struct _u3_ward* rev_u; // connecting to ward - struct _u3_wcon* nex_u; // next in list - } u3_wcon; - - /* u3_ward: reverse, reverse TCP proxy (ship-specific listener) - */ - typedef struct _u3_ward { - uv_tcp_t tcp_u; // listener handle - uv_timer_t tim_u; // expiration timer - c3_d who_d[2]; // reverse proxy for ship - c3_s por_s; // listening on port - uv_buf_t non_u; // nonce - struct _u3_wcon* won_u; // candidate upstream connections - struct _u3_pcon* con_u; // initiating connection - struct _u3_ward* nex_u; // next in list - struct _u3_ward* pre_u; // previous in list - } u3_ward; - - /* u3_prox: reverse TCP proxy server - */ - typedef struct _u3_prox { - uv_tcp_t sev_u; // server handle - c3_s por_s; // listening on port - c3_o sec; // yes == https - struct _u3_http* htp_u; // local server backlink - struct _u3_pcon* con_u; // active connection list - struct _u3_ward* rev_u; // active reverse listeners - } u3_prox; - /* u3_chot: foreign host (not yet used). */ typedef struct _u3_chot { @@ -438,12 +298,9 @@ c3_d now_d; // event tick uv_loop_t* lup_u; // libuv event loop u3_usig* sig_u; // signal list - u3_hfig fig_u; // http configuration - u3_http* htp_u; // http servers u3_utty* uty_u; // linked terminal list u3_opts ops_u; // commandline options c3_i xit_i; // exit code for shutdown - void* tls_u; // server SSL_CTX* u3_trac tra_u; // tracing information void (*bot_f)(); // call when chis is up } u3_host; // host == computer == process @@ -1075,44 +932,10 @@ /** HTTP server. **/ - /* u3_http_ef_form: send %from effect to http. - */ - void - u3_http_ef_form(u3_noun fig); - - /* u3_http_ef_that: send %that effect to http. - */ - void - u3_http_ef_that(u3_noun sip, u3_noun tat); - - /* u3_http_ef_http_server(): dispatch an %http-server effect from %light. - */ - void - u3_http_ef_http_server(c3_l sev_l, - c3_l coq_l, - c3_l seq_l, - u3_noun cad); - - /* u3_http_ef_bake(): create new http server. - */ - void - u3_http_ef_bake(void); - /* u3_http_io_init(): initialize http I/O. */ - void - u3_http_io_init(void); - - /* u3_http_io_talk(): start http listener. - */ - void - u3_http_io_talk(void); - - /* u3_http_io_exit(): terminate http I/O. - */ - void - u3_http_io_exit(void); - + u3_auto* + u3_http_io_init(u3_pier* pir_u); /** HTTP client. **/ diff --git a/pkg/urbit/vere/http.c b/pkg/urbit/vere/http.c index 9f9072903..8b5ef7615 100644 --- a/pkg/urbit/vere/http.c +++ b/pkg/urbit/vere/http.c @@ -26,9 +26,88 @@ typedef struct _u3_h2o_serv { h2o_handler_t* han_u; // h2o request handler } u3_h2o_serv; +/* u3_rsat: http request state. +*/ + typedef enum { + u3_rsat_init = 0, // initialized + u3_rsat_plan = 1, // planned + u3_rsat_ripe = 2 // responded + } u3_rsat; + +/* u3_hreq: incoming http request. +*/ + typedef struct _u3_hreq { + h2o_req_t* rec_u; // h2o request + c3_w seq_l; // sequence within connection + u3_rsat sat_e; // request state + uv_timer_t* tim_u; // timeout + void* gen_u; // response generator + struct _u3_hcon* hon_u; // connection backlink + struct _u3_hreq* nex_u; // next in connection's list + struct _u3_hreq* pre_u; // next in connection's list + } u3_hreq; + +/* u3_hcon: incoming http connection. +*/ + typedef struct _u3_hcon { + uv_tcp_t wax_u; // client stream handler + h2o_conn_t* con_u; // h2o connection + h2o_socket_t* sok_u; // h2o connection socket + c3_w ipf_w; // client ipv4 + c3_w coq_l; // connection number + c3_w seq_l; // next request number + struct _u3_http* htp_u; // server backlink + struct _u3_hreq* req_u; // request list + struct _u3_hcon* nex_u; // next in server's list + struct _u3_hcon* pre_u; // next in server's list + } u3_hcon; + +/* u3_http: http server. +*/ + typedef struct _u3_http { + uv_tcp_t wax_u; // server stream handler + void* h2o_u; // libh2o configuration + c3_w sev_l; // server number + c3_w coq_l; // next connection number + c3_s por_s; // running port + c3_o sec; // logically secure + c3_o lop; // loopback-only + c3_o liv; // c3n == shutdown + struct _u3_hcon* hon_u; // connection list + struct _u3_http* nex_u; // next in list + struct _u3_httd* htd_u; // device backpointer + } u3_http; + +/* u3_form: http config from %eyre +*/ + typedef struct _u3_form { + c3_o pro; // proxy + c3_o log; // keep access log + c3_o red; // redirect to HTTPS + uv_buf_t key_u; // PEM RSA private key + uv_buf_t cer_u; // PEM certificate chain + } u3_form; + +/* u3_hfig: general http configuration +*/ + typedef struct _u3_hfig { + u3_form* for_u; // config from %eyre + struct _u3_warc* cli_u; // rev proxy clients + struct _u3_pcon* con_u; // cli_u connections + } u3_hfig; + +/* u3_httd: general http device +*/ +typedef struct _u3_httd { + u3_auto car_u; // driver + u3_hfig fig_u; // http configuration + u3_http* htp_u; // http servers + SSL_CTX* tls_u; // server SSL_CTX* +} u3_httd; + static void _http_serv_free(u3_http* htp_u); -static void _http_serv_start_all(void); -static void _http_form_free(void); +static void _http_serv_start_all(u3_httd* htd_u); +static void _http_form_free(u3_httd* htd_u); static const c3_i TCP_BACKLOG = 16; @@ -305,10 +384,11 @@ _http_req_to_duct(u3_hreq* req_u) static void _http_req_kill(u3_hreq* req_u) { - u3_noun pox = _http_req_to_duct(req_u); + u3_httd* htd_u = req_u->hon_u->htp_u->htd_u; + u3_noun pax = _http_req_to_duct(req_u); + u3_noun fav = u3nc(u3i_string("cancel-request"), u3_nul); - u3_pier_plan(pox, u3nc(u3i_string("cancel-request"), - u3_nul)); + u3_auto_plan(&htd_u->car_u, 0, 0, u3_blip, pax, fav); } typedef struct _u3_hgen { @@ -384,24 +464,24 @@ _http_req_dispatch(u3_hreq* req_u, u3_noun req) c3_assert(u3_rsat_init == req_u->sat_e); req_u->sat_e = u3_rsat_plan; - u3_noun pox = _http_req_to_duct(req_u); + { + u3_http* htp_u = req_u->hon_u->htp_u; + u3_httd* htd_u = htp_u->htd_u; + u3_noun pax = _http_req_to_duct(req_u); + u3_noun fav; - if ( c3y == req_u->hon_u->htp_u->lop ) { - u3_pier_plan(pox, u3nq(u3i_string("request-local"), - // XX automatically secure too? - // - req_u->hon_u->htp_u->sec, - u3nc(c3__ipv4, - u3i_words(1, &req_u->hon_u->ipf_w)), - req)); + { + u3_noun adr = u3nc(c3__ipv4, u3i_words(1, &req_u->hon_u->ipf_w)); + // XX loopback automatically secure too? + // + u3_noun dat = u3nt(htp_u->sec, adr, req); - } - else { - u3_pier_plan(pox, u3nq(u3i_string("request"), - req_u->hon_u->htp_u->sec, - u3nc(c3__ipv4, - u3i_words(1, &req_u->hon_u->ipf_w)), - req)); + fav = ( c3y == req_u->hon_u->htp_u->lop ) + ? u3nc(u3i_string("request-local"), dat) + : u3nc(u3i_string("request"), dat); + } + + u3_auto_plan(&htd_u->car_u, 0, 0, u3_blip, pax, fav); } } @@ -822,9 +902,9 @@ _http_conn_new(u3_http* htp_u) /* _http_serv_find(): find http server by sequence. */ static u3_http* -_http_serv_find(c3_l sev_l) +_http_serv_find(u3_httd* htd_u, c3_l sev_l) { - u3_http* htp_u = u3_Host.htp_u; + u3_http* htp_u = htd_u->htp_u; // XX glories of linear search // @@ -840,19 +920,22 @@ _http_serv_find(c3_l sev_l) /* _http_serv_link(): link http server to global state. */ static void -_http_serv_link(u3_http* htp_u) +_http_serv_link(u3_httd* htd_u, u3_http* htp_u) { // XX link elsewhere initially, relink on start? - if ( 0 != u3_Host.htp_u ) { - htp_u->sev_l = 1 + u3_Host.htp_u->sev_l; + if ( 0 != htd_u->htp_u ) { + htp_u->sev_l = 1 + htd_u->htp_u->sev_l; } else { + // XX load from elsewhere + // htp_u->sev_l = u3A->sev_l; } - htp_u->nex_u = u3_Host.htp_u; - u3_Host.htp_u = htp_u; + htp_u->nex_u = htd_u->htp_u; + htp_u->htd_u = htd_u; + htd_u->htp_u = htp_u; } /* _http_serv_unlink(): remove http server from global state. @@ -864,13 +947,12 @@ _http_serv_unlink(u3_http* htp_u) #if 0 u3l_log("http serv unlink %d\n", htp_u->sev_l); #endif + u3_http* pre_u = htp_u->htd_u->htp_u; - if ( u3_Host.htp_u == htp_u ) { - u3_Host.htp_u = htp_u->nex_u; + if ( pre_u == htp_u ) { + pre_u = htp_u->nex_u; } else { - u3_http* pre_u = u3_Host.htp_u; - // XX glories of linear search // while ( pre_u ) { @@ -1021,6 +1103,7 @@ static void _http_serv_close_cb(uv_handle_t* han_u) { u3_http* htp_u = (u3_http*)han_u; + u3_httd* htd_u = htp_u->htd_u; htp_u->liv = c3n; // otherwise freed by the last linked connection @@ -1030,7 +1113,7 @@ _http_serv_close_cb(uv_handle_t* han_u) // restart if all linked servers have been shutdown { - htp_u = u3_Host.htp_u; + htp_u = htd_u->htp_u; c3_o res = c3y; while ( 0 != htp_u ) { @@ -1040,8 +1123,8 @@ _http_serv_close_cb(uv_handle_t* han_u) htp_u = htp_u->nex_u; } - if ( (c3y == res) && (0 != u3_Host.fig_u.for_u) ) { - _http_serv_start_all(); + if ( (c3y == res) && (0 != htd_u->fig_u.for_u) ) { + _http_serv_start_all(htd_u); } } } @@ -1064,7 +1147,7 @@ _http_serv_close(u3_http* htp_u) /* _http_serv_new(): create new http server. */ static u3_http* -_http_serv_new(c3_s por_s, c3_o sec, c3_o lop) +_http_serv_new(u3_httd* htd_u, c3_s por_s, c3_o sec, c3_o lop) { u3_http* htp_u = c3_malloc(sizeof(*htp_u)); @@ -1074,11 +1157,10 @@ _http_serv_new(c3_s por_s, c3_o sec, c3_o lop) htp_u->lop = lop; htp_u->liv = c3y; htp_u->h2o_u = 0; - htp_u->rox_u = 0; htp_u->hon_u = 0; htp_u->nex_u = 0; - _http_serv_link(htp_u); + _http_serv_link(htd_u, htp_u); return htp_u; } @@ -1240,19 +1322,10 @@ _http_serv_start(u3_http* htp_u) return; } - if ( 0 != htp_u->rox_u ) { - u3l_log("http: live (%s, %s) on %d (proxied on %d)\n", - (c3y == htp_u->sec) ? "secure" : "insecure", - (c3y == htp_u->lop) ? "loopback" : "public", - htp_u->por_s, - htp_u->rox_u->por_s); - } - else { - u3l_log("http: live (%s, %s) on %d\n", - (c3y == htp_u->sec) ? "secure" : "insecure", - (c3y == htp_u->lop) ? "loopback" : "public", - htp_u->por_s); - } + u3l_log("http: live (%s, %s) on %d\n", + (c3y == htp_u->sec) ? "secure" : "insecure", + (c3y == htp_u->lop) ? "loopback" : "public", + htp_u->por_s); break; } @@ -1398,7 +1471,7 @@ _http_init_tls(uv_buf_t key_u, uv_buf_t cer_u) /* _http_write_ports_file(): update .http.ports */ static void -_http_write_ports_file(c3_c *pax_c) +_http_write_ports_file(u3_httd* htd_u, c3_c *pax_c) { c3_c* nam_c = ".http.ports"; c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(nam_c); @@ -1409,7 +1482,7 @@ _http_write_ports_file(c3_c *pax_c) c3_i por_i = open(paf_c, O_WRONLY | O_CREAT | O_TRUNC, 0666); c3_free(paf_c); - u3_http* htp_u = u3_Host.htp_u; + u3_http* htp_u = htd_u->htp_u; while ( 0 != htp_u ) { if ( 0 < htp_u->por_s ) { @@ -1440,28 +1513,18 @@ _http_release_ports_file(c3_c *pax_c) c3_free(paf_c); } -/* u3_http_ef_bake(): notify %eyre that we're live -*/ -void -u3_http_ef_bake(void) -{ - u3_noun pax = u3nq(u3_blip, u3i_string("http-server"), - u3k(u3A->sen), u3_nul); - - u3_pier_plan(pax, u3nc(c3__born, u3_nul)); -} - static u3_hreq* -_http_search_req(c3_l sev_l, - c3_l coq_l, - c3_l seq_l) +_http_search_req(u3_httd* htd_u, + c3_l sev_l, + c3_l coq_l, + c3_l seq_l) { u3_http* htp_u; u3_hcon* hon_u; u3_hreq* req_u; c3_w bug_w = u3C.wag_w & u3o_verbose; - if ( !(htp_u = _http_serv_find(sev_l)) ) { + if ( !(htp_u = _http_serv_find(htd_u, sev_l)) ) { if ( bug_w ) { u3l_log("http: server not found: %x\r\n", sev_l); } @@ -1484,68 +1547,10 @@ _http_search_req(c3_l sev_l, return req_u; } -/* u3_http_ef_http_server(): dispatch an %http-server effect from %light. -*/ -void -u3_http_ef_http_server(c3_l sev_l, - c3_l coq_l, - c3_l seq_l, - u3_noun cad) -{ - u3_hreq* req_u; - - u3_noun tag, dat; - u3x_cell(cad, &tag, &dat); - - // sets server configuration - // - if ( c3y == u3r_sing_c("set-config", tag) ) { - u3_http_ef_form(u3k(dat)); - } - // responds to an open request - // - else if ( 0 != (req_u = _http_search_req(sev_l, coq_l, seq_l)) ) { - if ( c3y == u3r_sing_c("response", tag) ) { - u3_noun response = dat; - - if ( c3y == u3r_sing_c("start", u3h(response)) ) { - // Separate the %start message into its components. - // - u3_noun response_header, data, complete; - u3_noun status, headers; - u3x_trel(u3t(response), &response_header, &data, &complete); - u3x_cell(response_header, &status, &headers); - - _http_start_respond(req_u, u3k(status), u3k(headers), u3k(data), - u3k(complete)); - } - else if ( c3y == u3r_sing_c("continue", u3h(response)) ) { - // Separate the %continue message into its components. - // - u3_noun data, complete; - u3x_cell(u3t(response), &data, &complete); - - _http_continue_respond(req_u, u3k(data), u3k(complete)); - } - else if (c3y == u3r_sing_c("cancel", u3h(response))) { - u3l_log("http: %%cancel not handled yet\n"); - } - else { - u3l_log("http: strange response\n"); - } - } - else { - u3l_log("http: strange response\n"); - } - } - - u3z(cad); -} - /* _http_serv_start_all(): initialize and start servers based on saved config. */ static void -_http_serv_start_all(void) +_http_serv_start_all(u3_httd* htd_u) { u3_http* htp_u; c3_s por_s; @@ -1553,24 +1558,24 @@ _http_serv_start_all(void) u3_noun sec = u3_nul; u3_noun non = u3_none; - u3_form* for_u = u3_Host.fig_u.for_u; + u3_form* for_u = htd_u->fig_u.for_u; c3_assert( 0 != for_u ); // if the SSL_CTX existed, it'll be freed with the servers - u3_Host.tls_u = 0; + htd_u->tls_u = 0; // HTTPS server. if ( (0 != for_u->key_u.base) && (0 != for_u->cer_u.base) ) { - u3_Host.tls_u = _http_init_tls(for_u->key_u, for_u->cer_u); + htd_u->tls_u = _http_init_tls(for_u->key_u, for_u->cer_u); // Note: if tls_u is used for additional servers, // its reference count must be incremented with SSL_CTX_up_ref - if ( 0 != u3_Host.tls_u ) { + if ( 0 != htd_u->tls_u ) { por_s = ( c3y == for_u->pro ) ? 8443 : 443; - htp_u = _http_serv_new(por_s, c3y, c3n); - htp_u->h2o_u = _http_serv_init_h2o(u3_Host.tls_u, for_u->log, for_u->red); + htp_u = _http_serv_new(htd_u, por_s, c3y, c3n); + htp_u->h2o_u = _http_serv_init_h2o(htd_u->tls_u, for_u->log, for_u->red); _http_serv_start(htp_u); sec = u3nc(u3_nul, htp_u->por_s); @@ -1580,7 +1585,7 @@ _http_serv_start_all(void) // HTTP server. { por_s = ( c3y == for_u->pro ) ? 8080 : 80; - htp_u = _http_serv_new(por_s, c3n, c3n); + htp_u = _http_serv_new(htd_u, por_s, c3n, c3n); htp_u->h2o_u = _http_serv_init_h2o(0, for_u->log, for_u->red); _http_serv_start(htp_u); @@ -1590,7 +1595,7 @@ _http_serv_start_all(void) // Loopback server. { por_s = 12321; - htp_u = _http_serv_new(por_s, c3n, c3y); + htp_u = _http_serv_new(htd_u, por_s, c3n, c3y); htp_u->h2o_u = _http_serv_init_h2o(0, for_u->log, for_u->red); _http_serv_start(htp_u); @@ -1600,26 +1605,30 @@ _http_serv_start_all(void) { c3_assert( u3_none != non ); + // XX remove [sen] + // u3_noun pax = u3nq(u3_blip, u3i_string("http-server"), u3k(u3A->sen), u3_nul); - u3_pier_plan(pax, u3nt(c3__live, non, sec)); + u3_noun fav = u3nt(c3__live, non, sec); + + u3_auto_plan(&htd_u->car_u, 0, 0, u3_blip, pax, fav); } - _http_write_ports_file(u3_Host.dir_c); - _http_form_free(); + _http_write_ports_file(htd_u, u3_Host.dir_c); + _http_form_free(htd_u); } /* _http_serv_restart(): gracefully shutdown, then start servers. */ static void -_http_serv_restart(void) +_http_serv_restart(u3_httd* htd_u) { - u3_http* htp_u = u3_Host.htp_u; + u3_http* htp_u = htd_u->htp_u; if ( 0 == htp_u ) { - _http_serv_start_all(); + _http_serv_start_all(htd_u); } else { u3l_log("http: restarting servers to apply configuration\n"); @@ -1638,9 +1647,9 @@ _http_serv_restart(void) /* _http_form_free(): free and unlink saved config. */ static void -_http_form_free(void) +_http_form_free(u3_httd* htd_u) { - u3_form* for_u = u3_Host.fig_u.for_u; + u3_form* for_u = htd_u->fig_u.for_u; if ( 0 == for_u ) { return; @@ -1655,13 +1664,13 @@ _http_form_free(void) } c3_free(for_u); - u3_Host.fig_u.for_u = 0; + htd_u->fig_u.for_u = 0; } /* u3_http_ef_form(): apply configuration, restart servers. */ void -u3_http_ef_form(u3_noun fig) +u3_http_ef_form(u3_httd* htd_u, u3_noun fig) { u3_noun sec, pro, log, red; @@ -1697,11 +1706,11 @@ u3_http_ef_form(u3_noun fig) } u3z(fig); - _http_form_free(); + _http_form_free(htd_u); - u3_Host.fig_u.for_u = for_u; + htd_u->fig_u.for_u = for_u; - _http_serv_restart(); + _http_serv_restart(htd_u); // The control server has now started. // @@ -1716,44 +1725,237 @@ u3_http_ef_form(u3_noun fig) } } -/* u3_http_io_init(): initialize http I/O. +/* _http_io_talk(): start http I/O. */ -void -u3_http_io_init(void) +static void +_http_io_talk(u3_auto* car_u) { + // XX remove u3A->sen + // + u3_noun pax = u3nq(u3_blip, u3i_string("http-server"), + u3k(u3A->sen), u3_nul); + u3_noun fav = u3nc(c3__born, u3_nul); + + u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + + // XX set liv_o on done/swap? + // } -/* u3_http_io_talk(): start http I/O. +/* _http_ef_http_server(): dispatch an %http-server effect from %light. */ void -u3_http_io_talk(void) +_http_ef_http_server(u3_httd* htd_u, + c3_l sev_l, + c3_l coq_l, + c3_l seq_l, + u3_noun tag, + u3_noun dat) { + u3_hreq* req_u; + + // sets server configuration + // + if ( c3y == u3r_sing_c("set-config", tag) ) { + u3_http_ef_form(htd_u, u3k(dat)); + } + // responds to an open request + // + else if ( 0 != (req_u = _http_search_req(htd_u, sev_l, coq_l, seq_l)) ) { + if ( c3y == u3r_sing_c("response", tag) ) { + u3_noun response = dat; + + if ( c3y == u3r_sing_c("start", u3h(response)) ) { + // Separate the %start message into its components. + // + u3_noun response_header, data, complete; + u3_noun status, headers; + u3x_trel(u3t(response), &response_header, &data, &complete); + u3x_cell(response_header, &status, &headers); + + _http_start_respond(req_u, u3k(status), u3k(headers), u3k(data), + u3k(complete)); + } + else if ( c3y == u3r_sing_c("continue", u3h(response)) ) { + // Separate the %continue message into its components. + // + u3_noun data, complete; + u3x_cell(u3t(response), &data, &complete); + + _http_continue_respond(req_u, u3k(data), u3k(complete)); + } + else if (c3y == u3r_sing_c("cancel", u3h(response))) { + u3l_log("http: %%cancel not handled yet\n"); + } + else { + u3l_log("http: strange response\n"); + } + } + else { + u3l_log("http: strange response\n"); + } + } + + u3z(tag); + u3z(dat); } -/* u3_http_io_exit(): shut down http. +/* _reck_mole(): parse simple atomic mole. */ -void -u3_http_io_exit(void) +static u3_noun +_reck_mole(u3_noun fot, + u3_noun san, + c3_d* ato_d) { + u3_noun uco = u3dc("slaw", fot, san); + u3_noun p_uco, q_uco; + + if ( (c3n == u3r_cell(uco, &p_uco, &q_uco)) || + (u3_nul != p_uco) ) + { + u3l_log("strange mole %s\n", u3r_string(san)); + + u3z(fot); u3z(uco); return c3n; + } + else { + *ato_d = u3r_chub(0, q_uco); + + u3z(fot); u3z(uco); return c3y; + } +} + +/* _reck_lily(): parse little atom. +*/ +static u3_noun +_reck_lily(u3_noun fot, u3_noun txt, c3_l* tid_l) +{ + c3_d ato_d; + + if ( c3n == _reck_mole(fot, txt, &ato_d) ) { + return c3n; + } else { + if ( ato_d >= 0x80000000ULL ) { + return c3n; + } else { + *tid_l = (c3_l) ato_d; + + return c3y; + } + } +} + +/* _http_io_fete(): +*/ +static c3_o +_http_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +{ + u3_httd* htd_u = (u3_httd*)car_u; + + u3_noun i_pax, it_pax, tt_pax, tag, dat; + + if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, &tt_pax)) + || (c3n == u3r_cell(fav, &tag, &dat)) + || (u3_blip != i_pax ) + || (c3n == u3r_sing_c("http-server", it_pax)) ) + { + u3z(pax); u3z(fav); + return c3n; + } + + // XX this needs to be rewritten, defers in cases it should not + // + { + u3_noun pud = tt_pax; + u3_noun p_pud, t_pud, tt_pud, q_pud, r_pud, s_pud; + c3_l sev_l, coq_l, seq_l; + + + if ( (c3n == u3r_cell(pud, &p_pud, &t_pud)) || + (c3n == _reck_lily(c3__uv, u3k(p_pud), &sev_l)) ) + { + u3z(pax); u3z(fav); + return c3n; + } + + if ( u3_nul == t_pud ) { + coq_l = seq_l = 0; + } + else { + if ( (c3n == u3r_cell(t_pud, &q_pud, &tt_pud)) || + (c3n == _reck_lily(c3__ud, u3k(q_pud), &coq_l)) ) + { + u3z(pax); u3z(fav); + return c3n; + } + + if ( u3_nul == tt_pud ) { + seq_l = 0; + } else { + if ( (c3n == u3r_cell(tt_pud, &r_pud, &s_pud)) || + (u3_nul != s_pud) || + (c3n == _reck_lily(c3__ud, u3k(r_pud), &seq_l)) ) + { + u3z(pax); u3z(fav); + return c3n; + } + } + } + + _http_ef_http_server(htd_u, sev_l, coq_l, seq_l, u3k(tag), u3k(dat)); + u3z(pax); u3z(fav); + return c3y; + } +} + +/* _http_io_exit(): shut down http. +*/ +static void +_http_io_exit(u3_auto* car_u) +{ + u3_httd* htd_u = (u3_httd*)car_u; + // dispose of configuration to avoid restarts // - _http_form_free(); + _http_form_free(htd_u); // close all servers // - for ( u3_http* htp_u = u3_Host.htp_u; htp_u; htp_u = htp_u->nex_u ) { - _http_serv_close(htp_u); - } + // XX broken + // + // for ( u3_http* htp_u = htd_u->htp_u; htp_u; htp_u = htp_u->nex_u ) { + // _http_serv_close(htp_u); + // } // XX close u3_Host.fig_u.cli_u and con_u _http_release_ports_file(u3_Host.dir_c); } -/* u3_http_ef_that(): reverse proxy requested connection notification. -*/ -void -u3_http_ef_that(u3_noun sip, u3_noun tat) +static void +_http_ev_noop(u3_auto* car_u, void* vod_p) { - c3_assert(0); } + + +/* u3_http_io_init(): initialize http I/O. +*/ +u3_auto* +u3_http_io_init(u3_pier* pir_u) +{ + u3_httd* htd_u = c3_calloc(sizeof(*htd_u)); + + u3_auto* car_u = &htd_u->car_u; + car_u->nam_m = c3__http; + car_u->liv_o = c3n; + car_u->io.talk_f = _http_io_talk; + car_u->io.fete_f = _http_io_fete; + car_u->io.exit_f = _http_io_exit; + + car_u->ev.drop_f = _http_ev_noop; + car_u->ev.work_f = _http_ev_noop; + car_u->ev.done_f = _http_ev_noop; + car_u->ev.swap_f = _http_ev_noop; + car_u->ev.bail_f = _http_ev_noop; + + return car_u; +} \ No newline at end of file diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 8241c5f4d..7ac419fef 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -1179,11 +1179,11 @@ _pier_loop_wake(u3_auto* car_u) // XX legacy handlers, not yet scoped to a pier // { - cod_l = u3a_lush(c3__http); - u3_http_io_talk(); - u3_http_ef_bake(); + // cod_l = u3a_lush(c3__http); + // u3_http_io_talk(); + // u3_http_ef_bake(); // u3_cttp_ef_bake(); - u3a_lop(cod_l); + // u3a_lop(cod_l); cod_l = u3a_lush(c3__term); u3_term_io_talk(); @@ -1219,9 +1219,9 @@ _pier_loop_exit(u3_auto* car_u) // XX legacy handlers, not yet scoped to a pier // { - cod_l = u3a_lush(c3__http); - u3_http_io_exit(); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__http); + // u3_http_io_exit(); + // u3a_lop(cod_l); // cod_l = u3a_lush(c3__cttp); // u3_cttp_io_exit(); @@ -1282,6 +1282,14 @@ _pier_loop_init(u3_pier* pir_u) las_u = &rac_u->nex_u; } + { + u3_auto* rac_u = u3_http_io_init(pir_u); + rac_u->pir_u = pir_u; + + *las_u = rac_u; + las_u = &rac_u->nex_u; + } + { u3_auto* rac_u = u3_ames_io_init(pir_u); rac_u->pir_u = pir_u; @@ -1339,9 +1347,9 @@ _pier_loop_init(u3_pier* pir_u) u3_term_io_init(); u3a_lop(cod_l); - cod_l = u3a_lush(c3__http); - u3_http_io_init(); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__http); + // u3_http_io_init(); + // u3a_lop(cod_l); // cod_l = u3a_lush(c3__cttp); // u3_cttp_io_init(); diff --git a/pkg/urbit/vere/reck.c b/pkg/urbit/vere/reck.c index c3a731dd4..a8fd888ac 100644 --- a/pkg/urbit/vere/reck.c +++ b/pkg/urbit/vere/reck.c @@ -13,49 +13,49 @@ #include "all.h" #include "vere/vere.h" -/* _reck_mole(): parse simple atomic mole. -*/ -static u3_noun -_reck_mole(u3_noun fot, - u3_noun san, - c3_d* ato_d) -{ - u3_noun uco = u3dc("slaw", fot, san); - u3_noun p_uco, q_uco; +// /* _reck_mole(): parse simple atomic mole. +// */ +// static u3_noun +// _reck_mole(u3_noun fot, +// u3_noun san, +// c3_d* ato_d) +// { +// u3_noun uco = u3dc("slaw", fot, san); +// u3_noun p_uco, q_uco; - if ( (c3n == u3r_cell(uco, &p_uco, &q_uco)) || - (u3_nul != p_uco) ) - { - u3l_log("strange mole %s\n", u3r_string(san)); +// if ( (c3n == u3r_cell(uco, &p_uco, &q_uco)) || +// (u3_nul != p_uco) ) +// { +// u3l_log("strange mole %s\n", u3r_string(san)); - u3z(fot); u3z(uco); return c3n; - } - else { - *ato_d = u3r_chub(0, q_uco); +// u3z(fot); u3z(uco); return c3n; +// } +// else { +// *ato_d = u3r_chub(0, q_uco); - u3z(fot); u3z(uco); return c3y; - } -} +// u3z(fot); u3z(uco); return c3y; +// } +// } -/* _reck_lily(): parse little atom. -*/ -static u3_noun -_reck_lily(u3_noun fot, u3_noun txt, c3_l* tid_l) -{ - c3_d ato_d; +// /* _reck_lily(): parse little atom. +// */ +// static u3_noun +// _reck_lily(u3_noun fot, u3_noun txt, c3_l* tid_l) +// { +// c3_d ato_d; - if ( c3n == _reck_mole(fot, txt, &ato_d) ) { - return c3n; - } else { - if ( ato_d >= 0x80000000ULL ) { - return c3n; - } else { - *tid_l = (c3_l) ato_d; +// if ( c3n == _reck_mole(fot, txt, &ato_d) ) { +// return c3n; +// } else { +// if ( ato_d >= 0x80000000ULL ) { +// return c3n; +// } else { +// *tid_l = (c3_l) ato_d; - return c3y; - } - } -} +// return c3y; +// } +// } +// } /* _reck_orchid(): parses only a number as text * @@ -303,43 +303,43 @@ _reck_kick_spec(u3_pier* pir_u, u3_noun pox, u3_noun fav) if ( (c3n == u3r_cell(t_pox, &it_pox, &tt_pox)) ) { u3z(pox); u3z(fav); return c3n; } - else if ( c3y == u3r_sing_c("http-server", it_pox) ) { - u3_noun pud = tt_pox; - u3_noun p_pud, t_pud, tt_pud, q_pud, r_pud, s_pud; - c3_l sev_l, coq_l, seq_l; + // else if ( c3y == u3r_sing_c("http-server", it_pox) ) { + // u3_noun pud = tt_pox; + // u3_noun p_pud, t_pud, tt_pud, q_pud, r_pud, s_pud; + // c3_l sev_l, coq_l, seq_l; - if ( (c3n == u3r_cell(pud, &p_pud, &t_pud)) || - (c3n == _reck_lily(c3__uv, u3k(p_pud), &sev_l)) ) - { - u3z(pox); u3z(fav); return c3n; - } + // if ( (c3n == u3r_cell(pud, &p_pud, &t_pud)) || + // (c3n == _reck_lily(c3__uv, u3k(p_pud), &sev_l)) ) + // { + // u3z(pox); u3z(fav); return c3n; + // } - if ( u3_nul == t_pud ) { - coq_l = seq_l = 0; - } - else { - if ( (c3n == u3r_cell(t_pud, &q_pud, &tt_pud)) || - (c3n == _reck_lily(c3__ud, u3k(q_pud), &coq_l)) ) - { - u3z(pox); u3z(fav); return c3n; - } + // if ( u3_nul == t_pud ) { + // coq_l = seq_l = 0; + // } + // else { + // if ( (c3n == u3r_cell(t_pud, &q_pud, &tt_pud)) || + // (c3n == _reck_lily(c3__ud, u3k(q_pud), &coq_l)) ) + // { + // u3z(pox); u3z(fav); return c3n; + // } - if ( u3_nul == tt_pud ) { - seq_l = 0; - } else { - if ( (c3n == u3r_cell(tt_pud, &r_pud, &s_pud)) || - (u3_nul != s_pud) || - (c3n == _reck_lily(c3__ud, u3k(r_pud), &seq_l)) ) - { - u3z(pox); u3z(fav); return c3n; - } - } - } - u3_http_ef_http_server(sev_l, coq_l, seq_l, u3k(fav)); + // if ( u3_nul == tt_pud ) { + // seq_l = 0; + // } else { + // if ( (c3n == u3r_cell(tt_pud, &r_pud, &s_pud)) || + // (u3_nul != s_pud) || + // (c3n == _reck_lily(c3__ud, u3k(r_pud), &seq_l)) ) + // { + // u3z(pox); u3z(fav); return c3n; + // } + // } + // } + // u3_http_ef_http_server(sev_l, coq_l, seq_l, u3k(fav)); - u3z(pox); u3z(fav); - return c3y; - } + // u3z(pox); u3z(fav); + // return c3y; + // } // else if ( c3y == u3r_sing_c("http-client", it_pox) ) { // u3_cttp_ef_http_client(u3k(fav)); From 5e612caea3eec059cce27d4ace44e84cd9dbe01b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sun, 19 Apr 2020 23:27:28 -0700 Subject: [PATCH 021/257] vere: WIP moves term.c to u3_auto --- pkg/urbit/include/vere/vere.h | 46 ++--- pkg/urbit/vere/daemon.c | 2 + pkg/urbit/vere/pier.c | 33 ++-- pkg/urbit/vere/reck.c | 188 +++++++++---------- pkg/urbit/vere/term.c | 327 +++++++++++++++++++++++++++------- 5 files changed, 390 insertions(+), 206 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 88dfde91c..56227e286 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -244,6 +244,7 @@ u3_utat tat_u; // control state struct termios bak_u; // cooked terminal state struct termios raw_u; // raw terminal state + struct _u3_auto* car_u; // driver hack } u3_utty; /* u3_trac: tracing information. @@ -814,16 +815,6 @@ u3_noun u3_term_get_blew(c3_l tid_l); - /* u3_term_ef_boil(): initial effects for restored server. - */ - void - u3_term_ef_boil(); - - /* u3_term_ef_verb(): initial effects for verbose events. - */ - void - u3_term_ef_verb(void); - /* u3_term_ef_winc(): window change. */ void @@ -834,31 +825,10 @@ void u3_term_ef_ctlc(void); - /* u3_term_ef_bake(): initial effects for new server. - */ - void - u3_term_ef_bake(void); - - /* u3_term_ef_blit(): send %blit effect to terminal. - */ - void - u3_term_ef_blit(c3_l tid_l, - u3_noun blt); - /* u3_term_io_init(): initialize terminal I/O. */ - void - u3_term_io_init(void); - - /* u3_term_io_talk(): start terminal listener. - */ - void - u3_term_io_talk(void); - - /* u3_term_io_exit(): terminate terminal I/O. - */ - void - u3_term_io_exit(void); + u3_auto* + u3_term_io_init(u3_pier* pir_u); /* u3_term_io_hija(): hijack console for cooked print. */ @@ -875,6 +845,16 @@ void u3_term_io_loja(int x); + /* u3_term_log_init(): initialize terminal for logging + */ + void + u3_term_log_init(void); + + /* u3_term_log_exit(): clean up terminal. + */ + void + u3_term_log_exit(void); + /** Ames, packet networking. **/ diff --git a/pkg/urbit/vere/daemon.c b/pkg/urbit/vere/daemon.c index 4981c820e..930ed7506 100644 --- a/pkg/urbit/vere/daemon.c +++ b/pkg/urbit/vere/daemon.c @@ -871,6 +871,8 @@ _daemon_loop_init() uv_pipe_init(u3L, &mor_u->pyp_u, 0); uv_pipe_connect(con_u, &mor_u->pyp_u, u3K.soc_c, _boothack_cb); } + + u3_term_log_init(); } /* _daemon_loop_exit(): cleanup after event loop diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 7ac419fef..9c7535faf 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -573,6 +573,9 @@ _pier_on_lord_exit(void* vod_p, c3_o ret_o) // XX dispose // // exit(0); + u3_term_log_exit(); + // XX no can do + // uv_stop(u3L); } else { @@ -1185,10 +1188,10 @@ _pier_loop_wake(u3_auto* car_u) // u3_cttp_ef_bake(); // u3a_lop(cod_l); - cod_l = u3a_lush(c3__term); - u3_term_io_talk(); - u3_term_ef_bake(); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__term); + // u3_term_io_talk(); + // u3_term_ef_bake(); + // u3a_lop(cod_l); } } @@ -1227,9 +1230,9 @@ _pier_loop_exit(u3_auto* car_u) // u3_cttp_io_exit(); // u3a_lop(cod_l); - cod_l = u3a_lush(c3__term); - u3_term_io_exit(); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__term); + // u3_term_io_exit(); + // u3a_lop(cod_l); } } @@ -1258,6 +1261,14 @@ _pier_loop_init(u3_pier* pir_u) u3_auto* car_u; u3_auto** las_u = &car_u; + { + u3_auto* rac_u = u3_term_io_init(pir_u); + rac_u->pir_u = pir_u; + + *las_u = rac_u; + las_u = &rac_u->nex_u; + } + { u3_auto* rac_u = u3_unix_io_init(pir_u); rac_u->pir_u = pir_u; @@ -1343,9 +1354,9 @@ _pier_loop_init(u3_pier* pir_u) // XX legacy handlers, not yet scoped to a pier // { - cod_l = u3a_lush(c3__term); - u3_term_io_init(); - u3a_lop(cod_l); + // cod_l = u3a_lush(c3__term); + // u3_term_io_init(); + // u3a_lop(cod_l); // cod_l = u3a_lush(c3__http); // u3_http_io_init(); @@ -1407,6 +1418,8 @@ _pier_exit_done(u3_pier* pir_u) // _pier_loop_exit(pir_u->car_u); + u3_term_log_exit(); + // XX uninstall pier from u3K.tab_u, dispose // XX no can do diff --git a/pkg/urbit/vere/reck.c b/pkg/urbit/vere/reck.c index a8fd888ac..7936beb8a 100644 --- a/pkg/urbit/vere/reck.c +++ b/pkg/urbit/vere/reck.c @@ -57,100 +57,100 @@ // } // } -/* _reck_orchid(): parses only a number as text - * - * Parses a text string which contains a decimal number. In practice, this - * number is always '1'. - */ -static u3_noun -_reck_orchid(u3_noun fot, u3_noun txt, c3_l* tid_l) -{ - c3_c* str = u3r_string(txt); - c3_d ato_d = strtol(str, NULL, 10); - c3_free(str); +// /* _reck_orchid(): parses only a number as text +// * +// * Parses a text string which contains a decimal number. In practice, this +// * number is always '1'. +// */ +// static u3_noun +// _reck_orchid(u3_noun fot, u3_noun txt, c3_l* tid_l) +// { +// c3_c* str = u3r_string(txt); +// c3_d ato_d = strtol(str, NULL, 10); +// c3_free(str); - if ( ato_d >= 0x80000000ULL ) { - return c3n; - } else { - *tid_l = (c3_l) ato_d; +// if ( ato_d >= 0x80000000ULL ) { +// return c3n; +// } else { +// *tid_l = (c3_l) ato_d; - return c3y; - } -} +// return c3y; +// } +// } -/* _reck_kick_term(): apply terminal outputs. -*/ -static u3_noun -_reck_kick_term(u3_pier* pir_u, u3_noun pox, c3_l tid_l, u3_noun fav) -{ - u3_noun p_fav; +// /* _reck_kick_term(): apply terminal outputs. +// */ +// static u3_noun +// _reck_kick_term(u3_pier* pir_u, u3_noun pox, c3_l tid_l, u3_noun fav) +// { +// u3_noun p_fav; - if ( c3n == u3du(fav) ) { - u3z(pox); u3z(fav); return c3n; - } - else switch ( u3h(fav) ) { - default: u3z(pox); u3z(fav); return c3n; - case c3__bbye: - { - u3z(pox); u3z(fav); return c3y; - } break; +// if ( c3n == u3du(fav) ) { +// u3z(pox); u3z(fav); return c3n; +// } +// else switch ( u3h(fav) ) { +// default: u3z(pox); u3z(fav); return c3n; +// case c3__bbye: +// { +// u3z(pox); u3z(fav); return c3y; +// } break; - case c3__blit: p_fav = u3t(fav); - { - u3_term_ef_blit(tid_l, u3k(p_fav)); +// case c3__blit: p_fav = u3t(fav); +// { +// u3_term_ef_blit(tid_l, u3k(p_fav)); - u3z(pox); u3z(fav); return c3y; - } break; +// u3z(pox); u3z(fav); return c3y; +// } break; - // // this can return through dill due to our fscked up boot sequence - // // - // case c3__send: { - // u3_noun lan = u3k(u3h(u3t(fav))); - // u3_noun pac = u3k(u3t(u3t(fav))); +// // // this can return through dill due to our fscked up boot sequence +// // // +// // case c3__send: { +// // u3_noun lan = u3k(u3h(u3t(fav))); +// // u3_noun pac = u3k(u3t(u3t(fav))); - // u3l_log("kick: strange send\r\n"); - // u3_ames_ef_send(pir_u, lan, pac); - // u3z(pox); u3z(fav); return c3y; - // } break; +// // u3l_log("kick: strange send\r\n"); +// // u3_ames_ef_send(pir_u, lan, pac); +// // u3z(pox); u3z(fav); return c3y; +// // } break; - case c3__logo: - { - u3_pier_exit(pir_u); - u3_Host.xit_i = u3t(fav); +// case c3__logo: +// { +// u3_pier_exit(pir_u); +// u3_Host.xit_i = u3t(fav); - u3z(pox); u3z(fav); return c3y; - } break; +// u3z(pox); u3z(fav); return c3y; +// } break; - case c3__init: p_fav = u3t(fav); - { - // daemon ignores %init - // u3A->own = u3nc(u3k(p_fav), u3A->own); - // u3l_log("kick: init: %d\n", p_fav); - u3z(pox); u3z(fav); return c3y; - } break; +// case c3__init: p_fav = u3t(fav); +// { +// // daemon ignores %init +// // u3A->own = u3nc(u3k(p_fav), u3A->own); +// // u3l_log("kick: init: %d\n", p_fav); +// u3z(pox); u3z(fav); return c3y; +// } break; - case c3__mass: - { - u3z(pox); u3z(fav); +// case c3__mass: +// { +// u3z(pox); u3z(fav); - // gc the daemon area - // - // XX disabled due to known leaks; uncomment for dev - // - // uv_timer_start(&u3K.tim_u, (uv_timer_cb)u3_daemon_grab, 0, 0); - return c3y; - } break; +// // gc the daemon area +// // +// // XX disabled due to known leaks; uncomment for dev +// // +// // uv_timer_start(&u3K.tim_u, (uv_timer_cb)u3_daemon_grab, 0, 0); +// return c3y; +// } break; - // ignore pack (processed in worker) - // - case c3__pack: - { - u3z(pox); u3z(fav); - return c3y; - } break; - } - c3_assert(!"not reached"); return 0; -} +// // ignore pack (processed in worker) +// // +// case c3__pack: +// { +// u3z(pox); u3z(fav); +// return c3y; +// } break; +// } +// c3_assert(!"not reached"); return 0; +// } /* _reck_kick_arvo(): apply loopback effects. */ @@ -384,21 +384,21 @@ _reck_kick_spec(u3_pier* pir_u, u3_noun pox, u3_noun fav) u3z(pox); u3z(fav); return c3y; } break; - case c3__term: { - u3_noun pud = tt_pox; - u3_noun p_pud, q_pud; - c3_l tid_l; + // case c3__term: { + // u3_noun pud = tt_pox; + // u3_noun p_pud, q_pud; + // c3_l tid_l; - if ( (c3n == u3r_cell(pud, &p_pud, &q_pud)) || - (u3_nul != q_pud) || - (c3n == _reck_orchid(c3__ud, u3k(p_pud), &tid_l)) ) - { - u3l_log("term: bad tire\n"); - u3z(pox); u3z(fav); return c3n; - } else { - return _reck_kick_term(pir_u, pox, tid_l, fav); - } - } break; + // if ( (c3n == u3r_cell(pud, &p_pud, &q_pud)) || + // (u3_nul != q_pud) || + // (c3n == _reck_orchid(c3__ud, u3k(p_pud), &tid_l)) ) + // { + // u3l_log("term: bad tire\n"); + // u3z(pox); u3z(fav); return c3n; + // } else { + // return _reck_kick_term(pir_u, pox, tid_l, fav); + // } + // } break; } } c3_assert(!"not reached"); diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 3d7e550be..74f38d10a 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -58,7 +58,6 @@ _term_alloc(uv_handle_t* had_u, *buf = uv_buf_init(ptr_v, 123); } - // XX unused, but %hook is in %zuse. // implement or remove // @@ -92,10 +91,10 @@ _term_close_cb(uv_handle_t* han_t) } #endif -/* u3_term_io_init(): initialize terminal. +/* u3_term_log_init(): initialize terminal for logging */ void -u3_term_io_init() +u3_term_log_init(void) { u3_utty* uty_u = c3_calloc(sizeof(u3_utty)); @@ -113,7 +112,6 @@ u3_term_io_init() uv_pipe_init(u3L, &(uty_u->pop_u), 0); uv_pipe_open(&(uty_u->pop_u), uty_u->fid_i); - uv_read_start((uv_stream_t*)&(uty_u->pop_u), _term_alloc, _term_read_cb); } // Configure horrible stateful terminfo api. @@ -227,6 +225,21 @@ u3_term_io_init() uty_u->tat_u.fut.len_w = 0; uty_u->tat_u.fut.wid_w = 0; } + + // default size + // + { + uty_u->tat_u.siz.col_l = 80; + uty_u->tat_u.siz.row_l = 24; + } + + // initialize spinner state + // + { + uty_u->tat_u.sun_u.diz_o = c3n; + uty_u->tat_u.sun_u.eve_d = 0; + uty_u->tat_u.sun_u.end_d = 0; + } } // This is terminal 1, linked in host. @@ -237,6 +250,8 @@ u3_term_io_init() u3_Host.uty_u = uty_u; } + // if terminal/tty is enabled + // if ( c3n == u3_Host.ops_u.tem ) { // Start raw input. // @@ -249,24 +264,19 @@ u3_term_io_init() } } - // initialize spinner timeout (if terminal/tty is enabled) + // initialize spinner timeout // - if ( c3n == u3_Host.ops_u.tem ) { + { uv_timer_init(u3L, &uty_u->tat_u.sun_u.tim_u); uty_u->tat_u.sun_u.tim_u.data = uty_u; } } } -void -u3_term_io_talk(void) -{ -} - -/* u3_term_io_exit(): clean up terminal. +/* u3_term_log_exit(): clean up terminal. */ void -u3_term_io_exit(void) +u3_term_log_exit(void) { if ( c3y == u3_Host.ops_u.tem ) { uv_close((uv_handle_t*)&u3_Host.uty_u->pop_u, 0); @@ -289,6 +299,7 @@ u3_term_io_exit(void) } } + /* _term_tcsetattr(): tcsetattr w/retry on EINTR. */ static c3_i @@ -578,10 +589,15 @@ _term_it_save(u3_noun pax, u3_noun pad) static void _term_io_belt(u3_utty* uty_u, u3_noun blb) { - u3_noun tid = u3dc("scot", c3__ud, uty_u->tid_l); - u3_noun pax = u3nq(u3_blip, c3__term, tid, u3_nul); + // XX s/b u3dc("scot", c3__ud, uty_u->tid_l) + // + u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + u3_noun fav = u3nc(c3__belt, blb); - u3_pier_plan(pax, u3nc(c3__belt, blb)); + c3_assert( 1 == uty_u->tid_l ); + c3_assert( uty_u->car_u ); + + u3_auto_plan(uty_u->car_u, 0, 0, u3_blip, pax, fav); } /* _term_io_suck_char(): process a single character. @@ -897,7 +913,7 @@ _term_main() /* _term_ef_get(): terminal by id. */ static u3_utty* -_term_ef_get(c3_l tid_l) +_term_ef_get(c3_l tid_l) { if ( 0 != tid_l ) { u3_utty* uty_u; @@ -945,8 +961,12 @@ void u3_term_ef_winc(void) { u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + u3_noun fav = u3nc(c3__blew, u3_term_get_blew(1)); - u3_pier_plan(pax, u3nc(c3__blew, u3_term_get_blew(1))); + c3_assert( 1 == u3_Host.uty_u->tid_l ); + c3_assert( u3_Host.uty_u->car_u ); + + u3_auto_plan(u3_Host.uty_u->car_u, 0, 0, u3_blip, pax, fav); } /* u3_term_ef_ctlc(): send ^C on console. @@ -954,35 +974,19 @@ u3_term_ef_winc(void) void u3_term_ef_ctlc(void) { - u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + u3_utty* uty_u = _term_main(); - u3_pier_plan(pax, u3nt(c3__belt, c3__ctl, 'c')); + { + u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + u3_noun fav = u3nt(c3__belt, c3__ctl, 'c'); - _term_it_refresh_line(_term_main()); -} + c3_assert( 1 == uty_u->tid_l ); + c3_assert( uty_u->car_u ); -/* u3_term_ef_verb(): initial effects for verbose events -*/ -void -u3_term_ef_verb(void) -{ - u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + u3_auto_plan(uty_u->car_u, 0, 0, u3_blip, pax, fav); + } - u3_pier_plan(pax, u3nc(c3__verb, u3_nul)); -} - -/* u3_term_ef_bake(): initial effects for new terminal. -*/ -void -u3_term_ef_bake(void) -{ - u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); - - // u3_pier_plan(u3k(pax), u3nq(c3__flow, c3__seat, c3__dojo, u3_nul)); - u3_pier_plan(u3k(pax), u3nc(c3__blew, u3_term_get_blew(1))); - u3_pier_plan(u3k(pax), u3nc(c3__hail, u3_nul)); - - u3z(pax); + _term_it_refresh_line(uty_u); } /* _term_ef_blit(): send blit to terminal. @@ -1071,32 +1075,6 @@ _term_ef_blit(u3_utty* uty_u, return; } -/* u3_term_ef_blit(): send %blit list to specific terminal. -*/ -void -u3_term_ef_blit(c3_l tid_l, - u3_noun bls) -{ - u3_utty* uty_u = _term_ef_get(tid_l); - - if ( 0 == uty_u ) { - // u3l_log("no terminal %d\n", tid_l); - // u3l_log("uty_u %p\n", u3_Host.uty_u); - - u3z(bls); return; - } - - { - u3_noun bis = bls; - - while ( c3y == u3du(bis) ) { - _term_ef_blit(uty_u, u3k(u3h(bis))); - bis = u3t(bis); - } - u3z(bls); - } -} - /* u3_term_io_hija(): hijack console for fprintf, returning FILE*. */ FILE* @@ -1241,3 +1219,214 @@ u3_term_wall(u3_noun wol) u3z(wol); } + +/* _term_io_talk(): +*/ +static void +_term_io_talk(u3_auto* car_u) +{ + if ( c3n == u3_Host.ops_u.tem ) { + u3_utty* uty_u = _term_main(); + + uv_read_start((uv_stream_t*)&(uty_u->pop_u), + _term_alloc, + _term_read_cb); + } + + // XX groace hardcoded terminal number + // + u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + u3_noun fav; + + // set verbose as per -v + // + // XX should be explicit, not a toggle + // + if ( c3y == u3_Host.ops_u.veb ) { + fav = u3nc(c3__verb, u3_nul); + u3_auto_plan(car_u, 0, 0, u3_blip, u3k(pax), fav); + } + + // send terminal dimensions + // + { + fav = u3nc(c3__blew, u3_term_get_blew(1)); + u3_auto_plan(car_u, 0, 0, u3_blip, u3k(pax), fav); + } + + // NB, term.c used to also start :dojo + // + // u3nq(c3__flow, c3__seat, c3__dojo, u3_nul) + + // refresh terminal state + // + { + fav = u3nc(c3__hail, u3_nul); + u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + } +} + +/* _reck_orchid(): parses only a number as text + * + * Parses a text string which contains a decimal number. In practice, this + * number is always '1'. + */ +static u3_noun +_reck_orchid(u3_noun fot, u3_noun txt, c3_l* tid_l) +{ + c3_c* str = u3r_string(txt); + c3_d ato_d = strtol(str, NULL, 10); + c3_free(str); + + if ( ato_d >= 0x80000000ULL ) { + return c3n; + } else { + *tid_l = (c3_l) ato_d; + + return c3y; + } +} + +/* _term_io_fete(): +*/ +static c3_o +_term_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +{ + u3_noun i_pax, it_pax, tt_pax, tag, dat; + c3_o ret_o; + + if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, &tt_pax)) + || (c3n == u3r_cell(fav, &tag, &dat)) + || (u3_blip != i_pax ) + || (c3__term != it_pax) ) + { + ret_o = c3n; + } + else { + u3_noun pud = tt_pax; + u3_noun p_pud, q_pud; + c3_l tid_l; + + if ( (c3n == u3r_cell(pud, &p_pud, &q_pud)) + || (u3_nul != q_pud) + || (c3n == _reck_orchid(c3__ud, u3k(p_pud), &tid_l)) ) + { + u3l_log("term: bad tire\n"); + ret_o = c3n; + } + else { + switch ( tag ) { + default: { + ret_o = c3n; + } break; + + // XX review, accepted and ignored + // + case c3__bbye: { + ret_o = c3y; + } break; + + case c3__blit: { + ret_o = c3y; + + { + u3_utty* uty_u = _term_ef_get(tid_l); + if ( 0 == uty_u ) { + // u3l_log("no terminal %d\n", tid_l); + // u3l_log("uty_u %p\n", u3_Host.uty_u); + } + else { + u3_noun bis = dat; + + while ( c3y == u3du(bis) ) { + _term_ef_blit(uty_u, u3k(u3h(bis))); + bis = u3t(bis); + } + } + } + } break; + + // XX obsolete %ames + // + // case c3__send: + + case c3__logo: { + ret_o = c3y; + u3_pier_exit(car_u->pir_u); + // XX validate? ignore? + // + u3_Host.xit_i = dat; + } break; + + // XX obsolete, remove in %zuse and %dill + case c3__init: { + // daemon ignores %init + // u3A->own = u3nc(u3k(p_fav), u3A->own); + // u3l_log("kick: init: %d\n", p_fav); + ret_o = c3y; + } break; + + case c3__mass: { + ret_o = c3y; + + // gc the daemon area + // + // XX disabled due to known leaks; uncomment for dev + // + // uv_timer_start(&u3K.tim_u, (uv_timer_cb)u3_daemon_grab, 0, 0); + } break; + + // ignore pack (processed in worker) + // + case c3__pack: { + ret_o = c3y; + } break; + } + } + } + + u3z(pax); u3z(fav); + return ret_o; +} + +/* _term_io_exit(): clean up terminal. +*/ +static void +_term_io_exit(u3_auto* car_u) +{ + if ( c3n == u3_Host.ops_u.tem ) { + u3_utty* uty_u = _term_main(); + uv_read_stop((uv_stream_t*)&(uty_u->pop_u)); + } +} + +static void +_term_ev_noop(u3_auto* car_u, void* vod_p) +{ +} + +/* u3_term_io_init(): initialize terminal +*/ +u3_auto* +u3_term_io_init(u3_pier* pir_u) +{ + u3_auto* car_u = c3_calloc(sizeof(*car_u)); + + if ( u3_Host.uty_u ) { + u3_Host.uty_u->car_u = car_u; + } + + car_u->nam_m = c3__term; + car_u->liv_o = c3n; + car_u->io.talk_f = _term_io_talk; + car_u->io.fete_f = _term_io_fete; + car_u->io.exit_f = _term_io_exit; + + car_u->ev.drop_f = _term_ev_noop; + car_u->ev.work_f = _term_ev_noop; + car_u->ev.done_f = _term_ev_noop; + car_u->ev.swap_f = _term_ev_noop; + car_u->ev.bail_f = _term_ev_noop; + + return car_u; +} From 5e6a989509bbb5026ae2a1c3f6f8f194c539c8bc Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 24 Apr 2020 10:52:33 -0700 Subject: [PATCH 022/257] vere: prevents term.c from retrying tcsetattr() indefinitely --- pkg/urbit/vere/term.c | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 74f38d10a..aae0cbd46 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -19,7 +19,7 @@ static u3_utty* _term_main(); static void _term_read_cb(uv_stream_t* tcp_u, ssize_t siz_i, const uv_buf_t* buf_u); -static c3_i _term_tcsetattr(int, int, const struct termios *); +static c3_i _term_tcsetattr(c3_i, c3_i, const struct termios*); /* _write(): wraps write(), asserting length */ @@ -303,13 +303,21 @@ u3_term_log_exit(void) /* _term_tcsetattr(): tcsetattr w/retry on EINTR. */ static c3_i -_term_tcsetattr(int fildes, int optional_actions, - const struct termios *termios_p) +_term_tcsetattr(c3_i fil_i, c3_i act_i, const struct termios* tms_u) { c3_i ret_i = 0; + c3_w len_w = 0; + do { - ret_i = tcsetattr(fildes, optional_actions, termios_p); - } while (-1 == ret_i && errno == EINTR); + // abort pathological retry loop + // + if ( 100 == ++len_w ) { + fprintf(stderr, "term: tcsetattr loop\r\n"); + return -1; + } + ret_i = tcsetattr(fil_i, act_i, tms_u); + } while ( (-1 == ret_i) && (EINTR == errno) ); + return ret_i; } From ecc8080619fe641b9b3aaa573c28b042f56ac31b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 20 Apr 2020 00:17:45 -0700 Subject: [PATCH 023/257] vere: removes reck.c, all i/o drivers use u3_auto --- pkg/urbit/include/vere/vere.h | 24 +- pkg/urbit/vere/auto.c | 19 +- pkg/urbit/vere/daemon.c | 4 - pkg/urbit/vere/pier.c | 212 ++------------- pkg/urbit/vere/reck.c | 482 ---------------------------------- pkg/urbit/vere/root.c | 138 ++++++++++ pkg/urbit/vere/term.c | 9 - 7 files changed, 186 insertions(+), 702 deletions(-) delete mode 100644 pkg/urbit/vere/reck.c create mode 100644 pkg/urbit/vere/root.c diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 56227e286..6ef3c67b7 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -791,13 +791,6 @@ u3_dire* u3_foil_folder(const c3_c* pax_c); // directory object, or 0 - /** Output. - **/ - /* u3_reck_kick(): handle effect. - */ - void - u3_reck_kick(u3_pier* pir_u, u3_noun ovo); - /** Terminal, new style. **/ /* u3_term_start_spinner(): prepare spinner state. RETAIN. @@ -924,6 +917,13 @@ u3_auto* u3_cttp_io_init(u3_pier* pir_u); + /** Root, grab bag + **/ + /* u3_root_io_init(): initialize root + */ + u3_auto* + u3_root_io_init(u3_pier* pir_u); + /** Stream messages. **/ /* u3_newt_encode(): encode an atom to a length-prefixed byte buffer @@ -977,11 +977,6 @@ void u3_pier_bail(void); - /* u3_pier_work(): send event; real pier pointer. - */ - void - u3_pier_work(u3_pier* pir_u, u3_noun pax, u3_noun fav); - /* u3_pier_snap(): request checkpoint. */ void @@ -992,11 +987,6 @@ u3_pier* u3_pier_stub(void); - /* u3_pier_plan(): submit event; fake pier - */ - void - u3_pier_plan(u3_noun pax, u3_noun fav); - /* u3_pier_boot(): start the new pier system. */ void diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index d93e9bee0..dc95d9c81 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -166,6 +166,22 @@ u3_auto_next(u3_auto* car_u) return egg_u; } +/* _auto_fete_lost(): RETAIN +*/ +static void +_auto_fete_lost(u3_noun pax, u3_noun fav) +{ + u3_noun tox = u3do("spat", u3k(pax)); + c3_c* tag_c = u3r_string(u3h(fav)); + c3_c* pax_c = u3r_string(tox); + + u3l_log("kick: lost %%%s on %s\n", tag_c, pax_c); + + c3_free(pax_c); + c3_free(tag_c); + u3z(tox); +} + /* u3_auto_fete(): route effects to a linked driver */ void @@ -180,8 +196,7 @@ u3_auto_fete(u3_auto* car_u, u3_noun act) while ( c3n == car_u->io.fete_f(car_u, u3k(pax), u3k(fav)) ) { if ( !car_u->nex_u ) { - // reck_kick_norm - // "kick: lost" + _auto_fete_lost(pax, fav); break; } else { diff --git a/pkg/urbit/vere/daemon.c b/pkg/urbit/vere/daemon.c index 930ed7506..9428dc566 100644 --- a/pkg/urbit/vere/daemon.c +++ b/pkg/urbit/vere/daemon.c @@ -243,10 +243,6 @@ _daemon_susp(u3_atom ship, u3_noun susp) void _daemon_vent(u3_atom ship, u3_noun vent) { - /* stub; have to find pier from ship */ - u3z(ship); - u3_pier_work(u3_pier_stub(), u3h(vent), u3t(vent)); - u3z(vent); } /* _daemon_doom(): doom parser diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 9c7535faf..69541e834 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -382,8 +382,7 @@ _pier_next(u3_pier* pir_u) switch ( pir_u->sat_e ) { default: c3_assert(0); - case u3_peat_work: - case u3_peat_done: { + case u3_peat_work: { _pier_work(pir_u); break; } @@ -393,6 +392,11 @@ _pier_next(u3_pier* pir_u) _pier_play(pir_u); break; } + + case u3_peat_done: { + _pier_work_fete(pir_u); + break; + } case u3_peat_init: { break; @@ -1145,122 +1149,34 @@ u3_pier_exit(u3_pier* pir_u) // neighbor with sponsor // -/* _pier_loop_wake(): initialize listeners and send initial events. -*/ -static void -_pier_loop_wake(u3_auto* car_u) -{ - u3_pier* pir_u = car_u->pir_u; - c3_l cod_l; - - // inject fresh entropy - // - { - c3_w eny_w[16]; - c3_rand(eny_w); - - u3_noun wir = u3nt(u3_blip, c3__arvo, u3_nul); - u3_noun car = u3nc(c3__wack, u3i_words(16, eny_w)); - - u3_pier_work(pir_u, wir, car); - } - - // cod_l = u3a_lush(c3__unix); - // u3_unix_io_talk(pir_u); - // u3_unix_ef_bake(pir_u); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__ames); - // u3_ames_io_talk(pir_u); - // u3_ames_ef_bake(pir_u); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__behn); - // u3_behn_ef_bake(pir_u); - // u3a_lop(cod_l); - - // XX legacy handlers, not yet scoped to a pier - // - { - // cod_l = u3a_lush(c3__http); - // u3_http_io_talk(); - // u3_http_ef_bake(); - // u3_cttp_ef_bake(); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__term); - // u3_term_io_talk(); - // u3_term_ef_bake(); - // u3a_lop(cod_l); - } -} - -/* _pier_loop_exit(): terminate I/O across the process. -*/ -static void -_pier_loop_exit(u3_auto* car_u) -{ - u3_pier* pir_u = car_u->pir_u; - c3_l cod_l; - - // cod_l = u3a_lush(c3__unix); - // u3_unix_io_exit(pir_u); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__ames); - // u3_ames_io_exit(pir_u); - // u3a_lop(cod_l); - - cod_l = u3a_lush(c3__save); - u3_save_io_exit(pir_u); - u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__behn); - // u3_behn_io_exit(pir_u); - // u3a_lop(cod_l); - - // XX legacy handlers, not yet scoped to a pier - // - { - // cod_l = u3a_lush(c3__http); - // u3_http_io_exit(); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__cttp); - // u3_cttp_io_exit(); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__term); - // u3_term_io_exit(); - // u3a_lop(cod_l); - } -} - -static c3_o -_pier_loop_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) -{ - u3_reck_kick(car_u->pir_u, u3nc(pax, fav)); - return c3y; -} - -static void -_pier_auto_noop(u3_auto* car_u, void* vod_p) -{ -} - /* _pier_loop_init_pier(): initialize loop handlers. */ static u3_auto* _pier_loop_init(u3_pier* pir_u) { - // encapsulate all i/o drivers in one u3_auto (temporary) + + _pier_loop_time(pir_u); + + // for i/o drivers that still use u3A->sen // - // XX move to u3_auto_init(pir_u->car_u); + u3v_numb(); + + // XX move to u3_auto_init(pir_u->car_u); // u3_auto* car_u; u3_auto** las_u = &car_u; + // XX this should be the first to work, but last to route effects and eit + // + { + u3_auto* rac_u = u3_root_io_init(pir_u); + rac_u->pir_u = pir_u; + + *las_u = rac_u; + las_u = &rac_u->nex_u; + } + { u3_auto* rac_u = u3_term_io_init(pir_u); rac_u->pir_u = pir_u; @@ -1309,87 +1225,9 @@ _pier_loop_init(u3_pier* pir_u) las_u = &rac_u->nex_u; } - { - u3_auto* rac_u = c3_calloc(sizeof(*rac_u)); - rac_u->nam_m = u3_blip; - rac_u->liv_o = c3y; - rac_u->pir_u = pir_u; - rac_u->io.talk_f = _pier_loop_wake; - rac_u->io.fete_f = _pier_loop_fete; - rac_u->io.exit_f = _pier_loop_exit; - rac_u->ev.drop_f = _pier_auto_noop; - rac_u->ev.work_f = _pier_auto_noop; - rac_u->ev.done_f = _pier_auto_noop; - rac_u->ev.swap_f = _pier_auto_noop; - rac_u->ev.bail_f = _pier_auto_noop; - - *las_u = rac_u; - las_u = &rac_u->nex_u; - } - - c3_l cod_l; - - _pier_loop_time(pir_u); - - // for i/o drivers that still use u3A->sen - // - u3v_numb(); - - // cod_l = u3a_lush(c3__ames); - // u3_ames_io_init(pir_u); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__behn); - // u3_behn_io_init(pir_u); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__unix); - // u3_unix_io_init(pir_u); - // u3a_lop(cod_l); - - cod_l = u3a_lush(c3__save); - u3_save_io_init(pir_u); - u3a_lop(cod_l); - - // XX legacy handlers, not yet scoped to a pier - // - { - // cod_l = u3a_lush(c3__term); - // u3_term_io_init(); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__http); - // u3_http_io_init(); - // u3a_lop(cod_l); - - // cod_l = u3a_lush(c3__cttp); - // u3_cttp_io_init(); - // u3a_lop(cod_l); - } - return car_u; } -/* u3_pier_work(): send event; real pier pointer. -** -** XX: u3_pier_work() is for legacy events sent to a real pier. -*/ -void -u3_pier_work(u3_pier* pir_u, u3_noun pax, u3_noun fav) -{ - u3_auto_plan(pir_u->car_u, 0, 0, u3_blip, pax, fav); -} - -/* u3_pier_plan(): send event; fake pier pointer -** -** XX: u3_pier_plan() is maximum legacy, do not use. -*/ -void -u3_pier_plan(u3_noun pax, u3_noun fav) -{ - u3_pier_work(u3_pier_stub(), pax, fav); -} - /* c3_rand(): fill a 512-bit (16-word) buffer. */ void @@ -1414,9 +1252,7 @@ _pier_exit_done(u3_pier* pir_u) u3_lord_exit(pir_u->god_u, 0); } - // XX - // - _pier_loop_exit(pir_u->car_u); + u3_auto_exit(pir_u->car_u); u3_term_log_exit(); diff --git a/pkg/urbit/vere/reck.c b/pkg/urbit/vere/reck.c deleted file mode 100644 index 7936beb8a..000000000 --- a/pkg/urbit/vere/reck.c +++ /dev/null @@ -1,482 +0,0 @@ -/* vere/reck.c -** -*/ -#include -#include -#include -#include -#include -#include -#include -#include - -#include "all.h" -#include "vere/vere.h" - -// /* _reck_mole(): parse simple atomic mole. -// */ -// static u3_noun -// _reck_mole(u3_noun fot, -// u3_noun san, -// c3_d* ato_d) -// { -// u3_noun uco = u3dc("slaw", fot, san); -// u3_noun p_uco, q_uco; - -// if ( (c3n == u3r_cell(uco, &p_uco, &q_uco)) || -// (u3_nul != p_uco) ) -// { -// u3l_log("strange mole %s\n", u3r_string(san)); - -// u3z(fot); u3z(uco); return c3n; -// } -// else { -// *ato_d = u3r_chub(0, q_uco); - -// u3z(fot); u3z(uco); return c3y; -// } -// } - -// /* _reck_lily(): parse little atom. -// */ -// static u3_noun -// _reck_lily(u3_noun fot, u3_noun txt, c3_l* tid_l) -// { -// c3_d ato_d; - -// if ( c3n == _reck_mole(fot, txt, &ato_d) ) { -// return c3n; -// } else { -// if ( ato_d >= 0x80000000ULL ) { -// return c3n; -// } else { -// *tid_l = (c3_l) ato_d; - -// return c3y; -// } -// } -// } - -// /* _reck_orchid(): parses only a number as text -// * -// * Parses a text string which contains a decimal number. In practice, this -// * number is always '1'. -// */ -// static u3_noun -// _reck_orchid(u3_noun fot, u3_noun txt, c3_l* tid_l) -// { -// c3_c* str = u3r_string(txt); -// c3_d ato_d = strtol(str, NULL, 10); -// c3_free(str); - -// if ( ato_d >= 0x80000000ULL ) { -// return c3n; -// } else { -// *tid_l = (c3_l) ato_d; - -// return c3y; -// } -// } - -// /* _reck_kick_term(): apply terminal outputs. -// */ -// static u3_noun -// _reck_kick_term(u3_pier* pir_u, u3_noun pox, c3_l tid_l, u3_noun fav) -// { -// u3_noun p_fav; - -// if ( c3n == u3du(fav) ) { -// u3z(pox); u3z(fav); return c3n; -// } -// else switch ( u3h(fav) ) { -// default: u3z(pox); u3z(fav); return c3n; -// case c3__bbye: -// { -// u3z(pox); u3z(fav); return c3y; -// } break; - -// case c3__blit: p_fav = u3t(fav); -// { -// u3_term_ef_blit(tid_l, u3k(p_fav)); - -// u3z(pox); u3z(fav); return c3y; -// } break; - -// // // this can return through dill due to our fscked up boot sequence -// // // -// // case c3__send: { -// // u3_noun lan = u3k(u3h(u3t(fav))); -// // u3_noun pac = u3k(u3t(u3t(fav))); - -// // u3l_log("kick: strange send\r\n"); -// // u3_ames_ef_send(pir_u, lan, pac); -// // u3z(pox); u3z(fav); return c3y; -// // } break; - -// case c3__logo: -// { -// u3_pier_exit(pir_u); -// u3_Host.xit_i = u3t(fav); - -// u3z(pox); u3z(fav); return c3y; -// } break; - -// case c3__init: p_fav = u3t(fav); -// { -// // daemon ignores %init -// // u3A->own = u3nc(u3k(p_fav), u3A->own); -// // u3l_log("kick: init: %d\n", p_fav); -// u3z(pox); u3z(fav); return c3y; -// } break; - -// case c3__mass: -// { -// u3z(pox); u3z(fav); - -// // gc the daemon area -// // -// // XX disabled due to known leaks; uncomment for dev -// // -// // uv_timer_start(&u3K.tim_u, (uv_timer_cb)u3_daemon_grab, 0, 0); -// return c3y; -// } break; - -// // ignore pack (processed in worker) -// // -// case c3__pack: -// { -// u3z(pox); u3z(fav); -// return c3y; -// } break; -// } -// c3_assert(!"not reached"); return 0; -// } - -/* _reck_kick_arvo(): apply loopback effects. -*/ -static u3_noun -_reck_kick_arvo(u3_pier* pir_u, u3_noun pox, u3_noun fav) -{ - if ( c3__trim == u3h(fav) ) { - u3_pier_work(pir_u, pox, fav); - return c3y; - } - - u3z(pox); u3z(fav); return c3n; -} - -// /* _reck_kick_behn(): apply packet network outputs. -// */ -// static u3_noun -// _reck_kick_behn(u3_pier* pir_u, u3_noun pox, u3_noun fav) -// { -// switch ( u3h(fav) ) { -// default: break; - -// case c3__doze: { -// u3_behn_ef_doze(pir_u, u3k(u3t(fav))); -// u3z(pox); u3z(fav); return c3y; -// } break; -// } -// u3z(pox); u3z(fav); return c3n; -// } - -// /* _reck_kick_sync(): apply sync outputs. -// */ -// static u3_noun -// _reck_kick_sync(u3_pier* pir_u, u3_noun pox, u3_noun fav) -// { -// switch ( u3h(fav) ) { -// default: break; -// case c3__dirk: { -// u3_unix_ef_dirk(pir_u, u3k(u3t(fav))); -// u3z(pox); u3z(fav); return c3y; -// } -// case c3__ergo: { -// u3_noun mon = u3k(u3h(u3t(fav))); -// u3_noun can = u3k(u3t(u3t(fav))); - -// u3_unix_ef_ergo(pir_u, mon, can); -// u3z(pox); u3z(fav); return c3y; -// } break; -// case c3__ogre: { -// u3_unix_ef_ogre(pir_u, u3k(u3t(fav))); -// u3z(pox); u3z(fav); return c3y; -// } -// case c3__hill: { -// u3_unix_ef_hill(pir_u, u3k(u3t(fav))); -// u3z(pox); u3z(fav); return c3y; -// } -// } - -// // XX obviously not right! -// // ? looks fine to me -// u3z(pox); u3z(fav); return c3n; -// } - -// /* _reck_kick_newt(): apply packet network outputs. -// */ -// static u3_noun -// _reck_kick_newt(u3_pier* pir_u, u3_noun pox, u3_noun fav) -// { -// switch ( u3h(fav) ) { -// default: break; - -// case c3__send: { -// u3_noun lan = u3k(u3h(u3t(fav))); -// u3_noun pac = u3k(u3t(u3t(fav))); - -// u3_ames_ef_send(pir_u, lan, pac); -// u3z(pox); u3z(fav); return c3y; -// } break; - -// case c3__turf: { -// u3_ames_ef_turf(pir_u, u3k(u3t(fav))); -// u3z(pox); u3z(fav); return c3y; -// } break; - -// } -// u3z(pox); u3z(fav); return c3n; -// } - -// /* _reck_kick_ames(): apply packet network outputs. -// */ -// static u3_noun -// _reck_kick_ames(u3_pier* pir_u, u3_noun pox, u3_noun fav) -// { -// u3_noun p_fav; - -// switch ( u3h(fav) ) { -// default: break; -// case c3__init: p_fav = u3t(fav); -// { -// // daemon ignores %init -// // u3A->own = u3nc(u3k(p_fav), u3A->own); -// // u3l_log("kick: init: %d\n", p_fav); -// u3z(pox); u3z(fav); return c3y; -// } break; - -// case c3__west: { -// u3_noun who, cha, dat; -// u3x_trel(u3t(fav), &who, &cha, &dat); - -// // XX route by cha path? -// // s/b //give/prox -// // -// switch ( u3h(dat) ) { -// default: break; - -// case c3__that: { -// u3_http_ef_that(u3k(who), u3k(u3t(dat))); -// u3z(pox); u3z(fav); return c3y; -// } -// } -// } - -// case c3__woot: { -// // XX print tang if nack? -// // -// u3z(pox); u3z(fav); return c3y; -// } -// } - -// u3z(pox); u3z(fav); return c3n; -// } - -/* _reck_kick_spec(): apply an effect, by path. -*/ -static u3_noun -_reck_kick_spec(u3_pier* pir_u, u3_noun pox, u3_noun fav) -{ - u3_noun i_pox, t_pox; - - if ( (c3n == u3r_cell(pox, &i_pox, &t_pox)) || - ((i_pox != u3_blip) && - (i_pox != c3__gold) && - (i_pox != c3__iron) && - (i_pox != c3__lead)) ) - { - u3z(pox); u3z(fav); return c3n; - } else { - u3_noun it_pox, tt_pox; - - if ( (c3n == u3r_cell(t_pox, &it_pox, &tt_pox)) ) { - u3z(pox); u3z(fav); return c3n; - } - // else if ( c3y == u3r_sing_c("http-server", it_pox) ) { - // u3_noun pud = tt_pox; - // u3_noun p_pud, t_pud, tt_pud, q_pud, r_pud, s_pud; - // c3_l sev_l, coq_l, seq_l; - - // if ( (c3n == u3r_cell(pud, &p_pud, &t_pud)) || - // (c3n == _reck_lily(c3__uv, u3k(p_pud), &sev_l)) ) - // { - // u3z(pox); u3z(fav); return c3n; - // } - - // if ( u3_nul == t_pud ) { - // coq_l = seq_l = 0; - // } - // else { - // if ( (c3n == u3r_cell(t_pud, &q_pud, &tt_pud)) || - // (c3n == _reck_lily(c3__ud, u3k(q_pud), &coq_l)) ) - // { - // u3z(pox); u3z(fav); return c3n; - // } - - // if ( u3_nul == tt_pud ) { - // seq_l = 0; - // } else { - // if ( (c3n == u3r_cell(tt_pud, &r_pud, &s_pud)) || - // (u3_nul != s_pud) || - // (c3n == _reck_lily(c3__ud, u3k(r_pud), &seq_l)) ) - // { - // u3z(pox); u3z(fav); return c3n; - // } - // } - // } - // u3_http_ef_http_server(sev_l, coq_l, seq_l, u3k(fav)); - - // u3z(pox); u3z(fav); - // return c3y; - // } - // else if ( c3y == u3r_sing_c("http-client", it_pox) ) { - // u3_cttp_ef_http_client(u3k(fav)); - - // u3z(pox); u3z(fav); - // return c3y; - // } - else switch ( it_pox ) { - default: u3z(pox); u3z(fav); return c3n; - - case c3__arvo: { - return _reck_kick_arvo(pir_u, pox, fav); - } break; - - // case c3__behn: { - // return _reck_kick_behn(pir_u, pox, fav); - // } break; - - // case c3__clay: - // case c3__boat: - // case c3__sync: { - // return _reck_kick_sync(pir_u, pox, fav); - // } break; - - // case c3__newt: { - // return _reck_kick_newt(pir_u, pox, fav); - // } break; - - // case c3__ames: { - // if ( (u3_nul != tt_pox) ) { - // u3z(pox); u3z(fav); return c3n; - // } - // else { - // return _reck_kick_ames(pir_u, pox, fav); - // } - // } break; - - case c3__init: { - // daemon ignores %init - // p_fav = u3t(fav); - // u3A->own = u3nc(u3k(p_fav), u3A->own); - // u3l_log("kick: init: %d\n", p_fav); - u3z(pox); u3z(fav); return c3y; - } break; - - // case c3__term: { - // u3_noun pud = tt_pox; - // u3_noun p_pud, q_pud; - // c3_l tid_l; - - // if ( (c3n == u3r_cell(pud, &p_pud, &q_pud)) || - // (u3_nul != q_pud) || - // (c3n == _reck_orchid(c3__ud, u3k(p_pud), &tid_l)) ) - // { - // u3l_log("term: bad tire\n"); - // u3z(pox); u3z(fav); return c3n; - // } else { - // return _reck_kick_term(pir_u, pox, tid_l, fav); - // } - // } break; - } - } - c3_assert(!"not reached"); - return c3n; -} - -/* _reck_kick_norm(): non path-specific effect handling. -*/ -static u3_noun -_reck_kick_norm(u3_pier* pir_u, u3_noun pox, u3_noun fav) -{ - if ( c3n == u3du(fav) ) { - u3z(pox); u3z(fav); return c3n; - } - else switch ( u3h(fav) ) { - default: u3z(pox); u3z(fav); return c3n; - - case c3__vega: - { - u3l_log("<<>>\n"); - u3z(pox); u3z(fav); - - // reclaim memory from persistent caches - // - u3m_reclaim(); - - return c3y; - } - case c3__exit: - { - u3l_log("<<>>\n"); - u3_pier_exit(pir_u); - - u3z(pox); u3z(fav); return c3y; - } break; - } - c3_assert(!"not reached"); return c3n; - u3z(pox); u3z(fav); return c3n; -} - -/* u3_reck_kick(): handle effect. -*/ -void -u3_reck_kick(u3_pier* pir_u, u3_noun ovo) -{ - if ( (c3n == _reck_kick_spec(pir_u, u3k(u3h(ovo)), u3k(u3t(ovo)))) && - (c3n == _reck_kick_norm(pir_u, u3k(u3h(ovo)), u3k(u3t(ovo)))) ) - { -#if 0 - if ( (c3__warn != u3h(u3t(ovo))) && - (c3__text != u3h(u3t(ovo))) && - (c3__note != u3h(u3t(ovo))) ) -#endif -#if 1 - if ( (c3__crud == u3h(u3t(ovo))) ) -#if 0 - (c3__talk == u3h(u3t(ovo))) || - (c3__helo == u3h(u3t(ovo))) || - (c3__init == u3h(u3t(ovo))) ) -#endif - { - u3_pier_work(pir_u, - u3nt(u3_blip, c3__term, u3_nul), - u3nc(c3__flog, u3k(u3t(ovo)))); - } - else { - u3_noun tox = u3do("spat", u3k(u3h(ovo))); - u3l_log("kick: lost %%%s on %s\n", - u3r_string(u3h(u3t(ovo))), - u3r_string(tox)); - u3z(tox); -#if 0 - if ( c3__hear == u3h(u3t(ovo)) ) { - c3_assert(0); - } -#endif - } -#endif - } - u3z(ovo); -} diff --git a/pkg/urbit/vere/root.c b/pkg/urbit/vere/root.c new file mode 100644 index 000000000..0c07a3104 --- /dev/null +++ b/pkg/urbit/vere/root.c @@ -0,0 +1,138 @@ +/* vere/root.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* _root_io_talk(): +*/ +static void +_root_io_talk(u3_auto* car_u) +{ + u3_noun pax, fav; + + // inject fresh entropy + // + { + c3_w eny_w[16]; + c3_rand(eny_w); + + pax = u3nt(u3_blip, c3__arvo, u3_nul); + fav = u3nc(c3__wack, u3i_words(16, eny_w)); + + u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + } + + // set verbose as per -v + // + // XX should be explicit, not a toggle + // + if ( c3y == u3_Host.ops_u.veb ) { + // XX this path shouldn't be necessary + // + pax = u3nq(u3_blip, c3__term, '1', u3_nul); + fav = u3nc(c3__verb, u3_nul); + + u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + } +} + +/* _root_io_fete(): +*/ +static c3_o +_root_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +{ + u3_noun i_pax, tag, dat; + c3_o ret_o; + + if ( (c3n == u3r_cell(pax, &i_pax, 0)) + || (c3n == u3r_cell(fav, &tag, &dat)) + || (u3_blip != i_pax ) ) + { + ret_o = c3n; + } + else { + switch ( tag ) { + default: { + ret_o = c3n; + } break; + + case c3__exit: { + ret_o = c3y; + u3l_log("<<>>\n"); + u3_pier_exit(car_u->pir_u); + } break; + + // XX fake effect, check //arvo wire? + // + case c3__trim: { + ret_o = c3y; + u3_auto_plan(car_u, 0, 0, u3_blip, u3k(pax), u3k(fav)); + } + + case c3__vega: { + ret_o = c3y; + u3l_log("<<>>\n"); + } break; + } + } + + u3z(pax); u3z(fav); + return ret_o; +} + +/* _root_io_exit(): +*/ +static void +_root_io_exit(u3_auto* car_u) +{ + // XX moveme + // + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_exit(car_u->pir_u); + u3a_lop(cod_l); +} + +static void +_root_ev_noop(u3_auto* car_u, void* vod_p) +{ +} + +/* u3_root_io_init(): +*/ +u3_auto* +u3_root_io_init(u3_pier* pir_u) +{ + u3_auto* car_u = c3_calloc(sizeof(*car_u)); + car_u->nam_m = c3__root; + car_u->liv_o = c3n; + car_u->io.talk_f = _root_io_talk; + car_u->io.fete_f = _root_io_fete; + car_u->io.exit_f = _root_io_exit; + + car_u->ev.drop_f = _root_ev_noop; + car_u->ev.work_f = _root_ev_noop; + car_u->ev.done_f = _root_ev_noop; + car_u->ev.swap_f = _root_ev_noop; + car_u->ev.bail_f = _root_ev_noop; + + // XX moveme + // + { + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_init(pir_u); + u3a_lop(cod_l); + } + + return car_u; +} diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index aae0cbd46..e26fb7bf4 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -1246,15 +1246,6 @@ _term_io_talk(u3_auto* car_u) u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); u3_noun fav; - // set verbose as per -v - // - // XX should be explicit, not a toggle - // - if ( c3y == u3_Host.ops_u.veb ) { - fav = u3nc(c3__verb, u3_nul); - u3_auto_plan(car_u, 0, 0, u3_blip, u3k(pax), fav); - } - // send terminal dimensions // { From 1f6342fc2501ac684eceb49ab24e304e94e60d79 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 20 Apr 2020 15:50:25 -0700 Subject: [PATCH 024/257] vere: disposes of ovum when done and on exit --- pkg/urbit/include/vere/vere.h | 5 +++++ pkg/urbit/vere/auto.c | 11 +++++++++-- pkg/urbit/vere/pier.c | 7 +++++-- 3 files changed, 19 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 6ef3c67b7..bfca41cf0 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -578,6 +578,11 @@ u3_noun pax, u3_noun fav); + /* u3_auto_drop(): dequeue and dispose an ovum. + */ + void + u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u); + /* u3_auto_exit(): close all drivers */ void diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index dc95d9c81..7237ed382 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -45,9 +45,17 @@ u3_auto_talk(u3_auto* car_u) void u3_auto_exit(u3_auto* car_u) { + u3_auto* nex_u; + while ( car_u ) { + nex_u = car_u->nex_u; + + while ( car_u->ext_u ) { + u3_auto_drop(car_u, car_u->ext_u); + } car_u->io.exit_f(car_u); - car_u = car_u->nex_u; + + car_u = nex_u; } } @@ -104,7 +112,6 @@ u3_auto_plan(u3_auto* car_u, return egg_u; } - /* u3_auto_drop(): dequeue and dispose an ovum. */ void diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 69541e834..0837834d3 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -142,8 +142,11 @@ _pier_work_fete(u3_pier* pir_u) fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", wok_u->eve_d); #endif u3_auto_fete(pir_u->car_u, wok_u->act); - // XX dispose wok_u->egg_u - // + + if ( wok_u->egg_u ) { + u3_auto_drop(wok_u->egg_u->car_u, wok_u->egg_u); + } + c3_free(wok_u); } } From c619884efde7b86a154ee44bb733ee0408944f9f Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 20 Apr 2020 15:50:54 -0700 Subject: [PATCH 025/257] vere: plugs leaks in cttp --- pkg/urbit/vere/cttp.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/pkg/urbit/vere/cttp.c b/pkg/urbit/vere/cttp.c index ffdc59e50..92125b983 100644 --- a/pkg/urbit/vere/cttp.c +++ b/pkg/urbit/vere/cttp.c @@ -579,6 +579,7 @@ _cttp_creq_free(u3_creq* ceq_u) } c3_free(ceq_u->hot_c); + c3_free(ceq_u->ipf_c); c3_free(ceq_u->por_c); c3_free(ceq_u->met_c); c3_free(ceq_u->url_c); @@ -675,6 +676,7 @@ static void _cttp_creq_fire_str(u3_creq* ceq_u, c3_c* str_c) { _cttp_creq_fire_body(ceq_u, _cttp_bod_new(strlen(str_c), str_c)); + c3_free(str_c); } /* _cttp_creq_fire_heds(): attach output headers. From 16f606419c4b2fa502328f117d85e937b038c12e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 20 Apr 2020 20:30:35 -0700 Subject: [PATCH 026/257] vere: refactored event batching to serf, fixing snapshots --- pkg/urbit/include/vere/vere.h | 4 +-- pkg/urbit/vere/auto.c | 6 ++++- pkg/urbit/vere/lord.c | 30 +++------------------ pkg/urbit/vere/pier.c | 49 +++++++++++++++++++++-------------- 4 files changed, 40 insertions(+), 49 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index bfca41cf0..a9df2cd04 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -426,7 +426,6 @@ c3_d eve_d; // last event completed c3_l mug_l; // mug at eve_d c3_w dep_w; // queue depth - c3_o hol_o; // on hold struct _u3_rrit* ent_u; // queue entry struct _u3_rrit* ext_u; // queue exit } u3_lord; @@ -554,7 +553,8 @@ } u3_daemon; u3_ovum* - u3_auto_next(u3_auto* car_u); + u3_auto_next(u3_auto* car_u, u3_noun* ovo); + void u3_auto_fete(u3_auto* car_u, u3_noun act); diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 7237ed382..bb090f208 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -140,7 +140,7 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) /* u3_auto_next(): select an ovum and dequeue. */ u3_ovum* -u3_auto_next(u3_auto* car_u) +u3_auto_next(u3_auto* car_u, u3_noun* ovo) { u3_ovum* egg_u = 0; @@ -164,6 +164,10 @@ u3_auto_next(u3_auto* car_u) // egg_u->car_u->ev.work_f(egg_u->car_u, egg_u->vod_p); + // XX cons [tar] route onto wire + // + *ovo = u3nc(u3k(egg_u->pax), u3k(egg_u->fav)); + return egg_u; } diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index d3c7bfaab..92987bb6b 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -55,9 +55,6 @@ #undef VERBOSE_LORD -static void -_lord_writ_spin(u3_lord* god_u); - /* _lord_writ_pop(): pop the writ stack */ static u3_rrit* @@ -182,16 +179,12 @@ _lord_plea_live(u3_lord* god_u, u3_noun dat) case c3__save: { god_u->cb_u.save_f(god_u->cb_u.vod_p, wit_u->eve_d); - god_u->hol_o = c3n; - _lord_writ_spin(god_u); break; } c3_assert(!"unreachable"); case c3__snap: { god_u->cb_u.snap_f(god_u->cb_u.vod_p, wit_u->eve_d); - god_u->hol_o = c3n; - _lord_writ_spin(god_u); break; } c3_assert(!"unreachable"); @@ -313,7 +306,7 @@ _lord_plea_play(u3_lord* god_u, u3_noun dat) c3_d eve_d; c3_l mug_l; - if ( (c3n == u3r_trel(u3t(dat), &eve, &mug, &dud)) + if ( (c3n == u3r_trel(u3t(dat), &eve, &mug, &dud)) || (c3n == u3r_safe_chub(eve, &eve_d)) || (c3n == u3r_safe_word(mug, &mug_l)) || (c3n == u3a_is_cell(dud)) ) @@ -513,7 +506,6 @@ u3_lord* u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) { u3_lord* god_u = c3_calloc(sizeof *god_u); - god_u->hol_o = c3n; god_u->liv_o = c3n; god_u->wag_w = wag_w; god_u->bin_c = u3_Host.wrk_c; // XX strcopy @@ -690,6 +682,7 @@ _lord_writ_send(u3_lord* god_u, u3_rrit* wit_u) _lord_writ_jam(god_u, wit_u); u3_newt_write(&god_u->inn_u, wit_u->mat, 0); wit_u->sen_o = c3y; + wit_u->mat = 0; // ignore subprocess error on shutdown // @@ -700,19 +693,6 @@ _lord_writ_send(u3_lord* god_u, u3_rrit* wit_u) } } -/* _lord_writ_spin(); -*/ -static void -_lord_writ_spin(u3_lord* god_u) -{ - u3_rrit* wit_u = god_u->ext_u; - - while ( wit_u ) { - _lord_writ_send(god_u, wit_u); - wit_u = wit_u->nex_u; - } -} - /* _lord_writ_plan(); */ static void @@ -730,9 +710,7 @@ _lord_writ_plan(u3_lord* god_u, u3_rrit* wit_u) god_u->ent_u = wit_u; } - if ( c3n == god_u->hol_o ) { - _lord_writ_send(god_u, wit_u); - } + _lord_writ_send(god_u, wit_u); } /* u3_lord_exit(); @@ -757,7 +735,6 @@ u3_lord_save(u3_lord* god_u, c3_d eve_d) wit_u->eve_d = eve_d; _lord_writ_plan(god_u, wit_u); - god_u->hol_o = c3y; } /* u3_lord_snap(); @@ -770,7 +747,6 @@ u3_lord_snap(u3_lord* god_u, c3_d eve_d) wit_u->eve_d = eve_d; _lord_writ_plan(god_u, wit_u); - god_u->hol_o = c3y; } /* u3_lord_peek(); diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 0837834d3..722b6e638 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -37,8 +37,6 @@ _pier_work_init(u3_pier* pir_u) u3_auto_talk(pir_u->car_u); } -#define SUB_FLOOR(a, b) ( (a <= b) ? 0 : a - b ) - /* _pier_work_send(): send new events for processing */ static void @@ -46,26 +44,38 @@ _pier_work_send(u3_pier* pir_u) { u3_lord* god_u = pir_u->god_u; u3_auto* car_u = pir_u->car_u; - u3_wall* wal_u = pir_u->wal_u; - c3_w len_w = ( wal_u ) - ? SUB_FLOOR(wal_u->eve_d, god_u->eve_d) - : SUB_FLOOR(PIER_WORK_BATCH, god_u->dep_w); - c3_w i_w = 0; - u3_ovum* egg_u; + c3_w len_w = 0; - while ( (i_w < len_w) - && car_u - && (egg_u = u3_auto_next(car_u)) ) + // calculate work batch size { - // XX cons [tar] route onto wire - // - u3_noun ovo = u3nc(u3k(egg_u->pax), u3k(egg_u->fav)); - u3_lord_work(pir_u->god_u, egg_u, ovo); + u3_wall* wal_u = pir_u->wal_u; - // queue events depth first - // - car_u = egg_u->car_u; - i_w++; + if ( !wal_u ) { + if ( PIER_WORK_BATCH > god_u->dep_w ) { + len_w = PIER_WORK_BATCH - god_u->dep_w; + } + } + else { + c3_d sen_d = god_u->eve_d + god_u->dep_w; + if ( wal_u->eve_d > sen_d ) { + len_w = wal_u->eve_d - sen_d; + } + } + } + + // send batch + // + { + u3_ovum* egg_u; + u3_noun ovo; + + while ( len_w-- && car_u && (egg_u = u3_auto_next(car_u, &ovo)) ) { + u3_lord_work(god_u, egg_u, ovo); + + // queue events depth first + // + car_u = egg_u->car_u; + } } } @@ -368,6 +378,7 @@ _pier_wall(u3_pier* pir_u) // XX check god_u->dep_w // while ( (wal_u = pir_u->wal_u) + && !god_u->dep_w && (wal_u->eve_d <= god_u->eve_d) ) { pir_u->wal_u = wal_u->nex_u; From 24b6190a3de2d53896f04bf6eb52b02774c0ab18 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 22 Apr 2020 19:22:21 -0700 Subject: [PATCH 027/257] c3: use c3_assert in c3_stub --- pkg/urbit/include/c/defs.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/urbit/include/c/defs.h b/pkg/urbit/include/c/defs.h index 636ee861b..8eee3998c 100644 --- a/pkg/urbit/include/c/defs.h +++ b/pkg/urbit/include/c/defs.h @@ -41,7 +41,7 @@ /* Stub. */ -# define c3_stub (assert(!"stub"), 0) +# define c3_stub c3_assert(!"stub") /* Size in words. */ From ef83c0160e297f9105c01971105643a6c49ccab8 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 21 Apr 2020 23:55:17 -0700 Subject: [PATCH 028/257] vere: refactors lmdb.c, separating it from u3 and uv --- pkg/urbit/Makefile | 2 +- pkg/urbit/daemon/main.c | 1 + pkg/urbit/include/vere/db/lmdb.h | 56 +++ pkg/urbit/include/vere/vere.h | 77 +--- pkg/urbit/vere/db/lmdb.c | 464 +++++++++++++++++++++ pkg/urbit/vere/disk.c | 232 +++++++++-- pkg/urbit/vere/lmdb.c | 673 ------------------------------- 7 files changed, 725 insertions(+), 780 deletions(-) create mode 100644 pkg/urbit/include/vere/db/lmdb.h create mode 100644 pkg/urbit/vere/db/lmdb.c delete mode 100644 pkg/urbit/vere/lmdb.c diff --git a/pkg/urbit/Makefile b/pkg/urbit/Makefile index 850f56e8f..972310caa 100644 --- a/pkg/urbit/Makefile +++ b/pkg/urbit/Makefile @@ -2,7 +2,7 @@ include config.mk jets = jets/tree.c $(wildcard jets/*/*.c) noun = $(wildcard noun/*.c) -vere = $(wildcard vere/*.c) +vere = $(wildcard vere/*.c) $(wildcard vere/*/*.c) daemon = $(wildcard daemon/*.c) worker = $(wildcard worker/*.c) tests = $(wildcard tests/*.c) diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 32290dfd0..62a6d96a6 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -20,6 +20,7 @@ #include #include #include +#include #define U3_GLOBAL #define C3_GLOBAL diff --git a/pkg/urbit/include/vere/db/lmdb.h b/pkg/urbit/include/vere/db/lmdb.h new file mode 100644 index 000000000..11889eebb --- /dev/null +++ b/pkg/urbit/include/vere/db/lmdb.h @@ -0,0 +1,56 @@ +/* include/vere/db/lmdb-impl.h +*/ + +#include + + /* lmdb api wrapper + */ + + /* c3_lmdb_init(): open lmdb at [pax_c], mmap up to [siz_i]. + */ + MDB_env* + c3_lmdb_init(const c3_c* pax_c, size_t siz_i); + + /* c3_lmdb_exit(): close lmdb. + */ + void + c3_lmdb_exit(MDB_env* env_u); + + /* c3_lmdb_gulf(): read first and last event numbers. + */ + c3_o + c3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d); + + /* c3_lmdb_read(): read [len_d] events starting at [eve_d]. + */ + c3_o + c3_lmdb_read(MDB_env* env_u, + void* vod_p, + c3_d eve_d, + c3_d len_d, + c3_o (*read_f)(void*, c3_d, size_t , void*)); + + /* c3_lmdb_save(): save [len_d] events starting at [eve_d]. + */ + c3_o + c3_lmdb_save(MDB_env* env_u, + c3_d eve_d, + c3_d len_d, + void** byt_p, + size_t* siz_i); + + /* c3_lmdb_read_meta(): read by string from the META db. + */ + void + c3_lmdb_read_meta(MDB_env* env_u, + void* vod_p, + const c3_c* key_c, + void (*read_f)(void*, size_t, void*)); + + /* c3_lmdb_save_meta(): save by string into the META db. + */ + c3_o + c3_lmdb_save_meta(MDB_env* env_u, + const c3_c* key_c, + size_t val_i, + void* val_p); diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index a9df2cd04..719efd258 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -4,7 +4,6 @@ */ #include "h2o.h" -#include /** Quasi-tunable parameters. **/ @@ -447,7 +446,7 @@ u3_dire* urb_u; // urbit system data u3_dire* com_u; // log directory c3_o liv_o; // live - MDB_env* db_u; // lmdb environment. + void* mdb_u; // lmdb environment. c3_d sen_d; // commit requested c3_d dun_d; // committed u3_disk_cb cb_u; // callbacks @@ -1054,77 +1053,3 @@ c3_w u3_readdir_r(DIR *dirp, struct dirent *entry, struct dirent **result); - - /* Database - */ - /* u3_lmdb_init(): Initializes lmdb inside log_path - */ - MDB_env* u3_lmdb_init(const char* log_path); - - /* u3_lmdb_shutdown(): Shuts down the entire logging system - */ - void u3_lmdb_shutdown(MDB_env* env); - - /* u3_lmdb_get_latest_event_number(): Gets last event id persisted - */ - c3_o u3_lmdb_get_latest_event_number(MDB_env* environment, - c3_d* event_number); - - /* u3_lmdb_write_request: opaque write request structures - */ - struct u3_lmdb_write_request; - - /* u3_lmdb_build_write_reuqest(): allocates and builds a write request - ** - ** Reads count sequential writs starting with event_u and creates a - ** single write request for all those writs. - */ - struct u3_lmdb_write_request* - u3_lmdb_build_write_request(u3_writ* event_u, c3_d count); - - /* u3_lmdb_free_write_request(): frees a write requst - */ - void u3_lmdb_free_write_request(struct u3_lmdb_write_request* request); - - /* u3_lmdb_write_event(): Persists an event to the database - */ - void u3_lmdb_write_event(MDB_env* environment, - u3_pier* pir_u, - struct u3_lmdb_write_request* request_u, - void (*on_complete)(c3_o success, u3_pier*, - c3_d, c3_d)); - - /* u3_lmdb_read_events(): Reads events back from the database - ** - ** Reads back up to |len_d| events starting with |first_event_d|. For - ** each event, the event will be passed to |on_event_read| and further - ** reading will be aborted if the callback returns c3n. - ** - ** Returns c3y on complete success; c3n on any error. - */ - c3_o - u3_lmdb_read_events(MDB_env* db_u, - c3_d first_event_d, - c3_d len_d, - void* vod_p, - c3_o(*on_event_read)(void*, c3_d, u3_atom)); - - /* u3_lmdb_write_identity(): Writes log identity - ** - ** Returns c3y on complete success; c3n on any error. - */ - c3_o u3_lmdb_write_identity(MDB_env* environment, - u3_noun who, - u3_noun is_fake, - u3_noun life); - - /* u3_lmdb_read_identity(): Reads log identity - ** - ** Returns c3y on complete success; c3n on any error. - */ - c3_o u3_lmdb_read_identity(MDB_env* environment, - u3_noun* who, - u3_noun* is_fake, - u3_noun* life); - - diff --git a/pkg/urbit/vere/db/lmdb.c b/pkg/urbit/vere/db/lmdb.c new file mode 100644 index 000000000..a8305fa31 --- /dev/null +++ b/pkg/urbit/vere/db/lmdb.c @@ -0,0 +1,464 @@ +/* vere/db/lmdb.c +*/ + +#include + +#include "c/portable.h" +#include "c/types.h" +#include "c/defs.h" + +#include + +// lmdb api wrapper +// +// this module implements a simple persistence api on top of lmdb. +// outside of its use of c3 type definitions, this module has no +// dependence on anything u3, or on any library besides lmdb itself. +// +// urbit requires very little from a persist store -- it merely +// needs to store variable-length buffers in: +// +// - a metadata store with c3_c (unsigned char) keys +// - an event store with contiguous c3_d (uint64_t) keys +// +// supported operations are as follows +// +// - open/close an environment +// - read/save metadata +// - read the first and last event numbers +// - read/save ranges of events +// + +/* c3_lmdb_init(): open lmdb at [pax_c], mmap up to [siz_i]. +*/ +MDB_env* +c3_lmdb_init(const c3_c* pax_c, size_t siz_i) +{ + MDB_env* env_u; + c3_w ret_w; + + if ( (ret_w = mdb_env_create(&env_u)) ) { + fprintf(stderr, "lmdb: init fail: %s\n", mdb_strerror(ret_w)); + return 0; + } + + // Our databases have two tables: META and EVENTS + // + if ( (ret_w = mdb_env_set_maxdbs(env_u, 2)) ) { + fprintf(stderr, "lmdb: failed to set number of databases: %s\r\n", + mdb_strerror(ret_w)); + // XX dispose env_u + // + return 0; + } + + if ( (ret_w = mdb_env_set_mapsize(env_u, siz_i)) ) { + fprintf(stderr, "lmdb: failed to set database size: %s\r\n", + mdb_strerror(ret_w)); + // XX dispose env_u + // + return 0; + } + + if ( (ret_w = mdb_env_open(env_u, pax_c, 0, 0664)) ) { + fprintf(stderr, "lmdb: failed to open event log: %s\n", + mdb_strerror(ret_w)); + // XX dispose env_u + // + return 0; + } + + return env_u; +} + +/* c3_lmdb_exit(): close lmdb. +*/ +void +c3_lmdb_exit(MDB_env* env_u) +{ + mdb_env_close(env_u); +} + +/* c3_lmdb_gulf(): read first and last event numbers. +*/ +c3_o +c3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d) +{ + MDB_txn* txn_u; + MDB_dbi mdb_u; + c3_w ret_w; + + // create a read-only transaction. + // + // XX why no MDB_RDONLY? + // + if ( (ret_w = mdb_txn_begin(env_u, 0, 0, &txn_u)) ) { + fprintf(stderr, "lmdb: gulf: txn_begin fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // open the database in the transaction + // + { + c3_w ops_w = MDB_CREATE | MDB_INTEGERKEY; + + if ( (ret_w = mdb_dbi_open(txn_u, "EVENTS", ops_w, &mdb_u)) ) { + fprintf(stderr, "lmdb: gulf: dbi_open fail: %s\n", mdb_strerror(ret_w)); + // XX confirm + // + mdb_txn_abort(txn_u); + return c3n; + } + } + + { + MDB_cursor* cur_u; + MDB_val key_u; + MDB_val val_u; + c3_d fir_d, las_d; + + // creates a cursor to point to the last event + // + if ( (ret_w = mdb_cursor_open(txn_u, mdb_u, &cur_u)) ) { + fprintf(stderr, "lmdb: gulf: cursor_open fail: %s\n", + mdb_strerror(ret_w)); + // XX confirm + // + mdb_txn_abort(txn_u); + return c3n; + } + + // read with the cursor from the start of the database + // + ret_w = mdb_cursor_get(cur_u, &key_u, &val_u, MDB_FIRST); + + if ( MDB_NOTFOUND == ret_w ) { + *low_d = 0; + *hig_d = 0; + mdb_cursor_close(cur_u); + mdb_txn_abort(txn_u); + return c3y; + } + else if ( ret_w ) { + fprintf(stderr, "lmdb: gulf: head fail: %s\n", + mdb_strerror(ret_w)); + mdb_cursor_close(cur_u); + mdb_txn_abort(txn_u); + return c3n; + } + else { + fir_d = *(c3_d*)key_u.mv_data; + } + + // read with the cursor from the end of the database + // + ret_w = mdb_cursor_get(cur_u, &key_u, &val_u, MDB_LAST); + + if ( !ret_w ) { + las_d = *(c3_d*)key_u.mv_data; + } + + // clean up unconditionally, we're done + // + mdb_cursor_close(cur_u); + mdb_txn_abort(txn_u); + + if ( ret_w ) { + fprintf(stderr, "lmdb: gulf: last fail: %s\r\n", mdb_strerror(ret_w)); + return c3n; + } + else { + *low_d = fir_d; + *hig_d = las_d; + return c3y; + } + } +} + +/* c3_lmdb_read(): read [len_d] events starting at [eve_d]. +*/ +c3_o +c3_lmdb_read(MDB_env* env_u, + void* vod_p, + c3_d eve_d, + c3_d len_d, + c3_o (*read_f)(void*, c3_d, size_t, void*)) +{ + MDB_txn* txn_u; + MDB_dbi mdb_u; + c3_w ret_w; + + // create a read-only transaction. + // + if ( (ret_w = mdb_txn_begin(env_u, 0, MDB_RDONLY, &txn_u)) ) { + fprintf(stderr, "lmdb: read txn_begin fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // open the database in the transaction + // + { + c3_w ops_w = MDB_CREATE | MDB_INTEGERKEY; + + if ( (ret_w = mdb_dbi_open(txn_u, "EVENTS", ops_w, &mdb_u)) ) { + fprintf(stderr, "lmdb: read: dbi_open fail: %s\n", mdb_strerror(ret_w)); + // XX confirm + // + mdb_txn_abort(txn_u); + return c3n; + } + } + + + { + MDB_cursor* cur_u; + MDB_val val_u; + // set the initial key to [eve_d] + // + MDB_val key_u = { .mv_size = sizeof(c3_d), .mv_data = &eve_d }; + + // creates a cursor to iterate over keys starting at [eve_d] + // + if ( (ret_w = mdb_cursor_open(txn_u, mdb_u, &cur_u)) ) { + fprintf(stderr, "lmdb: read: cursor_open fail: %s\n", + mdb_strerror(ret_w)); + // XX confirm + // + mdb_txn_abort(txn_u); + return c3n; + } + + // set the cursor to the position of [eve_d] + // + if ( (ret_w = mdb_cursor_get(cur_u, &key_u, &val_u, MDB_SET_KEY)) ) { + fprintf(stderr, "lmdb: read: initial cursor_get failed at %" PRIu64 ": %s\r\n", + eve_d, + mdb_strerror(ret_w)); + mdb_cursor_close(cur_u); + // XX confirm + // + mdb_txn_abort(txn_u); + return c3n; + } + + // load up to [len_d] events, iterating forward across the cursor. + // + { + c3_o ret_o = c3y; + c3_d i_d; + + for ( i_d = 0; (ret_w != MDB_NOTFOUND) && (i_d < len_d); ++i_d) { + c3_d cur_d = (eve_d + i_d); + if ( sizeof(c3_d) != key_u.mv_size ) { + fprintf(stderr, "lmdb: read: invalid key size\r\n"); + ret_o = c3n; + break; + } + + // sanity check: ensure contiguous event numbers + // + if ( *(c3_d*)key_u.mv_data != cur_d ) { + fprintf(stderr, "lmdb: read gap: expected %" PRIu64 + ", received %" PRIu64 "\r\n", + cur_d, + *(c3_d*)key_u.mv_data); + ret_o = c3n; + break; + } + + // invoke read callback with [val_u] + // + if ( c3n == read_f(vod_p, cur_d, val_u.mv_size, val_u.mv_data) ) { + ret_o = c3n; + break; + } + + // read the next event from the cursor + // + if ( (ret_w = mdb_cursor_get(cur_u, &key_u, &val_u, MDB_NEXT)) + && (MDB_NOTFOUND != ret_w) ) + { + fprintf(stderr, "lmdb: read: error: %s\r\n", + mdb_strerror(ret_w)); + ret_o = c3n; + break; + } + } + + mdb_cursor_close(cur_u); + + // read-only transactions are aborted when complete + // + mdb_txn_abort(txn_u); + + return ret_o; + } + } +} + +/* c3_lmdb_save(): save [len_d] events starting at [eve_d]. +*/ +c3_o +c3_lmdb_save(MDB_env* env_u, + c3_d eve_d, // first event + c3_d len_d, // number of events + void** byt_p, // array of bytes + size_t* siz_i) // array of lengths +{ + MDB_txn* txn_u; + MDB_dbi mdb_u; + c3_w ret_w; + + // create a write transaction + // + if ( (ret_w = mdb_txn_begin(env_u, 0, 0, &txn_u)) ) { + fprintf(stderr, "lmdb: write: txn_begin fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // opens the database in the transaction + // + { + c3_w ops_w = MDB_CREATE | MDB_INTEGERKEY; + + if ( (ret_w = mdb_dbi_open(txn_u, "EVENTS", ops_w, &mdb_u)) ) { + fprintf(stderr, "lmdb: write: dbi_open fail: %s\n", mdb_strerror(ret_w)); + mdb_txn_abort(txn_u); + return c3n; + } + } + + // write every event in the batch + // + { + c3_w ops_w = MDB_NOOVERWRITE; + c3_d las_d = (eve_d + len_d); + c3_d key_d, i_d; + + for ( i_d = 0; i_d < len_d; ++i_d) { + key_d = eve_d + i_d; + + { + MDB_val key_u = { .mv_size = sizeof(c3_d), .mv_data = &key_d }; + MDB_val val_u = { .mv_size = siz_i[i_d], .mv_data = byt_p[i_d] }; + + if ( (ret_w = mdb_put(txn_u, mdb_u, &key_u, &val_u, ops_w)) ) { + fprintf(stderr, "lmdb: write failed on event %" PRIu64 "\n", key_d); + mdb_txn_abort(txn_u); + return c3n; + } + } + } + } + + // commit transaction + // + if ( (ret_w = mdb_txn_commit(txn_u)) ) { + fprintf(stderr, "lmdb: write failed: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + return c3y; +} + +/* c3_lmdb_read_meta(): read by string from the META db. +*/ +void +c3_lmdb_read_meta(MDB_env* env_u, + void* vod_p, + const c3_c* key_c, + void (*read_f)(void*, size_t, void*)) +{ + MDB_txn* txn_u; + MDB_dbi mdb_u; + c3_w ret_w; + + // create a read transaction + // + if ( (ret_w = mdb_txn_begin(env_u, 0, MDB_RDONLY, &txn_u)) ) { + fprintf(stderr, "lmdb: meta read: txn_begin fail: %s\n", + mdb_strerror(ret_w)); + return read_f(vod_p, 0, 0); + } + + // open the database in the transaction + // + if ( (ret_w = mdb_dbi_open(txn_u, "META", 0, &mdb_u)) ) { + fprintf(stderr, "lmdb: meta read: dbi_open fail: %s\n", + mdb_strerror(ret_w)); + mdb_txn_abort(txn_u); + return read_f(vod_p, 0, 0); + } + + // read by string key, invoking callback with result + { + MDB_val key_u = { .mv_size = strlen(key_c), .mv_data = (void*)key_c }; + MDB_val val_u; + + if ( (ret_w = mdb_get(txn_u, mdb_u, &key_u, &val_u)) ) { + fprintf(stderr, "lmdb: read failed: %s\n", mdb_strerror(ret_w)); + mdb_txn_abort(txn_u); + return read_f(vod_p, 0, 0); + } + else { + read_f(vod_p, val_u.mv_size, val_u.mv_data); + + // read-only transactions are aborted when complete + // + mdb_txn_abort(txn_u); + } + } +} + +/* c3_lmdb_save_meta(): save by string into the META db. +*/ +c3_o +c3_lmdb_save_meta(MDB_env* env_u, + const c3_c* key_c, + size_t val_i, + void* val_p) +{ + MDB_txn* txn_u; + MDB_dbi mdb_u; + c3_w ret_w; + + // create a write transaction + // + if ( (ret_w = mdb_txn_begin(env_u, 0, 0, &txn_u)) ) { + fprintf(stderr, "lmdb: meta write: txn_begin fail: %s\n", + mdb_strerror(ret_w)); + return c3n; + } + + // opens the database in the transaction + // + if ( (ret_w = mdb_dbi_open(txn_u, "META", MDB_CREATE, &mdb_u)) ) { + fprintf(stderr, "lmdb: meta write: dbi_open fail: %s\n", + mdb_strerror(ret_w)); + mdb_txn_abort(txn_u); + return c3n; + } + + // put value by string key + // + { + MDB_val key_u = { .mv_size = strlen(key_c), .mv_data = (void*)key_c }; + MDB_val val_u = { .mv_size = val_i, .mv_data = val_p }; + + if ( (ret_w = mdb_put(txn_u, mdb_u, &key_u, &val_u, 0)) ) { + fprintf(stderr, "lmdb: write failed: %s\n", mdb_strerror(ret_w)); + mdb_txn_abort(txn_u); + return c3n; + } + } + + // commit txn + // + if ( (ret_w = mdb_txn_commit(txn_u)) ) { + fprintf(stderr, "lmdb: meta write: commit failed: %s\n", + mdb_strerror(ret_w)); + return c3n; + } + + return c3y; +} diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 5bc322c91..41f2edf9c 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -18,6 +18,7 @@ #include "all.h" #include "vere/vere.h" +#include struct _cd_read { c3_d eve_d; @@ -27,12 +28,26 @@ struct _cd_read { struct _u3_disk* log_u; }; -typedef struct _u3_db_batch { - c3_d eve_d; // first event - c3_d len_d; // number of events - void** byt_p; // array of bytes - size_t* siz_i; // array of lengths -} u3_db_batch; +/* u3_db_batch: database write batch +*/ + typedef struct _u3_db_batch { + c3_d eve_d; // first event + c3_d len_d; // number of events + void** byt_p; // array of bytes + size_t* siz_i; // array of lengths + } u3_db_batch; + +/* _write_request: callback struct for c3_lmdb_write_event() +** +** Note that [env_u] is thread-safe, but, transactions and handles +** opened from it are explicitly not. [dun_f] is called on the main thread +** +*/ +struct _cd_save { + c3_o ret_o; // result + u3_db_batch* bat_u; // write batch + struct _u3_disk* log_u; +}; #undef VERBOSE_DISK @@ -109,11 +124,23 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) return 0; } - if ( 0 == (log_u->db_u = u3_lmdb_init(log_c)) ) { - fprintf(stderr, "disk: failed to initialize database"); - c3_free(log_c); - c3_free(log_u); - return 0; + { + // TODO: Start with forty gigabytes on macOS and sixty otherwise for the + // maximum event log size. We'll need to do something more sophisticated for + // real in the long term, though. + // +#ifdef U3_OS_osx + const size_t siz_w = 42949672960; +#else + const size_t siz_w = 64424509440;; +#endif + + if ( 0 == (log_u->mdb_u = c3_lmdb_init(log_c, siz_w)) ) { + fprintf(stderr, "disk: failed to initialize database"); + c3_free(log_c); + c3_free(log_u); + return 0; + } } c3_free(log_c); @@ -123,8 +150,9 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) // { log_u->dun_d = 0; + c3_d fir_d; - if ( c3n == u3_lmdb_get_latest_event_number(log_u->db_u, &log_u->dun_d) ) { + if ( c3n == c3_lmdb_gulf(log_u->mdb_u, &fir_d, &log_u->dun_d) ) { fprintf(stderr, "disk: failed to load latest event from database"); c3_free(log_u); return 0; @@ -138,12 +166,59 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) return log_u; } +static void +_disk_meta_read_cb(void* vod_p, size_t val_i, void* val_p) +{ + u3_weak* mat = vod_p; + + if ( val_p ) { + *mat = u3i_bytes(val_i, val_p); + } +} + +static u3_weak +_disk_read_meta(u3_disk* log_u, const c3_c* key_c) +{ + u3_weak mat = u3_none; + + c3_lmdb_read_meta(log_u->mdb_u, &mat, "who", _disk_meta_read_cb); + + if ( u3_none == mat ) { + return u3_none; + } + + { + u3_noun pro = u3m_soft(0, u3ke_cue, mat); + u3_noun tag, dat; + u3x_cell(pro, &tag, &dat); + + if ( u3_blip == tag ) { + u3k(dat); + u3z(pro); + return dat; + } + else { + fprintf(stderr, "disk: meta cue failed\r\n"); + u3z(pro); + return u3_none; + } + } +} + c3_o u3_disk_read_header(u3_disk* log_u, c3_d* who_d, c3_o* fak_o, c3_w* lif_w) { - u3_noun who, fak, lif; + u3_weak who = _disk_read_meta(log_u, "who"); + u3_weak fak = _disk_read_meta(log_u, "is-fake"); + u3_weak lif = _disk_read_meta(log_u, "life"); - if ( c3n == u3_lmdb_read_identity(log_u->db_u, &who, &fak, &lif) ) { + if ( u3_none == who ) { + return c3n; + } + else if ( (u3_none == fak) + || (u3_none == lif) ) + { + u3z(who); return c3n; } @@ -167,25 +242,64 @@ u3_disk_read_header(u3_disk* log_u, c3_d* who_d, c3_o* fak_o, c3_w* lif_w) } u3z(who); - return c3y; } +static c3_o +_disk_save_meta(u3_disk* log_u, const c3_c* key_c, u3_atom dat) +{ + u3_atom mat = u3ke_jam(dat); + c3_w len_w = u3r_met(3, mat); + c3_y* byt_y = c3_malloc(len_w); + c3_o ret_o; + + u3r_bytes(0, len_w, byt_y, mat); + + ret_o = c3_lmdb_save_meta(log_u->mdb_u, key_c, len_w, byt_y); + + u3z(mat); + c3_free(byt_y); + + return ret_o; +} + c3_o u3_disk_write_header(u3_disk* log_u, c3_d who_d[2], c3_o fak_o, c3_w lif_w) { c3_assert( c3y == u3a_is_cat(lif_w) ); - u3_noun who = u3i_chubs(2, who_d); - return u3_lmdb_write_identity(log_u->db_u, who, fak_o, lif_w); + + if ( (c3n == _disk_save_meta(log_u, "who", u3i_chubs(2, who_d))) + || (c3n == _disk_save_meta(log_u, "is-fake", fak_o)) + || (c3n == _disk_save_meta(log_u, "life", lif_w)) ) + { + // XX dispose? + // + return c3n; + } + + return c3y; } +static void +_disk_free_batch(u3_db_batch* bat_u) +{ + while ( bat_u->len_d-- ) { + c3_free(bat_u->byt_p[bat_u->len_d]); + } + + c3_free(bat_u->byt_p); + c3_free(bat_u->siz_i); + c3_free(bat_u); +} /* _disk_commit_done(): commit complete. */ static void -_disk_commit_done(c3_o ret_o, void* vod_p, c3_d eve_d, c3_d len_d) +_disk_commit_done(void* vod_p, c3_o ret_o, u3_db_batch* bat_u) { u3_disk* log_u = vod_p; + c3_d eve_d = bat_u->eve_d; + c3_d len_d = bat_u->len_d; if ( c3n == ret_o ) { log_u->cb_u.write_bail_f(log_u->cb_u.vod_p, eve_d + (len_d - 1ULL)); @@ -232,10 +346,71 @@ _disk_commit_done(c3_o ret_o, void* vod_p, c3_d eve_d, c3_d len_d) log_u->put_u.ent_u = 0; } + _disk_free_batch(bat_u); + log_u->hol_o = c3n; _disk_commit(log_u); } + + + +/* _disk_commit_after_cb(): Implementation of c3_lmdb_write_event() +** +** This is always run on the main loop thread after the worker thread event +** completes. +*/ +static void +_disk_commit_after_cb(uv_work_t* ted_u, int status) +{ + struct _cd_save* req_u = ted_u->data; + _disk_commit_done(req_u->log_u, req_u->ret_o, req_u->bat_u); + c3_free(req_u); + c3_free(ted_u); +} + +/* _lmdb_write_event_cb(): Implementation of c3_lmdb_write_event() +** +** This is always run on a libuv background worker thread; actual nouns cannot +** be touched here. +*/ +static void +_disk_commit_cb(uv_work_t* ted_u) +{ + struct _cd_save* req_u = ted_u->data; + u3_db_batch* bat_u = req_u->bat_u; + req_u->ret_o = c3_lmdb_save(req_u->log_u->mdb_u, + bat_u->eve_d, + bat_u->len_d, + bat_u->byt_p, + bat_u->siz_i); +} + +/* c3_lmdb_write_event(): Asynchronously writes events to the database. +** +** This writes all the passed in events along with log metadata updates to the +** database as a single transaction on a worker thread. Once the transaction +** is completed, it calls the passed in callback on the main loop thread. +*/ +static void +_disk_commit_start(u3_disk* log_u, u3_db_batch* bat_u) +{ + // structure to pass to the worker thread. + // + struct _cd_save* req_u = c3_malloc(sizeof(*req_u)); + req_u->log_u = log_u; + req_u->bat_u = bat_u; + req_u->ret_o = c3n; + + // queue asynchronous work to happen on another thread + // + uv_work_t* ted_u = c3_malloc(sizeof(*ted_u)); + ted_u->data = req_u; + + uv_queue_work(u3L, ted_u, _disk_commit_cb, + _disk_commit_after_cb); +} + static void _disk_commit(u3_disk* log_u) { @@ -281,10 +456,7 @@ _disk_commit(u3_disk* log_u) } #endif - u3_lmdb_write_event(log_u->db_u, (u3_pier*)log_u, - (struct u3_lmdb_write_request*)bat_u, - (void(*)(c3_o, u3_pier*, c3_d, c3_d))_disk_commit_done); - + _disk_commit_start(log_u, bat_u); log_u->hol_o = c3y; } } @@ -369,7 +541,7 @@ _disk_read_done_cb(uv_timer_t* tim_u) } static c3_o -_disk_read_one_cb(void* vod_p, c3_d eve_d, u3_atom mat) +_disk_read_one_cb(void* vod_p, c3_d eve_d, size_t val_i, void* val_p) { struct _cd_read* red_u = vod_p; u3_disk* log_u = red_u->log_u; @@ -379,7 +551,7 @@ _disk_read_one_cb(void* vod_p, c3_d eve_d, u3_atom mat) { // xx soft? // - u3_noun dat = u3ke_cue(mat); + u3_noun dat = u3ke_cue(u3i_bytes(val_i, val_p)); u3_noun mug, job; if ( (c3n == u3r_cell(dat, &mug, &job)) @@ -420,11 +592,11 @@ _disk_read_start_cb(uv_timer_t* tim_u) uv_timer_start(&log_u->tim_u, _disk_read_done_cb, 0, 0); - if ( c3n == u3_lmdb_read_events(log_u->db_u, - red_u->eve_d, - red_u->len_d, - red_u, - _disk_read_one_cb) ) + if ( c3n == c3_lmdb_read(log_u->mdb_u, + red_u, + red_u->eve_d, + red_u->len_d, + _disk_read_one_cb) ) { log_u->cb_u.read_bail_f(log_u->cb_u.vod_p, red_u->eve_d); } @@ -448,7 +620,7 @@ u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d) void u3_disk_exit(u3_disk* log_u) { - u3_lmdb_shutdown(log_u->db_u); + c3_lmdb_exit(log_u->mdb_u); // XX dispose // } diff --git a/pkg/urbit/vere/lmdb.c b/pkg/urbit/vere/lmdb.c deleted file mode 100644 index 0d766d3da..000000000 --- a/pkg/urbit/vere/lmdb.c +++ /dev/null @@ -1,673 +0,0 @@ -/* vere/lmdb.c -*/ - -#include "all.h" - -#include -#include - -#include "vere/vere.h" - -// Event log persistence for Urbit -// -// Persistence works by having an lmdb environment opened on the main -// thread. This environment is used to create read-only transactions -// synchronously when needed. -// -// But the majority of lmdb writes operate asynchronously in the uv worker -// pool. Since individual transactions are bound to threads, we perform all -// blocking writing on worker threads. -// -// We perform the very first metadata writes on the main thread because we -// can't do anything until they persist. - -/* u3_lmdb_init(): Opens up a log environment -** -** Precondition: log_path points to an already created directory -*/ -MDB_env* u3_lmdb_init(const char* log_path) -{ - MDB_env* env = 0; - c3_w ret_w = mdb_env_create(&env); - if (ret_w != 0) { - u3l_log("lmdb: init fail: %s\n", mdb_strerror(ret_w)); - return 0; - } - - // Our databases have up to three tables: META, EVENTS, and GRAINS. - ret_w = mdb_env_set_maxdbs(env, 3); - if (ret_w != 0) { - u3l_log("lmdb: failed to set number of databases: %s\n", mdb_strerror(ret_w)); - return 0; - } - - // TODO: Start with forty gigabytes on macOS and sixty otherwise for the - // maximum event log size. We'll need to do something more sophisticated for - // real in the long term, though. - // -#ifdef U3_OS_osx - const size_t lmdb_mapsize = 42949672960; -#else - const size_t lmdb_mapsize = 64424509440;; -#endif - ret_w = mdb_env_set_mapsize(env, lmdb_mapsize); - if (ret_w != 0) { - u3l_log("lmdb: failed to set database size: %s\n", mdb_strerror(ret_w)); - return 0; - } - - ret_w = mdb_env_open(env, log_path, 0, 0664); - if (ret_w != 0) { - u3l_log("lmdb: failed to open event log: %s\n", mdb_strerror(ret_w)); - return 0; - } - - return env; -} - -/* u3_lmdb_shutdown(): Shuts down lmdb -*/ -void u3_lmdb_shutdown(MDB_env* env) -{ - mdb_env_close(env); -} - -/* _perform_put_on_database_raw(): Writes a key/value pair to a specific -** database as part of a transaction. -** -** The raw version doesn't take ownership of either key/value and performs no -** nock calculations, so it is safe to call from any thread. -*/ -static -c3_o _perform_put_on_database_raw(MDB_txn* transaction_u, - MDB_dbi database_u, - c3_w flags, - void* key, - size_t key_len, - void* value, - size_t value_len) { - MDB_val key_val, value_val; - - key_val.mv_size = key_len; - key_val.mv_data = key; - - value_val.mv_size = value_len; - value_val.mv_data = value; - - c3_w ret_w = mdb_put(transaction_u, database_u, &key_val, &value_val, flags); - if (ret_w != 0) { - u3l_log("lmdb: write failed: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - return c3y; -} - -/* _perform_get_on_database_raw(): Reads a key/value pair to a specific -** database as part of a transaction. -*/ -static -c3_o _perform_get_on_database_raw(MDB_txn* transaction_u, - MDB_dbi database_u, - void* key, - size_t key_len, - MDB_val* value) { - MDB_val key_val; - key_val.mv_size = key_len; - key_val.mv_data = key; - - c3_w ret_w = mdb_get(transaction_u, database_u, &key_val, value); - if (ret_w != 0) { - u3l_log("lmdb: read failed: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - return c3y; -} - -/* _perform_put_on_database_noun(): Writes a noun to the database. -** -** This requires access to the loom so it must only be run from the libuv -** thread. -*/ -static -c3_o _perform_put_on_database_noun(MDB_txn* transaction_u, - MDB_dbi database_u, - c3_c* key, - u3_noun noun) { - // jam noun into an atom representation - u3_atom mat = u3ke_jam(noun); - - // copy the jammed noun into a byte buffer we can hand to lmdb - c3_w len_w = u3r_met(3, mat); - c3_y* bytes_y = c3_malloc(len_w); - u3r_bytes(0, len_w, bytes_y, mat); - - c3_o ret = _perform_put_on_database_raw( - transaction_u, - database_u, - 0, - key, strlen(key), - bytes_y, len_w); - - c3_free(bytes_y); - u3z(mat); - - return ret; -} - -/* _perform_get_on_database_noun(): Reads a noun from the database. -** -** This requires access to the loom so it must only be run from the libuv -** thread. -*/ -static -c3_o _perform_get_on_database_noun(MDB_txn* transaction_u, - MDB_dbi database_u, - c3_c* key, - u3_noun* noun) { - MDB_val value_val; - c3_o ret = _perform_get_on_database_raw(transaction_u, - database_u, - key, strlen(key), - &value_val); - if (ret == c3n) { - return c3y; - } - - // Take the bytes and cue them. - u3_atom raw_atom = u3i_bytes(value_val.mv_size, value_val.mv_data); - *noun = u3qe_cue(raw_atom); - return c3y; -} - -/* u3_lmdb_write_request: Events to be written together -*/ -struct u3_lmdb_write_request { - // The event number of the first event. - c3_d first_event; - - // The number of events in this write request. Nonzero. - c3_d event_count; - - // An array of serialized event datas. The array size is |event_count|. We - // perform the event serialization on the main thread so we can read the loom - // and write into a malloced structure for the worker thread. - void** malloced_event_data; - - // An array of sizes of serialized event datas. We keep track of this for the - // database write. - size_t* malloced_event_data_size; -}; - -/* u3_lmdb_build_write_request(): Allocates and builds a write request -*/ -struct u3_lmdb_write_request* -u3_lmdb_build_write_request(u3_writ* event_u, c3_d count) -{ - struct u3_lmdb_write_request* request = - c3_malloc(sizeof(struct u3_lmdb_write_request)); - request->first_event = event_u->evt_d; - request->event_count = count; - request->malloced_event_data = c3_malloc(sizeof(void*) * count); - request->malloced_event_data_size = c3_malloc(sizeof(size_t) * count); - - for (c3_d i = 0; i < count; ++i) { - // Sanity check that the events in u3_writ are in order. - c3_assert(event_u->evt_d == (request->first_event + i)); - - // Serialize the jammed event log entry into a malloced buffer we can send - // to the other thread. - c3_w siz_w = u3r_met(3, event_u->mat); - c3_y* data_u = c3_calloc(siz_w); - u3r_bytes(0, siz_w, data_u, event_u->mat); - - request->malloced_event_data[i] = data_u; - request->malloced_event_data_size[i] = siz_w; - - event_u = event_u->nex_u; - } - - return request; -} - -/* u3_lmdb_free_write_request(): Frees a write request -*/ -void u3_lmdb_free_write_request(struct u3_lmdb_write_request* request) { - for (c3_d i = 0; i < request->event_count; ++i) - c3_free(request->malloced_event_data[i]); - - c3_free(request->malloced_event_data); - c3_free(request->malloced_event_data_size); - c3_free(request); -} - -/* _write_request_data: callback struct for u3_lmdb_write_event() -*/ -struct _write_request_data { - // The database environment to write to. This object is thread-safe, though - // the transactions and handles opened from it are explicitly not. - MDB_env* environment; - - // The pier that we're writing for. - u3_pier* pir_u; - - // The encapsulated request. This may contain multiple event writes. - struct u3_lmdb_write_request* request; - - // Whether the write completed successfully. - c3_o success; - - // Called on main loop thread on completion. - void (*on_complete)(c3_o, u3_pier*, c3_d, c3_d); -}; - -/* _u3_lmdb_write_event_cb(): Implementation of u3_lmdb_write_event() -** -** This is always run on a libuv background worker thread; actual nouns cannot -** be touched here. -*/ -static void _u3_lmdb_write_event_cb(uv_work_t* req) { - struct _write_request_data* data = req->data; - - // Creates the write transaction. - MDB_txn* transaction_u; - c3_w ret_w = mdb_txn_begin(data->environment, - (MDB_txn *) NULL, - 0, /* flags */ - &transaction_u); - if (0 != ret_w) { - u3l_log("lmdb: write: txn_begin fail: %s\n", mdb_strerror(ret_w)); - return; - } - - // Opens the database as part of the transaction. - c3_w flags_w = MDB_CREATE | MDB_INTEGERKEY; - MDB_dbi database_u; - ret_w = mdb_dbi_open(transaction_u, - "EVENTS", - flags_w, - &database_u); - if (0 != ret_w) { - u3l_log("lmdb: write: dbi_open fail: %s\n", mdb_strerror(ret_w)); - return; - } - - struct u3_lmdb_write_request* request = data->request; - for (c3_d i = 0; i < request->event_count; ++i) { - c3_d event_number = request->first_event + i; - - c3_o success = _perform_put_on_database_raw( - transaction_u, - database_u, - MDB_NOOVERWRITE, - &event_number, - sizeof(c3_d), - request->malloced_event_data[i], - request->malloced_event_data_size[i]); - - if (success == c3n) { - u3l_log("lmdb: failed to write event %" PRIu64 "\n", event_number); - mdb_txn_abort(transaction_u); - data->success = c3n; - return; - } - } - - ret_w = mdb_txn_commit(transaction_u); - if (0 != ret_w) { - if ( request->event_count == 1 ) { - u3l_log("lmdb: failed to commit event %" PRIu64 ": %s\n", - request->first_event, - mdb_strerror(ret_w)); - } else { - c3_d through = request->first_event + request->event_count - 1ULL; - u3l_log("lmdb: failed to commit events %" PRIu64 " through %" PRIu64 - ": %s\n", - request->first_event, - through, - mdb_strerror(ret_w)); - } - data->success = c3n; - return; - } - - data->success = c3y; -} - -/* _u3_lmdb_write_event_after_cb(): Implementation of u3_lmdb_write_event() -** -** This is always run on the main loop thread after the worker thread event -** completes. -*/ -static void _u3_lmdb_write_event_after_cb(uv_work_t* req, int status) { - struct _write_request_data* data = req->data; - - data->on_complete(data->success, - data->pir_u, - data->request->first_event, - data->request->event_count); - - u3_lmdb_free_write_request(data->request); - c3_free(data); - c3_free(req); -} - -/* u3_lmdb_write_event(): Asynchronously writes events to the database. -** -** This writes all the passed in events along with log metadata updates to the -** database as a single transaction on a worker thread. Once the transaction -** is completed, it calls the passed in callback on the main loop thread. -*/ -void u3_lmdb_write_event(MDB_env* environment, - u3_pier* pir_u, - struct u3_lmdb_write_request* request_u, - void (*on_complete)(c3_o, u3_pier*, c3_d, c3_d)) -{ - // Structure to pass to the worker thread. - struct _write_request_data* data = c3_malloc(sizeof(struct _write_request_data)); - data->environment = environment; - data->pir_u = pir_u; - data->request = request_u; - data->on_complete = on_complete; - data->success = c3n; - - // Queue asynchronous work to happen on the other thread. - uv_work_t* req = c3_malloc(sizeof(uv_work_t)); - req->data = data; - - uv_queue_work(uv_default_loop(), - req, - _u3_lmdb_write_event_cb, - _u3_lmdb_write_event_after_cb); -} - -/* u3_lmdb_read_events(): Synchronously reads events from the database. -** -** Reads back up to |len_d| events starting with |first_event_d|. For -** each event, the event will be passed to |on_event_read| and further -** reading will be aborted if the callback returns c3n. -** -** Returns c3y on complete success; c3n on any error. -*/ -c3_o -u3_lmdb_read_events(MDB_env* db_u, - c3_d first_event_d, - c3_d len_d, - void* vod_p, - c3_o(*on_event_read)(void*, c3_d, u3_atom)) -{ - // Creates the read transaction. - MDB_txn* transaction_u; - c3_w ret_w = mdb_txn_begin(db_u, - //environment, - (MDB_txn *) NULL, - MDB_RDONLY, /* flags */ - &transaction_u); - if (0 != ret_w) { - u3l_log("lmdb: read txn_begin fail: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - // Opens the database as part of the transaction. - c3_w flags_w = MDB_CREATE | MDB_INTEGERKEY; - MDB_dbi database_u; - ret_w = mdb_dbi_open(transaction_u, - "EVENTS", - flags_w, - &database_u); - if (0 != ret_w) { - u3l_log("lmdb: read: dbi_open fail: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - // Creates a cursor to iterate over keys starting at first_event_d. - MDB_cursor* cursor_u; - ret_w = mdb_cursor_open(transaction_u, database_u, &cursor_u); - if (0 != ret_w) { - u3l_log("lmdb: read: cursor_open fail: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - // Sets the cursor to the position of first_event_d. - MDB_val key; - MDB_val val; - key.mv_size = sizeof(c3_d); - key.mv_data = &first_event_d; - - ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_SET_KEY); - if (0 != ret_w) { - u3l_log("lmdb: read: could not find initial event %" PRIu64 ": %s\r\n", - first_event_d, mdb_strerror(ret_w)); - mdb_cursor_close(cursor_u); - return c3n; - } - - // Load up to len_d events, iterating forward across the cursor. - for (c3_d loaded = 0; (ret_w != MDB_NOTFOUND) && (loaded < len_d); ++loaded) { - // As a sanity check, we make sure that there aren't any discontinuities in - // the sequence of loaded events. - c3_d current_id = first_event_d + loaded; - if (key.mv_size != sizeof(c3_d)) { - u3l_log("lmdb: read: invalid cursor key\r\n"); - return c3n; - } - if (*(c3_d*)key.mv_data != current_id) { - u3l_log("lmdb: read: missing event in database. Expected %" PRIu64 ", received %" - PRIu64 "\r\n", - current_id, - *(c3_d*)key.mv_data); - return c3n; - } - - // Now build the atom version and then the cued version from the raw data - if ( c3n == on_event_read(vod_p, current_id, u3i_bytes(val.mv_size, val.mv_data)) ) { - // XX remove - // - u3l_log("lmdb: read: aborting replay due to error.\r\n"); - return c3n; - } - - ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_NEXT); - if (ret_w != 0 && ret_w != MDB_NOTFOUND) { - u3l_log("lmdb: read: error while loading events: %s\r\n", - mdb_strerror(ret_w)); - return c3n; - } - } - - mdb_cursor_close(cursor_u); - - // Read-only transactions are aborted since we don't need to record the fact - // that we performed a read. - mdb_txn_abort(transaction_u); - - return c3y; -} - -/* u3_lmdb_get_latest_event_number(): Gets last event id persisted -** -** Reads the last key in order from the EVENTS table as the latest event -** number. On table empty, returns c3y but doesn't modify event_number. -*/ -c3_o u3_lmdb_get_latest_event_number(MDB_env* environment, c3_d* event_number) -{ - // Creates the read transaction. - MDB_txn* transaction_u; - c3_w ret_w = mdb_txn_begin(environment, - (MDB_txn *) NULL, - 0, /* flags */ - &transaction_u); - if (0 != ret_w) { - u3l_log("lmdb: last: txn_begin fail: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - // Opens the database as part of the transaction. - c3_w flags_w = MDB_CREATE | MDB_INTEGERKEY; - MDB_dbi database_u; - ret_w = mdb_dbi_open(transaction_u, - "EVENTS", - flags_w, - &database_u); - if (0 != ret_w) { - u3l_log("lmdb: last: dbi_open fail: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - // Creates a cursor to point to the last event - MDB_cursor* cursor_u; - ret_w = mdb_cursor_open(transaction_u, database_u, &cursor_u); - if (0 != ret_w) { - u3l_log("lmdb: last: cursor_open fail: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - // Set the cursor at the end of the line. - MDB_val key; - MDB_val val; - ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_LAST); - if (MDB_NOTFOUND == ret_w) { - // Clean up, but don't error out. - mdb_cursor_close(cursor_u); - mdb_txn_abort(transaction_u); - return c3y; - } - - if (0 != ret_w) { - u3l_log("lmdb: could not find last event: %s\r\n", mdb_strerror(ret_w)); - mdb_cursor_close(cursor_u); - mdb_txn_abort(transaction_u); - return c3n; - } - - *event_number = *(c3_d*)key.mv_data; - - mdb_cursor_close(cursor_u); - - // Read-only transactions are aborted since we don't need to record the fact - // that we performed a read. - mdb_txn_abort(transaction_u); - - return c3y; -} - -/* u3_lmdb_write_identity(): Writes the event log identity information -** -** We have a secondary database (table) in this environment named META where we -** read/write identity information from/to. -*/ -c3_o u3_lmdb_write_identity(MDB_env* environment, - u3_noun who, - u3_noun is_fake, - u3_noun life) -{ - // Creates the write transaction. - MDB_txn* transaction_u; - c3_w ret_w = mdb_txn_begin(environment, - (MDB_txn *) NULL, - 0, /* flags */ - &transaction_u); - if (0 != ret_w) { - u3l_log("lmdb: meta write: txn_begin fail: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - // Opens the database as part of the transaction. - c3_w flags_w = MDB_CREATE; - MDB_dbi database_u; - ret_w = mdb_dbi_open(transaction_u, - "META", - flags_w, - &database_u); - if (0 != ret_w) { - u3l_log("lmdb: meta write: dbi_open fail: %s\n", mdb_strerror(ret_w)); - mdb_txn_abort(transaction_u); - return c3n; - } - - c3_o ret; - ret = _perform_put_on_database_noun(transaction_u, database_u, "who", who); - if (ret == c3n) { - mdb_txn_abort(transaction_u); - return c3n; - } - - ret = _perform_put_on_database_noun(transaction_u, database_u, "is-fake", - is_fake); - if (ret == c3n) { - mdb_txn_abort(transaction_u); - return c3n; - } - - ret = _perform_put_on_database_noun(transaction_u, database_u, "life", life); - if (ret == c3n) { - mdb_txn_abort(transaction_u); - return c3n; - } - - ret_w = mdb_txn_commit(transaction_u); - if (0 != ret_w) { - u3l_log("lmdb: meta write: failed to commit transaction: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - return c3y; -} - - -/* u3_lmdb_read_identity(): Reads the event log identity information. -*/ -c3_o u3_lmdb_read_identity(MDB_env* environment, - u3_noun* who, - u3_noun* is_fake, - u3_noun* life) { - // Creates the write transaction. - MDB_txn* transaction_u; - c3_w ret_w = mdb_txn_begin(environment, - (MDB_txn *) NULL, - MDB_RDONLY, /* flags */ - &transaction_u); - if (0 != ret_w) { - u3l_log("lmdb: meta read: txn_begin fail: %s\n", mdb_strerror(ret_w)); - return c3n; - } - - // Opens the database as part of the transaction. - MDB_dbi database_u; - ret_w = mdb_dbi_open(transaction_u, - "META", - 0, - &database_u); - if (0 != ret_w) { - u3l_log("lmdb: meta read: dbi_open fail: %s\n", mdb_strerror(ret_w)); - mdb_txn_abort(transaction_u); - return c3n; - } - - c3_o ret; - ret = _perform_get_on_database_noun(transaction_u, database_u, "who", who); - if (ret == c3n) { - mdb_txn_abort(transaction_u); - return c3n; - } - - ret = _perform_get_on_database_noun(transaction_u, database_u, "is-fake", - is_fake); - if (ret == c3n) { - mdb_txn_abort(transaction_u); - return c3n; - } - - ret = _perform_get_on_database_noun(transaction_u, database_u, "life", life); - if (ret == c3n) { - mdb_txn_abort(transaction_u); - return c3n; - } - - // Read-only transactions are aborted since we don't need to record the fact - // that we performed a read. - mdb_txn_abort(transaction_u); - - return c3y; -} From c91daffe0f6d57554c230326aadf627388030e31 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 22 Apr 2020 18:01:48 -0700 Subject: [PATCH 029/257] vere: refactors disk.c --- pkg/urbit/include/vere/vere.h | 72 ++- pkg/urbit/vere/disk.c | 997 ++++++++++++++++++---------------- pkg/urbit/vere/pier.c | 17 +- 3 files changed, 577 insertions(+), 509 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 719efd258..95a6f302d 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -451,7 +451,8 @@ c3_d dun_d; // committed u3_disk_cb cb_u; // callbacks uv_timer_t tim_u; // read timer - c3_o hol_o; // on hold + uv_work_t ted_u; // write thread + c3_o ted_o; // c3y == active u3_play put_u; // write queue } u3_disk; @@ -618,33 +619,11 @@ void u3_lord_snap(u3_lord* god_u, c3_d eve_d); - u3_disk* - u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u); - c3_o - u3_disk_read_header(u3_disk* log_u, c3_d who_d[2], c3_o* fak_o, c3_w* lif_w); - c3_o - u3_disk_write_header(u3_disk* log_u, c3_d who_d[2], c3_o fak_o, c3_w lif_w); - void - u3_disk_boot_plan(u3_disk* log_u, u3_noun job); - void - u3_disk_plan(u3_disk* log_u, - c3_d eve_d, - c3_l bug_l, - c3_l mug_l, - u3_noun job); - void - u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d); - /* u3_pier_spin(): (re-)activate idle handler */ void u3_pier_spin(u3_pier* pir_u); - /* u3_disk_exit(): close the log. - */ - void - u3_disk_exit(u3_disk* log_u); - # define u3L u3_Host.lup_u // global event loop # define u3Z (&(u3_Raft)) # define u3K u3_Daemon @@ -727,6 +706,53 @@ c3_d u3_time_gap_ms(u3_noun now, u3_noun wen); + /** New vere + **/ + /* u3_disk_init(): load or create pier directories and event log. + */ + u3_disk* + u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u); + + /* u3_disk_exit(): close [log_u] and dispose. + */ + void + u3_disk_exit(u3_disk* log_u); + + /* u3_disk_read_meta(): read metadata. + */ + c3_o + u3_disk_read_meta(u3_disk* log_u, + c3_d* who_d, + c3_o* fak_o, + c3_w* lif_w); + + /* u3_disk_save_meta(): save metadata. + */ + c3_o + u3_disk_save_meta(u3_disk* log_u, + c3_d who_d[2], + c3_o fak_o, + c3_w lif_w); + + /* u3_disk_read(): read [len_d] events starting at [eve_d]. + */ + void + u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d); + + /* u3_disk_boot_plan(): XX remove, just use u3_disk_plan(). + */ + void + u3_disk_boot_plan(u3_disk* log_u, u3_noun job); + + /* u3_disk_plan(): enqueue completed event for persistence. + */ + void + u3_disk_plan(u3_disk* log_u, + c3_d eve_d, + c3_l bug_l, + c3_l mug_l, + u3_noun job); + /** Filesystem (new api). **/ /* u3_walk_load(): load file or bail. diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 41f2edf9c..356289152 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -28,24 +28,12 @@ struct _cd_read { struct _u3_disk* log_u; }; -/* u3_db_batch: database write batch -*/ - typedef struct _u3_db_batch { - c3_d eve_d; // first event - c3_d len_d; // number of events - void** byt_p; // array of bytes - size_t* siz_i; // array of lengths - } u3_db_batch; - -/* _write_request: callback struct for c3_lmdb_write_event() -** -** Note that [env_u] is thread-safe, but, transactions and handles -** opened from it are explicitly not. [dun_f] is called on the main thread -** -*/ struct _cd_save { c3_o ret_o; // result - u3_db_batch* bat_u; // write batch + c3_d eve_d; // first event + c3_d len_d; // number of events + c3_y** byt_y; // array of bytes + size_t* siz_i; // array of lengths struct _u3_disk* log_u; }; @@ -54,14 +42,522 @@ struct _cd_save { static void _disk_commit(u3_disk* log_u); -/* u3_disk_init(): load or create pier and log. +/* _disk_free_save(): free write batch +*/ +static void +_disk_free_save(struct _cd_save* req_u) +{ + while ( req_u->len_d-- ) { + c3_free(req_u->byt_y[req_u->len_d]); + } + + c3_free(req_u->byt_y); + c3_free(req_u->siz_i); + c3_free(req_u); +} + +/* _disk_commit_done(): commit complete. + */ +static void +_disk_commit_done(struct _cd_save* req_u) +{ + u3_disk* log_u = req_u->log_u; + c3_d eve_d = req_u->eve_d; + c3_d len_d = req_u->len_d; + c3_o ret_o = req_u->ret_o; + + if ( c3n == ret_o ) { + log_u->cb_u.write_bail_f(log_u->cb_u.vod_p, eve_d + (len_d - 1ULL)); + +#ifdef VERBOSE_DISK + if ( 1ULL == len_d ) { + fprintf(stderr, "disk: (%" PRIu64 "): commit: failed\r\n", eve_d); + } + else { + fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: failed\r\n", + eve_d, + eve_d + (len_d - 1ULL)); + } +#endif + } + else { + log_u->dun_d = eve_d + (len_d - 1ULL); + log_u->cb_u.write_done_f(log_u->cb_u.vod_p, log_u->dun_d); + +#ifdef VERBOSE_DISK + if ( 1ULL == len_d ) { + fprintf(stderr, "disk: (%" PRIu64 "): commit: complete\r\n", eve_d); + } + else { + fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: complete\r\n", + eve_d, + eve_d + (len_d - 1ULL)); + } +#endif + } + + { + u3_fact* tac_u = log_u->put_u.ext_u; + + while ( tac_u && (tac_u->eve_d <= log_u->dun_d) ) { + log_u->put_u.ext_u = tac_u->nex_u; + u3z(tac_u->job); + c3_free(tac_u); + tac_u = log_u->put_u.ext_u; + } + } + + if ( !log_u->put_u.ext_u ) { + log_u->put_u.ent_u = 0; + } + + _disk_free_save(req_u); + + _disk_commit(log_u); +} + +/* _disk_commit_after_cb(): on the main thread, finish write +*/ +static void +_disk_commit_after_cb(uv_work_t* ted_u, c3_i sas_i) +{ + // XX UV_ECANCELED == sas_i? + // + struct _cd_save* req_u = ted_u->data; + + ted_u->data = 0; + req_u->log_u->ted_o = c3n; + _disk_commit_done(req_u); +} + +/* _disk_commit_cb(): off the main thread, write event-batch. +*/ +static void +_disk_commit_cb(uv_work_t* ted_u) +{ + struct _cd_save* req_u = ted_u->data; + req_u->ret_o = c3_lmdb_save(req_u->log_u->mdb_u, + req_u->eve_d, + req_u->len_d, + (void**)req_u->byt_y, // XX safe? + req_u->siz_i); +} + +/* _disk_commit_start(): queue async event-batch write. +*/ +static void +_disk_commit_start(struct _cd_save* req_u) +{ + u3_disk* log_u = req_u->log_u; + + c3_assert( c3n == log_u->ted_o ); + log_u->ted_o = c3y; + log_u->ted_u.data = req_u; + + // queue asynchronous work to happen on another thread + // + uv_queue_work(u3L, &log_u->ted_u, _disk_commit_cb, + _disk_commit_after_cb); +} + +/* _disk_serialize_v0(): serialize events in format v0. +*/ +static c3_w +_disk_serialize_v0(u3_fact* tac_u, c3_y** dat_y) +{ + u3_atom mat = u3ke_jam(u3nc(tac_u->bug_l, u3k(tac_u->job))); + c3_w len_w = u3r_met(3, mat); + *dat_y = c3_malloc(len_w); + u3r_bytes(0, len_w, *dat_y, mat); + + u3z(mat); + + return len_w; +} + +/* _disk_batch(): create a write batch +*/ +static struct _cd_save* +_disk_batch(u3_disk* log_u, c3_d len_d) +{ + u3_fact* tac_u = log_u->put_u.ext_u; + + c3_assert( (1ULL + log_u->dun_d) == tac_u->eve_d ); + c3_assert( log_u->sen_d == log_u->put_u.ent_u->eve_d ); + + struct _cd_save* req_u = c3_malloc(sizeof(*req_u)); + req_u->log_u = log_u; + req_u->ret_o = c3n; + req_u->eve_d = tac_u->eve_d; + req_u->len_d = len_d; + req_u->byt_y = c3_malloc(len_d * sizeof(c3_y*)); + req_u->siz_i = c3_malloc(len_d * sizeof(size_t)); + + for ( c3_d i_d = 0ULL; i_d < len_d; ++i_d) { + c3_assert( (req_u->eve_d + i_d) == tac_u->eve_d ); + + req_u->siz_i[i_d] = _disk_serialize_v0(tac_u, &req_u->byt_y[i_d]); + + tac_u = tac_u->nex_u; + } + + return req_u; +} + +/* _disk_commit(): commit all available events, if idle. +*/ +static void +_disk_commit(u3_disk* log_u) +{ + if ( (c3n == log_u->ted_o) + && (log_u->sen_d > log_u->dun_d) ) + { + c3_d len_d = log_u->sen_d - log_u->dun_d; + struct _cd_save* req_u = _disk_batch(log_u, len_d); + +#ifdef VERBOSE_DISK + if ( 1ULL == len_d ) { + fprintf(stderr, "disk: (%" PRIu64 "): commit: request\r\n", + req_u->eve_d); + } + else { + fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: request\r\n", + req_u->eve_d, + (req_u->eve_d + len_d - 1ULL)); + } +#endif + + _disk_commit_start(req_u); + } +} + +/* u3_disk_plan(): enqueue completed event for persistence. +*/ +void +u3_disk_plan(u3_disk* log_u, + c3_d eve_d, + c3_l bug_l, + c3_l mug_l, + u3_noun job) +{ + u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); + tac_u->bug_l = bug_l; + tac_u->mug_l = mug_l; + tac_u->eve_d = eve_d; + tac_u->nex_u = 0; + tac_u->job = job; + + c3_assert( (1ULL + log_u->sen_d) == eve_d ); + log_u->sen_d++; + + if ( !log_u->put_u.ent_u ) { + c3_assert( !log_u->put_u.ext_u ); + log_u->put_u.ent_u = log_u->put_u.ext_u = tac_u; + } + else { + log_u->put_u.ent_u->nex_u = tac_u; + log_u->put_u.ent_u = tac_u; + } + + _disk_commit(log_u); +} + +/* u3_disk_boot_plan(): XX remove, just use u3_disk_plan(). +*/ +void +u3_disk_boot_plan(u3_disk* log_u, u3_noun job) +{ + u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); + tac_u->mug_l = 0; //u3r_mug(job); XX + tac_u->eve_d = ++log_u->sen_d; + tac_u->nex_u = 0; + tac_u->job = job; + + if ( !log_u->put_u.ent_u ) { + c3_assert( !log_u->put_u.ext_u ); + c3_assert( 1ULL == log_u->sen_d ); + + tac_u->bug_l = 0; // XX + log_u->put_u.ent_u = log_u->put_u.ext_u = tac_u; + } + else { + tac_u->bug_l = log_u->put_u.ent_u->mug_l; // XX + log_u->put_u.ent_u->nex_u = tac_u; + log_u->put_u.ent_u = tac_u; + } + +#ifdef VERBOSE_DISK + fprintf(stderr, "disk: (%" PRIu64 "): db boot plan\r\n", tac_u->eve_d); +#endif + + _disk_commit(log_u); +} + +/* _disk_read_done_cb(): finalize read, invoke callback with response. +*/ +static void +_disk_read_done_cb(uv_timer_t* tim_u) +{ + struct _cd_read* red_u = tim_u->data; + u3_disk* log_u = red_u->log_u; + u3_play pay_u = { .ent_u = red_u->ent_u, .ext_u = red_u->ext_u }; + + c3_assert( red_u->ent_u ); + c3_assert( red_u->ext_u ); + + log_u->cb_u.read_done_f(log_u->cb_u.vod_p, pay_u); + c3_free(red_u); + tim_u->data = 0; +} + +/* _disk_read_one_cb(): lmdb read callback, invoked for each event in order +*/ +static c3_o +_disk_read_one_cb(void* vod_p, c3_d eve_d, size_t val_i, void* val_p) +{ + struct _cd_read* red_u = vod_p; + u3_disk* log_u = red_u->log_u; + u3_fact* tac_u = c3_calloc(sizeof(*tac_u)); + tac_u->eve_d = eve_d; + + { + // XX u3m_soft? + // + u3_noun dat = u3ke_cue(u3i_bytes(val_i, val_p)); + u3_noun mug, job; + + if ( (c3n == u3r_cell(dat, &mug, &job)) + || (c3n == u3r_safe_word(mug, &tac_u->bug_l)) ) // XX + { + // failure here triggers cleanup in _disk_read_start_cb() + // + c3_free(tac_u); + u3z(dat); + return c3n; + } + + tac_u->job = u3k(job); + u3z(dat); + } + + if ( !red_u->ent_u ) { + c3_assert( !red_u->ext_u ); + + c3_assert( red_u->eve_d == eve_d ); + // tac_u->mug_l = 0; // XX + red_u->ent_u = red_u->ext_u = tac_u; + } + else { + c3_assert( (1ULL + red_u->ent_u->eve_d) == eve_d ); + // log_u->get_u.ent_u->mug_l = tac_u->bug_l; // XX + red_u->ent_u->nex_u = tac_u; + red_u->ent_u = tac_u; + } + + return c3y; +} + +/* _disk_read_start_cb(): the read from the db, trigger response +*/ +static void +_disk_read_start_cb(uv_timer_t* tim_u) +{ + struct _cd_read* red_u = tim_u->data; + u3_disk* log_u = red_u->log_u; + + + // read events synchronously + // + if ( c3n == c3_lmdb_read(log_u->mdb_u, + red_u, + red_u->eve_d, + red_u->len_d, + _disk_read_one_cb) ) + { + log_u->cb_u.read_bail_f(log_u->cb_u.vod_p, red_u->eve_d); + // XX dispose all facts in red_u + // + c3_free(red_u); + tim_u->data = 0; + return; + } + + // finish the read asynchronously + // + uv_timer_start(&log_u->tim_u, _disk_read_done_cb, 0, 0); +} + +/* u3_disk_read(): read [len_d] events starting at [eve_d]. +*/ +void +u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d) +{ + // XX enqueue [red_u] in [log_u] for cancellation + // + struct _cd_read* red_u = c3_malloc(sizeof(*red_u)); + red_u->log_u = log_u; + red_u->eve_d = eve_d; + red_u->len_d = len_d; + red_u->ent_u = red_u->ext_u = 0; + + // perform the read asynchronously + // + // XX unsafe, queue reads + // + log_u->tim_u.data = red_u; + uv_timer_start(&log_u->tim_u, _disk_read_start_cb, 0, 0); +} + +/* _disk_save_meta(): serialize atom, save as metadata at [key_c]. +*/ +static c3_o +_disk_save_meta(u3_disk* log_u, const c3_c* key_c, u3_atom dat) +{ + u3_atom mat = u3ke_jam(dat); + c3_w len_w = u3r_met(3, mat); + c3_y* byt_y = c3_malloc(len_w); + c3_o ret_o; + + u3r_bytes(0, len_w, byt_y, mat); + + ret_o = c3_lmdb_save_meta(log_u->mdb_u, key_c, len_w, byt_y); + + u3z(mat); + c3_free(byt_y); + + return ret_o; +} + +/* u3_disk_save_meta(): save metadata. +*/ +c3_o +u3_disk_save_meta(u3_disk* log_u, + c3_d who_d[2], + c3_o fak_o, + c3_w lif_w) +{ + c3_assert( c3y == u3a_is_cat(lif_w) ); + + if ( (c3n == _disk_save_meta(log_u, "who", u3i_chubs(2, who_d))) + || (c3n == _disk_save_meta(log_u, "is-fake", fak_o)) + || (c3n == _disk_save_meta(log_u, "life", lif_w)) ) + { + return c3n; + } + + return c3y; +} + +/* _disk_meta_read_cb(): copy [val_p] to atom [vod_p] if present. +*/ +static void +_disk_meta_read_cb(void* vod_p, size_t val_i, void* val_p) +{ + u3_weak* mat = vod_p; + + if ( val_p ) { + *mat = u3i_bytes(val_i, val_p); + } +} + +/* _disk_read_meta(): read metadata at [key_c], deserialize. +*/ +static u3_weak +_disk_read_meta(u3_disk* log_u, const c3_c* key_c) +{ + u3_weak mat = u3_none; + u3_weak dat = u3_none; + u3_noun pro; + + c3_lmdb_read_meta(log_u->mdb_u, &mat, key_c, _disk_meta_read_cb); + + if ( u3_none != mat ) { + pro = u3m_soft(0, u3ke_cue, mat); + + if ( u3_blip != u3h(pro) ) { + fprintf(stderr, "disk: meta cue failed\r\n"); + } + else { + dat = u3k(u3t(pro)); + } + } + + u3z(pro); + return dat; +} + +/* u3_disk_read_meta(): read metadata. +*/ +c3_o +u3_disk_read_meta(u3_disk* log_u, + c3_d* who_d, + c3_o* fak_o, + c3_w* lif_w) +{ + u3_weak who = _disk_read_meta(log_u, "who"); + u3_weak fak = _disk_read_meta(log_u, "is-fake"); + u3_weak lif = _disk_read_meta(log_u, "life"); + + if ( u3_none == who ) { + fprintf(stderr, "disk: read meta: no indentity\r\n"); + return c3n; + } + else if ( u3_none == fak ) { + fprintf(stderr, "disk: read meta: no fake bit\r\n"); + u3z(who); + return c3n; + } + else if ( u3_none == lif ) { + fprintf(stderr, "disk: read meta: no lifecycle length\r\n"); + u3z(who); + return c3n; + } + + if ( !((c3y == fak ) || (c3n == fak )) ) { + fprintf(stderr, "disk: read meta: invalid fake bit\r\n"); + u3z(who); u3z(fak); u3z(lif); + return c3n; + } + else if ( c3n == u3a_is_cat(lif) ) { + fprintf(stderr, "disk: read meta: invalid lifecycle length\r\n"); + u3z(who); u3z(fak); u3z(lif); + return c3n; + } + + if ( who_d ) { + u3r_chubs(0, 2, who_d, who); + } + + if ( fak_o ) { + *fak_o = fak; + } + + if ( lif_w ) { + *lif_w = lif; + } + + u3z(who); + return c3y; +} + +/* u3_disk_exit(): close the log. +*/ +void +u3_disk_exit(u3_disk* log_u) +{ + c3_lmdb_exit(log_u->mdb_u); + // XX dispose + // +} + +/* u3_disk_init(): load or create pier directories and event log. */ u3_disk* u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) { u3_disk* log_u = c3_calloc(sizeof(*log_u)); log_u->liv_o = c3n; - log_u->hol_o = c3n; + log_u->ted_o = c3n; log_u->cb_u = cb_u; uv_timer_init(u3L, &log_u->tim_u); @@ -130,12 +626,12 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) // real in the long term, though. // #ifdef U3_OS_osx - const size_t siz_w = 42949672960; + const size_t siz_i = 42949672960; #else - const size_t siz_w = 64424509440;; + const size_t siz_i = 64424509440;; #endif - if ( 0 == (log_u->mdb_u = c3_lmdb_init(log_c, siz_w)) ) { + if ( 0 == (log_u->mdb_u = c3_lmdb_init(log_c, siz_i)) ) { fprintf(stderr, "disk: failed to initialize database"); c3_free(log_c); c3_free(log_u); @@ -165,462 +661,3 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) return log_u; } - -static void -_disk_meta_read_cb(void* vod_p, size_t val_i, void* val_p) -{ - u3_weak* mat = vod_p; - - if ( val_p ) { - *mat = u3i_bytes(val_i, val_p); - } -} - -static u3_weak -_disk_read_meta(u3_disk* log_u, const c3_c* key_c) -{ - u3_weak mat = u3_none; - - c3_lmdb_read_meta(log_u->mdb_u, &mat, "who", _disk_meta_read_cb); - - if ( u3_none == mat ) { - return u3_none; - } - - { - u3_noun pro = u3m_soft(0, u3ke_cue, mat); - u3_noun tag, dat; - u3x_cell(pro, &tag, &dat); - - if ( u3_blip == tag ) { - u3k(dat); - u3z(pro); - return dat; - } - else { - fprintf(stderr, "disk: meta cue failed\r\n"); - u3z(pro); - return u3_none; - } - } -} - -c3_o -u3_disk_read_header(u3_disk* log_u, c3_d* who_d, c3_o* fak_o, c3_w* lif_w) -{ - u3_weak who = _disk_read_meta(log_u, "who"); - u3_weak fak = _disk_read_meta(log_u, "is-fake"); - u3_weak lif = _disk_read_meta(log_u, "life"); - - if ( u3_none == who ) { - return c3n; - } - else if ( (u3_none == fak) - || (u3_none == lif) ) - { - u3z(who); - return c3n; - } - - if ( (c3n == u3a_is_cat(lif)) - || !((c3y == fak ) || (c3n == fak )) ) - { - u3z(who); u3z(fak); u3z(lif); - return c3n; - } - - if ( who_d ) { - u3r_chubs(0, 2, who_d, who); - } - - if ( fak_o ) { - *fak_o = fak; - } - - if ( lif_w ) { - *lif_w = lif; - } - - u3z(who); - return c3y; -} - -static c3_o -_disk_save_meta(u3_disk* log_u, const c3_c* key_c, u3_atom dat) -{ - u3_atom mat = u3ke_jam(dat); - c3_w len_w = u3r_met(3, mat); - c3_y* byt_y = c3_malloc(len_w); - c3_o ret_o; - - u3r_bytes(0, len_w, byt_y, mat); - - ret_o = c3_lmdb_save_meta(log_u->mdb_u, key_c, len_w, byt_y); - - u3z(mat); - c3_free(byt_y); - - return ret_o; -} - -c3_o -u3_disk_write_header(u3_disk* log_u, c3_d who_d[2], c3_o fak_o, c3_w lif_w) -{ - c3_assert( c3y == u3a_is_cat(lif_w) ); - - if ( (c3n == _disk_save_meta(log_u, "who", u3i_chubs(2, who_d))) - || (c3n == _disk_save_meta(log_u, "is-fake", fak_o)) - || (c3n == _disk_save_meta(log_u, "life", lif_w)) ) - { - // XX dispose? - // - return c3n; - } - - return c3y; -} - -static void -_disk_free_batch(u3_db_batch* bat_u) -{ - while ( bat_u->len_d-- ) { - c3_free(bat_u->byt_p[bat_u->len_d]); - } - - c3_free(bat_u->byt_p); - c3_free(bat_u->siz_i); - c3_free(bat_u); -} - -/* _disk_commit_done(): commit complete. - */ -static void -_disk_commit_done(void* vod_p, c3_o ret_o, u3_db_batch* bat_u) -{ - u3_disk* log_u = vod_p; - c3_d eve_d = bat_u->eve_d; - c3_d len_d = bat_u->len_d; - - if ( c3n == ret_o ) { - log_u->cb_u.write_bail_f(log_u->cb_u.vod_p, eve_d + (len_d - 1ULL)); - -#ifdef VERBOSE_DISK - if ( 1ULL == len_d ) { - fprintf(stderr, "disk: (%" PRIu64 "): commit: failed\r\n", eve_d); - } - else { - fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: failed\r\n", - eve_d, - eve_d + (len_d - 1ULL)); - } -#endif - } - else { - log_u->dun_d = eve_d + (len_d - 1ULL); - log_u->cb_u.write_done_f(log_u->cb_u.vod_p, log_u->dun_d); - -#ifdef VERBOSE_DISK - if ( 1ULL == len_d ) { - fprintf(stderr, "disk: (%" PRIu64 "): commit: complete\r\n", eve_d); - } - else { - fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: complete\r\n", - eve_d, - eve_d + (len_d - 1ULL)); - } -#endif - } - - { - u3_fact* tac_u = log_u->put_u.ext_u; - - while ( tac_u && (tac_u->eve_d <= log_u->dun_d) ) { - log_u->put_u.ext_u = tac_u->nex_u; - u3z(tac_u->job); - c3_free(tac_u); - tac_u = log_u->put_u.ext_u; - } - } - - if ( !log_u->put_u.ext_u ) { - log_u->put_u.ent_u = 0; - } - - _disk_free_batch(bat_u); - - log_u->hol_o = c3n; - _disk_commit(log_u); -} - - - - -/* _disk_commit_after_cb(): Implementation of c3_lmdb_write_event() -** -** This is always run on the main loop thread after the worker thread event -** completes. -*/ -static void -_disk_commit_after_cb(uv_work_t* ted_u, int status) -{ - struct _cd_save* req_u = ted_u->data; - _disk_commit_done(req_u->log_u, req_u->ret_o, req_u->bat_u); - c3_free(req_u); - c3_free(ted_u); -} - -/* _lmdb_write_event_cb(): Implementation of c3_lmdb_write_event() -** -** This is always run on a libuv background worker thread; actual nouns cannot -** be touched here. -*/ -static void -_disk_commit_cb(uv_work_t* ted_u) -{ - struct _cd_save* req_u = ted_u->data; - u3_db_batch* bat_u = req_u->bat_u; - req_u->ret_o = c3_lmdb_save(req_u->log_u->mdb_u, - bat_u->eve_d, - bat_u->len_d, - bat_u->byt_p, - bat_u->siz_i); -} - -/* c3_lmdb_write_event(): Asynchronously writes events to the database. -** -** This writes all the passed in events along with log metadata updates to the -** database as a single transaction on a worker thread. Once the transaction -** is completed, it calls the passed in callback on the main loop thread. -*/ -static void -_disk_commit_start(u3_disk* log_u, u3_db_batch* bat_u) -{ - // structure to pass to the worker thread. - // - struct _cd_save* req_u = c3_malloc(sizeof(*req_u)); - req_u->log_u = log_u; - req_u->bat_u = bat_u; - req_u->ret_o = c3n; - - // queue asynchronous work to happen on another thread - // - uv_work_t* ted_u = c3_malloc(sizeof(*ted_u)); - ted_u->data = req_u; - - uv_queue_work(u3L, ted_u, _disk_commit_cb, - _disk_commit_after_cb); -} - -static void -_disk_commit(u3_disk* log_u) -{ - if ( (c3n == log_u->hol_o) - && (log_u->sen_d > log_u->dun_d) ) - { - c3_d len_d = log_u->sen_d - log_u->dun_d; - u3_fact* tac_u = log_u->put_u.ext_u; - - c3_assert( (1ULL + log_u->dun_d) == tac_u->eve_d ); - c3_assert( log_u->sen_d == log_u->put_u.ent_u->eve_d ); - - u3_db_batch* bat_u = c3_malloc(sizeof(*bat_u)); - bat_u->eve_d = tac_u->eve_d; - bat_u->len_d = len_d; - bat_u->byt_p = c3_malloc(len_d * sizeof(void*)); - bat_u->siz_i = c3_malloc(len_d * sizeof(size_t)); - - for ( c3_d i_d = 0ULL; i_d < len_d; ++i_d) { - c3_assert( (bat_u->eve_d + i_d) == tac_u->eve_d ); - - u3_atom mat = u3ke_jam(u3nc(tac_u->bug_l, u3k(tac_u->job))); - c3_w len_w = u3r_met(3, mat); - c3_y* dat_y = c3_malloc(len_w); - u3r_bytes(0, len_w, dat_y, mat); - - bat_u->byt_p[i_d] = dat_y; - bat_u->siz_i[i_d] = len_w; - - tac_u = tac_u->nex_u; - u3z(mat); - } - -#ifdef VERBOSE_DISK - if ( 1ULL == len_d ) { - fprintf(stderr, "disk: (%" PRIu64 "): commit: request\r\n", - bat_u->eve_d); - } - else { - fprintf(stderr, "disk: (%" PRIu64 "-%" PRIu64 "): commit: request\r\n", - bat_u->eve_d, - (bat_u->eve_d + len_d - 1ULL)); - } -#endif - - _disk_commit_start(log_u, bat_u); - log_u->hol_o = c3y; - } -} - -/* u3_disk_plan(): -*/ -void -u3_disk_plan(u3_disk* log_u, - c3_d eve_d, - c3_l bug_l, - c3_l mug_l, - u3_noun job) -{ - u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); - tac_u->bug_l = bug_l; - tac_u->mug_l = mug_l; - tac_u->eve_d = eve_d; - tac_u->nex_u = 0; - tac_u->job = job; - - c3_assert( (1ULL + log_u->sen_d) == eve_d ); - log_u->sen_d++; - - if ( !log_u->put_u.ent_u ) { - c3_assert( !log_u->put_u.ext_u ); - log_u->put_u.ent_u = log_u->put_u.ext_u = tac_u; - } - else { - log_u->put_u.ent_u->nex_u = tac_u; - log_u->put_u.ent_u = tac_u; - } - - _disk_commit(log_u); -} - -/* u3_disk_boot_plan(): -*/ -void -u3_disk_boot_plan(u3_disk* log_u, u3_noun job) -{ - u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); - tac_u->mug_l = 0; //u3r_mug(job); XX - tac_u->eve_d = ++log_u->sen_d; - tac_u->nex_u = 0; - tac_u->job = job; - - if ( !log_u->put_u.ent_u ) { - c3_assert( !log_u->put_u.ext_u ); - c3_assert( 1ULL == log_u->sen_d ); - - tac_u->bug_l = 0; // XX - log_u->put_u.ent_u = log_u->put_u.ext_u = tac_u; - } - else { - tac_u->bug_l = log_u->put_u.ent_u->mug_l; // XX - log_u->put_u.ent_u->nex_u = tac_u; - log_u->put_u.ent_u = tac_u; - } - -#ifdef VERBOSE_DISK - fprintf(stderr, "disk: (%" PRIu64 "): db boot plan\r\n", tac_u->eve_d); -#endif - - _disk_commit(log_u); -} - -static void -_disk_read_done_cb(uv_timer_t* tim_u) -{ - struct _cd_read* red_u = tim_u->data; - u3_disk* log_u = red_u->log_u; - u3_play pay_u = { - .ent_u = red_u->ent_u, - .ext_u = red_u->ext_u - }; - - c3_assert( red_u->ent_u ); - c3_assert( red_u->ext_u ); - - log_u->cb_u.read_done_f(log_u->cb_u.vod_p, pay_u); - c3_free(red_u); -} - -static c3_o -_disk_read_one_cb(void* vod_p, c3_d eve_d, size_t val_i, void* val_p) -{ - struct _cd_read* red_u = vod_p; - u3_disk* log_u = red_u->log_u; - u3_fact* tac_u = c3_calloc(sizeof(*tac_u)); - tac_u->eve_d = eve_d; - - { - // xx soft? - // - u3_noun dat = u3ke_cue(u3i_bytes(val_i, val_p)); - u3_noun mug, job; - - if ( (c3n == u3r_cell(dat, &mug, &job)) - || (c3n == u3r_safe_word(mug, &tac_u->bug_l)) ) // XX - { - c3_free(tac_u); - // XX dispose get_u; - log_u->cb_u.read_bail_f(log_u->cb_u.vod_p, eve_d); - return c3n; - } - - tac_u->job = u3k(job); - u3z(dat); - } - - if ( !red_u->ent_u ) { - c3_assert( !red_u->ext_u ); - - c3_assert( red_u->eve_d == eve_d ); - // tac_u->mug_l = 0; // XX - red_u->ent_u = red_u->ext_u = tac_u; - } - else { - c3_assert( (1ULL + red_u->ent_u->eve_d) == eve_d ); - // log_u->get_u.ent_u->mug_l = tac_u->bug_l; // XX - red_u->ent_u->nex_u = tac_u; - red_u->ent_u = tac_u; - } - - return c3y; -} - -static void -_disk_read_start_cb(uv_timer_t* tim_u) -{ - struct _cd_read* red_u = tim_u->data; - u3_disk* log_u = red_u->log_u; - - uv_timer_start(&log_u->tim_u, _disk_read_done_cb, 0, 0); - - if ( c3n == c3_lmdb_read(log_u->mdb_u, - red_u, - red_u->eve_d, - red_u->len_d, - _disk_read_one_cb) ) - { - log_u->cb_u.read_bail_f(log_u->cb_u.vod_p, red_u->eve_d); - } -} - -void -u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d) -{ - struct _cd_read* red_u = c3_malloc(sizeof(*red_u)); - red_u->log_u = log_u; - red_u->eve_d = eve_d; - red_u->len_d = len_d; - red_u->ent_u = red_u->ext_u = 0; - - log_u->tim_u.data = red_u; - uv_timer_start(&log_u->tim_u, _disk_read_start_cb, 0, 0); -} - -/* u3_disk_exit(): close the log. -*/ -void -u3_disk_exit(u3_disk* log_u) -{ - c3_lmdb_exit(log_u->mdb_u); - // XX dispose - // -} diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 722b6e638..64b390e78 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -883,10 +883,13 @@ u3_pier_stay(c3_w wag_w, u3_noun pax) { u3_pier* pir_u = _pier_init(wag_w, u3r_string(pax)); - if ( c3n == u3_disk_read_header(pir_u->log_u, pir_u->who_d, - &pir_u->fak_o, &pir_u->lif_w) ) + if ( c3n == u3_disk_read_meta(pir_u->log_u, pir_u->who_d, + &pir_u->fak_o, &pir_u->lif_w) ) { - // xx dispose + fprintf(stderr, "pier: disk read meta fail\r\n"); + // XX dispose + // + u3_pier_bail(); exit(1); } @@ -1018,8 +1021,8 @@ _pier_boot_plan(u3_pier* pir_u, u3_noun who, u3_noun ven, u3_noun pil) pir_u->lif_w = u3qb_lent(bot_u.bot); } - if ( c3n == u3_disk_write_header(pir_u->log_u, pir_u->who_d, - pir_u->fak_o, pir_u->lif_w) ) + if ( c3n == u3_disk_save_meta(pir_u->log_u, pir_u->who_d, + pir_u->fak_o, pir_u->lif_w) ) { // XX dispose bot_u // @@ -1089,8 +1092,10 @@ u3_pier_boot(c3_w wag_w, // config flags u3_pier* pir_u = _pier_init(wag_w, u3r_string(pax)); if ( c3n == _pier_boot_plan(pir_u, who, ven, pil) ) { - // xx dispose + fprintf(stderr, "pier: boot plan fail\r\n"); + // XX dispose // + u3_pier_bail(); exit(1); } From 13ce959539bede974f6e56da60701125b2ff3683 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 22 Apr 2020 22:26:03 -0700 Subject: [PATCH 030/257] vere: refactors lord.c --- pkg/urbit/include/vere/vere.h | 91 ++-- pkg/urbit/vere/lord.c | 756 +++++++++++++++++----------------- 2 files changed, 421 insertions(+), 426 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 95a6f302d..686b87fad 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -307,21 +307,6 @@ /** New pier system. **/ - /* u3_writ: inbound event. - */ - typedef struct _u3_writ { - struct _u3_pier* pir_u; // backpointer to pier - u3_noun job; // (pair date ovum) - c3_d evt_d; // event number - c3_d rep_d; // replacement count - u3_noun now; // event time - c3_l msc_l; // ms to timeout - c3_l mug_l; // hash before executing - u3_atom mat; // jammed [mug_l job], or 0 - u3_noun act; // action list - struct _u3_writ* nex_u; // next in queue, or 0 - } u3_writ; - /* u3_ovum: potential event */ typedef struct _u3_ovum { @@ -372,13 +357,13 @@ u3_noun pat; // path (serialized beam) } u3_peek; - /* u3_rrit: new u3_writ + /* u3_writ: new u3_writ */ - typedef struct _u3_rrit { + typedef struct _u3_writ { struct timeval tim_tv; // time enqueued u3_atom mat; // serialized c3_o sen_o; // sent - struct _u3_rrit* nex_u; // next in queue, or 0 + struct _u3_writ* nex_u; // next in queue, or 0 c3_m typ_m; // tag union { // c3_w xit_w; // exit code @@ -387,7 +372,7 @@ struct _u3_play pay_u; // recompute struct _u3_work* wok_u; // compute }; - } u3_rrit; + } u3_writ; /* u3_lord_cb: u3_lord callbacks */ @@ -425,8 +410,8 @@ c3_d eve_d; // last event completed c3_l mug_l; // mug at eve_d c3_w dep_w; // queue depth - struct _u3_rrit* ent_u; // queue entry - struct _u3_rrit* ext_u; // queue exit + struct _u3_writ* ent_u; // queue entry + struct _u3_writ* ext_u; // queue exit } u3_lord; /* u3_disk_cb: u3_disk callbacks @@ -593,32 +578,6 @@ c3_o u3_auto_live(u3_auto* car_u); - u3_lord* - u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u); - - /* u3_lord_work(); - */ - void - u3_lord_play(u3_lord* god_u, u3_play pay_u); - - /* u3_lord_work(); - */ - void - u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo); - - void - u3_lord_save(u3_lord* god_u, c3_d eve_d); - - /* u3_lord_exit(); - */ - void - u3_lord_exit(u3_lord* god_u, c3_w cod_w); - - /* u3_lord_snap(); - */ - void - u3_lord_snap(u3_lord* god_u, c3_d eve_d); - /* u3_pier_spin(): (re-)activate idle handler */ void @@ -753,6 +712,44 @@ c3_l mug_l, u3_noun job); + /* u3_lord_init(): start serf. + */ + u3_lord* + u3_lord_init(c3_c* pax_c, + c3_w wag_w, + c3_d key_d[4], + u3_lord_cb cb_u); + + /* u3_lord_exit(): shutdown gracefully. + */ + void + u3_lord_exit(u3_lord* god_u, c3_w cod_w); + + /* u3_lord_save(): save portable state. + */ + void + u3_lord_save(u3_lord* god_u, c3_d eve_d); + + /* u3_lord_snap(): take a fast snapshot. + */ + void + u3_lord_snap(u3_lord* god_u, c3_d eve_d); + + /* u3_lord_work(): attempt work. + */ + void + u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo); + + /* u3_lord_play(): recompute batch. + */ + void + u3_lord_play(u3_lord* god_u, u3_play pay_u); + + /* u3_lord_peek(): read. + */ + void + u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun pat); + /** Filesystem (new api). **/ /* u3_walk_load(): load file or bail. diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 92987bb6b..2f34e0ab4 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -53,14 +53,12 @@ -- */ -#undef VERBOSE_LORD - /* _lord_writ_pop(): pop the writ stack */ -static u3_rrit* +static u3_writ* _lord_writ_pop(u3_lord* god_u) { - u3_rrit* wit_u = god_u->ext_u; + u3_writ* wit_u = god_u->ext_u; c3_assert( wit_u ); @@ -79,10 +77,10 @@ _lord_writ_pop(u3_lord* god_u) /* _lord_writ_need(): require mote */ -static u3_rrit* +static u3_writ* _lord_writ_need(u3_lord* god_u, c3_m ned_m) { - u3_rrit* wit_u = _lord_writ_pop(god_u); + u3_writ* wit_u = _lord_writ_pop(god_u); if ( ned_m != wit_u->typ_m ) { fprintf(stderr, "lord: unexpected %%%.4s, expected %%%.4s\r\n", @@ -105,7 +103,7 @@ _lord_on_exit(uv_process_t* req_u, u3_lord* god_u = (void*)req_u; c3_w xit_w; { - u3_rrit* wit_u =_lord_writ_need(god_u, c3__exit); + u3_writ* wit_u =_lord_writ_need(god_u, c3__exit); xit_w = wit_u->xit_w; c3_free(wit_u); } @@ -162,7 +160,7 @@ _lord_plea_foul(u3_lord* god_u, c3_m mot_m, u3_noun dat) static void _lord_plea_live(u3_lord* god_u, u3_noun dat) { - u3_rrit* wit_u = _lord_writ_pop(god_u); + u3_writ* wit_u = _lord_writ_pop(god_u); if( u3_nul != dat ) { return _lord_plea_foul(god_u, c3__live, dat); @@ -174,20 +172,15 @@ _lord_plea_live(u3_lord* god_u, u3_noun dat) (c3_c*)&wit_u->typ_m); u3_pier_bail(); exit(1); - } - c3_assert(!"unreachable"); + } break; case c3__save: { god_u->cb_u.save_f(god_u->cb_u.vod_p, wit_u->eve_d); - break; - } - c3_assert(!"unreachable"); + } break; case c3__snap: { god_u->cb_u.snap_f(god_u->cb_u.vod_p, wit_u->eve_d); - break; - } - c3_assert(!"unreachable"); + } break; } c3_free(wit_u); @@ -227,10 +220,6 @@ _lord_plea_ripe(u3_lord* god_u, u3_noun dat) exit(1); } -#ifdef VERBOSE_LORD - fprintf(stderr, "pier: (%" PRIu64 "): ripe at mug %x\r\n", eve_d, mug_l); -#endif - god_u->eve_d = eve_d; god_u->mug_l = mug_l; god_u->hon_y = hon_y; @@ -243,7 +232,7 @@ _lord_plea_ripe(u3_lord* god_u, u3_noun dat) u3z(dat); } -/* _lord_plea_slog(): hear serf debug output +/* _lord_plea_slog(): hear serf debug output */ static void _lord_plea_slog(u3_lord* god_u, u3_noun dat) @@ -271,7 +260,7 @@ _lord_plea_peek(u3_lord* god_u, u3_noun dat) { u3_peek* pek_u; { - u3_rrit* wit_u = _lord_writ_need(god_u, c3__peek); + u3_writ* wit_u = _lord_writ_need(god_u, c3__peek); pek_u = wit_u->pek_u; c3_free(wit_u); } @@ -279,6 +268,50 @@ _lord_plea_peek(u3_lord* god_u, u3_noun dat) god_u->cb_u.peek_f(god_u->cb_u.vod_p, pek_u->gan, pek_u->pat, dat); } +/* _lord_plea_play_bail(): hear serf %play %bail +*/ +static void +_lord_plea_play_bail(u3_lord* god_u, u3_play pay_u, u3_noun dat) +{ + u3_noun eve, mug, dud; + c3_d eve_d; + c3_l mug_l; + + if ( (c3n == u3r_trel(dat, &eve, &mug, &dud)) + || (c3n == u3r_safe_chub(eve, &eve_d)) + || (c3n == u3r_safe_word(mug, &mug_l)) + || (c3n == u3a_is_cell(dud)) ) + { + return _lord_plea_foul(god_u, c3__play, u3nc(c3__bail, dat)); + } + + god_u->eve_d = (eve_d - 1ULL); + god_u->mug_l = mug_l; + + god_u->cb_u.play_bail_f(god_u->cb_u.vod_p, + pay_u, mug_l, eve_d, u3k(dud)); + + u3z(dat); +} +/* _lord_plea_play_done(): hear serf %play %done +*/ +static void +_lord_plea_play_done(u3_lord* god_u, u3_play pay_u, u3_noun dat) +{ + c3_l mug_l; + + if ( c3n == u3r_safe_word(dat, &mug_l) ) { + return _lord_plea_foul(god_u, c3__play, u3nc(c3__done, dat)); + } + + god_u->eve_d = pay_u.ent_u->eve_d; + god_u->mug_l = mug_l; + + god_u->cb_u.play_done_f(god_u->cb_u.vod_p, pay_u, mug_l); + + u3z(dat); +} + /* _lord_plea_play(): hear serf %play response */ static void @@ -286,7 +319,7 @@ _lord_plea_play(u3_lord* god_u, u3_noun dat) { u3_play pay_u; { - u3_rrit* wit_u = _lord_writ_need(god_u, c3__play); + u3_writ* wit_u = _lord_writ_need(god_u, c3__play); pay_u = wit_u->pay_u; c3_free(wit_u); } @@ -299,45 +332,107 @@ _lord_plea_play(u3_lord* god_u, u3_noun dat) default: { return _lord_plea_foul(god_u, c3__play, dat); } - c3_assert(!"unreachable"); case c3__bail: { - u3_noun eve, mug, dud; - c3_d eve_d; - c3_l mug_l; - - if ( (c3n == u3r_trel(u3t(dat), &eve, &mug, &dud)) - || (c3n == u3r_safe_chub(eve, &eve_d)) - || (c3n == u3r_safe_word(mug, &mug_l)) - || (c3n == u3a_is_cell(dud)) ) - { - return _lord_plea_foul(god_u, c3__play, dat); - } - - god_u->eve_d = (eve_d - 1ULL); - god_u->mug_l = mug_l; - - god_u->cb_u.play_bail_f(god_u->cb_u.vod_p, - pay_u, mug_l, eve_d, u3k(dud)); - break; - } - c3_assert(!"unreachable"); + _lord_plea_play_bail(god_u, pay_u, u3k(u3t(dat))); + } break; case c3__done: { - c3_l mug_l; + _lord_plea_play_done(god_u, pay_u, u3k(u3t(dat))); + } break; + } - if ( c3n == u3r_safe_word(u3t(dat), &mug_l) ) { - return _lord_plea_foul(god_u, c3__play, dat); + u3z(dat); +} + +/* _lord_work_next(): pass along [bug_l] +*/ +static void +_lord_work_next(u3_lord* god_u, c3_l bug_l) +{ + u3_writ* wit_u = god_u->ext_u; + + while ( wit_u ) { + if ( c3__work != wit_u->typ_m ) { + wit_u = wit_u->nex_u; + } + else { + u3_work* nex_u = wit_u->wok_u; + u3_ovum* egg_u = nex_u->egg_u; + + // XX old log hack, remove + // + if ( bug_l ) { + nex_u->bug_l = bug_l; } - - god_u->eve_d = pay_u.ent_u->eve_d; - god_u->mug_l = mug_l; - - god_u->cb_u.play_done_f(god_u->cb_u.vod_p, pay_u, mug_l); break; } - c3_assert(!"unreachable"); } +} + +/* _lord_plea_work_bail(): hear serf %work %bail +*/ +static void +_lord_plea_work_bail(u3_lord* god_u, u3_work* wok_u, u3_noun lud) +{ + _lord_work_next(god_u, wok_u->bug_l); + + god_u->cb_u.work_bail_f(god_u->cb_u.vod_p, wok_u, lud); +} + +/* _lord_plea_work_swap(): hear serf %work %swap +*/ +static void +_lord_plea_work_swap(u3_lord* god_u, u3_work* wok_u, u3_noun dat) +{ + u3_noun eve, mug, job, fec; + c3_d eve_d; + c3_l mug_l; + + if ( (c3n == u3r_qual(dat, &eve, &mug, &job, &fec)) + || (c3n == u3r_safe_chub(eve, &eve_d)) + || (c3n == u3r_safe_word(mug, &mug_l)) + || (c3n == u3a_is_cell(job)) ) + { + return _lord_plea_foul(god_u, c3__work, u3nc(c3__swap, dat)); + } + + wok_u->eve_d = god_u->eve_d = eve_d; + wok_u->mug_l = god_u->mug_l = mug_l; + u3z(wok_u->job); + wok_u->job = u3k(job); + wok_u->act = u3k(fec); + + _lord_work_next(god_u, mug_l); + + god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u, c3y); + + u3z(dat); +} + +/* _lord_plea_work_done(): hear serf %work %done +*/ +static void +_lord_plea_work_done(u3_lord* god_u, u3_work* wok_u, u3_noun dat) +{ + u3_noun eve, mug, fec; + c3_d eve_d; + c3_l mug_l; + + if ( (c3n == u3r_trel(dat, &eve, &mug, &fec)) + || (c3n == u3r_safe_chub(eve, &eve_d)) + || (c3n == u3r_safe_word(mug, &mug_l)) ) + { + return _lord_plea_foul(god_u, c3__work, u3nc(c3__work, dat)); + } + + wok_u->eve_d = god_u->eve_d = eve_d; + wok_u->mug_l = god_u->mug_l = mug_l; + wok_u->act = u3k(fec); + + _lord_work_next(god_u, mug_l); + + god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u, c3n); u3z(dat); } @@ -349,7 +444,7 @@ _lord_plea_work(u3_lord* god_u, u3_noun dat) { u3_work* wok_u; { - u3_rrit* wit_u = _lord_writ_need(god_u, c3__work); + u3_writ* wit_u = _lord_writ_need(god_u, c3__work); wok_u = wit_u->wok_u; c3_free(wit_u); } @@ -361,145 +456,267 @@ _lord_plea_work(u3_lord* god_u, u3_noun dat) switch ( u3h(dat) ) { default: { return _lord_plea_foul(god_u, c3__work, dat); - } - c3_assert(!"unreachable"); + } break; case c3__bail: { - u3_noun lud = u3t(dat); - - if ( god_u->ext_u - && wok_u->bug_l - && ( c3__work == god_u->ext_u->typ_m ) ) - { - god_u->ext_u->wok_u->bug_l = wok_u->bug_l; - } - - god_u->cb_u.work_bail_f(god_u->cb_u.vod_p, wok_u, u3k(lud)); - break; - } - c3_assert(!"unreachable"); + _lord_plea_work_bail(god_u, wok_u, u3k(u3t(dat))); + } break; case c3__swap: { - u3_noun eve, mug, job, fec; - c3_d eve_d; - c3_l mug_l; - - if ( (c3n == u3r_qual(u3t(dat), &eve, &mug, &job, &fec)) - || (c3n == u3r_safe_chub(eve, &eve_d)) - || (c3n == u3r_safe_word(mug, &mug_l)) - || (c3n == u3a_is_cell(job)) ) - { - return _lord_plea_foul(god_u, c3__work, dat); - } - - wok_u->eve_d = god_u->eve_d = eve_d; - wok_u->mug_l = god_u->mug_l = mug_l; - u3z(wok_u->job); - wok_u->job = u3k(job); - wok_u->act = u3k(fec); - - if ( god_u->ext_u && ( c3__work == god_u->ext_u->typ_m ) ) { - god_u->ext_u->wok_u->bug_l = mug_l; - } - - god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u, c3y); - break; - } - c3_assert(!"unreachable"); + _lord_plea_work_swap(god_u, wok_u, u3k(u3t(dat))); + } break; case c3__done: { - u3_noun eve, mug, fec; - c3_d eve_d; - c3_l mug_l; - - if ( (c3n == u3r_trel(u3t(dat), &eve, &mug, &fec)) - || (c3n == u3r_safe_chub(eve, &eve_d)) - || (c3n == u3r_safe_word(mug, &mug_l)) ) - { - return _lord_plea_foul(god_u, c3__work, dat); - } - - wok_u->eve_d = god_u->eve_d = eve_d; - wok_u->mug_l = god_u->mug_l = mug_l; - wok_u->act = u3k(fec); - - if ( god_u->ext_u && ( c3__work == god_u->ext_u->typ_m ) ) { - god_u->ext_u->wok_u->bug_l = mug_l; - } - - god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u, c3n); - break; - } - c3_assert(!"unreachable"); + _lord_plea_work_done(god_u, wok_u, u3k(u3t(dat))); + } break; } u3z(dat); } -/* _lord_poke(): handle subprocess result. +/* _lord_poke(): handle plea from serf. */ static void -_lord_poke(void* vod_p, - u3_noun mat) +_lord_poke(void* vod_p, u3_noun mat) { u3_lord* god_u = vod_p; u3_noun jar = u3ke_cue(mat); u3_noun tag, dat; if ( c3n == u3r_cell(jar, &tag, &dat) ) { - goto error; + return _lord_plea_foul(god_u, u3_blip, jar); } switch ( tag ) { - default: goto error; - - case c3__live: { - _lord_plea_live(god_u, u3k(dat)); - break; + default: { + return _lord_plea_foul(god_u, u3_blip, jar); } - c3_assert(!"unreachable"); - - case c3__ripe: { - _lord_plea_ripe(god_u, u3k(dat)); - break; - } - c3_assert(!"unreachable"); - - case c3__slog: { - _lord_plea_slog(god_u, u3k(dat)); - break; - } - c3_assert(!"unreachable"); - - case c3__peek: { - _lord_plea_peek(god_u, u3k(dat)); - break; - } - c3_assert(!"unreachable"); - - case c3__play: { - _lord_plea_play(god_u, u3k(dat)); - break; - } - c3_assert(!"unreachable"); case c3__work: { _lord_plea_work(god_u, u3k(dat)); - break; - } - c3_assert(!"unreachable"); + } break; + + case c3__peek: { + _lord_plea_peek(god_u, u3k(dat)); + } break; + + case c3__slog: { + _lord_plea_slog(god_u, u3k(dat)); + } break; + + case c3__play: { + _lord_plea_play(god_u, u3k(dat)); + } break; + + case c3__live: { + _lord_plea_live(god_u, u3k(dat)); + } break; + + case c3__ripe: { + _lord_plea_ripe(god_u, u3k(dat)); + } break; } u3z(jar); - return; +} - error: { - u3m_p("jar", jar); - u3z(jar); - _lord_bail(0, "bad jar"); +/* _lord_writ_new(): allocate a new writ. +*/ +static u3_writ* +_lord_writ_new(u3_lord* god_u) +{ + u3_writ* wit_u = c3_calloc(sizeof(*wit_u)); + wit_u->sen_o = c3n; + gettimeofday(&wit_u->tim_tv, 0); + return wit_u; +} + +/* _lord_writ_jam(): serialize writ. +*/ +static void +_lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) +{ + if ( 0 == wit_u->mat ) { + u3_noun msg; + + switch ( wit_u->typ_m ) { + default: c3_assert(0); + + case c3__exit: { + // XX u3_newt_close on send + // + msg = u3nt(c3__live, c3__exit, u3i_words(1, &wit_u->xit_w)); + } break; + + case c3__save: { + if ( !wit_u->eve_d ) { + wit_u->eve_d = god_u->eve_d; + } + + msg = u3nt(c3__live, c3__save, u3i_chubs(1, &wit_u->eve_d)); + } break; + + case c3__snap: { + if ( !wit_u->eve_d ) { + wit_u->eve_d = god_u->eve_d; + } + + msg = u3nt(c3__live, c3__snap, u3i_chubs(1, &wit_u->eve_d)); + } break; + + case c3__peek: { + c3_stub; + } break; + + case c3__play: { + u3_fact* tac_u = wit_u->pay_u.ext_u; + c3_d eve_d = tac_u->eve_d; + u3_noun lit = u3_nul; + + while ( tac_u ) { + lit = u3nc(u3k(tac_u->job), lit); + tac_u = tac_u->nex_u; + } + + msg = u3nt(c3__play, u3i_chubs(1, &eve_d), u3kb_flop(lit)); + } break; + + case c3__work: { + msg = u3nc(c3__work, u3k(wit_u->wok_u->job)); + } break; + } + + wit_u->mat = u3ke_jam(msg); } } +/* _lord_writ_send(): send writ to serf. +*/ +static void +_lord_writ_send(u3_lord* god_u, u3_writ* wit_u) +{ + if ( c3n == wit_u->sen_o ) { + _lord_writ_jam(god_u, wit_u); + u3_newt_write(&god_u->inn_u, wit_u->mat, 0); + wit_u->sen_o = c3y; + wit_u->mat = 0; + + // ignore subprocess error on shutdown + // + if ( c3__exit == wit_u->typ_m ) { + god_u->out_u.bal_f = _lord_bail_noop; + god_u->inn_u.bal_f = _lord_bail_noop; + } + } +} + +/* _lord_writ_plan(): enqueue a writ and send. +*/ +static void +_lord_writ_plan(u3_lord* god_u, u3_writ* wit_u) +{ + if ( !god_u->ent_u ) { + c3_assert( !god_u->ext_u ); + c3_assert( !god_u->dep_w ); + god_u->dep_w = 1; + god_u->ent_u = god_u->ext_u = wit_u; + } + else { + god_u->dep_w++; + god_u->ent_u->nex_u = wit_u; + god_u->ent_u = wit_u; + } + + _lord_writ_send(god_u, wit_u); +} + +/* u3_lord_save(): save portable state. +*/ +void +u3_lord_save(u3_lord* god_u, c3_d eve_d) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__save; + wit_u->eve_d = eve_d; + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_snap(): take a fast snapshot. +*/ +void +u3_lord_snap(u3_lord* god_u, c3_d eve_d) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__snap; + wit_u->eve_d = eve_d; + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_peek(): read. +*/ +void +u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun pat) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__peek; + wit_u->pek_u = c3_malloc(sizeof(*wit_u->pek_u)); + wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_tv); + wit_u->pek_u->gan = gan; + wit_u->pek_u->pat = pat; + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_play(): recompute batch. +*/ +void +u3_lord_play(u3_lord* god_u, u3_play pay_u) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__play; + wit_u->pay_u = pay_u; + + c3_assert( !pay_u.ent_u->nex_u ); + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_work(): attempt work. +*/ +void +u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__work; + wit_u->wok_u = c3_calloc(sizeof(*wit_u->wok_u)); + wit_u->wok_u->egg_u = egg_u; + + { + u3_noun now = u3_time_in_tv(&wit_u->tim_tv); + wit_u->wok_u->job = u3nc(now, ovo); + } + + if ( !god_u->ent_u ) { + wit_u->wok_u->bug_l = god_u->mug_l; + } + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_exit(): shutdown gracefully. +*/ +void +u3_lord_exit(u3_lord* god_u, c3_w cod_w) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_m = c3__exit; + wit_u->xit_w = cod_w; + + _lord_writ_plan(god_u, wit_u); +} + /* u3_lord_init(): instantiate child process. */ u3_lord* @@ -580,222 +797,3 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) } return god_u; } - -/* _lord_writ_new(); -*/ -static u3_rrit* -_lord_writ_new(u3_lord* god_u) -{ - u3_rrit* wit_u = c3_calloc(sizeof(*wit_u)); - wit_u->sen_o = c3n; - wit_u->mat = 0; - wit_u->nex_u = 0; - gettimeofday(&wit_u->tim_tv, 0); - - return wit_u; -} - -/* _lord_writ_jam(); -*/ -static void -_lord_writ_jam(u3_lord* god_u, u3_rrit* wit_u) -{ - if ( 0 == wit_u->mat ) { - u3_noun msg; - - switch ( wit_u->typ_m ) { - default: c3_assert(0); - - case c3__exit: { - // XX u3_newt_close on send - // - msg = u3nt(c3__live, c3__exit, u3i_words(1, &wit_u->xit_w)); - break; - } - c3_assert(!"unreachable"); - - case c3__save: { - if ( !wit_u->eve_d ) { - wit_u->eve_d = god_u->eve_d; - } - -#ifdef VERBOSE_LORD - fprintf(stderr, "lord: (%" PRIu64 "): send save\r\n", wit_u->eve_d); -#endif - - msg = u3nt(c3__live, c3__save, u3i_chubs(1, &wit_u->eve_d)); - break; - } - c3_assert(!"unreachable"); - - case c3__snap: { - if ( !wit_u->eve_d ) { - wit_u->eve_d = god_u->eve_d; - } - -#ifdef VERBOSE_LORD - fprintf(stderr, "lord: (%" PRIu64 "): send save\r\n", wit_u->eve_d); -#endif - - msg = u3nt(c3__live, c3__snap, u3i_chubs(1, &wit_u->eve_d)); - break; - } - c3_assert(!"unreachable"); - - case c3__peek: { - c3_assert(0); - } - c3_assert(!"unreachable"); - - case c3__play: { - u3_fact* tac_u = wit_u->pay_u.ext_u; - c3_d eve_d = tac_u->eve_d; - u3_noun lit = u3_nul; - - while ( tac_u ) { - lit = u3nc(u3k(tac_u->job), lit); - tac_u = tac_u->nex_u; - } - - msg = u3nt(c3__play, u3i_chubs(1, &eve_d), u3kb_flop(lit)); - break; - } - c3_assert(!"unreachable"); - - case c3__work: { - msg = u3nc(c3__work, u3k(wit_u->wok_u->job)); - break; - } - c3_assert(!"unreachable"); - } - - wit_u->mat = u3ke_jam(msg); - } -} - -/* _lord_writ_send(); -*/ -static void -_lord_writ_send(u3_lord* god_u, u3_rrit* wit_u) -{ - if ( c3n == wit_u->sen_o ) { - _lord_writ_jam(god_u, wit_u); - u3_newt_write(&god_u->inn_u, wit_u->mat, 0); - wit_u->sen_o = c3y; - wit_u->mat = 0; - - // ignore subprocess error on shutdown - // - if ( c3__exit == wit_u->typ_m ) { - god_u->out_u.bal_f = _lord_bail_noop; - god_u->inn_u.bal_f = _lord_bail_noop; - } - } -} - -/* _lord_writ_plan(); -*/ -static void -_lord_writ_plan(u3_lord* god_u, u3_rrit* wit_u) -{ - if ( !god_u->ent_u ) { - c3_assert( !god_u->ext_u ); - c3_assert( !god_u->dep_w ); - god_u->dep_w = 1; - god_u->ent_u = god_u->ext_u = wit_u; - } - else { - god_u->dep_w++; - god_u->ent_u->nex_u = wit_u; - god_u->ent_u = wit_u; - } - - _lord_writ_send(god_u, wit_u); -} - -/* u3_lord_exit(); -*/ -void -u3_lord_exit(u3_lord* god_u, c3_w cod_w) -{ - u3_rrit* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__exit; - wit_u->xit_w = cod_w; - - _lord_writ_plan(god_u, wit_u); -} - -/* u3_lord_save(); -*/ -void -u3_lord_save(u3_lord* god_u, c3_d eve_d) -{ - u3_rrit* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__save; - wit_u->eve_d = eve_d; - - _lord_writ_plan(god_u, wit_u); -} - -/* u3_lord_snap(); -*/ -void -u3_lord_snap(u3_lord* god_u, c3_d eve_d) -{ - u3_rrit* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__snap; - wit_u->eve_d = eve_d; - - _lord_writ_plan(god_u, wit_u); -} - -/* u3_lord_peek(); -*/ -void -u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun pat) -{ - u3_rrit* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__peek; - wit_u->pek_u = c3_malloc(sizeof(*wit_u->pek_u)); - wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_tv); - wit_u->pek_u->gan = gan; - wit_u->pek_u->pat = pat; - - _lord_writ_plan(god_u, wit_u); -} - -/* u3_lord_play(); -*/ -void -u3_lord_play(u3_lord* god_u, u3_play pay_u) -{ - u3_rrit* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__play; - wit_u->pay_u = pay_u; - - c3_assert( !pay_u.ent_u->nex_u ); - - _lord_writ_plan(god_u, wit_u); -} - -/* u3_lord_work(); -*/ -void -u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo) -{ - u3_rrit* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__work; - wit_u->wok_u = c3_calloc(sizeof(*wit_u->wok_u)); - wit_u->wok_u->egg_u = egg_u; - - { - u3_noun now = u3_time_in_tv(&wit_u->tim_tv); - wit_u->wok_u->job = u3nc(now, ovo); - } - - if ( !god_u->ent_u ) { - wit_u->wok_u->bug_l = god_u->mug_l; - } - - _lord_writ_plan(god_u, wit_u); -} From 324175de92f783b3410986d902dac94c32fbfc79 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 22 Apr 2020 22:28:19 -0700 Subject: [PATCH 031/257] vere: re-enables event spinner --- pkg/urbit/include/vere/vere.h | 7 +++++- pkg/urbit/vere/auto.c | 6 +++++ pkg/urbit/vere/lord.c | 20 +++++++++++++++- pkg/urbit/vere/pier.c | 18 ++++++++++++++ pkg/urbit/vere/term.c | 45 ++++++++++++++++++++++++++--------- 5 files changed, 83 insertions(+), 13 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 686b87fad..f2bca3025 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -316,6 +316,8 @@ u3_noun tar; // target u3_noun pax; // wire u3_noun fav; // card + u3_atom pin; // spinner label + c3_o del_o; // spinner delay (c3y) struct _u3_ovum* pre_u; // previous ovum struct _u3_ovum* nex_u; // next ovum } u3_ovum; @@ -380,6 +382,8 @@ void* vod_p; void (*live_f)(void*); void (*slog_f)(void*, c3_w, u3_noun); + void (*spin_f)(void*, u3_atom, c3_o); + void (*spun_f)(void*); void (*peek_f)(void*, u3_noun gan, u3_noun pat, u3_noun dat); void (*play_done_f)(void*, u3_play, c3_l mug_l); void (*play_bail_f)(void*, u3_play, c3_l mug_l, c3_d eve_d, u3_noun dud); @@ -405,6 +409,7 @@ c3_d key_d[4]; // image key u3_lord_cb cb_u; // callbacks c3_o liv_o; // live + c3_o pin_o; // spinning c3_y hon_y; // hoon kelvin c3_y noc_y; // hoon kelvin c3_d eve_d; // last event completed @@ -823,7 +828,7 @@ /* u3_term_start_spinner(): prepare spinner state. RETAIN. */ void - u3_term_start_spinner(u3_noun say, c3_o now_o); + u3_term_start_spinner(u3_noun say, c3_o del_o); /* u3_term_stop_spinner(): reset spinner state and restore input line. */ diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index bb090f208..171e83727 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -93,6 +93,11 @@ u3_auto_plan(u3_auto* car_u, egg_u->pax = pax; egg_u->fav = fav; + // spinner defaults + // + egg_u->pin = u3k(u3h(u3t(pax))); + egg_u->del_o = c3y; + if ( !car_u->ent_u ) { c3_assert(!car_u->ext_u); @@ -131,6 +136,7 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) egg_u->car_u->ev.drop_f(egg_u->car_u, egg_u->vod_p); } + u3z(egg_u->pin); u3z(egg_u->tar); u3z(egg_u->pax); u3z(egg_u->fav); diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 2f34e0ab4..3892e5ec0 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -345,13 +345,21 @@ _lord_plea_play(u3_lord* god_u, u3_noun dat) u3z(dat); } -/* _lord_work_next(): pass along [bug_l] +/* _lord_work_next(): update spinner if more work is in progress. */ static void _lord_work_next(u3_lord* god_u, c3_l bug_l) { u3_writ* wit_u = god_u->ext_u; + // complete spinner + // + c3_assert( c3y == god_u->pin_o ); + god_u->cb_u.spun_f(god_u->cb_u.vod_p); + god_u->pin_o = c3n; + + // restart spinner if more work + // while ( wit_u ) { if ( c3__work != wit_u->typ_m ) { wit_u = wit_u->nex_u; @@ -365,6 +373,9 @@ _lord_work_next(u3_lord* god_u, c3_l bug_l) if ( bug_l ) { nex_u->bug_l = bug_l; } + + god_u->cb_u.spin_f(god_u->cb_u.vod_p, egg_u->pin, egg_u->del_o); + god_u->pin_o = c3y; break; } } @@ -702,6 +713,13 @@ u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo) wit_u->wok_u->bug_l = god_u->mug_l; } + // if not spinning, start + // + if ( c3n == god_u->pin_o ) { + god_u->cb_u.spin_f(god_u->cb_u.vod_p, egg_u->pin, egg_u->del_o); + god_u->pin_o = c3y; + } + _lord_writ_plan(god_u, wit_u); } diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 64b390e78..4f2e6e2db 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -501,6 +501,22 @@ _pier_on_lord_play_bail(void* vod_p, u3_play pay_u, u3_pier_bail(); } +/* _pier_on_lord_work_spin(): start spinner +*/ +static void +_pier_on_lord_work_spin(void* vod_p, u3_atom pin, c3_o del_o) +{ + u3_term_start_spinner(pin, c3y); // (c3y == del_o) ? c3n : c3y); +} + +/* _pier_on_lord_work_spin(): stop spinner +*/ +static void +_pier_on_lord_work_spun(void* vod_p) +{ + u3_term_stop_spinner(); +} + /* _pier_on_lord_work_done(): event completion from worker. */ static void @@ -840,6 +856,8 @@ _pier_init(c3_w wag_w, c3_c* pax_c) u3_lord_cb cb_u = { .vod_p = pir_u, .live_f = _pier_on_lord_live, + .spin_f = _pier_on_lord_work_spin, + .spun_f = _pier_on_lord_work_spun, .slog_f = _pier_on_lord_slog, // .peek_f = _pier_on_lord_peek, .play_done_f = _pier_on_lord_play_done, diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index e26fb7bf4..034918017 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -592,10 +592,25 @@ _term_it_save(u3_noun pax, u3_noun pad) c3_free(bas_c); } +static u3_ovum* +_term_ovum_plan(u3_auto* car_u, u3_noun pax, u3_noun fav) +{ + // XX c3__dill instead of u3_blip + // + u3_ovum* egg_u = u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + + // term events have no spinner label + // + u3z(egg_u->pin); + egg_u->pin = u3_blip; + + return egg_u; +} + /* _term_io_belt(): send belt. */ static void -_term_io_belt(u3_utty* uty_u, u3_noun blb) +_term_io_belt(u3_utty* uty_u, u3_noun blb) { // XX s/b u3dc("scot", c3__ud, uty_u->tid_l) // @@ -605,7 +620,15 @@ _term_io_belt(u3_utty* uty_u, u3_noun blb) c3_assert( 1 == uty_u->tid_l ); c3_assert( uty_u->car_u ); - u3_auto_plan(uty_u->car_u, 0, 0, u3_blip, pax, fav); + { + u3_ovum* egg_u = _term_ovum_plan(uty_u->car_u, pax, fav); + + // no spinner delay on %ret + // + if ( c3__ret == u3h(blb) ) { + egg_u->del_o = c3n; + } + } } /* _term_io_suck_char(): process a single character. @@ -814,15 +837,15 @@ _term_spin_timer_cb(uv_timer_t* tim_u) if ( tat_u->sun_u.why_c[0] ) { strncpy(cur_c, dal_c, 2); cur_c += 2; - sol_w += 1; // length of dal_c (utf-32) + sol_w += 1; // length of dal_c (utf-32) strncpy(cur_c, tat_u->sun_u.why_c, 4); cur_c += 4; - sol_w += 4; // XX assumed utf-8 + sol_w += 4; // XX assumed utf-8 strncpy(cur_c, dar_c, 2); cur_c += 2; - sol_w += 1; // length of dar_c (utf-32) + sol_w += 1; // length of dar_c (utf-32) } *cur_c = '\0'; @@ -852,7 +875,7 @@ _term_spin_timer_cb(uv_timer_t* tim_u) /* u3_term_start_spinner(): prepare spinner state. RETAIN. */ void -u3_term_start_spinner(u3_noun say, c3_o now_o) +u3_term_start_spinner(u3_atom say, c3_o del_o) { if ( c3n == u3_Host.ops_u.tem ) { u3_utty* uty_u = _term_main(); @@ -868,7 +891,7 @@ u3_term_start_spinner(u3_noun say, c3_o now_o) { c3_d now_d = _term_msc_out_host(); c3_d end_d = tat_u->sun_u.end_d; - c3_d wen_d = (c3y == now_o) ? 0UL : + c3_d wen_d = (c3n == del_o) ? 0UL : (now_d - end_d < _SPIN_IDLE_US) ? _SPIN_WARM_US : _SPIN_COOL_US; @@ -974,7 +997,7 @@ u3_term_ef_winc(void) c3_assert( 1 == u3_Host.uty_u->tid_l ); c3_assert( u3_Host.uty_u->car_u ); - u3_auto_plan(u3_Host.uty_u->car_u, 0, 0, u3_blip, pax, fav); + _term_ovum_plan(u3_Host.uty_u->car_u, pax, fav); } /* u3_term_ef_ctlc(): send ^C on console. @@ -991,7 +1014,7 @@ u3_term_ef_ctlc(void) c3_assert( 1 == uty_u->tid_l ); c3_assert( uty_u->car_u ); - u3_auto_plan(uty_u->car_u, 0, 0, u3_blip, pax, fav); + _term_ovum_plan(uty_u->car_u, pax, fav); } _term_it_refresh_line(uty_u); @@ -1250,7 +1273,7 @@ _term_io_talk(u3_auto* car_u) // { fav = u3nc(c3__blew, u3_term_get_blew(1)); - u3_auto_plan(car_u, 0, 0, u3_blip, u3k(pax), fav); + _term_ovum_plan(car_u, u3k(pax), fav); } // NB, term.c used to also start :dojo @@ -1261,7 +1284,7 @@ _term_io_talk(u3_auto* car_u) // { fav = u3nc(c3__hail, u3_nul); - u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + _term_ovum_plan(car_u, pax, fav); } } From c1d1f43034c4593f3709e873c1a3a353c41ef937 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 22 Apr 2020 23:51:35 -0700 Subject: [PATCH 032/257] vere: refactors init/boot/play state transitions --- pkg/urbit/vere/pier.c | 78 ++++++++++++++++++++++++++++++------------- 1 file changed, 54 insertions(+), 24 deletions(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 4f2e6e2db..311561dab 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -309,6 +309,45 @@ _pier_play_read(u3_pier* pir_u) } } +/* _pier_play_init(): begin boot/replay +*/ +static void +_pier_play_init(u3_pier* pir_u) +{ + u3_lord* god_u = pir_u->god_u; + u3_disk* log_u = pir_u->log_u; + + c3_assert( log_u->sen_d == log_u->dun_d ); + + switch ( pir_u->sat_e ) { + default: c3_assert(0); + + case u3_peat_init: { + c3_assert( god_u->eve_d <= log_u->dun_d ); + pir_u->sat_e = u3_peat_play; + pir_u->pay_u.sen_d = god_u->eve_d; + + u3l_log("---------------- playback starting ----------------\r\n"); + if ( (1ULL + god_u->eve_d) == log_u->dun_d ) { + u3l_log("pier: replaying event %" PRIu64 "\r\n", log_u->dun_d); + } + else { + u3l_log("pier: replaying events %" PRIu64 "-%" PRIu64 "\r\n", + (1ULL + god_u->eve_d), + log_u->dun_d); + } + + u3_term_start_spinner(c3__play, c3y); + } break; + + case u3_peat_boot: { + c3_assert( !god_u->eve_d ); + u3l_log("---------------- boot starting ----------------\r\n"); + u3_term_start_spinner(c3__boot, c3y); + } break; + } +} + /* _pier_play(): send a batch of events to the worker for log replay. */ static void @@ -321,9 +360,6 @@ _pier_play(u3_pier* pir_u) // wait if we're still committing the boot sequence // c3_assert( u3_peat_boot == pir_u->sat_e ); - // XX - // - u3l_log("pier: play boot\r\n"); } else if ( god_u->eve_d == log_u->dun_d ) { u3l_log("---------------- %s complete ----------------\r\n", @@ -628,39 +664,26 @@ _pier_on_lord_live(void* vod_p) u3_lord* god_u = pir_u->god_u; u3_disk* log_u = pir_u->log_u; + // XX plan kelvin event + // + #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): boot at mug %x\r\n", god_u->eve_d, god_u->mug_l); #endif + c3_assert( god_u->eve_d <= log_u->dun_d ); + if ( log_u->sen_d > log_u->dun_d ) { c3_assert( u3_peat_boot == pir_u->sat_e ); + // will init on _disk_write_done + // } else { c3_assert( (u3_peat_boot == pir_u->sat_e) || (u3_peat_init == pir_u->sat_e) ); - c3_assert( god_u->eve_d <= log_u->dun_d ); - if ( god_u->eve_d < log_u->dun_d ) { - pir_u->sat_e = u3_peat_play; - pir_u->pay_u.sen_d = god_u->eve_d; - - u3l_log("---------------- %s starting ----------------\r\n", - ( u3_peat_boot == pir_u->sat_e ) ? "boot" : "playback"); - - if ( (1ULL + god_u->eve_d) == log_u->dun_d ) { - u3l_log("pier: replaying event %" PRIu64 "\r\n", log_u->dun_d); - } - else { - u3l_log("pier: replaying events %" PRIu64 "-%" PRIu64 "\r\n", - (1ULL + god_u->eve_d), - log_u->dun_d); - } - - { - c3_m mot_m = ( u3_peat_boot == pir_u->sat_e ) ? c3__boot : c3__play; - u3_term_start_spinner(mot_m, c3y); - } + _pier_play_init(pir_u); } else { _pier_work_init(pir_u); @@ -705,6 +728,7 @@ static void _pier_on_disk_write_done(void* vod_p, c3_d eve_d) { u3_pier* pir_u = vod_p; + u3_disk* log_u = pir_u->log_u; #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): db commit: complete\r\n", eve_d); @@ -712,6 +736,12 @@ _pier_on_disk_write_done(void* vod_p, c3_d eve_d) if ( u3_peat_boot == pir_u->sat_e ) { pir_u->wok_u.rel_d = eve_d; + + // wait if we're still committing the boot sequence + // + if ( log_u->sen_d == log_u->dun_d ) { + _pier_play_init(pir_u); + } } else { c3_assert( u3_peat_work == pir_u->sat_e ); From 46dcef2c224157426bce295d4ea76d29d2b57bb1 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 23 Apr 2020 22:29:13 -0700 Subject: [PATCH 033/257] vere: refactors auto.c and i/o driver integrations --- pkg/urbit/include/c/motes.h | 1 + pkg/urbit/include/vere/vere.h | 133 ++++++++------ pkg/urbit/vere/ames.c | 55 +++--- pkg/urbit/vere/auto.c | 327 ++++++++++++++++++++++++---------- pkg/urbit/vere/behn.c | 45 +++-- pkg/urbit/vere/cttp.c | 47 +++-- pkg/urbit/vere/fore.c | 90 ++++++++++ pkg/urbit/vere/hind.c | 109 ++++++++++++ pkg/urbit/vere/http.c | 84 ++++----- pkg/urbit/vere/pier.c | 121 +++---------- pkg/urbit/vere/root.c | 138 -------------- pkg/urbit/vere/term.c | 72 ++++---- pkg/urbit/vere/unix.c | 52 +++--- 13 files changed, 712 insertions(+), 562 deletions(-) create mode 100644 pkg/urbit/vere/fore.c create mode 100644 pkg/urbit/vere/hind.c delete mode 100644 pkg/urbit/vere/root.c diff --git a/pkg/urbit/include/c/motes.h b/pkg/urbit/include/c/motes.h index 7560127e5..516b2d268 100644 --- a/pkg/urbit/include/c/motes.h +++ b/pkg/urbit/include/c/motes.h @@ -365,6 +365,7 @@ # define c3__dumb c3_s4('d','u','m','b') # define c3__dump c3_s4('d','u','m','p') # define c3__dust c3_s4('d','u','s','t') +# define c3__e c3_s1('e') # define c3__earl c3_s4('e','a','r','l') # define c3__east c3_s4('e','a','s','t') # define c3__echo c3_s4('e','c','h','o') diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index f2bca3025..4b4cd1c01 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -314,8 +314,8 @@ void* vod_p; // context c3_l msc_l; // ms to timeout u3_noun tar; // target - u3_noun pax; // wire - u3_noun fav; // card + u3_noun wir; // wire + u3_noun cad; // card u3_atom pin; // spinner label c3_o del_o; // spinner delay (c3y) struct _u3_ovum* pre_u; // previous ovum @@ -480,15 +480,14 @@ c3_o liv_o; struct { void (*talk_f)(struct _u3_auto*); - c3_o (*fete_f)(struct _u3_auto*, u3_noun pax, u3_noun fav); // RETAIN + c3_o (*kick_f)(struct _u3_auto*, u3_noun wir, u3_noun cad); void (*exit_f)(struct _u3_auto*); // XX close_cb? } io; struct { - void (*drop_f)(struct _u3_auto*, void*); - void (*work_f)(struct _u3_auto*, void*); - void (*done_f)(struct _u3_auto*, void*); - void (*swap_f)(struct _u3_auto*, void*); - void (*bail_f)(struct _u3_auto*, void*); + void (*drop_f)(struct _u3_auto*, u3_ovum*); + void (*work_f)(struct _u3_auto*, u3_ovum*); + void (*done_f)(struct _u3_auto*, u3_ovum*, c3_o); + void (*bail_f)(struct _u3_auto*, u3_ovum*, u3_noun); } ev; struct _u3_ovum* ent_u; struct _u3_ovum* ext_u; @@ -542,47 +541,6 @@ uv_timer_t tim_u; // gc timer } u3_daemon; - u3_ovum* - u3_auto_next(u3_auto* car_u, u3_noun* ovo); - - void - u3_auto_fete(u3_auto* car_u, u3_noun act); - - /* u3_auto_init(): initialize all drivers - */ - u3_auto* - u3_auto_init(void); - - /* u3_auto_talk(): start all drivers - */ - void - u3_auto_talk(u3_auto* car_u); - - /* u3_auto_plan(): create and enqueue an ovum - */ - u3_ovum* - u3_auto_plan(u3_auto* car_u, - void* vod_p, - c3_l msc_l, - u3_noun tar, - u3_noun pax, - u3_noun fav); - - /* u3_auto_drop(): dequeue and dispose an ovum. - */ - void - u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u); - - /* u3_auto_exit(): close all drivers - */ - void - u3_auto_exit(u3_auto* car_u); - - /* u3_auto_live(): check if all drivers are live. - */ - c3_o - u3_auto_live(u3_auto* car_u); - /* u3_pier_spin(): (re-)activate idle handler */ void @@ -672,6 +630,70 @@ /** New vere **/ + /* u3_auto_init(): initialize all drivers. + */ + u3_auto* + u3_auto_init(u3_pier* pir_u); + + /* u3_auto_exit(): close all drivers. + */ + void + u3_auto_exit(u3_auto* car_u); + + /* u3_auto_talk(): start all drivers. + */ + void + u3_auto_talk(u3_auto* car_u); + + /* u3_auto_live(): check if all drivers are live. + */ + c3_o + u3_auto_live(u3_auto* car_u); + + /* u3_auto_kick(): route effects to a linked driver. RETAIN + */ + void + u3_auto_kick(u3_auto* car_u, u3_noun act); + + /* u3_auto_next(): select an ovum, dequeue and construct. + */ + u3_ovum* + u3_auto_next(u3_auto* car_u, u3_noun* ovo); + + /* u3_auto_drop(): dequeue and dispose an ovum. + */ + void + u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u); + + /* u3_auto_work(): notify driver of [egg_u] commencement. + */ + void + u3_auto_work(u3_ovum* egg_u); + + /* u3_auto_done(): notify driver of [egg_u] completion. + */ + void + u3_auto_done(u3_ovum* egg_u, c3_o wap_o); + + /* u3_auto_bail(): notify driver that [egg_u] crashed. + */ + void + u3_auto_bail(u3_ovum* egg_u, u3_noun lud); + + /* u3_auto_bail_slog(): print a bail notification. + */ + void + u3_auto_bail_slog(u3_ovum* egg_u, u3_noun lud); + + /* u3_auto_plan(): create and enqueue an ovum. + */ + u3_ovum* + u3_auto_plan(u3_auto* car_u, + c3_l msc_l, + u3_noun tar, + u3_noun wir, + u3_noun cad); + /* u3_disk_init(): load or create pier directories and event log. */ u3_disk* @@ -949,12 +971,19 @@ u3_auto* u3_cttp_io_init(u3_pier* pir_u); - /** Root, grab bag + /** fore, first events **/ - /* u3_root_io_init(): initialize root + /* u3_hind_io_init(): initialize fore */ u3_auto* - u3_root_io_init(u3_pier* pir_u); + u3_fore_io_init(u3_pier* pir_u); + + /** hind, defaults + **/ + /* u3_hind_io_init(): initialize hint + */ + u3_auto* + u3_hind_io_init(u3_pier* pir_u); /** Stream messages. **/ diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/ames.c index 57093b0b2..dd1436b6a 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/ames.c @@ -379,8 +379,8 @@ _ames_recv_cb(uv_udp_t* wax_u, if ( (0 < nrd_i) && (0 == (0x7 & *((c3_w*)buf_u->base))) ) { - u3_noun pax = u3nt(u3_blip, c3__ames, u3_nul); - u3_noun fav; + u3_noun wir = u3nc(c3__ames, u3_nul); + u3_noun cad; { u3_noun msg = u3i_bytes((c3_w)nrd_i, (c3_y*)buf_u->base); @@ -395,10 +395,10 @@ _ames_recv_cb(uv_udp_t* wax_u, lan = u3_ames_encode_lane(lan_u); } - fav = u3nt(c3__hear, u3nc(c3n, lan), msg); + cad = u3nt(c3__hear, u3nc(c3n, lan), msg); } - u3_auto_plan(&sam_u->car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(&sam_u->car_u, 0, c3__a, wir, cad); } c3_free(buf_u->base); @@ -574,17 +574,17 @@ _ames_io_talk(u3_auto* car_u) // send born event // { - u3_noun pax = u3nq(u3_blip, c3__newt, u3k(u3A->sen), u3_nul); - u3_noun fav = u3nc(c3__born, u3_nul); + u3_noun wir = u3nt(c3__newt, u3k(u3A->sen), u3_nul); + u3_noun cad = u3nc(c3__born, u3_nul); - u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(car_u, 0, c3__a, wir, cad); } } -/* _ames_fete_newt(): apply packet network outputs. +/* _ames_kick_newt(): apply packet network outputs. */ static c3_o -_ames_fete_newt(u3_ames* sam_u, u3_noun tag, u3_noun dat) +_ames_kick_newt(u3_ames* sam_u, u3_noun tag, u3_noun dat) { c3_o ret_o; @@ -610,24 +610,23 @@ _ames_fete_newt(u3_ames* sam_u, u3_noun tag, u3_noun dat) return ret_o; } -/* _ames_io_fete(): +/* _ames_io_kick(): apply effects */ static c3_o -_ames_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +_ames_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) { u3_ames* sam_u = (u3_ames*)car_u; - u3_noun i_pax, it_pax, tt_pax, tag, dat; + u3_noun tag, dat, i_wir; c3_o ret_o; - if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, &tt_pax)) - || (c3n == u3r_cell(fav, &tag, &dat)) - || (u3_blip != i_pax ) ) + if ( (c3n == u3r_cell(wir, &i_wir, 0)) + || (c3n == u3r_cell(cad, &tag, &dat)) ) { ret_o = c3n; } else { - switch ( it_pax ) { + switch ( i_wir ) { default: { ret_o = c3n; } break; @@ -635,7 +634,7 @@ _ames_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) // XX should also be c3__ames // case c3__newt: { - ret_o = _ames_fete_newt(sam_u, u3k(tag), u3k(dat)); + ret_o = _ames_kick_newt(sam_u, u3k(tag), u3k(dat)); } break; // XX obsolete @@ -656,13 +655,13 @@ _ames_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) } else { u3l_log("kick: strange send\r\n"); - ret_o = _ames_fete_newt(sam_u, u3k(tag), u3k(dat)); + ret_o = _ames_kick_newt(sam_u, u3k(tag), u3k(dat)); } } break; } } - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return ret_o; } @@ -680,9 +679,14 @@ _ames_io_exit(u3_auto* car_u) } } +/* _ames_ev_bail(): event crashed. +*/ static void -_ames_ev_noop(u3_auto* car_u, void* vod_p) +_ames_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) { + // XX track and print every N? + // + u3_auto_bail_slog(egg_u, lud); } /* u3_ames_io_init(): initialize ames I/O. @@ -715,16 +719,9 @@ u3_ames_io_init(u3_pier* pir_u) car_u->nam_m = c3__ames; car_u->liv_o = c3n; car_u->io.talk_f = _ames_io_talk; - car_u->io.fete_f = _ames_io_fete; + car_u->io.kick_f = _ames_io_kick; car_u->io.exit_f = _ames_io_exit; - - car_u->ev.drop_f = _ames_ev_noop; - car_u->ev.work_f = _ames_ev_noop; - car_u->ev.done_f = _ames_ev_noop; - car_u->ev.swap_f = _ames_ev_noop; - // XX track and print every N? - // - car_u->ev.bail_f = _ames_ev_noop; + car_u->ev.bail_f = _ames_ev_bail; return car_u; diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 171e83727..e81b2b73c 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -19,83 +19,26 @@ #include "all.h" #include "vere/vere.h" -/* u3_auto_init(): initialize all drivers -*/ -u3_auto* -u3_auto_init(void) -{ - // XX initialize i/o drivers here - // - return 0; -} - -/* u3_auto_talk(): start all drivers -*/ -void -u3_auto_talk(u3_auto* car_u) -{ - while ( car_u ) { - car_u->io.talk_f(car_u); - car_u = car_u->nex_u; - } -} - -/* u3_auto_exit(): close all drivers -*/ -void -u3_auto_exit(u3_auto* car_u) -{ - u3_auto* nex_u; - - while ( car_u ) { - nex_u = car_u->nex_u; - - while ( car_u->ext_u ) { - u3_auto_drop(car_u, car_u->ext_u); - } - car_u->io.exit_f(car_u); - - car_u = nex_u; - } -} - -/* u3_auto_live(): check if all drivers are live. -*/ -c3_o -u3_auto_live(u3_auto* car_u) -{ - while ( car_u ) { - if ( c3n == car_u->liv_o ) { - return c3n; - } - - car_u = car_u->nex_u; - } - - return c3y; -} - -/* u3_auto_plan(): create and enqueue an ovum +/* u3_auto_plan(): create and enqueue an ovum. */ u3_ovum* u3_auto_plan(u3_auto* car_u, - void* vod_p, c3_l msc_l, u3_noun tar, - u3_noun pax, - u3_noun fav) + u3_noun wir, + u3_noun cad) { u3_ovum* egg_u = c3_malloc(sizeof(*egg_u)); egg_u->car_u = car_u; - egg_u->vod_p = vod_p; + egg_u->vod_p = 0; egg_u->msc_l = msc_l; egg_u->tar = tar; - egg_u->pax = pax; - egg_u->fav = fav; + egg_u->wir = wir; + egg_u->cad = cad; // spinner defaults // - egg_u->pin = u3k(u3h(u3t(pax))); + egg_u->pin = u3k(u3h(wir)); egg_u->del_o = c3y; if ( !car_u->ent_u ) { @@ -117,6 +60,106 @@ u3_auto_plan(u3_auto* car_u, return egg_u; } +/* u3_auto_bail_slog(): print a bail notification. +*/ +void +u3_auto_bail_slog(u3_ovum* egg_u, u3_noun lud) +{ + c3_c* car_c = u3r_string(egg_u->car_u->nam_m); + u3_noun dul = lud; + + while ( u3_nul != dul ) { + c3_c* mot_c; + u3_noun mot, tan; + + u3x_cell(u3h(dul), &mot, &tan); + + u3l_log("\n"); + u3_pier_punt(0, u3qb_flop(tan)); + + mot_c = u3r_string(mot); + u3l_log("%s: bail: %%%s\r\n", car_c, mot_c); + + dul = u3t(dul); + c3_free(mot_c); + } + + { + c3_c* tag_c = u3r_string(u3h(egg_u->cad)); + u3_noun riw = u3do("spat", u3k(egg_u->wir)); + c3_c* wir_c = u3r_string(riw); + + u3l_log("%s: %%%s event on %s failed\r\n\n", car_c, tag_c, wir_c); + c3_free(tag_c); + c3_free(wir_c); + u3z(riw); + } + + u3z(lud); + c3_free(car_c); +} + +/* u3_auto_bail(): notify driver that [egg_u] crashed. +*/ +void +u3_auto_bail(u3_ovum* egg_u, u3_noun lud) +{ + { + c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); + egg_u->car_u->ev.bail_f(egg_u->car_u, egg_u, lud); + u3a_lop(cod_l); + } + + // XX confirm + // + u3_auto_drop(0, egg_u); +} + +/* u3_auto_done(): notify driver of [egg_u] completion. +*/ +void +u3_auto_done(u3_ovum* egg_u, c3_o wap_o) +{ + // optional + // + if ( egg_u->car_u->ev.done_f ) { + c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); + egg_u->car_u->ev.done_f(egg_u->car_u, egg_u, wap_o); + u3a_lop(cod_l); + } + + // XX dispose egg_u here? + // +} + +/* u3_auto_work(): notify driver of [egg_u] commencement. +*/ +void +u3_auto_work(u3_ovum* egg_u) +{ + // optional + // + if ( egg_u->car_u->ev.work_f ) { + c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); + egg_u->car_u->ev.work_f(egg_u->car_u, egg_u); + u3a_lop(cod_l); + } +} + +/* _auto_drop(): notify driver of dropped ovum. +*/ +static void +_auto_drop(u3_ovum* egg_u) +{ + // optional + // + if ( egg_u->car_u->ev.drop_f ) { + c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); + egg_u->car_u->ev.drop_f(egg_u->car_u, egg_u->vod_p); + u3a_lop(cod_l); + } +} + /* u3_auto_drop(): dequeue and dispose an ovum. */ void @@ -133,26 +176,28 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) // notify driver if not self-caused // if ( egg_u->car_u && ( car_u != egg_u->car_u ) ) { - egg_u->car_u->ev.drop_f(egg_u->car_u, egg_u->vod_p); + _auto_drop(egg_u); } u3z(egg_u->pin); u3z(egg_u->tar); - u3z(egg_u->pax); - u3z(egg_u->fav); + u3z(egg_u->wir); + u3z(egg_u->cad); c3_free(egg_u); } -/* u3_auto_next(): select an ovum and dequeue. +/* u3_auto_next(): select an ovum, dequeue and construct. */ u3_ovum* u3_auto_next(u3_auto* car_u, u3_noun* ovo) { - u3_ovum* egg_u = 0; - while ( car_u ) { - if ( car_u->ext_u ) { - egg_u = car_u->ext_u; + if ( !car_u->ext_u ) { + car_u = car_u->nex_u; + continue; + } + else { + u3_ovum* egg_u = car_u->ext_u; c3_assert( !egg_u->pre_u ); @@ -166,27 +211,26 @@ u3_auto_next(u3_auto* car_u, u3_noun* ovo) egg_u->nex_u = 0; - // XX better name? - // - egg_u->car_u->ev.work_f(egg_u->car_u, egg_u->vod_p); + u3_auto_work(egg_u); // XX cons [tar] route onto wire // - *ovo = u3nc(u3k(egg_u->pax), u3k(egg_u->fav)); + // *ovo = u3nt(u3nc(u3k(egg_u->tar), u3k(egg_u->wir)), + // u3k(egg_u->cad)); + *ovo = u3nc(u3nc(u3_blip, u3k(egg_u->wir)), + u3k(egg_u->cad)); return egg_u; } - - car_u = car_u->nex_u; } - return egg_u; + return 0; } -/* _auto_fete_lost(): RETAIN +/* _auto_kick_lost(): print details of unroutable effect. RETAIN */ static void -_auto_fete_lost(u3_noun pax, u3_noun fav) +_auto_kick_lost(u3_noun pax, u3_noun fav) { u3_noun tox = u3do("spat", u3k(pax)); c3_c* tag_c = u3r_string(u3h(fav)); @@ -199,25 +243,38 @@ _auto_fete_lost(u3_noun pax, u3_noun fav) u3z(tox); } -/* u3_auto_fete(): route effects to a linked driver +/* _auto_kick(): kick with leak label. +*/ +static c3_o +_auto_kick(u3_auto* car_u, u3_noun pax, u3_noun fav) +{ + c3_l cod_l = u3a_lush(car_u->nam_m); + c3_o kik_o = car_u->io.kick_f(car_u, pax, fav); + u3a_lop(cod_l); + return kik_o; +} + +/* u3_auto_kick(): route effects to a linked driver. RETAIN */ void -u3_auto_fete(u3_auto* car_u, u3_noun act) +u3_auto_kick(u3_auto* car_u, u3_noun act) { - u3_noun pax, fav, fec; u3_auto* rac_u = car_u; + u3_noun fec, pax, wir, cad; while ( u3_nul != act ) { fec = u3h(act); - u3x_cell(fec, &pax, &fav); + u3x_cell(fec, &pax, &cad); + u3_assent(u3r_p(pax, u3_blip, &wir)); - while ( c3n == car_u->io.fete_f(car_u, u3k(pax), u3k(fav)) ) { - if ( !car_u->nex_u ) { - _auto_fete_lost(pax, fav); - break; + while ( c3n == _auto_kick(car_u, u3k(wir), u3k(cad)) ) { + if ( car_u->nex_u ) { + car_u = car_u->nex_u; + continue; } else { - car_u = car_u->nex_u; + _auto_kick_lost(wir, cad); + break; } } @@ -225,3 +282,93 @@ u3_auto_fete(u3_auto* car_u, u3_noun act) act = u3t(act); } } + +/* u3_auto_live(): check if all drivers are live. +*/ +c3_o +u3_auto_live(u3_auto* car_u) +{ + while ( car_u ) { + if ( c3n == car_u->liv_o ) { + return c3n; + } + + car_u = car_u->nex_u; + } + + return c3y; +} + +/* u3_auto_talk(): start all drivers. +*/ +void +u3_auto_talk(u3_auto* car_u) +{ + c3_l cod_l; + + while ( car_u ) { + cod_l = u3a_lush(car_u->nam_m); + car_u->io.talk_f(car_u); + u3a_lop(cod_l); + car_u = car_u->nex_u; + } +} + +/* u3_auto_exit(): close all drivers. +*/ +void +u3_auto_exit(u3_auto* car_u) +{ + u3_auto* nex_u; + c3_l cod_l; + + while ( car_u ) { + nex_u = car_u->nex_u; + + // while ( car_u->ext_u ) { + // u3_auto_drop(car_u, car_u->ext_u); + // } + + cod_l = u3a_lush(car_u->nam_m); + car_u->io.exit_f(car_u); + u3a_lop(cod_l); + + car_u = nex_u; + } +} + +/* _auto_link(): validate and link initalized [car_u] +*/ +static u3_auto* +_auto_link(u3_auto* car_u, u3_pier* pir_u, u3_auto* nex_u) +{ + // assert required callbacks are present + // + c3_assert( car_u->io.talk_f ); + c3_assert( car_u->io.kick_f ); + c3_assert( car_u->io.exit_f ); + c3_assert( car_u->ev.bail_f ); + + car_u->pir_u = pir_u; + car_u->nex_u = nex_u; + return car_u; +} + +/* u3_auto_init(): initialize all drivers. +*/ +u3_auto* +u3_auto_init(u3_pier* pir_u) +{ + u3_auto* car_u = 0; + + car_u = _auto_link(u3_hind_io_init(pir_u), pir_u, car_u); + car_u = _auto_link(u3_ames_io_init(pir_u), pir_u, car_u); + car_u = _auto_link(u3_http_io_init(pir_u), pir_u, car_u); + car_u = _auto_link(u3_cttp_io_init(pir_u), pir_u, car_u); + car_u = _auto_link(u3_behn_io_init(pir_u), pir_u, car_u); + car_u = _auto_link(u3_unix_io_init(pir_u), pir_u, car_u); + car_u = _auto_link(u3_term_io_init(pir_u), pir_u, car_u); + car_u = _auto_link(u3_fore_io_init(pir_u), pir_u, car_u); + + return car_u; +} diff --git a/pkg/urbit/vere/behn.c b/pkg/urbit/vere/behn.c index 45f589fd3..f4f881b0e 100644 --- a/pkg/urbit/vere/behn.c +++ b/pkg/urbit/vere/behn.c @@ -46,10 +46,10 @@ _behn_time_cb(uv_timer_t* tim_u) // send timer event // { - u3_noun pax = u3nt(u3_blip, c3__behn, u3_nul); - u3_noun fav = u3nc(c3__wake, u3_nul); + u3_noun wir = u3nc(c3__behn, u3_nul); + u3_noun cad = u3nc(c3__wake, u3_nul); - u3_auto_plan(&teh_u->car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(&teh_u->car_u, 0, c3__b, wir, cad); } } @@ -91,26 +91,25 @@ _behn_io_talk(u3_auto* car_u) { // XX remove u3A->sen // - u3_noun pax = u3nq(u3_blip, c3__behn, u3k(u3A->sen), u3_nul); - u3_noun fav = u3nc(c3__born, u3_nul); + u3_noun wir = u3nt(c3__behn, u3k(u3A->sen), u3_nul); + u3_noun cad = u3nc(c3__born, u3_nul); - u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(car_u, 0, c3__b, wir, cad); } -/* _behn_io_fete(): +/* _behn_io_kick(): apply effects. */ static c3_o -_behn_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +_behn_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) { u3_behn* teh_u = (u3_behn*)car_u; - u3_noun i_pax, it_pax, tag, dat; + u3_noun tag, dat, i_wir; c3_o ret_o; - if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, 0)) - || (c3n == u3r_cell(fav, &tag, &dat)) - || (u3_blip != i_pax ) - || (c3__behn != it_pax) ) + if ( (c3n == u3r_cell(wir, &i_wir, 0)) + || (c3n == u3r_cell(cad, &tag, &dat)) + || (c3__behn != i_wir) ) { ret_o = c3n; } @@ -119,7 +118,7 @@ _behn_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) _behn_ef_doze(teh_u, u3k(dat)); } - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return ret_o; } @@ -141,9 +140,14 @@ _behn_io_exit(u3_auto* car_u) uv_close((uv_handle_t*)&teh_u->tim_u, (uv_close_cb)_behn_exit_cb); } +/* _behn_ev_bail(): event crashed. +*/ static void -_behn_ev_noop(u3_auto* car_u, void* vod_p) +_behn_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) { + // XX retry up to N? + // + u3_auto_bail_slog(egg_u, lud); } /* u3_behn(): initialize time timer. @@ -163,16 +167,9 @@ u3_behn_io_init(u3_pier* pir_u) // car_u->liv_o = c3n; car_u->io.talk_f = _behn_io_talk; - car_u->io.fete_f = _behn_io_fete; + car_u->io.kick_f = _behn_io_kick; car_u->io.exit_f = _behn_io_exit; - - car_u->ev.drop_f = _behn_ev_noop; - car_u->ev.work_f = _behn_ev_noop; - car_u->ev.done_f = _behn_ev_noop; - car_u->ev.swap_f = _behn_ev_noop; - // XX important - // - car_u->ev.bail_f = _behn_ev_noop; + car_u->ev.bail_f = _behn_ev_bail; return car_u; } diff --git a/pkg/urbit/vere/cttp.c b/pkg/urbit/vere/cttp.c index 92125b983..14a649b32 100644 --- a/pkg/urbit/vere/cttp.c +++ b/pkg/urbit/vere/cttp.c @@ -760,14 +760,14 @@ _cttp_creq_quit(u3_creq* ceq_u) static void _cttp_http_client_receive(u3_creq* ceq_u, c3_w sas_w, u3_noun mes, u3_noun uct) { - // TODO: We want to eventually deal with partial responses, but I don't know - // how to get that working right now. - u3_noun pax = u3nq(u3_blip, u3i_string("http-client"), u3k(u3A->sen), u3_nul); - u3_noun fav = u3nt(u3i_string("receive"), + // XX inject partial responses as separate events + // + u3_noun wir = u3nt(u3i_string("http-client"), u3k(u3A->sen), u3_nul); + u3_noun cad = u3nt(u3i_string("receive"), ceq_u->num_l, u3nq(u3i_string("start"), u3nc(sas_w, mes), uct, c3y)); - u3_auto_plan(&ceq_u->ctp_u->car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(&ceq_u->ctp_u->car_u, 0, c3__i, wir, cad); } /* _cttp_creq_fail(): dispatch error response @@ -1063,26 +1063,25 @@ _cttp_io_talk(u3_auto* car_u) { // XX remove u3A->sen // - u3_noun pax = u3nq(u3_blip, u3i_string("http-client"), u3k(u3A->sen), u3_nul); - u3_noun fav = u3nc(c3__born, u3_nul); + u3_noun wir = u3nt(u3i_string("http-client"), u3k(u3A->sen), u3_nul); + u3_noun cad = u3nc(c3__born, u3_nul); - u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(car_u, 0, c3__i, wir, cad); } -/* _cttp_io_fete(): +/* _cttp_io_kick(): apply effects */ static c3_o -_cttp_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +_cttp_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) { u3_cttp* ctp_u = (u3_cttp*)car_u; - u3_noun i_pax, it_pax, tag, dat; + u3_noun tag, dat, i_wir; c3_o ret_o; - if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, 0)) - || (c3n == u3r_cell(fav, &tag, &dat)) - || (u3_blip != i_pax ) - || (c3n == u3r_sing_c("http-client", it_pax)) ) + if ( (c3n == u3r_cell(wir, &i_wir, 0)) + || (c3n == u3r_cell(cad, &tag, &dat)) + || (c3n == u3r_sing_c("http-client", i_wir)) ) { ret_o = c3n; } @@ -1090,7 +1089,7 @@ _cttp_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) ret_o = _cttp_ef_http_client(ctp_u, u3k(tag), u3k(dat)); } - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return ret_o; } @@ -1121,9 +1120,14 @@ _cttp_io_exit(u3_auto* car_u) // } +/* _cttp_ev_bail(): event crashed. +*/ static void -_cttp_ev_noop(u3_auto* car_u, void* vod_p) +_cttp_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) { + // XX retry up to N? + // + u3_auto_bail_slog(egg_u, lud); } /* u3_cttp_io_init(): initialize http client I/O. @@ -1153,14 +1157,9 @@ u3_cttp_io_init(u3_pier* pir_u) // car_u->liv_o = c3n; car_u->io.talk_f = _cttp_io_talk; - car_u->io.fete_f = _cttp_io_fete; + car_u->io.kick_f = _cttp_io_kick; car_u->io.exit_f = _cttp_io_exit; - - car_u->ev.drop_f = _cttp_ev_noop; - car_u->ev.work_f = _cttp_ev_noop; - car_u->ev.done_f = _cttp_ev_noop; - car_u->ev.swap_f = _cttp_ev_noop; - car_u->ev.bail_f = _cttp_ev_noop; + car_u->ev.bail_f = _cttp_ev_bail; return car_u; } diff --git a/pkg/urbit/vere/fore.c b/pkg/urbit/vere/fore.c new file mode 100644 index 000000000..4811bdd1d --- /dev/null +++ b/pkg/urbit/vere/fore.c @@ -0,0 +1,90 @@ +/* vere/root.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* _fore_io_talk(): +*/ +static void +_fore_io_talk(u3_auto* car_u) +{ + u3_noun wir, cad; + + // inject fresh entropy + // + { + c3_w eny_w[16]; + c3_rand(eny_w); + + wir = u3nc(c3__arvo, u3_nul); + cad = u3nc(c3__wack, u3i_words(16, eny_w)); + + u3_auto_plan(car_u, 0, u3_blip, wir, cad); + } + + // set verbose as per -v + // + // XX should be explicit, not a toggle + // + if ( c3y == u3_Host.ops_u.veb ) { + // XX this path shouldn't be necessary + // + wir = u3nt(c3__term, '1', u3_nul); + cad = u3nc(c3__verb, u3_nul); + + u3_auto_plan(car_u, 0, u3_blip, wir, cad); + } +} + +/* _fore_io_kick(): handle no effects. +*/ +static c3_o +_fore_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) +{ + u3z(wir); u3z(cad); + return c3n; +} + +/* _fore_io_exit(): +*/ +static void +_fore_io_exit(u3_auto* car_u) +{ +} + +/* _fore_ev_bail(): event crashed. +*/ +static void +_fore_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) +{ + // XX retry up to N? + // + u3_auto_bail_slog(egg_u, lud); +} + +/* u3_fore_io_init(): initialize fore +*/ +u3_auto* +u3_fore_io_init(u3_pier* pir_u) +{ + u3_auto* car_u = c3_calloc(sizeof(*car_u)); + car_u->nam_m = c3__fore; + car_u->liv_o = c3n; + car_u->io.talk_f = _fore_io_talk; + car_u->io.kick_f = _fore_io_kick; + car_u->io.exit_f = _fore_io_exit; + car_u->ev.bail_f = _fore_ev_bail; + + return car_u; +} diff --git a/pkg/urbit/vere/hind.c b/pkg/urbit/vere/hind.c new file mode 100644 index 000000000..ada6f38b5 --- /dev/null +++ b/pkg/urbit/vere/hind.c @@ -0,0 +1,109 @@ +/* vere/root.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* _hind_io_talk(): +*/ +static void +_hind_io_talk(u3_auto* car_u) +{ +} + +/* _hind_io_kick(): handle generic effects, by tag +*/ +static c3_o +_hind_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) +{ + u3_noun tag, dat; + c3_o ret_o; + + if ( c3n == u3r_cell(cad, &tag, &dat) ) { + ret_o = c3n; + } + else { + switch ( tag ) { + default: { + ret_o = c3n; + } break; + + case c3__exit: { + ret_o = c3y; + u3l_log("<<>>\n"); + u3_pier_exit(car_u->pir_u); + } break; + + // XX fake effect, check //arvo wire? + // + case c3__trim: { + ret_o = c3y; + u3_auto_plan(car_u, 0, u3_blip, u3k(wir), u3k(cad)); + } + + case c3__vega: { + ret_o = c3y; + u3l_log("<<>>\n"); + } break; + } + } + + u3z(wir); u3z(cad); + return ret_o; +} + +/* _hind_io_exit(): +*/ +static void +_hind_io_exit(u3_auto* car_u) +{ + // XX moveme + // + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_exit(car_u->pir_u); + u3a_lop(cod_l); +} + +/* _hind_ev_bail(): event crashed. +*/ +static void +_hind_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) +{ + // XX retry up to N? + // + u3_auto_bail_slog(egg_u, lud); +} + +/* u3_hind_io_init(): +*/ +u3_auto* +u3_hind_io_init(u3_pier* pir_u) +{ + u3_auto* car_u = c3_calloc(sizeof(*car_u)); + car_u->nam_m = c3__hind; + car_u->liv_o = c3n; + car_u->io.talk_f = _hind_io_talk; + car_u->io.kick_f = _hind_io_kick; + car_u->io.exit_f = _hind_io_exit; + car_u->ev.bail_f = _hind_ev_bail; + + // XX moveme + // + { + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_init(pir_u); + u3a_lop(cod_l); + } + + return car_u; +} diff --git a/pkg/urbit/vere/http.c b/pkg/urbit/vere/http.c index 8b5ef7615..0bdda52ce 100644 --- a/pkg/urbit/vere/http.c +++ b/pkg/urbit/vere/http.c @@ -372,10 +372,10 @@ _http_req_unlink(u3_hreq* req_u) static u3_noun _http_req_to_duct(u3_hreq* req_u) { - return u3nt(u3_blip, u3i_string("http-server"), - u3nq(u3dc("scot", c3_s2('u','v'), req_u->hon_u->htp_u->sev_l), - u3dc("scot", c3_s2('u','d'), req_u->hon_u->coq_l), - u3dc("scot", c3_s2('u','d'), req_u->seq_l), + return u3nc(u3i_string("http-server"), + u3nq(u3dc("scot", c3__uv, req_u->hon_u->htp_u->sev_l), + u3dc("scot", c3__ud, req_u->hon_u->coq_l), + u3dc("scot", c3__ud, req_u->seq_l), u3_nul)); } @@ -385,10 +385,10 @@ static void _http_req_kill(u3_hreq* req_u) { u3_httd* htd_u = req_u->hon_u->htp_u->htd_u; - u3_noun pax = _http_req_to_duct(req_u); - u3_noun fav = u3nc(u3i_string("cancel-request"), u3_nul); + u3_noun wir = _http_req_to_duct(req_u); + u3_noun cad = u3nc(u3i_string("cancel-request"), u3_nul); - u3_auto_plan(&htd_u->car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(&htd_u->car_u, 0, c3__e, wir, cad); } typedef struct _u3_hgen { @@ -467,8 +467,8 @@ _http_req_dispatch(u3_hreq* req_u, u3_noun req) { u3_http* htp_u = req_u->hon_u->htp_u; u3_httd* htd_u = htp_u->htd_u; - u3_noun pax = _http_req_to_duct(req_u); - u3_noun fav; + u3_noun wir = _http_req_to_duct(req_u); + u3_noun cad; { u3_noun adr = u3nc(c3__ipv4, u3i_words(1, &req_u->hon_u->ipf_w)); @@ -476,12 +476,12 @@ _http_req_dispatch(u3_hreq* req_u, u3_noun req) // u3_noun dat = u3nt(htp_u->sec, adr, req); - fav = ( c3y == req_u->hon_u->htp_u->lop ) + cad = ( c3y == req_u->hon_u->htp_u->lop ) ? u3nc(u3i_string("request-local"), dat) : u3nc(u3i_string("request"), dat); } - u3_auto_plan(&htd_u->car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(&htd_u->car_u, 0, c3__e, wir, cad); } } @@ -1607,13 +1607,10 @@ _http_serv_start_all(u3_httd* htd_u) // XX remove [sen] // - u3_noun pax = u3nq(u3_blip, - u3i_string("http-server"), - u3k(u3A->sen), - u3_nul); - u3_noun fav = u3nt(c3__live, non, sec); + u3_noun wir = u3nt(u3i_string("http-server"), u3k(u3A->sen), u3_nul); + u3_noun cad = u3nt(c3__live, non, sec); - u3_auto_plan(&htd_u->car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(&htd_u->car_u, 0, c3__e, wir, cad); } _http_write_ports_file(htd_u, u3_Host.dir_c); @@ -1732,11 +1729,10 @@ _http_io_talk(u3_auto* car_u) { // XX remove u3A->sen // - u3_noun pax = u3nq(u3_blip, u3i_string("http-server"), - u3k(u3A->sen), u3_nul); - u3_noun fav = u3nc(c3__born, u3_nul); + u3_noun wir = u3nt(u3i_string("http-server"), u3k(u3A->sen), u3_nul); + u3_noun cad = u3nc(c3__born, u3_nul); - u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(car_u, 0, c3__e, wir, cad); // XX set liv_o on done/swap? // @@ -1844,28 +1840,27 @@ _reck_lily(u3_noun fot, u3_noun txt, c3_l* tid_l) } } -/* _http_io_fete(): +/* _http_io_kick(): apply effects. */ static c3_o -_http_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +_http_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) { u3_httd* htd_u = (u3_httd*)car_u; - u3_noun i_pax, it_pax, tt_pax, tag, dat; + u3_noun tag, dat, i_wir, t_wir; - if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, &tt_pax)) - || (c3n == u3r_cell(fav, &tag, &dat)) - || (u3_blip != i_pax ) - || (c3n == u3r_sing_c("http-server", it_pax)) ) + if ( (c3n == u3r_cell(wir, &i_wir, &t_wir)) + || (c3n == u3r_cell(cad, &tag, &dat)) + || (c3n == u3r_sing_c("http-server", i_wir)) ) { - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return c3n; } - // XX this needs to be rewritten, defers in cases it should not + // XX this needs to be rewritten, it defers (c3n) in cases it should not // { - u3_noun pud = tt_pax; + u3_noun pud = t_wir; u3_noun p_pud, t_pud, tt_pud, q_pud, r_pud, s_pud; c3_l sev_l, coq_l, seq_l; @@ -1873,7 +1868,7 @@ _http_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) if ( (c3n == u3r_cell(pud, &p_pud, &t_pud)) || (c3n == _reck_lily(c3__uv, u3k(p_pud), &sev_l)) ) { - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return c3n; } @@ -1884,7 +1879,7 @@ _http_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) if ( (c3n == u3r_cell(t_pud, &q_pud, &tt_pud)) || (c3n == _reck_lily(c3__ud, u3k(q_pud), &coq_l)) ) { - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return c3n; } @@ -1895,14 +1890,14 @@ _http_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) (u3_nul != s_pud) || (c3n == _reck_lily(c3__ud, u3k(r_pud), &seq_l)) ) { - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return c3n; } } } _http_ef_http_server(htd_u, sev_l, coq_l, seq_l, u3k(tag), u3k(dat)); - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return c3y; } } @@ -1931,12 +1926,16 @@ _http_io_exit(u3_auto* car_u) _http_release_ports_file(u3_Host.dir_c); } +/* _http_ev_bail(): event crashed. +*/ static void -_http_ev_noop(u3_auto* car_u, void* vod_p) +_http_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) { + // XX retry up to N? + // + u3_auto_bail_slog(egg_u, lud); } - /* u3_http_io_init(): initialize http I/O. */ u3_auto* @@ -1948,14 +1947,9 @@ u3_http_io_init(u3_pier* pir_u) car_u->nam_m = c3__http; car_u->liv_o = c3n; car_u->io.talk_f = _http_io_talk; - car_u->io.fete_f = _http_io_fete; + car_u->io.kick_f = _http_io_kick; car_u->io.exit_f = _http_io_exit; - - car_u->ev.drop_f = _http_ev_noop; - car_u->ev.work_f = _http_ev_noop; - car_u->ev.done_f = _http_ev_noop; - car_u->ev.swap_f = _http_ev_noop; - car_u->ev.bail_f = _http_ev_noop; + car_u->ev.bail_f = _http_ev_bail; return car_u; -} \ No newline at end of file +} diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 311561dab..2f8932a05 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -140,10 +140,10 @@ _pier_work_next(u3_pier* pir_u) } } -/* _pier_work_fete(): apply effects. +/* _pier_work_kick(): apply effects. */ static void -_pier_work_fete(u3_pier* pir_u) +_pier_work_kick(u3_pier* pir_u) { u3_work* wok_u; @@ -151,12 +151,14 @@ _pier_work_fete(u3_pier* pir_u) #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", wok_u->eve_d); #endif - u3_auto_fete(pir_u->car_u, wok_u->act); + u3_auto_kick(pir_u->car_u, wok_u->act); if ( wok_u->egg_u ) { - u3_auto_drop(wok_u->egg_u->car_u, wok_u->egg_u); + u3_auto_drop(0, wok_u->egg_u); } + // XX dispose properly + // c3_free(wok_u); } } @@ -177,7 +179,7 @@ _pier_work(u3_pier* pir_u) } _pier_work_send(pir_u); - _pier_work_fete(pir_u); + _pier_work_kick(pir_u); } /* _pier_play_plan(): enqueue events for replay. @@ -444,7 +446,7 @@ _pier_next(u3_pier* pir_u) } case u3_peat_done: { - _pier_work_fete(pir_u); + _pier_work_kick(pir_u); break; } @@ -560,22 +562,14 @@ _pier_on_lord_work_done(void* vod_p, u3_work* wok_u, c3_o wap_o) { u3_pier* pir_u = vod_p; - { - u3_ovum* egg_u = wok_u->egg_u; - - if ( egg_u ) { - if ( c3y == wap_o ) { - egg_u->car_u->ev.swap_f(egg_u->car_u, egg_u->vod_p); - } - else { - egg_u->car_u->ev.done_f(egg_u->car_u, egg_u->vod_p); - } - } - } +#ifdef VERBOSE_PIER + fprintf(stderr, "pier (%" PRIu64 "): work: %s\r\n", + wok_u->eve_d, + ( c3y == wap_o ) ? "swap" : "done"); +#endif + u3_auto_done(wok_u->egg_u, wap_o); _pier_work_plan(pir_u, wok_u); - - _pier_next(pir_u); } @@ -586,20 +580,15 @@ _pier_on_lord_work_bail(void* vod_p, u3_work* wok_u, u3_noun lud) { u3_pier* pir_u = vod_p; - { - u3_ovum* egg_u = wok_u->egg_u; - - if ( egg_u ) { - egg_u->car_u->ev.bail_f(egg_u->car_u, egg_u->vod_p); - } - } - - // XX print lud - // XX dispose - // +#ifdef VERBOSE_PIER fprintf(stderr, "pier: work: bail\r\n"); - u3m_p("wir", u3h(u3t(wok_u->job))); - u3m_p("tag", u3h(u3t(u3t(wok_u->job)))); +#endif + + u3_auto_bail(wok_u->egg_u, lud); + + // XX dispose wok_u + // + wok_u->egg_u = 0; _pier_next(pir_u); } @@ -1228,71 +1217,7 @@ _pier_loop_init(u3_pier* pir_u) // u3v_numb(); - // XX move to u3_auto_init(pir_u->car_u); - // - - u3_auto* car_u; - u3_auto** las_u = &car_u; - - // XX this should be the first to work, but last to route effects and eit - // - { - u3_auto* rac_u = u3_root_io_init(pir_u); - rac_u->pir_u = pir_u; - - *las_u = rac_u; - las_u = &rac_u->nex_u; - } - - { - u3_auto* rac_u = u3_term_io_init(pir_u); - rac_u->pir_u = pir_u; - - *las_u = rac_u; - las_u = &rac_u->nex_u; - } - - { - u3_auto* rac_u = u3_unix_io_init(pir_u); - rac_u->pir_u = pir_u; - - *las_u = rac_u; - las_u = &rac_u->nex_u; - } - - { - u3_auto* rac_u = u3_behn_io_init(pir_u); - rac_u->pir_u = pir_u; - - *las_u = rac_u; - las_u = &rac_u->nex_u; - } - - { - u3_auto* rac_u = u3_cttp_io_init(pir_u); - rac_u->pir_u = pir_u; - - *las_u = rac_u; - las_u = &rac_u->nex_u; - } - - { - u3_auto* rac_u = u3_http_io_init(pir_u); - rac_u->pir_u = pir_u; - - *las_u = rac_u; - las_u = &rac_u->nex_u; - } - - { - u3_auto* rac_u = u3_ames_io_init(pir_u); - rac_u->pir_u = pir_u; - - *las_u = rac_u; - las_u = &rac_u->nex_u; - } - - return car_u; + return u3_auto_init(pir_u); } /* c3_rand(): fill a 512-bit (16-word) buffer. diff --git a/pkg/urbit/vere/root.c b/pkg/urbit/vere/root.c deleted file mode 100644 index 0c07a3104..000000000 --- a/pkg/urbit/vere/root.c +++ /dev/null @@ -1,138 +0,0 @@ -/* vere/root.c -** -*/ -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "all.h" -#include "vere/vere.h" - -/* _root_io_talk(): -*/ -static void -_root_io_talk(u3_auto* car_u) -{ - u3_noun pax, fav; - - // inject fresh entropy - // - { - c3_w eny_w[16]; - c3_rand(eny_w); - - pax = u3nt(u3_blip, c3__arvo, u3_nul); - fav = u3nc(c3__wack, u3i_words(16, eny_w)); - - u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); - } - - // set verbose as per -v - // - // XX should be explicit, not a toggle - // - if ( c3y == u3_Host.ops_u.veb ) { - // XX this path shouldn't be necessary - // - pax = u3nq(u3_blip, c3__term, '1', u3_nul); - fav = u3nc(c3__verb, u3_nul); - - u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); - } -} - -/* _root_io_fete(): -*/ -static c3_o -_root_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) -{ - u3_noun i_pax, tag, dat; - c3_o ret_o; - - if ( (c3n == u3r_cell(pax, &i_pax, 0)) - || (c3n == u3r_cell(fav, &tag, &dat)) - || (u3_blip != i_pax ) ) - { - ret_o = c3n; - } - else { - switch ( tag ) { - default: { - ret_o = c3n; - } break; - - case c3__exit: { - ret_o = c3y; - u3l_log("<<>>\n"); - u3_pier_exit(car_u->pir_u); - } break; - - // XX fake effect, check //arvo wire? - // - case c3__trim: { - ret_o = c3y; - u3_auto_plan(car_u, 0, 0, u3_blip, u3k(pax), u3k(fav)); - } - - case c3__vega: { - ret_o = c3y; - u3l_log("<<>>\n"); - } break; - } - } - - u3z(pax); u3z(fav); - return ret_o; -} - -/* _root_io_exit(): -*/ -static void -_root_io_exit(u3_auto* car_u) -{ - // XX moveme - // - c3_l cod_l = u3a_lush(c3__save); - u3_save_io_exit(car_u->pir_u); - u3a_lop(cod_l); -} - -static void -_root_ev_noop(u3_auto* car_u, void* vod_p) -{ -} - -/* u3_root_io_init(): -*/ -u3_auto* -u3_root_io_init(u3_pier* pir_u) -{ - u3_auto* car_u = c3_calloc(sizeof(*car_u)); - car_u->nam_m = c3__root; - car_u->liv_o = c3n; - car_u->io.talk_f = _root_io_talk; - car_u->io.fete_f = _root_io_fete; - car_u->io.exit_f = _root_io_exit; - - car_u->ev.drop_f = _root_ev_noop; - car_u->ev.work_f = _root_ev_noop; - car_u->ev.done_f = _root_ev_noop; - car_u->ev.swap_f = _root_ev_noop; - car_u->ev.bail_f = _root_ev_noop; - - // XX moveme - // - { - c3_l cod_l = u3a_lush(c3__save); - u3_save_io_init(pir_u); - u3a_lop(cod_l); - } - - return car_u; -} diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 034918017..2ec76e18d 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -592,12 +592,14 @@ _term_it_save(u3_noun pax, u3_noun pad) c3_free(bas_c); } +/* _term_ovum_plan(): plan term ovums, configuring spinner. +*/ static u3_ovum* -_term_ovum_plan(u3_auto* car_u, u3_noun pax, u3_noun fav) +_term_ovum_plan(u3_auto* car_u, u3_noun wir, u3_noun cad) { // XX c3__dill instead of u3_blip // - u3_ovum* egg_u = u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + u3_ovum* egg_u = u3_auto_plan(car_u, 0, c3__d, wir, cad); // term events have no spinner label // @@ -614,14 +616,14 @@ _term_io_belt(u3_utty* uty_u, u3_noun blb) { // XX s/b u3dc("scot", c3__ud, uty_u->tid_l) // - u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); - u3_noun fav = u3nc(c3__belt, blb); + u3_noun wir = u3nt(c3__term, '1', u3_nul); + u3_noun cad = u3nc(c3__belt, blb); c3_assert( 1 == uty_u->tid_l ); c3_assert( uty_u->car_u ); { - u3_ovum* egg_u = _term_ovum_plan(uty_u->car_u, pax, fav); + u3_ovum* egg_u = _term_ovum_plan(uty_u->car_u, wir, cad); // no spinner delay on %ret // @@ -991,13 +993,13 @@ u3_term_get_blew(c3_l tid_l) void u3_term_ef_winc(void) { - u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); - u3_noun fav = u3nc(c3__blew, u3_term_get_blew(1)); + u3_noun wir = u3nt(c3__term, '1', u3_nul); + u3_noun cad = u3nc(c3__blew, u3_term_get_blew(1)); c3_assert( 1 == u3_Host.uty_u->tid_l ); c3_assert( u3_Host.uty_u->car_u ); - _term_ovum_plan(u3_Host.uty_u->car_u, pax, fav); + _term_ovum_plan(u3_Host.uty_u->car_u, wir, cad); } /* u3_term_ef_ctlc(): send ^C on console. @@ -1008,13 +1010,13 @@ u3_term_ef_ctlc(void) u3_utty* uty_u = _term_main(); { - u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); - u3_noun fav = u3nt(c3__belt, c3__ctl, 'c'); + u3_noun wir = u3nt(c3__term, '1', u3_nul); + u3_noun cad = u3nt(c3__belt, c3__ctl, 'c'); c3_assert( 1 == uty_u->tid_l ); c3_assert( uty_u->car_u ); - _term_ovum_plan(uty_u->car_u, pax, fav); + _term_ovum_plan(uty_u->car_u, wir, cad); } _term_it_refresh_line(uty_u); @@ -1266,14 +1268,14 @@ _term_io_talk(u3_auto* car_u) // XX groace hardcoded terminal number // - u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); - u3_noun fav; + u3_noun wir = u3nt(c3__term, '1', u3_nul); + u3_noun cad; // send terminal dimensions // { - fav = u3nc(c3__blew, u3_term_get_blew(1)); - _term_ovum_plan(car_u, u3k(pax), fav); + cad = u3nc(c3__blew, u3_term_get_blew(1)); + _term_ovum_plan(car_u, u3k(wir), cad); } // NB, term.c used to also start :dojo @@ -1283,8 +1285,8 @@ _term_io_talk(u3_auto* car_u) // refresh terminal state // { - fav = u3nc(c3__hail, u3_nul); - _term_ovum_plan(car_u, pax, fav); + cad = u3nc(c3__hail, u3_nul); + _term_ovum_plan(car_u, wir, cad); } } @@ -1309,23 +1311,22 @@ _reck_orchid(u3_noun fot, u3_noun txt, c3_l* tid_l) } } -/* _term_io_fete(): +/* _term_io_kick(): apply effects. */ static c3_o -_term_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +_term_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) { - u3_noun i_pax, it_pax, tt_pax, tag, dat; + u3_noun tag, dat, i_wir, t_wir; c3_o ret_o; - if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, &tt_pax)) - || (c3n == u3r_cell(fav, &tag, &dat)) - || (u3_blip != i_pax ) - || (c3__term != it_pax) ) + if ( (c3n == u3r_cell(wir, &i_wir, &t_wir)) + || (c3n == u3r_cell(cad, &tag, &dat)) + || (c3__term != i_wir) ) { ret_o = c3n; } else { - u3_noun pud = tt_pax; + u3_noun pud = t_wir; u3_noun p_pud, q_pud; c3_l tid_l; @@ -1407,7 +1408,7 @@ _term_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) } } - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return ret_o; } @@ -1422,9 +1423,12 @@ _term_io_exit(u3_auto* car_u) } } +/* _term_ev_bail(): event crashed. +*/ static void -_term_ev_noop(u3_auto* car_u, void* vod_p) +_term_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) { + u3_auto_bail_slog(egg_u, lud); } /* u3_term_io_init(): initialize terminal @@ -1434,21 +1438,15 @@ u3_term_io_init(u3_pier* pir_u) { u3_auto* car_u = c3_calloc(sizeof(*car_u)); - if ( u3_Host.uty_u ) { - u3_Host.uty_u->car_u = car_u; - } + c3_assert( u3_Host.uty_u ); + u3_Host.uty_u->car_u = car_u; car_u->nam_m = c3__term; car_u->liv_o = c3n; car_u->io.talk_f = _term_io_talk; - car_u->io.fete_f = _term_io_fete; + car_u->io.kick_f = _term_io_kick; car_u->io.exit_f = _term_io_exit; - - car_u->ev.drop_f = _term_ev_noop; - car_u->ev.work_f = _term_ev_noop; - car_u->ev.done_f = _term_ev_noop; - car_u->ev.swap_f = _term_ev_noop; - car_u->ev.bail_f = _term_ev_noop; + car_u->ev.bail_f = _term_ev_bail; return car_u; } diff --git a/pkg/urbit/vere/unix.c b/pkg/urbit/vere/unix.c index 0fee14cdc..e62cc9f5b 100644 --- a/pkg/urbit/vere/unix.c +++ b/pkg/urbit/vere/unix.c @@ -956,11 +956,12 @@ _unix_update_mount(u3_unix* unx_u, u3_umon* mon_u, u3_noun all) } { + // XX remove u3A->sen + // + u3_noun wir = u3nt(c3__sync, u3k(u3A->sen), u3_nul); + u3_noun cad = u3nq(c3__into, u3i_string(mon_u->nam_c), all, can); - u3_noun pax = u3nq(u3_blip, c3__sync, u3k(u3A->sen), u3_nul); - u3_noun fav = u3nq(c3__into, u3i_string(mon_u->nam_c), all, can); - - u3_auto_plan(&unx_u->car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(&unx_u->car_u, 0, c3__c, wir, cad); } } } @@ -1371,28 +1372,29 @@ u3_unix_ef_look(u3_unix* unx_u, u3_noun all) static void _unix_io_talk(u3_auto* car_u) { - u3_noun pax = u3nt(u3_blip, c3__boat, u3_nul); - u3_noun fav = u3nc(c3__boat, u3_nul); + // XX review wire + // + u3_noun wir = u3nc(c3__boat, u3_nul); + u3_noun cad = u3nc(c3__boat, u3_nul); - u3_auto_plan(car_u, 0, 0, u3_blip, pax, fav); + u3_auto_plan(car_u, 0, c3__c, wir, cad); } -/* _unix_io_fete(): +/* _unix_io_kick(): apply effects. */ static c3_o -_unix_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) +_unix_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) { u3_unix* unx_u = (u3_unix*)car_u; - u3_noun i_pax, it_pax, tag, dat; + u3_noun tag, dat, i_wir; c3_o ret_o; - if ( (c3n == u3r_trel(pax, &i_pax, &it_pax, 0)) - || (c3n == u3r_cell(fav, &tag, &dat)) - || (u3_blip != i_pax ) - || ( (c3__clay != it_pax) - && (c3__boat != it_pax) - && (c3__sync != it_pax) ) ) + if ( (c3n == u3r_cell(wir, &i_wir, 0)) + || (c3n == u3r_cell(cad, &tag, &dat)) + || ( (c3__clay != i_wir) + && (c3__boat != i_wir) + && (c3__sync != i_wir) ) ) { ret_o = c3n; } @@ -1427,7 +1429,7 @@ _unix_io_fete(u3_auto* car_u, u3_noun pax, u3_noun fav) } } - u3z(pax); u3z(fav); + u3z(wir); u3z(cad); return ret_o; } @@ -1446,9 +1448,14 @@ _unix_io_exit(u3_auto* car_u) c3_free(unx_u); } +/* _unix_ev_bail(): event crashed. +*/ static void -_unix_ev_noop(u3_auto* car_u, void* vod_p) +_unix_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) { + // XX wat do + // + u3_auto_bail_slog(egg_u, lud); } /* u3_unix_io_init(): initialize unix sync. @@ -1470,14 +1477,9 @@ u3_unix_io_init(u3_pier* pir_u) car_u->nam_m = c3__unix; car_u->liv_o = c3n; car_u->io.talk_f = _unix_io_talk; - car_u->io.fete_f = _unix_io_fete; + car_u->io.kick_f = _unix_io_kick; car_u->io.exit_f = _unix_io_exit; - - car_u->ev.drop_f = _unix_ev_noop; - car_u->ev.work_f = _unix_ev_noop; - car_u->ev.done_f = _unix_ev_noop; - car_u->ev.swap_f = _unix_ev_noop; - car_u->ev.bail_f = _unix_ev_noop; + car_u->ev.bail_f = _unix_ev_bail; return car_u; } From a3f85f8086fc3633b4261154cfadbafd0b4c4c00 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 23 Apr 2020 23:25:00 -0700 Subject: [PATCH 034/257] arvo: fixes +solid boot sequence --- pkg/arvo/gen/solid.hoon | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) diff --git a/pkg/arvo/gen/solid.hoon b/pkg/arvo/gen/solid.hoon index 762f211e2..7a26757ef 100644 --- a/pkg/arvo/gen/solid.hoon +++ b/pkg/arvo/gen/solid.hoon @@ -69,13 +69,37 @@ |= [ovo=ovum ken=*] [~ (slum ken [now ovo])] :: -:: our boot-ova is a list containing one massive formula: +:: boot-one: lifecycle formula (from +brass) +:: +=/ boot-one + => [boot-formula=** full-sequence=**] + != =+ [state-gate main-sequence]=.*(full-sequence boot-formula) + |- + ?@ main-sequence + state-gate + %= $ + main-sequence +.main-sequence + state-gate .*(state-gate [%9 2 %10 [6 %1 -.main-sequence] %0 1]) + == +:: +:: kernel-formula :: :: We evaluate :arvo-formula (for jet registration), -:: then ignore the result and produce :installed +:: then ignore the result and produce .installed +:: +=/ kernel-formula + [%7 arvo-formula %1 installed] +:: +:: boot-two: startup formula +:: +=/ boot-two + => [kernel-formula=** main-sequence=**] + != [.*(0 kernel-formula) main-sequence] +:: +:: boot-ova :: =/ boot-ova=(list) - [[%7 arvo-formula %1 installed] ~] + [boot-one boot-two kernel-formula ~] :: :: a pill is a 3-tuple of event-lists: [boot kernel userspace] :: From 723f271ac62cf8d21addb4e11fb3c8765f468378 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sun, 26 Apr 2020 19:36:19 -0700 Subject: [PATCH 035/257] WIP solid pill --- bin/solid.pill | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/solid.pill b/bin/solid.pill index bdddad801..95a51662b 100644 --- a/bin/solid.pill +++ b/bin/solid.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:bc9be816d013b7ec9a68897e548a2ee8a0d26267f982eac59474eba1db35f0d6 -size 13103410 +oid sha256:f39f6f1c7de1bca5710731ca11664771280a54b72c61192a1416c9ea23b25e16 +size 13036410 From b77da3b0f180bd116515977521cb95ac3efe5628 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 23 Apr 2020 23:24:10 -0700 Subject: [PATCH 036/257] vere: WIP moar serf refactoring, leaks appear fixed --- pkg/urbit/include/noun/vortex.h | 5 + pkg/urbit/noun/vortex.c | 10 +- pkg/urbit/worker/serf.c | 293 ++++++++++++++++++-------------- 3 files changed, 176 insertions(+), 132 deletions(-) diff --git a/pkg/urbit/include/noun/vortex.h b/pkg/urbit/include/noun/vortex.h index ba0593f9e..c1f1e7270 100644 --- a/pkg/urbit/include/noun/vortex.h +++ b/pkg/urbit/include/noun/vortex.h @@ -34,6 +34,11 @@ /** Functions. **/ + /* u3v_life(): execute initial lifecycle, producing Arvo core. + */ + u3_noun + u3v_life(u3_noun eve); + /* u3v_boot(): evaluate boot sequence, making a kernel */ c3_o diff --git a/pkg/urbit/noun/vortex.c b/pkg/urbit/noun/vortex.c index 8bb1bae0e..e10c19af3 100644 --- a/pkg/urbit/noun/vortex.c +++ b/pkg/urbit/noun/vortex.c @@ -8,10 +8,10 @@ #define _CVX_POKE 47 #define _CVX_PEEK 46 -/* _cv_life(): execute initial lifecycle, producing Arvo core. +/* u3v_life(): execute initial lifecycle, producing Arvo core. */ -static u3_noun -_cv_life(u3_noun eve) +u3_noun +u3v_life(u3_noun eve) { u3_noun lyf = u3nt(2, u3nc(0, 3), u3nc(0, 2)); u3_noun gat = u3n_nock_on(eve, lyf); @@ -31,7 +31,7 @@ u3v_boot(u3_noun eve) u3A->roc = 0; { - u3_noun pro = u3m_soft(0, _cv_life, eve); + u3_noun pro = u3m_soft(0, u3v_life, eve); if ( u3_blip != u3h(pro) ) { u3z(pro); @@ -56,7 +56,7 @@ _cv_lite(u3_noun pil) u3x_trel(arv, &eve, 0, 0); u3l_log("lite: arvo formula %x\r\n", u3r_mug(arv)); - pro = _cv_life(u3k(eve)); + pro = u3v_life(u3k(eve)); u3l_log("lite: core %x\r\n", u3r_mug(pro)); u3z(arv); diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 9f8d9b956..b045b8b09 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -379,6 +379,7 @@ _serf_sure_post(void) { if ( c3y == u3V.rec_o ) { u3m_reclaim(); + u3V.rec_o = c3n; } // XX this runs on replay too @@ -387,6 +388,7 @@ _serf_sure_post(void) if ( c3y == u3V.pac_o ) { _serf_pack(); + u3V.pac_o = c3n; } } @@ -528,38 +530,41 @@ _serf_poke_time(c3_d evt_d, c3_c* txt_c, struct timeval b4) } #endif -/* _serf_work(): apply event, capture effects. +static u3_noun +_serf_make_crud(u3_noun job, u3_noun dud) +{ + u3_noun now, ovo, wir, cad, new; + u3x_cell(job, &now, &ovo); + u3x_cell(ovo, &wir, &cad); + + new = u3nt(u3i_vint(u3k(now)), u3k(wir), u3nt(c3__crud, dud, u3k(cad))); + u3z(job); + return new; +} + +/* _serf_poke(): RETAIN */ static u3_noun -_serf_work(u3_noun job) +_serf_poke(u3_noun job, c3_c* cap_c) { - u3_noun now, ovo, gon, last_date; - c3_w pre_w = u3a_open(u3R); - - // %work must be performed against an extant kernel - // - c3_assert( 0 != u3V.mug_l); - - // event numbers must be continuous (see [%live %walk @]) - // - c3_assert( u3V.sen_d == u3V.dun_d); - u3V.sen_d++; - + u3_noun now, ovo, wen, gon; u3x_cell(job, &now, &ovo); - last_date = u3A->now; - u3A->now = u3k(now); + wen = u3A->now; + u3A->now = u3k(now); #ifdef U3_EVENT_TIME_DEBUG struct timeval b4; - c3_t bug_t = c3__belt != u3h(u3t(ovo)); + c3_t bug_t = ( (c3__belt != u3h(u3t(ovo))) + || ( (c3__crud == u3h(u3t(ovo))) + && (c3__belt != u3h(u3t(u3t(u3t(ovo))))) )); c3_c* txt_c = 0; if ( bug_t ) { gettimeofday(&b4, 0); txt_c = u3r_string(u3h(u3t(ovo))); - u3l_log("serf: work (%" PRIu64 ") %s\r\n", txt_c, u3V.sen_d); + u3l_log("serf: %s (%" PRIu64 ") %s\r\n", cap_c, u3V.sen_d, txt_c); } #endif @@ -572,6 +577,36 @@ _serf_work(u3_noun job) } #endif + if ( u3_blip != u3h(gon) ) { + u3z(u3A->now); + u3A->now = wen; + } + else { + u3z(wen); + } + + return gon; +} + +/* _serf_work(): apply event, capture effects. +*/ +static u3_noun +_serf_work(u3_noun job) +{ + u3_noun gon; + c3_w pre_w = u3a_open(u3R); + + // %work must be performed against an extant kernel + // + c3_assert( 0 != u3V.mug_l); + + // event numbers must be continuous + // + c3_assert( u3V.sen_d == u3V.dun_d); + u3V.sen_d++; + + gon = _serf_poke(job, "work"); + // event accepted // if ( u3_blip == u3h(gon) ) { @@ -584,49 +619,23 @@ _serf_work(u3_noun job) _serf_sure_core(u3k(cor)); vir = _serf_sure_feck(pre_w, u3k(vir)); - u3z(gon); u3z(job); u3z(last_date); - + u3z(gon); u3z(job); return u3nc(c3__done, u3nt(u3i_chubs(1, &u3V.dun_d), u3i_words(1, &u3V.mug_l), vir)); } - // event rejected // - { + else { // stash $goof from first crash // - u3_noun dud = u3k(u3t(gon)); - - // replace [ovo] with error notification - // - { - u3_noun wir, cad, dud; - u3x_cell(ovo, &wir, &cad); - ovo = u3nq(u3k(wir), c3__crud, u3k(dud), u3k(cad)); - } + u3_noun dud = u3k(gon); // XX reclaim/pack on %meme first? // - // XX u3i_vint(u3A->now) ?? - // - -#ifdef U3_EVENT_TIME_DEBUG - if ( bug_t ) { - gettimeofday(&b4, 0); - u3l_log("serf: crud (%" PRIu64 ") live\r\n", u3V.sen_d); - } -#endif - - u3z(gon); - gon = u3m_soft(0, u3v_poke, u3k(ovo)); - -#ifdef U3_EVENT_TIME_DEBUG - if ( bug_t ) { - _serf_poke_time(u3V.sen_d, "crud", b4); - } -#endif + job = _serf_make_crud(job, dud); + gon = _serf_poke(u3k(job), "crud"); // error notification accepted // @@ -640,35 +649,22 @@ _serf_work(u3_noun job) _serf_sure_core(u3k(cor)); vir = _serf_sure_feck(pre_w, u3k(vir)); - u3z(gon); u3z(job); u3z(last_date); u3z(dud); - - - return u3nc(c3__swap, u3nq(u3i_chubs(1, &u3V.dun_d), - u3i_words(1, &u3V.mug_l), - u3nc(u3k(u3A->now), ovo), - vir)); + u3z(gon); u3z(dud); + return u3nc(c3__swap, u3nq(u3i_chubs(1, &u3V.dun_d), + u3i_words(1, &u3V.mug_l), + job, + vir)); } - // error notification rejected // - { - // stash $goof from second crash - // - u3_noun dud = u3k(u3t(gon)); - - // restore previous time - // - u3z(u3A->now); - u3A->now = last_date; - + else { u3V.sen_d = u3V.dun_d; - u3z(gon); u3z(job); u3z(ovo); - // XX reclaim/pack on %meme ? // - return u3nq(c3__bail, u3k(u3t(gon)), dud, u3_nul); + u3z(job); + return u3nq(c3__bail, gon, dud, u3_nul); } } } @@ -709,70 +705,89 @@ _serf_work_trace(u3_noun job) } static u3_noun -_serf_play_life(u3_noun eve) +_serf_writ_play_life(u3_noun eve) { - c3_d len_d; + u3_noun gon; + + c3_assert( 0ULL == u3V.sen_d ); + { u3_noun len = u3qb_lent(eve); - c3_assert( c3y == u3r_safe_chub(len, &len_d) ); + c3_assert( c3y == u3r_safe_chub(len, &u3V.sen_d) ); u3z(len); } - c3_assert( 0ULL == u3V.sen_d ); - u3V.sen_d = len_d; - - // XX set evt_d forall lit so that %slog is accurate? - // XX capture bail instead of exit + // ensure zero-initialized kernel // - if ( c3n == u3v_boot(eve) ) { - fprintf(stderr, "serf: boot failed: invalid sequence (from pill)\r\n"); - exit(1); + // XX assert? + // + u3A->roc = 0; + + gon = u3m_soft(0, u3v_life, eve); + + // lifecycle sequence succeeded + // + if ( u3_blip == u3h(gon) ) { + // save product as initial arvo kernel + // + _serf_sure_core(u3k(u3t(gon))); + + u3z(gon); + return u3nc(c3__done, u3V.mug_l); + } + // lifecycle sequence failed + // + else { + // send failure message and trace + // + u3V.dun_d = u3V.sen_d = 0; + + return u3nq(c3__bail, 0, 0, gon); + } +} + +/* _serf_play_poke(): RETAIN +*/ +static u3_noun +_serf_play_poke(u3_noun job) +{ + u3_noun now, ovo, wen, gon; + u3x_cell(job, &now, &ovo); + + wen = u3A->now; + u3A->now = u3k(now); + gon = u3m_soft(0, u3v_poke, u3k(ovo)); + + if ( u3_blip != u3h(gon) ) { + u3z(u3A->now); + u3A->now = wen; + } + else { + u3z(wen); } - // XX refactor to use _serf_sure_core() - // - u3V.dun_d = u3A->ent_d = u3V.sen_d; - u3V.mug_l = u3r_mug(u3A->roc); - - return u3nc(c3__done, u3V.mug_l); + return gon; } static u3_noun -_serf_play_list(u3_noun eve) +_serf_writ_play_list(u3_noun eve) { c3_w pre_w = u3a_open(u3R); u3_noun vev = eve; - u3_noun job, now, ovo, gon, last_date; + u3_noun job, gon; while ( u3_nul != eve ) { job = u3h(eve); - u3x_cell(job, &now, &ovo); - last_date = u3A->now; - u3A->now = u3k(now); + // bump sent event counter + // u3V.sen_d++; - gon = u3m_soft(0, u3v_poke, u3k(ovo)); + gon = _serf_play_poke(job); - if ( u3_blip != u3h(gon) ) { - u3_noun dud = u3k(u3t(gon)); - c3_d eve_d = u3V.sen_d; - u3z(gon); - - // restore previous time - // - u3z(u3A->now); - u3A->now = last_date; - - u3V.sen_d = u3V.dun_d; - u3z(vev); - - // XX reclaim/pack on meme - // XX retry? - // - return u3nq(c3__bail, eve_d, u3V.mug_l, dud); - } - else { + // event succeeded, save and continue + // + if ( u3_blip == u3h(gon) ) { // vir/(list ovum) list of effects // cor/arvo arvo core // @@ -784,32 +799,56 @@ _serf_play_list(u3_noun eve) // process effects to set pack/reclaim flags // u3z(_serf_sure_feck(pre_w, u3k(vir))); + u3z(gon); // skip |mass on replay + // u3z(u3V.sac); u3V.sac = u3_nul; eve = u3t(eve); } + // event succeeded, save and continue + // + else { + u3_noun dud = u3k(u3t(gon)); + + // reset sent event counter + // + u3V.sen_d = u3V.dun_d; + + u3z(gon); + + // XX reclaim/pack on meme + // XX retry? + // + + // send failure notification + // + u3z(vev); + return u3nc(c3__bail, u3nt(u3i_chubs(1, &u3V.dun_d), + u3i_words(1, &u3V.mug_l), + dud)); + } } u3z(vev); - return u3nc(c3__done, u3V.mug_l); + return u3nc(c3__done, u3i_words(1, &u3V.mug_l)); } -/* _serf_play(): apply events. +/* _serf_writ_play(): apply events. */ static u3_noun -_serf_play(c3_d evt_d, u3_noun lit) +_serf_writ_play(c3_d evt_d, u3_noun lit) { c3_assert( evt_d == 1ULL + u3V.sen_d ); // XX better condition for no kernel? // return u3nc(c3__play, ( 0ULL == u3V.dun_d ) - ? _serf_play_life(lit) - : _serf_play_list(lit)); + ? _serf_writ_play_life(lit) + : _serf_writ_play_list(lit)); } // /* _serf_poke_peek(): dereference namespace. @@ -820,10 +859,10 @@ _serf_play(c3_d evt_d, u3_noun lit) // // XX u3v_peek // } -/* _serf_live_exit(): exit on command. +/* _serf_writ_live_exit(): exit on command. */ static void -_serf_live_exit(c3_w cod_w) +_serf_writ_live_exit(c3_w cod_w) { if ( u3C.wag_w & u3o_debug_cpu ) { FILE* fil_u; @@ -863,10 +902,10 @@ _serf_live_exit(c3_w cod_w) exit(cod_w); } -/* _serf_live_save(): save snapshot. +/* _serf_writ_live_save(): save snapshot. */ static u3_noun -_serf_live_save(c3_d evt_d) +_serf_writ_live_save(c3_d evt_d) { c3_assert( evt_d == u3V.dun_d ); u3e_save(); @@ -889,10 +928,10 @@ _serf_step_trace(void) } } -/* _serf_newt_poke(): +/* _serf_writ(): */ static void -_serf_newt_poke(void* vod_p, u3_noun mat) +_serf_writ(void* vod_p, u3_noun mat) { u3_noun jar = u3ke_cue(mat); @@ -927,7 +966,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) } u3z(jar); - _serf_live_exit(cod_y); + _serf_writ_live_exit(cod_y); return; } @@ -942,7 +981,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) } u3z(jar); - _serf_send(_serf_live_save(evt_d)); + _serf_send(_serf_writ_live_save(evt_d)); return; } } @@ -978,7 +1017,7 @@ _serf_newt_poke(void* vod_p, u3_noun mat) u3k(lit); u3z(jar); - _serf_send(_serf_play(evt_d, lit)); + _serf_send(_serf_writ_play(evt_d, lit)); _serf_sure_post(); return; } @@ -1126,7 +1165,7 @@ main(c3_i argc, c3_c* argv[]) /* start reading */ u3V.inn_u.vod_p = &u3V; - u3V.inn_u.pok_f = _serf_newt_poke; + u3V.inn_u.pok_f = _serf_writ; u3V.inn_u.bal_f = _serf_newt_fail; u3_newt_read(&u3V.inn_u); From 54b404f2732b6fd0f54f9d664de4b2f7cde2028b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 24 Apr 2020 14:37:07 -0700 Subject: [PATCH 037/257] vere: WIP refactors serf --- pkg/urbit/include/vere/serf.h | 50 +++ pkg/urbit/worker/main.c | 190 ++++++++++ pkg/urbit/worker/serf.c | 633 ++++++++++++++-------------------- 3 files changed, 497 insertions(+), 376 deletions(-) create mode 100644 pkg/urbit/include/vere/serf.h create mode 100644 pkg/urbit/worker/main.c diff --git a/pkg/urbit/include/vere/serf.h b/pkg/urbit/include/vere/serf.h new file mode 100644 index 000000000..7248d111e --- /dev/null +++ b/pkg/urbit/include/vere/serf.h @@ -0,0 +1,50 @@ +/* include/vere/serf.h +*/ + + /** Data types. + **/ + /* u3_serf: worker-process state + */ + typedef struct _u3_serf { + c3_d key_d[4]; // disk key + c3_c* dir_c; // execution directory (pier) + c3_d sen_d; // last event requested + c3_d dun_d; // last event processed + c3_l mug_l; // hash of state + c3_o pac_o; // pack kernel + c3_o rec_o; // reclaim cash + c3_o mut_o; // mutated kerne + u3_noun sac; // space measurementl + } u3_serf; + + /** Functions. + **/ + /* u3_serf_init(): init or restore, producing status. + */ + u3_noun + u3_serf_init(u3_serf* sef_u); + + /* u3_serf_writ(): apply writ [wit], producing plea [*pel] on c3y. + */ + c3_o + u3_serf_writ(u3_serf* sef_u, u3_noun wit, u3_noun* pel); + + /* u3_serf_live(): apply %live command [com], producing *ret on c3y. + */ + c3_o + u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret); + + /* u3_serf_play(): apply event list, producing status. + */ + u3_noun + u3_serf_play(u3_serf* sef_u, c3_d evt_d, u3_noun lit); + + /* u3_serf_work(): apply event, producing effects. + */ + u3_noun + u3_serf_work(u3_serf* sef_u, u3_noun job); + + /* u3_serf_post(): update serf state post-writ. + */ + void + u3_serf_post(u3_serf* sef_u); diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c new file mode 100644 index 000000000..42d2f8180 --- /dev/null +++ b/pkg/urbit/worker/main.c @@ -0,0 +1,190 @@ +/* worker/main.c +** +** the main loop of a serf process. +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include +#include + +static u3_serf u3V; // one serf per process +static u3_moat inn_u; // input stream +static u3_mojo out_u; // output stream + +/* _newt_fail(): failure stub. +*/ +static void +_newt_fail(void* vod_p, const c3_c* wut_c) +{ + fprintf(stderr, "serf: fail: %s\r\n", wut_c); + exit(1); +} + +/* _newt_send(): send plea back to daemon. +*/ +static void +_newt_send(u3_noun pel) +{ + u3_newt_write(&out_u, u3ke_jam(pel), 0); +} + +/* _newt_send_slog(): send hint output (hod is [priority tank]). +*/ +static void +_newt_send_slog(u3_noun hod) +{ + _newt_send(u3nc(c3__slog, hod)); +} + +/* _newt_send_stdr(): send stderr output +*/ +static void +_newt_send_stdr(c3_c* str_c) +{ + _newt_send_slog(u3nt(0, c3__leaf, u3i_tape(str_c))); +} + +/* _newt_writ(): +*/ +static void +_newt_writ(void* vod_p, u3_noun mat) +{ + u3_noun ret; + + if ( c3n == u3_serf_writ(&u3V, u3ke_cue(mat), &ret) ) { + _newt_fail(0, "bad jar"); + } + else { + _newt_send(ret); + + // all references must now be counted, and all roots recorded + // + u3_serf_post(&u3V); + } +} + +/* main(): main() when run as urbit-worker +*/ +c3_i +main(c3_i argc, c3_c* argv[]) +{ + // the serf is spawned with [FD 0] = events and [FD 1] = effects + // we dup [FD 0 & 1] so we don't accidently use them for something else + // we replace [FD 0] (stdin) with a fd pointing to /dev/null + // we replace [FD 1] (stdout) with a dup of [FD 2] (stderr) + // + c3_i nul_i = open("/dev/null", O_RDWR, 0); + c3_i inn_i = dup(0); + c3_i out_i = dup(1); + dup2(nul_i, 0); + dup2(2, 1); + close(nul_i); + + uv_loop_t* lup_u = uv_default_loop(); + c3_c* dir_c = argv[1]; + c3_c* key_c = argv[2]; + c3_c* wag_c = argv[3]; + + c3_assert(4 == argc); + + memset(&u3V, 0, sizeof(u3V)); + memset(&u3_Host.tra_u, 0, sizeof(u3_Host.tra_u)); + + // load passkey + // + // XX and then ... use passkey + // + { + sscanf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", + &u3V.key_d[0], + &u3V.key_d[1], + &u3V.key_d[2], + &u3V.key_d[3]); + } + + // load runtime config + // + { + sscanf(wag_c, "%" SCNu32, &u3C.wag_w); + } + + // Ignore SIGPIPE signals. + // + { + struct sigaction sig_s = {{0}}; + sigemptyset(&(sig_s.sa_mask)); + sig_s.sa_handler = SIG_IGN; + sigaction(SIGPIPE, &sig_s, 0); + } + + // configure pipe to daemon process + // + { + c3_i err_i; + + err_i = uv_pipe_init(lup_u, &inn_u.pyp_u, 0); + c3_assert(!err_i); + uv_pipe_open(&inn_u.pyp_u, inn_i); + + err_i = uv_pipe_init(lup_u, &out_u.pyp_u, 0); + c3_assert(!err_i); + uv_pipe_open(&out_u.pyp_u, out_i); + } + + // set up writing + // + out_u.bal_f = _newt_fail; + + // set up reading + // + inn_u.vod_p = &u3V; + inn_u.pok_f = _newt_writ; + inn_u.bal_f = _newt_fail; + + // setup loom + // + { + u3V.dir_c = strdup(dir_c); + u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); + } + + // set up logging + // + // XX must be after u3m_boot due to u3l_log + // + { + u3C.stderr_log_f = _newt_send_stdr; + u3C.slog_f = _newt_send_slog; + } + + // start serf + // + { + _newt_send(u3_serf_init(&u3V)); + } + + // start reading + // + u3_newt_read(&inn_u); + + // enter loop + // + uv_run(lup_u, UV_RUN_DEFAULT); + + return 0; +} diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index b045b8b09..7491d288b 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -1,6 +1,4 @@ -/* worker/main.c -** -** the main loop of a serf process. +/* worker/serf.c */ #include #include @@ -23,20 +21,7 @@ #include "all.h" #include - - typedef struct _u3_serf { - c3_d sen_d; // last event requested - c3_d dun_d; // last event processed - c3_l mug_l; // hash of state - u3_noun sac; // space measurement - c3_o pac_o; // pack kernel - c3_o rec_o; // reclaim cash - c3_d key_d[4]; // disk key - u3_moat inn_u; // message input - u3_mojo out_u; // message output - c3_c* dir_c; // execution directory (pier) - } u3_serf; - static u3_serf u3V; +#include /* |% @@ -222,11 +207,11 @@ _serf_prof(FILE* fil_u, c3_w den, u3_noun mas) /* _serf_grab(): garbage collect, checking for profiling. RETAIN. */ static void -_serf_grab(void) +_serf_grab(u3_serf* sef_u) { - if ( u3_nul == u3V.sac) { + if ( u3_nul == sef_u->sac) { if ( u3C.wag_w & (u3o_debug_ram | u3o_check_corrupt) ) { - u3m_grab(u3V.sac, u3_none); + u3m_grab(sef_u->sac, u3_none); } } else { @@ -264,9 +249,9 @@ _serf_grab(void) c3_assert( u3R == &(u3H->rod_u) ); fprintf(fil_u, "\r\n"); - tot_w += u3a_maid(fil_u, "total userspace", _serf_prof(fil_u, 0, u3V.sac)); + tot_w += u3a_maid(fil_u, "total userspace", _serf_prof(fil_u, 0, sef_u->sac)); tot_w += u3m_mark(fil_u); - tot_w += u3a_maid(fil_u, "space profile", u3a_mark_noun(u3V.sac)); + tot_w += u3a_maid(fil_u, "space profile", u3a_mark_noun(sef_u->sac)); u3a_print_memory(fil_u, "total marked", tot_w); u3a_print_memory(fil_u, "free lists", u3a_idle(u3R)); @@ -280,8 +265,8 @@ _serf_grab(void) } #endif - u3z(u3V.sac); - u3V.sac = u3_nul; + u3z(sef_u->sac); + sef_u->sac = u3_nul; } } @@ -303,12 +288,12 @@ _serf_static_grab(void) /* _serf_pack(): deduplicate and compact memory */ static void -_serf_pack(void) +_serf_pack(u3_serf* sef_u) { - _serf_static_grab(); + // _serf_static_grab(); u3l_log("serf: compacting loom\r\n"); - if ( c3n == u3m_rock_stay(u3V.dir_c, u3V.dun_d) ) { + if ( c3n == u3m_rock_stay(sef_u->dir_c, sef_u->dun_d) ) { u3l_log("serf: unable to jam state\r\n"); return; } @@ -320,7 +305,7 @@ _serf_pack(void) u3m_wipe(); - if ( c3n == u3m_rock_load(u3V.dir_c, u3V.dun_d) ) { + if ( c3n == u3m_rock_load(sef_u->dir_c, sef_u->dun_d) ) { u3l_log("serf: compaction failed, restoring checkpoint\r\n"); if ( c3n == u3e_fall() ) { @@ -333,7 +318,7 @@ _serf_pack(void) u3l_log("serf: warning: orphaned backup checkpoint file\r\n"); } - if ( c3n == u3m_rock_drop(u3V.dir_c, u3V.dun_d) ) { + if ( c3n == u3m_rock_drop(sef_u->dir_c, sef_u->dun_d) ) { u3l_log("serf: warning: orphaned state file\r\n"); } @@ -341,61 +326,33 @@ _serf_pack(void) _serf_static_grab(); } -/* _serf_newt_fail(): failure stub. +/* u3_serf_post(): update serf state post-writ. */ -static void -_serf_newt_fail(void* vod_p, const c3_c* wut_c) +void +u3_serf_post(u3_serf* sef_u) { - fprintf(stderr, "serf: fail: %s\r\n", wut_c); - exit(1); -} - -/* _serf_send(): send result back to daemon. -*/ -static void -_serf_send(u3_noun job) -{ - u3_newt_write(&u3V.out_u, u3ke_jam(job), 0); -} - -/* _serf_send_slog(): send hint output (hod is [priority tank]). -*/ -static void -_serf_send_slog(u3_noun hod) -{ - _serf_send(u3nc(c3__slog, hod)); -} - -/* _serf_send_stdr(): send stderr output -*/ -static void -_serf_send_stdr(c3_c* str_c) -{ - _serf_send_slog(u3nt(0, c3__leaf, u3i_tape(str_c))); -} - -static void -_serf_sure_post(void) -{ - if ( c3y == u3V.rec_o ) { + if ( c3y == sef_u->rec_o ) { u3m_reclaim(); - u3V.rec_o = c3n; + sef_u->rec_o = c3n; } // XX this runs on replay too // - _serf_grab(); + if ( c3y == sef_u->mut_o ) { + sef_u->mut_o = c3n; + _serf_grab(sef_u); + } - if ( c3y == u3V.pac_o ) { - _serf_pack(); - u3V.pac_o = c3n; + if ( c3y == sef_u->pac_o ) { + _serf_pack(sef_u); + sef_u->pac_o = c3n; } } /* _serf_sure_feck(): event succeeded, send effects. */ static u3_noun -_serf_sure_feck(c3_w pre_w, u3_noun vir) +_serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) { // intercept |mass, observe |reset // @@ -411,7 +368,7 @@ _serf_sure_feck(c3_w pre_w, u3_noun vir) if ( c3__mass == u3h(fec) ) { // save a copy of the %mass data // - u3V.sac = u3k(u3t(fec)); + sef_u->sac = u3k(u3t(fec)); // replace the %mass data with ~ // // For efficient transmission to daemon. @@ -427,13 +384,13 @@ _serf_sure_feck(c3_w pre_w, u3_noun vir) // reclaim memory from persistent caches on |reset // if ( c3__vega == u3h(fec) ) { - u3V.rec_o = c3y; + sef_u->rec_o = c3y; } // pack memory on |pack // if ( c3__pack == u3h(fec) ) { - u3V.pac_o = c3y; + sef_u->pac_o = c3y; } riv = u3t(riv); @@ -464,13 +421,13 @@ _serf_sure_feck(c3_w pre_w, u3_noun vir) // XX set flag(s) in u3V so we don't repeat endlessly? // XX pack here too? // - u3V.pac_o = c3y; - u3V.rec_o = c3y; + sef_u->pac_o = c3y; + sef_u->rec_o = c3y; pri = 1; } else if ( (pre_w > hig_w) && !(pos_w > hig_w) ) { - u3V.pac_o = c3y; - u3V.rec_o = c3y; + sef_u->pac_o = c3y; + sef_u->rec_o = c3y; pri = 0; } // reclaim memory from persistent caches periodically @@ -480,7 +437,7 @@ _serf_sure_feck(c3_w pre_w, u3_noun vir) // - we don't make very effective use of our free lists // else { - u3V.rec_o = _(0 == (u3V.dun_d % 1000ULL)); + sef_u->rec_o = _(0 == (sef_u->dun_d % 1000ULL)); } // notify daemon of memory pressure via "fake" effect @@ -498,38 +455,19 @@ _serf_sure_feck(c3_w pre_w, u3_noun vir) /* _serf_sure_core(): event succeeded, save state. */ static void -_serf_sure_core(u3_noun cor) +_serf_sure_core(u3_serf* sef_u, u3_noun cor) { - u3V.dun_d = u3V.sen_d; + sef_u->dun_d = sef_u->sen_d; u3z(u3A->roc); - u3A->roc = cor; - u3A->ent_d = u3V.dun_d; - u3V.mug_l = u3r_mug(u3A->roc); + u3A->roc = cor; + u3A->ent_d = sef_u->dun_d; + sef_u->mug_l = u3r_mug(u3A->roc); + sef_u->mut_o = c3y; } -#ifdef U3_EVENT_TIME_DEBUG -static void -_serf_poke_time(c3_d evt_d, c3_c* txt_c, struct timeval b4) -{ - struct timeval f2, d0; - c3_w ms_w; - c3_w clr_w; - - gettimeofday(&f2, 0); - timersub(&f2, &b4, &d0); - - ms_w = (d0.tv_sec * 1000) + (d0.tv_usec / 1000); - clr_w = ms_w > 1000 ? 1 : ms_w < 100 ? 2 : 3; // red, green, yellow - - if ( clr_w != 2 ) { - u3l_log("\x1b[3%dm%%%s (%" PRIu64 ") %4d.%02dms\x1b[0m\n", - clr_w, txt_c, evt_d, ms_w, - (int) (d0.tv_usec % 1000) / 10); - } -} -#endif - +/* _serf_make_crud(): +*/ static u3_noun _serf_make_crud(u3_noun job, u3_noun dud) { @@ -545,7 +483,7 @@ _serf_make_crud(u3_noun job, u3_noun dud) /* _serf_poke(): RETAIN */ static u3_noun -_serf_poke(u3_noun job, c3_c* cap_c) +_serf_poke(u3_serf* sef_u, c3_c* cap_c, u3_noun job) { u3_noun now, ovo, wen, gon; u3x_cell(job, &now, &ovo); @@ -555,24 +493,42 @@ _serf_poke(u3_noun job, c3_c* cap_c) #ifdef U3_EVENT_TIME_DEBUG struct timeval b4; - c3_t bug_t = ( (c3__belt != u3h(u3t(ovo))) - || ( (c3__crud == u3h(u3t(ovo))) - && (c3__belt != u3h(u3t(u3t(u3t(ovo))))) )); - c3_c* txt_c = 0; + c3_c* txt_c; - if ( bug_t ) { - gettimeofday(&b4, 0); - txt_c = u3r_string(u3h(u3t(ovo))); + gettimeofday(&b4, 0); - u3l_log("serf: %s (%" PRIu64 ") %s\r\n", cap_c, u3V.sen_d, txt_c); + { + u3_noun tag = u3h(u3t(ovo)); + txt_c = u3r_string(tag); + + if ( (c3__belt != tag) + && (c3__crud != tag) ) + { + u3l_log("serf: %s (%" PRIu64 ") %s\r\n", cap_c, sef_u->sen_d, txt_c); + } } #endif gon = u3m_soft(0, u3v_poke, u3k(ovo)); #ifdef U3_EVENT_TIME_DEBUG - if ( bug_t ) { - _serf_poke_time(u3V.sen_d, txt_c, b4); + { + struct timeval f2, d0; + c3_w ms_w; + c3_w clr_w; + + gettimeofday(&f2, 0); + timersub(&f2, &b4, &d0); + + ms_w = (d0.tv_sec * 1000) + (d0.tv_usec / 1000); + clr_w = ms_w > 1000 ? 1 : ms_w < 100 ? 2 : 3; // red, green, yellow + + if ( clr_w != 2 ) { + u3l_log("\x1b[3%dm%%%s (%" PRIu64 ") %4d.%02dms\x1b[0m\n", + clr_w, txt_c, sef_u->sen_d, ms_w, + (int) (d0.tv_usec % 1000) / 10); + } + c3_free(txt_c); } #endif @@ -591,21 +547,21 @@ _serf_poke(u3_noun job, c3_c* cap_c) /* _serf_work(): apply event, capture effects. */ static u3_noun -_serf_work(u3_noun job) +_serf_work(u3_serf* sef_u, u3_noun job) { u3_noun gon; c3_w pre_w = u3a_open(u3R); // %work must be performed against an extant kernel // - c3_assert( 0 != u3V.mug_l); + c3_assert( 0 != sef_u->mug_l); // event numbers must be continuous // - c3_assert( u3V.sen_d == u3V.dun_d); - u3V.sen_d++; + c3_assert( sef_u->sen_d == sef_u->dun_d); + sef_u->sen_d++; - gon = _serf_poke(job, "work"); + gon = _serf_poke(sef_u, "work", job); // event accepted // @@ -616,12 +572,12 @@ _serf_work(u3_noun job) u3_noun vir, cor; u3x_trel(gon, 0, &vir, &cor); - _serf_sure_core(u3k(cor)); - vir = _serf_sure_feck(pre_w, u3k(vir)); + _serf_sure_core(sef_u, u3k(cor)); + vir = _serf_sure_feck(sef_u, pre_w, u3k(vir)); u3z(gon); u3z(job); - return u3nc(c3__done, u3nt(u3i_chubs(1, &u3V.dun_d), - u3i_words(1, &u3V.mug_l), + return u3nc(c3__done, u3nt(u3i_chubs(1, &sef_u->dun_d), + u3i_words(1, &sef_u->mug_l), vir)); } // event rejected @@ -635,7 +591,7 @@ _serf_work(u3_noun job) // job = _serf_make_crud(job, dud); - gon = _serf_poke(u3k(job), "crud"); + gon = _serf_poke(sef_u, "crud", u3k(job)); // error notification accepted // @@ -646,19 +602,19 @@ _serf_work(u3_noun job) u3_noun vir, cor; u3x_trel(gon, 0, &vir, &cor); - _serf_sure_core(u3k(cor)); - vir = _serf_sure_feck(pre_w, u3k(vir)); + _serf_sure_core(sef_u, u3k(cor)); + vir = _serf_sure_feck(sef_u, pre_w, u3k(vir)); u3z(gon); u3z(dud); - return u3nc(c3__swap, u3nq(u3i_chubs(1, &u3V.dun_d), - u3i_words(1, &u3V.mug_l), + return u3nc(c3__swap, u3nq(u3i_chubs(1, &sef_u->dun_d), + u3i_words(1, &sef_u->mug_l), job, vir)); } // error notification rejected // else { - u3V.sen_d = u3V.dun_d; + sef_u->sen_d = sef_u->dun_d; // XX reclaim/pack on %meme ? // @@ -669,10 +625,10 @@ _serf_work(u3_noun job) } } -/* _serf_work_trace(): %work, with trace +/* u3_serf_work(): apply event, producing effects. */ -static u3_noun -_serf_work_trace(u3_noun job) +u3_noun +u3_serf_work(u3_serf* sef_u, u3_noun job) { c3_t tac_t = ( 0 != u3_Host.tra_u.fil_u ); c3_c lab_c[2048]; @@ -695,7 +651,7 @@ _serf_work_trace(u3_noun job) u3t_event_trace(lab_c, 'B'); } - pro = u3nc(c3__work, _serf_work(job)); + pro = u3nc(c3__work, _serf_work(sef_u, job)); if ( tac_t ) { u3t_event_trace(lab_c, 'E'); @@ -704,16 +660,18 @@ _serf_work_trace(u3_noun job) return pro; } +/* _serf_play_life(): +*/ static u3_noun -_serf_writ_play_life(u3_noun eve) +_serf_play_life(u3_serf* sef_u, u3_noun eve) { u3_noun gon; - c3_assert( 0ULL == u3V.sen_d ); + c3_assert( 0ULL == sef_u->sen_d ); { u3_noun len = u3qb_lent(eve); - c3_assert( c3y == u3r_safe_chub(len, &u3V.sen_d) ); + c3_assert( c3y == u3r_safe_chub(len, &sef_u->sen_d) ); u3z(len); } @@ -730,17 +688,17 @@ _serf_writ_play_life(u3_noun eve) if ( u3_blip == u3h(gon) ) { // save product as initial arvo kernel // - _serf_sure_core(u3k(u3t(gon))); + _serf_sure_core(sef_u, u3k(u3t(gon))); u3z(gon); - return u3nc(c3__done, u3V.mug_l); + return u3nc(c3__done, sef_u->mug_l); } // lifecycle sequence failed // else { // send failure message and trace // - u3V.dun_d = u3V.sen_d = 0; + sef_u->dun_d = sef_u->sen_d = 0; return u3nq(c3__bail, 0, 0, gon); } @@ -769,8 +727,10 @@ _serf_play_poke(u3_noun job) return gon; } +/* _serf_play_list(): +*/ static u3_noun -_serf_writ_play_list(u3_noun eve) +_serf_play_list(u3_serf* sef_u, u3_noun eve) { c3_w pre_w = u3a_open(u3R); u3_noun vev = eve; @@ -781,7 +741,7 @@ _serf_writ_play_list(u3_noun eve) // bump sent event counter // - u3V.sen_d++; + sef_u->sen_d++; gon = _serf_play_poke(job); @@ -794,18 +754,18 @@ _serf_writ_play_list(u3_noun eve) u3_noun vir, cor; u3x_trel(gon, 0, &vir, &cor); - _serf_sure_core(u3k(cor)); + _serf_sure_core(sef_u, u3k(cor)); // process effects to set pack/reclaim flags // - u3z(_serf_sure_feck(pre_w, u3k(vir))); + u3z(_serf_sure_feck(sef_u, pre_w, u3k(vir))); u3z(gon); // skip |mass on replay // - u3z(u3V.sac); - u3V.sac = u3_nul; + u3z(sef_u->sac); + sef_u->sac = u3_nul; eve = u3t(eve); } @@ -816,7 +776,7 @@ _serf_writ_play_list(u3_noun eve) // reset sent event counter // - u3V.sen_d = u3V.dun_d; + sef_u->sen_d = sef_u->dun_d; u3z(gon); @@ -827,28 +787,28 @@ _serf_writ_play_list(u3_noun eve) // send failure notification // u3z(vev); - return u3nc(c3__bail, u3nt(u3i_chubs(1, &u3V.dun_d), - u3i_words(1, &u3V.mug_l), + return u3nc(c3__bail, u3nt(u3i_chubs(1, &sef_u->dun_d), + u3i_words(1, &sef_u->mug_l), dud)); } } u3z(vev); - return u3nc(c3__done, u3i_words(1, &u3V.mug_l)); + return u3nc(c3__done, u3i_words(1, &sef_u->mug_l)); } -/* _serf_writ_play(): apply events. +/* u3_serf_play(): apply event list, producing status. */ -static u3_noun -_serf_writ_play(c3_d evt_d, u3_noun lit) +u3_noun +u3_serf_play(u3_serf* sef_u, c3_d eve_d, u3_noun lit) { - c3_assert( evt_d == 1ULL + u3V.sen_d ); + c3_assert( eve_d == 1ULL + sef_u->sen_d ); // XX better condition for no kernel? // - return u3nc(c3__play, ( 0ULL == u3V.dun_d ) - ? _serf_writ_play_life(lit) - : _serf_writ_play_list(lit)); + return u3nc(c3__play, ( 0ULL == sef_u->dun_d ) + ? _serf_play_life(sef_u, lit) + : _serf_play_list(sef_u, lit)); } // /* _serf_poke_peek(): dereference namespace. @@ -904,162 +864,182 @@ _serf_writ_live_exit(c3_w cod_w) /* _serf_writ_live_save(): save snapshot. */ -static u3_noun -_serf_writ_live_save(c3_d evt_d) +static void +_serf_writ_live_save(u3_serf* sef_u, c3_d eve_d) { - c3_assert( evt_d == u3V.dun_d ); + if( eve_d != sef_u->dun_d ) { + fprintf(stderr, "serf (%" PRIu64 "): save failed: %" PRIu64 "\r\n", + sef_u->dun_d, + eve_d); + exit(1); + } + u3e_save(); - return u3nc(c3__live, u3_nul); +} + +/* u3_serf_live(): apply %live command [com], producing *ret on c3y. +*/ +c3_o +u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) +{ + u3_noun tag, dat; + c3_o ret_o; + + // refcounts around snapshots require special handling + // + if ( c3n == u3r_cell(com, &tag, &dat) ) { + u3z(com); + return c3n; + } + + switch ( tag ) { + default: { + u3z(com); + return c3n; + } + + case c3__exit: { + c3_y cod_y; + + if ( c3n == u3r_safe_byte(dat, &cod_y) ) { + u3z(com); + return c3n; + } + + u3z(com); + // NB, doesn't return + // + _serf_writ_live_exit(cod_y); + *ret = u3nc(c3__live, u3_nul); + return c3y; + } + + // XX + // + case c3__save: { + c3_stub; + } + + case c3__snap: { + c3_d eve_d; + + if ( c3n == u3r_safe_chub(dat, &eve_d) ) { + u3z(com); + return c3n; + } + + u3z(com); + _serf_writ_live_save(sef_u, eve_d); + *ret = u3nc(c3__live, u3_nul); + return c3y; + } + } } /* _serf_step_trace(): initialize or rotate trace file. */ static void -_serf_step_trace(void) +_serf_step_trace(u3_serf* sef_u) { if ( u3C.wag_w & u3o_trace ) { if ( u3_Host.tra_u.con_w == 0 && u3_Host.tra_u.fun_w == 0 ) { - u3t_trace_open(u3V.dir_c); + u3t_trace_open(sef_u->dir_c); } else if ( u3_Host.tra_u.con_w >= 100000 ) { u3t_trace_close(); - u3t_trace_open(u3V.dir_c); + u3t_trace_open(sef_u->dir_c); } } } -/* _serf_writ(): +/* u3_serf_writ(): apply writ [wit], producing plea [*pel] on c3y. */ -static void -_serf_writ(void* vod_p, u3_noun mat) +c3_o +u3_serf_writ(u3_serf* sef_u, u3_noun wit, u3_noun* pel) { - u3_noun jar = u3ke_cue(mat); + u3_noun tag, com; + c3_o ret_o; - if ( c3n == u3a_is_cell(jar) ) { - goto error; + if ( c3n == u3r_cell(wit, &tag, &com) ) { + ret_o = c3n; } + else { + _serf_step_trace(sef_u); - _serf_step_trace(); + switch ( tag ) { + default: { + ret_o = c3n; + } break; - switch ( u3h(jar) ) { - default: { - goto error; - } - - case c3__live: { - u3_noun com, dat; - - if ( c3n == u3r_trel(jar, 0, &com, &dat) ) { - goto error; - } - - switch (com) { - default: { - goto error; - } - - case c3__exit: { - c3_y cod_y; - - if ( c3n == u3r_safe_byte(dat, &cod_y) ) { - goto error; - } - - u3z(jar); - _serf_writ_live_exit(cod_y); - return; - } - - // XX + case c3__live: { + // since %live can take snapshots, it's refcount protocol is unique // - case c3__save: - case c3__snap: { - c3_d evt_d; + u3k(com); + u3z(wit); + return u3_serf_live(sef_u, com, pel); + } break; - if ( c3n == u3r_safe_chub(dat, &evt_d) ) { - goto error; - } + case c3__peek: { + c3_stub; + } break; - u3z(jar); - _serf_send(_serf_writ_live_save(evt_d)); - return; + case c3__play: { + u3_noun eve, lit; + c3_d eve_d; + + if ( (c3n == u3r_cell(com, &eve, &lit)) || + (c3n == u3a_is_cell(lit)) || + (c3n == u3r_safe_chub(eve, &eve_d)) ) + { + ret_o = c3n; } - } - } + else { + *pel = u3_serf_play(sef_u, eve_d, u3k(lit)); + ret_o = c3y; + } + } break; - // case c3__peek: { - // u3_noun now, pat; - - // if ( (c3n == u3r_trel(jar, 0, &now, &pat)) || - // (c3n == u3a_is_cell(pat)) || - // (c3n == u3a_is_atom(now)) || - // (1 != u3r_met(8, now)) ) - // { - // goto error; - // } - - // u3k(now); u3k(pat); - // u3z(jar); - - // return _serf_poke_peek(now, pat); - // } - - case c3__play: { - u3_noun evt, lit; - c3_d evt_d; - - if ( (c3n == u3r_trel(jar, 0, &evt, &lit)) || - (c3n == u3a_is_cell(lit)) || - (c3n == u3r_safe_chub(evt, &evt_d)) ) - { - goto error; - } - - u3k(lit); - u3z(jar); - _serf_send(_serf_writ_play(evt_d, lit)); - _serf_sure_post(); - return; - } - - case c3__work: { - u3_noun job = u3k(u3t(jar)); - u3z(jar); - _serf_send(_serf_work_trace(job)); - _serf_sure_post(); - return; + case c3__work: { + *pel = u3_serf_work(sef_u, u3k(com)); + ret_o = c3y; + } break; } } - error: { - // u3m_p("jar", jar); - u3z(jar); - _serf_newt_fail(0, "bad jar"); - } + u3z(wit); + return ret_o; } /* _serf_ripe(): produce initial serf state as [eve=@ mug=@] */ static u3_noun -_serf_ripe(void) +_serf_ripe(u3_serf* sef_u) { - // u3l_log("serf: ripe %" PRIu64 "\r\n", u3V.dun_d); + // u3l_log("serf: ripe %" PRIu64 "\r\n", sef_u->dun_d); - u3V.mug_l = ( 0 == u3V.dun_d ) ? 0 : u3r_mug(u3A->roc); - return u3nc(u3i_chubs(1, &u3V.dun_d), u3i_words(1, &u3V.mug_l)); + sef_u->mug_l = ( 0 == sef_u->dun_d ) + ? 0 + : u3r_mug(u3A->roc); + + return u3nc(u3i_chubs(1, &sef_u->dun_d), + u3i_words(1, &sef_u->mug_l)); } -/* u3_serf_boot(): send startup message to manager. +/* u3_serf_init(): init or restore, producing status. */ -void -u3_serf_boot(void) +u3_noun +u3_serf_init(u3_serf* sef_u) { - c3_w pro_w = 1; - c3_y hon_y = 141; - c3_y noc_y = 4; - u3_noun ver = u3nt(pro_w, hon_y, noc_y); + u3_noun rip; - _serf_send(u3nt(c3__ripe, ver, _serf_ripe())); + { + c3_w pro_w = 1; + c3_y hon_y = 141; + c3_y noc_y = 4; + u3_noun ver = u3nt(pro_w, hon_y, noc_y); + + rip = u3nt(c3__ripe, ver, _serf_ripe(sef_u)); + } // measure/print static memory usage if < 1/2 of the loom is available // @@ -1073,109 +1053,10 @@ u3_serf_boot(void) } } - u3V.pac_o = c3n; - u3V.rec_o = c3n; - u3V.sac = u3_nul; -} - -/* main(): main() when run as urbit-worker -*/ -c3_i -main(c3_i argc, c3_c* argv[]) -{ - // the serf is spawned with [FD 0] = events and [FD 1] = effects - // we dup [FD 0 & 1] so we don't accidently use them for something else - // we replace [FD 0] (stdin) with a fd pointing to /dev/null - // we replace [FD 1] (stdout) with a dup of [FD 2] (stderr) - // - c3_i nul_i = open("/dev/null", O_RDWR, 0); - c3_i inn_i = dup(0); - c3_i out_i = dup(1); - dup2(nul_i, 0); - dup2(2, 1); - close(nul_i); - - uv_loop_t* lup_u = uv_default_loop(); - c3_c* dir_c = argv[1]; - c3_c* key_c = argv[2]; - c3_c* wag_c = argv[3]; - - c3_assert(4 == argc); - - memset(&u3V, 0, sizeof(u3V)); - memset(&u3_Host.tra_u, 0, sizeof(u3_Host.tra_u)); - - /* load passkey - */ - { - sscanf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", - &u3V.key_d[0], - &u3V.key_d[1], - &u3V.key_d[2], - &u3V.key_d[3]); - } - - /* load runtime config - */ - { - sscanf(wag_c, "%" SCNu32, &u3C.wag_w); - } - - /* load pier directory - */ - { - u3V.dir_c = strdup(dir_c); - } - - /* boot image - */ - { - u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); - u3C.stderr_log_f = _serf_send_stdr; - u3C.slog_f = _serf_send_slog; - } - - // Ignore SIGPIPE signals. - // - { - struct sigaction sig_s = {{0}}; - sigemptyset(&(sig_s.sa_mask)); - sig_s.sa_handler = SIG_IGN; - sigaction(SIGPIPE, &sig_s, 0); - } - - /* configure pipe to daemon process - */ - { - c3_i err_i; - - err_i = uv_pipe_init(lup_u, &u3V.inn_u.pyp_u, 0); - c3_assert(!err_i); - uv_pipe_open(&u3V.inn_u.pyp_u, inn_i); - - err_i = uv_pipe_init(lup_u, &u3V.out_u.pyp_u, 0); - c3_assert(!err_i); - uv_pipe_open(&u3V.out_u.pyp_u, out_i); - } - - /* set up writing - */ - u3V.out_u.bal_f = _serf_newt_fail; - - /* start reading - */ - u3V.inn_u.vod_p = &u3V; - u3V.inn_u.pok_f = _serf_writ; - u3V.inn_u.bal_f = _serf_newt_fail; - - u3_newt_read(&u3V.inn_u); - - /* send start request - */ - u3_serf_boot(); - - /* enter loop - */ - uv_run(lup_u, UV_RUN_DEFAULT); - return 0; + sef_u->pac_o = c3n; + sef_u->rec_o = c3n; + sef_u->mut_o = c3n; + sef_u->sac = u3_nul; + + return rip; } From a44dadc5fce2fefd076e7f673585778d812fb7d7 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 24 Apr 2020 15:19:49 -0700 Subject: [PATCH 038/257] vere: adds hack to fix u3l_log printing across the pipe --- pkg/urbit/vere/lord.c | 2 +- pkg/urbit/vere/pier.c | 12 +++++++++++- pkg/urbit/worker/main.c | 2 +- pkg/urbit/worker/serf.c | 2 +- 4 files changed, 14 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 3892e5ec0..c0bfb97a0 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -38,7 +38,7 @@ +$ plea $% [%live ~] [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] - [%slog pri=@ =tank] + [%slog pri=@ ?(cord tank)] [%peek dat=(unit (cask))] $: %play $% [%done mug=@] diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 2f8932a05..2aa46f694 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -464,7 +464,17 @@ static void _pier_on_lord_slog(void* vod_p, c3_w pri_w, u3_noun tan) { u3_pier* pir_u = vod_p; - u3_pier_tank(0, pri_w, tan); + + if ( c3y == u3a_is_atom(tan) ) { + c3_c* tan_c = u3r_string(tan); + u3C.stderr_log_f(tan_c); + c3_free(tan_c); + u3z(tan); + } + else { + u3_pier_tank(0, pri_w, tan); + } + _pier_next(pir_u); } diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index 42d2f8180..d0ba2bd06 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -56,7 +56,7 @@ _newt_send_slog(u3_noun hod) static void _newt_send_stdr(c3_c* str_c) { - _newt_send_slog(u3nt(0, c3__leaf, u3i_tape(str_c))); + _newt_send_slog(u3nc(0, u3i_string(str_c))); } /* _newt_writ(): diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 7491d288b..132e6f4e7 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -42,7 +42,7 @@ +$ plea $% [%live ~] [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] - [%slog pri=@ =tank] + [%slog pri=@ ?(cord tank)] [%peek dat=(unit (cask))] $: %play $% [%done mug=@] From 1302a120b103ef251049c614020a8469b2fb1edb Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 24 Apr 2020 15:41:47 -0700 Subject: [PATCH 039/257] vere: making i/o driver bail callbacks optional --- pkg/urbit/vere/ames.c | 15 ++++----------- pkg/urbit/vere/auto.c | 10 +++++++--- pkg/urbit/vere/behn.c | 14 +++----------- pkg/urbit/vere/cttp.c | 14 +++----------- pkg/urbit/vere/fore.c | 12 +----------- pkg/urbit/vere/hind.c | 12 +----------- pkg/urbit/vere/http.c | 14 +++----------- pkg/urbit/vere/term.c | 9 --------- pkg/urbit/vere/unix.c | 14 +++----------- 9 files changed, 25 insertions(+), 89 deletions(-) diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/ames.c index dd1436b6a..c4f46a06e 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/ames.c @@ -679,16 +679,6 @@ _ames_io_exit(u3_auto* car_u) } } -/* _ames_ev_bail(): event crashed. -*/ -static void -_ames_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) -{ - // XX track and print every N? - // - u3_auto_bail_slog(egg_u, lud); -} - /* u3_ames_io_init(): initialize ames I/O. */ u3_auto* @@ -721,7 +711,10 @@ u3_ames_io_init(u3_pier* pir_u) car_u->io.talk_f = _ames_io_talk; car_u->io.kick_f = _ames_io_kick; car_u->io.exit_f = _ames_io_exit; - car_u->ev.bail_f = _ames_ev_bail; + + // XX track and print every N? + // + // car_u->ev.bail_f = ...; return car_u; diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index e81b2b73c..98a363359 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -104,11 +104,16 @@ u3_auto_bail_slog(u3_ovum* egg_u, u3_noun lud) void u3_auto_bail(u3_ovum* egg_u, u3_noun lud) { - { + // optional + // + if ( egg_u->car_u->ev.bail_f ) { c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); egg_u->car_u->ev.bail_f(egg_u->car_u, egg_u, lud); u3a_lop(cod_l); } + else { + u3_auto_bail_slog(egg_u, lud); + } // XX confirm // @@ -342,12 +347,11 @@ u3_auto_exit(u3_auto* car_u) static u3_auto* _auto_link(u3_auto* car_u, u3_pier* pir_u, u3_auto* nex_u) { - // assert required callbacks are present + // assert that io callbacks are present // c3_assert( car_u->io.talk_f ); c3_assert( car_u->io.kick_f ); c3_assert( car_u->io.exit_f ); - c3_assert( car_u->ev.bail_f ); car_u->pir_u = pir_u; car_u->nex_u = nex_u; diff --git a/pkg/urbit/vere/behn.c b/pkg/urbit/vere/behn.c index f4f881b0e..ffdc6d1c8 100644 --- a/pkg/urbit/vere/behn.c +++ b/pkg/urbit/vere/behn.c @@ -140,16 +140,6 @@ _behn_io_exit(u3_auto* car_u) uv_close((uv_handle_t*)&teh_u->tim_u, (uv_close_cb)_behn_exit_cb); } -/* _behn_ev_bail(): event crashed. -*/ -static void -_behn_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) -{ - // XX retry up to N? - // - u3_auto_bail_slog(egg_u, lud); -} - /* u3_behn(): initialize time timer. */ u3_auto* @@ -169,7 +159,9 @@ u3_behn_io_init(u3_pier* pir_u) car_u->io.talk_f = _behn_io_talk; car_u->io.kick_f = _behn_io_kick; car_u->io.exit_f = _behn_io_exit; - car_u->ev.bail_f = _behn_ev_bail; + // XX retry up to N? + // + // car_u->ev.bail_f = ...; return car_u; } diff --git a/pkg/urbit/vere/cttp.c b/pkg/urbit/vere/cttp.c index 14a649b32..7947b6164 100644 --- a/pkg/urbit/vere/cttp.c +++ b/pkg/urbit/vere/cttp.c @@ -1120,16 +1120,6 @@ _cttp_io_exit(u3_auto* car_u) // } -/* _cttp_ev_bail(): event crashed. -*/ -static void -_cttp_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) -{ - // XX retry up to N? - // - u3_auto_bail_slog(egg_u, lud); -} - /* u3_cttp_io_init(): initialize http client I/O. */ u3_auto* @@ -1159,7 +1149,9 @@ u3_cttp_io_init(u3_pier* pir_u) car_u->io.talk_f = _cttp_io_talk; car_u->io.kick_f = _cttp_io_kick; car_u->io.exit_f = _cttp_io_exit; - car_u->ev.bail_f = _cttp_ev_bail; + // XX retry up to N? + // + // car_u->ev.bail_f = ...; return car_u; } diff --git a/pkg/urbit/vere/fore.c b/pkg/urbit/vere/fore.c index 4811bdd1d..d0789c2be 100644 --- a/pkg/urbit/vere/fore.c +++ b/pkg/urbit/vere/fore.c @@ -63,16 +63,6 @@ _fore_io_exit(u3_auto* car_u) { } -/* _fore_ev_bail(): event crashed. -*/ -static void -_fore_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) -{ - // XX retry up to N? - // - u3_auto_bail_slog(egg_u, lud); -} - /* u3_fore_io_init(): initialize fore */ u3_auto* @@ -84,7 +74,7 @@ u3_fore_io_init(u3_pier* pir_u) car_u->io.talk_f = _fore_io_talk; car_u->io.kick_f = _fore_io_kick; car_u->io.exit_f = _fore_io_exit; - car_u->ev.bail_f = _fore_ev_bail; + // car_u->ev.bail_f = ...; return car_u; } diff --git a/pkg/urbit/vere/hind.c b/pkg/urbit/vere/hind.c index ada6f38b5..f2d1f99a1 100644 --- a/pkg/urbit/vere/hind.c +++ b/pkg/urbit/vere/hind.c @@ -74,16 +74,6 @@ _hind_io_exit(u3_auto* car_u) u3a_lop(cod_l); } -/* _hind_ev_bail(): event crashed. -*/ -static void -_hind_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) -{ - // XX retry up to N? - // - u3_auto_bail_slog(egg_u, lud); -} - /* u3_hind_io_init(): */ u3_auto* @@ -95,7 +85,7 @@ u3_hind_io_init(u3_pier* pir_u) car_u->io.talk_f = _hind_io_talk; car_u->io.kick_f = _hind_io_kick; car_u->io.exit_f = _hind_io_exit; - car_u->ev.bail_f = _hind_ev_bail; + // car_u->ev.bail_f = ...; // XX moveme // diff --git a/pkg/urbit/vere/http.c b/pkg/urbit/vere/http.c index 0bdda52ce..c7b1bd0c1 100644 --- a/pkg/urbit/vere/http.c +++ b/pkg/urbit/vere/http.c @@ -1926,16 +1926,6 @@ _http_io_exit(u3_auto* car_u) _http_release_ports_file(u3_Host.dir_c); } -/* _http_ev_bail(): event crashed. -*/ -static void -_http_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) -{ - // XX retry up to N? - // - u3_auto_bail_slog(egg_u, lud); -} - /* u3_http_io_init(): initialize http I/O. */ u3_auto* @@ -1949,7 +1939,9 @@ u3_http_io_init(u3_pier* pir_u) car_u->io.talk_f = _http_io_talk; car_u->io.kick_f = _http_io_kick; car_u->io.exit_f = _http_io_exit; - car_u->ev.bail_f = _http_ev_bail; + // XX retry up to N? + // + // car_u->ev.bail_f = ...; return car_u; } diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 2ec76e18d..6be1feaad 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -1423,14 +1423,6 @@ _term_io_exit(u3_auto* car_u) } } -/* _term_ev_bail(): event crashed. -*/ -static void -_term_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) -{ - u3_auto_bail_slog(egg_u, lud); -} - /* u3_term_io_init(): initialize terminal */ u3_auto* @@ -1446,7 +1438,6 @@ u3_term_io_init(u3_pier* pir_u) car_u->io.talk_f = _term_io_talk; car_u->io.kick_f = _term_io_kick; car_u->io.exit_f = _term_io_exit; - car_u->ev.bail_f = _term_ev_bail; return car_u; } diff --git a/pkg/urbit/vere/unix.c b/pkg/urbit/vere/unix.c index e62cc9f5b..8e2fc87ac 100644 --- a/pkg/urbit/vere/unix.c +++ b/pkg/urbit/vere/unix.c @@ -1448,16 +1448,6 @@ _unix_io_exit(u3_auto* car_u) c3_free(unx_u); } -/* _unix_ev_bail(): event crashed. -*/ -static void -_unix_ev_bail(u3_auto* car_u, u3_ovum* egg_u, u3_noun lud) -{ - // XX wat do - // - u3_auto_bail_slog(egg_u, lud); -} - /* u3_unix_io_init(): initialize unix sync. */ u3_auto* @@ -1479,7 +1469,9 @@ u3_unix_io_init(u3_pier* pir_u) car_u->io.talk_f = _unix_io_talk; car_u->io.kick_f = _unix_io_kick; car_u->io.exit_f = _unix_io_exit; - car_u->ev.bail_f = _unix_ev_bail; + // XX wat do + // + // car_u->ev.bail_f = ...l; return car_u; } From a49d9b8206780f9c9729b7912cb8d158d1690dd3 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 24 Apr 2020 16:19:45 -0700 Subject: [PATCH 040/257] vere: sets up i/o driver async initialization --- pkg/urbit/vere/ames.c | 52 ++++++++++++++++++++----------------------- pkg/urbit/vere/behn.c | 5 +++-- pkg/urbit/vere/cttp.c | 5 +++-- pkg/urbit/vere/fore.c | 4 +++- pkg/urbit/vere/hind.c | 2 +- pkg/urbit/vere/http.c | 12 +--------- pkg/urbit/vere/pier.c | 29 +++++++++++------------- pkg/urbit/vere/term.c | 2 +- pkg/urbit/vere/unix.c | 6 +++-- 9 files changed, 53 insertions(+), 64 deletions(-) diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/ames.c index c4f46a06e..1f449db07 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/ames.c @@ -39,8 +39,6 @@ }; // c3_d who_d[2]; // identity c3_o fak_o; // fake keys - c3_o liv; // listener on - c3_o alm; // alarm on c3_s por_s; // public IPv4 port c3_c* dns_c; // domain XX multiple/fallback c3_w imp_w[256]; // imperial IPs @@ -311,7 +309,7 @@ _ames_czar(u3_pact* pac_u, c3_c* bos_c) static void _ames_ef_send(u3_ames* sam_u, u3_noun lan, u3_noun pac) { - if ( c3n == sam_u->liv ) { + if ( c3n == sam_u->car_u.liv_o ) { u3l_log("ames: not yet live, dropping outbound\r\n"); u3z(lan); u3z(pac); return; @@ -427,13 +425,6 @@ _ames_io_start(u3_ames* sam_u) } } - if ( 0 != (ret_i = uv_udp_init(u3L, &sam_u->wax_u)) ) { - u3l_log("ames: init: %s\n", uv_strerror(ret_i)); - c3_assert(0); - } - - sam_u->wax_u.data = sam_u; - // Bind and stuff. { struct sockaddr_in add_u; @@ -477,7 +468,7 @@ _ames_io_start(u3_ames* sam_u) uv_udp_recv_start(&sam_u->wax_u, _ames_alloc, _ames_recv_cb); - sam_u->liv = c3y; + sam_u->car_u.liv_o = c3y; u3z(rac); u3z(who); } @@ -544,7 +535,8 @@ static void _ames_ef_turf(u3_ames* sam_u, u3_noun tuf) { if ( u3_nul != tuf ) { - // XX save all for fallback, not just first + // XX save all for fallback, not just first + // u3_noun hot = u3k(u3h(tuf)); c3_w len_w = _cttp_mcut_host(0, 0, u3k(hot)); @@ -552,13 +544,18 @@ _ames_ef_turf(u3_ames* sam_u, u3_noun tuf) _cttp_mcut_host(sam_u->dns_c, 0, hot); sam_u->dns_c[len_w] = 0; + // XX invalidate sam_u->imp_w &c ? + // + u3z(tuf); } else if ( (c3n == sam_u->fak_o) && (0 == sam_u->dns_c) ) { u3l_log("ames: turf: no domains\n"); } - if ( c3n == sam_u->liv ) { + // XX is this ever necessary? + // + if ( c3n == sam_u->car_u.liv_o ) { _ames_io_start(sam_u); } } @@ -665,18 +662,22 @@ _ames_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) return ret_o; } +/* _ames_exit_cb(): dispose resources aftr close. +*/ +static void +_ames_exit_cb(uv_handle_t* had_u) +{ + u3_ames* sam_u = had_u->data; + c3_free(sam_u); +} + /* _ames_io_exit(): terminate ames I/O. */ static void _ames_io_exit(u3_auto* car_u) { u3_ames* sam_u = (u3_ames*)car_u; - - // XX dispose - // - if ( c3y == sam_u->liv ) { - uv_close(&sam_u->had_u, 0); - } + uv_close(&sam_u->had_u, _ames_exit_cb); } /* u3_ames_io_init(): initialize ames I/O. @@ -684,26 +685,21 @@ _ames_io_exit(u3_auto* car_u) u3_auto* u3_ames_io_init(u3_pier* pir_u) { - u3_ames* sam_u = c3_calloc(sizeof(*sam_u)); - // XX pass pier on init? - // + u3_ames* sam_u = c3_calloc(sizeof(*sam_u)); sam_u->who_d[0] = pir_u->who_d[0]; sam_u->who_d[1] = pir_u->who_d[1]; sam_u->por_s = pir_u->por_s; sam_u->fak_o = pir_u->fak_o; + c3_assert( !uv_udp_init(u3L, &sam_u->wax_u) ); + sam_u->wax_u.data = sam_u; + // Disable networking for fake ships // if ( c3y == sam_u->fak_o ) { u3_Host.ops_u.net = c3n; } - // XX redundant - // - sam_u->liv = c3n; - - // XX uv_udp_init - // u3_auto* car_u = &sam_u->car_u; car_u->nam_m = c3__ames; diff --git a/pkg/urbit/vere/behn.c b/pkg/urbit/vere/behn.c index ffdc6d1c8..eed3bfb10 100644 --- a/pkg/urbit/vere/behn.c +++ b/pkg/urbit/vere/behn.c @@ -153,9 +153,10 @@ u3_behn_io_init(u3_pier* pir_u) u3_auto* car_u = &teh_u->car_u; car_u->nam_m = c3__behn; - // XX factor out + + // XX set in done_cb for %born // - car_u->liv_o = c3n; + car_u->liv_o = c3y; car_u->io.talk_f = _behn_io_talk; car_u->io.kick_f = _behn_io_kick; car_u->io.exit_f = _behn_io_exit; diff --git a/pkg/urbit/vere/cttp.c b/pkg/urbit/vere/cttp.c index 7947b6164..0342e57ac 100644 --- a/pkg/urbit/vere/cttp.c +++ b/pkg/urbit/vere/cttp.c @@ -1143,9 +1143,10 @@ u3_cttp_io_init(u3_pier* pir_u) u3_auto* car_u = &ctp_u->car_u; car_u->nam_m = c3__cttp; - // XX post born + + // XX set in done_cb for %born // - car_u->liv_o = c3n; + car_u->liv_o = c3y; car_u->io.talk_f = _cttp_io_talk; car_u->io.kick_f = _cttp_io_kick; car_u->io.exit_f = _cttp_io_exit; diff --git a/pkg/urbit/vere/fore.c b/pkg/urbit/vere/fore.c index d0789c2be..3666360a9 100644 --- a/pkg/urbit/vere/fore.c +++ b/pkg/urbit/vere/fore.c @@ -70,7 +70,9 @@ u3_fore_io_init(u3_pier* pir_u) { u3_auto* car_u = c3_calloc(sizeof(*car_u)); car_u->nam_m = c3__fore; - car_u->liv_o = c3n; + // XX set in done_cb for %wack + // + car_u->liv_o = c3y; car_u->io.talk_f = _fore_io_talk; car_u->io.kick_f = _fore_io_kick; car_u->io.exit_f = _fore_io_exit; diff --git a/pkg/urbit/vere/hind.c b/pkg/urbit/vere/hind.c index f2d1f99a1..c88c9874a 100644 --- a/pkg/urbit/vere/hind.c +++ b/pkg/urbit/vere/hind.c @@ -81,7 +81,7 @@ u3_hind_io_init(u3_pier* pir_u) { u3_auto* car_u = c3_calloc(sizeof(*car_u)); car_u->nam_m = c3__hind; - car_u->liv_o = c3n; + car_u->liv_o = c3y; car_u->io.talk_f = _hind_io_talk; car_u->io.kick_f = _hind_io_kick; car_u->io.exit_f = _hind_io_exit; diff --git a/pkg/urbit/vere/http.c b/pkg/urbit/vere/http.c index c7b1bd0c1..29987d402 100644 --- a/pkg/urbit/vere/http.c +++ b/pkg/urbit/vere/http.c @@ -1709,17 +1709,7 @@ u3_http_ef_form(u3_httd* htd_u, u3_noun fig) _http_serv_restart(htd_u); - // The control server has now started. - // - // If we're in daemon mode, we need to inform the parent process - // that we've finished booting. - // - // XX using this effect is a terrible heuristic; - // "fully booted" should be formalized. - // - if (u3_Host.bot_f) { - u3_Host.bot_f(); - } + htd_u->car_u.liv_o = c3y; } /* _http_io_talk(): start http I/O. diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 2aa46f694..4de0118db 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -172,9 +172,19 @@ _pier_work(u3_pier* pir_u) if ( c3n == pir_u->liv_o ) { pir_u->liv_o = u3_auto_live(pir_u->car_u); + // all i/o drivers are fully initialized + // if ( c3y == pir_u->liv_o ) { - // XX print - // XX bot_f ? + // XX this is when "boot" is actually complete + // XX even better would be after neighboring with our sponsor + // + u3l_log("pier: live\r\n"); + + // XX move callbacking to king + // + if ( u3_Host.bot_f ) { + u3_Host.bot_f(); + } } } @@ -827,6 +837,7 @@ _pier_init(c3_w wag_w, c3_c* pax_c) pir_u->pax_c = pax_c; pir_u->sat_e = u3_peat_init; + pir_u->liv_o = c3n; // XX remove // @@ -1201,20 +1212,6 @@ u3_pier_exit(u3_pier* pir_u) _pier_wall_plan(pir_u, 0, pir_u, _pier_exit_cb); } -// startup validation -// -// replay the log -// init all the i/o drivers -// - - -// boot validation -// -// play the (pill / boot-sequence) -// init all the i/o drivers -// neighbor with sponsor -// - /* _pier_loop_init_pier(): initialize loop handlers. */ static u3_auto* diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 6be1feaad..421564546 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -1434,7 +1434,7 @@ u3_term_io_init(u3_pier* pir_u) u3_Host.uty_u->car_u = car_u; car_u->nam_m = c3__term; - car_u->liv_o = c3n; + car_u->liv_o = c3y; car_u->io.talk_f = _term_io_talk; car_u->io.kick_f = _term_io_kick; car_u->io.exit_f = _term_io_exit; diff --git a/pkg/urbit/vere/unix.c b/pkg/urbit/vere/unix.c index 8e2fc87ac..381c7376c 100644 --- a/pkg/urbit/vere/unix.c +++ b/pkg/urbit/vere/unix.c @@ -1268,13 +1268,15 @@ u3_unix_ef_ogre(u3_unix* unx_u, u3_noun mon) void u3_unix_ef_hill(u3_unix* unx_u, u3_noun hil) { - // XX set car_u->liv_o - // u3_noun mon; + for ( mon = hil; c3y == u3du(mon); mon = u3t(mon) ) { u3_umon* mon_u = _unix_get_mount_point(unx_u, u3k(u3h(mon))); _unix_scan_mount_point(unx_u, mon_u); } + + unx_u->car_u.liv_o = c3y; + u3z(hil); } From 3f476570c9a357d8557e2ec4a562530a753df57a Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 25 Apr 2020 17:57:03 -0700 Subject: [PATCH 041/257] vere: renames newt callback typedefs --- pkg/urbit/include/vere/vere.h | 22 +++++++++------------- pkg/urbit/vere/daemon.c | 20 +++++++++++--------- 2 files changed, 20 insertions(+), 22 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 4b4cd1c01..e884136ab 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -51,17 +51,13 @@ c3_s por_s; // target port } u3_lane; - /* u3_poke: poke callback function. + /* u3_moor_poke: poke callback function. */ - typedef void (*u3_poke)(void*, u3_atom); + typedef void (*u3_moor_poke)(void*, u3_atom); - /* u3_bail: bailout callback function. + /* u3_moor_bail: bailout callback function. */ - typedef void (*u3_bail)(void*, const c3_c* err_c); - - /* u3_done: completion function. - */ - typedef void (*u3_done)(void *); + typedef void (*u3_moor_bail)(void*, const c3_c* err_c); /* u3_mess: blob message in process. */ @@ -84,9 +80,9 @@ */ typedef struct _u3_moat { uv_pipe_t pyp_u; // input stream - u3_bail bal_f; // error response function + u3_moor_bail bal_f; // error response function void* vod_p; // callback pointer - u3_poke pok_f; // action function + u3_moor_poke pok_f; // action function struct _u3_mess* mes_u; // message in progress c3_d len_d; // length of stray bytes c3_y* rag_y; // stray bytes @@ -96,15 +92,15 @@ */ typedef struct _u3_mojo { uv_pipe_t pyp_u; // output stream - u3_bail bal_f; // error response function + u3_moor_bail bal_f; // error response function } u3_mojo; /* u3_moor: two-way message stream, linked list */ typedef struct _u3_moor { uv_pipe_t pyp_u; - u3_bail bal_f; + u3_moor_bail bal_f; void* vod_p; - u3_poke pok_f; + u3_moor_poke pok_f; struct _u3_mess* mes_u; c3_d len_d; c3_y* rag_y; diff --git a/pkg/urbit/vere/daemon.c b/pkg/urbit/vere/daemon.c index 9428dc566..844cb1c99 100644 --- a/pkg/urbit/vere/daemon.c +++ b/pkg/urbit/vere/daemon.c @@ -384,21 +384,23 @@ _daemon_root(u3_noun root) /* _daemon_bail(): bail for command socket newt */ void -_daemon_bail(u3_moor *vod_p, const c3_c *err_c) +_daemon_bail(void* vod_p, const c3_c *err_c) { - u3_moor *free_p; + u3_moor* mor_p = vod_p; + u3_moor* fre_p; + u3l_log("_daemon_bail: %s\r\n", err_c); - if ( vod_p == 0 ) { - free_p = u3K.cli_u; + if ( !mor_p ) { + fre_p = u3K.cli_u; u3K.cli_u = u3K.cli_u->nex_u; - c3_free(free_p); } else { - free_p = vod_p->nex_u; - vod_p->nex_u = vod_p->nex_u->nex_u; - c3_free(free_p); + fre_p = mor_p->nex_u; + mor_p->nex_u = fre_p->nex_u; } + + c3_free(fre_p); } /* _daemon_socket_connect(): callback for new connections @@ -425,7 +427,7 @@ _daemon_socket_connect(uv_stream_t *sock, int status) uv_pipe_init(u3L, &mor_u->pyp_u, 0); mor_u->pok_f = _daemon_fate; - mor_u->bal_f = (u3_bail)_daemon_bail; + mor_u->bal_f = _daemon_bail; uv_accept(sock, (uv_stream_t *)&mor_u->pyp_u); u3_newt_read((u3_moat *)mor_u); From 8935682067a515ed70e1d5af9afd91e7b78b1a67 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 25 Apr 2020 18:00:05 -0700 Subject: [PATCH 042/257] vere: begins vere.h header cleanup --- pkg/urbit/include/vere/vere.h | 17 ++--------------- 1 file changed, 2 insertions(+), 15 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index e884136ab..2a572ebb2 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -1,9 +1,7 @@ -/* include/v/vere.h -** -** This file is in the public domain. +/* include/vere/vere.h */ -#include "h2o.h" +#include /** Quasi-tunable parameters. **/ @@ -12,8 +10,6 @@ # define FirstKernel 164 # define DefaultKernel 164 -#define RECK - /** Data types. **/ @@ -35,15 +31,6 @@ c3_y hun_y[0]; } u3_hbod; - /* u3_chot: foreign host (not yet used). - */ - typedef struct _u3_chot { - c3_w ipf_w; // ip address (or 0) - c3_c* hot_c; // hostname (no port) (or 0) - void* ins_u; // insecure connection (or 0) - void* sec_u; // secure connection (or 0) - } u3_chot; - /* u3_lane: ames lane (IP address and port) */ typedef struct _u3_lane { From 6ec8f5fc4983e69264437b552f4470b57c8da15e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 25 Apr 2020 17:44:20 -0700 Subject: [PATCH 043/257] vere: WIP refactor types, enable peek --- pkg/urbit/include/vere/serf.h | 7 +- pkg/urbit/include/vere/vere.h | 162 +++++++------ pkg/urbit/vere/auto.c | 6 +- pkg/urbit/vere/disk.c | 19 +- pkg/urbit/vere/lord.c | 441 ++++++++++++++++++++-------------- pkg/urbit/vere/pier.c | 263 ++++++++++++-------- pkg/urbit/vere/save.c | 2 +- pkg/urbit/vere/term.c | 6 +- pkg/urbit/worker/serf.c | 47 +++- 9 files changed, 575 insertions(+), 378 deletions(-) diff --git a/pkg/urbit/include/vere/serf.h b/pkg/urbit/include/vere/serf.h index 7248d111e..b49533e90 100644 --- a/pkg/urbit/include/vere/serf.h +++ b/pkg/urbit/include/vere/serf.h @@ -34,10 +34,15 @@ c3_o u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret); + /* u3_serf_peek(): read namespace. + */ + u3_noun + u3_serf_peek(u3_serf* sef_u, u3_noun sam); + /* u3_serf_play(): apply event list, producing status. */ u3_noun - u3_serf_play(u3_serf* sef_u, c3_d evt_d, u3_noun lit); + u3_serf_play(u3_serf* sef_u, c3_d eve_d, u3_noun lit); /* u3_serf_work(): apply event, producing effects. */ diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 2a572ebb2..91c0f4ab5 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -293,69 +293,94 @@ /* u3_ovum: potential event */ typedef struct _u3_ovum { - struct _u3_auto* car_u; // backpointer to i/o driver void* vod_p; // context c3_l msc_l; // ms to timeout - u3_noun tar; // target + u3_noun tar; // target (in arvo) u3_noun wir; // wire u3_noun cad; // card - u3_atom pin; // spinner label - c3_o del_o; // spinner delay (c3y) + struct { // spinner + u3_atom lab; // label + c3_o del_o; // delay (c3y) + } pin_u; // struct _u3_ovum* pre_u; // previous ovum struct _u3_ovum* nex_u; // next ovum + struct _u3_auto* car_u; // backpointer to i/o driver } u3_ovum; - /* u3_fact: logged event + /* u3_fact: completed event */ typedef struct _u3_fact { c3_d eve_d; // event number - c3_l bug_l; // kernel mug before + c3_l bug_l; // kernel mug before XX remove c3_l mug_l; // kernel mug after - u3_noun job; // (pair date ovum) (XX or 0?) + u3_noun job; // (pair date ovum) struct _u3_fact* nex_u; // next in queue } u3_fact; - /* u3_play: batch of logged events + /* u3_gift: effects */ - typedef struct _u3_play { - struct _u3_fact* ent_u; // queue entry - struct _u3_fact* ext_u; // queue exit - } u3_play; + typedef struct _u3_gift { + c3_d eve_d; // causal event number + u3_noun act; // (list ovum) + struct _u3_gift* nex_u; // next in queue + } u3_gift; - /* u3_work: new event, while processsing + /* u3_info: ordered, contiguous slice of facts */ - typedef struct _u3_work { - struct _u3_ovum* egg_u; // unlinked ovum - c3_l bug_l; // kernel mug before - u3_noun job; // (pair date ovum) - c3_d eve_d; // event number - c3_l mug_l; // kernel mug after - u3_noun act; // action list - struct _u3_work* nex_u; - } u3_work; + typedef struct _u3_info { + u3_fact* ent_u; // queue entry (highest) + u3_fact* ext_u; // queue exit (lowest) + } u3_info; + + /* u3_peek_type: namespace read request types + */ + typedef enum { + u3_peek_just = 0, + u3_peek_last = 1 + } u3_peek_type; /* u3_peek: namespace read request */ typedef struct _u3_peek { - u3_noun now; // date - u3_noun gan; // (unit (set ship)) - u3_noun pat; // path (serialized beam) + c3_m car_m; // care + u3_noun gan; // leakset + u3_peek_type typ_e; // type-tagged + union { // + u3_noun pax; // /desk/case/... + struct { // + u3_atom des; // desk + u3_noun pax; // /... + } las_u; // + }; // } u3_peek; - /* u3_writ: new u3_writ + /* u3_writ_type: king->serf ipc message types + */ + typedef enum { + u3_writ_work = 0, + u3_writ_peek = 1, + u3_writ_play = 2, + u3_writ_save = 3, + u3_writ_pack = 4, + u3_writ_exit = 5 + } u3_writ_type; + + /* u3_writ: ipc message from king to serf */ typedef struct _u3_writ { - struct timeval tim_tv; // time enqueued + struct timeval tim_u; // time enqueued u3_atom mat; // serialized - c3_o sen_o; // sent - struct _u3_writ* nex_u; // next in queue, or 0 - c3_m typ_m; // tag + struct _u3_writ* nex_u; // next in queue + u3_writ_type typ_e; // type-tagged union { // - c3_w xit_w; // exit code - c3_d eve_d; // for %save or %snap - struct _u3_peek* pek_u; // read - struct _u3_play pay_u; // recompute - struct _u3_work* wok_u; // compute + struct { // work: + u3_ovum* egg_u; // origin + u3_noun job; // (pair date ovum) + } wok_u; // + u3_peek* pek_u; // peek + u3_info fon_u; // recompute + c3_d eve_d; // save/pack at + c3_w xit_w; // exit code }; } u3_writ; @@ -367,13 +392,13 @@ void (*slog_f)(void*, c3_w, u3_noun); void (*spin_f)(void*, u3_atom, c3_o); void (*spun_f)(void*); - void (*peek_f)(void*, u3_noun gan, u3_noun pat, u3_noun dat); - void (*play_done_f)(void*, u3_play, c3_l mug_l); - void (*play_bail_f)(void*, u3_play, c3_l mug_l, c3_d eve_d, u3_noun dud); - void (*work_done_f)(void*, u3_work*, c3_o wap_o); - void (*work_bail_f)(void*, u3_work*, u3_noun lud); - void (*save_f)(void*, c3_d eve_d); - void (*snap_f)(void*, c3_d eve_d); + void (*peek_f)(void*, u3_peek*, u3_noun); + void (*play_done_f)(void*, u3_info, c3_l mug_l); + void (*play_bail_f)(void*, u3_info, c3_l mug_l, c3_d eve_d, u3_noun dud); + void (*work_done_f)(void*, u3_ovum*, u3_fact*, u3_gift*); + void (*work_bail_f)(void*, u3_ovum*, u3_noun lud); + void (*save_f)(void*); + void (*pack_f)(void*); void (*exit_f)(void*, c3_o); } u3_lord_cb; @@ -406,7 +431,7 @@ */ typedef struct _u3_disk_cb { void* vod_p; - void (*read_done_f)(void*, u3_play); + void (*read_done_f)(void*, u3_info); void (*read_bail_f)(void*, c3_d eve_d); void (*write_done_f)(void*, c3_d eve_d); void (*write_bail_f)(void*, c3_d eve_d); @@ -426,7 +451,7 @@ uv_timer_t tim_u; // read timer uv_work_t ted_u; // write thread c3_o ted_o; // c3y == active - u3_play put_u; // write queue + u3_info put_u; // write queue } u3_disk; /* u3_boot: bootstrap event sequence @@ -456,16 +481,21 @@ struct _u3_wall* nex_u; } u3_wall; + /* u3_auto_cb: i/o driver callbacks + */ + typedef struct _u3_auto_cb { + void (*talk_f)(struct _u3_auto*); + c3_o (*kick_f)(struct _u3_auto*, u3_noun, u3_noun); + c3_w (*mark_f)(struct _u3_auto*); + void (*exit_f)(struct _u3_auto*); // XX close_cb? + } u3_auto_cb; + /* u3_auto: abstract i/o driver */ typedef struct _u3_auto { c3_m nam_m; c3_o liv_o; - struct { - void (*talk_f)(struct _u3_auto*); - c3_o (*kick_f)(struct _u3_auto*, u3_noun wir, u3_noun cad); - void (*exit_f)(struct _u3_auto*); // XX close_cb? - } io; + u3_auto_cb io; // XX io_u; struct { void (*drop_f)(struct _u3_auto*, u3_ovum*); void (*work_f)(struct _u3_auto*, u3_ovum*); @@ -500,9 +530,9 @@ } pay_u; // struct { // finished event queue: c3_d rel_d; // last released - u3_work* ent_u; // entry - u3_work* ext_u; // exit - } wok_u; // + u3_gift* ent_u; // entry + u3_gift* ext_u; // exit + } fec_u; // uv_prepare_t pep_u; // preloop registration uv_check_t cek_u; // postloop registration uv_idle_t idl_u; // postloop registration @@ -716,11 +746,7 @@ /* u3_disk_plan(): enqueue completed event for persistence. */ void - u3_disk_plan(u3_disk* log_u, - c3_d eve_d, - c3_l bug_l, - c3_l mug_l, - u3_noun job); + u3_disk_plan(u3_disk* log_u, u3_fact* tac_u); /* u3_lord_init(): start serf. */ @@ -735,15 +761,15 @@ void u3_lord_exit(u3_lord* god_u, c3_w cod_w); - /* u3_lord_save(): save portable state. + /* u3_lord_save(): save a snapshot. */ - void - u3_lord_save(u3_lord* god_u, c3_d eve_d); + c3_o + u3_lord_save(u3_lord* god_u); - /* u3_lord_snap(): take a fast snapshot. + /* u3_lord_pack(): save portable state. */ - void - u3_lord_snap(u3_lord* god_u, c3_d eve_d); + c3_o + u3_lord_pack(u3_lord* god_u); /* u3_lord_work(): attempt work. */ @@ -753,12 +779,12 @@ /* u3_lord_play(): recompute batch. */ void - u3_lord_play(u3_lord* god_u, u3_play pay_u); + u3_lord_play(u3_lord* god_u, u3_info fon_u); - /* u3_lord_peek(): read. + /* u3_lord_peek(): read namespace. */ void - u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun pat); + u3_lord_peek(u3_lord* god_u, u3_peek* pek_u); /** Filesystem (new api). **/ @@ -1021,10 +1047,10 @@ void u3_pier_bail(void); - /* u3_pier_snap(): request checkpoint. + /* u3_pier_save(): request checkpoint. */ void - u3_pier_snap(u3_pier* pir_u); + u3_pier_save(u3_pier* pir_u); /* u3_pier_stub(): get the One Pier for unreconstructed code. */ diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 98a363359..12664a339 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -38,8 +38,8 @@ u3_auto_plan(u3_auto* car_u, // spinner defaults // - egg_u->pin = u3k(u3h(wir)); - egg_u->del_o = c3y; + egg_u->pin_u.lab = u3k(u3h(wir)); + egg_u->pin_u.del_o = c3y; if ( !car_u->ent_u ) { c3_assert(!car_u->ext_u); @@ -184,7 +184,7 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) _auto_drop(egg_u); } - u3z(egg_u->pin); + u3z(egg_u->pin_u.lab); u3z(egg_u->tar); u3z(egg_u->wir); u3z(egg_u->cad); diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 356289152..457718ef6 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -234,20 +234,9 @@ _disk_commit(u3_disk* log_u) /* u3_disk_plan(): enqueue completed event for persistence. */ void -u3_disk_plan(u3_disk* log_u, - c3_d eve_d, - c3_l bug_l, - c3_l mug_l, - u3_noun job) +u3_disk_plan(u3_disk* log_u, u3_fact* tac_u) { - u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); - tac_u->bug_l = bug_l; - tac_u->mug_l = mug_l; - tac_u->eve_d = eve_d; - tac_u->nex_u = 0; - tac_u->job = job; - - c3_assert( (1ULL + log_u->sen_d) == eve_d ); + c3_assert( (1ULL + log_u->sen_d) == tac_u->eve_d ); log_u->sen_d++; if ( !log_u->put_u.ent_u ) { @@ -290,6 +279,8 @@ u3_disk_boot_plan(u3_disk* log_u, u3_noun job) fprintf(stderr, "disk: (%" PRIu64 "): db boot plan\r\n", tac_u->eve_d); #endif + // XX make explicit + // _disk_commit(log_u); } @@ -300,7 +291,7 @@ _disk_read_done_cb(uv_timer_t* tim_u) { struct _cd_read* red_u = tim_u->data; u3_disk* log_u = red_u->log_u; - u3_play pay_u = { .ent_u = red_u->ent_u, .ext_u = red_u->ext_u }; + u3_info pay_u = { .ent_u = red_u->ent_u, .ext_u = red_u->ext_u }; c3_assert( red_u->ent_u ); c3_assert( red_u->ext_u ); diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index c0bfb97a0..dc1b802c8 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -27,7 +27,7 @@ $% $: %live $% [%exit cod=@] [%save eve=@] - [%snap eve=@] + [%pack eve=@] == == [%peek now=date lyc=gang pat=path] [%play eve=@ lit=(list ?((pair date ovum) *))] @@ -53,7 +53,7 @@ -- */ -/* _lord_writ_pop(): pop the writ stack +/* _lord_writ_pop(): pop the writ stack. */ static u3_writ* _lord_writ_pop(u3_lord* god_u) @@ -75,17 +75,34 @@ _lord_writ_pop(u3_lord* god_u) return wit_u; } -/* _lord_writ_need(): require mote +/* _lord_writ_str(): writ labels for printing. +*/ +static inline const c3_c* +_lord_writ_str(u3_writ_type typ_e) +{ + switch ( typ_e ) { + default: c3_assert(0); + + case u3_writ_work: return "work"; + case u3_writ_peek: return "peek"; + case u3_writ_play: return "play"; + case u3_writ_save: return "save"; + case u3_writ_pack: return "pack"; + case u3_writ_exit: return "exit"; + } +} + +/* _lord_writ_need(): require writ type. */ static u3_writ* -_lord_writ_need(u3_lord* god_u, c3_m ned_m) +_lord_writ_need(u3_lord* god_u, u3_writ_type typ_e) { u3_writ* wit_u = _lord_writ_pop(god_u); - if ( ned_m != wit_u->typ_m ) { - fprintf(stderr, "lord: unexpected %%%.4s, expected %%%.4s\r\n", - (c3_c*)&wit_u->typ_m, - (c3_c*)&ned_m); + if ( typ_e != wit_u->typ_e ) { + fprintf(stderr, "lord: unexpected %%%s, expected %%%s\r\n", + _lord_writ_str(typ_e), + _lord_writ_str(wit_u->typ_e)); u3_pier_bail(); exit(1); } @@ -101,19 +118,17 @@ _lord_on_exit(uv_process_t* req_u, c3_i sig_i) { u3_lord* god_u = (void*)req_u; - c3_w xit_w; - { - u3_writ* wit_u =_lord_writ_need(god_u, c3__exit); - xit_w = wit_u->xit_w; - c3_free(wit_u); - } { void (*exit_f)(void*, c3_o) = god_u->cb_u.exit_f; void* vod_p = god_u->cb_u.vod_p; + // XX correct comparison? // - c3_o ret_o = ( xit_w == sas_i ) ? c3y : c3n; + c3_o ret_o = ( u3_writ_exit != god_u->ext_u->typ_e ) + ? c3n + : ( god_u->ext_u->xit_w == sas_i ) + ? c3y : c3n; // XX dispose god_u // @@ -140,6 +155,8 @@ _lord_bail(void* vod_p, fprintf(stderr, "\rpier: work error: %s\r\n", err_c); } +/* _lord_plea_foul(): +*/ static void _lord_plea_foul(u3_lord* god_u, c3_m mot_m, u3_noun dat) { @@ -166,20 +183,17 @@ _lord_plea_live(u3_lord* god_u, u3_noun dat) return _lord_plea_foul(god_u, c3__live, dat); } - switch ( wit_u->typ_m ) { + switch ( wit_u->typ_e ) { default: { - fprintf(stderr, "lord: unexpected %%live, expected %%%.4s\r\n", - (c3_c*)&wit_u->typ_m); - u3_pier_bail(); - exit(1); + return _lord_plea_foul(god_u, c3__live, dat); } break; - case c3__save: { - god_u->cb_u.save_f(god_u->cb_u.vod_p, wit_u->eve_d); + case u3_writ_save: { + god_u->cb_u.save_f(god_u->cb_u.vod_p); } break; - case c3__snap: { - god_u->cb_u.snap_f(god_u->cb_u.vod_p, wit_u->eve_d); + case u3_writ_pack: { + god_u->cb_u.pack_f(god_u->cb_u.vod_p); } break; } @@ -260,18 +274,17 @@ _lord_plea_peek(u3_lord* god_u, u3_noun dat) { u3_peek* pek_u; { - u3_writ* wit_u = _lord_writ_need(god_u, c3__peek); + u3_writ* wit_u = _lord_writ_need(god_u, u3_writ_peek); pek_u = wit_u->pek_u; - c3_free(wit_u); } - god_u->cb_u.peek_f(god_u->cb_u.vod_p, pek_u->gan, pek_u->pat, dat); + god_u->cb_u.peek_f(god_u->cb_u.vod_p, pek_u, dat); } /* _lord_plea_play_bail(): hear serf %play %bail */ static void -_lord_plea_play_bail(u3_lord* god_u, u3_play pay_u, u3_noun dat) +_lord_plea_play_bail(u3_lord* god_u, u3_info fon_u, u3_noun dat) { u3_noun eve, mug, dud; c3_d eve_d; @@ -282,32 +295,34 @@ _lord_plea_play_bail(u3_lord* god_u, u3_play pay_u, u3_noun dat) || (c3n == u3r_safe_word(mug, &mug_l)) || (c3n == u3a_is_cell(dud)) ) { - return _lord_plea_foul(god_u, c3__play, u3nc(c3__bail, dat)); + fprintf(stderr, "lord: invalid %%play\r\n"); + return _lord_plea_foul(god_u, c3__bail, dat); } god_u->eve_d = (eve_d - 1ULL); god_u->mug_l = mug_l; god_u->cb_u.play_bail_f(god_u->cb_u.vod_p, - pay_u, mug_l, eve_d, u3k(dud)); + fon_u, mug_l, eve_d, u3k(dud)); u3z(dat); } /* _lord_plea_play_done(): hear serf %play %done */ static void -_lord_plea_play_done(u3_lord* god_u, u3_play pay_u, u3_noun dat) +_lord_plea_play_done(u3_lord* god_u, u3_info fon_u, u3_noun dat) { c3_l mug_l; if ( c3n == u3r_safe_word(dat, &mug_l) ) { - return _lord_plea_foul(god_u, c3__play, u3nc(c3__done, dat)); + fprintf(stderr, "lord: invalid %%play\r\n"); + return _lord_plea_foul(god_u, c3__done, dat); } - god_u->eve_d = pay_u.ent_u->eve_d; + god_u->eve_d = fon_u.ent_u->eve_d; god_u->mug_l = mug_l; - god_u->cb_u.play_done_f(god_u->cb_u.vod_p, pay_u, mug_l); + god_u->cb_u.play_done_f(god_u->cb_u.vod_p, fon_u, mug_l); u3z(dat); } @@ -317,10 +332,10 @@ _lord_plea_play_done(u3_lord* god_u, u3_play pay_u, u3_noun dat) static void _lord_plea_play(u3_lord* god_u, u3_noun dat) { - u3_play pay_u; + u3_info fon_u; { - u3_writ* wit_u = _lord_writ_need(god_u, c3__play); - pay_u = wit_u->pay_u; + u3_writ* wit_u = _lord_writ_need(god_u, u3_writ_play); + fon_u = wit_u->fon_u; c3_free(wit_u); } @@ -333,22 +348,22 @@ _lord_plea_play(u3_lord* god_u, u3_noun dat) return _lord_plea_foul(god_u, c3__play, dat); } - case c3__bail: { - _lord_plea_play_bail(god_u, pay_u, u3k(u3t(dat))); + case c3__done: { + _lord_plea_play_done(god_u, fon_u, u3k(u3t(dat))); } break; - case c3__done: { - _lord_plea_play_done(god_u, pay_u, u3k(u3t(dat))); + case c3__bail: { + _lord_plea_play_bail(god_u, fon_u, u3k(u3t(dat))); } break; } u3z(dat); } -/* _lord_work_next(): update spinner if more work is in progress. -*/ -static void -_lord_work_next(u3_lord* god_u, c3_l bug_l) +/* _lord_work_spin(): update spinner if more work is in progress. + */ + static void +_lord_work_spin(u3_lord* god_u) { u3_writ* wit_u = god_u->ext_u; @@ -361,91 +376,113 @@ _lord_work_next(u3_lord* god_u, c3_l bug_l) // restart spinner if more work // while ( wit_u ) { - if ( c3__work != wit_u->typ_m ) { + if ( u3_writ_work != wit_u->typ_e ) { wit_u = wit_u->nex_u; } else { - u3_work* nex_u = wit_u->wok_u; - u3_ovum* egg_u = nex_u->egg_u; + u3_ovum* egg_u = wit_u->wok_u.egg_u; - // XX old log hack, remove - // - if ( bug_l ) { - nex_u->bug_l = bug_l; - } - - god_u->cb_u.spin_f(god_u->cb_u.vod_p, egg_u->pin, egg_u->del_o); + god_u->cb_u.spin_f(god_u->cb_u.vod_p, + egg_u->pin_u.lab, + egg_u->pin_u.del_o); god_u->pin_o = c3y; break; } } } +/* _lord_work_done(): +*/ +static void +_lord_work_done(u3_lord* god_u, + u3_ovum* egg_u, + c3_d eve_d, + c3_l mug_l, + u3_noun job, + u3_noun act) +{ + u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); + tac_u->bug_l = god_u->mug_l; + tac_u->mug_l = god_u->mug_l = mug_l; + tac_u->eve_d = god_u->eve_d = eve_d; + tac_u->nex_u = 0; + tac_u->job = job; + + u3_gift* gif_u = c3_malloc(sizeof(*gif_u)); + gif_u->eve_d = eve_d; + gif_u->nex_u = 0; + gif_u->act = act; + + _lord_work_spin(god_u); + + god_u->cb_u.work_done_f(god_u->cb_u.vod_p, egg_u, tac_u, gif_u); +} + + /* _lord_plea_work_bail(): hear serf %work %bail */ static void -_lord_plea_work_bail(u3_lord* god_u, u3_work* wok_u, u3_noun lud) +_lord_plea_work_bail(u3_lord* god_u, u3_ovum* egg_u, u3_noun lud) { - _lord_work_next(god_u, wok_u->bug_l); + _lord_work_spin(god_u); - god_u->cb_u.work_bail_f(god_u->cb_u.vod_p, wok_u, lud); + god_u->cb_u.work_bail_f(god_u->cb_u.vod_p, egg_u, lud); } /* _lord_plea_work_swap(): hear serf %work %swap */ static void -_lord_plea_work_swap(u3_lord* god_u, u3_work* wok_u, u3_noun dat) +_lord_plea_work_swap(u3_lord* god_u, u3_ovum* egg_u, u3_noun dat) { - u3_noun eve, mug, job, fec; + u3_noun eve, mug, job, act; c3_d eve_d; c3_l mug_l; - if ( (c3n == u3r_qual(dat, &eve, &mug, &job, &fec)) + if ( (c3n == u3r_qual(dat, &eve, &mug, &job, &act)) || (c3n == u3r_safe_chub(eve, &eve_d)) || (c3n == u3r_safe_word(mug, &mug_l)) || (c3n == u3a_is_cell(job)) ) { - return _lord_plea_foul(god_u, c3__work, u3nc(c3__swap, dat)); + // XX dispose egg_u + // + u3z(job); + fprintf(stderr, "lord: invalid %%work\r\n"); + return _lord_plea_foul(god_u, c3__swap, dat); + } + else { + u3k(job); u3k(act); + u3z(dat); + _lord_work_done(god_u, egg_u, eve_d, mug_l, job, act); } - - wok_u->eve_d = god_u->eve_d = eve_d; - wok_u->mug_l = god_u->mug_l = mug_l; - u3z(wok_u->job); - wok_u->job = u3k(job); - wok_u->act = u3k(fec); - - _lord_work_next(god_u, mug_l); - - god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u, c3y); - - u3z(dat); } /* _lord_plea_work_done(): hear serf %work %done */ static void -_lord_plea_work_done(u3_lord* god_u, u3_work* wok_u, u3_noun dat) +_lord_plea_work_done(u3_lord* god_u, + u3_ovum* egg_u, + u3_noun job, + u3_noun dat) { - u3_noun eve, mug, fec; + u3_noun eve, mug, act; c3_d eve_d; c3_l mug_l; - if ( (c3n == u3r_trel(dat, &eve, &mug, &fec)) + if ( (c3n == u3r_trel(dat, &eve, &mug, &act)) || (c3n == u3r_safe_chub(eve, &eve_d)) || (c3n == u3r_safe_word(mug, &mug_l)) ) { - return _lord_plea_foul(god_u, c3__work, u3nc(c3__work, dat)); + // XX dispose egg_u + // + u3z(job); + fprintf(stderr, "lord: invalid %%work\r\n"); + return _lord_plea_foul(god_u, c3__done, dat); + } + else { + u3k(act); + u3z(dat); + _lord_work_done(god_u, egg_u, eve_d, mug_l, job, act); } - - wok_u->eve_d = god_u->eve_d = eve_d; - wok_u->mug_l = god_u->mug_l = mug_l; - wok_u->act = u3k(fec); - - _lord_work_next(god_u, mug_l); - - god_u->cb_u.work_done_f(god_u->cb_u.vod_p, wok_u, c3n); - - u3z(dat); } /* _lord_plea_work(): hear serf %work response @@ -453,54 +490,66 @@ _lord_plea_work_done(u3_lord* god_u, u3_work* wok_u, u3_noun dat) static void _lord_plea_work(u3_lord* god_u, u3_noun dat) { - u3_work* wok_u; + u3_ovum* egg_u; + u3_noun job; + { - u3_writ* wit_u = _lord_writ_need(god_u, c3__work); - wok_u = wit_u->wok_u; + u3_writ* wit_u = _lord_writ_need(god_u, u3_writ_work); + egg_u = wit_u->wok_u.egg_u; + job = wit_u->wok_u.job; c3_free(wit_u); } if ( c3n == u3a_is_cell(dat) ) { + // XX dispose egg_u + // + u3z(job); return _lord_plea_foul(god_u, c3__work, dat); } switch ( u3h(dat) ) { default: { + // XX dispose egg_u + // + u3z(job); return _lord_plea_foul(god_u, c3__work, dat); } break; - case c3__bail: { - _lord_plea_work_bail(god_u, wok_u, u3k(u3t(dat))); + case c3__done: { + _lord_plea_work_done(god_u, egg_u, job, u3k(u3t(dat))); } break; case c3__swap: { - _lord_plea_work_swap(god_u, wok_u, u3k(u3t(dat))); + u3z(job); + _lord_plea_work_swap(god_u, egg_u, u3k(u3t(dat))); } break; - case c3__done: { - _lord_plea_work_done(god_u, wok_u, u3k(u3t(dat))); + case c3__bail: { + u3z(job); + _lord_plea_work_bail(god_u, egg_u, u3k(u3t(dat))); } break; } u3z(dat); } -/* _lord_poke(): handle plea from serf. +/* _lord_plea(): handle plea from serf. */ static void -_lord_poke(void* vod_p, u3_noun mat) +_lord_plea(void* vod_p, u3_noun mat) { u3_lord* god_u = vod_p; u3_noun jar = u3ke_cue(mat); u3_noun tag, dat; if ( c3n == u3r_cell(jar, &tag, &dat) ) { - return _lord_plea_foul(god_u, u3_blip, jar); + u3m_p("jar", jar); + return _lord_plea_foul(god_u, 0, jar); } switch ( tag ) { default: { - return _lord_plea_foul(god_u, u3_blip, jar); + return _lord_plea_foul(god_u, 0, jar); } case c3__work: { @@ -537,11 +586,40 @@ static u3_writ* _lord_writ_new(u3_lord* god_u) { u3_writ* wit_u = c3_calloc(sizeof(*wit_u)); - wit_u->sen_o = c3n; - gettimeofday(&wit_u->tim_tv, 0); + gettimeofday(&wit_u->tim_u, 0); return wit_u; } +/* _lord_writ_peek(): serialize read +*/ +static u3_noun +_lord_writ_peek(u3_noun now, u3_noun our, u3_peek* pek_u) +{ + u3_noun bem; + + { + u3_noun car = u3k(pek_u->car_m); + + switch ( pek_u->typ_e ) { + default: c3_assert(0); + + case u3_peek_just: { + bem = u3nt(car, our, u3k(pek_u->pax)); + } break; + + case u3_peek_last: { + u3_noun des = u3k(pek_u->las_u.des); + u3_noun cas = u3dc("scot", c3__da, u3k(now)); + u3_noun pax = u3k(pek_u->las_u.pax); + + bem = u3nc(car, u3nq(our, des, cas, pax)); + } break; + } + } + + return u3nt(now, u3k(pek_u->gan), bem); +} + /* _lord_writ_jam(): serialize writ. */ static void @@ -550,37 +628,25 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) if ( 0 == wit_u->mat ) { u3_noun msg; - switch ( wit_u->typ_m ) { + switch ( wit_u->typ_e ) { default: c3_assert(0); - case c3__exit: { - // XX u3_newt_close on send + case u3_writ_work: { + msg = u3nc(c3__work, u3k(wit_u->wok_u.job)); + } break; + + case u3_writ_peek: { + // XX cache // - msg = u3nt(c3__live, c3__exit, u3i_words(1, &wit_u->xit_w)); + u3_noun our = u3dc("scot", 'p', u3i_chubs(2, ((u3_pier*)god_u->cb_u.vod_p)->who_d)); + u3_noun now = u3_time_in_tv(&wit_u->tim_u); + u3_noun sam = _lord_writ_peek(now, our, wit_u->pek_u); + + msg = u3nc(c3__peek, sam); } break; - case c3__save: { - if ( !wit_u->eve_d ) { - wit_u->eve_d = god_u->eve_d; - } - - msg = u3nt(c3__live, c3__save, u3i_chubs(1, &wit_u->eve_d)); - } break; - - case c3__snap: { - if ( !wit_u->eve_d ) { - wit_u->eve_d = god_u->eve_d; - } - - msg = u3nt(c3__live, c3__snap, u3i_chubs(1, &wit_u->eve_d)); - } break; - - case c3__peek: { - c3_stub; - } break; - - case c3__play: { - u3_fact* tac_u = wit_u->pay_u.ext_u; + case u3_writ_play: { + u3_fact* tac_u = wit_u->fon_u.ext_u; c3_d eve_d = tac_u->eve_d; u3_noun lit = u3_nul; @@ -590,10 +656,21 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) } msg = u3nt(c3__play, u3i_chubs(1, &eve_d), u3kb_flop(lit)); + } break; - case c3__work: { - msg = u3nc(c3__work, u3k(wit_u->wok_u->job)); + case u3_writ_save: { + msg = u3nt(c3__live, c3__save, u3i_chubs(1, &god_u->eve_d)); + } break; + + case u3_writ_pack: { + msg = u3nt(c3__live, c3__pack, u3i_chubs(1, &god_u->eve_d)); + } break; + + case u3_writ_exit: { + // XX u3_newt_close on send + // + msg = u3nt(c3__live, c3__exit, u3i_words(1, &wit_u->xit_w)); } break; } @@ -606,18 +683,16 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) static void _lord_writ_send(u3_lord* god_u, u3_writ* wit_u) { - if ( c3n == wit_u->sen_o ) { - _lord_writ_jam(god_u, wit_u); - u3_newt_write(&god_u->inn_u, wit_u->mat, 0); - wit_u->sen_o = c3y; - wit_u->mat = 0; - // ignore subprocess error on shutdown - // - if ( c3__exit == wit_u->typ_m ) { - god_u->out_u.bal_f = _lord_bail_noop; - god_u->inn_u.bal_f = _lord_bail_noop; - } + _lord_writ_jam(god_u, wit_u); + u3_newt_write(&god_u->inn_u, wit_u->mat, 0); + wit_u->mat = 0; + + // ignore subprocess error on shutdown + // + if ( u3_writ_exit == wit_u->typ_e ) { + god_u->out_u.bal_f = _lord_bail_noop; + god_u->inn_u.bal_f = _lord_bail_noop; } } @@ -641,55 +716,61 @@ _lord_writ_plan(u3_lord* god_u, u3_writ* wit_u) _lord_writ_send(god_u, wit_u); } -/* u3_lord_save(): save portable state. +/* u3_lord_save(): save a snapshot. */ -void -u3_lord_save(u3_lord* god_u, c3_d eve_d) +c3_o +u3_lord_save(u3_lord* god_u) { - u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__save; - wit_u->eve_d = eve_d; - - _lord_writ_plan(god_u, wit_u); + if ( god_u->dep_w ) { + return c3n; + } + else { + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_e = u3_writ_save; + _lord_writ_plan(god_u, wit_u); + return c3y; + } } -/* u3_lord_snap(): take a fast snapshot. +/* u3_lord_pack(): save portable state. */ -void -u3_lord_snap(u3_lord* god_u, c3_d eve_d) +c3_o +u3_lord_pack(u3_lord* god_u) { - u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__snap; - wit_u->eve_d = eve_d; - - _lord_writ_plan(god_u, wit_u); + if ( god_u->dep_w ) { + return c3n; + } + else { + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_e = u3_writ_pack; + _lord_writ_plan(god_u, wit_u); + return c3y; + } } -/* u3_lord_peek(): read. +/* u3_lord_peek(): read namespace. */ void -u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun pat) +u3_lord_peek(u3_lord* god_u, u3_peek* pek_u) { u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__peek; - wit_u->pek_u = c3_malloc(sizeof(*wit_u->pek_u)); - wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_tv); - wit_u->pek_u->gan = gan; - wit_u->pek_u->pat = pat; - + wit_u->typ_e = u3_writ_peek; + wit_u->pek_u = pek_u; _lord_writ_plan(god_u, wit_u); } /* u3_lord_play(): recompute batch. */ void -u3_lord_play(u3_lord* god_u, u3_play pay_u) +u3_lord_play(u3_lord* god_u, u3_info fon_u) { u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__play; - wit_u->pay_u = pay_u; + wit_u->typ_e = u3_writ_play; + wit_u->fon_u = fon_u; - c3_assert( !pay_u.ent_u->nex_u ); + // XX wat do? + // + // c3_assert( !pay_u.ent_u->nex_u ); _lord_writ_plan(god_u, wit_u); } @@ -700,23 +781,20 @@ void u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo) { u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__work; - wit_u->wok_u = c3_calloc(sizeof(*wit_u->wok_u)); - wit_u->wok_u->egg_u = egg_u; + wit_u->typ_e = u3_writ_work; + wit_u->wok_u.egg_u = egg_u; { - u3_noun now = u3_time_in_tv(&wit_u->tim_tv); - wit_u->wok_u->job = u3nc(now, ovo); - } - - if ( !god_u->ent_u ) { - wit_u->wok_u->bug_l = god_u->mug_l; + u3_noun now = u3_time_in_tv(&wit_u->tim_u); + wit_u->wok_u.job = u3nc(now, ovo); } // if not spinning, start // if ( c3n == god_u->pin_o ) { - god_u->cb_u.spin_f(god_u->cb_u.vod_p, egg_u->pin, egg_u->del_o); + god_u->cb_u.spin_f(god_u->cb_u.vod_p, + egg_u->pin_u.lab, + egg_u->pin_u.del_o); god_u->pin_o = c3y; } @@ -729,9 +807,8 @@ void u3_lord_exit(u3_lord* god_u, c3_w cod_w) { u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_m = c3__exit; + wit_u->typ_e = u3_writ_exit; wit_u->xit_w = cod_w; - _lord_writ_plan(god_u, wit_u); } @@ -804,7 +881,7 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) // { god_u->out_u.vod_p = god_u; - god_u->out_u.pok_f = _lord_poke; + god_u->out_u.pok_f = _lord_plea; god_u->out_u.bal_f = _lord_bail; // XX distinguish from out_u.bal_f ? diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 4de0118db..4caa19bf6 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -79,96 +79,133 @@ _pier_work_send(u3_pier* pir_u) } } -/* _pier_work_plan(): enqueue computed events, send to disk. +/* _pier_gift_plan(): enqueue effects. */ static void -_pier_work_plan(u3_pier* pir_u, u3_work* wok_u) +_pier_gift_plan(u3_pier* pir_u, u3_gift* gif_u) { - c3_assert( wok_u->eve_d > pir_u->wok_u.rel_d ); - c3_assert( wok_u->eve_d > pir_u->log_u->sen_d ); + c3_assert( gif_u->eve_d > pir_u->fec_u.rel_d ); #ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): compute: complete\r\n", wok_u->eve_d); + fprintf(stderr, "pier: (%" PRIu64 "): compute: complete\r\n", gif_u->eve_d); #endif - wok_u->nex_u = 0; + gif_u->nex_u = 0; - if ( !pir_u->wok_u.ent_u ) { - c3_assert( !pir_u->wok_u.ext_u ); - pir_u->wok_u.ent_u = pir_u->wok_u.ext_u = wok_u; + if ( !pir_u->fec_u.ent_u ) { + c3_assert( !pir_u->fec_u.ext_u ); + pir_u->fec_u.ent_u = pir_u->fec_u.ext_u = gif_u; } else { - pir_u->wok_u.ent_u->nex_u = wok_u; - pir_u->wok_u.ent_u = wok_u; + pir_u->fec_u.ent_u->nex_u = gif_u; + pir_u->fec_u.ent_u = gif_u; } - - // XX this is a departure from the general organization of this file - // - -#ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): disk: plan\r\n", wok_u->eve_d); -#endif - u3_disk_plan(pir_u->log_u, - wok_u->eve_d, - wok_u->bug_l, - wok_u->mug_l, - u3k(wok_u->job)); } -/* _pier_work_next(): dequeue finished events for effect application +/* _pier_gift_next(): dequeue effect. */ -static u3_work* -_pier_work_next(u3_pier* pir_u) +static u3_gift* +_pier_gift_next(u3_pier* pir_u) { u3_disk* log_u = pir_u->log_u; - u3_work* wok_u = pir_u->wok_u.ext_u; + u3_gift* gif_u = pir_u->fec_u.ext_u; - if ( !wok_u || (wok_u->eve_d > log_u->dun_d) ) { + if ( !gif_u || (gif_u->eve_d > log_u->dun_d) ) { return 0; } else { - pir_u->wok_u.ext_u = wok_u->nex_u; + pir_u->fec_u.ext_u = gif_u->nex_u; - if ( !pir_u->wok_u.ext_u ) { - pir_u->wok_u.ent_u = 0; + if ( !pir_u->fec_u.ext_u ) { + pir_u->fec_u.ent_u = 0; } - c3_assert( (1ULL + pir_u->wok_u.rel_d) == wok_u->eve_d ); - pir_u->wok_u.rel_d = wok_u->eve_d; + c3_assert( (1ULL + pir_u->fec_u.rel_d) == gif_u->eve_d ); + pir_u->fec_u.rel_d = gif_u->eve_d; - return wok_u; + return gif_u; } } -/* _pier_work_kick(): apply effects. +/* _pier_gift_kick(): apply effects. */ static void -_pier_work_kick(u3_pier* pir_u) +_pier_gift_kick(u3_pier* pir_u) { - u3_work* wok_u; + u3_gift* gif_u; - while ( (wok_u = _pier_work_next(pir_u)) ) { + while ( (gif_u = _pier_gift_next(pir_u)) ) { #ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", wok_u->eve_d); + fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", gif_u->eve_d); #endif - u3_auto_kick(pir_u->car_u, wok_u->act); - - if ( wok_u->egg_u ) { - u3_auto_drop(0, wok_u->egg_u); - } + u3_auto_kick(pir_u->car_u, gif_u->act); // XX dispose properly // - c3_free(wok_u); + c3_free(gif_u); } } +/* u3_pier_peek_as(): +*/ +void +u3_pier_peek_as(u3_pier* pir_u, + u3_noun gan, + c3_m car_m, + u3_noun pax) +{ + u3_peek* pek_u = c3_malloc(sizeof(*pek_u)); + pek_u->car_m = car_m; + pek_u->gan = gan; + pek_u->typ_e = u3_peek_just; + pek_u->pax = pax; + + u3_lord_peek(pir_u->god_u, pek_u); +} + +/* u3_pier_peek(): +*/ +void +u3_pier_peek(u3_pier* pir_u, c3_m car_m, u3_noun pax) +{ + u3_pier_peek_as(pir_u, u3nc(u3_nul, u3_nul), car_m, pax); +} + +/* u3_pier_peep_as(): +*/ +void +u3_pier_peep_as(u3_pier* pir_u, + u3_noun gan, + c3_m car_m, + u3_atom des, + u3_noun pax) +{ + u3_peek* pek_u = c3_malloc(sizeof(*pek_u)); + pek_u->car_m = car_m; + pek_u->gan = gan; + pek_u->typ_e = u3_peek_last; + pek_u->las_u.des = des; + pek_u->las_u.pax = pax; + + u3_lord_peek(pir_u->god_u, pek_u); +} + +/* u3_pier_peep(): +*/ +void +u3_pier_peep(u3_pier* pir_u, + c3_m car_m, + u3_atom des, + u3_noun pax) +{ + u3_pier_peep_as(pir_u, u3nc(u3_nul, u3_nul), car_m, des, pax); +} + /* _pier_work(): advance event processing. */ static void _pier_work(u3_pier* pir_u) { - if ( c3n == pir_u->liv_o ) { pir_u->liv_o = u3_auto_live(pir_u->car_u); @@ -189,13 +226,13 @@ _pier_work(u3_pier* pir_u) } _pier_work_send(pir_u); - _pier_work_kick(pir_u); + _pier_gift_kick(pir_u); } /* _pier_play_plan(): enqueue events for replay. */ static void -_pier_play_plan(u3_pier* pir_u, u3_play pay_u) +_pier_play_plan(u3_pier* pir_u, u3_info pay_u) { u3_fact** ext_u; c3_d old_d; @@ -225,22 +262,22 @@ _pier_play_plan(u3_pier* pir_u, u3_play pay_u) /* _pier_play_send(): detach a batch of up to [len_d] events from queue. */ -static u3_play +static u3_info _pier_play_next(u3_pier* pir_u, c3_d len_d) { u3_fact* tac_u = pir_u->pay_u.ext_u; - u3_play pay_u; + u3_info fon_u; // set batch entry and exit pointers // { - pay_u.ext_u = tac_u; + fon_u.ext_u = tac_u; while ( len_d-- && tac_u->nex_u ) { tac_u = tac_u->nex_u; } - pay_u.ent_u = tac_u; + fon_u.ent_u = tac_u; } // detatch batch from queue @@ -253,7 +290,7 @@ _pier_play_next(u3_pier* pir_u, c3_d len_d) pir_u->pay_u.ent_u = pir_u->pay_u.ext_u = 0; } - return pay_u; + return fon_u; } /* _pier_play_send(): send a batch of events to the worker for replay. @@ -270,17 +307,17 @@ _pier_play_send(u3_pier* pir_u) c3_d len_d = ( !pir_u->pay_u.sen_d ) ? c3_max(pir_u->lif_w, PIER_PLAY_BATCH) : PIER_PLAY_BATCH; - u3_play pay_u = _pier_play_next(pir_u, len_d); + u3_info fon_u = _pier_play_next(pir_u, len_d); // bump sent counter // - pir_u->pay_u.sen_d = pay_u.ent_u->eve_d; + pir_u->pay_u.sen_d = fon_u.ent_u->eve_d; #ifdef VERBOSE_PIER - fprintf(stderr, "pier: play send %" PRIu64 "-%" PRIu64 "\r\n", pay_u.ext_u->eve_d, pay_u.ent_u->eve_d); + fprintf(stderr, "pier: play send %" PRIu64 "-%" PRIu64 "\r\n", fon_u.ext_u->eve_d, fon_u.ent_u->eve_d); #endif - u3_lord_play(pir_u->god_u, pay_u); + u3_lord_play(pir_u->god_u, fon_u); } } @@ -456,7 +493,7 @@ _pier_next(u3_pier* pir_u) } case u3_peat_done: { - _pier_work_kick(pir_u); + _pier_gift_kick(pir_u); break; } @@ -491,15 +528,21 @@ _pier_on_lord_slog(void* vod_p, c3_w pri_w, u3_noun tan) /* _pier_on_lord_peek(): namespace read response from worker. */ static void -_pier_on_lord_peek(void* vod_p, u3_noun gan, u3_noun pat, u3_noun dat); +_pier_on_lord_peek(void* vod_p, u3_peek* pek_u, u3_noun dat) +{ + // XX cache, invoke callback, dispose pek_u + // + u3m_p("lord peek", dat); + u3z(dat); +} /* _pier_on_lord_play_done(): log replay batch completion from worker. */ static void -_pier_on_lord_play_done(void* vod_p, u3_play pay_u, c3_l mug_l) +_pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) { u3_pier* pir_u = vod_p; - c3_d las_d = pay_u.ent_u->eve_d; + c3_d las_d = fon_u.ent_u->eve_d; #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): play: done\r\n", las_d); @@ -507,17 +550,17 @@ _pier_on_lord_play_done(void* vod_p, u3_play pay_u, c3_l mug_l) // XX optional // - if ( pay_u.ent_u->mug_l - && (pay_u.ent_u->mug_l != mug_l) ) + if ( fon_u.ent_u->mug_l + && (fon_u.ent_u->mug_l != mug_l) ) { // XX printf // - u3l_log("pier: (%" PRIu64 "): play: mug mismatch %x %x\r\n", las_d, pay_u.ent_u->mug_l, mug_l); + u3l_log("pier: (%" PRIu64 "): play: mug mismatch %x %x\r\n", las_d, fon_u.ent_u->mug_l, mug_l); // u3_pier_bail(); } { - u3_fact* tac_u = pay_u.ext_u; + u3_fact* tac_u = fon_u.ext_u; u3_fact* nex_u; while ( tac_u ) { @@ -534,7 +577,7 @@ _pier_on_lord_play_done(void* vod_p, u3_play pay_u, c3_l mug_l) /* _pier_on_lord_play_bail(): log replay batch failure from worker. */ static void -_pier_on_lord_play_bail(void* vod_p, u3_play pay_u, +_pier_on_lord_play_bail(void* vod_p, u3_info fon_u, c3_l mug_l, c3_d eve_d, u3_noun dud) { #ifdef VERBOSE_PIER @@ -578,25 +621,40 @@ _pier_on_lord_work_spun(void* vod_p) /* _pier_on_lord_work_done(): event completion from worker. */ static void -_pier_on_lord_work_done(void* vod_p, u3_work* wok_u, c3_o wap_o) +_pier_on_lord_work_done(void* vod_p, + u3_ovum* egg_u, + u3_fact* tac_u, + u3_gift* gif_u) { u3_pier* pir_u = vod_p; #ifdef VERBOSE_PIER - fprintf(stderr, "pier (%" PRIu64 "): work: %s\r\n", - wok_u->eve_d, - ( c3y == wap_o ) ? "swap" : "done"); + fprintf(stderr, "pier (%" PRIu64 "): work: done\r\n", tac_u->eve_d); #endif - u3_auto_done(wok_u->egg_u, wap_o); - _pier_work_plan(pir_u, wok_u); + // XX revise + // + u3_auto_done(egg_u, c3n); + u3_auto_drop(0, egg_u); + + _pier_gift_plan(pir_u, gif_u); + + // XX this is a departure from the general organization of this file + // + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): disk: plan\r\n", tac_u->eve_d); +#endif + + u3_disk_plan(pir_u->log_u, tac_u); + _pier_next(pir_u); } /* _pier_on_lord_work_bail(): event failure from worker. */ static void -_pier_on_lord_work_bail(void* vod_p, u3_work* wok_u, u3_noun lud) +_pier_on_lord_work_bail(void* vod_p, u3_ovum* egg_u, u3_noun lud) { u3_pier* pir_u = vod_p; @@ -604,38 +662,34 @@ _pier_on_lord_work_bail(void* vod_p, u3_work* wok_u, u3_noun lud) fprintf(stderr, "pier: work: bail\r\n"); #endif - u3_auto_bail(wok_u->egg_u, lud); - - // XX dispose wok_u - // - wok_u->egg_u = 0; + u3_auto_bail(egg_u, lud); _pier_next(pir_u); } -/* _pier_on_lord_save(): worker state-export complete (portable snapshot). +/* _pier_on_lord_save(): worker (non-portable) snapshot complete. */ static void -_pier_on_lord_save(void* vod_p, c3_d eve_d) +_pier_on_lord_save(void* vod_p) { u3_pier* pir_u = vod_p; #ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): lord: snap\r\n", eve_d); + fprintf(stderr, "pier: (%" PRIu64 "): lord: save\r\n", pir_u->god_u->eve_d); #endif _pier_next(pir_u); } -/* _pier_on_lord_snap(): worker (non-portable) snapshot complete. +/* _pier_on_lord_pack(): worker state-export complete (portable snapshot). */ static void -_pier_on_lord_snap(void* vod_p, c3_d eve_d) +_pier_on_lord_pack(void* vod_p) { u3_pier* pir_u = vod_p; #ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): lord: snap\r\n", eve_d); + fprintf(stderr, "pier: (%" PRIu64 "): lord: pack\r\n", pir_u->god_u->eve_d); #endif _pier_next(pir_u); @@ -705,7 +759,7 @@ _pier_on_lord_live(void* vod_p) /* _pier_on_disk_read_done(): event log read success. */ static void -_pier_on_disk_read_done(void* vod_p, u3_play pay_u) +_pier_on_disk_read_done(void* vod_p, u3_info pay_u) { u3_pier* pir_u = vod_p; @@ -744,7 +798,7 @@ _pier_on_disk_write_done(void* vod_p, c3_d eve_d) #endif if ( u3_peat_boot == pir_u->sat_e ) { - pir_u->wok_u.rel_d = eve_d; + pir_u->fec_u.rel_d = eve_d; // wait if we're still committing the boot sequence // @@ -879,7 +933,7 @@ _pier_init(c3_w wag_w, c3_c* pax_c) return 0; } - pir_u->wok_u.rel_d = pir_u->log_u->dun_d; + pir_u->fec_u.rel_d = pir_u->log_u->dun_d; } // start the worker process @@ -899,13 +953,13 @@ _pier_init(c3_w wag_w, c3_c* pax_c) .spin_f = _pier_on_lord_work_spin, .spun_f = _pier_on_lord_work_spun, .slog_f = _pier_on_lord_slog, - // .peek_f = _pier_on_lord_peek, + .peek_f = _pier_on_lord_peek, .play_done_f = _pier_on_lord_play_done, .play_bail_f = _pier_on_lord_play_bail, .work_done_f = _pier_on_lord_work_done, .work_bail_f = _pier_on_lord_work_bail, .save_f = _pier_on_lord_save, - .snap_f = _pier_on_lord_snap, + .pack_f = _pier_on_lord_pack, .exit_f = _pier_on_lord_exit }; @@ -1166,14 +1220,23 @@ static void _pier_save_cb(void* vod_p, c3_d eve_d) { u3_pier* pir_u = vod_p; - u3_lord_save(pir_u->god_u, eve_d); + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): save: send at %" PRIu64 "\r\n", pir_u->god_u->eve_d, eve_d); +#endif + + u3_lord_save(pir_u->god_u); } -/* u3_pier_save(): save a portable snapshot. +/* u3_pier_save(): save a non-portable snapshot */ void u3_pier_save(u3_pier* pir_u) { +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): save: plan\r\n", pir_u->god_u->eve_d); +#endif + _pier_wall_plan(pir_u, 0, pir_u, _pier_save_cb); } @@ -1181,14 +1244,23 @@ static void _pier_snap_cb(void* vod_p, c3_d eve_d) { u3_pier* pir_u = vod_p; - u3_lord_snap(pir_u->god_u, eve_d); + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): snap: send at %" PRIu64 "\r\n", pir_u->god_u->eve_d, eve_d); +#endif + + u3_lord_pack(pir_u->god_u); } -/* u3_pier_snap(): save a non-portable snapshot +/* u3_pier_pack(): save a portable snapshot. */ void -u3_pier_snap(u3_pier* pir_u) +u3_pier_pack(u3_pier* pir_u) { +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): snap: plan\r\n", pir_u->god_u->eve_d); +#endif + _pier_wall_plan(pir_u, 0, pir_u, _pier_snap_cb); } @@ -1206,7 +1278,8 @@ u3_pier_exit(u3_pier* pir_u) { pir_u->sat_e = u3_peat_done; - u3_pier_snap(pir_u); + + u3_pier_save(pir_u); u3_disk_exit(pir_u->log_u); u3_auto_exit(pir_u->car_u); _pier_wall_plan(pir_u, 0, pir_u, _pier_exit_cb); diff --git a/pkg/urbit/vere/save.c b/pkg/urbit/vere/save.c index 63ad73876..e2c042b24 100644 --- a/pkg/urbit/vere/save.c +++ b/pkg/urbit/vere/save.c @@ -17,7 +17,7 @@ static void _save_time_cb(uv_timer_t* tim_u) { u3_pier *pir_u = tim_u->data; - u3_pier_snap(pir_u); + u3_pier_save(pir_u); } /* u3_save_ef_chld(): report save termination. diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 421564546..5089d2e36 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -603,8 +603,8 @@ _term_ovum_plan(u3_auto* car_u, u3_noun wir, u3_noun cad) // term events have no spinner label // - u3z(egg_u->pin); - egg_u->pin = u3_blip; + u3z(egg_u->pin_u.lab); + egg_u->pin_u.lab = u3_blip; return egg_u; } @@ -628,7 +628,7 @@ _term_io_belt(u3_utty* uty_u, u3_noun blb) // no spinner delay on %ret // if ( c3__ret == u3h(blb) ) { - egg_u->del_o = c3n; + egg_u->pin_u.del_o = c3n; } } } diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 132e6f4e7..db286742e 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -31,7 +31,7 @@ $% $: %live $% [%exit cod=@] [%save eve=@] - [%snap eve=@] + [%pack eve=@] == == [%peek now=date lyc=gang pat=path] [%play eve=@ lit=(list ?((pair date ovum) *))] @@ -811,13 +811,37 @@ u3_serf_play(u3_serf* sef_u, c3_d eve_d, u3_noun lit) : _serf_play_list(sef_u, lit)); } -// /* _serf_poke_peek(): dereference namespace. -// */ -// static void -// _serf_poke_peek(u3_noun now, u3_noun pat) -// { -// // XX u3v_peek -// } +/* u3_serf_peek(): dereference namespace. +*/ +u3_noun +u3_serf_peek(u3_serf* sef_u, u3_noun sam) +{ + u3_noun now, lyc, pat, wen, gon, pro; + u3x_trel(sam, &now, &lyc, &pat); + + wen = u3A->now; + u3A->now = u3k(now); + + // XX pass lyc as well + // + gon = u3v_peek(u3k(pat)); + + // XX preserve mark in arvo + // + if ( u3_nul == gon ) { + pro = u3_nul; + } + else { + pro = u3nt(u3_nul, c3__noun, u3k(u3t(gon))); + u3z(gon); + } + + u3z(u3A->now); + u3A->now = wen; + + u3z(sam); + return u3nc(c3__peek, pro); +} /* _serf_writ_live_exit(): exit on command. */ @@ -916,11 +940,11 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) // XX // - case c3__save: { + case c3__pack: { c3_stub; } - case c3__snap: { + case c3__save: { c3_d eve_d; if ( c3n == u3r_safe_chub(dat, &eve_d) ) { @@ -980,7 +1004,8 @@ u3_serf_writ(u3_serf* sef_u, u3_noun wit, u3_noun* pel) } break; case c3__peek: { - c3_stub; + *pel = u3_serf_peek(sef_u, u3k(com)); + ret_o = c3y; } break; case c3__play: { From e80f6f8539927f8f444d89999bc78b5b40eb1da7 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sun, 26 Apr 2020 18:27:22 -0700 Subject: [PATCH 044/257] vere: misc tweaks --- pkg/urbit/vere/hind.c | 13 ------------- pkg/urbit/vere/pier.c | 26 +++++++++++++++++++++----- 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/pkg/urbit/vere/hind.c b/pkg/urbit/vere/hind.c index c88c9874a..28ad16fab 100644 --- a/pkg/urbit/vere/hind.c +++ b/pkg/urbit/vere/hind.c @@ -67,11 +67,6 @@ _hind_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) static void _hind_io_exit(u3_auto* car_u) { - // XX moveme - // - c3_l cod_l = u3a_lush(c3__save); - u3_save_io_exit(car_u->pir_u); - u3a_lop(cod_l); } /* u3_hind_io_init(): @@ -87,13 +82,5 @@ u3_hind_io_init(u3_pier* pir_u) car_u->io.exit_f = _hind_io_exit; // car_u->ev.bail_f = ...; - // XX moveme - // - { - c3_l cod_l = u3a_lush(c3__save); - u3_save_io_init(pir_u); - u3a_lop(cod_l); - } - return car_u; } diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 4caa19bf6..c34291203 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -20,8 +20,8 @@ #include "all.h" #include "vere/vere.h" -#define PIER_READ_BATCH 100ULL -#define PIER_PLAY_BATCH 10ULL +#define PIER_READ_BATCH 1000ULL +#define PIER_PLAY_BATCH 100ULL #define PIER_WORK_BATCH 10ULL #undef VERBOSE_PIER @@ -382,7 +382,7 @@ _pier_play_init(u3_pier* pir_u) } else { u3l_log("pier: replaying events %" PRIu64 "-%" PRIu64 "\r\n", - (1ULL + god_u->eve_d), + (c3_d)(1ULL + god_u->eve_d), log_u->dun_d); } @@ -544,9 +544,9 @@ _pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) u3_pier* pir_u = vod_p; c3_d las_d = fon_u.ent_u->eve_d; -#ifdef VERBOSE_PIER +// #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): play: done\r\n", las_d); -#endif +// #endif // XX optional // @@ -1278,6 +1278,14 @@ u3_pier_exit(u3_pier* pir_u) { pir_u->sat_e = u3_peat_done; + // XX moveme + // + { + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_exit(pir_u); + u3a_lop(cod_l); + } + u3_pier_save(pir_u); u3_disk_exit(pir_u->log_u); @@ -1297,6 +1305,14 @@ _pier_loop_init(u3_pier* pir_u) // u3v_numb(); + // XX moveme + // + { + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_init(pir_u); + u3a_lop(cod_l); + } + return u3_auto_init(pir_u); } From afcba71a649b431b63e90fe83abbebd90affaded Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sun, 26 Apr 2020 23:09:26 -0700 Subject: [PATCH 045/257] blah i/o driver integrations --- pkg/urbit/vere/term.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 5089d2e36..15be1c2e6 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -597,8 +597,6 @@ _term_it_save(u3_noun pax, u3_noun pad) static u3_ovum* _term_ovum_plan(u3_auto* car_u, u3_noun wir, u3_noun cad) { - // XX c3__dill instead of u3_blip - // u3_ovum* egg_u = u3_auto_plan(car_u, 0, c3__d, wir, cad); // term events have no spinner label From 9cc3242d758dad5c7005458d952968cb260e2b82 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sun, 26 Apr 2020 23:16:45 -0700 Subject: [PATCH 046/257] vere: free i/o drivers on exit --- pkg/urbit/vere/cttp.c | 6 +----- pkg/urbit/vere/hind.c | 1 + pkg/urbit/vere/term.c | 2 ++ 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/vere/cttp.c b/pkg/urbit/vere/cttp.c index 0342e57ac..181a790e3 100644 --- a/pkg/urbit/vere/cttp.c +++ b/pkg/urbit/vere/cttp.c @@ -1111,13 +1111,9 @@ _cttp_io_exit(u3_auto* car_u) } } - // dispose of global resources - // h2o_timeout_dispose(u3L, &ctp_u->tim_u); SSL_CTX_free(ctp_u->tls_u); - - // XX dispose ctp_u - // + c3_free(ctp_u); } /* u3_cttp_io_init(): initialize http client I/O. diff --git a/pkg/urbit/vere/hind.c b/pkg/urbit/vere/hind.c index 28ad16fab..342c7d33d 100644 --- a/pkg/urbit/vere/hind.c +++ b/pkg/urbit/vere/hind.c @@ -67,6 +67,7 @@ _hind_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) static void _hind_io_exit(u3_auto* car_u) { + c3_free(car_u); } /* u3_hind_io_init(): diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 15be1c2e6..d29ee128b 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -1419,6 +1419,8 @@ _term_io_exit(u3_auto* car_u) u3_utty* uty_u = _term_main(); uv_read_stop((uv_stream_t*)&(uty_u->pop_u)); } + + c3_free(car_u); } /* u3_term_io_init(): initialize terminal From baa8c0e98f97b7ae05ff4979c3205240ddb78fbb Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 27 Apr 2020 11:39:31 -0700 Subject: [PATCH 047/257] vere: much more pier refactoring --- pkg/urbit/daemon/main.c | 4 +- pkg/urbit/include/vere/vere.h | 108 +-- pkg/urbit/vere/disk.c | 11 +- pkg/urbit/vere/pier.c | 1257 ++++++++++++++++++--------------- 4 files changed, 757 insertions(+), 623 deletions(-) diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 62a6d96a6..9f64c3cde 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -478,9 +478,7 @@ _stop_signal(c3_i int_i) { // if we have a pier, unmap the event log before dumping core // - if ( 0 != u3K.len_w ) { - u3_disk_exit(u3_pier_stub()->log_u); - } + u3_pier_halt(); } /* diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 91c0f4ab5..a4cfee6f1 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -415,13 +415,13 @@ c3_c* bin_c; // binary path c3_c* pax_c; // directory c3_d key_d[4]; // image key - u3_lord_cb cb_u; // callbacks c3_o liv_o; // live - c3_o pin_o; // spinning c3_y hon_y; // hoon kelvin - c3_y noc_y; // hoon kelvin + c3_y noc_y; // nock kelvin c3_d eve_d; // last event completed c3_l mug_l; // mug at eve_d + u3_lord_cb cb_u; // callbacks + c3_o pin_o; // spinning c3_w dep_w; // queue depth struct _u3_writ* ent_u; // queue entry struct _u3_writ* ext_u; // queue exit @@ -454,6 +454,16 @@ u3_info put_u; // write queue } u3_disk; + /* u3_psat: pier state. + */ + typedef enum { + u3_psat_init = 0, // initialized + u3_psat_boot = 1, // bootstrap + u3_psat_play = 2, // replaying + u3_psat_work = 3, // working + u3_psat_done = 4 // shutting down + } u3_psat; + /* u3_boot: bootstrap event sequence */ typedef struct _u3_boot { @@ -462,31 +472,25 @@ u3_noun use; // userpace ova } u3_boot; - /* u3_peat: pier state. // XX rename to u3_psat + /* u3_play: replay control. */ - typedef enum { - u3_peat_init = 0, // initialized - u3_peat_boot = 1, // bootstrap - u3_peat_play = 2, // replaying - u3_peat_work = 3, // working - u3_peat_done = 4 // shutting down - } u3_peat; - - /* u3_wall: pier barrier - */ - typedef struct _u3_wall { - void* vod_p; - c3_d eve_d; - void (*wal_f)(void*, c3_d); - struct _u3_wall* nex_u; - } u3_wall; + typedef struct _u3_play { + // XX batch, save/pack/wall? + // + c3_d eve_d; // target + c3_d req_d; // last read requested + c3_d sen_d; // last sent + // u3_fact* sen_u; // last sent + u3_fact* ent_u; // queue entry + u3_fact* ext_u; // queue exit + struct _u3_pier* pir_u; // pier backpointer + } u3_play; /* u3_auto_cb: i/o driver callbacks */ typedef struct _u3_auto_cb { void (*talk_f)(struct _u3_auto*); c3_o (*kick_f)(struct _u3_auto*, u3_noun, u3_noun); - c3_w (*mark_f)(struct _u3_auto*); void (*exit_f)(struct _u3_auto*); // XX close_cb? } u3_auto_cb; @@ -508,6 +512,31 @@ struct _u3_pier* pir_u; } u3_auto; + /* u3_wall: pier barrier + */ + typedef struct _u3_wall { + void* vod_p; + c3_d eve_d; + void (*wal_f)(void*, c3_d); + struct _u3_wall* nex_u; + } u3_wall; + + /* u3_work: normal operation. + */ + typedef struct _u3_work { + u3_auto* car_u; // i/o drivers + u3_wall* wal_u; // barriers + struct { // finished event queue: + c3_d rel_d; // last released + u3_gift* ent_u; // entry + u3_gift* ext_u; // exit + } fec_u; // + uv_prepare_t pep_u; // pre-loop + uv_check_t cek_u; // post-loop + uv_idle_t idl_u; // catchall XX uv_async_t? + struct _u3_pier* pir_u; // pier backpointer + } u3_work; + /* u3_pier: ship controller. */ typedef struct _u3_pier { @@ -517,25 +546,14 @@ c3_c* who_c; // identity as C string c3_o fak_o; // yes iff fake security c3_o liv_o; // fully live - u3_peat sat_e; // pier state u3_disk* log_u; // event log u3_lord* god_u; // computer - u3_wall* wal_u; // barriers - u3_auto* car_u; // i/o drivers - struct { // replay queue - c3_d sen_d; // last sent - c3_d req_d; // last requested - u3_fact* ent_u; // entry - u3_fact* ext_u; // exit - } pay_u; // - struct { // finished event queue: - c3_d rel_d; // last released - u3_gift* ent_u; // entry - u3_gift* ext_u; // exit - } fec_u; // - uv_prepare_t pep_u; // preloop registration - uv_check_t cek_u; // postloop registration - uv_idle_t idl_u; // postloop registration + u3_psat sat_e; // type-tagged + union { // + u3_boot* bot_u; // bootstrap + u3_play* pay_u; // recompute + u3_work* wok_u; // work + }; // XX remove c3_s por_s; // UDP port u3_save* sav_u; // autosave @@ -738,11 +756,16 @@ void u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d); - /* u3_disk_boot_plan(): XX remove, just use u3_disk_plan(). + /* u3_disk_boot_plan(): enqueue boot sequence, without autocommit. */ void u3_disk_boot_plan(u3_disk* log_u, u3_noun job); + /* u3_disk_boot_save(): commit boot sequence. + */ + void + u3_disk_boot_save(u3_disk* log_u); + /* u3_disk_plan(): enqueue completed event for persistence. */ void @@ -1047,9 +1070,14 @@ void u3_pier_bail(void); - /* u3_pier_save(): request checkpoint. + /* u3_pier_halt(): emergency release. */ void + u3_pier_halt(void); + + /* u3_pier_save(): request checkpoint. + */ + c3_o u3_pier_save(u3_pier* pir_u); /* u3_pier_stub(): get the One Pier for unreconstructed code. diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 457718ef6..4075a4ca3 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -251,7 +251,7 @@ u3_disk_plan(u3_disk* log_u, u3_fact* tac_u) _disk_commit(log_u); } -/* u3_disk_boot_plan(): XX remove, just use u3_disk_plan(). +/* u3_disk_boot_plan(): enqueue boot sequence, without autocommit. */ void u3_disk_boot_plan(u3_disk* log_u, u3_noun job) @@ -278,9 +278,14 @@ u3_disk_boot_plan(u3_disk* log_u, u3_noun job) #ifdef VERBOSE_DISK fprintf(stderr, "disk: (%" PRIu64 "): db boot plan\r\n", tac_u->eve_d); #endif +} - // XX make explicit - // +/* u3_disk_boot_save(): commit boot sequence. +*/ +void +u3_disk_boot_save(u3_disk* log_u) +{ + c3_assert( !log_u->dun_d ); _disk_commit(log_u); } diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index c34291203..1ce1b3c95 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -26,31 +26,23 @@ #undef VERBOSE_PIER -// XX snapshot timer - -/* _pier_work_init(): begin processing new events -*/ -static void -_pier_work_init(u3_pier* pir_u) -{ - pir_u->sat_e = u3_peat_work; - u3_auto_talk(pir_u->car_u); -} - /* _pier_work_send(): send new events for processing */ static void -_pier_work_send(u3_pier* pir_u) +_pier_work_send(u3_work* wok_u) { + u3_auto* car_u = wok_u->car_u; + u3_pier* pir_u = wok_u->pir_u; u3_lord* god_u = pir_u->god_u; - u3_auto* car_u = pir_u->car_u; c3_w len_w = 0; // calculate work batch size { - u3_wall* wal_u = pir_u->wal_u; + u3_wall* wal_u = wok_u->wal_u; if ( !wal_u ) { + // XX work depth, or full lord send-stack depth? + // if ( PIER_WORK_BATCH > god_u->dep_w ) { len_w = PIER_WORK_BATCH - god_u->dep_w; } @@ -82,9 +74,9 @@ _pier_work_send(u3_pier* pir_u) /* _pier_gift_plan(): enqueue effects. */ static void -_pier_gift_plan(u3_pier* pir_u, u3_gift* gif_u) +_pier_gift_plan(u3_work* wok_u, u3_gift* gif_u) { - c3_assert( gif_u->eve_d > pir_u->fec_u.rel_d ); + c3_assert( gif_u->eve_d > wok_u->fec_u.rel_d ); #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): compute: complete\r\n", gif_u->eve_d); @@ -92,36 +84,37 @@ _pier_gift_plan(u3_pier* pir_u, u3_gift* gif_u) gif_u->nex_u = 0; - if ( !pir_u->fec_u.ent_u ) { - c3_assert( !pir_u->fec_u.ext_u ); - pir_u->fec_u.ent_u = pir_u->fec_u.ext_u = gif_u; + if ( !wok_u->fec_u.ent_u ) { + c3_assert( !wok_u->fec_u.ext_u ); + wok_u->fec_u.ent_u = wok_u->fec_u.ext_u = gif_u; } else { - pir_u->fec_u.ent_u->nex_u = gif_u; - pir_u->fec_u.ent_u = gif_u; + wok_u->fec_u.ent_u->nex_u = gif_u; + wok_u->fec_u.ent_u = gif_u; } } /* _pier_gift_next(): dequeue effect. */ static u3_gift* -_pier_gift_next(u3_pier* pir_u) +_pier_gift_next(u3_work* wok_u) { + u3_pier* pir_u = wok_u->pir_u; u3_disk* log_u = pir_u->log_u; - u3_gift* gif_u = pir_u->fec_u.ext_u; + u3_gift* gif_u = wok_u->fec_u.ext_u; if ( !gif_u || (gif_u->eve_d > log_u->dun_d) ) { return 0; } else { - pir_u->fec_u.ext_u = gif_u->nex_u; + wok_u->fec_u.ext_u = gif_u->nex_u; - if ( !pir_u->fec_u.ext_u ) { - pir_u->fec_u.ent_u = 0; + if ( !wok_u->fec_u.ext_u ) { + wok_u->fec_u.ent_u = 0; } - c3_assert( (1ULL + pir_u->fec_u.rel_d) == gif_u->eve_d ); - pir_u->fec_u.rel_d = gif_u->eve_d; + c3_assert( (1ULL + wok_u->fec_u.rel_d) == gif_u->eve_d ); + wok_u->fec_u.rel_d = gif_u->eve_d; return gif_u; } @@ -130,15 +123,15 @@ _pier_gift_next(u3_pier* pir_u) /* _pier_gift_kick(): apply effects. */ static void -_pier_gift_kick(u3_pier* pir_u) +_pier_gift_kick(u3_work* wok_u) { u3_gift* gif_u; - while ( (gif_u = _pier_gift_next(pir_u)) ) { + while ( (gif_u = _pier_gift_next(wok_u)) ) { #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", gif_u->eve_d); #endif - u3_auto_kick(pir_u->car_u, gif_u->act); + u3_auto_kick(wok_u->car_u, gif_u->act); // XX dispose properly // @@ -146,68 +139,64 @@ _pier_gift_kick(u3_pier* pir_u) } } -/* u3_pier_peek_as(): +/* _pier_wall_plan(): enqueue a barrier. */ -void -u3_pier_peek_as(u3_pier* pir_u, - u3_noun gan, - c3_m car_m, - u3_noun pax) +static void +_pier_wall_plan(u3_pier* pir_u, c3_d eve_d, + void* vod_p, void (*wal_f)(void*, c3_d)) { - u3_peek* pek_u = c3_malloc(sizeof(*pek_u)); - pek_u->car_m = car_m; - pek_u->gan = gan; - pek_u->typ_e = u3_peek_just; - pek_u->pax = pax; + c3_assert( u3_psat_work == pir_u->sat_e ); - u3_lord_peek(pir_u->god_u, pek_u); + u3_wall* wal_u = c3_malloc(sizeof(*wal_u)); + wal_u->vod_p = vod_p; + wal_u->eve_d = eve_d; + wal_u->wal_f = wal_f; + + // insert into [pir_u->wal_u], preserving stable sort by [eve_d] + // + { + u3_wall** las_u = &pir_u->wok_u->wal_u; + + while ( *las_u && (eve_d <= (*las_u)->eve_d) ) { + las_u = &(*las_u)->nex_u; + } + + wal_u->nex_u = *las_u; + *las_u = wal_u; + } } -/* u3_pier_peek(): +/* _pier_wall(): process a barrier if possible. */ -void -u3_pier_peek(u3_pier* pir_u, c3_m car_m, u3_noun pax) +static void +_pier_wall(u3_work* wok_u) { - u3_pier_peek_as(pir_u, u3nc(u3_nul, u3_nul), car_m, pax); -} + u3_lord* god_u = wok_u->pir_u->god_u; + u3_disk* log_u = wok_u->pir_u->log_u; -/* u3_pier_peep_as(): -*/ -void -u3_pier_peep_as(u3_pier* pir_u, - u3_noun gan, - c3_m car_m, - u3_atom des, - u3_noun pax) -{ - u3_peek* pek_u = c3_malloc(sizeof(*pek_u)); - pek_u->car_m = car_m; - pek_u->gan = gan; - pek_u->typ_e = u3_peek_last; - pek_u->las_u.des = des; - pek_u->las_u.pax = pax; + if ( god_u->eve_d == log_u->dun_d ) { + u3_wall* wal_u; - u3_lord_peek(pir_u->god_u, pek_u); -} - -/* u3_pier_peep(): -*/ -void -u3_pier_peep(u3_pier* pir_u, - c3_m car_m, - u3_atom des, - u3_noun pax) -{ - u3_pier_peep_as(pir_u, u3nc(u3_nul, u3_nul), car_m, des, pax); + while ( (wal_u = wok_u->wal_u) + && !god_u->dep_w + && (wal_u->eve_d <= god_u->eve_d) ) + { + wok_u->wal_u = wal_u->nex_u; + wal_u->wal_f(wal_u->vod_p, god_u->eve_d); + c3_free(wal_u); + } + } } /* _pier_work(): advance event processing. */ static void -_pier_work(u3_pier* pir_u) +_pier_work(u3_work* wok_u) { + u3_pier* pir_u = wok_u->pir_u; + if ( c3n == pir_u->liv_o ) { - pir_u->liv_o = u3_auto_live(pir_u->car_u); + pir_u->liv_o = u3_auto_live(wok_u->car_u); // all i/o drivers are fully initialized // @@ -225,55 +214,269 @@ _pier_work(u3_pier* pir_u) } } - _pier_work_send(pir_u); - _pier_gift_kick(pir_u); + _pier_gift_kick(wok_u); + _pier_wall(wok_u); + + if ( u3_psat_work == pir_u->sat_e ) { + _pier_work_send(wok_u); + } + else { + c3_assert( u3_psat_done == pir_u->sat_e ); + } +} + +/* _pier_on_lord_work_spin(): start spinner +*/ +static void +_pier_on_lord_work_spin(void* vod_p, u3_atom pin, c3_o del_o) +{ + u3_pier* pir_u = vod_p; + + c3_assert( (u3_psat_work == pir_u->sat_e) + || (u3_psat_done == pir_u->sat_e) ); + + u3_term_start_spinner(pin, del_o); +} + +/* _pier_on_lord_work_spin(): stop spinner +*/ +static void +_pier_on_lord_work_spun(void* vod_p) +{ + u3_pier* pir_u = vod_p; + + c3_assert( (u3_psat_work == pir_u->sat_e) + || (u3_psat_done == pir_u->sat_e) ); + + u3_term_stop_spinner(); +} + +/* _pier_on_lord_work_done(): event completion from worker. +*/ +static void +_pier_on_lord_work_done(void* vod_p, + u3_ovum* egg_u, + u3_fact* tac_u, + u3_gift* gif_u) +{ + u3_pier* pir_u = vod_p; + + c3_assert( (u3_psat_work == pir_u->sat_e) + || (u3_psat_done == pir_u->sat_e) ); + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier (%" PRIu64 "): work: done\r\n", tac_u->eve_d); +#endif + + // XX this is a departure from the general organization of this file + // + u3_disk_plan(pir_u->log_u, tac_u); + + // XX revise + // + u3_auto_done(egg_u, c3n); + u3_auto_drop(0, egg_u); + + _pier_gift_plan(pir_u->wok_u, gif_u); + _pier_work(pir_u->wok_u); +} + +/* _pier_on_lord_work_bail(): event failure from worker. +*/ +static void +_pier_on_lord_work_bail(void* vod_p, u3_ovum* egg_u, u3_noun lud) +{ + u3_pier* pir_u = vod_p; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: work: bail\r\n"); +#endif + + c3_assert( (u3_psat_work == pir_u->sat_e) + || (u3_psat_done == pir_u->sat_e) ); + + u3_auto_bail(egg_u, lud); + + _pier_work(pir_u->wok_u); +} + +/* _pier_work_time(): set time. +*/ +static void +_pier_work_time(u3_pier* pir_u) +{ + struct timeval tim_tv; + gettimeofday(&tim_tv, 0); + + // XX save to pier + // + u3v_time(u3_time_in_tv(&tim_tv)); +} + +/* _pier_work_fore_cb(): run on every loop iteration before i/o polling. +*/ +static void +_pier_work_fore_cb(uv_prepare_t* pep_u) +{ + u3_work* wok_u = pep_u->data; + _pier_work_time(wok_u->pir_u); +} + +/* _pier_work_afte_cb(): run on every loop iteration after i/o polling. +*/ +static void +_pier_work_afte_cb(uv_check_t* cek_u) +{ + u3_work* wok_u = cek_u->data; + _pier_work(wok_u); +} + +/* _pier_work_idle_cb(): run on next loop iteration. +*/ +static void +_pier_work_idle_cb(uv_idle_t* idl_u) +{ + u3_work* wok_u = idl_u->data; + _pier_work(wok_u); + uv_idle_stop(idl_u); +} + +/* u3_pier_spin(): (re-)activate idle handler +*/ +void +u3_pier_spin(u3_pier* pir_u) +{ + // XX return c3n instead? + // + c3_assert( (u3_psat_work == pir_u->sat_e) + || (u3_psat_done == pir_u->sat_e) ); + + u3_work* wok_u = pir_u->wok_u; + + if ( !uv_is_active((uv_handle_t*)&wok_u->idl_u) ) { + uv_idle_start(&wok_u->idl_u, _pier_work_idle_cb); + } +} + +/* _pier_work_init(): begin processing new events +*/ +static void +_pier_work_init(u3_pier* pir_u) +{ + u3_work* wok_u; + + c3_assert( (u3_psat_init == pir_u->sat_e) + || (u3_psat_play == pir_u->sat_e) ); + + pir_u->sat_e = u3_psat_work; + pir_u->wok_u = wok_u = c3_calloc(sizeof(*wok_u)); + wok_u->pir_u = pir_u; + wok_u->fec_u.rel_d = pir_u->log_u->dun_d; + + _pier_work_time(pir_u); + + // for i/o drivers that still use u3A->sen + // + u3v_numb(); + + // XX plan kelvin event + // + + // XX snapshot timer + // XX moveme + // + { + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_init(pir_u); + u3a_lop(cod_l); + } + + // initialize pre i/o polling handle + // + uv_prepare_init(u3L, &wok_u->pep_u); + wok_u->pep_u.data = wok_u; + uv_prepare_start(&wok_u->pep_u, _pier_work_fore_cb); + + // initialize post i/o polling handle + // + uv_check_init(u3L, &wok_u->cek_u); + wok_u->cek_u.data = wok_u; + uv_check_start(&wok_u->cek_u, _pier_work_afte_cb); + + // initialize idle i/o polling handle + // + // NB, not started + // + uv_idle_init(u3L, &wok_u->idl_u); + wok_u->idl_u.data = wok_u; + + // initialize i/o drivers + // + wok_u->car_u = u3_auto_init(pir_u); + u3_auto_talk(wok_u->car_u); + + // // setup u3_lord work callbacks + // // + // u3_lord_work_cb cb_u = { + // .vod_p = wok_u, + // .spin_f = _pier_on_lord_work_spin, + // .spun_f = _pier_on_lord_work_spun, + // .done_f = _pier_on_lord_work_done, + // .bail_f = _pier_on_lord_work_bail + // }; + // u3_lord_work_init(pir_u->god_u, cb_u); + + _pier_work(wok_u); } /* _pier_play_plan(): enqueue events for replay. */ static void -_pier_play_plan(u3_pier* pir_u, u3_info pay_u) +_pier_play_plan(u3_play* pay_u, u3_info fon_u) { u3_fact** ext_u; c3_d old_d; - if ( !pir_u->pay_u.ext_u ) { - c3_assert( !pir_u->pay_u.ent_u ); - ext_u = &pir_u->pay_u.ext_u; - old_d = pir_u->pay_u.sen_d; + if ( !pay_u->ext_u ) { + c3_assert( !pay_u->ent_u ); + ext_u = &pay_u->ext_u; + old_d = pay_u->sen_d; } else { - ext_u = &pir_u->pay_u.ent_u->nex_u; - old_d = pir_u->pay_u.ent_u->eve_d; + ext_u = &pay_u->ent_u->nex_u; + old_d = pay_u->ent_u->eve_d; } #ifdef VERBOSE_PIER fprintf(stderr, "pier: play plan %" PRIu64 "-%" PRIu64 " at %" PRIu64 "\r\n", - pay_u.ext_u->eve_d, - pay_u.ent_u->eve_d, + fon_u.ext_u->eve_d, + fon_u.ent_u->eve_d, old_d); #endif - c3_assert( (1ULL + old_d) == pay_u.ext_u->eve_d ); + c3_assert( (1ULL + old_d) == fon_u.ext_u->eve_d ); - *ext_u = pay_u.ext_u; - pir_u->pay_u.ent_u = pay_u.ent_u; + *ext_u = fon_u.ext_u; + pay_u->ent_u = fon_u.ent_u; } -/* _pier_play_send(): detach a batch of up to [len_d] events from queue. +/* _pier_play_send(): detach a batch of up to [len_w] events from queue. */ static u3_info -_pier_play_next(u3_pier* pir_u, c3_d len_d) +_pier_play_next(u3_play* pay_u, c3_w len_w) { - u3_fact* tac_u = pir_u->pay_u.ext_u; + u3_fact* tac_u = pay_u->ext_u; u3_info fon_u; + // XX just share batch with lord, save last sent to pay_u->sen_u + // + // set batch entry and exit pointers // { fon_u.ext_u = tac_u; - while ( len_d-- && tac_u->nex_u ) { + while ( len_w-- && tac_u->nex_u ) { tac_u = tac_u->nex_u; } @@ -283,11 +486,11 @@ _pier_play_next(u3_pier* pir_u, c3_d len_d) // detatch batch from queue // if ( tac_u->nex_u ) { - pir_u->pay_u.ext_u = tac_u->nex_u; + pay_u->ext_u = tac_u->nex_u; tac_u->nex_u = 0; } else { - pir_u->pay_u.ent_u = pir_u->pay_u.ext_u = 0; + pay_u->ent_u = pay_u->ext_u = 0; } return fon_u; @@ -296,22 +499,37 @@ _pier_play_next(u3_pier* pir_u, c3_d len_d) /* _pier_play_send(): send a batch of events to the worker for replay. */ static void -_pier_play_send(u3_pier* pir_u) +_pier_play_send(u3_play* pay_u) { + u3_pier* pir_u = pay_u->pir_u; + c3_w len_w; + + // awaiting read + // + if ( !pay_u->ext_u ) { + return; + } + // XX fill the pipe how much? // (god_u->dep_w > PIER_WORK_BATCH) ) // - if ( pir_u->pay_u.ext_u ) { - // the first batch must be >= the lifecycle barrier - // - c3_d len_d = ( !pir_u->pay_u.sen_d ) - ? c3_max(pir_u->lif_w, PIER_PLAY_BATCH) - : PIER_PLAY_BATCH; - u3_info fon_u = _pier_play_next(pir_u, len_d); + + // the first batch must be >= the lifecycle barrier + // + if ( !pay_u->sen_d ) { + len_w = c3_max(pir_u->lif_w, PIER_PLAY_BATCH); + } + else { + c3_d lef_d = (pay_u->eve_d - pay_u->sen_d); + len_w = c3_min(lef_d, PIER_PLAY_BATCH); + } + + { + u3_info fon_u = _pier_play_next(pay_u, len_w); // bump sent counter // - pir_u->pay_u.sen_d = fon_u.ent_u->eve_d; + pay_u->sen_d = fon_u.ent_u->eve_d; #ifdef VERBOSE_PIER fprintf(stderr, "pier: play send %" PRIu64 "-%" PRIu64 "\r\n", fon_u.ext_u->eve_d, fon_u.ent_u->eve_d); @@ -324,21 +542,22 @@ _pier_play_send(u3_pier* pir_u) /* _pier_play_read(): read events from disk for replay. */ static void -_pier_play_read(u3_pier* pir_u) +_pier_play_read(u3_play* pay_u) { + u3_pier* pir_u = pay_u->pir_u; c3_d las_d; - if ( pir_u->pay_u.ent_u ) { - las_d = pir_u->pay_u.ent_u->eve_d; + if ( pay_u->ent_u ) { + las_d = pay_u->ent_u->eve_d; // cap the pir_u->pay_u queue depth // - if ( (las_d - pir_u->pay_u.ext_u->eve_d) >= PIER_PLAY_BATCH ) { + if ( (las_d - pay_u->ext_u->eve_d) >= PIER_PLAY_BATCH ) { return; } } else { - las_d = pir_u->pay_u.sen_d; + las_d = pay_u->sen_d; } { @@ -346,10 +565,10 @@ _pier_play_read(u3_pier* pir_u) c3_d len_d = c3_min(pir_u->log_u->dun_d - las_d, PIER_READ_BATCH); if ( len_d - && (nex_d > pir_u->pay_u.req_d) ) + && (nex_d > pay_u->req_d) ) { u3_disk_read(pir_u->log_u, nex_d, len_d); - pir_u->pay_u.req_d = nex_d; + pay_u->req_d = nex_d; #ifdef VERBOSE_PIER fprintf(stderr, "pier: play read %" PRIu64 " at %" PRIu64 "\r\n", len_d, nex_d); @@ -358,184 +577,37 @@ _pier_play_read(u3_pier* pir_u) } } -/* _pier_play_init(): begin boot/replay -*/ -static void -_pier_play_init(u3_pier* pir_u) -{ - u3_lord* god_u = pir_u->god_u; - u3_disk* log_u = pir_u->log_u; - - c3_assert( log_u->sen_d == log_u->dun_d ); - - switch ( pir_u->sat_e ) { - default: c3_assert(0); - - case u3_peat_init: { - c3_assert( god_u->eve_d <= log_u->dun_d ); - pir_u->sat_e = u3_peat_play; - pir_u->pay_u.sen_d = god_u->eve_d; - - u3l_log("---------------- playback starting ----------------\r\n"); - if ( (1ULL + god_u->eve_d) == log_u->dun_d ) { - u3l_log("pier: replaying event %" PRIu64 "\r\n", log_u->dun_d); - } - else { - u3l_log("pier: replaying events %" PRIu64 "-%" PRIu64 "\r\n", - (c3_d)(1ULL + god_u->eve_d), - log_u->dun_d); - } - - u3_term_start_spinner(c3__play, c3y); - } break; - - case u3_peat_boot: { - c3_assert( !god_u->eve_d ); - u3l_log("---------------- boot starting ----------------\r\n"); - u3_term_start_spinner(c3__boot, c3y); - } break; - } -} - /* _pier_play(): send a batch of events to the worker for log replay. */ static void -_pier_play(u3_pier* pir_u) +_pier_play(u3_play* pay_u) { + u3_pier* pir_u = pay_u->pir_u; u3_lord* god_u = pir_u->god_u; u3_disk* log_u = pir_u->log_u; - if ( log_u->sen_d > log_u->dun_d ) { - // wait if we're still committing the boot sequence + if ( god_u->eve_d == pay_u->eve_d ) { + // XX should be play_cb // - c3_assert( u3_peat_boot == pir_u->sat_e ); - } - else if ( god_u->eve_d == log_u->dun_d ) { - u3l_log("---------------- %s complete ----------------\r\n", - ( u3_peat_boot == pir_u->sat_e ) ? "boot" : "playback"); + u3l_log("---------------- playback complete ----------------\r\n"); u3_term_stop_spinner(); - _pier_work_init(pir_u); - // XX _pier_next(pir_u); + + if ( pay_u->eve_d < log_u->dun_d ) { + // XX graceful shutdown + u3_pier_bail(); + exit(0); + } + else if ( pay_u->eve_d == log_u->dun_d ) { + _pier_work_init(pir_u); + } } else { - c3_assert( god_u->eve_d < log_u->dun_d ); - _pier_play_send(pir_u); - _pier_play_read(pir_u); + c3_assert( god_u->eve_d < pay_u->eve_d ); + _pier_play_send(pay_u); + _pier_play_read(pay_u); } } -/* _pier_wall_plan(): enqueue a barrier. -*/ -static void -_pier_wall_plan(u3_pier* pir_u, c3_d eve_d, - void* vod_p, void (*wal_f)(void*, c3_d)) -{ - u3_wall* wal_u = c3_malloc(sizeof(*wal_u)); - wal_u->vod_p = vod_p; - wal_u->eve_d = eve_d; - wal_u->wal_f = wal_f; - - // insert into [pir_u->wal_u], preserving stable sort by [eve_d] - // - { - u3_wall** las_u = &pir_u->wal_u; - - while ( *las_u && (eve_d <= (*las_u)->eve_d) ) { - las_u = &(*las_u)->nex_u; - } - - wal_u->nex_u = *las_u; - *las_u = wal_u; - } -} - -/* _pier_wall(): process a barrier if possible. -*/ -static void -_pier_wall(u3_pier* pir_u) -{ - u3_lord* god_u = pir_u->god_u; - u3_disk* log_u = pir_u->log_u; - - if ( god_u->eve_d == log_u->dun_d ) { - u3_wall* wal_u; - - // XX check god_u->dep_w - // - while ( (wal_u = pir_u->wal_u) - && !god_u->dep_w - && (wal_u->eve_d <= god_u->eve_d) ) - { - pir_u->wal_u = wal_u->nex_u; - wal_u->wal_f(wal_u->vod_p, god_u->eve_d); - c3_free(wal_u); - } - } -} - -/* _pier_next(): advance the pier state machine. -*/ -static void -_pier_next(u3_pier* pir_u) -{ - switch ( pir_u->sat_e ) { - default: c3_assert(0); - - case u3_peat_work: { - _pier_work(pir_u); - break; - } - - case u3_peat_play: - case u3_peat_boot: { - _pier_play(pir_u); - break; - } - - case u3_peat_done: { - _pier_gift_kick(pir_u); - break; - } - - case u3_peat_init: { - break; - } - } - - _pier_wall(pir_u); -} - -/* _pier_on_lord_slog(): debug printf from worker. -*/ -static void -_pier_on_lord_slog(void* vod_p, c3_w pri_w, u3_noun tan) -{ - u3_pier* pir_u = vod_p; - - if ( c3y == u3a_is_atom(tan) ) { - c3_c* tan_c = u3r_string(tan); - u3C.stderr_log_f(tan_c); - c3_free(tan_c); - u3z(tan); - } - else { - u3_pier_tank(0, pri_w, tan); - } - - _pier_next(pir_u); -} - -/* _pier_on_lord_peek(): namespace read response from worker. -*/ -static void -_pier_on_lord_peek(void* vod_p, u3_peek* pek_u, u3_noun dat) -{ - // XX cache, invoke callback, dispose pek_u - // - u3m_p("lord peek", dat); - u3z(dat); -} - /* _pier_on_lord_play_done(): log replay batch completion from worker. */ static void @@ -544,6 +616,8 @@ _pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) u3_pier* pir_u = vod_p; c3_d las_d = fon_u.ent_u->eve_d; + c3_assert( u3_psat_play == pir_u->sat_e ); + // #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): play: done\r\n", las_d); // #endif @@ -571,7 +645,7 @@ _pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) } } - _pier_next(pir_u); + _pier_play(pir_u->pay_u); } /* _pier_on_lord_play_bail(): log replay batch failure from worker. @@ -580,9 +654,14 @@ static void _pier_on_lord_play_bail(void* vod_p, u3_info fon_u, c3_l mug_l, c3_d eve_d, u3_noun dud) { + u3_pier* pir_u = vod_p; + #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): play: bail\r\n", eve_d); #endif + + c3_assert( u3_psat_play == pir_u->sat_e ); + // XX verify pay_u mug_l // XX check dud mote, retry yap_u or shutdown @@ -602,173 +681,53 @@ _pier_on_lord_play_bail(void* vod_p, u3_info fon_u, u3_pier_bail(); } -/* _pier_on_lord_work_spin(): start spinner +/* _pier_play_init(): begin boot/replay up to [eve_d]. */ static void -_pier_on_lord_work_spin(void* vod_p, u3_atom pin, c3_o del_o) +_pier_play_init(u3_pier* pir_u, c3_d eve_d) { - u3_term_start_spinner(pin, c3y); // (c3y == del_o) ? c3n : c3y); -} - -/* _pier_on_lord_work_spin(): stop spinner -*/ -static void -_pier_on_lord_work_spun(void* vod_p) -{ - u3_term_stop_spinner(); -} - -/* _pier_on_lord_work_done(): event completion from worker. -*/ -static void -_pier_on_lord_work_done(void* vod_p, - u3_ovum* egg_u, - u3_fact* tac_u, - u3_gift* gif_u) -{ - u3_pier* pir_u = vod_p; - -#ifdef VERBOSE_PIER - fprintf(stderr, "pier (%" PRIu64 "): work: done\r\n", tac_u->eve_d); -#endif - - // XX revise - // - u3_auto_done(egg_u, c3n); - u3_auto_drop(0, egg_u); - - _pier_gift_plan(pir_u, gif_u); - - // XX this is a departure from the general organization of this file - // - -#ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): disk: plan\r\n", tac_u->eve_d); -#endif - - u3_disk_plan(pir_u->log_u, tac_u); - - _pier_next(pir_u); -} - -/* _pier_on_lord_work_bail(): event failure from worker. -*/ -static void -_pier_on_lord_work_bail(void* vod_p, u3_ovum* egg_u, u3_noun lud) -{ - u3_pier* pir_u = vod_p; - -#ifdef VERBOSE_PIER - fprintf(stderr, "pier: work: bail\r\n"); -#endif - - u3_auto_bail(egg_u, lud); - - _pier_next(pir_u); -} - -/* _pier_on_lord_save(): worker (non-portable) snapshot complete. -*/ -static void -_pier_on_lord_save(void* vod_p) -{ - u3_pier* pir_u = vod_p; - -#ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): lord: save\r\n", pir_u->god_u->eve_d); -#endif - - _pier_next(pir_u); -} - -/* _pier_on_lord_pack(): worker state-export complete (portable snapshot). -*/ -static void -_pier_on_lord_pack(void* vod_p) -{ - u3_pier* pir_u = vod_p; - -#ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): lord: pack\r\n", pir_u->god_u->eve_d); -#endif - - _pier_next(pir_u); -} - -/* _pier_on_lord_exit(): worker shutdown. -*/ -static void -_pier_on_lord_exit(void* vod_p, c3_o ret_o) -{ - u3_pier* pir_u = vod_p; - - if ( u3_peat_done == pir_u->sat_e ) { - // XX dispose - // - // exit(0); - u3_term_log_exit(); - // XX no can do - // - uv_stop(u3L); - } - else { - // XX print error - // XX dispose - u3_pier_bail(); - } -} - -/* _pier_on_lord_live(): worker is ready. -*/ -static void -_pier_on_lord_live(void* vod_p) -{ - u3_pier* pir_u = vod_p; u3_lord* god_u = pir_u->god_u; u3_disk* log_u = pir_u->log_u; + u3_play* pay_u; - // XX plan kelvin event - // + c3_assert( (u3_psat_init == pir_u->sat_e) + || (u3_psat_boot == pir_u->sat_e) ); -#ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): boot at mug %x\r\n", god_u->eve_d, god_u->mug_l); -#endif + c3_assert( eve_d > god_u->eve_d ); + c3_assert( eve_d <= log_u->dun_d ); - c3_assert( god_u->eve_d <= log_u->dun_d ); + pir_u->sat_e = u3_psat_play; + pir_u->pay_u = pay_u = c3_calloc(sizeof(*pay_u)); + pay_u->pir_u = pir_u; + pay_u->eve_d = eve_d; + pay_u->sen_d = god_u->eve_d; - if ( log_u->sen_d > log_u->dun_d ) { - c3_assert( u3_peat_boot == pir_u->sat_e ); - // will init on _disk_write_done - // + u3l_log("---------------- playback starting ----------------\r\n"); + if ( (1ULL + god_u->eve_d) == eve_d ) { + u3l_log("pier: replaying event %" PRIu64 "\r\n", eve_d); } else { - c3_assert( (u3_peat_boot == pir_u->sat_e) - || (u3_peat_init == pir_u->sat_e) ); - - if ( god_u->eve_d < log_u->dun_d ) { - _pier_play_init(pir_u); - } - else { - _pier_work_init(pir_u); - } + u3l_log("pier: replaying events %" PRIu64 "-%" PRIu64 "\r\n", + (c3_d)(1ULL + god_u->eve_d), + eve_d); } - _pier_next(pir_u); + u3_term_start_spinner(c3__play, c3n); + + _pier_play(pay_u); } /* _pier_on_disk_read_done(): event log read success. */ static void -_pier_on_disk_read_done(void* vod_p, u3_info pay_u) +_pier_on_disk_read_done(void* vod_p, u3_info fon_u) { u3_pier* pir_u = vod_p; - c3_assert( (u3_peat_boot == pir_u->sat_e) - || (u3_peat_play == pir_u->sat_e) ); + c3_assert( u3_psat_play == pir_u->sat_e ); - _pier_play_plan(pir_u, pay_u); - - _pier_next(pir_u); + _pier_play_plan(pir_u->pay_u, fon_u); + _pier_play(pir_u->pay_u); } /* _pier_on_disk_read_bail(): event log read failure. @@ -778,7 +737,9 @@ _pier_on_disk_read_bail(void* vod_p, c3_d eve_d) { u3_pier* pir_u = vod_p; - // XX + c3_assert( u3_psat_play == pir_u->sat_e ); + + // XX s/b play_bail_cb // fprintf(stderr, "pier: disk read bail\r\n"); u3_term_stop_spinner(); @@ -797,20 +758,22 @@ _pier_on_disk_write_done(void* vod_p, c3_d eve_d) fprintf(stderr, "pier: (%" PRIu64 "): db commit: complete\r\n", eve_d); #endif - if ( u3_peat_boot == pir_u->sat_e ) { - pir_u->fec_u.rel_d = eve_d; - - // wait if we're still committing the boot sequence + if ( u3_psat_boot == pir_u->sat_e ) { + // lord already live // - if ( log_u->sen_d == log_u->dun_d ) { - _pier_play_init(pir_u); + if ( c3y == pir_u->god_u->liv_o ) { + // XX print bootstrap commit complete + // XX s/b boot_complete_cb + // + _pier_play_init(pir_u, log_u->dun_d); } } else { - c3_assert( u3_peat_work == pir_u->sat_e ); - } + c3_assert( (u3_psat_work == pir_u->sat_e) + || (u3_psat_done == pir_u->sat_e) ); - _pier_next(pir_u); + _pier_work(pir_u->wok_u); + } } /* _pier_on_disk_write_bail(): event log write failure. @@ -820,65 +783,136 @@ _pier_on_disk_write_bail(void* vod_p, c3_d eve_d) { u3_pier* pir_u = vod_p; + if ( u3_psat_boot == pir_u->sat_e ) { + // XX nice message + // + } + // XX // fprintf(stderr, "pier: disk write bail\r\n"); u3_pier_bail(); } -/* _pier_loop_time(): set time. +/* _pier_on_lord_slog(): debug printf from worker. */ static void -_pier_loop_time(u3_pier* pir_u) +_pier_on_lord_slog(void* vod_p, c3_w pri_w, u3_noun tan) { - struct timeval tim_tv; - gettimeofday(&tim_tv, 0); + u3_pier* pir_u = vod_p; - // XX save to pier - // - u3v_time(u3_time_in_tv(&tim_tv)); -} - -/* _pier_loop_before_cb(): run on every loop iteration before i/o polling. -*/ -static void -_pier_loop_fore_cb(uv_prepare_t* pep_u) -{ - u3_pier* pir_u = pep_u->data; - _pier_loop_time(pir_u); -} - -/* _pier_loop_afte_cb(): run on every loop iteration after i/o polling. -*/ -static void -_pier_loop_afte_cb(uv_check_t* cek_u) -{ - u3_pier* pir_u = cek_u->data; - _pier_next(pir_u); -} - -/* _pier_loop_idle_cb(): run on next loop iteration. -*/ -static void -_pier_loop_idle_cb(uv_idle_t* idl_u) -{ - u3_pier* pir_u = idl_u->data; - _pier_next(pir_u); - uv_idle_stop(idl_u); -} - -/* u3_pier_spin(): (re-)activate idle handler -*/ -void -u3_pier_spin(u3_pier* pir_u) -{ - if ( !uv_is_active((uv_handle_t*)&pir_u->idl_u) ) { - uv_idle_start(&pir_u->idl_u, _pier_loop_idle_cb); + if ( c3y == u3a_is_atom(tan) ) { + c3_c* tan_c = u3r_string(tan); + u3C.stderr_log_f(tan_c); + c3_free(tan_c); + u3z(tan); + } + else { + u3_pier_tank(0, pri_w, tan); } } -static u3_auto* -_pier_loop_init(u3_pier* pir_u); +/* _pier_on_lord_peek(): namespace read response from worker. +*/ +static void +_pier_on_lord_peek(void* vod_p, u3_peek* pek_u, u3_noun dat) +{ + // XX cache, invoke callback, dispose pek_u + // + u3m_p("lord peek", dat); + u3z(dat); +} + +/* _pier_on_lord_save(): worker (non-portable) snapshot complete. +*/ +static void +_pier_on_lord_save(void* vod_p) +{ + u3_pier* pir_u = vod_p; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): lord: save\r\n", pir_u->god_u->eve_d); +#endif + + // _pier_next(pir_u); +} + +/* _pier_on_lord_pack(): worker state-export complete (portable snapshot). +*/ +static void +_pier_on_lord_pack(void* vod_p) +{ + u3_pier* pir_u = vod_p; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): lord: pack\r\n", pir_u->god_u->eve_d); +#endif + + // if ( u3_psat_done == pir_u->sat_e ) { + // fprintf(stderr, "snap cb exit\r\n"); + // u3_lord_exit(pir_u->god_u, 0); + // } + // else { + // _pier_next(pir_u); + // } +} + +/* _pier_on_lord_exit(): worker shutdown. +*/ +static void +_pier_on_lord_exit(void* vod_p, c3_o ret_o) +{ + u3_pier* pir_u = vod_p; + + if ( u3_psat_done == pir_u->sat_e ) { + if ( c3n == ret_o ) { + u3l_log("pier: serf shutdown dirty\r\n"); + } + } + else { + u3l_log("pier: serf shutdown unexpected\r\n"); + u3_pier_bail(); + } +} + +/* _pier_on_lord_live(): worker is ready. +*/ +static void +_pier_on_lord_live(void* vod_p) +{ + u3_pier* pir_u = vod_p; + u3_lord* god_u = pir_u->god_u; + u3_disk* log_u = pir_u->log_u; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): boot at mug %x\r\n", god_u->eve_d, god_u->mug_l); +#endif + + c3_assert( god_u->eve_d <= log_u->dun_d ); + + if ( u3_psat_boot == pir_u->sat_e ) { + // boot-sequence commit complete + // + if ( log_u->sen_d + && (log_u->sen_d == log_u->dun_d) ) { + // XX print bootstrap commit complete + // XX s/b boot_complete_cb + // + _pier_play_init(pir_u, log_u->dun_d); + } + } + else { + c3_assert( u3_psat_init == pir_u->sat_e ); + c3_assert( log_u->sen_d == log_u->dun_d ); + + if ( god_u->eve_d < log_u->dun_d ) { + _pier_play_init(pir_u, log_u->dun_d); + } + else { + _pier_work_init(pir_u); + } + } +} /* _pier_init(): create a pier, loading existing. */ @@ -890,7 +924,7 @@ _pier_init(c3_w wag_w, c3_c* pax_c) u3_pier* pir_u = c3_calloc(sizeof(*pir_u)); pir_u->pax_c = pax_c; - pir_u->sat_e = u3_peat_init; + pir_u->sat_e = u3_psat_init; pir_u->liv_o = c3n; // XX remove @@ -898,23 +932,6 @@ _pier_init(c3_w wag_w, c3_c* pax_c) pir_u->por_s = u3_Host.ops_u.por_s; pir_u->sav_u = c3_calloc(sizeof(u3_save)); - // initialize pre i/o polling handle - // - uv_prepare_init(u3L, &pir_u->pep_u); - pir_u->pep_u.data = pir_u; - uv_prepare_start(&pir_u->pep_u, _pier_loop_fore_cb); - - // initialize post i/o polling handle - // - uv_check_init(u3L, &pir_u->cek_u); - pir_u->cek_u.data = pir_u; - uv_check_start(&pir_u->cek_u, _pier_loop_afte_cb); - - // NB, not started - // - uv_idle_init(u3L, &pir_u->idl_u); - pir_u->idl_u.data = pir_u; - // initialize persistence // { @@ -932,11 +949,9 @@ _pier_init(c3_w wag_w, c3_c* pax_c) c3_free(pir_u); return 0; } - - pir_u->fec_u.rel_d = pir_u->log_u->dun_d; } - // start the worker process + // initialize compute // { // XX load/set secrets @@ -1005,8 +1020,6 @@ u3_pier_stay(c3_w wag_w, u3_noun pax) exit(1); } - pir_u->car_u = _pier_loop_init(pir_u); - u3z(pax); } @@ -1125,7 +1138,7 @@ _pier_boot_plan(u3_pier* pir_u, u3_noun who, u3_noun ven, u3_noun pil) { u3_boot bot_u; { - pir_u->sat_e = u3_peat_boot; + pir_u->sat_e = u3_psat_boot; pir_u->fak_o = ( c3__fake == u3h(ven) ) ? c3y : c3n; u3r_chubs(0, 2, pir_u->who_d, who); @@ -1185,6 +1198,8 @@ _pier_boot_plan(u3_pier* pir_u, u3_noun who, u3_noun ven, u3_noun pil) } } + u3_disk_boot_save(pir_u->log_u); + u3z(bot_u.bot); u3z(bot_u.mod); u3z(bot_u.use); @@ -1211,8 +1226,6 @@ u3_pier_boot(c3_w wag_w, // config flags exit(1); } - pir_u->car_u = _pier_loop_init(pir_u); - u3z(pax); } @@ -1230,18 +1243,27 @@ _pier_save_cb(void* vod_p, c3_d eve_d) /* u3_pier_save(): save a non-portable snapshot */ -void +c3_o u3_pier_save(u3_pier* pir_u) { #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): save: plan\r\n", pir_u->god_u->eve_d); #endif + if ( u3_psat_play == pir_u->sat_e ) { + u3_lord_save(pir_u->god_u); + return c3y; + } - _pier_wall_plan(pir_u, 0, pir_u, _pier_save_cb); + if ( u3_psat_work == pir_u->sat_e ) { + _pier_wall_plan(pir_u, 0, pir_u, _pier_save_cb); + return c3y; + } + + return c3n; } static void -_pier_snap_cb(void* vod_p, c3_d eve_d) +_pier_pack_cb(void* vod_p, c3_d eve_d) { u3_pier* pir_u = vod_p; @@ -1254,94 +1276,61 @@ _pier_snap_cb(void* vod_p, c3_d eve_d) /* u3_pier_pack(): save a portable snapshot. */ -void +c3_o u3_pier_pack(u3_pier* pir_u) { #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): snap: plan\r\n", pir_u->god_u->eve_d); #endif - _pier_wall_plan(pir_u, 0, pir_u, _pier_snap_cb); + if ( u3_psat_play == pir_u->sat_e ) { + u3_lord_pack(pir_u->god_u); + return c3y; + } + + if ( u3_psat_work == pir_u->sat_e ) { + _pier_wall_plan(pir_u, 0, pir_u, _pier_pack_cb); + return c3y; + } + + return c3n; } +static void +_pier_exit_work_cb(uv_handle_t* idl_u) +{ + u3_work* wok_u = idl_u->data; + c3_free(wok_u); +} + +/* _pier_exit_cb(): synchronous shutdown. +*/ static void _pier_exit_cb(void* vod_p, c3_d eve_d) { u3_pier* pir_u = vod_p; - u3_lord_exit(pir_u->god_u, 0); -} -/* u3_pier_exit(): shutdown. -*/ -void -u3_pier_exit(u3_pier* pir_u) -{ - pir_u->sat_e = u3_peat_done; - - // XX moveme - // - { - c3_l cod_l = u3a_lush(c3__save); - u3_save_io_exit(pir_u); - u3a_lop(cod_l); - } - - - u3_pier_save(pir_u); - u3_disk_exit(pir_u->log_u); - u3_auto_exit(pir_u->car_u); - _pier_wall_plan(pir_u, 0, pir_u, _pier_exit_cb); -} - -/* _pier_loop_init_pier(): initialize loop handlers. -*/ -static u3_auto* -_pier_loop_init(u3_pier* pir_u) -{ - - _pier_loop_time(pir_u); - - // for i/o drivers that still use u3A->sen - // - u3v_numb(); - - // XX moveme - // - { - c3_l cod_l = u3a_lush(c3__save); - u3_save_io_init(pir_u); - u3a_lop(cod_l); - } - - return u3_auto_init(pir_u); -} - -/* c3_rand(): fill a 512-bit (16-word) buffer. -*/ -void -c3_rand(c3_w* rad_w) -{ - if ( 0 != ent_getentropy(rad_w, 64) ) { - fprintf(stderr, "c3_rand getentropy: %s\n", strerror(errno)); - // XX review + if ( pir_u->wok_u ) { + u3_work* wok_u = pir_u->wok_u; + u3_auto_exit(wok_u->car_u); + // XX confirm, libuv close callback are fired with a stack discipline // - u3_pier_bail(); + uv_close((uv_handle_t*)&wok_u->pep_u, _pier_exit_work_cb); + uv_close((uv_handle_t*)&wok_u->cek_u, 0); + uv_close((uv_handle_t*)&wok_u->idl_u, 0); + pir_u->wok_u = 0; + } + + if ( pir_u->log_u ) { + u3_disk_exit(pir_u->log_u); + pir_u->log_u = 0; } -} -/* _pier_exit_done(): synchronously shutting down -*/ -static void -_pier_exit_done(u3_pier* pir_u) -{ - u3_disk_exit(pir_u->log_u); - - if ( 0 != pir_u->god_u ) { + if ( pir_u->god_u ) { u3_lord_exit(pir_u->god_u, 0); + pir_u->god_u = 0; } - u3_auto_exit(pir_u->car_u); - u3_term_log_exit(); // XX uninstall pier from u3K.tab_u, dispose @@ -1351,6 +1340,93 @@ _pier_exit_done(u3_pier* pir_u) uv_stop(u3L); } +/* u3_pier_exit(): graceful shutdown. +*/ +void +u3_pier_exit(u3_pier* pir_u) +{ + // fprintf(stderr, "pier: exit\r\n"); + + switch ( pir_u->sat_e ) { + // XX specifically handle init/done? + // + default: { + fprintf(stderr, "pier: unexpected exit: %u\r\n", pir_u->sat_e); + c3_assert(0); + } + + case u3_psat_boot: { + // XX properly dispose boot + // + c3_free(pir_u->bot_u); + pir_u->bot_u = 0; + _pier_exit_cb(pir_u, 0); + } break; + + case u3_psat_play: { + // XX dispose play q + // + c3_free(pir_u->pay_u); + pir_u->pay_u = 0; + _pier_exit_cb(pir_u, 0); + } break; + + case u3_psat_work: { + _pier_wall_plan(pir_u, 0, pir_u, _pier_save_cb); + _pier_wall_plan(pir_u, 0, pir_u, _pier_exit_cb); + + // XX moveme + // + { + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_exit(pir_u); + u3a_lop(cod_l); + } + } break; + } + + u3K.len_w = 0; + pir_u->sat_e = u3_psat_done; +} + +/* _pier_exit_done(): force synchronous shut down. +*/ +static void +_pier_exit_done(u3_pier* pir_u) +{ + switch ( pir_u->sat_e ) { + default: break; + + case u3_psat_boot: { + // XX properly dispose boot + // + c3_free(pir_u->bot_u); + pir_u->bot_u = 0; + } break; + + case u3_psat_play: { + // XX dispose play q + // + c3_free(pir_u->pay_u); + pir_u->pay_u = 0; + } break; + + case u3_psat_work: { + // XX moveme + // + { + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_exit(pir_u); + u3a_lop(cod_l); + } + } break; + } + + u3K.len_w = 0; + pir_u->sat_e = u3_psat_done; + _pier_exit_cb(pir_u, 0); +} + /* u3_pier_bail(): immediately shutdown. */ void @@ -1364,6 +1440,33 @@ u3_pier_bail(void) exit(1); } +/* u3_pier_halt(): emergency release. +*/ +void +u3_pier_halt(void) +{ + if ( 0 != u3K.len_w ) { + u3_disk_exit(u3_pier_stub()->log_u); + + // we should only ever try this trick once + // + u3K.len_w = 0; + } +} + +/* c3_rand(): fill a 512-bit (16-word) buffer. +*/ +void +c3_rand(c3_w* rad_w) +{ + if ( 0 != ent_getentropy(rad_w, 64) ) { + fprintf(stderr, "c3_rand getentropy: %s\n", strerror(errno)); + // XX review + // + u3_pier_bail(); + } +} + /* _pier_dump_tape(): dump a tape, old style. Don't do this. */ static void From 224856c81c4b32a67e7ded23a23b1ff360dba92b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 27 Apr 2020 12:37:43 -0700 Subject: [PATCH 048/257] vere: refactors ovum lifecycle callbacks --- pkg/urbit/include/vere/vere.h | 39 +++++++++++++++---- pkg/urbit/vere/auto.c | 70 ++++++++++++++++++----------------- pkg/urbit/vere/pier.c | 5 +-- 3 files changed, 69 insertions(+), 45 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index a4cfee6f1..96696792b 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -290,6 +290,24 @@ /** New pier system. **/ + /* u3_ovum_news: u3_ovum lifecycle events + */ + typedef enum { + u3_ovum_drop = 0, // unplanned + u3_ovum_work = 1, // begun + u3_ovum_done = 2 // complete + } u3_ovum_news; + + struct _u3_ovum; + + /* u3_ovum_peer: news callback + */ + typedef void (*u3_ovum_peer)(struct _u3_ovum*, u3_ovum_news); + + /* u3_ovum_bail: failure callback + */ + typedef void (*u3_ovum_bail)(struct _u3_ovum*, u3_noun); + /* u3_ovum: potential event */ typedef struct _u3_ovum { @@ -298,10 +316,14 @@ u3_noun tar; // target (in arvo) u3_noun wir; // wire u3_noun cad; // card - struct { // spinner + struct { // spinner: u3_atom lab; // label c3_o del_o; // delay (c3y) } pin_u; // + struct { // optional callbacks: + u3_ovum_peer news_f; // progress + u3_ovum_bail bail_f; // failure + } cb_u; // struct _u3_ovum* pre_u; // previous ovum struct _u3_ovum* nex_u; // next ovum struct _u3_auto* car_u; // backpointer to i/o driver @@ -500,12 +522,6 @@ c3_m nam_m; c3_o liv_o; u3_auto_cb io; // XX io_u; - struct { - void (*drop_f)(struct _u3_auto*, u3_ovum*); - void (*work_f)(struct _u3_auto*, u3_ovum*); - void (*done_f)(struct _u3_auto*, u3_ovum*, c3_o); - void (*bail_f)(struct _u3_auto*, u3_ovum*, u3_noun); - } ev; struct _u3_ovum* ent_u; struct _u3_ovum* ext_u; struct _u3_auto* nex_u; @@ -704,7 +720,7 @@ /* u3_auto_done(): notify driver of [egg_u] completion. */ void - u3_auto_done(u3_ovum* egg_u, c3_o wap_o); + u3_auto_done(u3_ovum* egg_u); /* u3_auto_bail(): notify driver that [egg_u] crashed. */ @@ -725,6 +741,13 @@ u3_noun wir, u3_noun cad); + /* u3_auto_peer(): subscribe to updates. + */ + void + u3_auto_peer(u3_ovum* egg_u, + u3_ovum_peer news_f, + u3_ovum_bail bail_f); + /* u3_disk_init(): load or create pier directories and event log. */ u3_disk* diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 12664a339..0c3c7339a 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -41,6 +41,9 @@ u3_auto_plan(u3_auto* car_u, egg_u->pin_u.lab = u3k(u3h(wir)); egg_u->pin_u.del_o = c3y; + egg_u->cb_u.news_f = 0; + egg_u->cb_u.bail_f = 0; + if ( !car_u->ent_u ) { c3_assert(!car_u->ext_u); @@ -60,6 +63,17 @@ u3_auto_plan(u3_auto* car_u, return egg_u; } +/* u3_auto_peer(): subscribe to updates. +*/ +void +u3_auto_peer(u3_ovum* egg_u, + u3_ovum_peer news_f, + u3_ovum_bail bail_f) +{ + egg_u->cb_u.news_f = news_f; + egg_u->cb_u.bail_f = bail_f; +} + /* u3_auto_bail_slog(): print a bail notification. */ void @@ -106,9 +120,9 @@ u3_auto_bail(u3_ovum* egg_u, u3_noun lud) { // optional // - if ( egg_u->car_u->ev.bail_f ) { + if ( egg_u->cb_u.bail_f ) { c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); - egg_u->car_u->ev.bail_f(egg_u->car_u, egg_u, lud); + egg_u->cb_u.bail_f(egg_u, lud); u3a_lop(cod_l); } else { @@ -120,20 +134,30 @@ u3_auto_bail(u3_ovum* egg_u, u3_noun lud) u3_auto_drop(0, egg_u); } +/* _auto_news(): notify driver of ovum status +*/ +static void +_auto_news(u3_ovum* egg_u, u3_ovum_news new_e) +{ + // optional + // + if ( egg_u->cb_u.news_f ) { + c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); + egg_u->cb_u.news_f(egg_u, new_e); + u3a_lop(cod_l); + } +} + /* u3_auto_done(): notify driver of [egg_u] completion. */ void -u3_auto_done(u3_ovum* egg_u, c3_o wap_o) +u3_auto_done(u3_ovum* egg_u) { - // optional - // - if ( egg_u->car_u->ev.done_f ) { - c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); - egg_u->car_u->ev.done_f(egg_u->car_u, egg_u, wap_o); - u3a_lop(cod_l); - } + _auto_news(egg_u, u3_ovum_done); - // XX dispose egg_u here? + // XX confirm + // + u3_auto_drop(0, egg_u); // } @@ -142,27 +166,7 @@ u3_auto_done(u3_ovum* egg_u, c3_o wap_o) void u3_auto_work(u3_ovum* egg_u) { - // optional - // - if ( egg_u->car_u->ev.work_f ) { - c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); - egg_u->car_u->ev.work_f(egg_u->car_u, egg_u); - u3a_lop(cod_l); - } -} - -/* _auto_drop(): notify driver of dropped ovum. -*/ -static void -_auto_drop(u3_ovum* egg_u) -{ - // optional - // - if ( egg_u->car_u->ev.drop_f ) { - c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); - egg_u->car_u->ev.drop_f(egg_u->car_u, egg_u->vod_p); - u3a_lop(cod_l); - } + _auto_news(egg_u, u3_ovum_work); } /* u3_auto_drop(): dequeue and dispose an ovum. @@ -181,7 +185,7 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) // notify driver if not self-caused // if ( egg_u->car_u && ( car_u != egg_u->car_u ) ) { - _auto_drop(egg_u); + _auto_news(egg_u, u3_ovum_drop); } u3z(egg_u->pin_u.lab); diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 1ce1b3c95..2b2aed0ff 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -272,10 +272,7 @@ _pier_on_lord_work_done(void* vod_p, // u3_disk_plan(pir_u->log_u, tac_u); - // XX revise - // - u3_auto_done(egg_u, c3n); - u3_auto_drop(0, egg_u); + u3_auto_done(egg_u); _pier_gift_plan(pir_u->wok_u, gif_u); _pier_work(pir_u->wok_u); From f28c775337d10f5b28b27db3353372d4777d40b4 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 27 Apr 2020 22:04:53 -0700 Subject: [PATCH 049/257] wip rewrites peek --- pkg/urbit/include/vere/vere.h | 48 ++++++--- pkg/urbit/vere/lord.c | 197 +++++++++++++++++++++------------- pkg/urbit/vere/pier.c | 12 --- 3 files changed, 157 insertions(+), 100 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 96696792b..30aa9fa80 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -354,26 +354,18 @@ u3_fact* ext_u; // queue exit (lowest) } u3_info; - /* u3_peek_type: namespace read request types + /* u3_peek_cb: namespace read response callback. */ - typedef enum { - u3_peek_just = 0, - u3_peek_last = 1 - } u3_peek_type; + typedef void (*u3_peek_cb)(void*, u3_noun); /* u3_peek: namespace read request */ typedef struct _u3_peek { - c3_m car_m; // care + void* vod_p; // context + u3_peek_cb fun_f; // callback + u3_noun now; // XX u3_noun gan; // leakset - u3_peek_type typ_e; // type-tagged - union { // - u3_noun pax; // /desk/case/... - struct { // - u3_atom des; // desk - u3_noun pax; // /... - } las_u; // - }; // + u3_noun ful; // /care/beam } u3_peek; /* u3_writ_type: king->serf ipc message types @@ -414,7 +406,6 @@ void (*slog_f)(void*, c3_w, u3_noun); void (*spin_f)(void*, u3_atom, c3_o); void (*spun_f)(void*); - void (*peek_f)(void*, u3_peek*, u3_noun); void (*play_done_f)(void*, u3_info, c3_l mug_l); void (*play_bail_f)(void*, u3_info, c3_l mug_l, c3_d eve_d, u3_noun dud); void (*work_done_f)(void*, u3_ovum*, u3_fact*, u3_gift*); @@ -830,7 +821,32 @@ /* u3_lord_peek(): read namespace. */ void - u3_lord_peek(u3_lord* god_u, u3_peek* pek_u); + u3_lord_peek(u3_lord* god_u, + u3_noun gan, + u3_noun ful, + void* vod_p, + u3_peek_cb fun_f); + + /* u3_lord_peek_mine(): read namespace, injecting ship. + */ + void + u3_lord_peek_mine(u3_lord* god_u, + u3_noun gan, + c3_m car_m, + u3_noun pax, + void* vod_p, + u3_peek_cb fun_f); + + /* u3_lord_peek_last(): read namespace, injecting ship and case. + */ + void + u3_lord_peek_last(u3_lord* god_u, + u3_noun gan, + c3_m car_m, + u3_atom des, + u3_noun pax, + void* vod_p, + u3_peek_cb fun_f); /** Filesystem (new api). **/ diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index dc1b802c8..2e9a46014 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -278,7 +278,15 @@ _lord_plea_peek(u3_lord* god_u, u3_noun dat) pek_u = wit_u->pek_u; } - god_u->cb_u.peek_f(god_u->cb_u.vod_p, pek_u, dat); + // XX cache [dat] (unless last) + // + pek_u->fun_f(pek_u->vod_p, dat); + + u3z(pek_u->now); + u3z(pek_u->gan); + u3z(pek_u->ful); + c3_free(pek_u); + // god_u->cb_u.peek_f(god_u->cb_u.vod_p, pek_u, dat); } /* _lord_plea_play_bail(): hear serf %play %bail @@ -590,36 +598,6 @@ _lord_writ_new(u3_lord* god_u) return wit_u; } -/* _lord_writ_peek(): serialize read -*/ -static u3_noun -_lord_writ_peek(u3_noun now, u3_noun our, u3_peek* pek_u) -{ - u3_noun bem; - - { - u3_noun car = u3k(pek_u->car_m); - - switch ( pek_u->typ_e ) { - default: c3_assert(0); - - case u3_peek_just: { - bem = u3nt(car, our, u3k(pek_u->pax)); - } break; - - case u3_peek_last: { - u3_noun des = u3k(pek_u->las_u.des); - u3_noun cas = u3dc("scot", c3__da, u3k(now)); - u3_noun pax = u3k(pek_u->las_u.pax); - - bem = u3nc(car, u3nq(our, des, cas, pax)); - } break; - } - } - - return u3nt(now, u3k(pek_u->gan), bem); -} - /* _lord_writ_jam(): serialize writ. */ static void @@ -636,13 +614,9 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) } break; case u3_writ_peek: { - // XX cache - // - u3_noun our = u3dc("scot", 'p', u3i_chubs(2, ((u3_pier*)god_u->cb_u.vod_p)->who_d)); - u3_noun now = u3_time_in_tv(&wit_u->tim_u); - u3_noun sam = _lord_writ_peek(now, our, wit_u->pek_u); - - msg = u3nc(c3__peek, sam); + msg = u3nq(c3__peek, u3k(wit_u->pek_u->now), + u3k(wit_u->pek_u->gan), + u3k(wit_u->pek_u->ful)); } break; case u3_writ_play: { @@ -716,46 +690,93 @@ _lord_writ_plan(u3_lord* god_u, u3_writ* wit_u) _lord_writ_send(god_u, wit_u); } -/* u3_lord_save(): save a snapshot. -*/ -c3_o -u3_lord_save(u3_lord* god_u) -{ - if ( god_u->dep_w ) { - return c3n; - } - else { - u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_e = u3_writ_save; - _lord_writ_plan(god_u, wit_u); - return c3y; - } -} - -/* u3_lord_pack(): save portable state. -*/ -c3_o -u3_lord_pack(u3_lord* god_u) -{ - if ( god_u->dep_w ) { - return c3n; - } - else { - u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_e = u3_writ_pack; - _lord_writ_plan(god_u, wit_u); - return c3y; - } -} - /* u3_lord_peek(): read namespace. */ void -u3_lord_peek(u3_lord* god_u, u3_peek* pek_u) +u3_lord_peek(u3_lord* god_u, + u3_noun gan, + u3_noun ful, + void* vod_p, + u3_peek_cb fun_f) { u3_writ* wit_u = _lord_writ_new(god_u); wit_u->typ_e = u3_writ_peek; - wit_u->pek_u = pek_u; + wit_u->pek_u = c3_calloc(sizeof(*wit_u->pek_u)); + wit_u->pek_u->vod_p = vod_p; + wit_u->pek_u->fun_f = fun_f; + wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_u); + wit_u->pek_u->gan = gan; + wit_u->pek_u->ful = ful; + + // XX cache check + // + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_peek_mine(): read namespace, injecting ship (our). +*/ +void +u3_lord_peek_mine(u3_lord* god_u, + u3_noun gan, + c3_m car_m, + u3_noun pax, + void* vod_p, + u3_peek_cb fun_f) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_e = u3_writ_peek; + wit_u->pek_u = c3_calloc(sizeof(*wit_u->pek_u)); + wit_u->pek_u->vod_p = vod_p; + wit_u->pek_u->fun_f = fun_f; + wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_u); + wit_u->pek_u->gan = gan; + + { + // XX cache + // + u3_pier* pir_u = god_u->cb_u.vod_p; // XX do better + u3_noun our = u3dc("scot", 'p', u3i_chubs(2, pir_u->who_d)); + wit_u->pek_u->ful = u3nt(car_m, our, pax); + } + + // XX cache check + // + + _lord_writ_plan(god_u, wit_u); +} + +/* u3_lord_peek_last(): read namespace, injecting ship (our) and case (now). +*/ +void +u3_lord_peek_last(u3_lord* god_u, + u3_noun gan, + c3_m car_m, + u3_atom des, + u3_noun pax, + void* vod_p, + u3_peek_cb fun_f) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_e = u3_writ_peek; + wit_u->pek_u = c3_calloc(sizeof(*wit_u->pek_u)); + wit_u->pek_u->vod_p = vod_p; + wit_u->pek_u->fun_f = fun_f; + wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_u); + wit_u->pek_u->gan = gan; + + { + // XX cache + // + u3_pier* pir_u = god_u->cb_u.vod_p; // XX do better + u3_noun our = u3dc("scot", 'p', u3i_chubs(2, pir_u->who_d)); + u3_noun cas = u3dc("scot", c3__da, u3k(wit_u->pek_u->now)); + + wit_u->pek_u->ful = u3nc(car_m, u3nq(our, des, cas, pax)); + } + + // NB, won't be cached, result shouldn't be + // _lord_writ_plan(god_u, wit_u); } @@ -801,6 +822,38 @@ u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo) _lord_writ_plan(god_u, wit_u); } +/* u3_lord_save(): save a snapshot. +*/ +c3_o +u3_lord_save(u3_lord* god_u) +{ + if ( god_u->dep_w ) { + return c3n; + } + else { + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_e = u3_writ_save; + _lord_writ_plan(god_u, wit_u); + return c3y; + } +} + +/* u3_lord_pack(): save portable state. +*/ +c3_o +u3_lord_pack(u3_lord* god_u) +{ + if ( god_u->dep_w ) { + return c3n; + } + else { + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_e = u3_writ_pack; + _lord_writ_plan(god_u, wit_u); + return c3y; + } +} + /* u3_lord_exit(): shutdown gracefully. */ void diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 2b2aed0ff..65eee218e 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -809,17 +809,6 @@ _pier_on_lord_slog(void* vod_p, c3_w pri_w, u3_noun tan) } } -/* _pier_on_lord_peek(): namespace read response from worker. -*/ -static void -_pier_on_lord_peek(void* vod_p, u3_peek* pek_u, u3_noun dat) -{ - // XX cache, invoke callback, dispose pek_u - // - u3m_p("lord peek", dat); - u3z(dat); -} - /* _pier_on_lord_save(): worker (non-portable) snapshot complete. */ static void @@ -965,7 +954,6 @@ _pier_init(c3_w wag_w, c3_c* pax_c) .spin_f = _pier_on_lord_work_spin, .spun_f = _pier_on_lord_work_spun, .slog_f = _pier_on_lord_slog, - .peek_f = _pier_on_lord_peek, .play_done_f = _pier_on_lord_play_done, .play_bail_f = _pier_on_lord_play_bail, .work_done_f = _pier_on_lord_work_done, From 60183bded1c5581d1eef6ab63d01dd1c2ffc6f34 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 29 Apr 2020 17:35:31 -0700 Subject: [PATCH 050/257] vere: refactors event replay and failure printfs --- pkg/urbit/include/vere/vere.h | 13 +++- pkg/urbit/vere/auto.c | 25 +----- pkg/urbit/vere/pier.c | 139 +++++++++++++++++++++++++++------- 3 files changed, 124 insertions(+), 53 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 30aa9fa80..9b91d5b34 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -488,12 +488,9 @@ /* u3_play: replay control. */ typedef struct _u3_play { - // XX batch, save/pack/wall? - // c3_d eve_d; // target c3_d req_d; // last read requested c3_d sen_d; // last sent - // u3_fact* sen_u; // last sent u3_fact* ent_u; // queue entry u3_fact* ext_u; // queue exit struct _u3_pier* pir_u; // pier backpointer @@ -1148,6 +1145,16 @@ void u3_pier_punt(c3_l tab_l, u3_noun tac); + /* u3_pier_punt_goof(): dump a [mote tang] crash report. + */ + void + u3_pier_punt_goof(const c3_c* cap_c, u3_noun dud); + + /* u3_pier_punt_ovum(): print ovum details. + */ + void + u3_pier_punt_ovum(const c3_c* cap_c, u3_noun wir, u3_noun tag); + /* u3_pier_sway(): print trace. */ void diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 0c3c7339a..743fdd528 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -81,33 +81,16 @@ u3_auto_bail_slog(u3_ovum* egg_u, u3_noun lud) { c3_c* car_c = u3r_string(egg_u->car_u->nam_m); u3_noun dul = lud; + c3_w len_w = 1; while ( u3_nul != dul ) { - c3_c* mot_c; - u3_noun mot, tan; - - u3x_cell(u3h(dul), &mot, &tan); - - u3l_log("\n"); - u3_pier_punt(0, u3qb_flop(tan)); - - mot_c = u3r_string(mot); - u3l_log("%s: bail: %%%s\r\n", car_c, mot_c); + u3l_log("%s: bail %u\r\n", car_c, len_w++); + u3_pier_punt_goof(car_c, u3k(u3h(dul))); dul = u3t(dul); - c3_free(mot_c); } - { - c3_c* tag_c = u3r_string(u3h(egg_u->cad)); - u3_noun riw = u3do("spat", u3k(egg_u->wir)); - c3_c* wir_c = u3r_string(riw); - - u3l_log("%s: %%%s event on %s failed\r\n\n", car_c, tag_c, wir_c); - c3_free(tag_c); - c3_free(wir_c); - u3z(riw); - } + u3_pier_punt_ovum(car_c, u3k(egg_u->wir), u3k(u3h(egg_u->cad))); u3z(lud); c3_free(car_c); diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 65eee218e..7a8d2418d 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -611,28 +611,29 @@ static void _pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) { u3_pier* pir_u = vod_p; - c3_d las_d = fon_u.ent_u->eve_d; + u3_fact* tac_u = fon_u.ent_u; + u3_fact* nex_u; c3_assert( u3_psat_play == pir_u->sat_e ); -// #ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): play: done\r\n", las_d); -// #endif +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): play: done\r\n", tac_u->eve_d); +#endif // XX optional // - if ( fon_u.ent_u->mug_l - && (fon_u.ent_u->mug_l != mug_l) ) - { - // XX printf - // - u3l_log("pier: (%" PRIu64 "): play: mug mismatch %x %x\r\n", las_d, fon_u.ent_u->mug_l, mug_l); + if ( tac_u->mug_l && (tac_u->mug_l != mug_l) ) { + u3l_log("pier: (%" PRIu64 "): play: mug mismatch %x %x\r\n", + tac_u->eve_d, + tac_u->mug_l, + mug_l); // u3_pier_bail(); } + // dispose successful + // { - u3_fact* tac_u = fon_u.ext_u; - u3_fact* nex_u; + tac_u = fon_u.ext_u; while ( tac_u ) { nex_u = tac_u->nex_u; @@ -653,29 +654,71 @@ _pier_on_lord_play_bail(void* vod_p, u3_info fon_u, { u3_pier* pir_u = vod_p; -#ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): play: bail\r\n", eve_d); -#endif - c3_assert( u3_psat_play == pir_u->sat_e ); - // XX verify pay_u mug_l - // XX check dud mote, retry yap_u or shutdown + { + u3_fact* tac_u = fon_u.ext_u; + u3_fact* nex_u; + c3_l las_l = 0; - // { - // u3_play* yap_u = c3_malloc(sizeof(*yap_u)); - // u3_fact* fac_u = pay_u->ext_u; + // dispose successful + // + while ( tac_u->eve_d < eve_d ) { + nex_u = tac_u->nex_u; + las_l = tac_u->mug_l; + u3z(tac_u->job); + c3_free(tac_u); + tac_u = nex_u; + } - // while ( fac_u->eve_d < eve_d ) { - // fac_u = fac_u->nex_u; - // } + // XX optional + // + if ( las_l && (las_l != mug_l) ) { + u3l_log("pier: (%" PRIu64 "): play bail: mug mismatch %x %x\r\n", + (c3_d)(eve_d - 1ULL), + las_l, + mug_l); + // u3_pier_bail(); + } - // yap_u->ext_u = fac_u->nex_u; - // yap_u->ent_u = pay_u->ent_u; - // pay_u->ent_u = fac_u; - // } + // XX enable to retry + // +#if 0 + { + u3l_log("pier: (%" PRIu64 "): play: retry\r\n", eve_d); - u3_pier_bail(); + fon_u.ext_u = tac_u; + + // we're enqueuing here directly onto the exit. + // like, _pier_play_plan() in reverse + // + if ( !pay_u->ext_u ) { + pay_u->ext_u = fon_u.ext_u; + pay_u->ent_u = fon_u.ent_u; + } + else { + fon_u.ent_u->nex_u = pay_u->ext_u; + pay_u->ext_u = fon_u.ext_u; + } + + _pier_play(pir_u->pay_u); + u3z(dud); + } +#else + { + u3l_log("pier: (%" PRIu64 "): play: bail\r\n", eve_d); + u3_pier_punt_goof("play", dud); + { + u3_noun wir, tag; + u3x_qual(tac_u->job, 0, &wir, &tag, 0); + u3_pier_punt_ovum("play", u3k(wir), u3k(tag)); + } + + u3_pier_bail(); + exit(1); + } +#endif + } } /* _pier_play_init(): begin boot/replay up to [eve_d]. @@ -1571,6 +1614,44 @@ u3_pier_punt(c3_l tab_l, u3_noun tac) u3z(tac); } +/* u3_pier_punt_goof(): dump a [mote tang] crash report. +*/ +void +u3_pier_punt_goof(const c3_c* cap_c, u3_noun dud) +{ + u3_noun bud = dud; + u3_noun mot, tan; + + u3x_cell(dud, &mot, &tan); + + u3l_log("\n"); + u3_pier_punt(0, u3qb_flop(tan)); + + { + c3_c* mot_c = u3r_string(mot); + u3l_log("%s: bail: %%%s\r\n", cap_c, mot_c); + c3_free(mot_c); + } + + u3z(bud); +} + +/* u3_pier_punt_ovum(): print ovum details. +*/ +void +u3_pier_punt_ovum(const c3_c* cap_c, u3_noun wir, u3_noun tag) +{ + c3_c* tag_c = u3r_string(tag); + u3_noun riw = u3do("spat", wir); + c3_c* wir_c = u3r_string(riw); + + u3l_log("%s: %%%s event on %s failed\r\n\n", cap_c, tag_c, wir_c); + + c3_free(tag_c); + c3_free(wir_c); + u3z(riw); +} + /* u3_pier_sway(): print trace. */ void From 6e98bdd3d3eb1343a95f4da8d6309051ef6d8e59 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 14:48:29 -0700 Subject: [PATCH 051/257] TMP kill -9 urbit in test --- nix/ops/test/builder.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nix/ops/test/builder.sh b/nix/ops/test/builder.sh index 875be32b3..ae5948e6a 100644 --- a/nix/ops/test/builder.sh +++ b/nix/ops/test/builder.sh @@ -12,7 +12,7 @@ tailproc=$! shutdown () { if [ -e ./ship/.vere.lock ] - then kill $(< ./ship/.vere.lock) || true; + then kill -9 $(< ./ship/.vere.lock) || true; fi kill "$tailproc" || true; From 008cd925ffd8823c8f67b0c5366ff5320918165a Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 14:53:14 -0700 Subject: [PATCH 052/257] u3: switches GMP import assert to conditional --- pkg/urbit/noun/retrieve.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/pkg/urbit/noun/retrieve.c b/pkg/urbit/noun/retrieve.c index cd01e2ba8..7da63cbcc 100644 --- a/pkg/urbit/noun/retrieve.c +++ b/pkg/urbit/noun/retrieve.c @@ -1092,10 +1092,14 @@ u3r_mp(mpz_t a_mp, u3a_atom* b_u = u3a_to_ptr(b); c3_w len_w = b_u->len_w; - // slight deficiency in the GMP API. + // avoid reallocation on import, if possible // - c3_assert(!(len_w >> 27)); - mpz_init2(a_mp, len_w << 5); + if ( (len_w >> 27) ) { + mpz_init(a_mp); + } + else { + mpz_init2(a_mp, len_w << 5); + } mpz_import(a_mp, len_w, -1, sizeof(c3_w), 0, 0, b_u->buf_w); } From 9b4dfa930c4a4e777d9742dd1c0a7802b5688f6b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 18:55:19 -0700 Subject: [PATCH 053/257] u3: fixes rock:load size printf --- pkg/urbit/noun/manage.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/urbit/noun/manage.c b/pkg/urbit/noun/manage.c index 6098a042f..3f7b60ec0 100644 --- a/pkg/urbit/noun/manage.c +++ b/pkg/urbit/noun/manage.c @@ -1744,7 +1744,7 @@ u3m_rock_load(c3_c* dir_c, c3_d evt_d) // XX u3m_file bails, but we'd prefer to return errors // u3_noun fil = u3m_file(nam_c); - u3a_print_memory(stderr, "rock: load", u3r_met(3, fil)); + u3a_print_memory(stderr, "rock: load", u3r_met(5, fil)); u3_noun pro = u3m_soft(0, u3ke_cue, fil); From 6d29897bb45240e65843d8322c0450f84e165612 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 14:58:31 -0700 Subject: [PATCH 054/257] serf: tweaks pack for recovery ops --- pkg/urbit/worker/serf.c | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index db286742e..15374a5f7 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -290,8 +290,11 @@ _serf_static_grab(void) static void _serf_pack(u3_serf* sef_u) { + // skip for now + // // _serf_static_grab(); - u3l_log("serf: compacting loom\r\n"); + + u3l_log("serf (%" PRIu64 "): compacting loom\r\n", sef_u->dun_d); if ( c3n == u3m_rock_stay(sef_u->dir_c, sef_u->dun_d) ) { u3l_log("serf: unable to jam state\r\n"); @@ -318,12 +321,19 @@ _serf_pack(u3_serf* sef_u) u3l_log("serf: warning: orphaned backup checkpoint file\r\n"); } - if ( c3n == u3m_rock_drop(sef_u->dir_c, sef_u->dun_d) ) { - u3l_log("serf: warning: orphaned state file\r\n"); - } + // leave these for now + // + // if ( c3n == u3m_rock_drop(sef_u->dir_c, sef_u->dun_d) ) { + // u3l_log("serf: warning: orphaned state file\r\n"); + // } + + u3l_log("serf (%" PRIu64 "): compacted loom\r\n", sef_u->dun_d); - u3l_log("serf: compacted loom\r\n"); _serf_static_grab(); + + // save now for flexibility + // + u3e_save(); } /* u3_serf_post(): update serf state post-writ. From 1c105a89189b719cca0e6668f686d4525b4badd9 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 18:14:42 -0700 Subject: [PATCH 055/257] serf: fix bug on auto-reclaim on replay --- pkg/urbit/worker/serf.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 15374a5f7..aa65de765 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -447,7 +447,7 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) // - we don't make very effective use of our free lists // else { - sef_u->rec_o = _(0 == (sef_u->dun_d % 1000ULL)); + sef_u->rec_o = c3o(sef_u->rec_o, _(0 == (sef_u->dun_d % 1000ULL))); } // notify daemon of memory pressure via "fake" effect From b06772f264628f60c60a8ed68903396b2c829724 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 18:08:51 -0700 Subject: [PATCH 056/257] vere: print replay batch completions --- pkg/urbit/vere/pier.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 9e1fe00e2..dec7d0d1f 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -619,9 +619,7 @@ _pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) c3_assert( u3_psat_play == pir_u->sat_e ); -#ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): play: done\r\n", tac_u->eve_d); -#endif + u3l_log("pier: (%" PRIu64 "): play: done\r\n", tac_u->eve_d); // XX optional // From 1827d0a4c03ea9ef25071ac5bc1be4634fb9bc1b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 1 May 2020 00:00:23 -0700 Subject: [PATCH 057/257] serf: implements %pack writ --- pkg/urbit/worker/serf.c | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index aa65de765..a20ad6f3b 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -948,10 +948,32 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) return c3y; } - // XX - // case c3__pack: { - c3_stub; + c3_d eve_d; + + if ( c3n == u3r_safe_chub(dat, &eve_d) ) { + u3z(com); + return c3n; + } + + u3z(com); + + if( eve_d != sef_u->dun_d ) { + fprintf(stderr, "serf (%" PRIu64 "): pack failed: %" PRIu64 "\r\n", + sef_u->dun_d, + eve_d); + return c3n; + } + + u3l_log("serf (%" PRIu64 "): saving rock\r\n", sef_u->dun_d); + + if ( c3n == u3m_rock_stay(sef_u->dir_c, eve_d) ) { + fprintf(stderr, "serf (%" PRIu64 "): unable to jam state\r\n", eve_d); + return c3n; + } + + *ret = u3nc(c3__live, u3_nul); + return c3y; } case c3__save: { From b24a83e8f26d08d9de59859527fed1363c903652 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 18:57:49 -0700 Subject: [PATCH 058/257] vere: bumps replay batch size to 500 events --- pkg/urbit/vere/pier.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index dec7d0d1f..b5d27a4d5 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -21,7 +21,7 @@ #include "vere/vere.h" #define PIER_READ_BATCH 1000ULL -#define PIER_PLAY_BATCH 100ULL +#define PIER_PLAY_BATCH 500ULL #define PIER_WORK_BATCH 10ULL #undef VERBOSE_PIER From 00851a2229d5416d25d8430b31cbade7afb49a13 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 23:30:19 -0700 Subject: [PATCH 059/257] vere: fixes early replay termination --- pkg/urbit/vere/pier.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 7a8d2418d..b7ec5c901 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -559,7 +559,7 @@ _pier_play_read(u3_play* pay_u) { c3_d nex_d = (1ULL + las_d); - c3_d len_d = c3_min(pir_u->log_u->dun_d - las_d, PIER_READ_BATCH); + c3_d len_d = c3_min(pay_u->eve_d - las_d, PIER_READ_BATCH); if ( len_d && (nex_d > pay_u->req_d) ) @@ -590,7 +590,10 @@ _pier_play(u3_play* pay_u) u3_term_stop_spinner(); if ( pay_u->eve_d < log_u->dun_d ) { + u3l_log("pier: replay barrier reached, shutting down\r\n"); // XX graceful shutdown + // + u3_lord_save(pir_u->god_u); u3_pier_bail(); exit(0); } From d91e119623731f5db513dbb7e24ac962de2364b9 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 15:29:56 -0700 Subject: [PATCH 060/257] serf: auto-pack every 50K events --- pkg/urbit/worker/serf.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index a20ad6f3b..53f366be5 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -450,6 +450,10 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) sef_u->rec_o = c3o(sef_u->rec_o, _(0 == (sef_u->dun_d % 1000ULL))); } + // pack every 50K events + // + sef_u->pac_o = c3o(sef_u->pac_o, _(0 == (sef_u->dun_d % 50000ULL))); + // notify daemon of memory pressure via "fake" effect // if ( u3_none != pri ) { From dfa818a069dd6ba201b4cfbe2e171275e9f044af Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 16:02:30 -0700 Subject: [PATCH 061/257] vere: adds -r to load rock (jammed kernel) on startup if present --- pkg/urbit/daemon/main.c | 6 +++- pkg/urbit/include/vere/vere.h | 1 + pkg/urbit/vere/lord.c | 14 +++++++-- pkg/urbit/worker/main.c | 59 ++++++++++++++++++++++++++++++++++- 4 files changed, 76 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 9f64c3cde..1b533b578 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -97,7 +97,7 @@ _main_getopt(c3_i argc, c3_c** argv) u3_Host.ops_u.kno_w = DefaultKernel; while ( -1 != (ch_i=getopt(argc, argv, - "G:J:B:K:A:H:I:w:u:e:F:k:p:LljacdgqstvxPDRS")) ) + "G:J:B:K:A:H:I:w:u:e:F:k:p:r:LljacdgqstvxPDRS")) ) { switch ( ch_i ) { case 'J': { @@ -166,6 +166,10 @@ _main_getopt(c3_i argc, c3_c** argv) u3_Host.ops_u.rep = c3y; return c3y; } + case 'r': { + u3_Host.ops_u.roc_c = strdup(optarg); + break; + } case 'L': { u3_Host.ops_u.net = c3n; break; } case 'l': { u3_Host.ops_u.lit = c3y; break; } case 'j': { u3_Host.ops_u.tra = c3y; break; } diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 9b91d5b34..dd5e46b31 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -263,6 +263,7 @@ c3_s por_s; // -p, ames port c3_o qui; // -q, quiet c3_o rep; // -R, report build info + c3_c* roc_c; // -r, load rock by eve_d c3_o has; // -S, Skip battery hashes c3_o tem; // -t, Disable terminal/tty assumptions c3_o git; // -s, pill url from arvo git hash diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 2e9a46014..5e0b4757a 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -885,7 +885,7 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) // spawn new process and connect to it // { - c3_c* arg_c[5]; + c3_c* arg_c[6]; c3_c key_c[256]; c3_c wag_c[11]; c3_i err_i; @@ -902,7 +902,17 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) arg_c[1] = god_u->pax_c; // path to checkpoint directory arg_c[2] = key_c; // disk key arg_c[3] = wag_c; // runtime config - arg_c[4] = 0; + + if ( u3_Host.ops_u.roc_c ) { + // XX validate + // + arg_c[4] = u3_Host.ops_u.roc_c; + } + else { + arg_c[4] = 0; + } + + arg_c[5] = 0; uv_pipe_init(u3L, &god_u->inn_u.pyp_u, 0); uv_pipe_init(u3L, &god_u->out_u.pyp_u, 0); diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index d0ba2bd06..7ebbf44c4 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -99,8 +99,15 @@ main(c3_i argc, c3_c* argv[]) c3_c* dir_c = argv[1]; c3_c* key_c = argv[2]; c3_c* wag_c = argv[3]; + c3_d eve_d = 0; - c3_assert(4 == argc); + c3_assert( (4 == argc) || (5 == argc) ); + + if ( 5 == argc ) { + if ( 1 != sscanf(argv[4], "%" PRIu64 "", &eve_d) ) { + fprintf(stderr, "serf: rock: invalid number '%s'\r\n", argv[4]); + } + } memset(&u3V, 0, sizeof(u3V)); memset(&u3_Host.tra_u, 0, sizeof(u3_Host.tra_u)); @@ -161,6 +168,56 @@ main(c3_i argc, c3_c* argv[]) { u3V.dir_c = strdup(dir_c); u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); + + + { + c3_o roc_o; + c3_c nam_c[8193]; + snprintf(nam_c, 8192, "%s/.urb/roc/%" PRIu64 ".jam", u3V.dir_c, eve_d); + + struct stat buf_b; + c3_i fid_i = open(nam_c, O_RDONLY, 0644); + + if ( (fid_i < 0) || (fstat(fid_i, &buf_b) < 0) ) { + fprintf(stderr, "serf: rock: %s not found\r\n", nam_c); + roc_o = c3n; + } + else { + fprintf(stderr, "serf: rock: %s found\r\n", nam_c); + roc_o = c3y; + } + + close(fid_i); + + + if ( c3y == roc_o ) { + if ( c3n == u3e_hold() ) { + fprintf(stderr, "serf: unable to backup checkpoint\r\n"); + } + else { + u3m_wipe(); + + if ( c3n == u3m_rock_load(u3V.dir_c, eve_d) ) { + fprintf(stderr, "serf: compaction failed, restoring checkpoint\r\n"); + + if ( c3n == u3e_fall() ) { + fprintf(stderr, "serf: unable to restore checkpoint\r\n"); + c3_assert(0); + } + } + + if ( c3n == u3e_drop() ) { + fprintf(stderr, "serf: warning: orphaned backup checkpoint file\r\n"); + } + + fprintf(stderr, "serf (%" PRIu64 "): compacted loom\r\n", eve_d); + + // save now for flexibility + // + u3e_save(); + } + } + } } // set up logging From 73b74af67860ba69b9befdf0c10b478db0ad4282 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 1 May 2020 00:18:15 -0700 Subject: [PATCH 062/257] vere: HACK pack on -n completion --- pkg/urbit/vere/pier.c | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index b5d27a4d5..7b98fdfab 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -574,6 +574,9 @@ _pier_play_read(u3_play* pay_u) } } +c3_o +u3_pier_pack(u3_pier* pir_u); + /* _pier_play(): send a batch of events to the worker for log replay. */ static void @@ -590,12 +593,17 @@ _pier_play(u3_play* pay_u) u3_term_stop_spinner(); if ( pay_u->eve_d < log_u->dun_d ) { - u3l_log("pier: replay barrier reached, shutting down\r\n"); - // XX graceful shutdown + // u3l_log("pier: replay barrier reached, shutting down\r\n"); + // // XX graceful shutdown + // // + // u3_lord_save(pir_u->god_u); + // u3_pier_bail(); + // exit(0); + + // XX temporary hack // - u3_lord_save(pir_u->god_u); - u3_pier_bail(); - exit(0); + u3l_log("pier: replay barrier reached, packing\r\n"); + u3_pier_pack(pir_u); } else if ( pay_u->eve_d == log_u->dun_d ) { _pier_work_init(pir_u); @@ -878,6 +886,14 @@ _pier_on_lord_pack(void* vod_p) fprintf(stderr, "pier: (%" PRIu64 "): lord: pack\r\n", pir_u->god_u->eve_d); #endif + // XX temporary hack + // + if ( u3_psat_play == pir_u->sat_e ) { + u3l_log("pier: pack complete, shutting down\r\n"); + u3_pier_bail(); + exit(0); + } + // if ( u3_psat_done == pir_u->sat_e ) { // fprintf(stderr, "snap cb exit\r\n"); // u3_lord_exit(pir_u->god_u, 0); From 496b0aa412755acfbc05ed87a07704c0867d8ad7 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 30 Apr 2020 23:31:01 -0700 Subject: [PATCH 063/257] vere: adds -n replay barrier --- pkg/urbit/daemon/main.c | 6 +++++- pkg/urbit/include/vere/vere.h | 1 + pkg/urbit/vere/pier.c | 22 ++++++++++++++++++++-- 3 files changed, 26 insertions(+), 3 deletions(-) diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 1b533b578..17de3f5f7 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -97,7 +97,7 @@ _main_getopt(c3_i argc, c3_c** argv) u3_Host.ops_u.kno_w = DefaultKernel; while ( -1 != (ch_i=getopt(argc, argv, - "G:J:B:K:A:H:I:w:u:e:F:k:p:r:LljacdgqstvxPDRS")) ) + "G:J:B:K:A:H:I:w:u:e:F:k:n:p:r:LljacdgqstvxPDRS")) ) { switch ( ch_i ) { case 'J': { @@ -156,6 +156,10 @@ _main_getopt(c3_i argc, c3_c** argv) u3_Host.ops_u.key_c = strdup(optarg); break; } + case 'n': { + u3_Host.ops_u.til_c = strdup(optarg); + break; + } case 'p': { if ( c3n == _main_readw(optarg, 65536, &arg_w) ) { return c3n; diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index dd5e46b31..1640ba924 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -259,6 +259,7 @@ c3_c* key_c; // -k, private key file c3_o net; // -L, local-only networking c3_o lit; // -l, lite mode + c3_c* til_c; // -n, play till eve_d c3_o pro; // -P, profile c3_s por_s; // -p, ames port c3_o qui; // -q, quiet diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index b7ec5c901..9e1fe00e2 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -204,7 +204,7 @@ _pier_work(u3_work* wok_u) // XX this is when "boot" is actually complete // XX even better would be after neighboring with our sponsor // - u3l_log("pier: live\r\n"); + u3l_log("pier (%" PRIu64 "): live\r\n", pir_u->god_u->eve_d); // XX move callbacking to king // @@ -938,7 +938,25 @@ _pier_on_lord_live(void* vod_p) c3_assert( log_u->sen_d == log_u->dun_d ); if ( god_u->eve_d < log_u->dun_d ) { - _pier_play_init(pir_u, log_u->dun_d); + c3_d eve_d; + + // XX revisit + // + if ( u3_Host.ops_u.til_c ) { + if ( 1 == sscanf(u3_Host.ops_u.til_c, "%" PRIu64 "", &eve_d) ) { + u3l_log("pier: replay till %" PRIu64 "\r\n", eve_d); + } + else { + u3l_log("pier: ignoring invalid replay barrier '%s'\r\n", + u3_Host.ops_u.til_c); + eve_d = log_u->dun_d; + } + } + else { + eve_d = log_u->dun_d; + } + + _pier_play_init(pir_u, eve_d); } else { _pier_work_init(pir_u); From 50f64ec76ec3b8c124fd3a8951fcf15146d3195f Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 1 May 2020 01:04:28 -0700 Subject: [PATCH 064/257] blah roc --- pkg/urbit/worker/main.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index 7ebbf44c4..9adb5b0e2 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -169,8 +169,7 @@ main(c3_i argc, c3_c* argv[]) u3V.dir_c = strdup(dir_c); u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); - - { + if ( eve_d ) { c3_o roc_o; c3_c nam_c[8193]; snprintf(nam_c, 8192, "%s/.urb/roc/%" PRIu64 ".jam", u3V.dir_c, eve_d); From 94b99c38ef1c9231bf84a8d4caf0fce0becf7929 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 1 May 2020 01:04:03 -0700 Subject: [PATCH 065/257] vere: use separate timers for each disk read request --- pkg/urbit/vere/disk.c | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 4075a4ca3..3b3a7dcca 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -21,6 +21,7 @@ #include struct _cd_read { + uv_timer_t tim_u; c3_d eve_d; c3_d len_d; struct _u3_fact* ent_u; // queue entry @@ -302,8 +303,7 @@ _disk_read_done_cb(uv_timer_t* tim_u) c3_assert( red_u->ext_u ); log_u->cb_u.read_done_f(log_u->cb_u.vod_p, pay_u); - c3_free(red_u); - tim_u->data = 0; + uv_close((uv_handle_t*)tim_u, (uv_close_cb)free); } /* _disk_read_one_cb(): lmdb read callback, invoked for each event in order @@ -361,7 +361,6 @@ _disk_read_start_cb(uv_timer_t* tim_u) struct _cd_read* red_u = tim_u->data; u3_disk* log_u = red_u->log_u; - // read events synchronously // if ( c3n == c3_lmdb_read(log_u->mdb_u, @@ -380,7 +379,7 @@ _disk_read_start_cb(uv_timer_t* tim_u) // finish the read asynchronously // - uv_timer_start(&log_u->tim_u, _disk_read_done_cb, 0, 0); + uv_timer_start(&red_u->tim_u, _disk_read_done_cb, 0, 0); } /* u3_disk_read(): read [len_d] events starting at [eve_d]. @@ -398,10 +397,12 @@ u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d) // perform the read asynchronously // - // XX unsafe, queue reads + // XX queue reads for cancelation // - log_u->tim_u.data = red_u; - uv_timer_start(&log_u->tim_u, _disk_read_start_cb, 0, 0); + uv_timer_init(u3L, &red_u->tim_u); + + red_u->tim_u.data = red_u; + uv_timer_start(&red_u->tim_u, _disk_read_start_cb, 0, 0); } /* _disk_save_meta(): serialize atom, save as metadata at [key_c]. @@ -556,7 +557,7 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) log_u->ted_o = c3n; log_u->cb_u = cb_u; - uv_timer_init(u3L, &log_u->tim_u); + // uv_timer_init(u3L, &log_u->tim_u); // create/load pier directory // From 69dc86c5771b6e661a94c7b474870a4b8fbd7064 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 1 May 2020 01:37:08 -0700 Subject: [PATCH 066/257] serf: measure memory after %pack writ --- pkg/urbit/worker/serf.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 53f366be5..08c5c8e02 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -976,6 +976,8 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) return c3n; } + _serf_static_grab(); + *ret = u3nc(c3__live, u3_nul); return c3y; } From a1389f6ecd8d5b6298d1be9a36b83295b9db95e1 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 1 May 2020 01:39:31 -0700 Subject: [PATCH 067/257] serf: fixes -r load by tracking event number --- pkg/urbit/worker/main.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index 9adb5b0e2..c50d12728 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -211,6 +211,8 @@ main(c3_i argc, c3_c* argv[]) fprintf(stderr, "serf (%" PRIu64 "): compacted loom\r\n", eve_d); + u3V.sen_d = u3V.dun_d = eve_d; + // save now for flexibility // u3e_save(); From 80d900d542be65aa8254697977b1b2147e647b5c Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Fri, 1 May 2020 14:30:54 -0700 Subject: [PATCH 068/257] king: First stab at handling ship crashes gracefully. --- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 84 ++++++++++++++++++++++-- 1 file changed, 79 insertions(+), 5 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index eeb4b806e..ba69f092e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -1,5 +1,25 @@ -{-| - King Haskell Entry Point +{- | + # Signal Handling (SIGTERM, SIGINT) + + We handle SIGTERM by causing the main thread to raise a `UserInterrupt` + exception. This is the same behavior as SIGINT (the signal sent upon + `CTRL-C`). + + The main thread is therefore responsible for handling this exception + and causing everything to shut down properly. + + # Crashing and Shutting Down + + Rule number one: The King never crashes. + + This rule is asperational at the moment, but it needs to become as + close to truth as possible. Shut down ships in extreme cases, but + never let the king go down. +-} + +{- + TODO These some old scribbled notes. They don't belong here + anymore. Do something about it. # Event Pruning @@ -561,14 +581,68 @@ main = do CLI.CmdBug CLI.CheckComet -> runApp $ checkComet CLI.CmdCon pier -> runAppLogFile $ connTerm pier + +{- + Runs a ship but restarts it if it crashes or shuts down on it's own. + + Once `waitForKillRequ` returns, the ship will be terminated and this + routine will exit. + + TODO Use logging system instead of printing. +-} +runShipRestarting :: STM () -> CLI.Run -> CLI.Opts -> IO () +runShipRestarting waitForKillRequ r o = do + let pier = pack (CLI.rPierPath r) + loop = runShipRestarting waitForKillRequ r o + + tid <- asyncBound (runShip r o True) + + let onShipExit = Left <$> waitCatchSTM tid + onKillRequ = Right <$> waitForKillRequ + + atomically (onShipExit <|> onKillRequ) >>= \case + Left exit -> do + case exit of + Left err -> putStrLn (tshow err <> ": " <> pier) + Right () -> putStrLn ("Ship exited on it's own. Why? " <> pier) + threadDelay 250_000 + loop + Right () -> do + putStrLn ("King Shutdown requested. Killing: " <> pier) + cancel tid + putStrLn ("Ship terminated: " <> pier) + + runShips :: [(CLI.Run, CLI.Opts, Bool)] -> IO () runShips = \case [] -> pure () [(r, o, d)] -> runShip r o d ships -> do - threads <- for ships $ \(r, o, _) -> asyncBound (runShip r o True) - atomically $ asum (void . waitCatchSTM <$> threads) - for_ threads cancel + killSignal <- newEmptyTMVarIO + + let waitForKillRequ = readTMVar killSignal + + shipThreads <- for ships $ \(r, o, _) -> do + async (runShipRestarting waitForKillRequ r o) + + {- + This `waitAny` call never returns, so this runs until the main + thread is killed with an async exception. The one we expect is + `UserInterrupt` which will be raised on this thread upon SIGKILL + or SIGTERM. + -} + res <- try (waitAny shipThreads) + + {- + Send the kill signal to all of the ships, and then wait for all + of them to exit. + -} + let die = do atomically (putTMVar killSignal ()) + for_ shipThreads waitCatch + + case res of + Left UserInterrupt -> die + _ -> die -------------------------------------------------------------------------------- From e56e538ff39ce308db9dbe35f5201842605a1af4 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Fri, 1 May 2020 15:32:08 -0700 Subject: [PATCH 069/257] Correctly shutdown on SIGTERM/SIGINT (fixing bad exception handling code). --- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 28 +++++++++++------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index ba69f092e..9ea6b6434 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -564,9 +564,10 @@ main = do hSetBuffering stdout NoBuffering - let onTermSig = throwTo mainTid UserInterrupt + let onKillSig = throwTo mainTid UserInterrupt - Sys.installHandler Sys.sigTERM (Sys.Catch onTermSig) Nothing + Sys.installHandler Sys.sigTERM (Sys.Catch onKillSig) Nothing + Sys.installHandler Sys.sigINT (Sys.Catch onKillSig) Nothing CLI.parseArgs >>= \case CLI.CmdRun ships -> runShips ships @@ -626,23 +627,20 @@ runShips = \case async (runShipRestarting waitForKillRequ r o) {- - This `waitAny` call never returns, so this runs until the main - thread is killed with an async exception. The one we expect is + Since `spin` never returns, this will run until the main + thread is killed with an async exception. The one we expect is `UserInterrupt` which will be raised on this thread upon SIGKILL or SIGTERM. - -} - res <- try (waitAny shipThreads) - {- - Send the kill signal to all of the ships, and then wait for all - of them to exit. + Once that happens, we write to `killSignal` which will cause + all ships to be shut down, and then we `wait` for them to finish + before returning. -} - let die = do atomically (putTMVar killSignal ()) - for_ shipThreads waitCatch - - case res of - Left UserInterrupt -> die - _ -> die + let spin = forever (threadDelay maxBound) + finally spin $ do + putStrLn "KING IS GOING DOWN" + atomically (putTMVar killSignal ()) + for_ shipThreads waitCatch -------------------------------------------------------------------------------- From f8460cec0a4c0481a15e29fe6e30e1c18b1d49cf Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 1 May 2020 20:59:06 -0700 Subject: [PATCH 070/257] vere: fix ames port in startup printfs --- pkg/urbit/vere/ames.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/ames.c index 1f449db07..ce6be2ee0 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/ames.c @@ -460,10 +460,10 @@ _ames_io_start(u3_ames* sam_u) } if ( c3y == u3_Host.ops_u.net ) { - u3l_log("ames: live on %d\n", por_s); + u3l_log("ames: live on %d\n", sam_u->por_s); } else { - u3l_log("ames: live on %d (localhost only)\n", por_s); + u3l_log("ames: live on %d (localhost only)\n", sam_u->por_s); } uv_udp_recv_start(&sam_u->wax_u, _ames_alloc, _ames_recv_cb); From 3dbb13ec3adb8152f20031598bca064582186c18 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 1 May 2020 21:04:16 -0700 Subject: [PATCH 071/257] serf: clean up auto reclaim/pack conditions, pack every 20k --- pkg/urbit/worker/serf.c | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 08c5c8e02..9a22b937e 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -364,6 +364,9 @@ u3_serf_post(u3_serf* sef_u) static u3_noun _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) { + c3_o rec_o = c3n; + c3_o pac_o = c3n; + // intercept |mass, observe |reset // { @@ -394,13 +397,13 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) // reclaim memory from persistent caches on |reset // if ( c3__vega == u3h(fec) ) { - sef_u->rec_o = c3y; + rec_o = c3y; } // pack memory on |pack // if ( c3__pack == u3h(fec) ) { - sef_u->pac_o = c3y; + pac_o = c3y; } riv = u3t(riv); @@ -431,13 +434,13 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) // XX set flag(s) in u3V so we don't repeat endlessly? // XX pack here too? // - sef_u->pac_o = c3y; - sef_u->rec_o = c3y; + pac_o = c3y; + rec_o = c3y; pri = 1; } else if ( (pre_w > hig_w) && !(pos_w > hig_w) ) { - sef_u->pac_o = c3y; - sef_u->rec_o = c3y; + pac_o = c3y; + rec_o = c3y; pri = 0; } // reclaim memory from persistent caches periodically @@ -446,13 +449,15 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) // - bytecode caches grow rapidly and can't be simply capped // - we don't make very effective use of our free lists // - else { - sef_u->rec_o = c3o(sef_u->rec_o, _(0 == (sef_u->dun_d % 1000ULL))); + else if ( 0 == (sef_u->dun_d % 1000ULL) ) { + rec_o = c3y; } - // pack every 50K events + // pack every 20K events // - sef_u->pac_o = c3o(sef_u->pac_o, _(0 == (sef_u->dun_d % 50000ULL))); + if ( 0 == (sef_u->dun_d % 20000ULL) ) { + pac_o = c3y; + } // notify daemon of memory pressure via "fake" effect // @@ -463,6 +468,9 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) } } + sef_u->rec_o = c3o(sef_u->rec_o, rec_o); + sef_u->pac_o = c3o(sef_u->pac_o, pac_o); + return vir; } From eec02ebaa334c7bd51255ea1648cf85fa9903ec6 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Sun, 3 May 2020 09:29:00 -0700 Subject: [PATCH 072/257] king: CLI parsing for ship-shared HTTP(S) server. --- pkg/hs/urbit-king/lib/Urbit/King/CLI.hs | 30 +++++++++++++- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 53 +++++++++++++----------- 2 files changed, 57 insertions(+), 26 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs index b7c394278..8a12c0146 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs @@ -15,6 +15,12 @@ import System.Environment (getProgName) -------------------------------------------------------------------------------- +data KingOpts = KingOpts + { koSharedHttpPort :: Maybe Word16 + , koSharedHttpsPort :: Maybe Word16 + } + deriving (Show) + data Opts = Opts { oQuiet :: Bool , oHashless :: Bool @@ -93,7 +99,7 @@ data Bug data Cmd = CmdNew New Opts - | CmdRun [(Run, Opts, Bool)] + | CmdRun KingOpts [(Run, Opts, Bool)] | CmdBug Bug | CmdCon FilePath deriving (Show) @@ -312,8 +318,28 @@ runOneShip = (,,) <$> fmap Run pierPath <*> opts <*> df where df = switch (short 'd' <> long "daemon" <> help "Daemon mode" <> hidden) +kingOpts :: Parser KingOpts +kingOpts = do + koSharedHttpPort <- + optional + $ option auto + $ metavar "PORT" + <> long "shared-http-port" + <> help "HTTP port" + <> hidden + + koSharedHttpsPort <- + optional + $ option auto + $ metavar "PORT" + <> long "shared-https-port" + <> help "HTTPS port" + <> hidden + + pure (KingOpts{..}) + runShip :: Parser Cmd -runShip = CmdRun <$> some runOneShip +runShip = CmdRun <$> kingOpts <*> some runOneShip valPill :: Parser Bug valPill = do diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 9ea6b6434..064d58a8c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -570,7 +570,7 @@ main = do Sys.installHandler Sys.sigINT (Sys.Catch onKillSig) Nothing CLI.parseArgs >>= \case - CLI.CmdRun ships -> runShips ships + CLI.CmdRun ko ships -> runShips ko ships CLI.CmdNew n o -> runApp $ newShip n o CLI.CmdBug (CLI.CollectAllFX pax) -> runApp $ collectAllFx pax CLI.CmdBug (CLI.EventBrowser pax) -> runApp $ startBrowser pax @@ -614,33 +614,38 @@ runShipRestarting waitForKillRequ r o = do putStrLn ("Ship terminated: " <> pier) -runShips :: [(CLI.Run, CLI.Opts, Bool)] -> IO () -runShips = \case - [] -> pure () - [(r, o, d)] -> runShip r o d - ships -> do - killSignal <- newEmptyTMVarIO +runShips :: CLI.KingOpts -> [(CLI.Run, CLI.Opts, Bool)] -> IO () +runShips CLI.KingOpts {..} = \case + [] -> pure () + [(r, o, d)] -> runShip r o d + ships | sharedHttp -> error "TODO Shared HTTP not yet implemented." + ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) + where sharedHttp = isJust koSharedHttpPort || isJust koSharedHttpsPort - let waitForKillRequ = readTMVar killSignal +runMultipleShips :: [(CLI.Run, CLI.Opts)] -> IO () +runMultipleShips ships = do + killSignal <- newEmptyTMVarIO - shipThreads <- for ships $ \(r, o, _) -> do - async (runShipRestarting waitForKillRequ r o) + let waitForKillRequ = readTMVar killSignal - {- - Since `spin` never returns, this will run until the main - thread is killed with an async exception. The one we expect is - `UserInterrupt` which will be raised on this thread upon SIGKILL - or SIGTERM. + shipThreads <- for ships $ \(r, o) -> do + async (runShipRestarting waitForKillRequ r o) - Once that happens, we write to `killSignal` which will cause - all ships to be shut down, and then we `wait` for them to finish - before returning. - -} - let spin = forever (threadDelay maxBound) - finally spin $ do - putStrLn "KING IS GOING DOWN" - atomically (putTMVar killSignal ()) - for_ shipThreads waitCatch + {- + Since `spin` never returns, this will run until the main + thread is killed with an async exception. The one we expect is + `UserInterrupt` which will be raised on this thread upon SIGKILL + or SIGTERM. + + Once that happens, we write to `killSignal` which will cause + all ships to be shut down, and then we `wait` for them to finish + before returning. + -} + let spin = forever (threadDelay maxBound) + finally spin $ do + putStrLn "KING IS GOING DOWN" + atomically (putTMVar killSignal ()) + for_ shipThreads waitCatch -------------------------------------------------------------------------------- From cb6d1c0f7f8b1c3b4631fd30f38d045222c6e7d8 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Tue, 5 May 2020 09:30:37 -0700 Subject: [PATCH 073/257] king: Started implementing multi-tenet HTTP. --- .../urbit-king/lib/Urbit/Vere/Http/Server.hs | 77 +++++++++++++++++++ sh/test | 2 +- 2 files changed, 78 insertions(+), 1 deletion(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs index 0da819e15..90511ef3c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs @@ -633,3 +633,80 @@ serv king plan isFake = -- when (i == fromIntegral king) $ do logDebug "respond" respond drv (fromIntegral req) ev + + +-- Multi-Tenet HTTP ------------------------------------------------------------ + +{- + # Very First Phase: Shared HTTP, no SSL. + + - Global configuration flag for shared HTTP port. + + - Shared server starts before ships. + + - Shared server is informed when ships go up and come down. + + - Shared server delivers requests to existing HTTP driver. + + - Existing HTTP driver can send responses to shared HTTP server. +-} + +type ShareRequ = (ServId, ReqId, WhichServer, Address, HttpRequest) +type ShareResp = (ServId, UD, UD, HttpEvent) + +data ShipAPI = ShipAPI + { sapiReq :: ShareRequ -> STM () + , sapiRes :: STM ShareResp + } + +data MultiServ = MultiServ + { msPort :: Maybe Word16 + , msShip :: TVar (Map Ship ShipAPI) + , msBoot :: TMVar (Ship, ShipAPI) + , msDead :: TMVar Ship + , msKill :: STM () + } + +data Hap = Deþ Ship + | Lif (Ship, ShipAPI) + | Res ShareResp + | Kil () + +multiServ :: MultiServ -> IO () +multiServ ms = do + case msPort ms of + Nothing -> doNothing ms + Just po -> doSomething ms po + +{- + If the port is set, we do things for real. We run an HTTP server, + sends requests to the appropriate ship, respond to requests when + responses are given, and shuts down when the king shuts down. +-} +doSomething :: MultiServ -> Word16 -> IO () +doSomething MultiServ{..} httpPort = do + error "TODO" + +{- + If the port is not set, we still run a thread for the shared server. It + doesn't run an HTTP server, it ignores all responses, and it shuts + down when the king shuts down. +-} +doNothing :: MultiServ -> IO () +doNothing MultiServ{..} = do + vShips :: TVar (Map Ship ShipAPI) <- newTVarIO mempty + + let onHapn :: STM Hap + onHapn = asum [ Lif <$> takeTMVar msBoot + , Deþ <$> takeTMVar msDead + , Res <$> (readTVar vShips >>= asum . fmap sapiRes . toList) + , Kil <$> msKill + ] + + let loop = join $ atomically $ onHapn >>= \case + Deþ s -> modifyTVar' vShips (deleteMap s) >> pure loop + Lif (s,api) -> modifyTVar' vShips (insertMap s api) >> pure loop + Res _ -> pure loop + Kil _ -> pure (pure ()) + + loop diff --git a/sh/test b/sh/test index dac77b5a8..39c64fa6f 100755 --- a/sh/test +++ b/sh/test @@ -2,7 +2,7 @@ set -e -stack test urbit-king --fast +(cd pkg/hs; stack test urbit-king --fast) pkg=$(nix-build nix/ops -A test --no-out-link "$@") From 47bf14f0f2e163ae4f774f86efa9610091f20327 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Tue, 5 May 2020 10:29:19 -0700 Subject: [PATCH 074/257] king: Further sketch of shared http. --- .../urbit-king/lib/Urbit/Vere/Http/Server.hs | 39 +++++++++++++++++-- 1 file changed, 35 insertions(+), 4 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs index 90511ef3c..002baa634 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs @@ -672,7 +672,7 @@ data Hap = Deþ Ship | Res ShareResp | Kil () -multiServ :: MultiServ -> IO () +multiServ :: HasLogFunc e => MultiServ -> RIO e () multiServ ms = do case msPort ms of Nothing -> doNothing ms @@ -683,16 +683,47 @@ multiServ ms = do sends requests to the appropriate ship, respond to requests when responses are given, and shuts down when the king shuts down. -} -doSomething :: MultiServ -> Word16 -> IO () +doSomething :: HasLogFunc e => MultiServ -> Word16 -> RIO e () doSomething MultiServ{..} httpPort = do - error "TODO" + logDebug "Starting HTTP server" + + let httpOpts = W.defaultSettings & W.setHost "*" + & W.setPort (fromIntegral httpPort) + + sId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32) + + vShips :: TVar (Map Ship ShipAPI) <- newTVarIO mempty + liv <- newTVarIO emptyLiveReqs + + env <- ask + + plan <- error "TODO" + + httpTid <- async $ io + $ W.runSettings httpOpts + $ app env sId liv plan Insecure + + let onHapn :: STM Hap + onHapn = asum [ Lif <$> takeTMVar msBoot + , Deþ <$> takeTMVar msDead + , Res <$> (readTVar vShips >>= asum . fmap sapiRes . toList) + , Kil <$> msKill + ] + + let loop = join $ atomically $ onHapn >>= \case + Deþ s -> modifyTVar' vShips (deleteMap s) >> pure loop + Lif (s,api) -> modifyTVar' vShips (insertMap s api) >> pure loop + Res _ -> error "TODO" + Kil _ -> pure (cancel httpTid) + + loop {- If the port is not set, we still run a thread for the shared server. It doesn't run an HTTP server, it ignores all responses, and it shuts down when the king shuts down. -} -doNothing :: MultiServ -> IO () +doNothing :: MultiServ -> RIO e () doNothing MultiServ{..} = do vShips :: TVar (Map Ship ShipAPI) <- newTVarIO mempty From 21dcddc65bdf524077c35fb824daa49cf31368b0 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Tue, 5 May 2020 12:57:05 -0700 Subject: [PATCH 075/257] king: Factored out UDP flow from Ames driver. --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 286 ++++++++----------- pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs | 241 ++++++++++++++++ 2 files changed, 360 insertions(+), 167 deletions(-) create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 9d8d09846..7f0b5a36f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -1,32 +1,30 @@ {-| - Ames IO Driver -- UDP + Ames IO Driver -} module Urbit.Vere.Ames (ames) where import Urbit.Prelude -import Control.Monad.Extra hiding (mapM_) -import Network.Socket hiding (recvFrom, sendTo) -import Network.Socket.ByteString -import Urbit.Arvo hiding (Fake) +import Network.Socket hiding (recvFrom, sendTo) +import Urbit.Arvo hiding (Fake) import Urbit.King.Config import Urbit.Vere.Pier.Types -import qualified Data.ByteString as BS -import qualified Data.Map as M -import qualified Urbit.Ob as Ob -import qualified Urbit.Time as Time +import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ) + +import qualified Data.Map as M +import qualified Urbit.Ob as Ob +import qualified Urbit.Time as Time + -- Types ----------------------------------------------------------------------- data AmesDrv = AmesDrv - { aTurfs :: TVar (Maybe [Turf]) - , aGalaxies :: IORef (M.Map Galaxy (Async (), TQueue ByteString)) - , aSocket :: TVar (Maybe Socket) - , aListener :: Async () - , aSendingQueue :: TQueue (SockAddr, ByteString) - , aSendingThread :: Async () + { aTurfs :: TVar (Maybe [Turf]) + , aGalaxies :: IORef (M.Map Galaxy (Async (), TQueue ByteString)) + , aUdpServ :: UdpServ + , aRecvTid :: Async () } data NetworkMode = Fake | Localhost | Real | NoNetwork @@ -36,45 +34,51 @@ data NetworkMode = Fake | Localhost | Real | NoNetwork -- Utils ----------------------------------------------------------------------- galaxyPort :: NetworkMode -> Galaxy -> PortNumber -galaxyPort Fake (Patp g) = fromIntegral g + 31337 +galaxyPort Fake (Patp g) = fromIntegral g + 31337 galaxyPort Localhost (Patp g) = fromIntegral g + 13337 -galaxyPort Real (Patp g) = fromIntegral g + 13337 +galaxyPort Real (Patp g) = fromIntegral g + 13337 galaxyPort NoNetwork _ = fromIntegral 0 listenPort :: NetworkMode -> Ship -> PortNumber listenPort m s | s < 256 = galaxyPort m (fromIntegral s) -listenPort m _ = 0 +listenPort m _ = 0 localhost :: HostAddress -localhost = tupleToHostAddress (127,0,0,1) +localhost = tupleToHostAddress (127, 0, 0, 1) inaddrAny :: HostAddress -inaddrAny = tupleToHostAddress (0,0,0,0) +inaddrAny = tupleToHostAddress (0, 0, 0, 0) + +modeAddress :: NetworkMode -> Maybe HostAddress +modeAddress = \case + Fake -> Just localhost + Localhost -> Just localhost + Real -> Just inaddrAny + NoNetwork -> Nothing okayFakeAddr :: AmesDest -> Bool okayFakeAddr = \case - EachYes _ -> True - EachNo (Jammed (AAIpv4 (Ipv4 a) _)) -> a == localhost - EachNo (Jammed (AAVoid v)) -> absurd v + EachYes _ -> True + EachNo (Jammed (AAIpv4 (Ipv4 a) _)) -> a == localhost + EachNo (Jammed (AAVoid v )) -> absurd v localhostSockAddr :: NetworkMode -> AmesDest -> SockAddr localhostSockAddr mode = \case - EachYes g -> SockAddrInet (galaxyPort mode g) localhost - EachNo (Jammed (AAIpv4 _ p)) -> SockAddrInet (fromIntegral p) localhost - EachNo (Jammed (AAVoid v)) -> absurd v + EachYes g -> SockAddrInet (galaxyPort mode g) localhost + EachNo (Jammed (AAIpv4 _ p)) -> SockAddrInet (fromIntegral p) localhost + EachNo (Jammed (AAVoid v )) -> absurd v bornEv :: KingId -> Ev -bornEv inst = - EvBlip $ BlipEvNewt $ NewtEvBorn (fromIntegral inst, ()) () +bornEv inst = EvBlip $ BlipEvNewt $ NewtEvBorn (fromIntegral inst, ()) () hearEv :: PortNumber -> HostAddress -> ByteString -> Ev hearEv p a bs = - EvBlip $ BlipEvAmes $ AmesEvHear () dest (MkBytes bs) - where - dest = EachNo $ Jammed $ AAIpv4 (Ipv4 a) (fromIntegral p) + EvBlip $ BlipEvAmes $ AmesEvHear () dest (MkBytes bs) + where + dest = EachNo $ Jammed $ AAIpv4 (Ipv4 a) (fromIntegral p) -_turfText :: Turf -> Text -_turfText = intercalate "." . reverse . fmap unCord . unTurf +turfText :: Turf -> Text +turfText = intercalate "." . reverse . fmap unCord . unTurf renderGalaxy :: Galaxy -> Text renderGalaxy = Ob.renderPatp . Ob.patp . fromIntegral . unPatp @@ -82,6 +86,31 @@ renderGalaxy = Ob.renderPatp . Ob.patp . fromIntegral . unPatp -------------------------------------------------------------------------------- +netMode :: HasNetworkConfig e => Bool -> RIO e NetworkMode +netMode True = pure Fake +netMode False = view (networkConfigL . ncNetMode . to cvt) + where + cvt :: NetMode -> NetworkMode + cvt = \case + NMNormal -> Real + NMLocalhost -> Localhost + NMNone -> NoNetwork + +udpPort :: Bool -> Ship -> HasNetworkConfig e => RIO e PortNumber +udpPort isFake who = do + mode <- netMode isFake + mPort <- view (networkConfigL . ncAmesPort) + pure $ maybe (listenPort mode who) fromIntegral mPort + +udpServ :: (HasLogFunc e, HasNetworkConfig e) => Bool -> Ship -> RIO e UdpServ +udpServ isFake who = do + mode <- netMode isFake + port <- udpPort isFake who + case modeAddress mode of + Nothing -> fakeUdpServ + Just host -> realUdpServ port host + + {-| inst -- Process instance number. who -- Which ship are we? @@ -105,145 +134,38 @@ ames inst who isFake enqueueEv stderr = runAmes :: RAcquire e (EffCb e NewtEf) runAmes = do - drv <- mkRAcquire start stop - pure (handleEffect drv) + mode <- rio (netMode isFake) + drv <- mkRAcquire start stop + pure (handleEffect drv mode) start :: RIO e AmesDrv start = do - aTurfs <- newTVarIO Nothing - aGalaxies <- newIORef mempty - aSocket <- newTVarIO Nothing - bindSock aSocket - aListener <- async (waitPacket aSocket) - aSendingQueue <- newTQueueIO - aSendingThread <- async (sendingThread aSendingQueue aSocket) - pure $ AmesDrv{..} + aTurfs <- newTVarIO Nothing + aGalaxies <- newIORef mempty + aUdpServ <- udpServ isFake who + aRecvTid <- queuePacketsThread aUdpServ + pure (AmesDrv{..}) - netMode :: RIO e NetworkMode - netMode = do - if isFake - then pure Fake - else view (networkConfigL . ncNetMode) >>= \case - NMNormal -> pure Real - NMLocalhost -> pure Localhost - NMNone -> pure NoNetwork + queuePacketsThread :: UdpServ -> RIO e (Async ()) + queuePacketsThread UdpServ{..} = async $ forever $ atomically $ do + (p, a, b) <- usRecv + enqueueEv (hearEv p a b) stop :: AmesDrv -> RIO e () stop AmesDrv{..} = do - readIORef aGalaxies >>= mapM_ (cancel . fst) + io (usKill aUdpServ) + cancel aRecvTid + readIORef aGalaxies >>= mapM_ (cancel . fst) - cancel aSendingThread - cancel aListener - socket <- atomically $ readTVar aSocket - io $ maybeM (pure ()) (close') (pure socket) - - bindSock :: TVar (Maybe Socket) -> RIO e () - bindSock socketVar = getBindAddr >>= doBindSocket - where - getBindAddr = netMode >>= \case - Fake -> pure $ Just localhost - Localhost -> pure $ Just localhost - Real -> pure $ Just inaddrAny - NoNetwork -> pure Nothing - - doBindSocket :: Maybe HostAddress -> RIO e () - doBindSocket Nothing = atomically $ writeTVar socketVar Nothing - doBindSocket (Just bindAddr) = do - mode <- netMode - mPort <- view (networkConfigL . ncAmesPort) - let ourPort = maybe (listenPort mode who) fromIntegral mPort - s <- io $ socket AF_INET Datagram defaultProtocol - - logTrace $ displayShow ("(ames) Binding to port ", ourPort) - let addr = SockAddrInet ourPort bindAddr - () <- io $ bind s addr - - atomically $ writeTVar socketVar (Just s) - - waitPacket :: TVar (Maybe Socket) -> RIO e () - waitPacket socketVar = do - (atomically $ readTVar socketVar) >>= \case - Nothing -> pure () - Just s -> do - res <- io $ tryIOError $ recvFrom s 4096 - case res of - Left exn -> do - -- When we have a socket exception, we need to rebuild the - -- socket. - logTrace $ displayShow ("(ames) Socket exception. Rebinding.") - bindSock socketVar - Right (bs, addr) -> do - logTrace $ displayShow ("(ames) Received packet from ", addr) - case addr of - SockAddrInet p a -> atomically (enqueueEv $ hearEv p a bs) - _ -> pure () - - waitPacket socketVar - - - handleEffect :: AmesDrv -> NewtEf -> RIO e () - handleEffect drv@AmesDrv{..} = \case + handleEffect :: AmesDrv -> NetworkMode -> NewtEf -> RIO e () + handleEffect drv@AmesDrv{..} mode = \case NewtEfTurf (_id, ()) turfs -> do - atomically $ writeTVar aTurfs (Just turfs) + atomically $ writeTVar aTurfs (Just turfs) NewtEfSend (_id, ()) dest (MkBytes bs) -> do - atomically (readTVar aTurfs) >>= \case - Nothing -> pure () - Just turfs -> do - mode <- netMode - (sendPacket drv mode dest bs) - - sendPacket :: AmesDrv -> NetworkMode -> AmesDest -> ByteString -> RIO e () - - sendPacket AmesDrv{..} NoNetwork dest bs = pure () - - sendPacket AmesDrv{..} Fake dest bs = do - when (okayFakeAddr dest) $ atomically $ - writeTQueue aSendingQueue ((localhostSockAddr Fake dest), bs) - - -- In localhost only mode, regardless of the actual destination, send it to - -- localhost. - sendPacket AmesDrv{..} Localhost dest bs = atomically $ - writeTQueue aSendingQueue ((localhostSockAddr Localhost dest), bs) - - sendPacket AmesDrv{..} Real (EachYes galaxy) bs = do - galaxies <- readIORef aGalaxies - queue <- case M.lookup galaxy galaxies of - Just (_, queue) -> pure queue - Nothing -> do - inQueue <- newTQueueIO - thread <- async $ galaxyResolver galaxy aTurfs inQueue aSendingQueue - modifyIORef (aGalaxies) (M.insert galaxy (thread, inQueue)) - pure inQueue - - atomically $ writeTQueue queue bs - - sendPacket AmesDrv{..} Real (EachNo (Jammed (AAIpv4 a p))) bs = do - let addr = SockAddrInet (fromIntegral p) (unIpv4 a) - atomically $ writeTQueue aSendingQueue (addr, bs) - - sendPacket AmesDrv{..} Real (EachNo (Jammed (AAVoid v))) bs = do - pure (absurd v) - - -- An outbound queue of messages. We can only write to a socket from one - -- thread, so coalesce those writes here. - sendingThread :: TQueue (SockAddr, ByteString) - -> TVar (Maybe Socket) - -> RIO e () - sendingThread queue socketVar = forever $ - do - (dest, bs) <- atomically $ readTQueue queue - logTrace $ displayShow ("(ames) Sending packet to ", dest) - sendAll bs dest - where - sendAll bs dest = do - mybSocket <- atomically $ readTVar socketVar - case mybSocket of - Nothing -> pure () - Just socket -> do - bytesSent <- io $ sendTo socket bs dest - when (bytesSent /= BS.length bs) $ do - sendAll (drop bytesSent bs) dest + atomically (readTVar aTurfs) >>= \case + Nothing -> pure () + Just turfs -> sendPacket drv mode dest bs -- Asynchronous thread per galaxy which handles domain resolution, and can -- block its own queue of ByteStrings to send. @@ -253,9 +175,9 @@ ames inst who isFake enqueueEv stderr = -- -- TODO: Figure out how the real haskell time library works. galaxyResolver :: Galaxy -> TVar (Maybe [Turf]) -> TQueue ByteString - -> TQueue (SockAddr, ByteString) + -> (SockAddr -> ByteString -> RIO e ()) -> RIO e () - galaxyResolver galaxy turfVar incoming outgoing = + galaxyResolver galaxy turfVar incoming queueSendToGalaxy = loop Nothing Time.unixEpoch where loop :: Maybe SockAddr -> Time.Wen -> RIO e () @@ -314,8 +236,38 @@ ames inst who isFake enqueueEv stderr = name <- case stripPrefix "~" nameWithSig of Nothing -> error "Urbit.ob didn't produce string with ~" Just x -> pure (unpack x) - pure $ name ++ "." ++ (unpack $ _turfText turf) + pure $ name ++ "." ++ (unpack $ turfText turf) - queueSendToGalaxy :: SockAddr -> ByteString -> RIO e () - queueSendToGalaxy inet packet = do - atomically $ writeTQueue outgoing (inet, packet) + sendPacket :: AmesDrv -> NetworkMode -> AmesDest -> ByteString -> RIO e () + sendPacket AmesDrv{..} mode dest bs = do + let go adr byt = io (usSend aUdpServ adr byt) + + case (mode, dest) of + (NoNetwork, _) -> do + pure () + + (Fake, _) | okayFakeAddr dest -> do + go (localhostSockAddr Fake dest) bs + + (Fake, _) | otherwise -> do + pure () + + (Localhost, _) -> do + go (localhostSockAddr Localhost dest) bs + + (Real, EachYes galaxy) -> do + galaxies <- readIORef aGalaxies + queue <- case M.lookup galaxy galaxies of + Just (_, queue) -> pure queue + Nothing -> do + inQueue <- newTQueueIO + thread <- async (galaxyResolver galaxy aTurfs inQueue go) + modifyIORef (aGalaxies) (M.insert galaxy (thread, inQueue)) + pure inQueue + atomically $ writeTQueue queue bs + + (Real, EachNo (Jammed (AAIpv4 a p))) -> do + go (SockAddrInet (fromIntegral p) (unIpv4 a)) bs + + (Real, EachNo (Jammed (AAVoid v))) -> do + absurd v diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs new file mode 100644 index 000000000..c22df009f --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs @@ -0,0 +1,241 @@ +{- | + Raw UDP Server used by Ames driver. + + 1. Opens a UDP socket and makes sure that it stays open. + + - If can't open the port, wait and try again repeatedly. + - If there is an error reading or writting from the open socket, + close it and open another. + + 2. Receives packets from the socket. + + - When packets come in from the socket, they go into a bounded queue. + - If the queue is full, the packet is dropped. + - If the socket is closed, wait and try again repeatedly. + - `usRecv` gets the first packet from the queue. + + 3. Sends packets to the socket. + + - Packets sent to `usSend` enter a bounded queue. + - If that queue is full, the packet is dropped. + - Packets are taken off the queue one at a time. + - If the socket is closed (or broken), the packet is dropped. + + 4. Runs until `usKill` is run, then all threads are killed and the + socket is closed. +-} + +module Urbit.Vere.Ames.UDP + ( UdpServ(..) + , fakeUdpServ + , realUdpServ + ) +where + +import Urbit.Prelude + +import Network.Socket hiding (recvFrom, sendTo) + +import Control.Monad.STM (retry) +import Network.Socket.ByteString (recvFrom, sendTo) + + +-- Types ----------------------------------------------------------------------- + +data UdpServ = UdpServ + { usSend :: SockAddr -> ByteString -> IO () + , usRecv :: STM (PortNumber, HostAddress, ByteString) + , usKill :: IO () + } + + +-- Utils ----------------------------------------------------------------------- + +{- | + Writes to queue and returns `True` unless the queue is full, then do + nothing and return `False`. +-} +tryWriteTBQueue :: TBQueue x -> x -> STM Bool +tryWriteTBQueue q x = do + isFullTBQueue q >>= \case + True -> pure False + False -> writeTBQueue q x $> True + +{- | + Open a UDP socket and bind it to a port +-} +doBind :: PortNumber -> HostAddress -> IO (Either IOError Socket) +doBind por hos = tryIOError $ do + sok <- io $ socket AF_INET Datagram defaultProtocol + () <- io $ bind sok (SockAddrInet por hos) + pure sok + +{- | + Open a UDP socket and bind it to a port. + + If this fails, wait 250ms and repeat forever. +-} +forceBind :: HasLogFunc e => PortNumber -> HostAddress -> RIO e Socket +forceBind por hos = go + where + go = do + logTrace (display ("AMES: UDP: Opening socket on port " <> tshow por)) + io (doBind por hos) >>= \case + Right sk -> do + logTrace (display ("AMES: UDP: Opened socket on port " <> tshow por)) + pure sk + Left err -> do + logTrace (display ("AMES: UDP: " <> tshow err)) + logTrace ("AMES: UDP: Failed to open UDP socket. Waiting") + threadDelay 250_000 + go + +{- | + Attempt to send a packet to a socket. + + If it fails, return `False`. Otherwise, return `True`. +-} +sendPacket :: HasLogFunc e => ByteString -> SockAddr -> Socket -> RIO e Bool +sendPacket fullBytes adr sok = do + logTrace ("AMES: UDP: Sending packet") + res <- io $ tryIOError $ go fullBytes + case res of + Left err -> do + logError $ display ("AMES: UDP: " <> tshow err) + logError "AMES: UDP: Failed to send packet" + pure False + Right () -> do + logError "AMES: UDP: Packet sent" + pure True + where + go byt = do + sent <- sendTo sok byt adr + when (sent /= length byt) $ do + go (drop sent byt) + +{- | + Attempt to receive a packet from a socket. + + - If an exception is throw, return `Left exn`. + - If it wasn't an IPv4 packet, return `Right Nothing`. + - Otherwise, return `Right (Just packet)`. +-} +recvPacket + :: HasLogFunc e + => Socket + -> RIO e (Either IOError (Maybe (ByteString, PortNumber, HostAddress))) +recvPacket sok = do + io (tryIOError $ recvFrom sok 4096) <&> \case + Left exn -> Left exn + Right (b, SockAddrInet p a) -> Right (Just (b, p, a)) + Right (_, _ ) -> Right Nothing + + +-- Fake Server for No-Networking Mode ------------------------------------------ + +{- | + Fake UDP API for no-networking configurations. +-} +fakeUdpServ :: HasLogFunc e => RIO e UdpServ +fakeUdpServ = do + logTrace "AMES: UDP: \"Starting\" fake UDP server." + pure UdpServ { .. } + where + usSend = \_ _ -> pure () + usRecv = retry + usKill = pure () + + +-- Real Server ----------------------------------------------------------------- + +{- | + Real UDP server. See module-level docs. +-} +realUdpServ + :: forall e . HasLogFunc e => PortNumber -> HostAddress -> RIO e UdpServ +realUdpServ por hos = do + logTrace "AMES: UDP: Starting real UDP server." + + env <- ask + + vSock <- newTVarIO Nothing + vFail <- newEmptyTMVarIO + qSend <- newTBQueueIO 100 -- TODO Tuning + qRecv <- newTBQueueIO 100 -- TODO Tuning + + {- + If reading or writing to a socket fails, unbind it and tell the + socket-open thread to close it and open another. + + This is careful about edge-cases. In any of these cases, do nothing. + + - If vSock isn't set to the socket we used, do nothing. + - If vFail is already set (another thread signaled failure already). + -} + let signalBrokenSocket :: Socket -> RIO e () + signalBrokenSocket sock = do + logTrace "AMES: UDP: Socket broken. Requesting new socket" + atomically $ do + mSock <- readTVar vSock + mFail <- tryReadTMVar vFail + when (mSock == Just sock && mFail == Nothing) $ do + putTMVar vFail sock + writeTVar vSock Nothing + + enqueueRecvPacket :: PortNumber -> HostAddress -> ByteString -> RIO e () + enqueueRecvPacket p a b = do + did <- atomically (tryWriteTBQueue qRecv (p, a, b)) + when (did == False) $ do + logWarn "AMES: UDP: Dropping inbound packet because queue is full." + + enqueueSendPacket :: SockAddr -> ByteString -> RIO e () + enqueueSendPacket a b = do + did <- atomically (tryWriteTBQueue qSend (a, b)) + when (did == False) $ do + logWarn "AMES: UDP: Dropping outbound packet because queue is full." + + tOpen <- async $ forever $ do + sk <- forceBind por hos + atomically (writeTVar vSock (Just sk)) + broken <- atomically (takeTMVar vFail) + logTrace "AMES: UDP: Closing broken socket." + io (close broken) + + tSend <- async $ forever $ join $ atomically $ do + (adr, byt) <- readTBQueue qSend + readTVar vSock <&> \case + Nothing -> pure () + Just sk -> do + okay <- sendPacket byt adr sk + unless okay (signalBrokenSocket sk) + + tRecv <- async $ forever $ do + atomically (readTVar vSock) >>= \case + Nothing -> threadDelay 100_000 + Just sk -> do + recvPacket sk >>= \case + Left exn -> do + logError "AMES: UDP: Failed to receive packet" + signalBrokenSocket sk + Right Nothing -> do + logError "AMES: UDP: Dropping non-ipv4 packet" + pure () + Right (Just (b, p, a)) -> do + logTrace "AMES: UDP: Received packet." + enqueueRecvPacket p a b + + let shutdown = do + logTrace "AMES: UDP: Shutting down. (killing threads)" + cancel tOpen + cancel tSend + cancel tRecv + logTrace "AMES: UDP: Shutting down. (closing socket)" + io $ join $ atomically $ do + res <- readTVar vSock <&> maybe (pure ()) close + writeTVar vSock Nothing + pure res + + pure $ UdpServ { usSend = \a b -> runRIO env (enqueueSendPacket a b) + , usRecv = readTBQueue qRecv + , usKill = runRIO env shutdown + } From 36ca94931746072010bf289ad54d0106acd79839 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Thu, 7 May 2020 14:15:32 -0700 Subject: [PATCH 076/257] king: Factored out DNS flow from Ames driver. --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 226 +++++-------------- pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs | 217 ++++++++++++++++++ 2 files changed, 278 insertions(+), 165 deletions(-) create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 7f0b5a36f..dcccb18f6 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -11,34 +11,23 @@ import Urbit.Arvo hiding (Fake) import Urbit.King.Config import Urbit.Vere.Pier.Types +import Urbit.Vere.Ames.DNS (NetworkMode(..), ResolvServ(..)) +import Urbit.Vere.Ames.DNS (galaxyPort, resolvServ) import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ) -import qualified Data.Map as M -import qualified Urbit.Ob as Ob -import qualified Urbit.Time as Time - -- Types ----------------------------------------------------------------------- data AmesDrv = AmesDrv { aTurfs :: TVar (Maybe [Turf]) - , aGalaxies :: IORef (M.Map Galaxy (Async (), TQueue ByteString)) , aUdpServ :: UdpServ + , aResolvr :: ResolvServ , aRecvTid :: Async () } -data NetworkMode = Fake | Localhost | Real | NoNetwork - deriving (Eq, Ord, Show) - -- Utils ----------------------------------------------------------------------- -galaxyPort :: NetworkMode -> Galaxy -> PortNumber -galaxyPort Fake (Patp g) = fromIntegral g + 31337 -galaxyPort Localhost (Patp g) = fromIntegral g + 13337 -galaxyPort Real (Patp g) = fromIntegral g + 13337 -galaxyPort NoNetwork _ = fromIntegral 0 - listenPort :: NetworkMode -> Ship -> PortNumber listenPort m s | s < 256 = galaxyPort m (fromIntegral s) listenPort m _ = 0 @@ -56,14 +45,14 @@ modeAddress = \case Real -> Just inaddrAny NoNetwork -> Nothing -okayFakeAddr :: AmesDest -> Bool -okayFakeAddr = \case +okFakeAddr :: AmesDest -> Bool +okFakeAddr = \case EachYes _ -> True EachNo (Jammed (AAIpv4 (Ipv4 a) _)) -> a == localhost EachNo (Jammed (AAVoid v )) -> absurd v -localhostSockAddr :: NetworkMode -> AmesDest -> SockAddr -localhostSockAddr mode = \case +localAddr :: NetworkMode -> AmesDest -> SockAddr +localAddr mode = \case EachYes g -> SockAddrInet (galaxyPort mode g) localhost EachNo (Jammed (AAIpv4 _ p)) -> SockAddrInet (fromIntegral p) localhost EachNo (Jammed (AAVoid v )) -> absurd v @@ -77,12 +66,6 @@ hearEv p a bs = where dest = EachNo $ Jammed $ AAIpv4 (Ipv4 a) (fromIntegral p) -turfText :: Turf -> Text -turfText = intercalate "." . reverse . fmap unCord . unTurf - -renderGalaxy :: Galaxy -> Text -renderGalaxy = Ob.renderPatp . Ob.patp . fromIntegral . unPatp - -------------------------------------------------------------------------------- @@ -110,7 +93,6 @@ udpServ isFake who = do Nothing -> fakeUdpServ Just host -> realUdpServ port host - {-| inst -- Process instance number. who -- Which ship are we? @@ -122,152 +104,66 @@ udpServ isFake who = do TODO verify that the KingIds match on effects. -} -ames :: forall e. (HasLogFunc e, HasNetworkConfig e) - => KingId -> Ship -> Bool -> QueueEv - -> (Text -> RIO e ()) - -> ([Ev], RAcquire e (EffCb e NewtEf)) -ames inst who isFake enqueueEv stderr = - (initialEvents, runAmes) - where - initialEvents :: [Ev] - initialEvents = [bornEv inst] +ames + :: forall e + . (HasLogFunc e, HasNetworkConfig e) + => KingId + -> Ship + -> Bool + -> QueueEv + -> (Text -> RIO e ()) + -> ([Ev], RAcquire e (EffCb e NewtEf)) +ames inst who isFake enqueueEv stderr = (initialEvents, runAmes) + where + initialEvents :: [Ev] + initialEvents = [bornEv inst] - runAmes :: RAcquire e (EffCb e NewtEf) - runAmes = do - mode <- rio (netMode isFake) - drv <- mkRAcquire start stop - pure (handleEffect drv mode) + runAmes :: RAcquire e (EffCb e NewtEf) + runAmes = do + mode <- rio (netMode isFake) + drv <- mkRAcquire start stop + pure (handleEffect drv mode) - start :: RIO e AmesDrv - start = do - aTurfs <- newTVarIO Nothing - aGalaxies <- newIORef mempty - aUdpServ <- udpServ isFake who - aRecvTid <- queuePacketsThread aUdpServ - pure (AmesDrv{..}) + start :: RIO e AmesDrv + start = do + aTurfs <- newTVarIO Nothing + aUdpServ <- udpServ isFake who + aRecvTid <- queuePacketsThread aUdpServ + aResolvr <- resolvServ aTurfs (usSend aUdpServ) stderr + pure (AmesDrv { .. }) - queuePacketsThread :: UdpServ -> RIO e (Async ()) - queuePacketsThread UdpServ{..} = async $ forever $ atomically $ do - (p, a, b) <- usRecv - enqueueEv (hearEv p a b) + queuePacketsThread :: UdpServ -> RIO e (Async ()) + queuePacketsThread UdpServ {..} = async $ forever $ atomically $ do + (p, a, b) <- usRecv + enqueueEv (hearEv p a b) - stop :: AmesDrv -> RIO e () - stop AmesDrv{..} = do - io (usKill aUdpServ) - cancel aRecvTid - readIORef aGalaxies >>= mapM_ (cancel . fst) + stop :: AmesDrv -> RIO e () + stop AmesDrv {..} = io $ do + usKill aUdpServ + rsKill aResolvr + cancel aRecvTid - handleEffect :: AmesDrv -> NetworkMode -> NewtEf -> RIO e () - handleEffect drv@AmesDrv{..} mode = \case - NewtEfTurf (_id, ()) turfs -> do - atomically $ writeTVar aTurfs (Just turfs) + handleEffect :: AmesDrv -> NetworkMode -> NewtEf -> RIO e () + handleEffect drv@AmesDrv {..} mode = \case + NewtEfTurf (_id, ()) turfs -> do + atomically $ writeTVar aTurfs (Just turfs) - NewtEfSend (_id, ()) dest (MkBytes bs) -> do - atomically (readTVar aTurfs) >>= \case - Nothing -> pure () - Just turfs -> sendPacket drv mode dest bs + NewtEfSend (_id, ()) dest (MkBytes bs) -> do + atomically (readTVar aTurfs) >>= \case + Nothing -> pure () + Just turfs -> sendPacket drv mode dest bs - -- Asynchronous thread per galaxy which handles domain resolution, and can - -- block its own queue of ByteStrings to send. - -- - -- Maybe perform the resolution asynchronously, injecting into the resolver - -- queue as a message. - -- - -- TODO: Figure out how the real haskell time library works. - galaxyResolver :: Galaxy -> TVar (Maybe [Turf]) -> TQueue ByteString - -> (SockAddr -> ByteString -> RIO e ()) - -> RIO e () - galaxyResolver galaxy turfVar incoming queueSendToGalaxy = - loop Nothing Time.unixEpoch - where - loop :: Maybe SockAddr -> Time.Wen -> RIO e () - loop lastGalaxyIP lastLookupTime = do - packet <- atomically $ readTQueue incoming + sendPacket :: AmesDrv -> NetworkMode -> AmesDest -> ByteString -> RIO e () + sendPacket AmesDrv {..} mode dest byt = do + let to adr = io (usSend aUdpServ adr byt) - checkIP lastGalaxyIP lastLookupTime >>= \case - (Nothing, t) -> do - -- We've failed to lookup the IP. Drop the outbound packet - -- because we have no IP for our galaxy, including possible - -- previous IPs. - logDebug $ displayShow - ("(ames) Dropping packet; no ip for galaxy ", galaxy) - loop Nothing t - (Just ip, t) -> do - queueSendToGalaxy ip packet - loop (Just ip) t + case (mode, dest) of + (NoNetwork, _ ) -> pure () + (Fake , _ ) -> when (okFakeAddr dest) $ to (localAddr Fake dest) + (Localhost, _ ) -> to (localAddr Localhost dest) + (Real , ra) -> ra & \case + EachYes gala -> io (rsSend aResolvr gala byt) + EachNo addr -> to (ipv4Addr addr) - checkIP :: Maybe SockAddr -> Time.Wen - -> RIO e (Maybe SockAddr, Time.Wen) - checkIP lastIP lastLookupTime = do - current <- io $ Time.now - if (Time.gap current lastLookupTime ^. Time.secs) < 300 - then pure (lastIP, lastLookupTime) - else do - toCheck <- fromMaybe [] <$> atomically (readTVar turfVar) - mybIp <- resolveFirstIP lastIP toCheck - timeAfterResolution <- io $ Time.now - pure (mybIp, timeAfterResolution) - - resolveFirstIP :: Maybe SockAddr -> [Turf] -> RIO e (Maybe SockAddr) - resolveFirstIP prevIP [] = do - stderr $ "ames: czar at " ++ renderGalaxy galaxy ++ ": not found" - logDebug $ displayShow - ("(ames) Failed to lookup IP for ", galaxy) - pure prevIP - - resolveFirstIP prevIP (x:xs) = do - hostname <- buildDNS galaxy x - let portstr = show $ galaxyPort Real galaxy - listIPs <- io $ getAddrInfo Nothing (Just hostname) (Just portstr) - case listIPs of - [] -> resolveFirstIP prevIP xs - (y:ys) -> do - let sockaddr = Just $ addrAddress y - when (sockaddr /= prevIP) $ - stderr $ "ames: czar " ++ renderGalaxy galaxy ++ ": ip " ++ - (tshow $ addrAddress y) - logDebug $ displayShow - ("(ames) Looked up ", hostname, portstr, y) - pure sockaddr - - buildDNS :: Galaxy -> Turf -> RIO e String - buildDNS (Patp g) turf = do - let nameWithSig = Ob.renderPatp $ Ob.patp $ fromIntegral g - name <- case stripPrefix "~" nameWithSig of - Nothing -> error "Urbit.ob didn't produce string with ~" - Just x -> pure (unpack x) - pure $ name ++ "." ++ (unpack $ turfText turf) - - sendPacket :: AmesDrv -> NetworkMode -> AmesDest -> ByteString -> RIO e () - sendPacket AmesDrv{..} mode dest bs = do - let go adr byt = io (usSend aUdpServ adr byt) - - case (mode, dest) of - (NoNetwork, _) -> do - pure () - - (Fake, _) | okayFakeAddr dest -> do - go (localhostSockAddr Fake dest) bs - - (Fake, _) | otherwise -> do - pure () - - (Localhost, _) -> do - go (localhostSockAddr Localhost dest) bs - - (Real, EachYes galaxy) -> do - galaxies <- readIORef aGalaxies - queue <- case M.lookup galaxy galaxies of - Just (_, queue) -> pure queue - Nothing -> do - inQueue <- newTQueueIO - thread <- async (galaxyResolver galaxy aTurfs inQueue go) - modifyIORef (aGalaxies) (M.insert galaxy (thread, inQueue)) - pure inQueue - atomically $ writeTQueue queue bs - - (Real, EachNo (Jammed (AAIpv4 a p))) -> do - go (SockAddrInet (fromIntegral p) (unIpv4 a)) bs - - (Real, EachNo (Jammed (AAVoid v))) -> do - absurd v + ipv4Addr (Jammed (AAVoid v )) = absurd v + ipv4Addr (Jammed (AAIpv4 a p)) = SockAddrInet (fromIntegral p) (unIpv4 a) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs new file mode 100644 index 000000000..f6e5bd763 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs @@ -0,0 +1,217 @@ +{-| + Handles sending packets to galaxies. We need to get their IP addresses + from DNS, which is more complicated. + +-- Asynchronous thread per galaxy which handles domain resolution, and can +-- block its own queue of ByteStrings to send. +-- +-- Maybe perform the resolution asynchronously, injecting into the resolver +-- queue as a message. +-- +-- TODO: Figure out how the real haskell time library works. + +-- We've failed to lookup the IP. Drop the outbound packet +-- because we have no IP for our galaxy, including possible +-- previous IPs. + +{- +- Sending Packets to Galaxies. + - Each galaxy has it's own DNS resolution thread. + - Initially, no threads are started. + - To send a message to a galaxy, + - Check to see if it already has a resolution thread. + - If it does, pass the packet to that thread. + - If it doesn't, start a new thread and give it the packet. +- Galaxy resolution threads work as follows: + - First, they are given: + - They know which galaxy they are responsible for. + - They have access to the turfs TVar (shared state with Ames driver). + - They can be given packets (to be send to their galaxy). + - They must be given a way to send UDP packets. + - Next, we loop forever + - In the loop we track: + - the last-known IP address. + - the time when we last looked up the IP address. + - We wait to be given a packet. + - We get the IP address. + - If we looked up the IP address in the last 5 minute, use the + cached IP address. + - Just use the one from last time. + - Otherwise, + - Do a DNS lookup. + - Go through the turf list one item at a time. + - Try each one. + - If it resolves to one-or-more IP addresses, + - Use the first one. + - If it resolves to zero IP addresses, move on to the next turf. + - If none of the turfs can be used to resolve the IP address, + then we don't know where the galaxy is. + - Drop the packet. +-} +-} + +module Urbit.Vere.Ames.DNS + ( NetworkMode(..) + , ResolvServ(..) + , resolvServ + , galaxyPort + , renderGalaxy + ) +where + +import Urbit.Prelude + +import Network.Socket hiding (recvFrom, sendTo) +import Urbit.Arvo hiding (Fake) + +import qualified Data.Map as M +import qualified Urbit.Ob as Ob +import qualified Urbit.Time as Time + + +-- Types ----------------------------------------------------------------------- + +data NetworkMode = Fake | Localhost | Real | NoNetwork + deriving (Eq, Ord, Show) + +data ResolvServ = ResolvServ + { rsSend :: Galaxy -> ByteString -> IO () + , rsKill :: IO () + } + + +-- Utils ----------------------------------------------------------------------- + +galaxyPort :: NetworkMode -> Galaxy -> PortNumber +galaxyPort Fake (Patp g) = fromIntegral g + 31337 +galaxyPort Localhost (Patp g) = fromIntegral g + 13337 +galaxyPort Real (Patp g) = fromIntegral g + 13337 +galaxyPort NoNetwork _ = fromIntegral 0 + +turfText :: Turf -> Text +turfText = intercalate "." . reverse . fmap unCord . unTurf + +renderGalaxy :: Galaxy -> Text +renderGalaxy = Ob.renderPatp . Ob.patp . fromIntegral . unPatp + +galaxyHostname :: Galaxy -> Turf -> Text +galaxyHostname g t = galaName g ++ "." ++ turfText t + where + stripSig :: Text -> Text + stripSig inp = fromMaybe inp (stripPrefix "~" inp) + + galaName :: Galaxy -> Text + galaName = stripSig . renderGalaxy + +resolv :: Galaxy -> [Turf] -> IO (Maybe (Turf, Text, PortNumber, SockAddr)) +resolv gal = go + where + go = \case + [] -> pure Nothing + turf : turfs -> do + let host = galaxyHostname gal turf + port = galaxyPort Real gal + getAddrInfo Nothing (Just (unpack host)) (Just (show port)) >>= \case + [] -> go turfs + ip : _ -> pure $ Just (turf, host, port, addrAddress ip) + +doResolv + :: HasLogFunc e + => Galaxy + -> (Time.Wen, Maybe SockAddr) + -> [Turf] + -> (Text -> RIO e ()) + -> RIO e (Maybe SockAddr, Time.Wen) +doResolv gal (prevWen, prevIP) turfs stderr = do + current <- io $ Time.now + if (Time.gap current prevWen ^. Time.secs) < 300 + then pure (prevIP, prevWen) + else do + tim <- io (Time.now) + io (resolv gal turfs) >>= \case + Nothing -> do + stderr $ "ames: czar at " ++ galStr ++ ": not found" + logDebug $ displayShow ("(ames) Failed to lookup IP for ", gal) + pure (prevIP, tim) + Just (turf, host, port, addr) -> do + when (Just addr /= prevIP) (printCzar addr) + logDebug $ displayShow ("(ames) Looked up ", host, port, turf, addr) + pure (Just addr, tim) + where + galStr = renderGalaxy gal + printCzar addr = stderr $ "ames: czar " ++ galStr ++ ": ip " ++ tshow addr + + +resolvWorker + :: forall e + . HasLogFunc e + => Galaxy + -> TVar (Maybe [Turf]) + -> TVar (Time.Wen, Maybe SockAddr) + -> STM ByteString + -> (SockAddr -> ByteString -> IO ()) + -> (Text -> RIO e ()) + -> RIO e (Async ()) +resolvWorker gal vTurfs vLast waitMsg send stderr = async (forever go) + where + logDrop = + logDebug $ displayShow ("(ames) Dropping packet; no ip for galaxy ", gal) + + go :: RIO e () + go = do + (packt, turfs, (lastTime, lastAddr)) <- atomically + ((,,) <$> waitMsg <*> readTVar vTurfs <*> readTVar vLast) + + (newAddr, newTime) <- doResolv gal + (lastTime, lastAddr) + (fromMaybe [] turfs) + stderr + + maybe logDrop (\ip -> io (send ip packt)) newAddr + + atomically $ writeTVar vLast (newTime, newAddr) + + +resolvServ + :: HasLogFunc e + => TVar (Maybe [Turf]) + -> (SockAddr -> ByteString -> IO ()) + -> (Text -> RIO e ()) + -> RIO e ResolvServ +resolvServ vTurfs send stderr = do + vGala <- newTVarIO (mempty :: Map Galaxy (Async (), TQueue ByteString)) + vDead <- newTVarIO False + envir <- ask + + let spawnWorker :: Galaxy -> IO (Async (), TQueue ByteString) + spawnWorker gal = runRIO envir $ do + que <- newTQueueIO + las <- newTVarIO (Time.unixEpoch, Nothing) + tid <- resolvWorker gal vTurfs las (readTQueue que) send stderr + pure (tid, que) + + let getWorker :: Galaxy -> IO (Async (), TQueue ByteString) + getWorker gal = do + (fmap (lookup gal) $ atomically $ readTVar vGala) >>= \case + Just (tid, que) -> do + pure (tid, que) + Nothing -> do + (tid, que) <- spawnWorker gal + atomically $ modifyTVar' vGala (M.insert gal (tid, que)) + pure (tid, que) + + let doSend :: Galaxy -> ByteString -> IO () + doSend gal byt = do + dead <- atomically (readTVar vDead) + unless dead $ do + (_, que) <- getWorker gal + atomically (writeTQueue que byt) + + let doKill :: IO () + doKill = do + galas <- atomically $ do + writeTVar vDead True + readTVar vGala + for_ galas (cancel . fst) + + pure (ResolvServ doSend doKill) From 5ba113b4999ce6c5f44231d58047cdf38cb18fb0 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Thu, 7 May 2020 16:35:49 -0700 Subject: [PATCH 077/257] Begin factoring out Raw HTTP logic from Eyre. --- .../urbit-king/lib/Urbit/Vere/Http/Server.hs | 320 +++++------------- .../lib/Urbit/Vere/Http/Server/WAIApp.hs | 216 ++++++++++++ 2 files changed, 295 insertions(+), 241 deletions(-) create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server/WAIApp.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs index 002baa634..eedf78b7d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs @@ -22,27 +22,30 @@ "hosed"; -} -module Urbit.Vere.Http.Server where +module Urbit.Vere.Http.Server + ( serv + , multiServ + , ShipAPI(..) + ) +where -import Data.Conduit -import Urbit.Arvo hiding (ServerId, reqBody, reqUrl, secure) -import Urbit.King.Config -import Urbit.Noun import Urbit.Prelude hiding (Builder) + +import Urbit.Arvo hiding (ServerId, reqUrl, secure) +import Urbit.King.Config +import Urbit.Vere.Http.Server.WAIApp hiding (ReqId) import Urbit.Vere.Pier.Types -import Data.Binary.Builder (Builder, fromByteString) -import Data.Bits (shiftL, (.|.)) -import Data.PEM (pemParseBS, pemWriteBS) -import Network.Socket (SockAddr(..)) -import System.Directory (doesFileExist, removeFile) -import System.Random (randomIO) -import Urbit.Vere.Http (convertHeaders, unconvertHeaders) +import Data.PEM (pemParseBS, pemWriteBS) +import Network.Socket (SockAddr(..)) +import RIO.Prelude (decodeUtf8Lenient) +import System.Directory (doesFileExist, removeFile) +import System.Random (randomIO) +import Urbit.Vere.Http (convertHeaders, unconvertHeaders) import qualified Network.HTTP.Types as H import qualified Network.Socket as Net import qualified Network.Wai as W -import qualified Network.Wai.Conduit as W import qualified Network.Wai.Handler.Warp as W import qualified Network.Wai.Handler.WarpTLS as W @@ -52,32 +55,6 @@ import qualified Network.Wai.Handler.WarpTLS as W type HasShipEnv e = (HasLogFunc e, HasNetworkConfig e, HasPierConfig e) type ReqId = UD -type SeqId = UD -- Unused, always 1 - -{-| - The sequence of actions on a given request *should* be: - - [%head .] [%bloc .]* %done - - But we will actually accept anything, and mostly do the right - thing. There are two situations where we ignore ignore the data from - some actions. - - - If you send something *after* a %done action, it will be ignored. - - If you send a %done before a %head, we will produce "444 No - Response" with an empty response body. --} -data RespAction - = RAHead ResponseHeader File - | RAFull ResponseHeader File - | RABloc File - | RADone - deriving (Eq, Ord, Show) - -data LiveReqs = LiveReqs - { nextReqId :: ReqId - , activeReqs :: Map ReqId (TQueue RespAction) - } data Ports = Ports { pHttps :: Maybe Port @@ -86,7 +63,7 @@ data Ports = Ports } deriving (Eq, Ord, Show) -newtype Drv = Drv { unDrv :: MVar (Maybe Serv) } +newtype Drv = Drv { _unDrv :: MVar (Maybe Serv) } data Serv = Serv { sServId :: ServId @@ -103,17 +80,6 @@ data Serv = Serv } --- RespAction -- Reorganized HttpEvent for Cleaner Processing ------------------ - -reorgHttpEvent :: HttpEvent -> [RespAction] -reorgHttpEvent = \case - Start head mBlk True -> [RAFull head (fromMaybe "" mBlk)] - Start head mBlk False -> [RAHead head (fromMaybe "" mBlk)] - Cancel () -> [RADone] - Continue mBlk isDone -> toList (RABloc <$> mBlk) - <> if isDone then [RADone] else [] - - -- Generic Service Stop/Restart -- Using an MVar for Atomicity ----------------- {-| @@ -163,35 +129,6 @@ stopService vServ kkill = do pure (Nothing, res) --- Live Requests Table -- All Requests Still Waiting for Responses ------------- - -emptyLiveReqs :: LiveReqs -emptyLiveReqs = LiveReqs 1 mempty - -respondToLiveReq :: TVar LiveReqs -> ReqId -> RespAction -> STM () -respondToLiveReq var req ev = do - mVar <- lookup req . activeReqs <$> readTVar var - case mVar of - Nothing -> pure () - Just tv -> writeTQueue tv ev - -rmLiveReq :: TVar LiveReqs -> ReqId -> STM () -rmLiveReq var reqId = do - liv <- readTVar var - writeTVar var (liv { activeReqs = deleteMap reqId (activeReqs liv) }) - -newLiveReq :: TVar LiveReqs -> STM (ReqId, TQueue RespAction) -newLiveReq var = do - liv <- readTVar var - tmv <- newTQueue - - let (nex, act) = (nextReqId liv, activeReqs liv) - - writeTVar var (LiveReqs (nex+1) (insertMap nex tmv act)) - - pure (nex, tmv) - - -- Ports File ------------------------------------------------------------------ removePortsFile :: FilePath -> RIO e () @@ -212,54 +149,6 @@ writePortsFile :: FilePath -> Ports -> RIO e () writePortsFile f = writeFile f . encodeUtf8 . portsFileText --- Random Helpers -------------------------------------------------------------- - -cordBytes :: Cord -> ByteString -cordBytes = encodeUtf8 . unCord - -wainBytes :: Wain -> ByteString -wainBytes = encodeUtf8 . unWain - -pass :: Monad m => m () -pass = pure () - -whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () -whenJust Nothing act = pure () -whenJust (Just a) act = act a - -cookMeth :: W.Request -> Maybe Method -cookMeth = H.parseMethod . W.requestMethod >>> \case - Left _ -> Nothing - Right m -> Just m - -reqIdCord :: ReqId -> Cord -reqIdCord = Cord . tshow - -reqBody :: W.Request -> RIO e (Maybe File) -reqBody req = do - bodyLbs <- io $ W.strictRequestBody req - pure $ if length bodyLbs == 0 - then Nothing - else Just $ File $ Octs (toStrict bodyLbs) - -reqAddr :: W.Request -> Address -reqAddr = W.remoteHost >>> \case - SockAddrInet _ a -> AIpv4 (Ipv4 a) - SockAddrInet6 _ _ a _ -> AIpv6 (mkIpv6 a) - _ -> error "invalid sock addr" - -mkIpv6 :: (Word32, Word32, Word32, Word32) -> Ipv6 -mkIpv6 (p, q, r, s) = Ipv6 (pBits .|. qBits .|. rBits .|. sBits) - where - pBits = shiftL (fromIntegral p) 0 - qBits = shiftL (fromIntegral q) 32 - rBits = shiftL (fromIntegral r) 64 - sBits = shiftL (fromIntegral s) 96 - -reqUrl :: W.Request -> Cord -reqUrl r = Cord $ decodeUtf8 $ W.rawPathInfo r <> W.rawQueryString r - - -- Utilities for Constructing Events ------------------------------------------- data WhichServer = Secure | Insecure | Loopback @@ -291,106 +180,6 @@ reqEv sId reqId which addr req = $ HttpServerReq (which == Secure) addr req --- Http Server Flows ----------------------------------------------------------- - -data Resp - = RHead ResponseHeader [File] - | RFull ResponseHeader [File] - | RNone - deriving (Show) - -{-| - This accepts all action orderings so that there are no edge-cases - to be handled: - - - If %bloc before %head, collect it and wait for %head. - - If %done before %head, ignore all chunks and produce Nothing. - - TODO Be strict about this instead. Ignore invalid request streams. --} -getResp :: TQueue RespAction -> RIO e Resp -getResp tmv = go [] - where - go çunks = atomically (readTQueue tmv) >>= \case - RAHead head ç -> pure $ RHead head $ reverse (ç : çunks) - RAFull head ç -> pure $ RFull head $ reverse (ç : çunks) - RABloc ç -> go (ç : çunks) - RADone -> pure RNone - -{-| - - Immediatly yield all of the initial chunks - - Yield the data from %bloc action. - - Close the stream when we hit a %done action. --} -streamBlocks :: HasLogFunc e - => e -> [File] -> TQueue RespAction - -> ConduitT () (Flush Builder) IO () -streamBlocks env init tmv = - for_ init yieldÇunk >> go - where - yieldFlush = \x -> yield (Chunk x) >> yield Flush - logDupHead = runRIO env (logError "Multiple %head actions on one request") - - yieldÇunk = \case - "" -> runRIO env (logTrace "sending empty chunk") - c -> do runRIO env (logTrace (display ("sending chunk " <> tshow c))) - (yieldFlush . fromByteString . unOcts . unFile) c - - go = atomically (readTQueue tmv) >>= \case - RAHead head c -> logDupHead >> yieldÇunk c >> go - RAFull head c -> logDupHead >> yieldÇunk c >> go - RABloc c -> yieldÇunk c >> go - RADone -> pure () - -sendResponse :: HasLogFunc e - => (W.Response -> IO W.ResponseReceived) - -> TQueue RespAction - -> RIO e W.ResponseReceived -sendResponse cb tmv = do - env <- ask - getResp tmv >>= \case - RNone -> io $ cb $ W.responseLBS (H.mkStatus 444 "No Response") [] - $ "" - RFull h f -> io $ cb $ W.responseLBS (hdrStatus h) (hdrHeaders h) - $ fromStrict $ concat $ unOcts . unFile <$> f - RHead h i -> io $ cb $ W.responseSource (hdrStatus h) (hdrHeaders h) - $ streamBlocks env i tmv - where - hdrHeaders :: ResponseHeader -> [H.Header] - hdrHeaders = unconvertHeaders . headers - - hdrStatus :: ResponseHeader -> H.Status - hdrStatus = toEnum . fromIntegral . statusCode - -liveReq :: TVar LiveReqs -> RAcquire e (ReqId, TQueue RespAction) -liveReq vLiv = mkRAcquire ins del - where - ins = atomically (newLiveReq vLiv) - del = atomically . rmLiveReq vLiv . fst - -app :: HasLogFunc e - => e -> ServId -> TVar LiveReqs -> (Ev -> STM ()) -> WhichServer - -> W.Application -app env sId liv plan which req respond = - runRIO env $ - rwith (liveReq liv) $ \(reqId, respVar) -> do - body <- reqBody req - meth <- maybe (error "bad method") pure (cookMeth req) - - let addr = reqAddr req - hdrs = convertHeaders $ W.requestHeaders req - evReq = HttpRequest meth (reqUrl req) hdrs body - - atomically $ plan (reqEv sId reqId which addr evReq) - - try (sendResponse respond respVar) >>= \case - Right rr -> pure rr - Left exn -> do - io $ atomically $ plan (cancelEv sId reqId) - logError $ display ("Exception during request" <> tshow exn) - throwIO (exn :: SomeException) - - -- Top-Level Driver Interface -------------------------------------------------- data CantOpenPort = CantOpenPort W.Port @@ -503,6 +292,34 @@ httpServerPorts fak = do pure (PortsToTry { .. }) +eyreApp + :: HasLogFunc e + => e + -> ServId + -> TVar LiveReqs + -> (Ev -> STM ()) + -> WhichServer + -> W.Application +eyreApp env sId vLive plan which = + app env vLive onReq onCancel + where + bodFile "" = Nothing + bodFile bs = Just $ File $ Octs bs + + onReq :: Word64 -> ReqInfo -> STM () + onReq reqId ReqInfo{..} = do + let evBod = bodFile riBod + evHdr = convertHeaders riHdr + evUrl = Cord (decodeUtf8Lenient riUrl) + evReq = HttpRequest riMet evUrl evHdr evBod + reqUd = fromIntegral reqId + event = reqEv sId reqUd which riAdr evReq + + plan event + + onCancel :: Word64 -> STM () + onCancel reqId = plan (cancelEv sId (fromIntegral reqId)) + parseCerts :: ByteString -> Maybe (ByteString, [ByteString]) parseCerts bs = do pems <- pemParseBS bs & either (const Nothing) Just @@ -510,6 +327,36 @@ parseCerts bs = do [] -> Nothing p:ps -> pure (pemWriteBS p, pemWriteBS <$> ps) +fByt :: File -> ByteString +fByt = unOcts . unFile + +reorgHttpEvent :: HttpEvent -> [RespAct] +reorgHttpEvent = \case + Start h b True -> [RAFull (hSta h) (hHdr h) (fByt $ fromMaybe "" b)] + Start h b False -> [RAHead (hSta h) (hHdr h) (fByt $ fromMaybe "" b)] + Cancel () -> [RADone] + Continue b done -> toList (RABloc . fByt <$> b) + <> if done then [RADone] else [] + where + hHdr :: ResponseHeader -> [H.Header] + hHdr = unconvertHeaders . headers + + hSta :: ResponseHeader -> H.Status + hSta = toEnum . fromIntegral . statusCode + + +respond :: HasLogFunc e + => Drv -> Word64 -> HttpEvent -> RIO e () +respond (Drv v) reqId ev = do + readMVar v >>= \case + Nothing -> logError "Got a response to a request that does not exist." + Just sv -> do logDebug $ displayShow ev + for_ (reorgHttpEvent ev) $ + atomically . routeRespAct (sLiveReqs sv) reqId + +wainBytes :: Wain -> ByteString +wainBytes = encodeUtf8 . unWain + startServ :: (HasPierConfig e, HasLogFunc e, HasNetworkConfig e) => Bool -> HttpServerConf -> (Ev -> STM ()) -> RIO e Serv @@ -546,18 +393,18 @@ startServ isFake conf plan = do logDebug "Starting loopback server" loopTid <- async $ io $ W.runSettingsSocket loopOpts loopSock - $ app env sId liv plan Loopback + $ eyreApp env sId liv plan Loopback logDebug "Starting HTTP server" httpTid <- async $ io $ W.runSettingsSocket httpOpts httpSock - $ app env sId liv plan Insecure + $ eyreApp env sId liv plan Insecure logDebug "Starting HTTPS server" httpsTid <- for tls $ \tlsOpts -> async $ io $ W.runTLSSocket tlsOpts httpsOpts httpsSock - $ app env sId liv plan Secure + $ eyreApp env sId liv plan Secure pierPath <- view pierPathL let por = Ports (tls <&> const httpsPort) httpPort loopPort @@ -588,15 +435,6 @@ killServ Serv{..} = do kill :: HasLogFunc e => Drv -> RIO e () kill (Drv v) = stopService v killServ >>= fromEither -respond :: HasLogFunc e - => Drv -> ReqId -> HttpEvent -> RIO e () -respond (Drv v) reqId ev = do - readMVar v >>= \case - Nothing -> logWarn "Got a response to a request that does not exist." - Just sv -> do logDebug $ displayShow $ reorgHttpEvent ev - for_ (reorgHttpEvent ev) $ - atomically . respondToLiveReq (sLiveReqs sv) reqId - serv :: ∀e. HasShipEnv e => KingId -> QueueEv -> Bool -> ([Ev], RAcquire e (EffCb e HttpServerEf)) @@ -701,7 +539,7 @@ doSomething MultiServ{..} httpPort = do httpTid <- async $ io $ W.runSettings httpOpts - $ app env sId liv plan Insecure + $ eyreApp env sId liv plan Insecure let onHapn :: STM Hap onHapn = asum [ Lif <$> takeTMVar msBoot diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server/WAIApp.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server/WAIApp.hs new file mode 100644 index 000000000..6a4a470a9 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server/WAIApp.hs @@ -0,0 +1,216 @@ +{-| + WAI Application for `eyre` driver. + + # Request Lifecycles + + - Requests come in, are given an identifier and are passed to a callback. + + - When requests timeout, the identifier is passed to anothing callback. + + - The server pulls response actions, and passes them to the associated + request. +-} + +module Urbit.Vere.Http.Server.WAIApp + ( ReqId + , RespAct(..) + , RespApi(..) + , LiveReqs(..) + , ReqInfo(..) + , emptyLiveReqs + , routeRespAct + , rmLiveReq + , newLiveReq + , app + ) +where + +import Urbit.Prelude hiding (Builder) + +import Data.Binary.Builder (Builder, fromByteString) +import Data.Bits (shiftL, (.|.)) +import Data.Conduit (ConduitT, Flush(Chunk, Flush), yield) +import Network.Socket (SockAddr(..)) +import Urbit.Arvo (Address(..), Ipv4(..), Ipv6(..), Method) + +import qualified Network.HTTP.Types as H +import qualified Network.Wai as W +import qualified Network.Wai.Conduit as W + + +-- Types ----------------------------------------------------------------------- + +type ReqId = Word64 + +data RespAct + = RAFull H.Status [H.Header] ByteString + | RAHead H.Status [H.Header] ByteString + | RABloc ByteString + | RADone + deriving (Eq, Ord, Show) + +data RespApi = RespApi + { raAct :: RespAct -> STM Bool + , raKil :: STM () + } + +data LiveReqs = LiveReqs + { nextReqId :: ReqId + , activeReqs :: Map ReqId RespApi + } + +data ReqInfo = ReqInfo + { riAdr :: Address + , riMet :: H.StdMethod + , riUrl :: ByteString + , riHdr :: [H.Header] + , riBod :: ByteString + } + + +-- Live Requests Table -- All Requests Still Waiting for Responses ------------- + +emptyLiveReqs :: LiveReqs +emptyLiveReqs = LiveReqs 1 mempty + +routeRespAct :: TVar LiveReqs -> ReqId -> RespAct -> STM Bool +routeRespAct vLiv reqId act = + (lookup reqId . activeReqs <$> readTVar vLiv) >>= \case + Nothing -> pure False + Just tv -> raAct tv act + +rmLiveReq :: TVar LiveReqs -> ReqId -> STM () +rmLiveReq var reqId = modifyTVar' var + $ \liv -> liv { activeReqs = deleteMap reqId (activeReqs liv) } + +newLiveReq :: TVar LiveReqs -> STM (ReqId, STM RespAct) +newLiveReq var = do + liv <- readTVar var + tmv <- newTQueue + kil <- newEmptyTMVar + + let waitAct = (<|>) (readTMVar kil $> RADone) (readTQueue tmv) + (nex, act) = (nextReqId liv, activeReqs liv) + respApi = RespApi + { raKil = putTMVar kil () + , raAct = \act -> tryReadTMVar kil >>= \case + Nothing -> writeTQueue tmv act $> True + Just () -> pure False + } + + + writeTVar var (LiveReqs (nex + 1) (insertMap nex respApi act)) + + pure (nex, waitAct) + + +-- Random Helpers -------------------------------------------------------------- + +cookMeth :: W.Request -> Maybe Method +cookMeth = H.parseMethod . W.requestMethod >>> \case + Left _ -> Nothing + Right m -> Just m + +reqAddr :: W.Request -> Address +reqAddr = W.remoteHost >>> \case + SockAddrInet _ a -> AIpv4 (Ipv4 a) + SockAddrInet6 _ _ a _ -> AIpv6 (mkIpv6 a) + _ -> error "invalid sock addr" + +mkIpv6 :: (Word32, Word32, Word32, Word32) -> Ipv6 +mkIpv6 (p, q, r, s) = Ipv6 (pBits .|. qBits .|. rBits .|. sBits) + where + pBits = shiftL (fromIntegral p) 0 + qBits = shiftL (fromIntegral q) 32 + rBits = shiftL (fromIntegral r) 64 + sBits = shiftL (fromIntegral s) 96 + +reqUrl :: W.Request -> ByteString +reqUrl r = W.rawPathInfo r <> W.rawQueryString r + + +-- Responses ------------------------------------------------------------------- + +noHeader :: HasLogFunc e => RIO e a +noHeader = do + logError "Response block with no response header." + error "Bad HttpEvent: Response block with no response header." + +emptyChunk :: HasLogFunc e => RIO e a +emptyChunk = do + logError "Bad response action: empty chunk" + error "Bad response action: empty chunk" + +dupHead :: HasLogFunc e => RIO e a +dupHead = do + logError "Multiple %head actions on one request" + error "Bad HttpEvent: Multiple header actions per on one request." + +{-| + - Immediately yield all of the initial chunks + - Yield the data from %bloc action. + - Close the stream when we hit a %done action. +-} +streamBlocks + :: HasLogFunc e + => e + -> ByteString + -> STM RespAct + -> ConduitT () (Flush Builder) IO () +streamBlocks env init getAct = send init >> loop + where + loop = atomically getAct >>= \case + RAHead _ _ _ -> runRIO env dupHead + RAFull _ _ _ -> runRIO env dupHead + RADone -> pure () + RABloc c -> send c >> loop + + send "" = runRIO env emptyChunk + send c = do + runRIO env (logTrace (display ("sending chunk " <> tshow c))) + yield $ Chunk $ fromByteString c + yield Flush + +sendResponse + :: HasLogFunc e + => (W.Response -> IO W.ResponseReceived) + -> STM RespAct + -> RIO e W.ResponseReceived +sendResponse cb waitAct = do + env <- ask + atomically waitAct >>= \case + RADone -> io $ cb $ W.responseLBS (H.mkStatus 444 "No Response") [] "" + RAFull s h b -> io $ cb $ W.responseLBS s h $ fromStrict b + RAHead s h b -> io $ cb $ W.responseSource s h $ streamBlocks env b waitAct + RABloc _ -> noHeader + +liveReq :: TVar LiveReqs -> RAcquire e (ReqId, STM RespAct) +liveReq vLiv = mkRAcquire ins del + where + ins = atomically (newLiveReq vLiv) + del = atomically . rmLiveReq vLiv . fst + +app + :: HasLogFunc e + => e + -> TVar LiveReqs + -> (ReqId -> ReqInfo -> STM ()) + -> (ReqId -> STM ()) + -> W.Application +app env liv inform cancel req respond = + runRIO env $ rwith (liveReq liv) $ \(reqId, respApi) -> do + bod <- io (toStrict <$> W.strictRequestBody req) + met <- maybe (error "bad method") pure (cookMeth req) + + let adr = reqAddr req + hdr = W.requestHeaders req + url = reqUrl req + + atomically $ inform reqId $ ReqInfo adr met url hdr bod + + try (sendResponse respond respApi) >>= \case + Right rr -> pure rr + Left exn -> do + atomically (cancel reqId) + logError $ display ("Exception during request" <> tshow exn) + throwIO (exn :: SomeException) From 4b6c2c6ce044bcd2d64a5f715738113358649c8e Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Fri, 8 May 2020 11:29:18 -0700 Subject: [PATCH 078/257] king: Renamed %eyre modules. --- .../lib/Urbit/Vere/{Http/Server.hs => Eyre.hs} | 12 ++++++------ .../Vere/{Http/Server/WAIApp.hs => Eyre/Wai.hs} | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 4 ++-- 3 files changed, 9 insertions(+), 9 deletions(-) rename pkg/hs/urbit-king/lib/Urbit/Vere/{Http/Server.hs => Eyre.hs} (98%) rename pkg/hs/urbit-king/lib/Urbit/Vere/{Http/Server/WAIApp.hs => Eyre/Wai.hs} (99%) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs similarity index 98% rename from pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs rename to pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index eedf78b7d..15baa2deb 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -22,8 +22,8 @@ "hosed"; -} -module Urbit.Vere.Http.Server - ( serv +module Urbit.Vere.Eyre + ( eyre , multiServ , ShipAPI(..) ) @@ -31,9 +31,9 @@ where import Urbit.Prelude hiding (Builder) -import Urbit.Arvo hiding (ServerId, reqUrl, secure) +import Urbit.Arvo hiding (ServerId, reqUrl, secure) import Urbit.King.Config -import Urbit.Vere.Http.Server.WAIApp hiding (ReqId) +import Urbit.Vere.Eyre.Wai hiding (ReqId) import Urbit.Vere.Pier.Types import Data.PEM (pemParseBS, pemWriteBS) @@ -435,10 +435,10 @@ killServ Serv{..} = do kill :: HasLogFunc e => Drv -> RIO e () kill (Drv v) = stopService v killServ >>= fromEither -serv :: ∀e. HasShipEnv e +eyre :: ∀e. HasShipEnv e => KingId -> QueueEv -> Bool -> ([Ev], RAcquire e (EffCb e HttpServerEf)) -serv king plan isFake = +eyre king plan isFake = (initialEvents, runHttpServer) where initialEvents :: [Ev] diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server/WAIApp.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs similarity index 99% rename from pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server/WAIApp.hs rename to pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs index 6a4a470a9..7eabdcad8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server/WAIApp.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs @@ -11,7 +11,7 @@ request. -} -module Urbit.Vere.Http.Server.WAIApp +module Urbit.Vere.Eyre.Wai ( ReqId , RespAct(..) , RespApi(..) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 2b0174e62..52f956426 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -23,8 +23,8 @@ import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) +import Urbit.Vere.Eyre (eyre) import Urbit.Vere.Http.Client (client) -import Urbit.Vere.Http.Server (serv) import Urbit.Vere.Log (EventLog) import Urbit.Vere.Serf (Serf, SerfState(..), doJob, sStderr) @@ -294,7 +294,7 @@ drivers inst who isFake plan shutdownSTM termSys stderr = where (behnBorn, runBehn) = behn inst plan (amesBorn, runAmes) = ames inst who isFake plan stderr - (httpBorn, runHttp) = serv inst plan isFake + (httpBorn, runHttp) = eyre inst plan isFake (clayBorn, runClay) = clay inst plan (irisBorn, runIris) = client inst plan (termBorn, runTerm) = Term.term termSys shutdownSTM inst plan From 37855fd704cbe03ef66fd0ff13f3a214ef86ea13 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Fri, 8 May 2020 14:27:53 -0700 Subject: [PATCH 079/257] king: Factor out HTTP server lifecycle from Eyre + impl multi-tenet HTTP. --- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs | 277 ++++++++++++++++++ pkg/hs/urbit-king/package.yaml | 1 + 2 files changed, 278 insertions(+) create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs new file mode 100644 index 000000000..97509a505 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -0,0 +1,277 @@ +{-| + Runs a single HTTP (or HTTPS) server for the eyre driver. + + A server is given: + + - A port, or a range or ports. + - Opens a socket on one of those ports. + - If this fails, try again repeatedly. + - Once a socket is opened, runs an HTTP server on the specified port. + - Once the server is up, calls a callback with the port that was opened. + - Once we have chosen a port, we commit to that port (ignoring the + original range). + - If the socket ever goes down, keep trying to reopen that port forever. + - When the server is shutdown, make sure the socket is closed. + + TODO How to detect socket closed during server run? +-} + +{-# OPTIONS_GHC -Wno-deprecations #-} + +module Urbit.Vere.Eyre.Serv + ( TlsConfig(..) + , MultiTlsConfig + , ReqApi(..) + , ServType(..) + , ServPort(..) + , ServHost(..) + , ServConf(..) + , configCreds + , serv + ) +where + +import Urbit.Prelude hiding (Builder) + +import Data.Default (def) +import Data.List.NonEmpty (NonEmpty((:|))) +import Network.TLS (Credential, Credentials(..), ServerHooks(..)) +import Network.TLS (credentialLoadX509ChainFromMemory) +import RIO.Prelude (decodeUtf8Lenient) + +import qualified Data.Char as C +import qualified Network.Socket as Net +import qualified Network.Wai as W +import qualified Network.Wai.Handler.Warp as W +import qualified Network.Wai.Handler.WarpTLS as W +import qualified Urbit.Ob as Ob +import qualified Urbit.Vere.Eyre.Wai as E + + +-- Internal Types -------------------------------------------------------------- + +data TlsConfig = TlsConfig + { tcPrKey :: ByteString + , tcCerti :: ByteString + , tcChain :: [ByteString] + } + +type MultiTlsConfig = TVar (Map Ship Credential) + +data ReqApi a = ReqApi + { rcReq :: a -> E.ReqId -> E.ReqInfo -> STM () + , rcKil :: E.ReqId -> STM () + } + +data ServType + = STHttp (ReqApi ()) + | STHttps TlsConfig (ReqApi ()) + | STMultiHttp (ReqApi Ship) + | STMultiHttps MultiTlsConfig (ReqApi Ship) + +data ServPort + = SPAnyPort + | SPChoices (NonEmpty W.Port) + +data ServHost + = SHLocalhost + | SHAnyHostOk + +data ServConf = ServConf + { scType :: ServType + , scHost :: ServHost + , scPort :: ServPort + , scRedi :: Maybe W.Port + , scOpnd :: W.Port -> STM () + , scDeth :: STM () + } + + +-- Opening Sockets ------------------------------------------------------------- + +getBindAddr :: String -> W.Port -> IO Net.SockAddr +getBindAddr hos por = + Net.getAddrInfo Nothing (Just hos) (Just (show por)) >>= \case + [] -> error "this should never happen." + x : _ -> pure (Net.addrAddress x) + +bindListenPort :: String -> W.Port -> Net.Socket -> IO Net.PortNumber +bindListenPort hos por sok = do + Net.bind sok =<< getBindAddr hos por + Net.listen sok 1 + Net.socketPort sok + +tcpSocket :: IO (Either IOError Net.Socket) +tcpSocket = + tryIOError (Net.socket Net.AF_INET Net.Stream Net.defaultProtocol) + +tryOpen :: String -> W.Port -> IO (Either IOError (W.Port, Net.Socket)) +tryOpen hos por = + tcpSocket >>= \case + Left exn -> pure (Left exn) + Right sok -> tryIOError (bindListenPort hos por sok) >>= \case + Left exn -> Net.close sok $> Left exn + Right por -> pure (Right (fromIntegral por, sok)) + +openFreePort :: String -> IO (Either IOError (W.Port, Net.Socket)) +openFreePort hos = do + tcpSocket >>= \case + Left exn -> pure (Left exn) + Right sok -> tryIOError (doBind sok) >>= \case + Left exn -> Net.close sok $> Left exn + Right ps -> pure (Right ps) + where + doBind sok = do + adr <- Net.inet_addr hos + Net.bind sok (Net.SockAddrInet Net.defaultPort adr) + Net.listen sok 1 + port <- Net.socketPort sok + pure (fromIntegral port, sok) + +retry :: HasLogFunc e => RIO e (Either IOError a) -> RIO e a +retry act = act >>= \case + Right res -> pure res + Left exn -> do + logError (displayShow ("EYRE", "Failed to open ports.", exn)) + logError (displayShow ("EYRE", "Waiting 250ms then trying again.")) + threadDelay 250_000 + retry act + +tryOpenChoices + :: HasLogFunc e + => String + -> NonEmpty W.Port + -> RIO e (Either IOError (W.Port, Net.Socket)) +tryOpenChoices hos = go + where + go (p :| ps) = do + logTrace (displayShow ("EYRE", "Trying to open port.", p)) + io (tryOpen hos p) >>= \case + Left err -> do + logError (displayShow ("EYRE", "Failed to open port.", p)) + case ps of + [] -> pure (Left err) + q : qs -> go (q :| qs) + Right (p, s) -> do + pure (Right (p, s)) + +tryOpenAny + :: HasLogFunc e => String -> RIO e (Either IOError (W.Port, Net.Socket)) +tryOpenAny hos = do + logTrace (displayShow ("EYRE", "Asking the OS for any free port.")) + io (openFreePort hos) >>= \case + Left exn -> pure (Left exn) + Right (p,s) -> do + pure (Right (p,s)) + +forceOpenSocket + :: forall e + . HasLogFunc e + => ServHost + -> ServPort + -> RAcquire e (W.Port, Net.Socket) +forceOpenSocket hos por = mkRAcquire opn kil + where + kil = io . Net.close . snd + + opn = do + (p, s) <- retry $ case por of + SPAnyPort -> tryOpenAny bind + SPChoices ps -> tryOpenChoices bind ps + rio $ logTrace $ displayShow ("EYRE", "Opened port.", p) + pure (p, s) + + bind = case hos of + SHLocalhost -> "127.0.0.1" + SHAnyHostOk -> "0.0.0.0" + + +-- Starting WAI ---------------------------------------------------------------- + +hostShip :: Maybe ByteString -> IO Ship +hostShip Nothing = error "Request must contain HOST header." +hostShip (Just bs) = byteShip (hedLabel bs) & \case + Left err -> error ("Bad host prefix. Must be a ship name: " <> unpack err) + Right sp -> pure sp + where + byteShip = fmap (fromIntegral . Ob.fromPatp) . bytePatp + bytePatp = Ob.parsePatp . decodeUtf8Lenient + hedLabel = fst . break (== fromIntegral (C.ord '.')) + +onSniHdr :: TVar (Map Ship Credential) -> Maybe String -> IO Credentials +onSniHdr mtls mHos = do + ship <- hostShip (encodeUtf8 . pack <$> mHos) + tabl <- atomically (readTVar mtls) + tcfg <- lookup ship tabl & maybe (notRunning ship) pure + pure (Credentials [tcfg]) + where + notRunning ship = error ("Ship not running: ~" <> show ship) + +startServer + :: HasLogFunc e + => ServType + -> ServHost + -> W.Port + -> Net.Socket + -> Maybe W.Port + -> RIO e () +startServer typ hos por sok red = do + envir <- ask + vLive <- newTVarIO E.emptyLiveReqs + + let host = case hos of + SHLocalhost -> "127.0.0.1" + SHAnyHostOk -> "*" + + let opts = + W.defaultSettings + & W.setHost host + & W.setPort (fromIntegral por) + & W.setTimeout (5 * 60) + + let runAppl = E.app envir vLive + reqShip = hostShip . W.requestHeaderHost + + case typ of + STHttp api -> do + let app = runAppl (rcReq api ()) (rcKil api) + io (W.runSettingsSocket opts sok app) + + STHttps TlsConfig {..} api -> do + let tls = W.tlsSettingsChainMemory tcCerti tcChain tcPrKey + let app = runAppl (rcReq api ()) (rcKil api) + io (W.runTLSSocket tls opts sok app) + + STMultiHttp api -> do + let app req resp = do + ship <- reqShip req + runAppl (rcReq api ship) (rcKil api) req resp + io (W.runSettingsSocket opts sok app) + + STMultiHttps mtls api -> do + let sni = def { onServerNameIndication = onSniHdr mtls } + let tls = W.defaultTlsSettings { W.tlsServerHooks = sni } + let app = \req resp -> do + ship <- reqShip req + runAppl (rcReq api ship) (rcKil api) req resp + + io (W.runTLSSocket tls opts sok app) + + +-------------------------------------------------------------------------------- + +configCreds :: TlsConfig -> Either Text Credential +configCreds TlsConfig {..} = + credentialLoadX509ChainFromMemory tcCerti tcChain tcPrKey & \case + Left str -> Left (pack str) + Right rs -> Right rs + +serv :: HasLogFunc e => ServConf -> RIO e () +serv ServConf {..} = do + tid <- async runServ + atomically scDeth + cancel tid + where + runServ = rwith (forceOpenSocket scHost scPort) $ \(por, sok) -> do + atomically (scOpnd por) + startServer scType scHost por sok scRedi diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml index e4da0a37b..3128109bd 100644 --- a/pkg/hs/urbit-king/package.yaml +++ b/pkg/hs/urbit-king/package.yaml @@ -92,6 +92,7 @@ dependencies: - text - these - time + - tls - transformers - unix - unliftio From c1454b13662f6cf7641eb9eb2a566372abfeedb0 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Sun, 10 May 2020 15:27:02 -0700 Subject: [PATCH 080/257] king: Finish factoring out HTTP server lifecycle from Eyre. --- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 425 +++++------------- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs | 40 +- 2 files changed, 128 insertions(+), 337 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 15baa2deb..5d1828357 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -1,31 +1,9 @@ {-| - Http Server Driver - - TODO Make sure that HTTP sockets get closed on shutdown. - - TODO What is this about? - - // if we don't explicitly set this field, h2o will send with - // transfer-encoding: chunked - // - if ( 1 == has_len_i ) { - rec_u->res.content_length = ( 0 == gen_u->bod_u ) ? - 0 : gen_u->bod_u->len_w; - } - - TODO Does this matter, is is using WAI's default behavior ok? - - rec_u->res.reason = (status < 200) ? "weird" : - (status < 300) ? "ok" : - (status < 400) ? "moved" : - (status < 500) ? "missing" : - "hosed"; + Eyre: Http Server Driver -} module Urbit.Vere.Eyre ( eyre - , multiServ - , ShipAPI(..) ) where @@ -34,20 +12,17 @@ import Urbit.Prelude hiding (Builder) import Urbit.Arvo hiding (ServerId, reqUrl, secure) import Urbit.King.Config import Urbit.Vere.Eyre.Wai hiding (ReqId) +import Urbit.Vere.Eyre.Serv import Urbit.Vere.Pier.Types -import Data.PEM (pemParseBS, pemWriteBS) -import Network.Socket (SockAddr(..)) -import RIO.Prelude (decodeUtf8Lenient) -import System.Directory (doesFileExist, removeFile) -import System.Random (randomIO) -import Urbit.Vere.Http (convertHeaders, unconvertHeaders) +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.PEM (pemParseBS, pemWriteBS) +import RIO.Prelude (decodeUtf8Lenient) +import System.Directory (doesFileExist, removeFile) +import System.Random (randomIO) +import Urbit.Vere.Http (convertHeaders, unconvertHeaders) -import qualified Network.HTTP.Types as H -import qualified Network.Socket as Net -import qualified Network.Wai as W -import qualified Network.Wai.Handler.Warp as W -import qualified Network.Wai.Handler.WarpTLS as W +import qualified Network.HTTP.Types as H -- Internal Types -------------------------------------------------------------- @@ -57,27 +32,24 @@ type HasShipEnv e = (HasLogFunc e, HasNetworkConfig e, HasPierConfig e) type ReqId = UD data Ports = Ports - { pHttps :: Maybe Port - , pHttp :: Port - , pLoop :: Port - } - deriving (Eq, Ord, Show) + { pHttps :: Maybe Port + , pHttp :: Port + , pLoop :: Port + } + deriving (Eq, Ord, Show) -newtype Drv = Drv { _unDrv :: MVar (Maybe Serv) } +newtype Drv = Drv (MVar (Maybe Serv)) data Serv = Serv - { sServId :: ServId - , sConfig :: HttpServerConf - , sLoopTid :: Async () - , sHttpTid :: Async () - , sHttpsTid :: Maybe (Async ()) - , sLoopSock :: Net.Socket - , sHttpSock :: Net.Socket - , sHttpsSock :: Net.Socket - , sPorts :: Ports - , sPortsFile :: FilePath - , sLiveReqs :: TVar LiveReqs - } + { sServId :: ServId + , sConfig :: HttpServerConf + , sLop :: ServApi + , sIns :: ServApi + , sSec :: Maybe ServApi + , sPorts :: Ports + , sPortsFile :: FilePath + , sLiveReqs :: TVar LiveReqs + } -- Generic Service Stop/Restart -- Using an MVar for Atomicity ----------------- @@ -182,16 +154,9 @@ reqEv sId reqId which addr req = -- Top-Level Driver Interface -------------------------------------------------- -data CantOpenPort = CantOpenPort W.Port - deriving (Eq, Ord, Show, Exception) - -data WhichPort - = WPSpecific W.Port - | WPChoices [W.Port] - data SockOpts = SockOpts { soLocalhost :: Bool - , soWhich :: WhichPort + , soWhich :: ServPort } data PortsToTry = PortsToTry @@ -200,73 +165,6 @@ data PortsToTry = PortsToTry , pttLop :: SockOpts } -{-| - Opens a socket on some port, accepting connections from `127.0.0.1` - if fake and `0.0.0.0` if real. - - It will attempt to open a socket on each of the supplied ports in - order. If they all fail, it will ask the operating system to give - us an open socket on *any* open port. If that fails, it will throw - an exception. --} -openPort :: forall e . HasLogFunc e => SockOpts -> RIO e (W.Port, Net.Socket) -openPort SockOpts {..} = case soWhich of - WPSpecific x -> insist (fromIntegral x) - WPChoices xs -> loop (fromIntegral <$> xs) - - where - loop :: [W.Port] -> RIO e (W.Port, Net.Socket) - loop = \case - [] -> do - logTrace "Fallback: asking the OS to give us some free port." - ps <- io W.openFreePort - logTrace (display ("Opened port " <> tshow (fst ps))) - pure ps - x : xs -> do - logTrace (display ("Trying to open port " <> tshow x)) - io (tryOpen x) >>= \case - Left (err :: IOError) -> do - logWarn (display ("Failed to open port " <> tshow x)) - logWarn (display (tshow err)) - loop xs - Right ps -> do - logTrace (display ("Opened port " <> tshow (fst ps))) - pure ps - - insist :: W.Port -> RIO e (W.Port, Net.Socket) - insist p = do - logTrace (display ("Opening configured port " <> tshow p)) - io (tryOpen p) >>= \case - Left (err :: IOError) -> do - logWarn (display ("Failed to open port " <> tshow p)) - logWarn (display (tshow err)) - throwIO (CantOpenPort p) - Right ps -> do - logTrace (display ("Opened port " <> tshow (fst ps))) - pure ps - - bindTo = if soLocalhost then "127.0.0.1" else "0.0.0.0" - - getBindAddr :: W.Port -> IO SockAddr - getBindAddr por = - Net.getAddrInfo Nothing (Just bindTo) (Just (show por)) >>= \case - [] -> error "this should never happen." - x : _ -> pure (Net.addrAddress x) - - bindListenPort :: W.Port -> Net.Socket -> IO Net.PortNumber - bindListenPort por sok = do - Net.bind sok =<< getBindAddr por - Net.listen sok 1 - Net.socketPort sok - - -- `inet_addr`, `bind`, and `listen` all throw `IOError` if they fail. - tryOpen :: W.Port -> IO (Either IOError (W.Port, Net.Socket)) - tryOpen por = do - sok <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol - try (bindListenPort por sok) >>= \case - Left exn -> Net.close sok $> Left exn - Right por -> pure (Right (fromIntegral por, sok)) - httpServerPorts :: HasShipEnv e => Bool -> RIO e PortsToTry httpServerPorts fak = do ins <- view (networkConfigL . ncHttpPort . to (fmap fromIntegral)) @@ -277,49 +175,21 @@ httpServerPorts fak = do let local = localMode || fak let pttSec = case (sec, fak) of - (Just p , _ ) -> SockOpts local (WPSpecific p) - (Nothing, False) -> SockOpts local (WPChoices (443 : [8443 .. 8448])) - (Nothing, True ) -> SockOpts local (WPChoices ([8443 .. 8448])) + (Just p , _ ) -> SockOpts local (SPChoices $ singleton p) + (Nothing, False) -> SockOpts local (SPChoices (443 :| [8443 .. 8453])) + (Nothing, True ) -> SockOpts local (SPChoices (8443 :| [8444 .. 8453])) let pttIns = case (ins, fak) of - (Just p , _ ) -> SockOpts local (WPSpecific p) - (Nothing, False) -> SockOpts local (WPChoices (80 : [8080 .. 8085])) - (Nothing, True ) -> SockOpts local (WPChoices [8080 .. 8085]) + (Just p , _ ) -> SockOpts local (SPChoices $ singleton p) + (Nothing, False) -> SockOpts local (SPChoices (80 :| [8080 .. 8090])) + (Nothing, True ) -> SockOpts local (SPChoices (8080 :| [8081 .. 8090])) let pttLop = case (lop, fak) of - (Just p , _) -> SockOpts local (WPSpecific p) - (Nothing, _) -> SockOpts local (WPChoices [12321 .. 12326]) + (Just p , _) -> SockOpts local (SPChoices $ singleton p) + (Nothing, _) -> SockOpts local SPAnyPort pure (PortsToTry { .. }) -eyreApp - :: HasLogFunc e - => e - -> ServId - -> TVar LiveReqs - -> (Ev -> STM ()) - -> WhichServer - -> W.Application -eyreApp env sId vLive plan which = - app env vLive onReq onCancel - where - bodFile "" = Nothing - bodFile bs = Just $ File $ Octs bs - - onReq :: Word64 -> ReqInfo -> STM () - onReq reqId ReqInfo{..} = do - let evBod = bodFile riBod - evHdr = convertHeaders riHdr - evUrl = Cord (decodeUtf8Lenient riUrl) - evReq = HttpRequest riMet evUrl evHdr evBod - reqUd = fromIntegral reqId - event = reqEv sId reqUd which riAdr evReq - - plan event - - onCancel :: Word64 -> STM () - onCancel reqId = plan (cancelEv sId (fromIntegral reqId)) - parseCerts :: ByteString -> Maybe (ByteString, [ByteString]) parseCerts bs = do pems <- pemParseBS bs & either (const Nothing) Just @@ -344,13 +214,12 @@ reorgHttpEvent = \case hSta :: ResponseHeader -> H.Status hSta = toEnum . fromIntegral . statusCode - respond :: HasLogFunc e => Drv -> Word64 -> HttpEvent -> RIO e () respond (Drv v) reqId ev = do readMVar v >>= \case Nothing -> logError "Got a response to a request that does not exist." - Just sv -> do logDebug $ displayShow ev + Just sv -> do logTrace $ displayShow ev for_ (reorgHttpEvent ev) $ atomically . routeRespAct (sLiveReqs sv) reqId @@ -361,76 +230,92 @@ startServ :: (HasPierConfig e, HasLogFunc e, HasNetworkConfig e) => Bool -> HttpServerConf -> (Ev -> STM ()) -> RIO e Serv startServ isFake conf plan = do - logDebug "startServ" + logTrace "startServ" - let tls = do (PEM key, PEM certs) <- hscSecure conf - (cert, chain) <- parseCerts (wainBytes certs) - pure $ W.tlsSettingsChainMemory cert chain $ wainBytes key + srvId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32) - sId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32) - liv <- newTVarIO emptyLiveReqs + let mTls = do + (PEM key, PEM certs) <- hscSecure conf + (cert, chain) <- parseCerts (wainBytes certs) + pure $ TlsConfig (wainBytes key) cert chain ptt <- httpServerPorts isFake - (httpPortInt, httpSock) <- openPort (pttIns ptt) - (httpsPortInt, httpsSock) <- openPort (pttSec ptt) - (loopPortInt, loopSock) <- openPort (pttLop ptt) + let secRedi = Nothing -- TODO - let httpPort = Port (fromIntegral httpPortInt) - httpsPort = Port (fromIntegral httpsPortInt) - loopPort = Port (fromIntegral loopPortInt) + let soHost :: SockOpts -> ServHost + soHost so = if soLocalhost so then SHLocalhost else SHAnyHostOk - let loopOpts = W.defaultSettings & W.setPort (fromIntegral loopPort) - & W.setHost "127.0.0.1" - & W.setTimeout (5 * 60) - httpOpts = W.defaultSettings & W.setHost "*" - & W.setPort (fromIntegral httpPort) - httpsOpts = W.defaultSettings & W.setHost "*" - & W.setPort (fromIntegral httpsPort) + vLive <- newTVarIO emptyLiveReqs - env <- ask + let bodFile "" = Nothing + bodFile bs = Just $ File $ Octs bs - logDebug "Starting loopback server" - loopTid <- async $ io - $ W.runSettingsSocket loopOpts loopSock - $ eyreApp env sId liv plan Loopback + let onReq :: WhichServer -> Word64 -> ReqInfo -> STM () + onReq which reqId ReqInfo{..} = do + let evBod = bodFile riBod + let evHdr = convertHeaders riHdr + let evUrl = Cord (decodeUtf8Lenient riUrl) + let evReq = HttpRequest riMet evUrl evHdr evBod + let reqUd = fromIntegral reqId + let event = reqEv srvId reqUd which riAdr evReq + plan event - logDebug "Starting HTTP server" - httpTid <- async $ io - $ W.runSettingsSocket httpOpts httpSock - $ eyreApp env sId liv plan Insecure + let onKilReq = plan . cancelEv srvId . fromIntegral - logDebug "Starting HTTPS server" - httpsTid <- for tls $ \tlsOpts -> - async $ io - $ W.runTLSSocket tlsOpts httpsOpts httpsSock - $ eyreApp env sId liv plan Secure + logTrace "Starting loopback server" + lop <- serv vLive $ ServConf + { scHost = soHost (pttLop ptt) + , scPort = soWhich (pttLop ptt) + , scRedi = Nothing + , scType = STHttp $ ReqApi + { rcReq = \() -> onReq Loopback + , rcKil = onKilReq + } + } + + logTrace "Starting insecure server" + ins <- serv vLive $ ServConf + { scHost = soHost (pttIns ptt) + , scPort = soWhich (pttIns ptt) + , scRedi = secRedi + , scType = STHttp $ ReqApi + { rcReq = \() -> onReq Insecure + , rcKil = onKilReq + } + } + + mSec <- for mTls $ \tls -> do + logTrace "Starting secure server" + serv vLive $ ServConf + { scHost = soHost (pttSec ptt) + , scPort = soWhich (pttSec ptt) + , scRedi = Nothing + , scType = STHttps tls $ ReqApi + { rcReq = \() -> onReq Secure + , rcKil = onKilReq + } + } pierPath <- view pierPathL - let por = Ports (tls <&> const httpsPort) httpPort loopPort + + lopPor <- atomically (fmap fromIntegral $ saPor lop) + insPor <- atomically (fmap fromIntegral $ saPor ins) + secPor <- for mSec (fmap fromIntegral . atomically . saPor) + + let por = Ports secPor insPor lopPor fil = pierPath <> "/.http.ports" - logDebug $ displayShow (sId, por, fil) + logTrace $ displayShow ("EYRE", "All Servers Started.", srvId, por, fil) - logDebug "Finished started HTTP Servers" - - pure $ Serv sId conf - loopTid httpTid httpsTid - httpSock httpsSock loopSock - por fil liv + pure $ Serv srvId conf lop ins mSec por fil vLive killServ :: HasLogFunc e => Serv -> RIO e () killServ Serv{..} = do - cancel sLoopTid - cancel sHttpTid - traverse_ cancel sHttpsTid - io $ Net.close sHttpSock - io $ Net.close sHttpsSock - io $ Net.close sLoopSock - removePortsFile sPortsFile - (void . waitCatch) sLoopTid - (void . waitCatch) sHttpTid - traverse_ (void . waitCatch) sHttpsTid + atomically (saKil sLop) + atomically (saKil sIns) + for_ sSec (\sec -> atomically (saKil sec)) + removePortsFile sPortsFile kill :: HasLogFunc e => Drv -> RIO e () kill (Drv v) = stopService v killServ >>= fromEither @@ -471,111 +356,3 @@ eyre king plan isFake = -- when (i == fromIntegral king) $ do logDebug "respond" respond drv (fromIntegral req) ev - - --- Multi-Tenet HTTP ------------------------------------------------------------ - -{- - # Very First Phase: Shared HTTP, no SSL. - - - Global configuration flag for shared HTTP port. - - - Shared server starts before ships. - - - Shared server is informed when ships go up and come down. - - - Shared server delivers requests to existing HTTP driver. - - - Existing HTTP driver can send responses to shared HTTP server. --} - -type ShareRequ = (ServId, ReqId, WhichServer, Address, HttpRequest) -type ShareResp = (ServId, UD, UD, HttpEvent) - -data ShipAPI = ShipAPI - { sapiReq :: ShareRequ -> STM () - , sapiRes :: STM ShareResp - } - -data MultiServ = MultiServ - { msPort :: Maybe Word16 - , msShip :: TVar (Map Ship ShipAPI) - , msBoot :: TMVar (Ship, ShipAPI) - , msDead :: TMVar Ship - , msKill :: STM () - } - -data Hap = Deþ Ship - | Lif (Ship, ShipAPI) - | Res ShareResp - | Kil () - -multiServ :: HasLogFunc e => MultiServ -> RIO e () -multiServ ms = do - case msPort ms of - Nothing -> doNothing ms - Just po -> doSomething ms po - -{- - If the port is set, we do things for real. We run an HTTP server, - sends requests to the appropriate ship, respond to requests when - responses are given, and shuts down when the king shuts down. --} -doSomething :: HasLogFunc e => MultiServ -> Word16 -> RIO e () -doSomething MultiServ{..} httpPort = do - logDebug "Starting HTTP server" - - let httpOpts = W.defaultSettings & W.setHost "*" - & W.setPort (fromIntegral httpPort) - - sId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32) - - vShips :: TVar (Map Ship ShipAPI) <- newTVarIO mempty - liv <- newTVarIO emptyLiveReqs - - env <- ask - - plan <- error "TODO" - - httpTid <- async $ io - $ W.runSettings httpOpts - $ eyreApp env sId liv plan Insecure - - let onHapn :: STM Hap - onHapn = asum [ Lif <$> takeTMVar msBoot - , Deþ <$> takeTMVar msDead - , Res <$> (readTVar vShips >>= asum . fmap sapiRes . toList) - , Kil <$> msKill - ] - - let loop = join $ atomically $ onHapn >>= \case - Deþ s -> modifyTVar' vShips (deleteMap s) >> pure loop - Lif (s,api) -> modifyTVar' vShips (insertMap s api) >> pure loop - Res _ -> error "TODO" - Kil _ -> pure (cancel httpTid) - - loop - -{- - If the port is not set, we still run a thread for the shared server. It - doesn't run an HTTP server, it ignores all responses, and it shuts - down when the king shuts down. --} -doNothing :: MultiServ -> RIO e () -doNothing MultiServ{..} = do - vShips :: TVar (Map Ship ShipAPI) <- newTVarIO mempty - - let onHapn :: STM Hap - onHapn = asum [ Lif <$> takeTMVar msBoot - , Deþ <$> takeTMVar msDead - , Res <$> (readTVar vShips >>= asum . fmap sapiRes . toList) - , Kil <$> msKill - ] - - let loop = join $ atomically $ onHapn >>= \case - Deþ s -> modifyTVar' vShips (deleteMap s) >> pure loop - Lif (s,api) -> modifyTVar' vShips (insertMap s api) >> pure loop - Res _ -> pure loop - Kil _ -> pure (pure ()) - - loop diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs index 97509a505..95e93efd0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -19,7 +19,8 @@ {-# OPTIONS_GHC -Wno-deprecations #-} module Urbit.Vere.Eyre.Serv - ( TlsConfig(..) + ( ServApi(..) + , TlsConfig(..) , MultiTlsConfig , ReqApi(..) , ServType(..) @@ -50,6 +51,11 @@ import qualified Urbit.Vere.Eyre.Wai as E -- Internal Types -------------------------------------------------------------- +data ServApi = ServApi + { saKil :: STM () + , saPor :: STM W.Port + } + data TlsConfig = TlsConfig { tcPrKey :: ByteString , tcCerti :: ByteString @@ -82,8 +88,6 @@ data ServConf = ServConf , scHost :: ServHost , scPort :: ServPort , scRedi :: Maybe W.Port - , scOpnd :: W.Port -> STM () - , scDeth :: STM () } @@ -214,10 +218,10 @@ startServer -> W.Port -> Net.Socket -> Maybe W.Port + -> TVar E.LiveReqs -> RIO e () -startServer typ hos por sok red = do +startServer typ hos por sok red vLive = do envir <- ask - vLive <- newTVarIO E.emptyLiveReqs let host = case hos of SHLocalhost -> "127.0.0.1" @@ -266,12 +270,22 @@ configCreds TlsConfig {..} = Left str -> Left (pack str) Right rs -> Right rs -serv :: HasLogFunc e => ServConf -> RIO e () -serv ServConf {..} = do - tid <- async runServ - atomically scDeth - cancel tid +serv :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi +serv vLive ServConf {..} = do + kil <- newEmptyTMVarIO + por <- newEmptyTMVarIO + + void $ async $ do + tid <- async (runServ por) + atomically (takeTMVar kil) + cancel tid + + pure $ ServApi + { saKil = void (tryPutTMVar kil ()) + , saPor = readTMVar por + } where - runServ = rwith (forceOpenSocket scHost scPort) $ \(por, sok) -> do - atomically (scOpnd por) - startServer scType scHost por sok scRedi + runServ vPort = do + rwith (forceOpenSocket scHost scPort) $ \(por, sok) -> do + atomically (putTMVar vPort por) + startServer scType scHost por sok scRedi vLive From 965f59978803c4907c18a0d3205b8e13c0d3ad29 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Mon, 11 May 2020 12:51:51 -0700 Subject: [PATCH 081/257] king: eyre: Finished multi-tenet HTTP flow (not yet started by king). --- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 443 ++++++++++-------- .../lib/Urbit/Vere/Eyre/PortsFile.hs | 44 ++ pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs | 32 +- .../urbit-king/lib/Urbit/Vere/Eyre/Service.hs | 67 +++ pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs | 43 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 2 +- 6 files changed, 394 insertions(+), 237 deletions(-) create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/PortsFile.hs create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Service.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 5d1828357..1fcc267d7 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -4,42 +4,52 @@ module Urbit.Vere.Eyre ( eyre + , multiEyre ) where -import Urbit.Prelude hiding (Builder) +import Urbit.Prelude hiding (Builder) -import Urbit.Arvo hiding (ServerId, reqUrl, secure) +import Urbit.Arvo hiding (ServerId, reqUrl, secure) import Urbit.King.Config -import Urbit.Vere.Eyre.Wai hiding (ReqId) +import Urbit.Vere.Eyre.PortsFile import Urbit.Vere.Eyre.Serv +import Urbit.Vere.Eyre.Service +import Urbit.Vere.Eyre.Wai import Urbit.Vere.Pier.Types import Data.List.NonEmpty (NonEmpty((:|))) import Data.PEM (pemParseBS, pemWriteBS) +import Network.TLS (Credential) import RIO.Prelude (decodeUtf8Lenient) -import System.Directory (doesFileExist, removeFile) import System.Random (randomIO) import Urbit.Vere.Http (convertHeaders, unconvertHeaders) import qualified Network.HTTP.Types as H --- Internal Types -------------------------------------------------------------- +-- Types ----------------------------------------------------------------------- type HasShipEnv e = (HasLogFunc e, HasNetworkConfig e, HasPierConfig e) type ReqId = UD -data Ports = Ports - { pHttps :: Maybe Port - , pHttp :: Port - , pLoop :: Port - } - deriving (Eq, Ord, Show) - newtype Drv = Drv (MVar (Maybe Serv)) +data WhichServer = Secure | Insecure | Loopback + deriving (Eq) + +data SockOpts = SockOpts + { soLocalhost :: Bool + , soWhich :: ServPort + } + +data PortsToTry = PortsToTry + { pttSec :: SockOpts + , pttIns :: SockOpts + , pttLop :: SockOpts + } + data Serv = Serv { sServId :: ServId , sConfig :: HttpServerConf @@ -52,118 +62,29 @@ data Serv = Serv } --- Generic Service Stop/Restart -- Using an MVar for Atomicity ----------------- - -{-| - Restart a running service. - - This can probably be made simpler, but it - - - Sets the MVar to Nothing if there was an exception whil starting - or stopping the service. - - - Keeps the MVar lock until the restart process finishes. --} -restartService :: ∀e s. HasLogFunc e - => MVar (Maybe s) - -> RIO e s - -> (s -> RIO e ()) - -> RIO e (Either SomeException s) -restartService vServ sstart kkill = do - logDebug "restartService" - modifyMVar vServ $ \case - Nothing -> doStart - Just sv -> doRestart sv - where - doRestart :: s -> RIO e (Maybe s, Either SomeException s) - doRestart serv = do - logDebug "doStart" - try (kkill serv) >>= \case - Left exn -> pure (Nothing, Left exn) - Right () -> doStart - - doStart :: RIO e (Maybe s, Either SomeException s) - doStart = do - logDebug "doStart" - try sstart <&> \case - Right s -> (Just s, Right s) - Left exn -> (Nothing, Left exn) - -stopService :: HasLogFunc e - => MVar (Maybe s) - -> (s -> RIO e ()) - -> RIO e (Either SomeException ()) -stopService vServ kkill = do - logDebug "stopService" - modifyMVar vServ $ \case - Nothing -> pure (Nothing, Right ()) - Just sv -> do res <- try (kkill sv) - pure (Nothing, res) - - --- Ports File ------------------------------------------------------------------ - -removePortsFile :: FilePath -> RIO e () -removePortsFile pax = - io (doesFileExist pax) >>= \case - True -> io $ removeFile pax - False -> pure () - -portsFileText :: Ports -> Text -portsFileText Ports{..} = - unlines $ catMaybes - [ pHttps <&> \p -> (tshow p <> " secure public") - , Just (tshow (unPort pHttp) <> " insecure public") - , Just (tshow (unPort pLoop) <> " insecure loopback") - ] - -writePortsFile :: FilePath -> Ports -> RIO e () -writePortsFile f = writeFile f . encodeUtf8 . portsFileText - - -- Utilities for Constructing Events ------------------------------------------- -data WhichServer = Secure | Insecure | Loopback - deriving (Eq) - servEv :: HttpServerEv -> Ev servEv = EvBlip . BlipEvHttpServer bornEv :: KingId -> Ev -bornEv king = - servEv $ HttpServerEvBorn (king, ()) () +bornEv king = servEv $ HttpServerEvBorn (king, ()) () liveEv :: ServId -> Ports -> Ev -liveEv sId Ports{..} = - servEv $ HttpServerEvLive (sId, ()) pHttp pHttps +liveEv sId Ports {..} = servEv $ HttpServerEvLive (sId, ()) pHttp pHttps cancelEv :: ServId -> ReqId -> Ev -cancelEv sId reqId = - servEv $ HttpServerEvCancelRequest (sId, reqId, 1, ()) () +cancelEv sId reqId = servEv $ HttpServerEvCancelRequest (sId, reqId, 1, ()) () reqEv :: ServId -> ReqId -> WhichServer -> Address -> HttpRequest -> Ev -reqEv sId reqId which addr req = - case which of - Loopback -> - servEv $ HttpServerEvRequestLocal (sId, reqId, 1, ()) - $ HttpServerReq False addr req - _ -> - servEv $ HttpServerEvRequest (sId, reqId, 1, ()) - $ HttpServerReq (which == Secure) addr req +reqEv sId reqId which addr req = case which of + Loopback -> servEv $ HttpServerEvRequestLocal (sId, reqId, 1, ()) + $ HttpServerReq False addr req + _ -> servEv $ HttpServerEvRequest (sId, reqId, 1, ()) + $ HttpServerReq (which == Secure) addr req --- Top-Level Driver Interface -------------------------------------------------- - -data SockOpts = SockOpts - { soLocalhost :: Bool - , soWhich :: ServPort - } - -data PortsToTry = PortsToTry - { pttSec :: SockOpts - , pttIns :: SockOpts - , pttLop :: SockOpts - } +-- Based on Pier+Config, which ports should each server run? ------------------- httpServerPorts :: HasShipEnv e => Bool -> RIO e PortsToTry httpServerPorts fak = do @@ -190,18 +111,23 @@ httpServerPorts fak = do pure (PortsToTry { .. }) -parseCerts :: ByteString -> Maybe (ByteString, [ByteString]) -parseCerts bs = do - pems <- pemParseBS bs & either (const Nothing) Just - case pems of - [] -> Nothing - p:ps -> pure (pemWriteBS p, pemWriteBS <$> ps) -fByt :: File -> ByteString -fByt = unOcts . unFile +-- Convert Between Urbit and WAI types. ---------------------------------------- -reorgHttpEvent :: HttpEvent -> [RespAct] -reorgHttpEvent = \case +parseTlsConfig :: (Key, Cert) -> Maybe TlsConfig +parseTlsConfig (PEM key, PEM certs) = do + let (cerByt, keyByt) = (wainBytes certs, wainBytes key) + pems <- pemParseBS cerByt & either (const Nothing) Just + (cert, chain) <- case pems of + [] -> Nothing + p : ps -> pure (pemWriteBS p, pemWriteBS <$> ps) + pure $ TlsConfig keyByt cert chain + where + wainBytes :: Wain -> ByteString + wainBytes = encodeUtf8 . unWain + +parseHttpEvent :: HttpEvent -> [RespAct] +parseHttpEvent = \case Start h b True -> [RAFull (hSta h) (hHdr h) (fByt $ fromMaybe "" b)] Start h b False -> [RAHead (hSta h) (hHdr h) (fByt $ fromMaybe "" b)] Cancel () -> [RADone] @@ -214,62 +140,79 @@ reorgHttpEvent = \case hSta :: ResponseHeader -> H.Status hSta = toEnum . fromIntegral . statusCode -respond :: HasLogFunc e - => Drv -> Word64 -> HttpEvent -> RIO e () -respond (Drv v) reqId ev = do - readMVar v >>= \case - Nothing -> logError "Got a response to a request that does not exist." - Just sv -> do logTrace $ displayShow ev - for_ (reorgHttpEvent ev) $ - atomically . routeRespAct (sLiveReqs sv) reqId + fByt :: File -> ByteString + fByt = unOcts . unFile -wainBytes :: Wain -> ByteString -wainBytes = encodeUtf8 . unWain +requestEvent :: ServId -> WhichServer -> Word64 -> ReqInfo -> Ev +requestEvent srvId which reqId ReqInfo{..} = reqEv srvId reqUd which riAdr evReq + where + evBod = bodFile riBod + evHdr = convertHeaders riHdr + evUrl = Cord (decodeUtf8Lenient riUrl) + evReq = HttpRequest riMet evUrl evHdr evBod + reqUd = fromIntegral reqId -startServ :: (HasPierConfig e, HasLogFunc e, HasNetworkConfig e) - => Bool -> HttpServerConf -> (Ev -> STM ()) - -> RIO e Serv -startServ isFake conf plan = do + bodFile :: ByteString -> Maybe File + bodFile "" = Nothing + bodFile bs = Just $ File $ Octs bs + + +-- Running Servers ------------------------------------------------------------- + +execRespActs :: HasLogFunc e => Drv -> Ship -> Word64 -> HttpEvent -> RIO e () +execRespActs (Drv v) who reqId ev = readMVar v >>= \case + Nothing -> logError "Got a response to a request that does not exist." + Just sv -> do + logTrace $ displayShow ev + for_ (parseHttpEvent ev) $ \act -> do + atomically (routeRespAct who (sLiveReqs sv) reqId act) + +startServ + :: (HasPierConfig e, HasLogFunc e, HasNetworkConfig e) + => MultiEyreApi + -> Ship + -> Bool + -> HttpServerConf + -> (Ev -> STM ()) + -> RIO e Serv +startServ multi who isFake conf plan = do logTrace "startServ" srvId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32) - let mTls = do - (PEM key, PEM certs) <- hscSecure conf - (cert, chain) <- parseCerts (wainBytes certs) - pure $ TlsConfig (wainBytes key) cert chain + let mTls = hscSecure conf >>= parseTlsConfig ptt <- httpServerPorts isFake - let secRedi = Nothing -- TODO + {- + TODO If configuration requests a redirect, get the HTTPS port (if + configuration specifies a specific port, use that. Otherwise, wait + for the HTTPS server to start and then use the port that it chose). + and run an HTTP server that simply redirects to the HTTPS server. + -} + let secRedi = Nothing let soHost :: SockOpts -> ServHost soHost so = if soLocalhost so then SHLocalhost else SHAnyHostOk vLive <- newTVarIO emptyLiveReqs - let bodFile "" = Nothing - bodFile bs = Just $ File $ Octs bs + let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM () + onReq which _ship reqId reqInfo = + plan (requestEvent srvId which reqId reqInfo) - let onReq :: WhichServer -> Word64 -> ReqInfo -> STM () - onReq which reqId ReqInfo{..} = do - let evBod = bodFile riBod - let evHdr = convertHeaders riHdr - let evUrl = Cord (decodeUtf8Lenient riUrl) - let evReq = HttpRequest riMet evUrl evHdr evBod - let reqUd = fromIntegral reqId - let event = reqEv srvId reqUd which riAdr evReq - plan event + let onKilReq :: Ship -> Word64 -> STM () + onKilReq _ship = plan . cancelEv srvId . fromIntegral - let onKilReq = plan . cancelEv srvId . fromIntegral + atomically (joinMultiEyre multi who mTls onReq onKilReq) logTrace "Starting loopback server" lop <- serv vLive $ ServConf { scHost = soHost (pttLop ptt) , scPort = soWhich (pttLop ptt) , scRedi = Nothing - , scType = STHttp $ ReqApi - { rcReq = \() -> onReq Loopback + , scType = STHttp who $ ReqApi + { rcReq = onReq Loopback , rcKil = onKilReq } } @@ -279,8 +222,8 @@ startServ isFake conf plan = do { scHost = soHost (pttIns ptt) , scPort = soWhich (pttIns ptt) , scRedi = secRedi - , scType = STHttp $ ReqApi - { rcReq = \() -> onReq Insecure + , scType = STHttp who $ ReqApi + { rcReq = onReq Insecure , rcKil = onKilReq } } @@ -291,8 +234,8 @@ startServ isFake conf plan = do { scHost = soHost (pttSec ptt) , scPort = soWhich (pttSec ptt) , scRedi = Nothing - , scType = STHttps tls $ ReqApi - { rcReq = \() -> onReq Secure + , scType = STHttps who tls $ ReqApi + { rcReq = onReq Secure , rcKil = onKilReq } } @@ -308,51 +251,153 @@ startServ isFake conf plan = do logTrace $ displayShow ("EYRE", "All Servers Started.", srvId, por, fil) - pure $ Serv srvId conf lop ins mSec por fil vLive + pure (Serv srvId conf lop ins mSec por fil vLive) -killServ :: HasLogFunc e => Serv -> RIO e () -killServ Serv{..} = do - atomically (saKil sLop) - atomically (saKil sIns) - for_ sSec (\sec -> atomically (saKil sec)) - removePortsFile sPortsFile -kill :: HasLogFunc e => Drv -> RIO e () -kill (Drv v) = stopService v killServ >>= fromEither +-- Eyre Driver ----------------------------------------------------------------- -eyre :: ∀e. HasShipEnv e - => KingId -> QueueEv -> Bool - -> ([Ev], RAcquire e (EffCb e HttpServerEf)) -eyre king plan isFake = - (initialEvents, runHttpServer) - where - initialEvents :: [Ev] - initialEvents = [bornEv king] +eyre + :: forall e + . HasShipEnv e + => KingId + -> MultiEyreApi + -> Ship + -> QueueEv + -> Bool + -> ([Ev], RAcquire e (EffCb e HttpServerEf)) +eyre king multi who plan isFake = (initialEvents, runHttpServer) + where + initialEvents :: [Ev] + initialEvents = [bornEv king] - runHttpServer :: RAcquire e (EffCb e HttpServerEf) - runHttpServer = handleEf <$> mkRAcquire (Drv <$> newMVar Nothing) kill + runHttpServer :: RAcquire e (EffCb e HttpServerEf) + runHttpServer = handleEf <$> mkRAcquire + (Drv <$> newMVar Nothing) + (\(Drv v) -> stopService v kill >>= fromEither) - restart :: Drv -> HttpServerConf -> RIO e Serv - restart (Drv var) conf = do - logDebug "Restarting http server" - res <- fromEither =<< - restartService var (startServ isFake conf plan) killServ - logDebug "Done restating http server" - pure res + kill :: HasLogFunc e => Serv -> RIO e () + kill Serv{..} = do + atomically (leaveMultiEyre multi who) + atomically (saKil sLop) + atomically (saKil sIns) + for_ sSec (\sec -> atomically (saKil sec)) + io (removePortsFile sPortsFile) - handleEf :: Drv -> HttpServerEf -> RIO e () - handleEf drv = \case - HSESetConfig (i, ()) conf -> do - -- print (i, king) - -- when (i == fromIntegral king) $ do - logDebug "restarting" - Serv{..} <- restart drv conf - logDebug "Enqueue %live" - atomically $ plan (liveEv sServId sPorts) - logDebug "Write ports file" - writePortsFile sPortsFile sPorts - HSEResponse (i, req, _seq, ()) ev -> do - -- print (i, king) - -- when (i == fromIntegral king) $ do - logDebug "respond" - respond drv (fromIntegral req) ev + restart :: Drv -> HttpServerConf -> RIO e Serv + restart (Drv var) conf = do + logDebug "Restarting http server" + let startAct = startServ multi who isFake conf plan + res <- fromEither =<< restartService var startAct kill + logDebug "Done restating http server" + pure res + + handleEf :: Drv -> HttpServerEf -> RIO e () + handleEf drv = \case + HSESetConfig (i, ()) conf -> do + logDebug (displayShow ("EYRE", "%set-config")) + Serv {..} <- restart drv conf + logDebug (displayShow ("EYRE", "%set-config", "Sending %live")) + atomically $ plan (liveEv sServId sPorts) + logDebug "Write ports file" + io (writePortsFile sPortsFile sPorts) + HSEResponse (i, req, _seq, ()) ev -> do + logDebug (displayShow ("EYRE", "%response")) + execRespActs drv who (fromIntegral req) ev + + +-- Multi-Tenet HTTP ------------------------------------------------------------ + +data MultiEyreConf = MultiEyreConf + { mecHttpsPort :: Maybe Port + , mecHttpPort :: Maybe Port + , mecLocalhostOnly :: Bool + } + +type OnMultiReq = WhichServer -> Ship -> Word64 -> ReqInfo -> STM () + +type OnMultiKil = Ship -> Word64 -> STM () + +data MultiEyreApi = MultiEyreApi + { meaConf :: MultiEyreConf + , meaLive :: TVar LiveReqs + , meaPlan :: TVar (Map Ship OnMultiReq) + , meaCanc :: TVar (Map Ship OnMultiKil) + , meaTlsC :: TVar (Map Ship Credential) + , meaKill :: STM () + } + +joinMultiEyre + :: MultiEyreApi + -> Ship + -> Maybe TlsConfig + -> OnMultiReq + -> OnMultiKil + -> STM () +joinMultiEyre api who mTls onReq onKil = do + modifyTVar' (meaPlan api) (insertMap who onReq) + modifyTVar' (meaCanc api) (insertMap who onKil) + for_ mTls $ \tls -> do + configCreds tls & \case + Left err -> pure () + Right cd -> modifyTVar' (meaTlsC api) (insertMap who cd) + +leaveMultiEyre :: MultiEyreApi -> Ship -> STM () +leaveMultiEyre MultiEyreApi {..} who = do + modifyTVar' meaCanc (deleteMap who) + modifyTVar' meaPlan (deleteMap who) + modifyTVar' meaTlsC (deleteMap who) + +multiEyre + :: (HasPierConfig e, HasLogFunc e, HasNetworkConfig e) + => MultiEyreConf + -> RIO e MultiEyreApi +multiEyre conf@MultiEyreConf{..} = do + vLive <- newTVarIO emptyLiveReqs + vPlan <- newTVarIO mempty + vCanc <- newTVarIO (mempty :: Map Ship (Ship -> Word64 -> STM ())) + vTlsC <- newTVarIO mempty + + let host = if mecLocalhostOnly then SHLocalhost else SHAnyHostOk + + let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM () + onReq which who reqId reqInfo = do + plan <- readTVar vPlan + lookup who plan & \case + Nothing -> pure () + Just cb -> cb which who reqId reqInfo + + let onKil :: Ship -> Word64 -> STM () + onKil who reqId = do + canc <- readTVar vCanc + lookup who canc & \case + Nothing -> pure () + Just cb -> cb who reqId + + mIns <- for mecHttpPort $ \por -> serv vLive $ ServConf + { scHost = host + , scPort = SPChoices $ singleton $ fromIntegral por + , scRedi = Nothing -- TODO + , scType = STMultiHttp $ ReqApi + { rcReq = onReq Insecure + , rcKil = onKil + } + } + + mSec <- for mecHttpsPort $ \por -> serv vLive $ ServConf + { scHost = host + , scPort = SPChoices $ singleton $ fromIntegral por + , scRedi = Nothing + , scType = STMultiHttps vTlsC $ ReqApi + { rcReq = onReq Secure + , rcKil = onKil + } + } + + pure $ MultiEyreApi + { meaLive = vLive + , meaPlan = vPlan + , meaCanc = vCanc + , meaTlsC = vTlsC + , meaConf = conf + , meaKill = traverse_ saKil (toList mIns <> toList mSec) + } diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/PortsFile.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/PortsFile.hs new file mode 100644 index 000000000..20e073122 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/PortsFile.hs @@ -0,0 +1,44 @@ +{-| + Eyre: Http Server Driver +-} + +module Urbit.Vere.Eyre.PortsFile + ( Ports(..) + , writePortsFile + , removePortsFile + ) +where + +import Urbit.Prelude + +import System.Directory (doesFileExist, removeFile) +import Urbit.Arvo (Port(unPort)) + + +-- Types ----------------------------------------------------------------------- + +data Ports = Ports + { pHttps :: Maybe Port + , pHttp :: Port + , pLoop :: Port + } + deriving (Eq, Ord, Show) + + +-- Creating and Deleting `.http.ports` files. ---------------------------------- + +portsFileText :: Ports -> Text +portsFileText Ports {..} = unlines $ catMaybes + [ pHttps <&> \p -> (tshow p <> " secure public") + , Just (tshow (unPort pHttp) <> " insecure public") + , Just (tshow (unPort pLoop) <> " insecure loopback") + ] + +removePortsFile :: FilePath -> IO () +removePortsFile pax = do + doesFileExist pax >>= \case + True -> removeFile pax + False -> pure () + +writePortsFile :: FilePath -> Ports -> IO () +writePortsFile f = writeFile f . encodeUtf8 . portsFileText diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs index 95e93efd0..0b3cd2e25 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -64,16 +64,16 @@ data TlsConfig = TlsConfig type MultiTlsConfig = TVar (Map Ship Credential) -data ReqApi a = ReqApi - { rcReq :: a -> E.ReqId -> E.ReqInfo -> STM () - , rcKil :: E.ReqId -> STM () +data ReqApi = ReqApi + { rcReq :: Ship -> Word64 -> E.ReqInfo -> STM () + , rcKil :: Ship -> Word64 -> STM () } data ServType - = STHttp (ReqApi ()) - | STHttps TlsConfig (ReqApi ()) - | STMultiHttp (ReqApi Ship) - | STMultiHttps MultiTlsConfig (ReqApi Ship) + = STHttp Ship ReqApi + | STHttps Ship TlsConfig ReqApi + | STMultiHttp ReqApi + | STMultiHttps MultiTlsConfig ReqApi data ServPort = SPAnyPort @@ -233,31 +233,31 @@ startServer typ hos por sok red vLive = do & W.setPort (fromIntegral por) & W.setTimeout (5 * 60) - let runAppl = E.app envir vLive + let runAppl who = E.app envir who vLive reqShip = hostShip . W.requestHeaderHost case typ of - STHttp api -> do - let app = runAppl (rcReq api ()) (rcKil api) + STHttp who api -> do + let app = runAppl who (rcReq api who) (rcKil api who) io (W.runSettingsSocket opts sok app) - STHttps TlsConfig {..} api -> do + STHttps who TlsConfig {..} api -> do let tls = W.tlsSettingsChainMemory tcCerti tcChain tcPrKey - let app = runAppl (rcReq api ()) (rcKil api) + let app = runAppl who (rcReq api who) (rcKil api who) io (W.runTLSSocket tls opts sok app) STMultiHttp api -> do let app req resp = do - ship <- reqShip req - runAppl (rcReq api ship) (rcKil api) req resp + who <- reqShip req + runAppl who (rcReq api who) (rcKil api who) req resp io (W.runSettingsSocket opts sok app) STMultiHttps mtls api -> do let sni = def { onServerNameIndication = onSniHdr mtls } let tls = W.defaultTlsSettings { W.tlsServerHooks = sni } let app = \req resp -> do - ship <- reqShip req - runAppl (rcReq api ship) (rcKil api) req resp + who <- reqShip req + runAppl who (rcReq api who) (rcKil api who) req resp io (W.runTLSSocket tls opts sok app) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Service.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Service.hs new file mode 100644 index 000000000..ce3bc01a9 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Service.hs @@ -0,0 +1,67 @@ +{-| + Eyre: Http Server Driver +-} + +module Urbit.Vere.Eyre.Service + ( restartService + , stopService + ) +where + +import Urbit.Prelude + + +-- Generic Service Stop/Restart -- Using an MVar for Atomicity ----------------- + +{-| + Restart a running service. + + This can probably be made simpler, but it + + - Sets the MVar to Nothing if there was an exception while starting + or stopping the service. + + - Keeps the MVar lock until the restart process finishes. +-} +restartService + :: forall e s + . HasLogFunc e + => MVar (Maybe s) + -> RIO e s + -> (s -> RIO e ()) + -> RIO e (Either SomeException s) +restartService vServ sstart kkill = do + logDebug "restartService" + modifyMVar vServ $ \case + Nothing -> doStart + Just sv -> doRestart sv + where + doRestart :: s -> RIO e (Maybe s, Either SomeException s) + doRestart serv = do + logDebug "doStart" + try (kkill serv) >>= \case + Left exn -> pure (Nothing, Left exn) + Right () -> doStart + + doStart :: RIO e (Maybe s, Either SomeException s) + doStart = do + logDebug "doStart" + try sstart <&> \case + Right s -> (Just s, Right s) + Left exn -> (Nothing, Left exn) + +{-| + Stop a running service. Do nothing if it's already stopped. +-} +stopService + :: HasLogFunc e + => MVar (Maybe s) + -> (s -> RIO e ()) + -> RIO e (Either SomeException ()) +stopService vServ kkill = do + logDebug "stopService" + modifyMVar vServ $ \case + Nothing -> pure (Nothing, Right ()) + Just sv -> do + res <- try (kkill sv) + pure (Nothing, res) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs index 7eabdcad8..0e1c85f44 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs @@ -12,8 +12,7 @@ -} module Urbit.Vere.Eyre.Wai - ( ReqId - , RespAct(..) + ( RespAct(..) , RespApi(..) , LiveReqs(..) , ReqInfo(..) @@ -40,8 +39,6 @@ import qualified Network.Wai.Conduit as W -- Types ----------------------------------------------------------------------- -type ReqId = Word64 - data RespAct = RAFull H.Status [H.Header] ByteString | RAHead H.Status [H.Header] ByteString @@ -55,8 +52,8 @@ data RespApi = RespApi } data LiveReqs = LiveReqs - { nextReqId :: ReqId - , activeReqs :: Map ReqId RespApi + { nextReqId :: Word64 + , activeReqs :: Map Word64 (Ship, RespApi) } data ReqInfo = ReqInfo @@ -73,18 +70,21 @@ data ReqInfo = ReqInfo emptyLiveReqs :: LiveReqs emptyLiveReqs = LiveReqs 1 mempty -routeRespAct :: TVar LiveReqs -> ReqId -> RespAct -> STM Bool -routeRespAct vLiv reqId act = +routeRespAct :: Ship -> TVar LiveReqs -> Word64 -> RespAct -> STM Bool +routeRespAct who vLiv reqId act = (lookup reqId . activeReqs <$> readTVar vLiv) >>= \case - Nothing -> pure False - Just tv -> raAct tv act + Nothing -> pure False + Just (own, tv) -> do + if (who == own) + then raAct tv act + else pure False -rmLiveReq :: TVar LiveReqs -> ReqId -> STM () +rmLiveReq :: TVar LiveReqs -> Word64 -> STM () rmLiveReq var reqId = modifyTVar' var $ \liv -> liv { activeReqs = deleteMap reqId (activeReqs liv) } -newLiveReq :: TVar LiveReqs -> STM (ReqId, STM RespAct) -newLiveReq var = do +newLiveReq :: Ship -> TVar LiveReqs -> STM (Word64, STM RespAct) +newLiveReq who var = do liv <- readTVar var tmv <- newTQueue kil <- newEmptyTMVar @@ -99,7 +99,7 @@ newLiveReq var = do } - writeTVar var (LiveReqs (nex + 1) (insertMap nex respApi act)) + writeTVar var (LiveReqs (nex + 1) (insertMap nex (who, respApi) act)) pure (nex, waitAct) @@ -184,21 +184,22 @@ sendResponse cb waitAct = do RAHead s h b -> io $ cb $ W.responseSource s h $ streamBlocks env b waitAct RABloc _ -> noHeader -liveReq :: TVar LiveReqs -> RAcquire e (ReqId, STM RespAct) -liveReq vLiv = mkRAcquire ins del +liveReq :: Ship -> TVar LiveReqs -> RAcquire e (Word64, STM RespAct) +liveReq who vLiv = mkRAcquire ins del where - ins = atomically (newLiveReq vLiv) + ins = atomically (newLiveReq who vLiv) del = atomically . rmLiveReq vLiv . fst app :: HasLogFunc e => e + -> Ship -> TVar LiveReqs - -> (ReqId -> ReqInfo -> STM ()) - -> (ReqId -> STM ()) + -> (Word64 -> ReqInfo -> STM ()) + -> (Word64 -> STM ()) -> W.Application -app env liv inform cancel req respond = - runRIO env $ rwith (liveReq liv) $ \(reqId, respApi) -> do +app env who liv inform cancel req respond = + runRIO env $ rwith (liveReq who liv) $ \(reqId, respApi) -> do bod <- io (toStrict <$> W.strictRequestBody req) met <- maybe (error "bad method") pure (cookMeth req) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 52f956426..abbb906d0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -294,7 +294,7 @@ drivers inst who isFake plan shutdownSTM termSys stderr = where (behnBorn, runBehn) = behn inst plan (amesBorn, runAmes) = ames inst who isFake plan stderr - (httpBorn, runHttp) = eyre inst plan isFake + (httpBorn, runHttp) = eyre inst (error "TODO") who plan isFake (clayBorn, runClay) = clay inst plan (irisBorn, runIris) = client inst plan (termBorn, runTerm) = Term.term termSys shutdownSTM inst plan From f8cd148f0eaebda66123ea2b4d63a2b7f544650a Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Mon, 11 May 2020 13:42:30 -0700 Subject: [PATCH 082/257] king: eyre: Hooked up multi-tenet HTTP. Start-up is a bit hacky. Still totally untested. --- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 105 ++++++++++----- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 104 +-------------- .../urbit-king/lib/Urbit/Vere/Eyre/Multi.hs | 124 ++++++++++++++++++ pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 27 ++-- 4 files changed, 213 insertions(+), 147 deletions(-) create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 064d58a8c..cf1799238 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -82,6 +82,7 @@ import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Dawn import Urbit.Vere.Pier +import Urbit.Vere.Eyre.Multi (multiEyre, MultiEyreApi, MultiEyreConf(..)) import Urbit.Vere.Pier.Types import Urbit.Vere.Serf @@ -169,10 +170,11 @@ tryBootFromPill :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e ) => Bool -> Pill -> Bool -> Serf.Flags -> Ship -> LegacyBootEvent + -> MultiEyreApi -> RIO e () -tryBootFromPill oExit pill lite flags ship boot = do +tryBootFromPill oExit pill lite flags ship boot multi = do mStart <- newEmptyMVar - runOrExitImmediately bootedPier oExit mStart + runOrExitImmediately bootedPier oExit mStart multi where bootedPier = do view pierPathL >>= lockFile @@ -181,14 +183,14 @@ tryBootFromPill oExit pill lite flags ship boot = do rio $ logTrace "Completed boot" pure sls -runOrExitImmediately :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e - , HasConfigDir e - ) - => RAcquire e (Serf e, Log.EventLog, SerfState) - -> Bool - -> MVar () - -> RIO e () -runOrExitImmediately getPier oExit mStart = +runOrExitImmediately + :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e, HasConfigDir e) + => RAcquire e (Serf e, Log.EventLog, SerfState) + -> Bool + -> MVar () + -> MultiEyreApi + -> RIO e () +runOrExitImmediately getPier oExit mStart multi = rwith getPier $ if oExit then shutdownImmediately else runPier where shutdownImmediately (serf, log, ss) = do @@ -203,15 +205,25 @@ runOrExitImmediately getPier oExit mStart = logTrace "Shutdown!" runPier sls = do - runRAcquire $ Pier.pier sls mStart + runRAcquire $ Pier.pier sls mStart multi -tryPlayShip :: ( HasStderrLogFunc e, HasLogFunc e, HasNetworkConfig e - , HasPierConfig e, HasConfigDir e - ) - => Bool -> Bool -> Maybe Word64 -> Serf.Flags -> MVar () -> RIO e () -tryPlayShip exitImmediately fullReplay playFrom flags mStart = do +tryPlayShip + :: ( HasStderrLogFunc e + , HasLogFunc e + , HasNetworkConfig e + , HasPierConfig e + , HasConfigDir e + ) + => Bool + -> Bool + -> Maybe Word64 + -> Serf.Flags + -> MVar () + -> MultiEyreApi + -> RIO e () +tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do when fullReplay wipeSnapshot - runOrExitImmediately resumeShip exitImmediately mStart + runOrExitImmediately resumeShip exitImmediately mStart multi where wipeSnapshot = do shipPath <- view pierPathL @@ -422,7 +434,12 @@ pillFrom (CLI.PillSourceURL url) = do fromNounErr noun & either (throwIO . uncurry ParseErr) pure newShip :: forall e. HasLogFunc e => CLI.New -> CLI.Opts -> RIO e () -newShip CLI.New{..} opts +newShip new opts = do + multi <- multiEyre (MultiEyreConf Nothing Nothing True) -- TODO Hack + newShip' multi new opts + +newShip' :: forall e. HasLogFunc e => MultiEyreApi -> CLI.New -> CLI.Opts -> RIO e () +newShip' multi CLI.New{..} opts | CLI.BootComet <- nBootType = do pill <- pillFrom nPillSource putStrLn "boot: retrieving list of stars currently accepting comets" @@ -493,12 +510,12 @@ newShip CLI.New{..} opts let pierConfig = toPierConfig (pierPath name) opts let networkConfig = toNetworkConfig opts io $ runPierApp pierConfig networkConfig True $ - tryBootFromPill True pill nLite flags ship bootEvent + tryBootFromPill True pill nLite flags ship bootEvent multi ------ tryBootFromPill (CLI.oExit opts) pill nLite flags ship bootEvent -runShip :: CLI.Run -> CLI.Opts -> Bool -> IO () -runShip (CLI.Run pierPath) opts daemon = do +runShip :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> IO () +runShip (CLI.Run pierPath) opts daemon multi = do tid <- myThreadId let onTermExit = throwTo tid UserInterrupt mStart <- newEmptyMVar @@ -518,6 +535,7 @@ runShip (CLI.Run pierPath) opts daemon = do (CLI.oDryFrom opts) (toSerfFlags opts) mStart + multi pierConfig = toPierConfig pierPath opts networkConfig = toNetworkConfig opts @@ -591,12 +609,12 @@ main = do TODO Use logging system instead of printing. -} -runShipRestarting :: STM () -> CLI.Run -> CLI.Opts -> IO () -runShipRestarting waitForKillRequ r o = do +runShipRestarting :: STM () -> CLI.Run -> CLI.Opts -> MultiEyreApi -> IO () +runShipRestarting waitForKillRequ r o multi = do let pier = pack (CLI.rPierPath r) - loop = runShipRestarting waitForKillRequ r o + loop = runShipRestarting waitForKillRequ r o multi - tid <- asyncBound (runShip r o True) + tid <- asyncBound (runShip r o True multi) let onShipExit = Left <$> waitCatchSTM tid onKillRequ = Right <$> waitForKillRequ @@ -615,21 +633,40 @@ runShipRestarting waitForKillRequ r o = do runShips :: CLI.KingOpts -> [(CLI.Run, CLI.Opts, Bool)] -> IO () -runShips CLI.KingOpts {..} = \case - [] -> pure () - [(r, o, d)] -> runShip r o d - ships | sharedHttp -> error "TODO Shared HTTP not yet implemented." - ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) - where sharedHttp = isJust koSharedHttpPort || isJust koSharedHttpsPort +runShips CLI.KingOpts {..} ships = do + let meConf = MultiEyreConf + { mecHttpPort = fromIntegral <$> koSharedHttpPort + , mecHttpsPort = fromIntegral <$> koSharedHttpsPort + , mecLocalhostOnly = False -- TODO Localhost-only needs to be + -- a king-wide option. + } -runMultipleShips :: [(CLI.Run, CLI.Opts)] -> IO () -runMultipleShips ships = do + {- + TODO Need to rework RIO environment to fix this. Should have a + bunch of nested contexts: + + - King has started. King has Id. Logging available. + - In running environment. MultiEyre and global config available. + - In pier environment: pier path and config available. + - In running ship environment: serf state, event queue available. + -} + multi <- runApp (multiEyre meConf) + + go multi ships + where + go me = \case + [] -> pure () + [(r, o, d)] -> runShip r o d me + ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) me + +runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> IO () +runMultipleShips ships multi = do killSignal <- newEmptyTMVarIO let waitForKillRequ = readTMVar killSignal shipThreads <- for ships $ \(r, o) -> do - async (runShipRestarting waitForKillRequ r o) + async (runShipRestarting waitForKillRequ r o multi) {- Since `spin` never returns, this will run until the main diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 1fcc267d7..4b2b34ba9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -4,7 +4,6 @@ module Urbit.Vere.Eyre ( eyre - , multiEyre ) where @@ -15,12 +14,12 @@ import Urbit.King.Config import Urbit.Vere.Eyre.PortsFile import Urbit.Vere.Eyre.Serv import Urbit.Vere.Eyre.Service +import Urbit.Vere.Eyre.Multi import Urbit.Vere.Eyre.Wai import Urbit.Vere.Pier.Types import Data.List.NonEmpty (NonEmpty((:|))) import Data.PEM (pemParseBS, pemWriteBS) -import Network.TLS (Credential) import RIO.Prelude (decodeUtf8Lenient) import System.Random (randomIO) import Urbit.Vere.Http (convertHeaders, unconvertHeaders) @@ -36,9 +35,6 @@ type ReqId = UD newtype Drv = Drv (MVar (Maybe Serv)) -data WhichServer = Secure | Insecure | Loopback - deriving (Eq) - data SockOpts = SockOpts { soLocalhost :: Bool , soWhich :: ServPort @@ -303,101 +299,3 @@ eyre king multi who plan isFake = (initialEvents, runHttpServer) HSEResponse (i, req, _seq, ()) ev -> do logDebug (displayShow ("EYRE", "%response")) execRespActs drv who (fromIntegral req) ev - - --- Multi-Tenet HTTP ------------------------------------------------------------ - -data MultiEyreConf = MultiEyreConf - { mecHttpsPort :: Maybe Port - , mecHttpPort :: Maybe Port - , mecLocalhostOnly :: Bool - } - -type OnMultiReq = WhichServer -> Ship -> Word64 -> ReqInfo -> STM () - -type OnMultiKil = Ship -> Word64 -> STM () - -data MultiEyreApi = MultiEyreApi - { meaConf :: MultiEyreConf - , meaLive :: TVar LiveReqs - , meaPlan :: TVar (Map Ship OnMultiReq) - , meaCanc :: TVar (Map Ship OnMultiKil) - , meaTlsC :: TVar (Map Ship Credential) - , meaKill :: STM () - } - -joinMultiEyre - :: MultiEyreApi - -> Ship - -> Maybe TlsConfig - -> OnMultiReq - -> OnMultiKil - -> STM () -joinMultiEyre api who mTls onReq onKil = do - modifyTVar' (meaPlan api) (insertMap who onReq) - modifyTVar' (meaCanc api) (insertMap who onKil) - for_ mTls $ \tls -> do - configCreds tls & \case - Left err -> pure () - Right cd -> modifyTVar' (meaTlsC api) (insertMap who cd) - -leaveMultiEyre :: MultiEyreApi -> Ship -> STM () -leaveMultiEyre MultiEyreApi {..} who = do - modifyTVar' meaCanc (deleteMap who) - modifyTVar' meaPlan (deleteMap who) - modifyTVar' meaTlsC (deleteMap who) - -multiEyre - :: (HasPierConfig e, HasLogFunc e, HasNetworkConfig e) - => MultiEyreConf - -> RIO e MultiEyreApi -multiEyre conf@MultiEyreConf{..} = do - vLive <- newTVarIO emptyLiveReqs - vPlan <- newTVarIO mempty - vCanc <- newTVarIO (mempty :: Map Ship (Ship -> Word64 -> STM ())) - vTlsC <- newTVarIO mempty - - let host = if mecLocalhostOnly then SHLocalhost else SHAnyHostOk - - let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM () - onReq which who reqId reqInfo = do - plan <- readTVar vPlan - lookup who plan & \case - Nothing -> pure () - Just cb -> cb which who reqId reqInfo - - let onKil :: Ship -> Word64 -> STM () - onKil who reqId = do - canc <- readTVar vCanc - lookup who canc & \case - Nothing -> pure () - Just cb -> cb who reqId - - mIns <- for mecHttpPort $ \por -> serv vLive $ ServConf - { scHost = host - , scPort = SPChoices $ singleton $ fromIntegral por - , scRedi = Nothing -- TODO - , scType = STMultiHttp $ ReqApi - { rcReq = onReq Insecure - , rcKil = onKil - } - } - - mSec <- for mecHttpsPort $ \por -> serv vLive $ ServConf - { scHost = host - , scPort = SPChoices $ singleton $ fromIntegral por - , scRedi = Nothing - , scType = STMultiHttps vTlsC $ ReqApi - { rcReq = onReq Secure - , rcKil = onKil - } - } - - pure $ MultiEyreApi - { meaLive = vLive - , meaPlan = vPlan - , meaCanc = vCanc - , meaTlsC = vTlsC - , meaConf = conf - , meaKill = traverse_ saKil (toList mIns <> toList mSec) - } diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs new file mode 100644 index 000000000..8aca5ab72 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -0,0 +1,124 @@ +{-| + Eyre: Http Server Driver +-} + +module Urbit.Vere.Eyre.Multi + ( WhichServer(..) + , MultiEyreConf(..) + , OnMultiReq + , OnMultiKil + , MultiEyreApi(..) + , joinMultiEyre + , leaveMultiEyre + , multiEyre + ) +where + +import Urbit.Prelude hiding (Builder) + +import Urbit.Arvo hiding (ServerId, reqUrl, secure) +import Urbit.Vere.Eyre.Serv +import Urbit.Vere.Eyre.Wai + +import Network.TLS (Credential) + + +-- Types ----------------------------------------------------------------------- + +data WhichServer = Secure | Insecure | Loopback + deriving (Eq) + +data MultiEyreConf = MultiEyreConf + { mecHttpsPort :: Maybe Port + , mecHttpPort :: Maybe Port + , mecLocalhostOnly :: Bool + } + +type OnMultiReq = WhichServer -> Ship -> Word64 -> ReqInfo -> STM () + +type OnMultiKil = Ship -> Word64 -> STM () + +data MultiEyreApi = MultiEyreApi + { meaConf :: MultiEyreConf + , meaLive :: TVar LiveReqs + , meaPlan :: TVar (Map Ship OnMultiReq) + , meaCanc :: TVar (Map Ship OnMultiKil) + , meaTlsC :: TVar (Map Ship Credential) + , meaKill :: STM () + } + + +-- Multi-Tenet HTTP ------------------------------------------------------------ + +joinMultiEyre + :: MultiEyreApi + -> Ship + -> Maybe TlsConfig + -> OnMultiReq + -> OnMultiKil + -> STM () +joinMultiEyre api who mTls onReq onKil = do + modifyTVar' (meaPlan api) (insertMap who onReq) + modifyTVar' (meaCanc api) (insertMap who onKil) + for_ mTls $ \tls -> do + configCreds tls & \case + Left err -> pure () + Right cd -> modifyTVar' (meaTlsC api) (insertMap who cd) + +leaveMultiEyre :: MultiEyreApi -> Ship -> STM () +leaveMultiEyre MultiEyreApi {..} who = do + modifyTVar' meaCanc (deleteMap who) + modifyTVar' meaPlan (deleteMap who) + modifyTVar' meaTlsC (deleteMap who) + +multiEyre :: HasLogFunc e => MultiEyreConf -> RIO e MultiEyreApi +multiEyre conf@MultiEyreConf{..} = do + vLive <- newTVarIO emptyLiveReqs + vPlan <- newTVarIO mempty + vCanc <- newTVarIO (mempty :: Map Ship (Ship -> Word64 -> STM ())) + vTlsC <- newTVarIO mempty + + let host = if mecLocalhostOnly then SHLocalhost else SHAnyHostOk + + let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM () + onReq which who reqId reqInfo = do + plan <- readTVar vPlan + lookup who plan & \case + Nothing -> pure () + Just cb -> cb which who reqId reqInfo + + let onKil :: Ship -> Word64 -> STM () + onKil who reqId = do + canc <- readTVar vCanc + lookup who canc & \case + Nothing -> pure () + Just cb -> cb who reqId + + mIns <- for mecHttpPort $ \por -> serv vLive $ ServConf + { scHost = host + , scPort = SPChoices $ singleton $ fromIntegral por + , scRedi = Nothing -- TODO + , scType = STMultiHttp $ ReqApi + { rcReq = onReq Insecure + , rcKil = onKil + } + } + + mSec <- for mecHttpsPort $ \por -> serv vLive $ ServConf + { scHost = host + , scPort = SPChoices $ singleton $ fromIntegral por + , scRedi = Nothing + , scType = STMultiHttps vTlsC $ ReqApi + { rcReq = onReq Secure + , rcKil = onKil + } + } + + pure $ MultiEyreApi + { meaLive = vLive + , meaPlan = vPlan + , meaCanc = vCanc + , meaTlsC = vTlsC + , meaConf = conf + , meaKill = traverse_ saKil (toList mIns <> toList mSec) + } diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index abbb906d0..5635bb99e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -24,6 +24,7 @@ import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) import Urbit.Vere.Eyre (eyre) +import Urbit.Vere.Eyre.Multi (MultiEyreApi) import Urbit.Vere.Http.Client (client) import Urbit.Vere.Log (EventLog) import Urbit.Vere.Serf (Serf, SerfState(..), doJob, sStderr) @@ -173,8 +174,9 @@ acquireWorker act = mkRAcquire (async act) cancel pier :: ∀e. (HasConfigDir e, HasLogFunc e, HasNetworkConfig e, HasPierConfig e) => (Serf e, EventLog, SerfState) -> MVar () + -> MultiEyreApi -> RAcquire e () -pier (serf, log, ss) mStart = do +pier (serf, log, ss) mStart multi = do computeQ <- newTQueueIO persistQ <- newTQueueIO executeQ <- newTQueueIO @@ -222,7 +224,7 @@ pier (serf, log, ss) mStart = do -- add them. let showErr = atomically . Term.trace muxed . (flip append "\r\n") let (bootEvents, startDrivers) = - drivers inst ship (isFake logId) + drivers inst multi ship (isFake logId) (writeTQueue computeQ) shutdownEvent (Term.TSize{tsWide=80, tsTall=24}, muxed) @@ -283,18 +285,23 @@ data Drivers e = Drivers , dTerm :: EffCb e TermEf } -drivers :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e) - => KingId -> Ship -> Bool -> (Ev -> STM ()) - -> STM() - -> (Term.TSize, Term.Client) - -> (Text -> RIO e ()) - -> ([Ev], RAcquire e (Drivers e)) -drivers inst who isFake plan shutdownSTM termSys stderr = +drivers + :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e) + => KingId + -> MultiEyreApi + -> Ship + -> Bool + -> (Ev -> STM ()) + -> STM () + -> (Term.TSize, Term.Client) + -> (Text -> RIO e ()) + -> ([Ev], RAcquire e (Drivers e)) +drivers inst multi who isFake plan shutdownSTM termSys stderr = (initialEvents, runDrivers) where (behnBorn, runBehn) = behn inst plan (amesBorn, runAmes) = ames inst who isFake plan stderr - (httpBorn, runHttp) = eyre inst (error "TODO") who plan isFake + (httpBorn, runHttp) = eyre inst multi who plan isFake (clayBorn, runClay) = clay inst plan (irisBorn, runIris) = client inst plan (termBorn, runTerm) = Term.term termSys shutdownSTM inst plan From 67245e9052d0934247c5ef301c25047f021c0e4f Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Tue, 12 May 2020 12:45:39 -0700 Subject: [PATCH 083/257] king: eyre: Got multi-tenet HTTP working. --- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 15 ++++--- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 4 +- .../urbit-king/lib/Urbit/Vere/Eyre/Multi.hs | 45 +++++++++++-------- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs | 30 +++++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs | 7 +-- 5 files changed, 58 insertions(+), 43 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index cf1799238..224f67d7c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -91,6 +91,7 @@ import Control.Exception (AsyncException(UserInterrupt)) import Control.Lens ((&)) import System.Process (system) import Text.Show.Pretty (pPrint) +import Urbit.King.App (App) import Urbit.King.App (runApp, runAppLogFile, runAppNoLog, runPierApp) import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) import Urbit.Noun.Conversions (cordToUW) @@ -514,8 +515,8 @@ newShip' multi CLI.New{..} opts ------ tryBootFromPill (CLI.oExit opts) pill nLite flags ship bootEvent -runShip :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> IO () -runShip (CLI.Run pierPath) opts daemon multi = do +runShip :: MonadIO m => CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> m () +runShip (CLI.Run pierPath) opts daemon multi = io $ do tid <- myThreadId let onTermExit = throwTo tid UserInterrupt mStart <- newEmptyMVar @@ -588,7 +589,7 @@ main = do Sys.installHandler Sys.sigINT (Sys.Catch onKillSig) Nothing CLI.parseArgs >>= \case - CLI.CmdRun ko ships -> runShips ko ships + CLI.CmdRun ko ships -> runApp $ runShips ko ships CLI.CmdNew n o -> runApp $ newShip n o CLI.CmdBug (CLI.CollectAllFX pax) -> runApp $ collectAllFx pax CLI.CmdBug (CLI.EventBrowser pax) -> runApp $ startBrowser pax @@ -632,7 +633,7 @@ runShipRestarting waitForKillRequ r o multi = do putStrLn ("Ship terminated: " <> pier) -runShips :: CLI.KingOpts -> [(CLI.Run, CLI.Opts, Bool)] -> IO () +runShips :: CLI.KingOpts -> [(CLI.Run, CLI.Opts, Bool)] -> RIO App () runShips CLI.KingOpts {..} ships = do let meConf = MultiEyreConf { mecHttpPort = fromIntegral <$> koSharedHttpPort @@ -650,7 +651,7 @@ runShips CLI.KingOpts {..} ships = do - In pier environment: pier path and config available. - In running ship environment: serf state, event queue available. -} - multi <- runApp (multiEyre meConf) + multi <- multiEyre meConf go multi ships where @@ -659,8 +660,8 @@ runShips CLI.KingOpts {..} ships = do [(r, o, d)] -> runShip r o d me ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) me -runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> IO () -runMultipleShips ships multi = do +runMultipleShips :: MonadIO m => [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> m () +runMultipleShips ships multi = io $ do killSignal <- newEmptyTMVarIO let waitForKillRequ = readTMVar killSignal diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 4b2b34ba9..4eb65288c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -174,6 +174,8 @@ startServ startServ multi who isFake conf plan = do logTrace "startServ" + let vLive = meaLive multi + srvId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32) let mTls = hscSecure conf >>= parseTlsConfig @@ -191,8 +193,6 @@ startServ multi who isFake conf plan = do let soHost :: SockOpts -> ServHost soHost so = if soLocalhost so then SHLocalhost else SHAnyHostOk - vLive <- newTVarIO emptyLiveReqs - let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM () onReq which _ship reqId reqInfo = plan (requestEvent srvId which reqId reqInfo) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs index 8aca5ab72..a1d77aa44 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -33,6 +33,7 @@ data MultiEyreConf = MultiEyreConf , mecHttpPort :: Maybe Port , mecLocalhostOnly :: Bool } + deriving (Show) type OnMultiReq = WhichServer -> Ship -> Word64 -> ReqInfo -> STM () @@ -72,7 +73,9 @@ leaveMultiEyre MultiEyreApi {..} who = do modifyTVar' meaTlsC (deleteMap who) multiEyre :: HasLogFunc e => MultiEyreConf -> RIO e MultiEyreApi -multiEyre conf@MultiEyreConf{..} = do +multiEyre conf@MultiEyreConf {..} = do + logTrace (displayShow ("EYRE", "MULTI", conf)) + vLive <- newTVarIO emptyLiveReqs vPlan <- newTVarIO mempty vCanc <- newTVarIO (mempty :: Map Ship (Ship -> Word64 -> STM ())) @@ -94,25 +97,29 @@ multiEyre conf@MultiEyreConf{..} = do Nothing -> pure () Just cb -> cb who reqId - mIns <- for mecHttpPort $ \por -> serv vLive $ ServConf - { scHost = host - , scPort = SPChoices $ singleton $ fromIntegral por - , scRedi = Nothing -- TODO - , scType = STMultiHttp $ ReqApi - { rcReq = onReq Insecure - , rcKil = onKil - } - } + mIns <- for mecHttpPort $ \por -> do + logTrace (displayShow ("EYRE", "MULTI", "HTTP", por)) + serv vLive $ ServConf + { scHost = host + , scPort = SPChoices $ singleton $ fromIntegral por + , scRedi = Nothing -- TODO + , scType = STMultiHttp $ ReqApi + { rcReq = onReq Insecure + , rcKil = onKil + } + } - mSec <- for mecHttpsPort $ \por -> serv vLive $ ServConf - { scHost = host - , scPort = SPChoices $ singleton $ fromIntegral por - , scRedi = Nothing - , scType = STMultiHttps vTlsC $ ReqApi - { rcReq = onReq Secure - , rcKil = onKil - } - } + mSec <- for mecHttpsPort $ \por -> do + logTrace (displayShow ("EYRE", "MULTI", "HTTPS", por)) + serv vLive $ ServConf + { scHost = host + , scPort = SPChoices $ singleton $ fromIntegral por + , scRedi = Nothing + , scType = STMultiHttps (MTC vTlsC) $ ReqApi + { rcReq = onReq Secure + , rcKil = onKil + } + } pure $ MultiEyreApi { meaLive = vLive diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs index 0b3cd2e25..ea78833f9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -21,7 +21,7 @@ module Urbit.Vere.Eyre.Serv ( ServApi(..) , TlsConfig(..) - , MultiTlsConfig + , MultiTlsConfig(..) , ReqApi(..) , ServType(..) , ServPort(..) @@ -61,27 +61,37 @@ data TlsConfig = TlsConfig , tcCerti :: ByteString , tcChain :: [ByteString] } + deriving (Show) -type MultiTlsConfig = TVar (Map Ship Credential) +newtype MultiTlsConfig = MTC (TVar (Map Ship Credential)) + +instance Show MultiTlsConfig where + show = const "MultiTlsConfig" data ReqApi = ReqApi { rcReq :: Ship -> Word64 -> E.ReqInfo -> STM () , rcKil :: Ship -> Word64 -> STM () } +instance Show ReqApi where + show = const "ReqApi" + data ServType = STHttp Ship ReqApi | STHttps Ship TlsConfig ReqApi | STMultiHttp ReqApi | STMultiHttps MultiTlsConfig ReqApi + deriving (Show) data ServPort = SPAnyPort | SPChoices (NonEmpty W.Port) + deriving (Show) data ServHost = SHLocalhost | SHAnyHostOk + deriving (Show) data ServConf = ServConf { scType :: ServType @@ -89,6 +99,7 @@ data ServConf = ServConf , scPort :: ServPort , scRedi :: Maybe W.Port } + deriving (Show) -- Opening Sockets ------------------------------------------------------------- @@ -179,6 +190,7 @@ forceOpenSocket hos por = mkRAcquire opn kil kil = io . Net.close . snd opn = do + logTrace (displayShow ("EYRE", "SERV", "forceOpenSocket", hos, por)) (p, s) <- retry $ case por of SPAnyPort -> tryOpenAny bind SPChoices ps -> tryOpenChoices bind ps @@ -202,8 +214,8 @@ hostShip (Just bs) = byteShip (hedLabel bs) & \case bytePatp = Ob.parsePatp . decodeUtf8Lenient hedLabel = fst . break (== fromIntegral (C.ord '.')) -onSniHdr :: TVar (Map Ship Credential) -> Maybe String -> IO Credentials -onSniHdr mtls mHos = do +onSniHdr :: MultiTlsConfig -> Maybe String -> IO Credentials +onSniHdr (MTC mtls) mHos = do ship <- hostShip (encodeUtf8 . pack <$> mHos) tabl <- atomically (readTVar mtls) tcfg <- lookup ship tabl & maybe (notRunning ship) pure @@ -271,14 +283,13 @@ configCreds TlsConfig {..} = Right rs -> Right rs serv :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi -serv vLive ServConf {..} = do +serv vLive conf@ServConf {..} = do + logTrace (displayShow ("EYRE", "SERV", "Start", conf)) kil <- newEmptyTMVarIO por <- newEmptyTMVarIO - void $ async $ do - tid <- async (runServ por) - atomically (takeTMVar kil) - cancel tid + tid <- async (runServ por) + _ <- async (atomically (takeTMVar kil) >> cancel tid) pure $ ServApi { saKil = void (tryPutTMVar kil ()) @@ -286,6 +297,7 @@ serv vLive ServConf {..} = do } where runServ vPort = do + logTrace (displayShow ("EYRE", "SERV", "runServ")) rwith (forceOpenSocket scHost scPort) $ \(por, sok) -> do atomically (putTMVar vPort por) startServer scType scHost por sok scRedi vLive diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs index 0e1c85f44..b45b94ac5 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs @@ -136,11 +136,6 @@ noHeader = do logError "Response block with no response header." error "Bad HttpEvent: Response block with no response header." -emptyChunk :: HasLogFunc e => RIO e a -emptyChunk = do - logError "Bad response action: empty chunk" - error "Bad response action: empty chunk" - dupHead :: HasLogFunc e => RIO e a dupHead = do logError "Multiple %head actions on one request" @@ -165,7 +160,7 @@ streamBlocks env init getAct = send init >> loop RADone -> pure () RABloc c -> send c >> loop - send "" = runRIO env emptyChunk + send "" = pure () send c = do runRIO env (logTrace (display ("sending chunk " <> tshow c))) yield $ Chunk $ fromByteString c From ba705694bdfc52738a85a0e6b6fb8e499db10597 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Tue, 12 May 2020 15:43:09 -0700 Subject: [PATCH 084/257] king: eyre: [WIP] Got multi-tenet HTTPS working. --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs | 18 ++++++++++-------- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 18 ++++++++++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs | 8 +++----- 3 files changed, 27 insertions(+), 17 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs index c22df009f..a1ae17ca0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs @@ -97,15 +97,14 @@ forceBind por hos = go -} sendPacket :: HasLogFunc e => ByteString -> SockAddr -> Socket -> RIO e Bool sendPacket fullBytes adr sok = do - logTrace ("AMES: UDP: Sending packet") + logTrace $ displayShow ("AMES", "UDP", "Sending packet.") res <- io $ tryIOError $ go fullBytes case res of Left err -> do - logError $ display ("AMES: UDP: " <> tshow err) - logError "AMES: UDP: Failed to send packet" + logError $ displayShow ("AMES", "UDP", "Failed to send packet", err) pure False Right () -> do - logError "AMES: UDP: Packet sent" + logTrace $ displayShow ("AMES", "UDP", "Packet sent.") pure True where go byt = do @@ -138,7 +137,7 @@ recvPacket sok = do -} fakeUdpServ :: HasLogFunc e => RIO e UdpServ fakeUdpServ = do - logTrace "AMES: UDP: \"Starting\" fake UDP server." + logTrace $ displayShow ("AMES", "UDP", "\"Starting\" fake UDP server.") pure UdpServ { .. } where usSend = \_ _ -> pure () @@ -154,7 +153,7 @@ fakeUdpServ = do realUdpServ :: forall e . HasLogFunc e => PortNumber -> HostAddress -> RIO e UdpServ realUdpServ por hos = do - logTrace "AMES: UDP: Starting real UDP server." + logTrace $ displayShow ("AMES", "UDP", "Starting real UDP server.") env <- ask @@ -174,7 +173,9 @@ realUdpServ por hos = do -} let signalBrokenSocket :: Socket -> RIO e () signalBrokenSocket sock = do - logTrace "AMES: UDP: Socket broken. Requesting new socket" + logTrace $ displayShow ("AMES", "UDP" + , "Socket broken. Requesting new socket" + ) atomically $ do mSock <- readTVar vSock mFail <- tryReadTMVar vFail @@ -186,7 +187,8 @@ realUdpServ por hos = do enqueueRecvPacket p a b = do did <- atomically (tryWriteTBQueue qRecv (p, a, b)) when (did == False) $ do - logWarn "AMES: UDP: Dropping inbound packet because queue is full." + logWarn $ displayShow $ ("AMES", "UDP",) + "Dropping inbound packet because queue is full." enqueueSendPacket :: SockAddr -> ByteString -> RIO e () enqueueSendPacket a b = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 4eb65288c..a0117ccca 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -172,7 +172,7 @@ startServ -> (Ev -> STM ()) -> RIO e Serv startServ multi who isFake conf plan = do - logTrace "startServ" + logTrace (displayShow ("EYRE", "startServ")) let vLive = meaLive multi @@ -180,6 +180,14 @@ startServ multi who isFake conf plan = do let mTls = hscSecure conf >>= parseTlsConfig + mCre <- mTls & \case + Nothing -> pure Nothing + Just tc -> configCreds tc & \case + Right rs -> pure (Just rs) + Left err -> do + logError "Couldn't Load TLS Credentials." + pure Nothing + ptt <- httpServerPorts isFake {- @@ -200,9 +208,11 @@ startServ multi who isFake conf plan = do let onKilReq :: Ship -> Word64 -> STM () onKilReq _ship = plan . cancelEv srvId . fromIntegral - atomically (joinMultiEyre multi who mTls onReq onKilReq) + logTrace (displayShow ("EYRE", "joinMultiEyre", who, mTls, mCre)) - logTrace "Starting loopback server" + atomically (joinMultiEyre multi who mCre onReq onKilReq) + + logTrace $ displayShow ("EYRE", "Starting loopback server") lop <- serv vLive $ ServConf { scHost = soHost (pttLop ptt) , scPort = soWhich (pttLop ptt) @@ -213,7 +223,7 @@ startServ multi who isFake conf plan = do } } - logTrace "Starting insecure server" + logTrace $ displayShow ("EYRE", "Starting insecure server") ins <- serv vLive $ ServConf { scHost = soHost (pttIns ptt) , scPort = soWhich (pttIns ptt) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs index a1d77aa44..9dda60349 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -54,17 +54,15 @@ data MultiEyreApi = MultiEyreApi joinMultiEyre :: MultiEyreApi -> Ship - -> Maybe TlsConfig + -> Maybe Credential -> OnMultiReq -> OnMultiKil -> STM () joinMultiEyre api who mTls onReq onKil = do modifyTVar' (meaPlan api) (insertMap who onReq) modifyTVar' (meaCanc api) (insertMap who onKil) - for_ mTls $ \tls -> do - configCreds tls & \case - Left err -> pure () - Right cd -> modifyTVar' (meaTlsC api) (insertMap who cd) + for_ mTls $ \creds -> do + modifyTVar' (meaTlsC api) (insertMap who creds) leaveMultiEyre :: MultiEyreApi -> Ship -> STM () leaveMultiEyre MultiEyreApi {..} who = do From 4ebf2764301fdd5b980b40f32592d2f66384b994 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Tue, 12 May 2020 16:55:49 -0700 Subject: [PATCH 085/257] king: Flags to disable HTTP/HTTPS/UDP per-ship. --- pkg/hs/urbit-king/lib/Urbit/King/CLI.hs | 21 +++++++++++++++ pkg/hs/urbit-king/lib/Urbit/King/Config.hs | 3 +++ pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 3 +++ pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 17 ++++++------ pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 6 +++++ .../urbit-king/lib/Urbit/Vere/Eyre/Multi.hs | 2 ++ pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs | 27 ++++++++++++++++--- 7 files changed, 68 insertions(+), 11 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs index 8a12c0146..bf8026820 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs @@ -29,6 +29,9 @@ data Opts = Opts , oDryFrom :: Maybe Word64 , oVerbose :: Bool , oAmesPort :: Maybe Word16 + , oNoAmes :: Bool + , oNoHttp :: Bool + , oNoHttps :: Bool , oTrace :: Bool , oCollectFx :: Bool , oLocalhost :: Bool @@ -227,6 +230,24 @@ opts = do <> help "Ames port" <> hidden + oNoAmes <- + switch + $ long "no-ames" + <> help "Run with Ames disabled." + <> hidden + + oNoHttp <- + switch + $ long "no-http" + <> help "Run with HTTP disabled." + <> hidden + + oNoHttps <- + switch + $ long "no-https" + <> help "Run with HTTPS disabled." + <> hidden + oHttpPort <- optional $ option auto diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs index 9292eb7ba..9fa95ae87 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs @@ -36,6 +36,9 @@ data NetMode data NetworkConfig = NetworkConfig { _ncNetMode :: NetMode , _ncAmesPort :: Maybe Word16 + , _ncNoAmes :: Bool + , _ncNoHttp :: Bool + , _ncNoHttps :: Bool , _ncHttpPort :: Maybe Word16 , _ncHttpsPort :: Maybe Word16 , _ncLocalPort :: Maybe Word16 diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 224f67d7c..e65d831e0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -165,6 +165,9 @@ toNetworkConfig CLI.Opts {..} = NetworkConfig { .. } _ncHttpPort = oHttpPort _ncHttpsPort = oHttpsPort _ncLocalPort = oLoopbackPort + _ncNoAmes = oNoAmes + _ncNoHttp = oNoHttp + _ncNoHttps = oNoHttps tryBootFromPill :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e , HasConfigDir e, HasStderrLogFunc e diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index dcccb18f6..7ee6e9759 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -70,14 +70,15 @@ hearEv p a bs = -------------------------------------------------------------------------------- netMode :: HasNetworkConfig e => Bool -> RIO e NetworkMode -netMode True = pure Fake -netMode False = view (networkConfigL . ncNetMode . to cvt) - where - cvt :: NetMode -> NetworkMode - cvt = \case - NMNormal -> Real - NMLocalhost -> Localhost - NMNone -> NoNetwork +netMode isFake = do + netMode <- view (networkConfigL . ncNetMode) + noAmes <- view (networkConfigL . ncNoAmes) + pure $ case (noAmes, isFake, netMode) of + (True, _ , _ ) -> NoNetwork + (_ , _ , NMNone ) -> NoNetwork + (_ , True, _ ) -> Fake + (_ , _ , NMNormal ) -> Real + (_ , _ , NMLocalhost) -> Localhost udpPort :: Bool -> Ship -> HasNetworkConfig e => RIO e PortNumber udpPort isFake who = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index a0117ccca..914d5a472 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -201,6 +201,9 @@ startServ multi who isFake conf plan = do let soHost :: SockOpts -> ServHost soHost so = if soLocalhost so then SHLocalhost else SHAnyHostOk + noHttp <- view (networkConfigL . ncNoHttp) + noHttps <- view (networkConfigL . ncNoHttps) + let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM () onReq which _ship reqId reqInfo = plan (requestEvent srvId which reqId reqInfo) @@ -217,6 +220,7 @@ startServ multi who isFake conf plan = do { scHost = soHost (pttLop ptt) , scPort = soWhich (pttLop ptt) , scRedi = Nothing + , scFake = False , scType = STHttp who $ ReqApi { rcReq = onReq Loopback , rcKil = onKilReq @@ -228,6 +232,7 @@ startServ multi who isFake conf plan = do { scHost = soHost (pttIns ptt) , scPort = soWhich (pttIns ptt) , scRedi = secRedi + , scFake = noHttp , scType = STHttp who $ ReqApi { rcReq = onReq Insecure , rcKil = onKilReq @@ -240,6 +245,7 @@ startServ multi who isFake conf plan = do { scHost = soHost (pttSec ptt) , scPort = soWhich (pttSec ptt) , scRedi = Nothing + , scFake = noHttps , scType = STHttps who tls $ ReqApi { rcReq = onReq Secure , rcKil = onKilReq diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs index 9dda60349..9580c8a6b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -101,6 +101,7 @@ multiEyre conf@MultiEyreConf {..} = do { scHost = host , scPort = SPChoices $ singleton $ fromIntegral por , scRedi = Nothing -- TODO + , scFake = False , scType = STMultiHttp $ ReqApi { rcReq = onReq Insecure , rcKil = onKil @@ -113,6 +114,7 @@ multiEyre conf@MultiEyreConf {..} = do { scHost = host , scPort = SPChoices $ singleton $ fromIntegral por , scRedi = Nothing + , scFake = False , scType = STMultiHttps (MTC vTlsC) $ ReqApi { rcReq = onReq Secure , rcKil = onKil diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs index ea78833f9..cf8d5e134 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -29,6 +29,7 @@ module Urbit.Vere.Eyre.Serv , ServConf(..) , configCreds , serv + , fakeServ ) where @@ -98,6 +99,7 @@ data ServConf = ServConf , scHost :: ServHost , scPort :: ServPort , scRedi :: Maybe W.Port + , scFake :: Bool } deriving (Show) @@ -282,9 +284,22 @@ configCreds TlsConfig {..} = Left str -> Left (pack str) Right rs -> Right rs -serv :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi -serv vLive conf@ServConf {..} = do - logTrace (displayShow ("EYRE", "SERV", "Start", conf)) +fakeServ :: HasLogFunc e => ServConf -> RIO e ServApi +fakeServ conf = do + let por = fakePort (scPort conf) + logTrace (displayShow ("EYRE", "SERV", "Running Fake Server", por)) + pure $ ServApi + { saKil = pure () + , saPor = pure por + } + where + fakePort :: ServPort -> W.Port + fakePort SPAnyPort = 55555 + fakePort (SPChoices (x :| _)) = x + +realServ :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi +realServ vLive conf@ServConf {..} = do + logTrace (displayShow ("EYRE", "SERV", "Running Real Server")) kil <- newEmptyTMVarIO por <- newEmptyTMVarIO @@ -301,3 +316,9 @@ serv vLive conf@ServConf {..} = do rwith (forceOpenSocket scHost scPort) $ \(por, sok) -> do atomically (putTMVar vPort por) startServer scType scHost por sok scRedi vLive + +serv :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi +serv vLive conf = do + if scFake conf + then fakeServ conf + else realServ vLive conf From b749017564655761f50e3b5a0692af03772f1b8f Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Tue, 12 May 2020 17:07:30 -0700 Subject: [PATCH 086/257] king: eyre: [WIP] Got multi-tenet HTTPS working. --- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 2 +- .../urbit-king/lib/Urbit/Vere/Eyre/Multi.hs | 4 +-- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs | 32 +++++++++++++++---- 3 files changed, 28 insertions(+), 10 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 914d5a472..8b67dd6b9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -183,7 +183,7 @@ startServ multi who isFake conf plan = do mCre <- mTls & \case Nothing -> pure Nothing Just tc -> configCreds tc & \case - Right rs -> pure (Just rs) + Right rs -> pure (Just (tc, rs)) Left err -> do logError "Couldn't Load TLS Credentials." pure Nothing diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs index 9580c8a6b..b93bb67b5 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -44,7 +44,7 @@ data MultiEyreApi = MultiEyreApi , meaLive :: TVar LiveReqs , meaPlan :: TVar (Map Ship OnMultiReq) , meaCanc :: TVar (Map Ship OnMultiKil) - , meaTlsC :: TVar (Map Ship Credential) + , meaTlsC :: TVar (Map Ship (TlsConfig, Credential)) , meaKill :: STM () } @@ -54,7 +54,7 @@ data MultiEyreApi = MultiEyreApi joinMultiEyre :: MultiEyreApi -> Ship - -> Maybe Credential + -> Maybe (TlsConfig, Credential) -> OnMultiReq -> OnMultiKil -> STM () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs index cf8d5e134..9fd642395 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -41,6 +41,7 @@ import Network.TLS (Credential, Credentials(..), ServerHooks(..)) import Network.TLS (credentialLoadX509ChainFromMemory) import RIO.Prelude (decodeUtf8Lenient) +import qualified Control.Monad.STM as STM import qualified Data.Char as C import qualified Network.Socket as Net import qualified Network.Wai as W @@ -64,7 +65,7 @@ data TlsConfig = TlsConfig } deriving (Show) -newtype MultiTlsConfig = MTC (TVar (Map Ship Credential)) +newtype MultiTlsConfig = MTC (TVar (Map Ship (TlsConfig, Credential))) instance Show MultiTlsConfig where show = const "MultiTlsConfig" @@ -216,11 +217,15 @@ hostShip (Just bs) = byteShip (hedLabel bs) & \case bytePatp = Ob.parsePatp . decodeUtf8Lenient hedLabel = fst . break (== fromIntegral (C.ord '.')) -onSniHdr :: MultiTlsConfig -> Maybe String -> IO Credentials -onSniHdr (MTC mtls) mHos = do - ship <- hostShip (encodeUtf8 . pack <$> mHos) +onSniHdr + :: HasLogFunc e => e -> MultiTlsConfig -> Maybe String -> IO Credentials +onSniHdr env (MTC mtls) mHos = do tabl <- atomically (readTVar mtls) - tcfg <- lookup ship tabl & maybe (notRunning ship) pure + runRIO env $ logTrace $ displayShow $ ("EYRE", "HTTPS", "SNI", tabl, mHos) + ship <- hostShip (encodeUtf8 . pack <$> mHos) + runRIO env $ logTrace $ displayShow $ ("EYRE", "HTTPS", "SNI", ship) + tcfg <- lookup ship tabl & maybe (notRunning ship) (pure . snd) + runRIO env $ logTrace $ displayShow $ ("EYRE", "HTTPS", "SNI", tcfg) pure (Credentials [tcfg]) where notRunning ship = error ("Ship not running: ~" <> show ship) @@ -267,10 +272,16 @@ startServer typ hos por sok red vLive = do io (W.runSettingsSocket opts sok app) STMultiHttps mtls api -> do - let sni = def { onServerNameIndication = onSniHdr mtls } - let tls = W.defaultTlsSettings { W.tlsServerHooks = sni } + TlsConfig {..} <- atomically (getFirstTlsConfig mtls) + + let sni = def { onServerNameIndication = onSniHdr envir mtls } + + let tls = (W.tlsSettingsChainMemory tcCerti tcChain tcPrKey) { W.tlsServerHooks = sni } + let app = \req resp -> do + runRIO envir $ logTrace $ displayShow ("EYRE", "HTTPS", "REQ") who <- reqShip req + runRIO envir $ logTrace $ displayShow ("EYRE", "HTTPS", "REQ", who) runAppl who (rcReq api who) (rcKil api who) req resp io (W.runTLSSocket tls opts sok app) @@ -297,6 +308,13 @@ fakeServ conf = do fakePort SPAnyPort = 55555 fakePort (SPChoices (x :| _)) = x +getFirstTlsConfig :: MultiTlsConfig -> STM TlsConfig +getFirstTlsConfig (MTC var) = do + map <- readTVar var + case toList map of + [] -> STM.retry + x:_ -> pure (fst x) + realServ :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi realServ vLive conf@ServConf {..} = do logTrace (displayShow ("EYRE", "SERV", "Running Real Server")) From ba4b9e7fdfb86b8cff4bdd37575a5379967b7ea0 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Wed, 13 May 2020 11:29:50 -0700 Subject: [PATCH 087/257] king: Use same logger from all contexts. --- pkg/hs/urbit-king/lib/Urbit/King/App.hs | 46 ++----- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 116 ++++++++++-------- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs | 54 +++++--- 3 files changed, 113 insertions(+), 103 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs index edef869b5..0eda0b41f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs @@ -3,7 +3,7 @@ -} module Urbit.King.App ( App - , runApp + , runAppStderr , runAppLogFile , runAppNoLog , runPierApp @@ -39,8 +39,8 @@ instance HasLogFunc App where instance HasStderrLogFunc App where stderrLogFuncL = appStderrLogFunc -runApp :: RIO App a -> IO a -runApp inner = do +runAppStderr :: RIO App a -> IO a +runAppStderr inner = do logOptions <- logOptionsHandle stderr True <&> setLogUseTime True <&> setLogUseLoc False @@ -105,36 +105,14 @@ instance HasNetworkConfig PierApp where instance HasConfigDir PierApp where configDirL = pierAppPierConfig . pcPierPath -runPierApp :: PierConfig -> NetworkConfig -> Bool -> RIO PierApp a -> IO a -runPierApp pierConfig networkConfig daemon inner = - if daemon - then execStderr - else withLogFileHandle execFile - where - execStderr = do - logOptions <- logOptionsHandle stderr True - <&> setLogUseTime True - <&> setLogUseLoc False +runPierApp :: PierConfig -> NetworkConfig -> RIO PierApp a -> RIO App a +runPierApp pierConfig networkConfig action = do + app <- ask - withLogFunc logOptions $ \logFunc -> - go $ PierApp { _pierAppLogFunc = logFunc - , _pierAppStderrLogFunc = logFunc - , _pierAppPierConfig = pierConfig - , _pierAppNetworkConfig = networkConfig - } + let pierApp = PierApp { _pierAppLogFunc = app ^. logFuncL + , _pierAppStderrLogFunc = app ^. stderrLogFuncL + , _pierAppPierConfig = pierConfig + , _pierAppNetworkConfig = networkConfig + } - execFile logHandle = do - logOptions <- logOptionsHandle logHandle True - <&> setLogUseTime True - <&> setLogUseLoc False - logStderrOptions <- logOptionsHandle stderr True - <&> setLogUseTime False - <&> setLogUseLoc False - withLogFunc logStderrOptions $ \logStderr -> - withLogFunc logOptions $ \logFunc -> - go $ PierApp { _pierAppLogFunc = logFunc - , _pierAppStderrLogFunc = logStderr - , _pierAppPierConfig = pierConfig - , _pierAppNetworkConfig = networkConfig - } - go app = runRIO app inner + io (runRIO pierApp action) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index e65d831e0..da58fb7cd 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -92,7 +92,7 @@ import Control.Lens ((&)) import System.Process (system) import Text.Show.Pretty (pPrint) import Urbit.King.App (App) -import Urbit.King.App (runApp, runAppLogFile, runAppNoLog, runPierApp) +import Urbit.King.App (runAppLogFile, runAppStderr, runPierApp) import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) import Urbit.Noun.Conversions (cordToUW) import Urbit.Time (Wen) @@ -437,14 +437,22 @@ pillFrom (CLI.PillSourceURL url) = do noun <- cueBS body & either throwIO pure fromNounErr noun & either (throwIO . uncurry ParseErr) pure -newShip :: forall e. HasLogFunc e => CLI.New -> CLI.Opts -> RIO e () -newShip new opts = do - multi <- multiEyre (MultiEyreConf Nothing Nothing True) -- TODO Hack - newShip' multi new opts +newShip :: CLI.New -> CLI.Opts -> RIO App () +newShip CLI.New{..} opts = do + {- + TODO XXX HACK -newShip' :: forall e. HasLogFunc e => MultiEyreApi -> CLI.New -> CLI.Opts -> RIO e () -newShip' multi CLI.New{..} opts - | CLI.BootComet <- nBootType = do + Because the "new ship" flow *may* automatically start the ship, + we need to create this, but it's not actually correct. + + The right solution is to separate out the "new ship" flow from the + "run ship" flow, and possibly sequence them from the outside if + that's really needed. + -} + multi <- multiEyre (MultiEyreConf Nothing Nothing True) + + case nBootType of + CLI.BootComet -> do pill <- pillFrom nPillSource putStrLn "boot: retrieving list of stars currently accepting comets" starList <- dawnCometList @@ -454,14 +462,14 @@ newShip' multi CLI.New{..} opts eny <- io $ Sys.randomIO let seed = mineComet (Set.fromList starList) eny putStrLn ("boot: found comet " ++ renderShip (sShip seed)) - bootFromSeed pill seed + bootFromSeed multi pill seed - | CLI.BootFake name <- nBootType = do + CLI.BootFake name -> do pill <- pillFrom nPillSource ship <- shipFrom name - runTryBootFromPill pill name ship (Fake ship) + runTryBootFromPill multi pill name ship (Fake ship) - | CLI.BootFromKeyfile keyFile <- nBootType = do + CLI.BootFromKeyfile keyFile -> do text <- readFileUtf8 keyFile asAtom <- case cordToUW (Cord $ T.strip text) of Nothing -> error "Couldn't parse keyfile. Hint: keyfiles start with 0w?" @@ -474,10 +482,10 @@ newShip' multi CLI.New{..} opts pill <- pillFrom nPillSource - bootFromSeed pill seed + bootFromSeed multi pill seed where - shipFrom :: Text -> RIO e Ship + shipFrom :: Text -> RIO App Ship shipFrom name = case Ob.parsePatp name of Left x -> error "Invalid ship name" Right p -> pure $ Ship $ fromIntegral $ Ob.fromPatp p @@ -487,7 +495,7 @@ newShip' multi CLI.New{..} opts Just x -> x Nothing -> "./" <> unpack name - nameFromShip :: Ship -> RIO e Text + nameFromShip :: Ship -> RIO App Text nameFromShip s = name where nameWithSig = Ob.renderPatp $ Ob.patp $ fromIntegral s @@ -495,8 +503,8 @@ newShip' multi CLI.New{..} opts Nothing -> error "Urbit.ob didn't produce string with ~" Just x -> pure x - bootFromSeed :: Pill -> Seed -> RIO e () - bootFromSeed pill seed = do + bootFromSeed :: MultiEyreApi -> Pill -> Seed -> RIO App () + bootFromSeed multi pill seed = do ethReturn <- dawnVent seed case ethReturn of @@ -504,23 +512,22 @@ newShip' multi CLI.New{..} opts Right dawn -> do let ship = sShip $ dSeed dawn name <- nameFromShip ship - runTryBootFromPill pill name ship (Dawn dawn) + runTryBootFromPill multi pill name ship (Dawn dawn) flags = toSerfFlags opts -- Now that we have all the information for running an application with a -- PierConfig, do so. - runTryBootFromPill pill name ship bootEvent = do + runTryBootFromPill multi pill name ship bootEvent = do let pierConfig = toPierConfig (pierPath name) opts let networkConfig = toNetworkConfig opts - io $ runPierApp pierConfig networkConfig True $ + runPierApp pierConfig networkConfig $ tryBootFromPill True pill nLite flags ship bootEvent multi ------ tryBootFromPill (CLI.oExit opts) pill nLite flags ship bootEvent - -runShip :: MonadIO m => CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> m () -runShip (CLI.Run pierPath) opts daemon multi = io $ do - tid <- myThreadId +runShip :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO App () +runShip (CLI.Run pierPath) opts daemon multi = do + tid <- io myThreadId let onTermExit = throwTo tid UserInterrupt mStart <- newEmptyMVar if daemon @@ -528,11 +535,11 @@ runShip (CLI.Run pierPath) opts daemon multi = io $ do else do connectionThread <- async $ do readMVar mStart - finally (runAppNoLog $ connTerm pierPath) onTermExit + finally (connTerm pierPath) onTermExit finally (runPier mStart) (cancel connectionThread) where runPier mStart = - runPierApp pierConfig networkConfig daemon $ + runPierApp pierConfig networkConfig $ tryPlayShip (CLI.oExit opts) (CLI.oFullReplay opts) @@ -582,27 +589,39 @@ checkComet = do main :: IO () main = do + args <- CLI.parseArgs + hSetBuffering stdout NoBuffering + setupSignalHandlers + + runApp args $ case args of + CLI.CmdRun ko ships -> runShips ko ships + CLI.CmdNew n o -> newShip n o + CLI.CmdBug (CLI.CollectAllFX pax ) -> collectAllFx pax + CLI.CmdBug (CLI.EventBrowser pax ) -> startBrowser pax + CLI.CmdBug (CLI.ValidatePill pax pil s) -> testPill pax pil s + CLI.CmdBug (CLI.ValidateEvents pax f l) -> checkEvs pax f l + CLI.CmdBug (CLI.ValidateFX pax f l) -> checkFx pax f l + CLI.CmdBug (CLI.ReplayEvents pax l ) -> replayPartEvs pax l + CLI.CmdBug (CLI.CheckDawn pax ) -> checkDawn pax + CLI.CmdBug CLI.CheckComet -> checkComet + CLI.CmdCon pier -> connTerm pier + + where + runApp args | willRunTerminal args = runAppLogFile + runApp args | otherwise = runAppStderr + + setupSignalHandlers = do mainTid <- myThreadId - - hSetBuffering stdout NoBuffering - let onKillSig = throwTo mainTid UserInterrupt + for_ [Sys.sigTERM, Sys.sigINT] $ \sig -> do + Sys.installHandler sig (Sys.Catch onKillSig) Nothing - Sys.installHandler Sys.sigTERM (Sys.Catch onKillSig) Nothing - Sys.installHandler Sys.sigINT (Sys.Catch onKillSig) Nothing - - CLI.parseArgs >>= \case - CLI.CmdRun ko ships -> runApp $ runShips ko ships - CLI.CmdNew n o -> runApp $ newShip n o - CLI.CmdBug (CLI.CollectAllFX pax) -> runApp $ collectAllFx pax - CLI.CmdBug (CLI.EventBrowser pax) -> runApp $ startBrowser pax - CLI.CmdBug (CLI.ValidatePill pax pil s) -> runApp $ testPill pax pil s - CLI.CmdBug (CLI.ValidateEvents pax f l) -> runApp $ checkEvs pax f l - CLI.CmdBug (CLI.ValidateFX pax f l) -> runApp $ checkFx pax f l - CLI.CmdBug (CLI.ReplayEvents pax l) -> runApp $ replayPartEvs pax l - CLI.CmdBug (CLI.CheckDawn pax) -> runApp $ checkDawn pax - CLI.CmdBug CLI.CheckComet -> runApp $ checkComet - CLI.CmdCon pier -> runAppLogFile $ connTerm pier + willRunTerminal :: CLI.Cmd -> Bool + willRunTerminal = \case + CLI.CmdCon _ -> True + CLI.CmdRun ko [(_,_,daemon)] -> not daemon + CLI.CmdRun ko _ -> False + _ -> False {- @@ -613,7 +632,7 @@ main = do TODO Use logging system instead of printing. -} -runShipRestarting :: STM () -> CLI.Run -> CLI.Opts -> MultiEyreApi -> IO () +runShipRestarting :: STM () -> CLI.Run -> CLI.Opts -> MultiEyreApi -> RIO App () runShipRestarting waitForKillRequ r o multi = do let pier = pack (CLI.rPierPath r) loop = runShipRestarting waitForKillRequ r o multi @@ -663,8 +682,8 @@ runShips CLI.KingOpts {..} ships = do [(r, o, d)] -> runShip r o d me ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) me -runMultipleShips :: MonadIO m => [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> m () -runMultipleShips ships multi = io $ do +runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> RIO App () +runMultipleShips ships multi = do killSignal <- newEmptyTMVarIO let waitForKillRequ = readTMVar killSignal @@ -692,8 +711,7 @@ runMultipleShips ships multi = io $ do -------------------------------------------------------------------------------- connTerm :: ∀e. HasLogFunc e => FilePath -> RIO e () -connTerm pier = - Term.runTerminalClient pier +connTerm = Term.runTerminalClient -------------------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs index 9fd642395..a105befae 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -149,11 +149,12 @@ openFreePort hos = do retry :: HasLogFunc e => RIO e (Either IOError a) -> RIO e a retry act = act >>= \case Right res -> pure res - Left exn -> do - logError (displayShow ("EYRE", "Failed to open ports.", exn)) - logError (displayShow ("EYRE", "Waiting 250ms then trying again.")) - threadDelay 250_000 + Left exn -> do + logTr ctx ("Failed to open ports. Waiting 5s, then trying again.", exn) + threadDelay 5_000_000 retry act + where + ctx = ["EYRE", "SERV", "retry"] tryOpenChoices :: HasLogFunc e @@ -176,11 +177,18 @@ tryOpenChoices hos = go tryOpenAny :: HasLogFunc e => String -> RIO e (Either IOError (W.Port, Net.Socket)) tryOpenAny hos = do - logTrace (displayShow ("EYRE", "Asking the OS for any free port.")) + let ctx = ["EYRE", "SERV", "tryOpenAny"] + logTr ctx "Asking the OS for any free port." io (openFreePort hos) >>= \case - Left exn -> pure (Left exn) - Right (p,s) -> do - pure (Right (p,s)) + Left exn -> pure (Left exn) + Right (p, s) -> do + pure (Right (p, s)) + +logTr :: (HasLogFunc e, Show a) => [Text] -> a -> RIO e () +logTr ctx msg = logTrace (prefix <> suffix) + where + prefix = display (concat $ fmap (<> ": ") ctx) + suffix = displayShow msg forceOpenSocket :: forall e @@ -193,11 +201,12 @@ forceOpenSocket hos por = mkRAcquire opn kil kil = io . Net.close . snd opn = do - logTrace (displayShow ("EYRE", "SERV", "forceOpenSocket", hos, por)) + let ctx = ["EYRE", "SERV", "forceOpenSocket"] + logTr ctx (hos, por) (p, s) <- retry $ case por of SPAnyPort -> tryOpenAny bind SPChoices ps -> tryOpenChoices bind ps - rio $ logTrace $ displayShow ("EYRE", "Opened port.", p) + logTr ctx ("Opened port.", p) pure (p, s) bind = case hos of @@ -221,14 +230,15 @@ onSniHdr :: HasLogFunc e => e -> MultiTlsConfig -> Maybe String -> IO Credentials onSniHdr env (MTC mtls) mHos = do tabl <- atomically (readTVar mtls) - runRIO env $ logTrace $ displayShow $ ("EYRE", "HTTPS", "SNI", tabl, mHos) + runRIO env $ logTr ctx (tabl, mHos) ship <- hostShip (encodeUtf8 . pack <$> mHos) - runRIO env $ logTrace $ displayShow $ ("EYRE", "HTTPS", "SNI", ship) + runRIO env $ logTr ctx ship tcfg <- lookup ship tabl & maybe (notRunning ship) (pure . snd) - runRIO env $ logTrace $ displayShow $ ("EYRE", "HTTPS", "SNI", tcfg) + runRIO env $ logTr ctx tcfg pure (Credentials [tcfg]) where notRunning ship = error ("Ship not running: ~" <> show ship) + ctx = ["EYRE", "HTTPS", "SNI"] startServer :: HasLogFunc e @@ -276,15 +286,19 @@ startServer typ hos por sok red vLive = do let sni = def { onServerNameIndication = onSniHdr envir mtls } - let tls = (W.tlsSettingsChainMemory tcCerti tcChain tcPrKey) { W.tlsServerHooks = sni } + let tlsSing = (W.tlsSettingsChainMemory tcCerti tcChain tcPrKey) + let tlsMany = tlsSing { W.tlsServerHooks = sni } - let app = \req resp -> do - runRIO envir $ logTrace $ displayShow ("EYRE", "HTTPS", "REQ") - who <- reqShip req - runRIO envir $ logTrace $ displayShow ("EYRE", "HTTPS", "REQ", who) - runAppl who (rcReq api who) (rcKil api who) req resp + let ctx = ["EYRE", "HTTPS", "REQ"] - io (W.runTLSSocket tls opts sok app) + let + app = \req resp -> do + runRIO envir $ logTr ctx "Got request" + who <- reqShip req + runRIO envir $ logTr ctx ("Parsed HOST", who) + runAppl who (rcReq api who) (rcKil api who) req resp + + io (W.runTLSSocket tlsMany opts sok app) -------------------------------------------------------------------------------- From 66278edd195e8cac2fd73c9e6075dd08aa12c688 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Wed, 13 May 2020 12:06:32 -0700 Subject: [PATCH 088/257] king: Logging cleanup. --- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 73 ++++++++++++------------ 1 file changed, 37 insertions(+), 36 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index da58fb7cd..922ae3ea3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -362,57 +362,57 @@ replayPartEvs top last = do -} testPill :: HasLogFunc e => FilePath -> Bool -> Bool -> RIO e () testPill pax showPil showSeq = do - putStrLn "Reading pill file." + logTrace "Reading pill file." pillBytes <- readFile pax - putStrLn "Cueing pill file." + logTrace "Cueing pill file." pillNoun <- io $ cueBS pillBytes & either throwIO pure - putStrLn "Parsing pill file." + logTrace "Parsing pill file." pill <- fromNounErr pillNoun & either (throwIO . uncurry ParseErr) pure - putStrLn "Using pill to generate boot sequence." + logTrace "Using pill to generate boot sequence." bootSeq <- generateBootSeq zod pill False (Fake $ Ship 0) - putStrLn "Validate jam/cue and toNoun/fromNoun on pill value" + logTrace "Validate jam/cue and toNoun/fromNoun on pill value" reJam <- validateNounVal pill - putStrLn "Checking if round-trip matches input file:" + logTrace "Checking if round-trip matches input file:" unless (reJam == pillBytes) $ do - putStrLn " Our jam does not match the file...\n" - putStrLn " This is surprising, but it is probably okay." + logTrace " Our jam does not match the file...\n" + logTrace " This is surprising, but it is probably okay." when showPil $ do - putStrLn "\n\n== Pill ==\n" + logTrace "\n\n== Pill ==\n" io $ pPrint pill when showSeq $ do - putStrLn "\n\n== Boot Sequence ==\n" + logTrace "\n\n== Boot Sequence ==\n" io $ pPrint bootSeq validateNounVal :: (HasLogFunc e, Eq a, ToNoun a, FromNoun a) => a -> RIO e ByteString validateNounVal inpVal = do - putStrLn " jam" + logTrace " jam" inpByt <- evaluate $ jamBS $ toNoun inpVal - putStrLn " cue" + logTrace " cue" outNon <- cueBS inpByt & either throwIO pure - putStrLn " fromNoun" + logTrace " fromNoun" outVal <- fromNounErr outNon & either (throwIO . uncurry ParseErr) pure - putStrLn " toNoun" + logTrace " toNoun" outNon <- evaluate (toNoun outVal) - putStrLn " jam" + logTrace " jam" outByt <- evaluate $ jamBS outNon - putStrLn "Checking if: x == cue (jam x)" + logTrace "Checking if: x == cue (jam x)" unless (inpVal == outVal) $ error "Value fails test: x == cue (jam x)" - putStrLn "Checking if: jam x == jam (cue (jam x))" + logTrace "Checking if: jam x == jam (cue (jam x))" unless (inpByt == outByt) $ error "Value fails test: jam x == jam (cue (jam x))" @@ -420,22 +420,22 @@ validateNounVal inpVal = do -------------------------------------------------------------------------------- -pillFrom :: CLI.PillSource -> RIO e Pill +pillFrom :: CLI.PillSource -> RIO App Pill +pillFrom = \case + CLI.PillSourceFile pillPath -> do + logTrace $ display $ "boot: reading pill from " ++ (pack pillPath :: Text) + io (loadFile pillPath >>= either throwIO pure) -pillFrom (CLI.PillSourceFile pillPath) = do - putStrLn $ "boot: reading pill from " ++ pack pillPath - io (loadFile pillPath >>= either throwIO pure) + CLI.PillSourceURL url -> do + logTrace $ display $ "boot: retrieving pill from " ++ (pack url :: Text) + -- Get the jamfile with the list of stars accepting comets right now. + manager <- io $ C.newManager tlsManagerSettings + request <- io $ C.parseRequest url + response <- io $ C.httpLbs (C.setRequestCheckStatus request) manager + let body = toStrict $ C.responseBody response -pillFrom (CLI.PillSourceURL url) = do - putStrLn $ "boot: retrieving pill from " ++ pack url - -- Get the jamfile with the list of stars accepting comets right now. - manager <- io $ C.newManager tlsManagerSettings - request <- io $ C.parseRequest url - response <- io $ C.httpLbs (C.setRequestCheckStatus request) manager - let body = toStrict $ C.responseBody response - - noun <- cueBS body & either throwIO pure - fromNounErr noun & either (throwIO . uncurry ParseErr) pure + noun <- cueBS body & either throwIO pure + fromNounErr noun & either (throwIO . uncurry ParseErr) pure newShip :: CLI.New -> CLI.Opts -> RIO App () newShip CLI.New{..} opts = do @@ -645,14 +645,15 @@ runShipRestarting waitForKillRequ r o multi = do atomically (onShipExit <|> onKillRequ) >>= \case Left exit -> do case exit of - Left err -> putStrLn (tshow err <> ": " <> pier) - Right () -> putStrLn ("Ship exited on it's own. Why? " <> pier) + Left err -> logError $ display (tshow err <> ": " <> pier) + Right () -> + logError $ display ("Ship exited on it's own. Why? " <> pier) threadDelay 250_000 loop Right () -> do - putStrLn ("King Shutdown requested. Killing: " <> pier) + logTrace $ display ("King Shutdown requested. Killing: " <> pier) cancel tid - putStrLn ("Ship terminated: " <> pier) + logTrace $ display ("Ship terminated: " <> pier) runShips :: CLI.KingOpts -> [(CLI.Run, CLI.Opts, Bool)] -> RIO App () @@ -703,7 +704,7 @@ runMultipleShips ships multi = do -} let spin = forever (threadDelay maxBound) finally spin $ do - putStrLn "KING IS GOING DOWN" + logTrace "KING IS GOING DOWN" atomically (putTMVar killSignal ()) for_ shipThreads waitCatch From 097259de66892f79bbbfdfd291b01b3483d7542c Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Wed, 13 May 2020 12:06:55 -0700 Subject: [PATCH 089/257] king: Use random numbers for request IDs. --- .../urbit-king/lib/Urbit/Vere/Eyre/Multi.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs | 31 ++++++++++++++----- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs index b93bb67b5..30b0298b8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -74,7 +74,7 @@ multiEyre :: HasLogFunc e => MultiEyreConf -> RIO e MultiEyreApi multiEyre conf@MultiEyreConf {..} = do logTrace (displayShow ("EYRE", "MULTI", conf)) - vLive <- newTVarIO emptyLiveReqs + vLive <- io emptyLiveReqs >>= newTVarIO vPlan <- newTVarIO mempty vCanc <- newTVarIO (mempty :: Map Ship (Ship -> Word64 -> STM ())) vTlsC <- newTVarIO mempty diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs index b45b94ac5..3815e1ca9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs @@ -30,6 +30,7 @@ import Data.Binary.Builder (Builder, fromByteString) import Data.Bits (shiftL, (.|.)) import Data.Conduit (ConduitT, Flush(Chunk, Flush), yield) import Network.Socket (SockAddr(..)) +import System.Random (newStdGen, randoms) import Urbit.Arvo (Address(..), Ipv4(..), Ipv6(..), Method) import qualified Network.HTTP.Types as H @@ -52,7 +53,7 @@ data RespApi = RespApi } data LiveReqs = LiveReqs - { nextReqId :: Word64 + { reqIdSuply :: [Word64] , activeReqs :: Map Word64 (Ship, RespApi) } @@ -67,8 +68,10 @@ data ReqInfo = ReqInfo -- Live Requests Table -- All Requests Still Waiting for Responses ------------- -emptyLiveReqs :: LiveReqs -emptyLiveReqs = LiveReqs 1 mempty +emptyLiveReqs :: IO LiveReqs +emptyLiveReqs = io $ do + gen <- newStdGen + pure (LiveReqs (randoms gen) mempty) routeRespAct :: Ship -> TVar LiveReqs -> Word64 -> RespAct -> STM Bool routeRespAct who vLiv reqId act = @@ -83,14 +86,28 @@ rmLiveReq :: TVar LiveReqs -> Word64 -> STM () rmLiveReq var reqId = modifyTVar' var $ \liv -> liv { activeReqs = deleteMap reqId (activeReqs liv) } +allocateReqId :: TVar LiveReqs -> STM Word64 +allocateReqId var = do + LiveReqs supply tbl <- readTVar var + + let loop :: [Word64] -> (Word64, [Word64]) + loop [] = error "impossible" + loop (x:xs) | member x tbl = loop xs + loop (x:xs) | otherwise = (x, xs) + + let (fresh, supply') = loop supply + writeTVar var (LiveReqs supply' tbl) + pure fresh + newLiveReq :: Ship -> TVar LiveReqs -> STM (Word64, STM RespAct) newLiveReq who var = do - liv <- readTVar var tmv <- newTQueue kil <- newEmptyTMVar + nex <- allocateReqId var - let waitAct = (<|>) (readTMVar kil $> RADone) (readTQueue tmv) - (nex, act) = (nextReqId liv, activeReqs liv) + LiveReqs sup tbl <- readTVar var + + let waitAct = (<|>) (readTMVar kil $> RADone) (readTQueue tmv) respApi = RespApi { raKil = putTMVar kil () , raAct = \act -> tryReadTMVar kil >>= \case @@ -99,7 +116,7 @@ newLiveReq who var = do } - writeTVar var (LiveReqs (nex + 1) (insertMap nex (who, respApi) act)) + writeTVar var (LiveReqs sup (insertMap nex (who, respApi) tbl)) pure (nex, waitAct) From 419dc03727f966cd60510da2f26b241db9db0a5b Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Wed, 13 May 2020 12:35:57 -0700 Subject: [PATCH 090/257] RIO environment cleanup. --- pkg/hs/urbit-king/lib/Urbit/King/App.hs | 189 ++++++++++-------- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 67 +++---- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 11 +- pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs | 11 +- pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs | 9 +- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 11 +- .../urbit-king/lib/Urbit/Vere/Http/Client.hs | 25 ++- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 48 +++-- pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 10 +- 9 files changed, 219 insertions(+), 162 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs index 0eda0b41f..46ed3141f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs @@ -2,117 +2,148 @@ Code for setting up the RIO environment. -} module Urbit.King.App - ( App - , runAppStderr - , runAppLogFile - , runAppNoLog - , runPierApp - , HasConfigDir(..) - , HasStderrLogFunc(..) - ) where + ( KingEnv + , runKingEnvStderr + , runKingEnvLogFile + , runKingEnvNoLog + , PierEnv + , runPierEnv + , HasConfigDir(..) + , HasStderrLogFunc(..) + , HasKingId(..) + , HasProcId(..) + ) +where import Urbit.King.Config import Urbit.Prelude -import System.Directory (createDirectoryIfMissing, getHomeDirectory) +import System.Directory (createDirectoryIfMissing, getHomeDirectory) +import System.Posix.Internals (c_getpid) +import System.Posix.Types (CPid(..)) +import System.Random (randomIO) --------------------------------------------------------------------------------- + +-- Constraints ----------------------------------------------------------------- class HasConfigDir a where - configDirL ∷ Lens' a FilePath + configDirL ∷ Lens' a FilePath class HasStderrLogFunc a where - stderrLogFuncL :: Lens' a LogFunc + stderrLogFuncL :: Lens' a LogFunc --------------------------------------------------------------------------------- +class HasProcId a where + procIdL :: Lens' a Int32 -data App = App - { _appLogFunc :: !LogFunc - , _appStderrLogFunc :: !LogFunc - } +class HasKingId a where + kingIdL :: Lens' a Word16 -makeLenses ''App -instance HasLogFunc App where - logFuncL = appLogFunc +-- KingEnv --------------------------------------------------------------------- -instance HasStderrLogFunc App where - stderrLogFuncL = appStderrLogFunc +data KingEnv = KingEnv + { _kingEnvLogFunc :: !LogFunc + , _kingEnvStderrLogFunc :: !LogFunc + , _kingEnvKingId :: !Word16 + , _kingEnvProcId :: !Int32 + } -runAppStderr :: RIO App a -> IO a -runAppStderr inner = do - logOptions <- logOptionsHandle stderr True - <&> setLogUseTime True - <&> setLogUseLoc False +makeLenses ''KingEnv - withLogFunc logOptions $ \logFunc -> - runRIO (App logFunc logFunc) inner +instance HasLogFunc KingEnv where + logFuncL = kingEnvLogFunc -runAppLogFile :: RIO App a -> IO a -runAppLogFile inner = - withLogFileHandle $ \h -> do - logOptions <- logOptionsHandle h True - <&> setLogUseTime True - <&> setLogUseLoc False - stderrLogOptions <- logOptionsHandle stderr True - <&> setLogUseTime False - <&> setLogUseLoc False +instance HasStderrLogFunc KingEnv where + stderrLogFuncL = kingEnvStderrLogFunc - withLogFunc stderrLogOptions $ \stderrLogFunc -> - withLogFunc logOptions $ \logFunc -> - runRIO (App logFunc stderrLogFunc) inner +instance HasProcId KingEnv where + procIdL = kingEnvProcId + +instance HasKingId KingEnv where + kingIdL = kingEnvKingId + + +-- Running KingEnvs ------------------------------------------------------------ + +runKingEnvStderr :: RIO KingEnv a -> IO a +runKingEnvStderr inner = do + logOptions <- + logOptionsHandle stderr True <&> setLogUseTime True <&> setLogUseLoc False + + withLogFunc logOptions $ \logFunc -> runKingEnv logFunc logFunc inner + +runKingEnvLogFile :: RIO KingEnv a -> IO a +runKingEnvLogFile inner = withLogFileHandle $ \h -> do + logOptions <- + logOptionsHandle h True <&> setLogUseTime True <&> setLogUseLoc False + stderrLogOptions <- + logOptionsHandle stderr True <&> setLogUseTime False <&> setLogUseLoc False + + withLogFunc stderrLogOptions $ \stderrLogFunc -> withLogFunc logOptions + $ \logFunc -> runKingEnv logFunc stderrLogFunc inner withLogFileHandle :: (Handle -> IO a) -> IO a withLogFileHandle act = do - home <- getHomeDirectory - let logDir = home ".urbit" - createDirectoryIfMissing True logDir - withFile (logDir "king.log") AppendMode $ \handle -> do - hSetBuffering handle LineBuffering - act handle + home <- getHomeDirectory + let logDir = home ".urbit" + createDirectoryIfMissing True logDir + withFile (logDir "king.log") AppendMode $ \handle -> do + hSetBuffering handle LineBuffering + act handle -runAppNoLog :: RIO App a -> IO a -runAppNoLog act = - withFile "/dev/null" AppendMode $ \handle -> do - logOptions <- logOptionsHandle handle True - withLogFunc logOptions $ \logFunc -> - runRIO (App logFunc logFunc) act +runKingEnvNoLog :: RIO KingEnv a -> IO a +runKingEnvNoLog act = withFile "/dev/null" AppendMode $ \handle -> do + logOptions <- logOptionsHandle handle True + withLogFunc logOptions $ \logFunc -> runKingEnv logFunc logFunc act --------------------------------------------------------------------------------- +runKingEnv :: LogFunc -> LogFunc -> RIO KingEnv a -> IO a +runKingEnv logFunc stderr action = do + kid <- randomIO + CPid pid <- c_getpid + runRIO (KingEnv logFunc stderr kid pid) action --- | A PierApp is like an App, except that it also provides a PierConfig -data PierApp = PierApp - { _pierAppLogFunc :: !LogFunc - , _pierAppStderrLogFunc :: !LogFunc - , _pierAppPierConfig :: !PierConfig - , _pierAppNetworkConfig :: !NetworkConfig - } -makeLenses ''PierApp +-- PierEnv --------------------------------------------------------------------- -instance HasStderrLogFunc PierApp where - stderrLogFuncL = pierAppStderrLogFunc +data PierEnv = PierEnv + { _pierEnvKingEnv :: !KingEnv + , _pierEnvPierConfig :: !PierConfig + , _pierEnvNetworkConfig :: !NetworkConfig + } -instance HasLogFunc PierApp where - logFuncL = pierAppLogFunc +makeLenses ''PierEnv -instance HasPierConfig PierApp where - pierConfigL = pierAppPierConfig +instance HasStderrLogFunc PierEnv where + stderrLogFuncL = pierEnvKingEnv . stderrLogFuncL -instance HasNetworkConfig PierApp where - networkConfigL = pierAppNetworkConfig +instance HasLogFunc PierEnv where + logFuncL = pierEnvKingEnv . logFuncL -instance HasConfigDir PierApp where - configDirL = pierAppPierConfig . pcPierPath +instance HasPierConfig PierEnv where + pierConfigL = pierEnvPierConfig -runPierApp :: PierConfig -> NetworkConfig -> RIO PierApp a -> RIO App a -runPierApp pierConfig networkConfig action = do +instance HasNetworkConfig PierEnv where + networkConfigL = pierEnvNetworkConfig + +instance HasConfigDir PierEnv where + configDirL = pierEnvPierConfig . pcPierPath + +instance HasProcId PierEnv where + procIdL = pierEnvKingEnv . kingEnvProcId + +instance HasKingId PierEnv where + kingIdL = pierEnvKingEnv . kingEnvKingId + + +-- Running Pier Envs ----------------------------------------------------------- + +runPierEnv :: PierConfig -> NetworkConfig -> RIO PierEnv a -> RIO KingEnv a +runPierEnv pierConfig networkConfig action = do app <- ask - let pierApp = PierApp { _pierAppLogFunc = app ^. logFuncL - , _pierAppStderrLogFunc = app ^. stderrLogFuncL - , _pierAppPierConfig = pierConfig - , _pierAppNetworkConfig = networkConfig + let pierEnv = PierEnv { _pierEnvKingEnv = app + , _pierEnvPierConfig = pierConfig + , _pierEnvNetworkConfig = networkConfig } - io (runRIO pierApp action) + io (runRIO pierEnv action) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 922ae3ea3..acd2013e8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -91,9 +91,9 @@ import Control.Exception (AsyncException(UserInterrupt)) import Control.Lens ((&)) import System.Process (system) import Text.Show.Pretty (pPrint) -import Urbit.King.App (App) -import Urbit.King.App (runAppLogFile, runAppStderr, runPierApp) -import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) +import Urbit.King.App (KingEnv, PierEnv) +import Urbit.King.App (runKingEnvLogFile, runKingEnvStderr, runPierEnv) +import Urbit.King.App (HasStderrLogFunc(..)) import Urbit.Noun.Conversions (cordToUW) import Urbit.Time (Wen) import Urbit.Vere.LockFile (lockFile) @@ -169,13 +169,15 @@ toNetworkConfig CLI.Opts {..} = NetworkConfig { .. } _ncNoHttp = oNoHttp _ncNoHttps = oNoHttps -tryBootFromPill :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e - , HasConfigDir e, HasStderrLogFunc e - ) - => Bool -> Pill -> Bool -> Serf.Flags -> Ship - -> LegacyBootEvent - -> MultiEyreApi - -> RIO e () +tryBootFromPill + :: Bool + -> Pill + -> Bool + -> Serf.Flags + -> Ship + -> LegacyBootEvent + -> MultiEyreApi + -> RIO PierEnv () tryBootFromPill oExit pill lite flags ship boot multi = do mStart <- newEmptyMVar runOrExitImmediately bootedPier oExit mStart multi @@ -188,12 +190,11 @@ tryBootFromPill oExit pill lite flags ship boot multi = do pure sls runOrExitImmediately - :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e, HasConfigDir e) - => RAcquire e (Serf e, Log.EventLog, SerfState) + :: RAcquire PierEnv (Serf PierEnv, Log.EventLog, SerfState) -> Bool -> MVar () -> MultiEyreApi - -> RIO e () + -> RIO PierEnv () runOrExitImmediately getPier oExit mStart multi = rwith getPier $ if oExit then shutdownImmediately else runPier where @@ -212,19 +213,13 @@ runOrExitImmediately getPier oExit mStart multi = runRAcquire $ Pier.pier sls mStart multi tryPlayShip - :: ( HasStderrLogFunc e - , HasLogFunc e - , HasNetworkConfig e - , HasPierConfig e - , HasConfigDir e - ) - => Bool + :: Bool -> Bool -> Maybe Word64 -> Serf.Flags -> MVar () -> MultiEyreApi - -> RIO e () + -> RIO PierEnv () tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do when fullReplay wipeSnapshot runOrExitImmediately resumeShip exitImmediately mStart multi @@ -240,6 +235,7 @@ tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do north shipPath = shipPath <> "/.urb/chk/north.bin" south shipPath = shipPath <> "/.urb/chk/south.bin" + resumeShip :: RAcquire PierEnv (Serf PierEnv, Log.EventLog, SerfState) resumeShip = do view pierPathL >>= lockFile rio $ logTrace "RESUMING SHIP" @@ -420,7 +416,7 @@ validateNounVal inpVal = do -------------------------------------------------------------------------------- -pillFrom :: CLI.PillSource -> RIO App Pill +pillFrom :: CLI.PillSource -> RIO KingEnv Pill pillFrom = \case CLI.PillSourceFile pillPath -> do logTrace $ display $ "boot: reading pill from " ++ (pack pillPath :: Text) @@ -437,7 +433,7 @@ pillFrom = \case noun <- cueBS body & either throwIO pure fromNounErr noun & either (throwIO . uncurry ParseErr) pure -newShip :: CLI.New -> CLI.Opts -> RIO App () +newShip :: CLI.New -> CLI.Opts -> RIO KingEnv () newShip CLI.New{..} opts = do {- TODO XXX HACK @@ -485,7 +481,7 @@ newShip CLI.New{..} opts = do bootFromSeed multi pill seed where - shipFrom :: Text -> RIO App Ship + shipFrom :: Text -> RIO KingEnv Ship shipFrom name = case Ob.parsePatp name of Left x -> error "Invalid ship name" Right p -> pure $ Ship $ fromIntegral $ Ob.fromPatp p @@ -495,7 +491,7 @@ newShip CLI.New{..} opts = do Just x -> x Nothing -> "./" <> unpack name - nameFromShip :: Ship -> RIO App Text + nameFromShip :: Ship -> RIO KingEnv Text nameFromShip s = name where nameWithSig = Ob.renderPatp $ Ob.patp $ fromIntegral s @@ -503,7 +499,7 @@ newShip CLI.New{..} opts = do Nothing -> error "Urbit.ob didn't produce string with ~" Just x -> pure x - bootFromSeed :: MultiEyreApi -> Pill -> Seed -> RIO App () + bootFromSeed :: MultiEyreApi -> Pill -> Seed -> RIO KingEnv () bootFromSeed multi pill seed = do ethReturn <- dawnVent seed @@ -521,11 +517,11 @@ newShip CLI.New{..} opts = do runTryBootFromPill multi pill name ship bootEvent = do let pierConfig = toPierConfig (pierPath name) opts let networkConfig = toNetworkConfig opts - runPierApp pierConfig networkConfig $ + runPierEnv pierConfig networkConfig $ tryBootFromPill True pill nLite flags ship bootEvent multi ------ tryBootFromPill (CLI.oExit opts) pill nLite flags ship bootEvent -runShip :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO App () +runShip :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO KingEnv () runShip (CLI.Run pierPath) opts daemon multi = do tid <- io myThreadId let onTermExit = throwTo tid UserInterrupt @@ -539,7 +535,7 @@ runShip (CLI.Run pierPath) opts daemon multi = do finally (runPier mStart) (cancel connectionThread) where runPier mStart = - runPierApp pierConfig networkConfig $ + runPierEnv pierConfig networkConfig $ tryPlayShip (CLI.oExit opts) (CLI.oFullReplay opts) @@ -593,7 +589,7 @@ main = do hSetBuffering stdout NoBuffering setupSignalHandlers - runApp args $ case args of + runKingEnv args $ case args of CLI.CmdRun ko ships -> runShips ko ships CLI.CmdNew n o -> newShip n o CLI.CmdBug (CLI.CollectAllFX pax ) -> collectAllFx pax @@ -607,8 +603,8 @@ main = do CLI.CmdCon pier -> connTerm pier where - runApp args | willRunTerminal args = runAppLogFile - runApp args | otherwise = runAppStderr + runKingEnv args | willRunTerminal args = runKingEnvLogFile + runKingEnv args | otherwise = runKingEnvStderr setupSignalHandlers = do mainTid <- myThreadId @@ -632,7 +628,8 @@ main = do TODO Use logging system instead of printing. -} -runShipRestarting :: STM () -> CLI.Run -> CLI.Opts -> MultiEyreApi -> RIO App () +runShipRestarting + :: STM () -> CLI.Run -> CLI.Opts -> MultiEyreApi -> RIO KingEnv () runShipRestarting waitForKillRequ r o multi = do let pier = pack (CLI.rPierPath r) loop = runShipRestarting waitForKillRequ r o multi @@ -656,7 +653,7 @@ runShipRestarting waitForKillRequ r o multi = do logTrace $ display ("Ship terminated: " <> pier) -runShips :: CLI.KingOpts -> [(CLI.Run, CLI.Opts, Bool)] -> RIO App () +runShips :: CLI.KingOpts -> [(CLI.Run, CLI.Opts, Bool)] -> RIO KingEnv () runShips CLI.KingOpts {..} ships = do let meConf = MultiEyreConf { mecHttpPort = fromIntegral <$> koSharedHttpPort @@ -683,7 +680,7 @@ runShips CLI.KingOpts {..} ships = do [(r, o, d)] -> runShip r o d me ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) me -runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> RIO App () +runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> RIO KingEnv () runMultipleShips ships multi = do killSignal <- newEmptyTMVarIO diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 7ee6e9759..4dd7f47a8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -11,6 +11,7 @@ import Urbit.Arvo hiding (Fake) import Urbit.King.Config import Urbit.Vere.Pier.Types +import Urbit.King.App (HasKingId(..)) import Urbit.Vere.Ames.DNS (NetworkMode(..), ResolvServ(..)) import Urbit.Vere.Ames.DNS (galaxyPort, resolvServ) import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ) @@ -107,17 +108,19 @@ udpServ isFake who = do -} ames :: forall e - . (HasLogFunc e, HasNetworkConfig e) - => KingId + . (HasLogFunc e, HasNetworkConfig e, HasKingId e) + => e -> Ship -> Bool -> QueueEv -> (Text -> RIO e ()) -> ([Ev], RAcquire e (EffCb e NewtEf)) -ames inst who isFake enqueueEv stderr = (initialEvents, runAmes) +ames env who isFake enqueueEv stderr = (initialEvents, runAmes) where + king = fromIntegral (env ^. kingIdL) + initialEvents :: [Ev] - initialEvents = [bornEv inst] + initialEvents = [bornEv king] runAmes :: RAcquire e (EffCb e NewtEf) runAmes = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs index 5336534b0..1f4735158 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs @@ -8,8 +8,9 @@ import Urbit.Arvo hiding (Behn) import Urbit.Prelude import Urbit.Vere.Pier.Types -import Urbit.Time (Wen) -import Urbit.Timer (Timer) +import Urbit.King.App (HasKingId(..)) +import Urbit.Time (Wen) +import Urbit.Timer (Timer) import qualified Urbit.Time as Time import qualified Urbit.Timer as Timer @@ -25,10 +26,12 @@ wakeEv = EvBlip $ BlipEvBehn $ BehnEvWake () () sysTime = view Time.systemTime -behn :: KingId -> QueueEv -> ([Ev], Acquire (EffCb e BehnEf)) -behn king enqueueEv = +behn :: HasKingId e => e -> QueueEv -> ([Ev], Acquire (EffCb e BehnEf)) +behn env enqueueEv = (initialEvents, runBehn) where + king = fromIntegral (env ^. kingIdL) + initialEvents = [bornEv king] runBehn :: Acquire (EffCb e BehnEf) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs index 811586409..4e2116b6b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs @@ -5,6 +5,7 @@ module Urbit.Vere.Clay (clay) where import Urbit.Arvo hiding (Term) +import Urbit.King.App (HasKingId(..)) import Urbit.King.Config import Urbit.Prelude import Urbit.Vere.Pier.Types @@ -112,11 +113,13 @@ buildActionListFromDifferences fp snapshot = do -------------------------------------------------------------------------------- -clay :: forall e. (HasPierConfig e, HasLogFunc e) - => KingId -> QueueEv -> ([Ev], RAcquire e (EffCb e SyncEf)) -clay king enqueueEv = +clay :: forall e. (HasPierConfig e, HasLogFunc e, HasKingId e) + => e -> QueueEv -> ([Ev], RAcquire e (EffCb e SyncEf)) +clay env enqueueEv = (initialEvents, runSync) where + king = fromIntegral (env ^. kingIdL) + initialEvents = [ EvBlip $ BlipEvBoat $ BoatEvBoat () () -- TODO: In the case of -A, we need to read all the data from the diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 8b67dd6b9..3e67abb0a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -10,11 +10,12 @@ where import Urbit.Prelude hiding (Builder) import Urbit.Arvo hiding (ServerId, reqUrl, secure) +import Urbit.King.App (HasKingId(..)) import Urbit.King.Config +import Urbit.Vere.Eyre.Multi import Urbit.Vere.Eyre.PortsFile import Urbit.Vere.Eyre.Serv import Urbit.Vere.Eyre.Service -import Urbit.Vere.Eyre.Multi import Urbit.Vere.Eyre.Wai import Urbit.Vere.Pier.Types @@ -270,15 +271,17 @@ startServ multi who isFake conf plan = do eyre :: forall e - . HasShipEnv e - => KingId + . (HasShipEnv e, HasKingId e) + => e -> MultiEyreApi -> Ship -> QueueEv -> Bool -> ([Ev], RAcquire e (EffCb e HttpServerEf)) -eyre king multi who plan isFake = (initialEvents, runHttpServer) +eyre env multi who plan isFake = (initialEvents, runHttpServer) where + king = fromIntegral (env ^. kingIdL) + initialEvents :: [Ev] initialEvents = [bornEv king] diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs index 23526467e..038d8218d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs @@ -7,19 +7,22 @@ module Urbit.Vere.Http.Client where -import Urbit.Arvo (BlipEv(..), Ev(..), HttpClientEf(..), - HttpClientEv(..), HttpClientReq(..), - HttpEvent(..), KingId, ResponseHeader(..)) -import Urbit.Prelude hiding (Builder) -import Urbit.Vere.Pier.Types +import Urbit.Prelude hiding (Builder) import Urbit.Vere.Http +import Urbit.Vere.Pier.Types + +import Urbit.Arvo (BlipEv(..), Ev(..), HttpClientEf(..), HttpClientEv(..), + HttpClientReq(..), HttpEvent(..), KingId, ResponseHeader(..)) + +import Urbit.King.App (HasKingId(..)) import qualified Data.Map as M import qualified Network.HTTP.Client as H import qualified Network.HTTP.Client.TLS as TLS import qualified Network.HTTP.Types as HT + -- Types ----------------------------------------------------------------------- type ReqId = Word @@ -54,10 +57,16 @@ bornEv king = -------------------------------------------------------------------------------- -client :: forall e. HasLogFunc e - => KingId -> QueueEv -> ([Ev], RAcquire e (EffCb e HttpClientEf)) -client kingId enqueueEv = (initialEvents, runHttpClient) +client + :: forall e + . (HasLogFunc e, HasKingId e) + => e + -> QueueEv + -> ([Ev], RAcquire e (EffCb e HttpClientEf)) +client env enqueueEv = (initialEvents, runHttpClient) where + kingId = view (kingIdL . to fromIntegral) env + initialEvents :: [Ev] initialEvents = [bornEv kingId] diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 5635bb99e..eb9dcb5ab 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -10,16 +10,16 @@ module Urbit.Vere.Pier import Urbit.Prelude +import Control.Monad.Trans.Maybe import RIO.Directory -import System.Random import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Pier.Types -import Control.Monad.Trans.Maybe import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) -import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) +import Urbit.King.App (HasConfigDir(..), HasKingId(..), + HasStderrLogFunc(..)) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -171,11 +171,18 @@ getSnapshot top last = do acquireWorker :: RIO e () -> RAcquire e (Async ()) acquireWorker act = mkRAcquire (async act) cancel -pier :: ∀e. (HasConfigDir e, HasLogFunc e, HasNetworkConfig e, HasPierConfig e) - => (Serf e, EventLog, SerfState) - -> MVar () - -> MultiEyreApi - -> RAcquire e () +pier + :: forall e + . ( HasConfigDir e + , HasLogFunc e + , HasNetworkConfig e + , HasPierConfig e + , HasKingId e + ) + => (Serf e, EventLog, SerfState) + -> MVar () + -> MultiEyreApi + -> RAcquire e () pier (serf, log, ss) mStart multi = do computeQ <- newTQueueIO persistQ <- newTQueueIO @@ -192,8 +199,6 @@ pier (serf, log, ss) mStart multi = do let shutdownEvent = putTMVar shutdownM () - inst <- io (KingId . UV . fromIntegral <$> randomIO @Word16) - -- (sz, local) <- Term.localClient -- (waitExternalTerm, termServPort) <- Term.termServer @@ -223,8 +228,11 @@ pier (serf, log, ss) mStart multi = do -- the c serf code. Logging output from our haskell process must manually -- add them. let showErr = atomically . Term.trace muxed . (flip append "\r\n") + + env <- ask + let (bootEvents, startDrivers) = - drivers inst multi ship (isFake logId) + drivers env multi ship (isFake logId) (writeTQueue computeQ) shutdownEvent (Term.TSize{tsWide=80, tsTall=24}, muxed) @@ -286,8 +294,8 @@ data Drivers e = Drivers } drivers - :: (HasLogFunc e, HasNetworkConfig e, HasPierConfig e) - => KingId + :: (HasLogFunc e, HasKingId e, HasNetworkConfig e, HasPierConfig e) + => e -> MultiEyreApi -> Ship -> Bool @@ -296,15 +304,15 @@ drivers -> (Term.TSize, Term.Client) -> (Text -> RIO e ()) -> ([Ev], RAcquire e (Drivers e)) -drivers inst multi who isFake plan shutdownSTM termSys stderr = +drivers env multi who isFake plan shutdownSTM termSys stderr = (initialEvents, runDrivers) where - (behnBorn, runBehn) = behn inst plan - (amesBorn, runAmes) = ames inst who isFake plan stderr - (httpBorn, runHttp) = eyre inst multi who plan isFake - (clayBorn, runClay) = clay inst plan - (irisBorn, runIris) = client inst plan - (termBorn, runTerm) = Term.term termSys shutdownSTM inst plan + (behnBorn, runBehn) = behn env plan + (amesBorn, runAmes) = ames env who isFake plan stderr + (httpBorn, runHttp) = eyre env multi who plan isFake + (clayBorn, runClay) = clay env plan + (irisBorn, runIris) = client env plan + (termBorn, runTerm) = Term.term env termSys shutdownSTM plan initialEvents = mconcat [behnBorn, clayBorn, amesBorn, httpBorn, termBorn, irisBorn] runDrivers = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index dc85580b3..dcc2342e0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -26,7 +26,7 @@ import Urbit.Vere.Pier.Types import Data.List ((!!)) import RIO.Directory (createDirectoryIfMissing) import Urbit.King.API (readPortsFile) -import Urbit.King.App (HasConfigDir(..)) +import Urbit.King.App (HasKingId(..), HasConfigDir(..)) import Urbit.Vere.Term.API (Client(Client)) import qualified Data.ByteString.Internal as BS @@ -494,13 +494,13 @@ localClient doneSignal = fst <$> mkRAcquire start stop {-| Terminal Driver -} -term :: forall e. (HasPierConfig e, HasLogFunc e) - => (T.TSize, Client) +term :: forall e. (HasPierConfig e, HasLogFunc e, HasKingId e) + => e + -> (T.TSize, Client) -> (STM ()) - -> KingId -> QueueEv -> ([Ev], RAcquire e (EffCb e TermEf)) -term (tsize, Client{..}) shutdownSTM king enqueueEv = +term env (tsize, Client{..}) shutdownSTM enqueueEv = (initialEvents, runTerm) where T.TSize wi hi = tsize From 0d4b0f6e3001bdafb88d93fd45625327442a43b9 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 20 May 2020 14:20:01 -0700 Subject: [PATCH 091/257] WIP kh ipc protocol --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 104 +++++++++++++++++++ 1 file changed, 104 insertions(+) create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs new file mode 100644 index 000000000..788d71e68 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -0,0 +1,104 @@ +module Urbit.Vere.Serf.IPC where + +import Urbit.Prelude + +import Urbit.Arvo +import Urbit.Vere.Pier.Types hiding (Work) + +import Urbit.Time (Wen) + +type Gang = (Maybe (HoonSet Ship)) + +type Goof = (Term, [Tank]) + +data Live + = LExit Atom + | LSave EventId + | LPack (EventId) + +data Play + = PDone Mug + | PBail EventId Mug Goof + +data Work + = WDone EventId Mug [Ef] + | WSwap EventId Mug (Wen, Noun) [Ef] + | WBail [Goof] + +data Writ + = WLive Live + | WPeek Wen Gang Path + | WPlay EventId [Noun] + | WWork Wen Ev + +data Plea + = PLive () + | PRipe (Atom, Atom, Atom) EventId Mug + | PSlog Atom Tank + | PPeek (Maybe (Term, Noun)) + | PPlay Play + | PWork Work + +deriveNoun ''Live +deriveNoun ''Play +deriveNoun ''Work +deriveNoun ''Writ +deriveNoun ''Plea + +{- +|% +:: +writ: from king to serf +:: ++$ writ + $% $: %live + $% [%exit cod=@] + [%save eve=@] + [%pack eve=@] + == == + [%peek now=date lyc=gang pat=path] + [%play eve=@ lit=(list ?((pair date ovum) *))] + [%work job=(pair date ovum)] + == +:: +plea: from serf to king +:: ++$ plea + $% [%live ~] + [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] + [%slog pri=@ ?(cord tank)] + [%peek dat=(unit (cask))] + $: %play + $% [%done mug=@] + [%bail eve=@ mug=@ dud=goof] + == == + $: %work + $% [%done eve=@ mug=@ fec=(list ovum)] + [%swap eve=@ mug=@ job=(pair date ovum) fec=(list ovum)] + [%bail lud=(list goof)] + == == + == +-- +-} + +data Lord = Lord + { sendHandle :: Handle + , recvHandle :: Handle + , process :: ProcessHandle + , foo :: TVar(EventId, Mug) + , sent :: TVar(Seq Writ) + , pending :: TVar(Seq Writ) + } + +data SerfConfig = SerfConfig() -- binary, directory, &c +data SerfInfo = SerfInfo + { siNock :: Atom + , siHoon :: Atom + } + +start :: SerfConfig -> IO(Lord, SerfInfo) +start = undefined + +pack :: Lord -> IO() -- wait for queue to drain, then send with latest EventId +pack l = atomically $ do + q <- readTVar(pending l) + writeTVar(pending l) ((Pack 0) <| q) + From 0b2c78e24bbb9da295a30a127d13b5727b6ff680 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Wed, 20 May 2020 17:35:33 -0700 Subject: [PATCH 092/257] king: Skecthed out lowest layer of new IPC protocol. --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 286 +++++++++++++++---- 1 file changed, 225 insertions(+), 61 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 788d71e68..bebab5607 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -1,50 +1,3 @@ -module Urbit.Vere.Serf.IPC where - -import Urbit.Prelude - -import Urbit.Arvo -import Urbit.Vere.Pier.Types hiding (Work) - -import Urbit.Time (Wen) - -type Gang = (Maybe (HoonSet Ship)) - -type Goof = (Term, [Tank]) - -data Live - = LExit Atom - | LSave EventId - | LPack (EventId) - -data Play - = PDone Mug - | PBail EventId Mug Goof - -data Work - = WDone EventId Mug [Ef] - | WSwap EventId Mug (Wen, Noun) [Ef] - | WBail [Goof] - -data Writ - = WLive Live - | WPeek Wen Gang Path - | WPlay EventId [Noun] - | WWork Wen Ev - -data Plea - = PLive () - | PRipe (Atom, Atom, Atom) EventId Mug - | PSlog Atom Tank - | PPeek (Maybe (Term, Noun)) - | PPlay Play - | PWork Work - -deriveNoun ''Live -deriveNoun ''Play -deriveNoun ''Work -deriveNoun ''Writ -deriveNoun ''Plea - {- |% :: +writ: from king to serf @@ -79,26 +32,237 @@ deriveNoun ''Plea -- -} -data Lord = Lord +module Urbit.Vere.Serf.IPC where + +import Urbit.Prelude hiding ((<|)) + +import Data.Conduit +import Urbit.Arvo +import Urbit.Vere.Pier.Types hiding (Work) + +import System.Process (ProcessHandle) +import Urbit.Time (Wen) + + +-- Types ----------------------------------------------------------------------- + +type Gang = Maybe (HoonSet Ship) + +type Goof = (Term, [Tank]) + +data Live + = LExit Atom + | LSave EventId + | LPack EventId + +type PlayBail = (EventId, Mug, Goof) + +data Play + = PDone Mug + | PBail PlayBail + +data Work + = WDone EventId Mug [Ef] + | WSwap EventId Mug (Wen, Noun) [Ef] + | WBail [Goof] + +data Writ + = WLive Live + | WPeek Wen Gang Path + | WPlay EventId [Noun] + | WWork Wen Ev + +data RipeInfo = RipeInfo + { riProt :: Atom + , riHoon :: Atom + , riNock :: Atom + } + +data SerfInfo = SerfInfo + { siRipe :: RipeInfo + , siEvId :: EventId + , siHash :: Mug + } + +data Plea + = PLive () + | PRipe SerfInfo + | PSlog Atom Tank + | PPeek (Maybe (Term, Noun)) + | PPlay Play + | PWork Work + +deriveNoun ''Live +deriveNoun ''Play +deriveNoun ''Work +deriveNoun ''Writ +deriveNoun ''RipeInfo +deriveNoun ''SerfInfo +deriveNoun ''Plea + +{- + startup: + wait for `PRipe` + + replay: + send WPlay + wait for PPlay + crash on PRipe or PWork + (maybe send LSave, LPack, LExit) + (print slogs) + + running: + Send WLive or WWork + wait for PWork + crash on PRipe or PPlay + (maybe send LSave, LPack, LExit) + (print slogs) + crash on +-} + +data Serf = Serf { sendHandle :: Handle , recvHandle :: Handle , process :: ProcessHandle - , foo :: TVar(EventId, Mug) - , sent :: TVar(Seq Writ) - , pending :: TVar(Seq Writ) } -data SerfConfig = SerfConfig() -- binary, directory, &c -data SerfInfo = SerfInfo - { siNock :: Atom - , siHoon :: Atom +{- +data Lord = Lord + { serf :: Serf + , foo :: TVar (EventId, Mug) + , sent :: TVar (Seq Writ) + , pending :: TVar (Seq Writ) } +-} -start :: SerfConfig -> IO(Lord, SerfInfo) -start = undefined +data SerfConfig = SerfConfig -- binary, directory, &c -pack :: Lord -> IO() -- wait for queue to drain, then send with latest EventId -pack l = atomically $ do - q <- readTVar(pending l) - writeTVar(pending l) ((Pack 0) <| q) +data RunError + = RunBail [Goof] + | RunSwap EventId Mug Wen Noun [Ef] +data RunInput + = RunSnap + | RunPack + | RunPeek Wen Gang Path (Maybe (Term, Noun) -> IO ()) + | RunWork Wen Ev (RunError -> IO ()) + +data RunOutput = RunOutput EventId Mug Wen (Either Noun Ev) [Ef] + + +-- Low Level IPC Functions ----------------------------------------------------- + +send :: Serf -> Writ -> IO () +send = error "TODO" + +recv :: Serf -> IO Plea +recv = error "TODO" + +recvPlay :: Serf -> IO Play +recvPlay serf = recv serf >>= \case + PLive () -> error "unexpected %live plea." + PRipe si -> error "TODO: crash" + PPeek _ -> error "TODO: crash" + PWork _ -> error "TODO: crash" + PPlay play -> pure play + PSlog a t -> do + io $ print (a, t) -- TODO + recvPlay serf + +recvLive :: Serf -> IO () +recvLive serf = recv serf >>= \case + PLive () -> pure () + PRipe si -> error "TODO: crash" + PPeek _ -> error "TODO: crash" + PWork _ -> error "TODO: crash" + PPlay play -> error "TODO: crash" + PSlog a t -> do + io $ print (a, t) -- TODO + recvLive serf + +-- TODO Should eid just be a mutable var in the serf? +snapshot :: Serf -> EventId -> IO () +snapshot serf eve = do + send serf (WLive $ LSave eve) + recvLive serf + +compact :: Serf -> EventId -> IO () +compact serf eve = do + send serf (WLive $ LPack eve) + recvLive serf + +recvWork :: Serf -> IO Work +recvWork = error "TODO" + +recvPeek :: Serf -> IO (Maybe (Term, Noun)) +recvPeek = error "TODO" + +scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) +scry serf w g p = do + send serf (WPeek w g p) + recvPeek serf + + +-- Serf Usage Flows ------------------------------------------------------------ + +start :: SerfConfig -> IO (Serf, SerfInfo) +start = error "TODO" + +{- + TODO wait for process exit? + TODO force shutdown after time period? Not our job? +-} +shutdown :: Serf -> Atom -> IO () +shutdown serf exitCode = do + send serf (WLive $ LExit exitCode) + pure () + +{- + TODO Take advantage of IPC support for batching. + TODO Maybe take snapshots +-} +replay + :: Serf -> SerfInfo -> ConduitT Noun Void IO (Either PlayBail (Mug, EventId)) +replay serf info = go (siHash info) (siEvId info) + where + go :: Mug -> EventId -> ConduitT Noun Void IO (Either PlayBail (Mug, EventId)) + go mug eid = await >>= \case + Nothing -> pure (Right (mug, eid)) + Just no -> do + io $ send serf (WPlay eid [no]) + io (recvPlay serf) >>= \case + PBail bail -> pure (Left bail) + PDone hash -> go hash (eid + 1) + +{- + TODO callbacks on snapshot and compaction? + TODO Take advantage of async IPC to fill pipe with more than one thing. +-} +running :: Serf -> SerfInfo -> ConduitT RunInput RunOutput IO (Mug, EventId) +running serf info = go (siHash info) (siEvId info) + where + go mug eve = await >>= \case + Nothing -> pure (mug, eve) + Just RunSnap -> do + io (snapshot serf eve) + go mug eve + Just RunPack -> do + io (compact serf eve) + go mug eve + Just (RunPeek wen gang pax act) -> do + res <- io (scry serf wen gang pax) + io (act res) + go mug eve + Just (RunWork wen evn err) -> do + io (send serf (WWork wen evn)) + io (recvWork serf) >>= \case + WDone eid hash fx -> do + yield (RunOutput eid hash wen (Right evn) fx) + go hash eid + WSwap eid hash (wen, noun) fx -> do + io $ err (RunSwap eid hash wen noun fx) + yield (RunOutput eid hash wen (Left noun) fx) + go hash eid + WBail goofs -> do + io $ err (RunBail goofs) + go mug eve From e10d8ab9cb8bda7489567cf9f4009d086a536c9e Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 21 May 2020 22:42:00 +0000 Subject: [PATCH 093/257] king: Fleshed out some IPC flows for new protocol. --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 199 ++++++++++++------- sh/test | 2 + 2 files changed, 132 insertions(+), 69 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index bebab5607..c1c0735a3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -40,11 +40,17 @@ import Data.Conduit import Urbit.Arvo import Urbit.Vere.Pier.Types hiding (Work) -import System.Process (ProcessHandle) -import Urbit.Time (Wen) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr (castPtr) +import Foreign.Storable (peek, poke) +import System.Process (ProcessHandle) +import Urbit.Time (Wen) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BS --- Types ----------------------------------------------------------------------- +-- IPC Types ------------------------------------------------------------------- type Gang = Maybe (HoonSet Ship) @@ -54,43 +60,52 @@ data Live = LExit Atom | LSave EventId | LPack EventId + deriving (Show) type PlayBail = (EventId, Mug, Goof) data Play = PDone Mug | PBail PlayBail + deriving (Show) data Work = WDone EventId Mug [Ef] | WSwap EventId Mug (Wen, Noun) [Ef] | WBail [Goof] + deriving (Show) data Writ = WLive Live | WPeek Wen Gang Path | WPlay EventId [Noun] | WWork Wen Ev + deriving (Show) data RipeInfo = RipeInfo { riProt :: Atom , riHoon :: Atom , riNock :: Atom } + deriving (Show) data SerfInfo = SerfInfo { siRipe :: RipeInfo , siEvId :: EventId , siHash :: Mug } + deriving (Show) + +type Slog = (Atom, Tank) data Plea = PLive () | PRipe SerfInfo - | PSlog Atom Tank + | PSlog Slog | PPeek (Maybe (Term, Noun)) | PPlay Play | PWork Work + deriving (Show) deriveNoun ''Live deriveNoun ''Play @@ -100,40 +115,15 @@ deriveNoun ''RipeInfo deriveNoun ''SerfInfo deriveNoun ''Plea -{- - startup: - wait for `PRipe` - - replay: - send WPlay - wait for PPlay - crash on PRipe or PWork - (maybe send LSave, LPack, LExit) - (print slogs) - - running: - Send WLive or WWork - wait for PWork - crash on PRipe or PPlay - (maybe send LSave, LPack, LExit) - (print slogs) - crash on --} - data Serf = Serf - { sendHandle :: Handle - , recvHandle :: Handle - , process :: ProcessHandle + { serfSend :: Handle + , serfRecv :: Handle + , serfProc :: ProcessHandle + , serfSlog :: Slog -> IO () } -{- -data Lord = Lord - { serf :: Serf - , foo :: TVar (EventId, Mug) - , sent :: TVar (Seq Writ) - , pending :: TVar (Seq Writ) - } --} + +-- API Types ------------------------------------------------------------------- data SerfConfig = SerfConfig -- binary, directory, &c @@ -150,56 +140,127 @@ data RunInput data RunOutput = RunOutput EventId Mug Wen (Either Noun Ev) [Ef] +-- Exceptions ------------------------------------------------------------------ + +data SerfExn +-- = BadComputeId EventId WorkResult +-- | BadReplacementId EventId ReplacementEv +-- | UnexpectedPlay EventId (EventId, Mug) + = UnexpectedPlea Plea Text + | BadPleaAtom Atom + | BadPleaNoun Noun [Text] Text +-- | ReplacedEventDuringReplay EventId ReplacementEv +-- | ReplacedEventDuringBoot EventId ReplacementEv +-- | EffectsDuringBoot EventId FX + | SerfConnectionClosed +-- | UnexpectedPleaOnNewShip Plea +-- | InvalidInitialPlea Plea + deriving (Show, Exception) + + -- Low Level IPC Functions ----------------------------------------------------- -send :: Serf -> Writ -> IO () -send = error "TODO" +fromRightExn :: (Exception e, MonadIO m) => Either a b -> (a -> e) -> m b +fromRightExn (Left m) exn = throwIO (exn m) +fromRightExn (Right x) _ = pure x -recv :: Serf -> IO Plea -recv = error "TODO" +withWord64AsByteString :: Word64 -> (ByteString -> IO a) -> IO a +withWord64AsByteString w k = alloca $ \wp -> do + poke wp w + bs <- BS.unsafePackCStringLen (castPtr wp, 8) + k bs + +sendLen :: Serf -> Int -> IO () +sendLen s i = do + w <- evaluate (fromIntegral i :: Word64) + withWord64AsByteString (fromIntegral i) (hPut (serfSend s)) + +sendBytes :: Serf -> ByteString -> IO () +sendBytes s bs = handle onIOError $ do + sendLen s (length bs) + hPut (serfSend s) bs + hFlush (serfSend s) + where + onIOError :: IOError -> IO () + onIOError = const (throwIO SerfConnectionClosed) + +recvBytes :: Serf -> Word64 -> IO ByteString +recvBytes serf = io . BS.hGet (serfRecv serf) . fromIntegral + +recvLen :: Serf -> IO Word64 +recvLen w = do + bs <- BS.hGet (serfRecv w) 8 + case length bs of + 8 -> BS.unsafeUseAsCString bs (peek . castPtr) + _ -> throwIO SerfConnectionClosed + +recvAtom :: Serf -> IO Atom +recvAtom w = do + len <- recvLen w + bytesAtom <$> recvBytes w len + + +-- Send Writ / Recv Plea ------------------------------------------------------- + +sendWrit :: Serf -> Writ -> IO () +sendWrit s w = do + sendBytes s $ jamBS $ toNoun w + +recvPlea :: Serf -> IO Plea +recvPlea w = do + a <- recvAtom w + n <- fromRightExn (cue a) (const $ BadPleaAtom a) + p <- fromRightExn (fromNounErr n) (\(p, m) -> BadPleaNoun n p m) + pure p + +recvPleaHandlingSlog :: Serf -> IO Plea +recvPleaHandlingSlog serf = loop + where + loop = recvPlea serf >>= \case + PSlog info -> serfSlog serf info >> loop + other -> pure other + + +-- Higher-Level IPC Functions -------------------------------------------------- recvPlay :: Serf -> IO Play -recvPlay serf = recv serf >>= \case - PLive () -> error "unexpected %live plea." - PRipe si -> error "TODO: crash" - PPeek _ -> error "TODO: crash" - PWork _ -> error "TODO: crash" +recvPlay serf = recvPleaHandlingSlog serf >>= \case PPlay play -> pure play - PSlog a t -> do - io $ print (a, t) -- TODO - recvPlay serf + plea -> throwIO (UnexpectedPlea plea "expecting %play") recvLive :: Serf -> IO () -recvLive serf = recv serf >>= \case - PLive () -> pure () - PRipe si -> error "TODO: crash" - PPeek _ -> error "TODO: crash" - PWork _ -> error "TODO: crash" - PPlay play -> error "TODO: crash" - PSlog a t -> do - io $ print (a, t) -- TODO - recvLive serf +recvLive serf = recvPleaHandlingSlog serf >>= \case + PLive () -> pure () + plea -> throwIO (UnexpectedPlea plea "expecting %live") + +recvWork :: Serf -> IO Work +recvWork serf = do + recvPleaHandlingSlog serf >>= \case + PWork work -> pure work + plea -> throwIO (UnexpectedPlea plea "expecting %work") + +recvPeek :: Serf -> IO (Maybe (Term, Noun)) +recvPeek serf = do + recvPleaHandlingSlog serf >>= \case + PPeek peek -> pure peek + plea -> throwIO (UnexpectedPlea plea "expecting %peek") + + +-- Request-Response Points ----------------------------------------------------- --- TODO Should eid just be a mutable var in the serf? snapshot :: Serf -> EventId -> IO () snapshot serf eve = do - send serf (WLive $ LSave eve) + sendWrit serf (WLive $ LSave eve) recvLive serf compact :: Serf -> EventId -> IO () compact serf eve = do - send serf (WLive $ LPack eve) + sendWrit serf (WLive $ LPack eve) recvLive serf -recvWork :: Serf -> IO Work -recvWork = error "TODO" - -recvPeek :: Serf -> IO (Maybe (Term, Noun)) -recvPeek = error "TODO" - scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) scry serf w g p = do - send serf (WPeek w g p) + sendWrit serf (WPeek w g p) recvPeek serf @@ -214,7 +275,7 @@ start = error "TODO" -} shutdown :: Serf -> Atom -> IO () shutdown serf exitCode = do - send serf (WLive $ LExit exitCode) + sendWrit serf (WLive $ LExit exitCode) pure () {- @@ -229,7 +290,7 @@ replay serf info = go (siHash info) (siEvId info) go mug eid = await >>= \case Nothing -> pure (Right (mug, eid)) Just no -> do - io $ send serf (WPlay eid [no]) + io $ sendWrit serf (WPlay eid [no]) io (recvPlay serf) >>= \case PBail bail -> pure (Left bail) PDone hash -> go hash (eid + 1) @@ -254,7 +315,7 @@ running serf info = go (siHash info) (siEvId info) io (act res) go mug eve Just (RunWork wen evn err) -> do - io (send serf (WWork wen evn)) + io (sendWrit serf (WWork wen evn)) io (recvWork serf) >>= \case WDone eid hash fx -> do yield (RunOutput eid hash wen (Right evn) fx) diff --git a/sh/test b/sh/test index dac77b5a8..7bd6ba6d8 100755 --- a/sh/test +++ b/sh/test @@ -2,6 +2,8 @@ set -e +export STACK_YAML="`pwd`/pkg/hs/stack.yaml" + stack test urbit-king --fast pkg=$(nix-build nix/ops -A test --no-out-link "$@") From c5896f5ea074a509ec3a4c40c4d615d2c40e445f Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Fri, 22 May 2020 11:12:28 -0700 Subject: [PATCH 094/257] HasKingEnv + HasPierEnv + misc cleanup --- pkg/hs/urbit-king/lib/Urbit/King/API.hs | 12 +- pkg/hs/urbit-king/lib/Urbit/King/App.hs | 53 ++++--- pkg/hs/urbit-king/lib/Urbit/King/Config.hs | 31 +++-- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 122 ++++++++-------- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 118 ++++++++-------- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 155 +++++++++++---------- pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 4 +- 7 files changed, 272 insertions(+), 223 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/API.hs b/pkg/hs/urbit-king/lib/Urbit/King/API.hs index 085130995..b62203016 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/API.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/API.hs @@ -12,7 +12,7 @@ import Urbit.Prelude import Network.Socket (Socket) import Prelude (read) import Urbit.Arvo (Belt) -import Urbit.King.App (HasConfigDir(..)) +import Urbit.King.App (HasPierPath(..)) import qualified Network.HTTP.Types as H import qualified Network.Wai as W @@ -43,16 +43,16 @@ data King = King {-| Get the filepath of the urbit config directory and the ports file. -} -portsFilePath :: HasConfigDir e => RIO e (FilePath, FilePath) +portsFilePath :: HasPierPath e => RIO e (FilePath, FilePath) portsFilePath = do - dir <- view configDirL + dir <- view pierPathL fil <- pure (dir ".king.ports") pure (dir, fil) {-| Write the ports file. -} -portsFile :: HasConfigDir e => Word -> RAcquire e (FilePath, FilePath) +portsFile :: HasPierPath e => Word -> RAcquire e (FilePath, FilePath) portsFile por = mkRAcquire mkFile (removeFile . snd) where @@ -65,7 +65,7 @@ portsFile por = {-| Get the HTTP port for the running Urbit daemon. -} -readPortsFile :: HasConfigDir e => RIO e (Maybe Word) +readPortsFile :: HasPierPath e => RIO e (Maybe Word) readPortsFile = do (_, fil) <- portsFilePath bs <- readFile fil @@ -86,7 +86,7 @@ kingServer is = {-| Start the HTTP server and write to the ports file. -} -kingAPI :: (HasConfigDir e, HasLogFunc e) +kingAPI :: (HasPierPath e, HasLogFunc e) => RAcquire e King kingAPI = do (port, sock) <- io $ W.openFreePort diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs index 46ed3141f..134c34fc0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs @@ -8,10 +8,12 @@ module Urbit.King.App , runKingEnvNoLog , PierEnv , runPierEnv - , HasConfigDir(..) , HasStderrLogFunc(..) , HasKingId(..) , HasProcId(..) + , HasKingEnv(..) + , HasPierEnv(..) + , module Urbit.King.Config ) where @@ -23,23 +25,25 @@ import System.Posix.Internals (c_getpid) import System.Posix.Types (CPid(..)) import System.Random (randomIO) - -- Constraints ----------------------------------------------------------------- -class HasConfigDir a where - configDirL ∷ Lens' a FilePath + + +-- KingEnv --------------------------------------------------------------------- class HasStderrLogFunc a where stderrLogFuncL :: Lens' a LogFunc -class HasProcId a where - procIdL :: Lens' a Int32 - class HasKingId a where kingIdL :: Lens' a Word16 +class HasProcId a where + procIdL :: Lens' a Int32 --- KingEnv --------------------------------------------------------------------- +class (HasLogFunc a, HasStderrLogFunc a, HasKingId a, HasProcId a) + => HasKingEnv a + where + kingEnvL :: Lens' a KingEnv data KingEnv = KingEnv { _kingEnvLogFunc :: !LogFunc @@ -50,6 +54,9 @@ data KingEnv = KingEnv makeLenses ''KingEnv +instance HasKingEnv KingEnv where + kingEnvL = id + instance HasLogFunc KingEnv where logFuncL = kingEnvLogFunc @@ -105,6 +112,9 @@ runKingEnv logFunc stderr action = do -- PierEnv --------------------------------------------------------------------- +class (HasKingEnv a, HasPierConfig a, HasNetworkConfig a) => HasPierEnv a where + pierEnvL :: Lens' a PierEnv + data PierEnv = PierEnv { _pierEnvKingEnv :: !KingEnv , _pierEnvPierConfig :: !PierConfig @@ -113,11 +123,26 @@ data PierEnv = PierEnv makeLenses ''PierEnv +instance HasKingEnv PierEnv where + kingEnvL = pierEnvKingEnv + +instance HasPierEnv PierEnv where + pierEnvL = id + +instance HasKingId PierEnv where + kingIdL = kingEnvL . kingEnvKingId + instance HasStderrLogFunc PierEnv where - stderrLogFuncL = pierEnvKingEnv . stderrLogFuncL + stderrLogFuncL = kingEnvL . stderrLogFuncL instance HasLogFunc PierEnv where - logFuncL = pierEnvKingEnv . logFuncL + logFuncL = kingEnvL . logFuncL + +instance HasPierPath PierEnv where + pierPathL = pierEnvPierConfig . pierPathL + +instance HasDryRun PierEnv where + dryRunL = pierEnvPierConfig . dryRunL instance HasPierConfig PierEnv where pierConfigL = pierEnvPierConfig @@ -125,14 +150,8 @@ instance HasPierConfig PierEnv where instance HasNetworkConfig PierEnv where networkConfigL = pierEnvNetworkConfig -instance HasConfigDir PierEnv where - configDirL = pierEnvPierConfig . pcPierPath - instance HasProcId PierEnv where - procIdL = pierEnvKingEnv . kingEnvProcId - -instance HasKingId PierEnv where - kingIdL = pierEnvKingEnv . kingEnvKingId + procIdL = kingEnvL . kingEnvProcId -- Running Pier Envs ----------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs index 9fa95ae87..cd9d0acb4 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs @@ -1,29 +1,36 @@ {-| - Pier Configuration + Pier Configuration -} module Urbit.King.Config where import Urbit.Prelude {-| - All the configuration data revolving around a ship and the current - execution options. + All the configuration data revolving around a ship and the current + execution options. -} data PierConfig = PierConfig - { _pcPierPath :: FilePath - , _pcDryRun :: Bool - } deriving (Show) + { _pcPierPath :: FilePath + , _pcDryRun :: Bool + } deriving (Show) makeLenses ''PierConfig -class HasPierConfig env where - pierConfigL :: Lens' env PierConfig +class HasPierPath a where + pierPathL :: Lens' a FilePath -pierPathL ∷ HasPierConfig a => Lens' a FilePath -pierPathL = pierConfigL . pcPierPath +class HasDryRun a where + dryRunL :: Lens' a Bool + +class (HasPierPath a, HasDryRun a) => HasPierConfig a where + pierConfigL :: Lens' a PierConfig + +instance HasPierPath PierConfig where + pierPathL = pcPierPath + +instance HasDryRun PierConfig where + dryRunL = pcDryRun -dryRunL :: HasPierConfig a => Lens' a Bool -dryRunL = pierConfigL . pcDryRun ------------------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index acd2013e8..4f6c189f6 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -93,7 +93,6 @@ import System.Process (system) import Text.Show.Pretty (pPrint) import Urbit.King.App (KingEnv, PierEnv) import Urbit.King.App (runKingEnvLogFile, runKingEnvStderr, runPierEnv) -import Urbit.King.App (HasStderrLogFunc(..)) import Urbit.Noun.Conversions (cordToUW) import Urbit.Time (Wen) import Urbit.Vere.LockFile (lockFile) @@ -190,7 +189,7 @@ tryBootFromPill oExit pill lite flags ship boot multi = do pure sls runOrExitImmediately - :: RAcquire PierEnv (Serf PierEnv, Log.EventLog, SerfState) + :: RAcquire PierEnv (Serf, Log.EventLog, SerfState) -> Bool -> MVar () -> MultiEyreApi @@ -221,27 +220,27 @@ tryPlayShip -> MultiEyreApi -> RIO PierEnv () tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do - when fullReplay wipeSnapshot - runOrExitImmediately resumeShip exitImmediately mStart multi - where - wipeSnapshot = do - shipPath <- view pierPathL - logTrace "wipeSnapshot" - logDebug $ display $ pack @Text ("Wiping " <> north shipPath) - logDebug $ display $ pack @Text ("Wiping " <> south shipPath) - removeFileIfExists (north shipPath) - removeFileIfExists (south shipPath) + when fullReplay wipeSnapshot + runOrExitImmediately resumeShip exitImmediately mStart multi + where + wipeSnapshot = do + shipPath <- view pierPathL + logTrace "wipeSnapshot" + logDebug $ display $ pack @Text ("Wiping " <> north shipPath) + logDebug $ display $ pack @Text ("Wiping " <> south shipPath) + removeFileIfExists (north shipPath) + removeFileIfExists (south shipPath) - north shipPath = shipPath <> "/.urb/chk/north.bin" - south shipPath = shipPath <> "/.urb/chk/south.bin" + north shipPath = shipPath <> "/.urb/chk/north.bin" + south shipPath = shipPath <> "/.urb/chk/south.bin" - resumeShip :: RAcquire PierEnv (Serf PierEnv, Log.EventLog, SerfState) - resumeShip = do - view pierPathL >>= lockFile - rio $ logTrace "RESUMING SHIP" - sls <- Pier.resumed playFrom flags - rio $ logTrace "SHIP RESUMED" - pure sls + resumeShip :: RAcquire PierEnv (Serf, Log.EventLog, SerfState) + resumeShip = do + view pierPathL >>= lockFile + rio $ logTrace "RESUMING SHIP" + sls <- Pier.resumed playFrom flags + rio $ logTrace "SHIP RESUMED" + pure sls runRAcquire :: (MonadUnliftIO (m e), MonadIO (m e), MonadReader e (m e)) => RAcquire e a -> m e a @@ -249,45 +248,51 @@ runRAcquire act = rwith act pure -------------------------------------------------------------------------------- -checkEvs :: forall e. HasLogFunc e => FilePath -> Word64 -> Word64 -> RIO e () +checkEvs :: FilePath -> Word64 -> Word64 -> RIO KingEnv () checkEvs pierPath first last = do - rwith (Log.existing logPath) $ \log -> do - let ident = Log.identity log - let pbSty = PB.defStyle { PB.stylePostfix = PB.exact } - logTrace (displayShow ident) + rwith (Log.existing logPath) $ \log -> do + let ident = Log.identity log + let pbSty = PB.defStyle { PB.stylePostfix = PB.exact } + logTrace (displayShow ident) - last <- Log.lastEv log <&> \lastReal -> min last lastReal + last <- Log.lastEv log <&> \lastReal -> min last lastReal - let evCount = fromIntegral (last - first) + let evCount = fromIntegral (last - first) - pb <- PB.newProgressBar pbSty 10 (PB.Progress 1 evCount ()) + pb <- PB.newProgressBar pbSty 10 (PB.Progress 1 evCount ()) - runConduit $ Log.streamEvents log first - .| showEvents pb first (fromIntegral $ lifecycleLen ident) - where - logPath :: FilePath - logPath = pierPath <> "/.urb/log" + runConduit $ Log.streamEvents log first .| showEvents + pb + first + (fromIntegral $ lifecycleLen ident) + where + logPath :: FilePath + logPath = pierPath <> "/.urb/log" - showEvents :: PB.ProgressBar () -> EventId -> EventId - -> ConduitT ByteString Void (RIO e) () - showEvents pb eId _ | eId > last = pure () - showEvents pb eId cycle = await >>= \case - Nothing -> do - lift $ PB.killProgressBar pb - lift $ logTrace "Everything checks out." - Just bs -> do - lift $ PB.incProgress pb 1 - lift $ do - n <- io $ cueBSExn bs - when (eId > cycle) $ do - (mug, wen, evNoun) <- unpackJob n - fromNounErr evNoun & \case - Left err -> logError (displayShow (eId, err)) - Right (_ ∷ Ev) -> pure () - showEvents pb (succ eId) cycle + showEvents + :: PB.ProgressBar () + -> EventId + -> EventId + -> ConduitT ByteString Void (RIO KingEnv) () + showEvents pb eId _ | eId > last = pure () + showEvents pb eId cycle = await >>= \case + Nothing -> do + lift $ PB.killProgressBar pb + lift $ logTrace "Everything checks out." + Just bs -> do + lift $ PB.incProgress pb 1 + lift $ do + n <- io $ cueBSExn bs + when (eId > cycle) $ do + (mug, wen, evNoun) <- unpackJob n + fromNounErr evNoun & \case + Left err -> logError (displayShow (eId, err)) + Right (_ :: Ev) -> pure () + showEvents pb (succ eId) cycle + + unpackJob :: Noun -> RIO KingEnv (Mug, Wen, Noun) + unpackJob = io . fromNounExn - unpackJob :: Noun -> RIO e (Mug, Wen, Noun) - unpackJob = io . fromNounExn -------------------------------------------------------------------------------- @@ -296,7 +301,7 @@ checkEvs pierPath first last = do so this should never actually be created. We just do this to avoid letting the serf use an existing snapshot. -} -collectAllFx :: ∀e. HasLogFunc e => FilePath -> RIO e () +collectAllFx :: FilePath -> RIO KingEnv () collectAllFx top = do logTrace $ display $ pack @Text top rwith collectedFX $ \() -> @@ -305,7 +310,7 @@ collectAllFx top = do tmpDir :: FilePath tmpDir = top ".tmpdir" - collectedFX :: RAcquire e () + collectedFX :: RAcquire KingEnv () collectedFX = do lockFile top log <- Log.existing (top <> "/.urb/log") @@ -317,15 +322,14 @@ collectAllFx top = do -------------------------------------------------------------------------------- -replayPartEvs :: ∀e. (HasStderrLogFunc e, HasLogFunc e) - => FilePath -> Word64 -> RIO e () +replayPartEvs :: FilePath -> Word64 -> RIO KingEnv () replayPartEvs top last = do logTrace $ display $ pack @Text top fetchSnapshot rwith replayedEvs $ \() -> logTrace "Done replaying events!" where - fetchSnapshot :: RIO e () + fetchSnapshot :: RIO KingEnv () fetchSnapshot = do snap <- Pier.getSnapshot top last case snap of @@ -337,7 +341,7 @@ replayPartEvs top last = do tmpDir :: FilePath tmpDir = top ".partial-replay" show last - replayedEvs :: RAcquire e () + replayedEvs :: RAcquire KingEnv () replayedEvs = do lockFile top log <- Log.existing (top <> "/.urb/log") diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index eb9dcb5ab..6ed1cd4e2 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -1,12 +1,19 @@ {-| - Top-Level Pier Management + Top-Level Pier Management - This is the code that starts the IO drivers and deals with - communication between the serf, the log, and the IO drivers. + This is the code that starts the IO drivers and deals with + communication between the serf, the log, and the IO drivers. -} module Urbit.Vere.Pier - ( booted, resumed, getSnapshot, pier, runPersist, runCompute, generateBootSeq - ) where + ( booted + , resumed + , getSnapshot + , pier + , runPersist + , runCompute + , generateBootSeq + ) +where import Urbit.Prelude @@ -18,8 +25,7 @@ import Urbit.Vere.Pier.Types import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) -import Urbit.King.App (HasConfigDir(..), HasKingId(..), - HasStderrLogFunc(..)) +import Urbit.King.App (HasKingEnv, HasPierEnv, PierEnv) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -42,14 +48,12 @@ import qualified Urbit.Vere.Term.Render as Term -------------------------------------------------------------------------------- -_ioDrivers = [] :: [IODriver] - setupPierDirectory :: FilePath -> RIO e () setupPierDirectory shipPath = do - for_ ["put", "get", "log", "chk"] $ \seg -> do - let pax = shipPath <> "/.urb/" <> seg - createDirectoryIfMissing True pax - io $ setFileMode pax ownerModes + for_ ["put", "get", "log", "chk"] $ \seg -> do + let pax = shipPath <> "/.urb/" <> seg + createDirectoryIfMissing True pax + io $ setFileMode pax ownerModes -- Load pill into boot sequence. ----------------------------------------------- @@ -58,45 +62,50 @@ genEntropy :: RIO e Word512 genEntropy = fromIntegral . bytesAtom <$> io (Ent.getEntropy 64) generateBootSeq :: Ship -> Pill -> Bool -> LegacyBootEvent -> RIO e BootSeq -generateBootSeq ship Pill{..} lite boot = do - ent <- genEntropy - let ovums = preKern ent <> pKernelOvums <> postKern <> pUserspaceOvums - pure $ BootSeq ident pBootFormulas ovums - where - ident = LogIdentity ship isFake (fromIntegral $ length pBootFormulas) - preKern ent = [ EvBlip $ BlipEvArvo $ ArvoEvWhom () ship - , EvBlip $ BlipEvArvo $ ArvoEvWack () ent - ] - postKern = [ EvBlip $ BlipEvTerm $ TermEvBoot (1,()) lite boot ] - isFake = case boot of - Fake _ -> True - _ -> False +generateBootSeq ship Pill {..} lite boot = do + ent <- genEntropy + let ovums = preKern ent <> pKernelOvums <> postKern <> pUserspaceOvums + pure $ BootSeq ident pBootFormulas ovums + where + ident = LogIdentity ship isFake (fromIntegral $ length pBootFormulas) + preKern ent = + [ EvBlip $ BlipEvArvo $ ArvoEvWhom () ship + , EvBlip $ BlipEvArvo $ ArvoEvWack () ent + ] + postKern = [EvBlip $ BlipEvTerm $ TermEvBoot (1, ()) lite boot] + isFake = case boot of + Fake _ -> True + _ -> False -- Write a batch of jobs into the event log ------------------------------------ writeJobs :: EventLog -> Vector Job -> RIO e () writeJobs log !jobs = do - expect <- Log.nextEv log - events <- fmap fromList $ traverse fromJob (zip [expect..] $ toList jobs) - Log.appendEvents log events - where - fromJob :: (EventId, Job) -> RIO e ByteString - fromJob (expectedId, job) = do - unless (expectedId == jobId job) $ - error $ show ("bad job id!", expectedId, jobId job) - pure $ jamBS $ jobPayload job + expect <- Log.nextEv log + events <- fmap fromList $ traverse fromJob (zip [expect ..] $ toList jobs) + Log.appendEvents log events + where + fromJob :: (EventId, Job) -> RIO e ByteString + fromJob (expectedId, job) = do + unless (expectedId == jobId job) $ error $ show + ("bad job id!", expectedId, jobId job) + pure $ jamBS $ jobPayload job - jobPayload :: Job -> Noun - jobPayload (RunNok (LifeCyc _ m n)) = toNoun (m, n) - jobPayload (DoWork (Work _ m d o)) = toNoun (m, d, o) + jobPayload :: Job -> Noun + jobPayload (RunNok (LifeCyc _ m n)) = toNoun (m, n) + jobPayload (DoWork (Work _ m d o )) = toNoun (m, d, o) -- Boot a new ship. ------------------------------------------------------------ -booted :: (HasPierConfig e, HasStderrLogFunc e, HasLogFunc e) - => Pill -> Bool -> Serf.Flags -> Ship -> LegacyBootEvent - -> RAcquire e (Serf e, EventLog, SerfState) +booted + :: Pill + -> Bool + -> Serf.Flags + -> Ship + -> LegacyBootEvent + -> RAcquire PierEnv (Serf, EventLog, SerfState) booted pill lite flags ship boot = do seq@(BootSeq ident x y) <- rio $ generateBootSeq ship pill lite boot @@ -128,9 +137,10 @@ booted pill lite flags ship boot = do -- Resume an existing ship. ---------------------------------------------------- -resumed :: (HasStderrLogFunc e, HasPierConfig e, HasLogFunc e) - => Maybe Word64 -> Serf.Flags - -> RAcquire e (Serf e, EventLog, SerfState) +resumed + :: Maybe Word64 + -> Serf.Flags + -> RAcquire PierEnv (Serf, EventLog, SerfState) resumed event flags = do rio $ logTrace "Resuming ship" top <- view pierPathL @@ -172,14 +182,8 @@ acquireWorker :: RIO e () -> RAcquire e (Async ()) acquireWorker act = mkRAcquire (async act) cancel pier - :: forall e - . ( HasConfigDir e - , HasLogFunc e - , HasNetworkConfig e - , HasPierConfig e - , HasKingId e - ) - => (Serf e, EventLog, SerfState) + :: forall e. HasPierEnv e + => (Serf, EventLog, SerfState) -> MVar () -> MultiEyreApi -> RAcquire e () @@ -190,7 +194,7 @@ pier (serf, log, ss) mStart multi = do saveM <- newEmptyTMVarIO shutdownM <- newEmptyTMVarIO - kapi ← King.kingAPI + kapi <- King.kingAPI termApiQ <- atomically $ do q <- newTQueue @@ -294,7 +298,7 @@ data Drivers e = Drivers } drivers - :: (HasLogFunc e, HasKingId e, HasNetworkConfig e, HasPierConfig e) + :: HasPierEnv e => e -> MultiEyreApi -> Ship @@ -377,8 +381,8 @@ logEffect ef = GoodParse e -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow e FailParse n -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow n -runCompute :: ∀e. HasLogFunc e - => Serf e +runCompute :: ∀e. HasKingEnv e + => Serf -> SerfState -> STM Ev -> STM () @@ -433,7 +437,7 @@ instance Exception PersistExn where , "\tExpected " <> show expected <> " but got " <> show got ] -runPersist :: ∀e. (HasPierConfig e, HasLogFunc e) +runPersist :: ∀e. HasPierEnv e => EventLog -> TQueue (Job, FX) -> (FX -> STM ()) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index ac9b1f035..efa47450b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -26,7 +26,7 @@ import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (castPtr) import Foreign.Storable (peek, poke) import System.Exit (ExitCode) -import Urbit.King.App (HasStderrLogFunc(..)) +import Urbit.King.App (HasStderrLogFunc(..), HasKingEnv(..)) import qualified Data.ByteString.Unsafe as BS import qualified Data.Conduit.Combinators as CC @@ -75,11 +75,11 @@ data SerfState = SerfState ssLastEv :: SerfState -> EventId ssLastEv = pred . ssNextEv -data Serf e = Serf +data Serf = Serf { sendHandle :: Handle , recvHandle :: Handle , process :: ProcessHandle - , sStderr :: MVar (Text -> RIO e ()) + , sStderr :: MVar (Text -> IO ()) } data ShipId = ShipId Ship Bool @@ -123,7 +123,7 @@ deriveNoun ''Plea -- Utils ----------------------------------------------------------------------- printTank :: HasLogFunc e - => MVar (Text -> RIO e ()) -> Word32 -> Tank + => MVar (Text -> IO ()) -> Word32 -> Tank -> RIO e () printTank log _pri = printErr log . unlines . fmap unTape . wash (WashCfg 0 80) @@ -134,18 +134,18 @@ fromRightExn :: (Exception e, MonadIO m) => Either a b -> (a -> e) -> m b fromRightExn (Left m) exn = throwIO (exn m) fromRightExn (Right x) _ = pure x -printErr :: MVar (Text -> RIO e ()) -> Text -> RIO e () +printErr :: MVar (Text -> IO ()) -> Text -> RIO e () printErr m txt = do f <- readMVar m - f txt + io (f txt) -- Process Management ---------------------------------------------------------- -run :: HasLogFunc e => Config -> RAcquire e (Serf e) +run :: HasKingEnv e => Config -> RAcquire e Serf run config = mkRAcquire (startUp config) tearDown -startUp :: HasLogFunc e => Config -> RIO e (Serf e) +startUp :: HasKingEnv e => Config -> RIO e Serf startUp conf@(Config pierPath flags) = do logTrace "STARTING SERF" logTrace (displayShow conf) @@ -154,7 +154,8 @@ startUp conf@(Config pierPath flags) = do (Just i, Just o, Just e, p) <- createProcess pSpec pure (i, o, e, p) - stderr <- newMVar serf + env <- ask + stderr <- newMVar (\t -> runRIO env (serf t)) async (readStdErr e stderr) pure (Serf i o p stderr) where @@ -167,7 +168,7 @@ startUp conf@(Config pierPath flags) = do , std_err = CreatePipe } -readStdErr :: ∀e. HasLogFunc e => Handle -> MVar (Text -> RIO e ()) -> RIO e () +readStdErr :: ∀e. HasKingEnv e => Handle -> MVar (Text -> IO ()) -> RIO e () readStdErr h print = untilEOFExn $ do raw <- io $ IO.hGetLine h @@ -189,7 +190,7 @@ readStdErr h print = Left exn -> io (IO.ioError exn) Right () -> loop -tearDown :: HasLogFunc e => Serf e -> RIO e () +tearDown :: HasKingEnv e => Serf -> RIO e () tearDown serf = do io $ terminateProcess (process serf) void $ waitForExit serf @@ -204,13 +205,13 @@ tearDown serf = do -- debug killedMsg -- terminateProcess (process serf) -waitForExit :: HasLogFunc e => Serf e -> RIO e ExitCode +waitForExit :: HasKingEnv e => Serf -> RIO e ExitCode waitForExit = io . waitForProcess . process -kill :: HasLogFunc e => Serf e -> RIO e ExitCode +kill :: HasKingEnv e => Serf -> RIO e ExitCode kill serf = io (terminateProcess $ process serf) >> waitForExit serf -_shutdownAndWait :: HasLogFunc e => Serf e -> Word8 -> RIO e ExitCode +_shutdownAndWait :: HasKingEnv e => Serf -> Word8 -> RIO e ExitCode _shutdownAndWait serf code = do shutdown serf code waitForExit serf @@ -226,18 +227,18 @@ withWord64AsByteString w k = do bs <- BS.unsafePackCStringLen (castPtr wp, 8) runRIO env (k bs) -sendLen :: HasLogFunc e => Serf e -> Int -> RIO e () +sendLen :: HasLogFunc e => Serf -> Int -> RIO e () sendLen s i = do w <- evaluate (fromIntegral i :: Word64) withWord64AsByteString (fromIntegral i) (hPut (sendHandle s)) -sendOrder :: HasLogFunc e => Serf e -> Order -> RIO e () +sendOrder :: HasLogFunc e => Serf -> Order -> RIO e () sendOrder w o = do -- logDebug $ display ("(sendOrder) " <> tshow o) sendBytes w $ jamBS $ toNoun o -- logDebug "(sendOrder) Done" -sendBytes :: HasLogFunc e => Serf e -> ByteString -> RIO e () +sendBytes :: HasLogFunc e => Serf -> ByteString -> RIO e () sendBytes s bs = handle ioErr $ do sendLen s (length bs) hPut (sendHandle s) bs @@ -247,18 +248,18 @@ sendBytes s bs = handle ioErr $ do ioErr :: IOError -> RIO e () ioErr _ = throwIO SerfConnectionClosed -recvLen :: (MonadIO m, HasLogFunc e) => Serf e -> m Word64 -recvLen w = io $ do +recvLen :: Serf -> IO Word64 +recvLen w = do bs <- hGet (recvHandle w) 8 case length bs of 8 -> unsafeUseAsCString bs (peek . castPtr) _ -> throwIO SerfConnectionClosed -recvBytes :: HasLogFunc e => Serf e -> Word64 -> RIO e ByteString +recvBytes :: Serf -> Word64 -> IO ByteString recvBytes serf = - io . hGet (recvHandle serf) . fromIntegral + hGet (recvHandle serf) . fromIntegral -recvAtom :: HasLogFunc e => Serf e -> RIO e Atom +recvAtom :: Serf -> IO Atom recvAtom w = do len <- recvLen w bytesAtom <$> recvBytes w len @@ -269,21 +270,21 @@ cordText = T.strip . unCord -------------------------------------------------------------------------------- -snapshot :: HasLogFunc e => Serf e -> SerfState -> RIO e () +snapshot :: HasLogFunc e => Serf -> SerfState -> RIO e () snapshot serf ss = do logTrace $ display ("Taking snapshot at event " <> tshow (ssLastEv ss)) sendOrder serf $ OSave $ ssLastEv ss -shutdown :: HasLogFunc e => Serf e -> Word8 -> RIO e () +shutdown :: HasLogFunc e => Serf -> Word8 -> RIO e () shutdown serf code = sendOrder serf (OExit code) {-| TODO Find a cleaner way to handle `PStdr` Pleas. -} -recvPlea :: HasLogFunc e => Serf e -> RIO e Plea +recvPlea :: HasLogFunc e => Serf -> RIO e Plea recvPlea w = do logDebug "(recvPlea) Waiting" - a <- recvAtom w + a <- io (recvAtom w) logDebug "(recvPlea) Got atom" n <- fromRightExn (cue a) (const $ BadPleaAtom a) p <- fromRightExn (fromNounErr n) (\(p,m) -> BadPleaNoun n p m) @@ -298,7 +299,7 @@ recvPlea w = do {-| Waits for initial plea, and then sends boot IPC if necessary. -} -handshake :: HasLogFunc e => Serf e -> LogIdentity -> RIO e SerfState +handshake :: HasLogFunc e => Serf -> LogIdentity -> RIO e SerfState handshake serf ident = do logTrace "Serf Handshake" @@ -317,7 +318,7 @@ handshake serf ident = do pure ss -sendWork :: ∀e. HasLogFunc e => Serf e -> Job -> RIO e SerfResp +sendWork :: ∀e. HasKingEnv e => Serf -> Job -> RIO e SerfResp sendWork w job = do sendOrder w (OWork job) @@ -348,19 +349,19 @@ sendWork w job = -------------------------------------------------------------------------------- -doJob :: HasLogFunc e => Serf e -> Job -> RIO e (Job, SerfState, FX) +doJob :: HasKingEnv e => Serf -> Job -> RIO e (Job, SerfState, FX) doJob serf job = do sendWork serf job >>= \case Left replaced -> doJob serf replaced Right (ss, fx) -> pure (job, ss, fx) -bootJob :: HasLogFunc e => Serf e -> Job -> RIO e (Job, SerfState) +bootJob :: HasKingEnv e => Serf -> Job -> RIO e (Job, SerfState) bootJob serf job = do doJob serf job >>= \case (job, ss, _) -> pure (job, ss) -- (job, ss, fx) -> throwIO (EffectsDuringBoot (jobId job) fx) -replayJob :: HasLogFunc e => Serf e -> Job -> RIO e SerfState +replayJob :: HasKingEnv e => Serf -> Job -> RIO e SerfState replayJob serf job = do sendWork serf job >>= \case Left replace -> throwIO (ReplacedEventDuringReplay (jobId job) replace) @@ -368,7 +369,7 @@ replayJob serf job = do -------------------------------------------------------------------------------- -updateProgressBar :: HasLogFunc e +updateProgressBar :: HasKingEnv e => Int -> Text -> Maybe (ProgressBar ()) -> RIO e (Maybe (ProgressBar ())) updateProgressBar count startMsg = \case @@ -391,49 +392,63 @@ data BootExn = ShipAlreadyBooted deriving stock (Eq, Ord, Show) deriving anyclass (Exception) -logStderr :: HasStderrLogFunc e => RIO LogFunc a -> RIO e a +logStderr :: (HasLogFunc e, HasStderrLogFunc e) => RIO e a -> RIO e a logStderr action = do - logFunc <- view stderrLogFuncL - runRIO logFunc action + env <- ask + let env' = env & set logFuncL (env ^. stderrLogFuncL) + runRIO env' action -bootFromSeq :: ∀e. (HasStderrLogFunc e, HasLogFunc e) - => Serf e -> BootSeq -> RIO e ([Job], SerfState) +bootFromSeq + :: forall e + . HasKingEnv e + => Serf + -> BootSeq + -> RIO e ([Job], SerfState) bootFromSeq serf (BootSeq ident nocks ovums) = do - handshake serf ident >>= \case - ss@(SerfState 1 (Mug 0)) -> loop [] ss Nothing bootSeqFns - _ -> throwIO ShipAlreadyBooted + handshake serf ident >>= \case + ss@(SerfState 1 (Mug 0)) -> loop [] ss Nothing bootSeqFns + _ -> throwIO ShipAlreadyBooted + where + loop + :: [Job] + -> SerfState + -> Maybe (ProgressBar ()) + -> [BootSeqFn] + -> RIO e ([Job], SerfState) + loop acc ss pb = \case + [] -> do + pb <- logStderr (updateProgressBar 0 bootMsg pb) + pure (reverse acc, ss) + x : xs -> do + wen <- io Time.now + job <- pure $ x (ssNextEv ss) (ssLastMug ss) wen + pb <- logStderr (updateProgressBar (1 + length xs) bootMsg pb) + (job, ss) <- bootJob serf job + loop (job : acc) ss pb xs - where - loop :: [Job] -> SerfState -> Maybe (ProgressBar ()) -> [BootSeqFn] - -> RIO e ([Job], SerfState) - loop acc ss pb = \case - [] -> do - pb <- logStderr (updateProgressBar 0 bootMsg pb) - pure (reverse acc, ss) - x:xs -> do - wen <- io Time.now - job <- pure $ x (ssNextEv ss) (ssLastMug ss) wen - pb <- logStderr (updateProgressBar (1 + length xs) bootMsg pb) - (job, ss) <- bootJob serf job - loop (job:acc) ss pb xs + bootSeqFns :: [BootSeqFn] + bootSeqFns = fmap muckNock nocks <> fmap muckOvum ovums + where + muckNock nok eId mug _ = RunNok $ LifeCyc eId mug nok + muckOvum ov eId mug wen = DoWork $ Work eId mug wen ov - bootSeqFns :: [BootSeqFn] - bootSeqFns = fmap muckNock nocks <> fmap muckOvum ovums - where - muckNock nok eId mug _ = RunNok $ LifeCyc eId mug nok - muckOvum ov eId mug wen = DoWork $ Work eId mug wen ov - - bootMsg = "Booting " ++ (fakeStr (isFake ident)) ++ - (Ob.renderPatp (Ob.patp (fromIntegral (who ident)))) - fakeStr True = "fake " - fakeStr False = "" + bootMsg = + "Booting " + ++ (fakeStr (isFake ident)) + ++ (Ob.renderPatp (Ob.patp (fromIntegral (who ident)))) + fakeStr True = "fake " + fakeStr False = "" {-| The ship is booted, but it is behind. shove events to the worker until it is caught up. -} -replayJobs :: (HasStderrLogFunc e, HasLogFunc e) - => Serf e -> Int -> SerfState -> ConduitT Job Void (RIO e) SerfState +replayJobs + :: HasKingEnv e + => Serf + -> Int + -> SerfState + -> ConduitT Job Void (RIO e) SerfState replayJobs serf lastEv = go Nothing where go pb ss = do @@ -452,8 +467,8 @@ replayJobs serf lastEv = go Nothing updateProgressBar start msg -replay :: (HasStderrLogFunc e, HasLogFunc e) - => Serf e -> Log.EventLog -> Maybe Word64 -> RIO e SerfState +replay + :: HasKingEnv e => Serf -> Log.EventLog -> Maybe Word64 -> RIO e SerfState replay serf log last = do logTrace "Beginning event log replay" @@ -507,7 +522,7 @@ toJobs ident eId = -- Collect Effects for Parsing ------------------------------------------------- -collectFX :: HasLogFunc e => Serf e -> Log.EventLog -> RIO e () +collectFX :: HasKingEnv e => Serf -> Log.EventLog -> RIO e () collectFX serf log = do ss <- handshake serf (Log.identity log) @@ -525,8 +540,8 @@ persistFX log = loop lift $ Log.writeEffectsRow log eId (jamBS $ toNoun fx) loop -doCollectFX :: ∀e. HasLogFunc e - => Serf e -> SerfState -> ConduitT Job (EventId, FX) (RIO e) () +doCollectFX :: ∀e. HasKingEnv e + => Serf -> SerfState -> ConduitT Job (EventId, FX) (RIO e) () doCollectFX serf = go where go :: SerfState -> ConduitT Job (EventId, FX) (RIO e) () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index dcc2342e0..dca916103 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -26,7 +26,7 @@ import Urbit.Vere.Pier.Types import Data.List ((!!)) import RIO.Directory (createDirectoryIfMissing) import Urbit.King.API (readPortsFile) -import Urbit.King.App (HasKingId(..), HasConfigDir(..)) +import Urbit.King.App (HasKingId(..), HasPierPath(..)) import Urbit.Vere.Term.API (Client(Client)) import qualified Data.ByteString.Internal as BS @@ -138,7 +138,7 @@ connectToRemote port local = mkRAcquire start stop data HackConfigDir = HCD { _hcdPax :: FilePath } makeLenses ''HackConfigDir -instance HasConfigDir HackConfigDir where configDirL = hcdPax +instance HasPierPath HackConfigDir where pierPathL = hcdPax runTerminalClient :: ∀e. HasLogFunc e => FilePath -> RIO e () runTerminalClient pier = runRAcquire $ do From 26bd5a9e4bec7f7f51578f8d4e755557bf6ba92a Mon Sep 17 00:00:00 2001 From: ~siprel Date: Tue, 26 May 2020 23:01:03 +0000 Subject: [PATCH 095/257] king: Got new IPC working, still needs lots of polish. --- nix/ops/boot-ship.nix | 3 +- pkg/hs/.gitignore | 1 + pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 69 ++- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 328 +++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 578 ++++--------------- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 206 +++++-- 6 files changed, 527 insertions(+), 658 deletions(-) create mode 100644 pkg/hs/.gitignore diff --git a/nix/ops/boot-ship.nix b/nix/ops/boot-ship.nix index ef78c294d..b54a7a90a 100644 --- a/nix/ops/boot-ship.nix +++ b/nix/ops/boot-ship.nix @@ -10,9 +10,10 @@ let tlon = import ../pkgs { inherit pkgs; }; arvo = tlon.arvo; urbit = tlon.urbit; + herb = tlon.herb; in import ./fakeship { - inherit pkgs tlon deps arvo pill ship debug; + inherit pkgs arvo pill ship urbit herb; } diff --git a/pkg/hs/.gitignore b/pkg/hs/.gitignore new file mode 100644 index 000000000..609770f0c --- /dev/null +++ b/pkg/hs/.gitignore @@ -0,0 +1 @@ +stack.yaml.lock diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index f8e40e099..ec5221075 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -105,7 +105,7 @@ removeFileIfExists pax = do -------------------------------------------------------------------------------- -toSerfFlags :: CLI.Opts -> Serf.Flags +toSerfFlags :: CLI.Opts -> [Serf.Flag] toSerfFlags CLI.Opts{..} = catMaybes m where -- TODO: This is not all the flags. @@ -147,7 +147,7 @@ toNetworkConfig CLI.Opts {..} = NetworkConfig { .. } tryBootFromPill :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e , HasConfigDir e, HasStderrLogFunc e ) - => Bool -> Pill -> Bool -> Serf.Flags -> Ship + => Bool -> Pill -> Bool -> [Serf.Flag] -> Ship -> LegacyBootEvent -> RIO e () tryBootFromPill oExit pill lite flags ship boot = do @@ -161,34 +161,32 @@ tryBootFromPill oExit pill lite flags ship boot = do rio $ logTrace "Completed boot" pure sls -runOrExitImmediately :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e - , HasConfigDir e - ) - => RAcquire e (Serf e, Log.EventLog, SerfState) - -> Bool - -> MVar () - -> RIO e () -runOrExitImmediately getPier oExit mStart = - rwith getPier $ if oExit then shutdownImmediately else runPier - where - shutdownImmediately (serf, log, ss) = do - logTrace "Sending shutdown signal" - logTrace $ displayShow ss +runOrExitImmediately + :: forall e + . (HasLogFunc e, HasNetworkConfig e, HasPierConfig e, HasConfigDir e) + => RAcquire e (Serf, Log.EventLog) + -> Bool + -> MVar () + -> RIO e () +runOrExitImmediately getPier oExit mStart = do + rwith getPier (if oExit then shutdownImmediately else runPier) + where + shutdownImmediately :: (Serf, Log.EventLog) -> RIO e () + shutdownImmediately (serf, log) = do + logTrace "Sending shutdown signal" + Serf.execShutdown serf + logTrace "Shutdown!" - -- Why is this here? Do I need to force a snapshot to happen? - io $ threadDelay 500000 - - ss <- shutdown serf 0 - logTrace $ displayShow ss - logTrace "Shutdown!" - - runPier sls = do - runRAcquire $ Pier.pier sls mStart + runPier :: (Serf, Log.EventLog) -> RIO e () + runPier serfLog = do + let defaultStderr txt = putStrLn "txt" -- TODO XX What did we do before? + vStderr <- newTVarIO defaultStderr + runRAcquire (Pier.pier serfLog vStderr mStart) tryPlayShip :: ( HasStderrLogFunc e, HasLogFunc e, HasNetworkConfig e , HasPierConfig e, HasConfigDir e ) - => Bool -> Bool -> Maybe Word64 -> Serf.Flags -> MVar () -> RIO e () + => Bool -> Bool -> Maybe Word64 -> [Serf.Flag] -> MVar () -> RIO e () tryPlayShip exitImmediately fullReplay playFrom flags mStart = do when fullReplay wipeSnapshot runOrExitImmediately resumeShip exitImmediately mStart @@ -277,10 +275,10 @@ collectAllFx top = do collectedFX = do lockFile top log <- Log.existing (top <> "/.urb/log") - serf <- Serf.run (Serf.Config tmpDir serfFlags) - rio $ Serf.collectFX serf log + serf <- Pier.runSerf tmpDir serfFlags + rio $ error "Serf.collectFX" serf log - serfFlags :: Serf.Flags + serfFlags :: [Serf.Flag] serfFlags = [Serf.Hashless, Serf.DryRun] -------------------------------------------------------------------------------- @@ -309,14 +307,21 @@ replayPartEvs top last = do replayedEvs = do lockFile top log <- Log.existing (top <> "/.urb/log") - serf <- Serf.run (Serf.Config tmpDir serfFlags) + let onSlog = print + let onStdr = print + let onDead = error "DIED" + let config = Serf.Config "urbit-worker" tmpDir serfFlags onSlog onStdr onDead + (serf, info) <- io (Serf.start config) rio $ do - ss <- Serf.replay serf log $ Just last - Serf.snapshot serf ss + eSs <- Serf.execReplay serf log (Just last) + case eSs of + Just bail -> error (show bail) + Nothing -> pure () + rio (Serf.execSnapshot serf) io $ threadDelay 500000 -- Copied from runOrExitImmediately pure () - serfFlags :: Serf.Flags + serfFlags :: [Serf.Flag] serfFlags = [Serf.Hashless] -------------------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 06b2baeab..2d7b6e3b8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wwarn #-} + {-| Top-Level Pier Management @@ -5,8 +7,16 @@ communication between the serf, the log, and the IO drivers. -} module Urbit.Vere.Pier - ( booted, resumed, getSnapshot, pier, runPersist, runCompute, generateBootSeq - ) where + ( booted + , runSerf + , resumed + , getSnapshot + , pier + , runPersist + , runCompute + , generateBootSeq + ) +where import Urbit.Prelude @@ -26,7 +36,8 @@ import Urbit.Vere.Clay (clay) import Urbit.Vere.Http.Client (client) import Urbit.Vere.Http.Server (serv) import Urbit.Vere.Log (EventLog) -import Urbit.Vere.Serf (Serf, SerfState(..), doJob, sStderr) +import Urbit.Vere.Serf (Serf, SerfState(..)) +import Data.Conduit import qualified System.Entropy as Ent import qualified Urbit.King.API as King @@ -37,12 +48,11 @@ import qualified Urbit.Vere.Term as Term import qualified Urbit.Vere.Term.API as Term import qualified Urbit.Vere.Term.Demux as Term import qualified Urbit.Vere.Term.Render as Term +import qualified Data.Conduit.Combinators as CC -------------------------------------------------------------------------------- -_ioDrivers = [] :: [IODriver] - setupPierDirectory :: FilePath -> RIO e () setupPierDirectory shipPath = do for_ ["put", "get", "log", "chk"] $ \seg -> do @@ -93,62 +103,105 @@ writeJobs log !jobs = do -- Boot a new ship. ------------------------------------------------------------ -booted :: (HasPierConfig e, HasStderrLogFunc e, HasLogFunc e) - => Pill -> Bool -> Serf.Flags -> Ship -> LegacyBootEvent - -> RAcquire e (Serf e, EventLog, SerfState) -booted pill lite flags ship boot = do - seq@(BootSeq ident x y) <- rio $ generateBootSeq ship pill lite boot +runSerf :: HasLogFunc e => FilePath -> [Serf.Flag] -> RAcquire e Serf +runSerf pax fax = fst <$> Serf.withSerf config + where + config = Serf.Config + { scSerf = "urbit-worker" + , scPier = pax + , scFlag = fax + , scSlog = \slog -> print ("slog", slog) -- TODO error "TODO: slog" + , scStdr = \stdr -> print ("stdr", stdr) -- TODO error "TODO: stdr" + , scDead = pure () -- error "TODO: dead" + } - rio $ logTrace "BootSeq Computed" +bootSeqJobs :: Time.Wen -> BootSeq -> [Job] +bootSeqJobs now (BootSeq ident nocks ovums) = zipWith ($) bootSeqFns [1 ..] + where + wen :: EventId -> Time.Wen + wen off = Time.addGap now ((fromIntegral off - 1) ^. from Time.microSecs) + + bootSeqFns :: [EventId -> Job] + bootSeqFns = fmap muckNock nocks <> fmap muckOvum ovums + where + muckNock nok eId = RunNok $ LifeCyc eId 0 nok + muckOvum ov eId = DoWork $ Work eId 0 (wen eId) ov + +{- + loop :: [Job] -> SerfState -> Maybe (ProgressBar ()) -> [BootSeqFn] + -> RIO e ([Job], SerfState) + loop acc ss pb = \case + [] -> do + pb <- logStderr (updateProgressBar 0 bootMsg pb) + pure (reverse acc, ss) + x:xs -> do + wen <- io Time.now + job <- pure $ x (ssNextEv ss) (ssLastMug ss) wen + pb <- logStderr (updateProgressBar (1 + length xs) bootMsg pb) + (job, ss) <- bootJob serf job + loop (job:acc) ss pb xs +-} + +bootNewShip + :: (HasPierConfig e, HasStderrLogFunc e, HasLogFunc e) + => Pill + -> Bool + -> [Serf.Flag] + -> Ship + -> LegacyBootEvent + -> RIO e () +bootNewShip pill lite flags ship bootEv = do + seq@(BootSeq ident x y) <- generateBootSeq ship pill lite bootEv + logTrace "BootSeq Computed" pierPath <- view pierPathL liftRIO (setupPierDirectory pierPath) + logTrace "Directory setup." - rio $ logTrace "Directory Setup" + rwith (Log.new (pierPath <> "/.urb/log") ident) $ \log -> do + logTrace "Event log initialized." + jobs <- (\now -> bootSeqJobs now seq) <$> io Time.now + writeJobs log (fromList jobs) - log <- Log.new (pierPath <> "/.urb/log") ident + logTrace "Finsihed populating event log with boot sequence" - rio $ logTrace "Event Log Initialized" - - serf <- Serf.run (Serf.Config pierPath flags) - - rio $ logTrace "Serf Started" - - rio $ do - (events, serfSt) <- Serf.bootFromSeq serf seq - logTrace "Boot Sequence completed" - Serf.snapshot serf serfSt - logTrace "Snapshot taken" - writeJobs log (fromList events) - logTrace "Events written" - pure (serf, log, serfSt) +booted :: (HasPierConfig e, HasStderrLogFunc e, HasLogFunc e) + => Pill -> Bool -> [Serf.Flag] -> Ship -> LegacyBootEvent + -> RAcquire e (Serf, EventLog) +booted pill lite flags ship boot = do + rio $ bootNewShip pill lite flags ship boot + resumed Nothing flags -- Resume an existing ship. ---------------------------------------------------- -resumed :: (HasStderrLogFunc e, HasPierConfig e, HasLogFunc e) - => Maybe Word64 -> Serf.Flags - -> RAcquire e (Serf e, EventLog, SerfState) -resumed event flags = do - rio $ logTrace "Resuming ship" - top <- view pierPathL - tap <- fmap (fromMaybe top) $ rio $ runMaybeT $ do - ev <- MaybeT (pure event) - MaybeT (getSnapshot top ev) +resumed + :: (HasStderrLogFunc e, HasPierConfig e, HasLogFunc e) + => Maybe Word64 + -> [Serf.Flag] + -> RAcquire e (Serf, EventLog) +resumed replayUntil flags = do + rio $ logTrace "Resuming ship" + top <- view pierPathL + tap <- fmap (fromMaybe top) $ rio $ runMaybeT $ do + ev <- MaybeT (pure replayUntil) + MaybeT (getSnapshot top ev) - rio $ logTrace $ display @Text ("pier: " <> pack top) - rio $ logTrace $ display @Text ("running serf in: " <> pack tap) + rio $ logTrace $ display @Text ("pier: " <> pack top) + rio $ logTrace $ display @Text ("running serf in: " <> pack tap) - log <- Log.existing (top <> "/.urb/log") + log <- Log.existing (top <> "/.urb/log") + serf <- runSerf tap flags - serf <- Serf.run (Serf.Config tap flags) + rio $ do + logTrace "Replaying events" + Serf.execReplay serf log replayUntil + logTrace "Taking snapshot" + Serf.execSnapshot serf + logTrace "Shuting down the serf" - serfSt <- rio $ Serf.replay serf log event - - rio $ Serf.snapshot serf serfSt - - pure (serf, log, serfSt) + pure (serf, log) getSnapshot :: forall e. FilePath -> Word64 -> RIO e (Maybe FilePath) getSnapshot top last = do @@ -171,10 +224,11 @@ acquireWorker :: RIO e () -> RAcquire e (Async ()) acquireWorker act = mkRAcquire (async act) cancel pier :: ∀e. (HasConfigDir e, HasLogFunc e, HasNetworkConfig e, HasPierConfig e) - => (Serf e, EventLog, SerfState) + => (Serf, EventLog) + -> TVar (Text -> IO ()) -> MVar () -> RAcquire e () -pier (serf, log, ss) mStart = do +pier (serf, log) vStderr mStart = do computeQ <- newTQueueIO persistQ <- newTQueueIO executeQ <- newTQueueIO @@ -211,7 +265,7 @@ pier (serf, log, ss) mStart = do Term.addDemux ext demux logTrace "TERMSERV External terminal connected." - swapMVar (sStderr serf) (atomically . Term.trace muxed) + atomically $ writeTVar vStderr (atomically . Term.trace muxed) let logId = Log.identity log let ship = who logId @@ -230,10 +284,12 @@ pier (serf, log, ss) mStart = do io $ atomically $ for_ bootEvents (writeTQueue computeQ) + let stubErrCallback = \_ -> pure () + tExe <- startDrivers >>= router (readTQueue executeQ) tDisk <- runPersist log persistQ (writeTQueue executeQ) - tCpu <- runCompute serf ss - (readTQueue computeQ) + tCpu <- runCompute serf + ((,stubErrCallback) <$> readTQueue computeQ) (takeTMVar saveM) (takeTMVar shutdownM) (Term.spin muxed) @@ -271,6 +327,7 @@ saveSignalThread tm = mkRAcquire start cancel threadDelay (120 * 1000000) -- 120 seconds atomically $ putTMVar tm () + -- Start All Drivers ----------------------------------------------------------- data Drivers e = Drivers @@ -340,12 +397,6 @@ router waitFx Drivers{..} = -- Compute Thread -------------------------------------------------------------- -data ComputeRequest - = CREvent Ev - | CRSave () - | CRShutdown () - deriving (Eq, Show) - logEvent :: HasLogFunc e => Ev -> RIO e () logEvent ev = logDebug $ display $ "[EVENT]\n" <> pretty @@ -362,49 +413,130 @@ logEffect ef = GoodParse e -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow e FailParse n -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow n -runCompute :: ∀e. HasLogFunc e - => Serf e - -> SerfState - -> STM Ev - -> STM () - -> STM () - -> (Maybe Text -> STM ()) - -> STM () - -> ((Job, FX) -> STM ()) - -> RAcquire e (Async ()) -runCompute serf ss getEvent getSaveSignal getShutdownSignal - showSpinner hideSpinner putResult = - mkRAcquire (async (go ss)) cancel - where - go :: SerfState -> RIO e () - go ss = do - cr <- atomically $ - CRShutdown <$> getShutdownSignal <|> - CRSave <$> getSaveSignal <|> - CREvent <$> getEvent - case cr of - CREvent ev -> do - logEvent ev - wen <- io Time.now - eId <- pure (ssNextEv ss) - mug <- pure (ssLastMug ss) +data ComputeRequest + = CREvent (Ev, Serf.RunError -> IO ()) + | CRSave () + | CRShutdown () - atomically $ showSpinner (getSpinnerNameForEvent ev) - (job', ss', fx) <- doJob serf $ DoWork $ Work eId mug wen ev - atomically $ hideSpinner - atomically (putResult (job', fx)) - go ss' - CRSave () -> do - logDebug $ "Taking periodic snapshot" - Serf.snapshot serf ss - go ss - CRShutdown () -> do - -- When shutting down, we first request a snapshot, and then we - -- just exit this recursive processing, which will cause the serf - -- to exit from its RAcquire. - logDebug $ "Shutting down compute system..." - Serf.snapshot serf ss - pure () +runCompute + :: forall e + . HasLogFunc e + => Serf + -> STM (Ev, Serf.RunError -> IO ()) + -> STM () + -> STM () + -> (Maybe Text -> STM ()) + -> STM () + -> ((Job, FX) -> STM ()) + -> RAcquire e (Async ()) +runCompute serf getEvent getSaveSignal getShutdownSignal showSpinner hideSpinner putResult = do + mkRAcquire (async $ newRunCompute serf config) cancel + where + config = ComputeConfig + { ccOnWork = getEvent + , ccOnKill = getShutdownSignal + , ccOnSave = getSaveSignal + , ccPutResult = putResult + , ccShowSpinner = showSpinner + , ccHideSpinner = hideSpinner + } + +-- data RunOutput = RunOutput EventId Mug Wen (Either Noun Ev) [Ef] +-- data Work = Work EventId Mug Wen Ev + +{- +data ComputeRequest + = CREvent Ev (Serf.RunError -> IO ()) + | CRSave () + | CRShutdown () + deriving (Eq, Show) +-} + +{- + TODO Pack and Peek +-} +ipcSource + :: forall e + . HasLogFunc e + => STM (Ev, Serf.RunError -> IO ()) + -> STM () + -> STM () + -> ConduitT () Serf.RunInput (RIO e) () +ipcSource onEvent onSave onKill = loop + where + loop :: ConduitT () Serf.RunInput (RIO e) () + loop = do + lift $ logTrace "ipcSource waiting for work request." + let down = CRShutdown <$> onKill + let save = CRSave <$> onSave + let work = CREvent <$> onEvent + atomically (down <|> save <|> work) >>= \case + CRShutdown () -> do + pure () + CRSave () -> do + lift $ logTrace "ipcSource: requesting snapshot" + yield Serf.RunSnap + loop + CREvent (ev, cb) -> do + lift $ logTrace "ipcSource: requesting work" + yield (Serf.RunWork ev cb) + loop + +fromRightErr :: Either a b -> IO b +fromRightErr (Left l) = error "unexpected Left value" +fromRightErr (Right r) = pure r + +data ComputeConfig = ComputeConfig + { ccOnWork :: STM (Ev, Serf.RunError -> IO ()) + , ccOnKill :: STM () + , ccOnSave :: STM () + , ccPutResult :: (Job, FX) -> STM () + , ccShowSpinner :: Maybe Text -> STM () + , ccHideSpinner :: STM () + } + +newRunCompute + :: forall e . HasLogFunc e => Serf.Serf -> ComputeConfig -> RIO e () +newRunCompute serf ComputeConfig {..} = do + logTrace "newRunCompute" + runConduit + $ ipcSource ccOnWork ccOnSave ccOnKill + .| Serf.running serf (atomically . onStatusChange) + .| sendResults + where + sendResults :: ConduitT Serf.RunOutput Void (RIO e) () + sendResults = await >>= \case + Nothing -> pure () + Just (Serf.RunOutput e m w nounEv fx) -> do + lift $ logTrace "newRunCompute: Got play result" + ev <- io $ fromRightErr nounEv -- TODO + let job :: Job = DoWork $ Work e m w ev + atomically (ccPutResult ((job, GoodParse <$> fx))) -- TODO GoodParse + sendResults + + onStatusChange :: Maybe Serf.RunInput -> STM () + onStatusChange = \case + Nothing -> ccHideSpinner + Just (Serf.RunWork ev _) -> ccShowSpinner (getSpinnerNameForEvent ev) + _ -> pure () + + +{- + FIND ME + + send event + push event + start spinner + hook for when event starts running + hook for when no event is running + send another event + first event is done + push to persistQ + update spinner to event #2 + second event is done + push to executeQ + remove spinner +-} -- Persist Thread -------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index ac9b1f035..57fa508e3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -1,15 +1,19 @@ +{-# OPTIONS_GHC -Wwarn #-} + {-| Serf Interface TODO: `recvLen` is not big-endian safe. -} -module Urbit.Vere.Serf ( Serf, sStderr, SerfState(..), doJob - , run, shutdown, kill - , replay, bootFromSeq, snapshot - , collectFX - , Config(..), Flags, Flag(..) - ) where +module Urbit.Vere.Serf + ( module Urbit.Vere.Serf.IPC + , withSerf + , execReplay + , execSnapshot + , execShutdown + ) +where import Urbit.Prelude @@ -18,6 +22,8 @@ import System.Process import System.ProgressBar import Urbit.Arvo import Urbit.Vere.Pier.Types +import Urbit.Vere.Serf.IPC +import System.Posix.Signals import Data.Bits (setBit) import Data.ByteString (hGet) @@ -38,510 +44,120 @@ import qualified Urbit.Time as Time import qualified Urbit.Vere.Log as Log --- Serf Config ----------------------------------------------------------------- +-------------------------------------------------------------------------------- -type Flags = [Flag] - -data Flag - = DebugRam - | DebugCpu - | CheckCorrupt - | CheckFatal - | Verbose - | DryRun - | Quiet - | Hashless - | Trace - deriving (Eq, Ord, Show, Enum, Bounded) - -compileFlags :: [Flag] -> Word -compileFlags = foldl' (\acc flag -> setBit acc (fromEnum flag)) 0 - -data Config = Config FilePath [Flag] - deriving (Show) - -serf :: HasLogFunc e => Text -> RIO e () -serf msg = logInfo $ display ("SERF: " <> msg) - - --- Types ----------------------------------------------------------------------- - -data SerfState = SerfState - { ssNextEv :: EventId - , ssLastMug :: Mug - } - deriving (Eq, Ord, Show) - -ssLastEv :: SerfState -> EventId -ssLastEv = pred . ssNextEv - -data Serf e = Serf - { sendHandle :: Handle - , recvHandle :: Handle - , process :: ProcessHandle - , sStderr :: MVar (Text -> RIO e ()) - } - -data ShipId = ShipId Ship Bool - deriving (Eq, Ord, Show) - -data Plea - = PPlay EventId Mug - | PWork Work - | PDone EventId Mug FX - | PStdr EventId Cord - | PSlog EventId Word32 Tank - deriving (Eq, Show) - -type ReplacementEv = Job -type WorkResult = (SerfState, FX) -type SerfResp = Either ReplacementEv WorkResult - -data SerfExn - = BadComputeId EventId WorkResult - | BadReplacementId EventId ReplacementEv - | UnexpectedPlay EventId (EventId, Mug) - | BadPleaAtom Atom - | BadPleaNoun Noun [Text] Text - | ReplacedEventDuringReplay EventId ReplacementEv - | ReplacedEventDuringBoot EventId ReplacementEv - | EffectsDuringBoot EventId FX - | SerfConnectionClosed - | UnexpectedPleaOnNewShip Plea - | InvalidInitialPlea Plea - deriving (Show) - - --- Instances ------------------------------------------------------------------- - -instance Exception SerfExn - -deriveNoun ''ShipId -deriveNoun ''Plea - - --- Utils ----------------------------------------------------------------------- - -printTank :: HasLogFunc e - => MVar (Text -> RIO e ()) -> Word32 -> Tank - -> RIO e () -printTank log _pri = printErr log . unlines . fmap unTape . wash (WashCfg 0 80) - -guardExn :: (Exception e, MonadIO m) => Bool -> e -> m () -guardExn ok = io . unless ok . throwIO - -fromRightExn :: (Exception e, MonadIO m) => Either a b -> (a -> e) -> m b -fromRightExn (Left m) exn = throwIO (exn m) -fromRightExn (Right x) _ = pure x - -printErr :: MVar (Text -> RIO e ()) -> Text -> RIO e () -printErr m txt = do - f <- readMVar m - f txt - - --- Process Management ---------------------------------------------------------- - -run :: HasLogFunc e => Config -> RAcquire e (Serf e) -run config = mkRAcquire (startUp config) tearDown - -startUp :: HasLogFunc e => Config -> RIO e (Serf e) -startUp conf@(Config pierPath flags) = do - logTrace "STARTING SERF" - logTrace (displayShow conf) - - (i, o, e, p) <- io $ do - (Just i, Just o, Just e, p) <- createProcess pSpec - pure (i, o, e, p) - - stderr <- newMVar serf - async (readStdErr e stderr) - pure (Serf i o p stderr) - where - diskKey = "" - config = show (compileFlags flags) - args = [pierPath, diskKey, config] - pSpec = (proc "urbit-worker" args) - { std_in = CreatePipe - , std_out = CreatePipe - , std_err = CreatePipe - } - -readStdErr :: ∀e. HasLogFunc e => Handle -> MVar (Text -> RIO e ()) -> RIO e () -readStdErr h print = - untilEOFExn $ do - raw <- io $ IO.hGetLine h - let ln = T.strip (pack raw) - printErr print ln - serf ("[stderr] " <> ln) - where - eofMsg = "[Serf.readStdErr] serf stderr closed" - - untilEOFExn :: RIO e () -> RIO e () - untilEOFExn act = loop - where - loop :: RIO e () - loop = do - env <- ask - res <- io $ IO.tryIOError $ runRIO env act - case res of - Left exn | IO.isEOFError exn -> logDebug eofMsg - Left exn -> io (IO.ioError exn) - Right () -> loop - -tearDown :: HasLogFunc e => Serf e -> RIO e () -tearDown serf = do - io $ terminateProcess (process serf) - void $ waitForExit serf - - -- race_ waitThenKill (shutdownAndWait serf 0) - where - -- killedMsg = - -- "[Serf.tearDown]: Serf didn't die when asked, killing it" - - -- waitThenKill = do - -- threadDelay 1000000 - -- debug killedMsg - -- terminateProcess (process serf) - -waitForExit :: HasLogFunc e => Serf e -> RIO e ExitCode -waitForExit = io . waitForProcess . process - -kill :: HasLogFunc e => Serf e -> RIO e ExitCode -kill serf = io (terminateProcess $ process serf) >> waitForExit serf - -_shutdownAndWait :: HasLogFunc e => Serf e -> Word8 -> RIO e ExitCode -_shutdownAndWait serf code = do - shutdown serf code - waitForExit serf - - --- Basic Send and Receive Operations ------------------------------------------- - -withWord64AsByteString :: Word64 -> (ByteString -> RIO e a) -> RIO e a -withWord64AsByteString w k = do - env <- ask - io $ alloca $ \wp -> do - poke wp w - bs <- BS.unsafePackCStringLen (castPtr wp, 8) - runRIO env (k bs) - -sendLen :: HasLogFunc e => Serf e -> Int -> RIO e () -sendLen s i = do - w <- evaluate (fromIntegral i :: Word64) - withWord64AsByteString (fromIntegral i) (hPut (sendHandle s)) - -sendOrder :: HasLogFunc e => Serf e -> Order -> RIO e () -sendOrder w o = do - -- logDebug $ display ("(sendOrder) " <> tshow o) - sendBytes w $ jamBS $ toNoun o - -- logDebug "(sendOrder) Done" - -sendBytes :: HasLogFunc e => Serf e -> ByteString -> RIO e () -sendBytes s bs = handle ioErr $ do - sendLen s (length bs) - hPut (sendHandle s) bs - hFlush (sendHandle s) - - where - ioErr :: IOError -> RIO e () - ioErr _ = throwIO SerfConnectionClosed - -recvLen :: (MonadIO m, HasLogFunc e) => Serf e -> m Word64 -recvLen w = io $ do - bs <- hGet (recvHandle w) 8 - case length bs of - 8 -> unsafeUseAsCString bs (peek . castPtr) - _ -> throwIO SerfConnectionClosed - -recvBytes :: HasLogFunc e => Serf e -> Word64 -> RIO e ByteString -recvBytes serf = - io . hGet (recvHandle serf) . fromIntegral - -recvAtom :: HasLogFunc e => Serf e -> RIO e Atom -recvAtom w = do - len <- recvLen w - bytesAtom <$> recvBytes w len - -cordText :: Cord -> Text -cordText = T.strip . unCord +-- TODO XXX HACK FIXME +data MissingBootEventsInEventLog = MissingBootEventsInEventLog Word Word + deriving (Show, Exception) -------------------------------------------------------------------------------- -snapshot :: HasLogFunc e => Serf e -> SerfState -> RIO e () -snapshot serf ss = do - logTrace $ display ("Taking snapshot at event " <> tshow (ssLastEv ss)) - sendOrder serf $ OSave $ ssLastEv ss +bytesNouns :: MonadIO m => ConduitT ByteString Noun m () +bytesNouns = await >>= \case + Nothing -> pure () + Just bs -> do + noun <- cueBSExn bs + (mug :: Noun, bod) <- fromNounExn noun + yield bod + bytesNouns -shutdown :: HasLogFunc e => Serf e -> Word8 -> RIO e () -shutdown serf code = sendOrder serf (OExit code) +withSerf :: HasLogFunc e => Config -> RAcquire e (Serf, SerfInfo) +withSerf config = mkRAcquire (io $ start config) kill + where + kill (serf, _) = do + void $ rio $ execShutdown serf -{-| - TODO Find a cleaner way to handle `PStdr` Pleas. +{- + TODO This needs to be thought through carfully once the callsites + have stabilized. -} -recvPlea :: HasLogFunc e => Serf e -> RIO e Plea -recvPlea w = do - logDebug "(recvPlea) Waiting" - a <- recvAtom w - logDebug "(recvPlea) Got atom" - n <- fromRightExn (cue a) (const $ BadPleaAtom a) - p <- fromRightExn (fromNounErr n) (\(p,m) -> BadPleaNoun n p m) +execShutdown :: HasLogFunc e => Serf -> RIO e () +execShutdown serf = do + race_ (wait2sec >> forceKill) $ do + logTrace "Getting current serf state (taking lock, might block if in use)." + finalState <- takeMVar (serfLock serf) + logTrace "Got serf state (and took lock). Requesting shutdown." + io (shutdown serf 0) + logTrace "Sent shutdown request. Waiting for process to die." + io $ waitForProcess (serfProc serf) + logTrace "RIP Serf process." + where + wait2sec = threadDelay 5_000_000 + forceKill = do + logTrace "Serf taking too long to go down, kill with fire (SIGTERM)." + io (getPid $ serfProc serf) >>= \case + Nothing -> do + logTrace "Serf process already dead." + Just pid -> do + io $ signalProcess sigKILL pid + io $ waitForProcess (serfProc serf) + logTrace "Finished killing serf process with fire." + +execSnapshot :: forall e . HasLogFunc e => Serf -> RIO e () +execSnapshot serf = do + logTrace "execSnapshot: taking lock" + serfState <- takeMVar (serfLock serf) + io (sendSnapshotRequest serf (ssLast serfState)) + logTrace "execSnapshot: releasing lock" + putMVar (serfLock serf) serfState - case p of PStdr e msg -> do printErr (sStderr w) (cordText msg) - recvPlea w - PSlog _ pri t -> do printTank (sStderr w) pri t - recvPlea w - _ -> do logTrace "recvPlea got something else" - pure p +execReplay + :: forall e + . HasLogFunc e + => Serf + -> Log.EventLog + -> Maybe Word64 + -> RIO e (Maybe PlayBail) +execReplay serf log last = do + lastEventInSnap <- io (ssLast <$> serfCurrentStateBlocking serf) + if lastEventInSnap == 0 then doBoot else doReplay + where + doBoot :: RIO e (Maybe PlayBail) + doBoot = do + let bootSeqLen = lifecycleLen (Log.identity log) -{-| - Waits for initial plea, and then sends boot IPC if necessary. --} -handshake :: HasLogFunc e => Serf e -> LogIdentity -> RIO e SerfState -handshake serf ident = do - logTrace "Serf Handshake" + evs <- runConduit $ Log.streamEvents log 1 + .| CC.take (fromIntegral bootSeqLen) + .| bytesNouns + .| CC.sinkList - ss@SerfState{..} <- recvPlea serf >>= \case - PPlay e m -> pure $ SerfState e m - x -> throwIO (InvalidInitialPlea x) + let numEvs = fromIntegral (length evs) + let bootLn = bootSeqLen - logTrace $ display ("Handshake result: " <> tshow ss) + when (numEvs /= bootLn) $ do + throwIO (MissingBootEventsInEventLog numEvs bootLn) - when (ssNextEv == 1) $ do - let ev = OBoot (lifecycleLen ident) - logTrace $ display ("No snapshot. Sending boot event: " <> tshow ev) - sendOrder serf ev + io (bootSeq serf evs) >>= \case + Just err -> pure (Just err) + Nothing -> doReplay - logTrace "Finished handshake" - - pure ss - -sendWork :: ∀e. HasLogFunc e => Serf e -> Job -> RIO e SerfResp -sendWork w job = - do - sendOrder w (OWork job) - res <- loop - logTrace ("[sendWork] Got response") - pure res - where - eId = jobId job - - produce :: WorkResult -> RIO e SerfResp - produce (ss@SerfState{..}, o) = do - guardExn (ssNextEv == (1+eId)) (BadComputeId eId (ss, o)) - pure $ Right (ss, o) - - replace :: ReplacementEv -> RIO e SerfResp - replace job = do - guardExn (jobId job == eId) (BadReplacementId eId job) - pure (Left job) - - loop :: RIO e SerfResp - loop = recvPlea w >>= \case - PPlay e m -> throwIO (UnexpectedPlay eId (e, m)) - PDone i m o -> produce (SerfState (i+1) m, o) - PWork work -> replace (DoWork work) - PStdr _ cord -> printErr (sStderr w) (cordText cord) >> loop - PSlog _ pri t -> printTank (sStderr w) pri t >> loop - - --------------------------------------------------------------------------------- - -doJob :: HasLogFunc e => Serf e -> Job -> RIO e (Job, SerfState, FX) -doJob serf job = do - sendWork serf job >>= \case - Left replaced -> doJob serf replaced - Right (ss, fx) -> pure (job, ss, fx) - -bootJob :: HasLogFunc e => Serf e -> Job -> RIO e (Job, SerfState) -bootJob serf job = do - doJob serf job >>= \case - (job, ss, _) -> pure (job, ss) --- (job, ss, fx) -> throwIO (EffectsDuringBoot (jobId job) fx) - -replayJob :: HasLogFunc e => Serf e -> Job -> RIO e SerfState -replayJob serf job = do - sendWork serf job >>= \case - Left replace -> throwIO (ReplacedEventDuringReplay (jobId job) replace) - Right (ss, _) -> pure ss - --------------------------------------------------------------------------------- - -updateProgressBar :: HasLogFunc e - => Int -> Text -> Maybe (ProgressBar ()) - -> RIO e (Maybe (ProgressBar ())) -updateProgressBar count startMsg = \case - Nothing -> do - -- We only construct the progress bar on the first time that we - -- process an event so that we don't display an empty progress - -- bar when the snapshot is caught up to the log. - let style = defStyle { stylePrefix = msg (fromStrict startMsg) } - pb <- newProgressBar style 10 (Progress 0 count ()) - pure (Just pb) - Just pb -> do - incProgress pb 1 - pure (Just pb) - --------------------------------------------------------------------------------- - -type BootSeqFn = EventId -> Mug -> Time.Wen -> Job - -data BootExn = ShipAlreadyBooted - deriving stock (Eq, Ord, Show) - deriving anyclass (Exception) - -logStderr :: HasStderrLogFunc e => RIO LogFunc a -> RIO e a -logStderr action = do - logFunc <- view stderrLogFuncL - runRIO logFunc action - -bootFromSeq :: ∀e. (HasStderrLogFunc e, HasLogFunc e) - => Serf e -> BootSeq -> RIO e ([Job], SerfState) -bootFromSeq serf (BootSeq ident nocks ovums) = do - handshake serf ident >>= \case - ss@(SerfState 1 (Mug 0)) -> loop [] ss Nothing bootSeqFns - _ -> throwIO ShipAlreadyBooted - - where - loop :: [Job] -> SerfState -> Maybe (ProgressBar ()) -> [BootSeqFn] - -> RIO e ([Job], SerfState) - loop acc ss pb = \case - [] -> do - pb <- logStderr (updateProgressBar 0 bootMsg pb) - pure (reverse acc, ss) - x:xs -> do - wen <- io Time.now - job <- pure $ x (ssNextEv ss) (ssLastMug ss) wen - pb <- logStderr (updateProgressBar (1 + length xs) bootMsg pb) - (job, ss) <- bootJob serf job - loop (job:acc) ss pb xs - - bootSeqFns :: [BootSeqFn] - bootSeqFns = fmap muckNock nocks <> fmap muckOvum ovums - where - muckNock nok eId mug _ = RunNok $ LifeCyc eId mug nok - muckOvum ov eId mug wen = DoWork $ Work eId mug wen ov - - bootMsg = "Booting " ++ (fakeStr (isFake ident)) ++ - (Ob.renderPatp (Ob.patp (fromIntegral (who ident)))) - fakeStr True = "fake " - fakeStr False = "" - -{-| - The ship is booted, but it is behind. shove events to the worker - until it is caught up. --} -replayJobs :: (HasStderrLogFunc e, HasLogFunc e) - => Serf e -> Int -> SerfState -> ConduitT Job Void (RIO e) SerfState -replayJobs serf lastEv = go Nothing - where - go pb ss = do - await >>= \case - Nothing -> pure ss - Just job -> do - pb <- lift $ logStderr (updatePb ss pb) - played <- lift $ replayJob serf job - go pb played - - updatePb ss = do - let start = lastEv - fromIntegral (ssNextEv ss) - let msg = pack ( "Replaying events #" ++ (show (ssNextEv ss)) - <> " to #" ++ (show lastEv) - ) - updateProgressBar start msg - - -replay :: (HasStderrLogFunc e, HasLogFunc e) - => Serf e -> Log.EventLog -> Maybe Word64 -> RIO e SerfState -replay serf log last = do + doReplay :: RIO e (Maybe PlayBail) + doReplay = do logTrace "Beginning event log replay" + lastEventInSnap <- io (ssLast <$> serfCurrentStateBlocking serf) + last & \case Nothing -> pure () Just lt -> logTrace $ display $ "User requested to replay up to event #" <> tshow lt - ss <- handshake serf (Log.identity log) - logLastEv :: Word64 <- fromIntegral <$> Log.lastEv log - let serfNextEv = ssNextEv ss - lastEventInSnap = serfNextEv - 1 - logTrace $ display $ "Last event in event log is #" <> tshow logLastEv - let replayUpTo = fromMaybe logLastEv last + let replayUpTo = min (fromMaybe logLastEv last) logLastEv let numEvs :: Int = fromIntegral replayUpTo - fromIntegral lastEventInSnap + when (numEvs < 0) $ do + error "impossible" + logTrace $ display $ "Replaying up to event #" <> tshow replayUpTo logTrace $ display $ "Will replay " <> tshow numEvs <> " in total." - runConduit $ Log.streamEvents log serfNextEv + runConduit $ Log.streamEvents log (lastEventInSnap + 1) .| CC.take (fromIntegral numEvs) - .| toJobs (Log.identity log) serfNextEv - .| replayJobs serf (fromIntegral replayUpTo) ss - -toJobs :: HasLogFunc e - => LogIdentity -> EventId -> ConduitT ByteString Job (RIO e) () -toJobs ident eId = - await >>= \case - Nothing -> lift $ logTrace "[toJobs] no more jobs" - Just at -> do yield =<< lift (fromAtom at) - lift $ logTrace $ display ("[toJobs] " <> tshow eId) - toJobs ident (eId+1) - where - isNock = eId <= fromIntegral (lifecycleLen ident) - - fromAtom :: ByteString -> RIO e Job - fromAtom bs | isNock = do - noun <- cueBSExn bs - (mug, nok) <- fromNounExn noun - pure $ RunNok (LifeCyc eId mug nok) - fromAtom bs = do - noun <- cueBSExn bs - (mug, wen, ovm) <- fromNounExn noun - pure $ DoWork (Work eId mug wen ovm) - - --- Collect Effects for Parsing ------------------------------------------------- - -collectFX :: HasLogFunc e => Serf e -> Log.EventLog -> RIO e () -collectFX serf log = do - ss <- handshake serf (Log.identity log) - - runConduit $ Log.streamEvents log (ssNextEv ss) - .| toJobs (Log.identity log) (ssNextEv ss) - .| doCollectFX serf ss - .| persistFX log - -persistFX :: Log.EventLog -> ConduitT (EventId, FX) Void (RIO e) () -persistFX log = loop - where - loop = await >>= \case - Nothing -> pure () - Just (eId, fx) -> do - lift $ Log.writeEffectsRow log eId (jamBS $ toNoun fx) - loop - -doCollectFX :: ∀e. HasLogFunc e - => Serf e -> SerfState -> ConduitT Job (EventId, FX) (RIO e) () -doCollectFX serf = go - where - go :: SerfState -> ConduitT Job (EventId, FX) (RIO e) () - go ss = await >>= \case - Nothing -> pure () - Just jb -> do - -- jb <- pure $ replaceMug jb (ssLastMug ss) - (_, ss, fx) <- lift $ doJob serf jb - when (0 == (jobId jb `mod` 10_000)) $ do - lift $ logTrace $ displayShow (jobId jb) - yield (jobId jb, fx) - go ss - -_replaceMug :: Job -> Mug -> Job -_replaceMug jb mug = - case jb of - DoWork (Work eId _ w o) -> DoWork (Work eId mug w o) - RunNok (LifeCyc eId _ n) -> RunNok (LifeCyc eId mug n) + .| bytesNouns + .| replay serf diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index c1c0735a3..ee06b9670 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -39,15 +39,19 @@ import Urbit.Prelude hiding ((<|)) import Data.Conduit import Urbit.Arvo import Urbit.Vere.Pier.Types hiding (Work) +import System.Process +import Data.Bits import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (castPtr) import Foreign.Storable (peek, poke) -import System.Process (ProcessHandle) +import RIO.Prelude (decodeUtf8Lenient) import Urbit.Time (Wen) import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS +import qualified System.IO.Error as IO +import qualified Urbit.Time as Time -- IPC Types ------------------------------------------------------------------- @@ -89,10 +93,15 @@ data RipeInfo = RipeInfo } deriving (Show) +data SerfState = SerfState + { ssLast :: EventId + , ssHash :: Mug + } + deriving (Show) + data SerfInfo = SerfInfo { siRipe :: RipeInfo - , siEvId :: EventId - , siHash :: Mug + , siStat :: SerfState } deriving (Show) @@ -112,6 +121,7 @@ deriveNoun ''Play deriveNoun ''Work deriveNoun ''Writ deriveNoun ''RipeInfo +deriveNoun ''SerfState deriveNoun ''SerfInfo deriveNoun ''Plea @@ -120,12 +130,32 @@ data Serf = Serf , serfRecv :: Handle , serfProc :: ProcessHandle , serfSlog :: Slog -> IO () + , serfLock :: MVar SerfState } -- API Types ------------------------------------------------------------------- -data SerfConfig = SerfConfig -- binary, directory, &c +data Flag + = DebugRam + | DebugCpu + | CheckCorrupt + | CheckFatal + | Verbose + | DryRun + | Quiet + | Hashless + | Trace + deriving (Eq, Ord, Show, Enum, Bounded) + +data Config = Config -- binary, directory, &c + { scSerf :: FilePath + , scPier :: FilePath + , scFlag :: [Flag] + , scSlog :: Slog -> IO () + , scStdr :: Text -> IO () + , scDead :: IO () + } data RunError = RunBail [Goof] @@ -135,7 +165,7 @@ data RunInput = RunSnap | RunPack | RunPeek Wen Gang Path (Maybe (Term, Noun) -> IO ()) - | RunWork Wen Ev (RunError -> IO ()) + | RunWork Ev (RunError -> IO ()) data RunOutput = RunOutput EventId Mug Wen (Either Noun Ev) [Ef] @@ -158,6 +188,11 @@ data SerfExn deriving (Show, Exception) +-- Access Current Serf State --------------------------------------------------- + +serfCurrentStateBlocking :: Serf -> IO SerfState +serfCurrentStateBlocking Serf{serfLock} = readMVar serfLock + -- Low Level IPC Functions ----------------------------------------------------- fromRightExn :: (Exception e, MonadIO m) => Either a b -> (a -> e) -> m b @@ -223,6 +258,11 @@ recvPleaHandlingSlog serf = loop -- Higher-Level IPC Functions -------------------------------------------------- +recvRipe :: Serf -> IO SerfInfo +recvRipe serf = recvPleaHandlingSlog serf >>= \case + PRipe ripe -> pure ripe + plea -> throwIO (UnexpectedPlea plea "expecting %play") + recvPlay :: Serf -> IO Play recvPlay serf = recvPleaHandlingSlog serf >>= \case PPlay play -> pure play @@ -248,8 +288,8 @@ recvPeek serf = do -- Request-Response Points ----------------------------------------------------- -snapshot :: Serf -> EventId -> IO () -snapshot serf eve = do +sendSnapshotRequest :: Serf -> EventId -> IO () +sendSnapshotRequest serf eve = do sendWrit serf (WLive $ LSave eve) recvLive serf @@ -266,8 +306,34 @@ scry serf w g p = do -- Serf Usage Flows ------------------------------------------------------------ -start :: SerfConfig -> IO (Serf, SerfInfo) -start = error "TODO" +compileFlags :: [Flag] -> Word +compileFlags = foldl' (\acc flag -> setBit acc (fromEnum flag)) 0 + +readStdErr :: Handle -> (Text -> IO ()) -> IO () -> IO () +readStdErr h onLine onClose = loop + where + loop = do + IO.tryIOError (BS.hGetLine h >>= onLine . decodeUtf8Lenient) >>= \case + Left exn -> onClose + Right () -> loop + +start :: Config -> IO (Serf, SerfInfo) +start (Config exePax pierPath flags onSlog onStdr onDead) = do + (Just i, Just o, Just e, p) <- createProcess pSpec + async (readStdErr e onStdr onDead) + vLock <- newEmptyMVar + let serf = Serf i o p onSlog vLock + info <- recvRipe serf -- Gross: recvRipe doesn't care about lock so this is fine. + putMVar vLock (siStat info) + pure (serf, info) + where + diskKey = "" + config = show (compileFlags flags) + args = [pierPath, diskKey, config] + pSpec = (proc exePax args) { std_in = CreatePipe + , std_out = CreatePipe + , std_err = CreatePipe + } {- TODO wait for process exit? @@ -278,52 +344,100 @@ shutdown serf exitCode = do sendWrit serf (WLive $ LExit exitCode) pure () +bootSeq :: Serf -> [Noun] -> IO (Maybe PlayBail) +bootSeq serf@Serf{..} seq = do + oldInfo <- takeMVar serfLock + sendWrit serf (WPlay 1 seq) + (res, newInfo) <- recvPlay serf >>= \case + PBail bail -> pure (Just bail, oldInfo) + PDone newMug -> pure (Nothing, SerfState (fromIntegral $ length seq) newMug) + putMVar serfLock newInfo + pure res + {- + If this throws an exception, the serf will be in an unusable state. Kill + the process. + TODO Take advantage of IPC support for batching. TODO Maybe take snapshots -} replay - :: Serf -> SerfInfo -> ConduitT Noun Void IO (Either PlayBail (Mug, EventId)) -replay serf info = go (siHash info) (siEvId info) + :: forall m + . MonadIO m + => Serf + -> ConduitT Noun Void m (Maybe PlayBail) +replay serf = do + initState <- takeMVar (serfLock serf) + (mErr, newState) <- loop initState + putMVar (serfLock serf) newState + pure mErr where - go :: Mug -> EventId -> ConduitT Noun Void IO (Either PlayBail (Mug, EventId)) - go mug eid = await >>= \case - Nothing -> pure (Right (mug, eid)) - Just no -> do - io $ sendWrit serf (WPlay eid [no]) - io (recvPlay serf) >>= \case - PBail bail -> pure (Left bail) - PDone hash -> go hash (eid + 1) + loop :: SerfState -> ConduitT Noun Void m (Maybe PlayBail, SerfState) + loop (SerfState lastEve lastMug) = do + await >>= \case + Nothing -> pure (Nothing, SerfState lastEve lastMug) + Just ev -> do + let newEve = lastEve + 1 + io $ sendWrit serf (WPlay newEve [ev]) + res <- io (recvPlay serf) >>= \case + PBail bail -> pure (Just bail, SerfState lastEve lastMug) + PDone newMug -> loop (SerfState newEve newMug) + pure res + +whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () +whenJust Nothing _ = pure () +whenJust (Just a) act = act a {- + If this throws an exception, the serf will be in an unusable state. Kill + the process. + TODO callbacks on snapshot and compaction? TODO Take advantage of async IPC to fill pipe with more than one thing. -} -running :: Serf -> SerfInfo -> ConduitT RunInput RunOutput IO (Mug, EventId) -running serf info = go (siHash info) (siEvId info) +running + :: forall m + . MonadIO m + => Serf + -> (Maybe RunInput -> IO ()) + -> ConduitT RunInput RunOutput m () +running serf notice = do + SerfState {..} <- takeMVar (serfLock serf) + newState <- loop ssHash ssLast + putMVar (serfLock serf) newState + pure () where - go mug eve = await >>= \case - Nothing -> pure (mug, eve) - Just RunSnap -> do - io (snapshot serf eve) - go mug eve - Just RunPack -> do - io (compact serf eve) - go mug eve - Just (RunPeek wen gang pax act) -> do - res <- io (scry serf wen gang pax) - io (act res) - go mug eve - Just (RunWork wen evn err) -> do - io (sendWrit serf (WWork wen evn)) - io (recvWork serf) >>= \case - WDone eid hash fx -> do - yield (RunOutput eid hash wen (Right evn) fx) - go hash eid - WSwap eid hash (wen, noun) fx -> do - io $ err (RunSwap eid hash wen noun fx) - yield (RunOutput eid hash wen (Left noun) fx) - go hash eid - WBail goofs -> do - io $ err (RunBail goofs) - go mug eve + loop :: Mug -> EventId -> ConduitT RunInput RunOutput m SerfState + loop mug eve = do + print "Serf.running.loop" + io (notice Nothing) + nex <- await + print ("Serf.running.loop: Got something") + io (notice nex) + nex & \case + Nothing -> do + pure $ SerfState eve mug + Just RunSnap -> do + io (sendSnapshotRequest serf eve) + loop mug eve + Just RunPack -> do + io (compact serf eve) + loop mug eve + Just (RunPeek wen gang pax act) -> do + res <- io (scry serf wen gang pax) + io (act res) + loop mug eve + Just (RunWork evn err) -> do + wen <- io Time.now + io (sendWrit serf (WWork wen evn)) + io (recvWork serf) >>= \case + WDone eid hash fx -> do + yield (RunOutput eid hash wen (Right evn) fx) + loop hash eid + WSwap eid hash (wen, noun) fx -> do + io $ err (RunSwap eid hash wen noun fx) + yield (RunOutput eid hash wen (Left noun) fx) + loop hash eid + WBail goofs -> do + io $ err (RunBail goofs) + loop mug eve From 1f64a528cdc32f014ebeb6f8bf976cb090317e01 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 27 May 2020 00:08:07 +0000 Subject: [PATCH 096/257] king: Handle replacement events correctly (dont try to parse them). --- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 152 +++++++------------ pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 6 +- 2 files changed, 59 insertions(+), 99 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 2d7b6e3b8..bf47ed113 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -26,10 +26,12 @@ import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Pier.Types import Control.Monad.Trans.Maybe +import Data.Conduit import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) +import Urbit.Time (Wen) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -37,7 +39,6 @@ import Urbit.Vere.Http.Client (client) import Urbit.Vere.Http.Server (serv) import Urbit.Vere.Log (EventLog) import Urbit.Vere.Serf (Serf, SerfState(..)) -import Data.Conduit import qualified System.Entropy as Ent import qualified Urbit.King.API as King @@ -127,21 +128,6 @@ bootSeqJobs now (BootSeq ident nocks ovums) = zipWith ($) bootSeqFns [1 ..] muckNock nok eId = RunNok $ LifeCyc eId 0 nok muckOvum ov eId = DoWork $ Work eId 0 (wen eId) ov -{- - loop :: [Job] -> SerfState -> Maybe (ProgressBar ()) -> [BootSeqFn] - -> RIO e ([Job], SerfState) - loop acc ss pb = \case - [] -> do - pb <- logStderr (updateProgressBar 0 bootMsg pb) - pure (reverse acc, ss) - x:xs -> do - wen <- io Time.now - job <- pure $ x (ssNextEv ss) (ssLastMug ss) wen - pb <- logStderr (updateProgressBar (1 + length xs) bootMsg pb) - (job, ss) <- bootJob serf job - loop (job:acc) ss pb xs --} - bootNewShip :: (HasPierConfig e, HasStderrLogFunc e, HasLogFunc e) => Pill @@ -223,6 +209,9 @@ getSnapshot top last = do acquireWorker :: RIO e () -> RAcquire e (Async ()) acquireWorker act = mkRAcquire (async act) cancel +acquireWorkerBound :: RIO e () -> RAcquire e (Async ()) +acquireWorkerBound act = mkRAcquire (asyncBound act) cancel + pier :: ∀e. (HasConfigDir e, HasLogFunc e, HasNetworkConfig e, HasPierConfig e) => (Serf, EventLog) -> TVar (Text -> IO ()) @@ -235,7 +224,7 @@ pier (serf, log) vStderr mStart = do saveM <- newEmptyTMVarIO shutdownM <- newEmptyTMVarIO - kapi ← King.kingAPI + kapi <- King.kingAPI termApiQ <- atomically $ do q <- newTQueue @@ -317,15 +306,15 @@ pier (serf, log) vStderr mStart = do death :: Text -> Async () -> STM (Either (Text, SomeException) Text) death tag tid = do waitCatchSTM tid <&> \case - Left exn -> Left (tag, exn) - Right () -> Right tag + Left exn -> Left (tag, exn) + Right () -> Right tag saveSignalThread :: TMVar () -> RAcquire e (Async ()) saveSignalThread tm = mkRAcquire start cancel - where - start = async $ forever $ do - threadDelay (120 * 1000000) -- 120 seconds - atomically $ putTMVar tm () + where + start = async $ forever $ do + threadDelay (120 * 1000000) -- 120 seconds + atomically $ putTMVar tm () -- Start All Drivers ----------------------------------------------------------- @@ -427,10 +416,10 @@ runCompute -> STM () -> (Maybe Text -> STM ()) -> STM () - -> ((Job, FX) -> STM ()) + -> ((Fact, FX) -> STM ()) -> RAcquire e (Async ()) runCompute serf getEvent getSaveSignal getShutdownSignal showSpinner hideSpinner putResult = do - mkRAcquire (async $ newRunCompute serf config) cancel + acquireWorker (newRunCompute serf config) where config = ComputeConfig { ccOnWork = getEvent @@ -441,17 +430,6 @@ runCompute serf getEvent getSaveSignal getShutdownSignal showSpinner hideSpinner , ccHideSpinner = hideSpinner } --- data RunOutput = RunOutput EventId Mug Wen (Either Noun Ev) [Ef] --- data Work = Work EventId Mug Wen Ev - -{- -data ComputeRequest - = CREvent Ev (Serf.RunError -> IO ()) - | CRSave () - | CRShutdown () - deriving (Eq, Show) --} - {- TODO Pack and Peek -} @@ -486,11 +464,18 @@ fromRightErr :: Either a b -> IO b fromRightErr (Left l) = error "unexpected Left value" fromRightErr (Right r) = pure r +data Fact = Fact + { factEve :: EventId + , factMug :: Mug + , factWen :: Wen + , factNon :: Noun + } + data ComputeConfig = ComputeConfig { ccOnWork :: STM (Ev, Serf.RunError -> IO ()) , ccOnKill :: STM () , ccOnSave :: STM () - , ccPutResult :: (Job, FX) -> STM () + , ccPutResult :: (Fact, FX) -> STM () , ccShowSpinner :: Maybe Text -> STM () , ccHideSpinner :: STM () } @@ -509,9 +494,7 @@ newRunCompute serf ComputeConfig {..} = do Nothing -> pure () Just (Serf.RunOutput e m w nounEv fx) -> do lift $ logTrace "newRunCompute: Got play result" - ev <- io $ fromRightErr nounEv -- TODO - let job :: Job = DoWork $ Work e m w ev - atomically (ccPutResult ((job, GoodParse <$> fx))) -- TODO GoodParse + atomically $ ccPutResult (Fact e m w nounEv, GoodParse <$> fx) -- TODO GoodParse sendResults onStatusChange :: Maybe Serf.RunInput -> STM () @@ -521,24 +504,6 @@ newRunCompute serf ComputeConfig {..} = do _ -> pure () -{- - FIND ME - - send event - push event - start spinner - hook for when event starts running - hook for when no event is running - send another event - first event is done - push to persistQ - update spinner to event #2 - second event is done - push to executeQ - remove spinner --} - - -- Persist Thread -------------------------------------------------------------- data PersistExn = BadEventId EventId EventId @@ -550,43 +515,38 @@ instance Exception PersistExn where , "\tExpected " <> show expected <> " but got " <> show got ] -runPersist :: ∀e. (HasPierConfig e, HasLogFunc e) - => EventLog - -> TQueue (Job, FX) - -> (FX -> STM ()) - -> RAcquire e (Async ()) -runPersist log inpQ out = - mkRAcquire runThread cancel - where - runThread :: RIO e (Async ()) - runThread = asyncBound $ do - dryRun <- view dryRunL - forever $ do - writs <- atomically getBatchFromQueue - unless dryRun $ do - events <- validateJobsAndGetBytes (toNullable writs) - Log.appendEvents log events - atomically $ for_ writs $ \(_,fx) -> out fx +runPersist + :: forall e + . (HasPierConfig e, HasLogFunc e) + => EventLog + -> TQueue (Fact, FX) + -> (FX -> STM ()) + -> RAcquire e (Async ()) +runPersist log inpQ out = mkRAcquire runThread cancel + where + runThread :: RIO e (Async ()) + runThread = asyncBound $ do + dryRun <- view dryRunL + forever $ do + writs <- atomically getBatchFromQueue + events <- validateFactsAndGetBytes (fst <$> toNullable writs) + unless dryRun (Log.appendEvents log events) + atomically $ for_ writs $ \(_, fx) -> do + out fx - validateJobsAndGetBytes :: [(Job, FX)] -> RIO e (Vector ByteString) - validateJobsAndGetBytes writs = do - expect <- Log.nextEv log - fmap fromList - $ for (zip [expect..] writs) - $ \(expectedId, (j, fx)) -> do - unless (expectedId == jobId j) $ - throwIO (BadEventId expectedId (jobId j)) - case j of - RunNok _ -> - error "This shouldn't happen here!" - DoWork (Work eId mug wen ev) -> - pure $ jamBS $ toNoun (mug, wen, ev) + validateFactsAndGetBytes :: [Fact] -> RIO e (Vector ByteString) + validateFactsAndGetBytes facts = do + expect <- Log.nextEv log + lis <- for (zip [expect ..] facts) $ \(expectedId, Fact eve mug wen non) -> + do + unless (expectedId == eve) $ do + throwIO (BadEventId expectedId eve) + pure $ jamBS $ toNoun (mug, wen, non) + pure (fromList lis) - getBatchFromQueue :: STM (NonNull [(Job, FX)]) - getBatchFromQueue = - readTQueue inpQ >>= go . singleton - where - go acc = - tryReadTQueue inpQ >>= \case - Nothing -> pure (reverse acc) - Just item -> go (item <| acc) + getBatchFromQueue :: STM (NonNull [(Fact, FX)]) + getBatchFromQueue = readTQueue inpQ >>= go . singleton + where + go acc = tryReadTQueue inpQ >>= \case + Nothing -> pure (reverse acc) + Just item -> go (item <| acc) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index ee06b9670..f4b2df383 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -167,7 +167,7 @@ data RunInput | RunPeek Wen Gang Path (Maybe (Term, Noun) -> IO ()) | RunWork Ev (RunError -> IO ()) -data RunOutput = RunOutput EventId Mug Wen (Either Noun Ev) [Ef] +data RunOutput = RunOutput EventId Mug Wen Noun [Ef] -- Exceptions ------------------------------------------------------------------ @@ -432,11 +432,11 @@ running serf notice = do io (sendWrit serf (WWork wen evn)) io (recvWork serf) >>= \case WDone eid hash fx -> do - yield (RunOutput eid hash wen (Right evn) fx) + yield (RunOutput eid hash wen (toNoun evn) fx) loop hash eid WSwap eid hash (wen, noun) fx -> do io $ err (RunSwap eid hash wen noun fx) - yield (RunOutput eid hash wen (Left noun) fx) + yield (RunOutput eid hash wen noun fx) loop hash eid WBail goofs -> do io $ err (RunBail goofs) From 8e78266d74d59f1786623834bb98bf9c68f05bde Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 27 May 2020 22:57:34 +0000 Subject: [PATCH 097/257] king: Review and Cleanup w/ Harrison --- pkg/hs/TODO.md | 27 +++ pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 4 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 6 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 57 ++---- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 178 +++++++++++-------- 5 files changed, 150 insertions(+), 122 deletions(-) create mode 100644 pkg/hs/TODO.md diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md new file mode 100644 index 000000000..495b71678 --- /dev/null +++ b/pkg/hs/TODO.md @@ -0,0 +1,27 @@ +Stubbed out: + +- [x] Handle replacement events (stubbed out now b/c interface can't + handle unparsed nouns) +- [ ] Handle IPC errors by killing serf process. +- [ ] Write haddock docs for `Urbit.Vere.Serf.IPC`. +- [ ] Unstub slog/stder/dead callbacks on serf config. +- [ ] GoodParse hack in newRunCompute. +- [ ] Bring back tank printing. +- [ ] Bring back code for handling serf stderr messages. + +King-Haskell specific features: + +- [ ] Re-implement "collect-fx" flow. + +Performance: + +- [ ] Batching during replay and normal operation. + +Polish: + +- [ ] Logging for new IPC flow. +- [ ] Logging for boot sequence. +- [ ] Bring back progress bars. +- [ ] Hook up error callbacks to IO Drivers. +- [x] Think through how to shutdown the serf on exception. +- [ ] Better exceptions in Serf error cases. diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index ec5221075..6d99b8ec7 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -174,7 +174,7 @@ runOrExitImmediately getPier oExit mStart = do shutdownImmediately :: (Serf, Log.EventLog) -> RIO e () shutdownImmediately (serf, log) = do logTrace "Sending shutdown signal" - Serf.execShutdown serf + Serf.shutdown serf logTrace "Shutdown!" runPier :: (Serf, Log.EventLog) -> RIO e () @@ -317,7 +317,7 @@ replayPartEvs top last = do case eSs of Just bail -> error (show bail) Nothing -> pure () - rio (Serf.execSnapshot serf) + rio (Serf.snapshot serf) io $ threadDelay 500000 -- Copied from runOrExitImmediately pure () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index bf47ed113..ebd044f8e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -38,7 +38,7 @@ import Urbit.Vere.Clay (clay) import Urbit.Vere.Http.Client (client) import Urbit.Vere.Http.Server (serv) import Urbit.Vere.Log (EventLog) -import Urbit.Vere.Serf (Serf, SerfState(..)) +import Urbit.Vere.Serf (Serf) import qualified System.Entropy as Ent import qualified Urbit.King.API as King @@ -105,7 +105,7 @@ writeJobs log !jobs = do -- Boot a new ship. ------------------------------------------------------------ runSerf :: HasLogFunc e => FilePath -> [Serf.Flag] -> RAcquire e Serf -runSerf pax fax = fst <$> Serf.withSerf config +runSerf pax fax = Serf.withSerf config where config = Serf.Config { scSerf = "urbit-worker" @@ -184,7 +184,7 @@ resumed replayUntil flags = do logTrace "Replaying events" Serf.execReplay serf log replayUntil logTrace "Taking snapshot" - Serf.execSnapshot serf + Serf.snapshot serf logTrace "Shuting down the serf" pure (serf, log) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 57fa508e3..6a0bbab10 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -10,8 +10,8 @@ module Urbit.Vere.Serf ( module Urbit.Vere.Serf.IPC , withSerf , execReplay - , execSnapshot - , execShutdown + , shutdown + , snapshot ) where @@ -62,45 +62,11 @@ bytesNouns = await >>= \case yield bod bytesNouns -withSerf :: HasLogFunc e => Config -> RAcquire e (Serf, SerfInfo) -withSerf config = mkRAcquire (io $ start config) kill +withSerf :: HasLogFunc e => Config -> RAcquire e Serf +withSerf config = mkRAcquire (io $ fmap fst $ start config) kill where - kill (serf, _) = do - void $ rio $ execShutdown serf - -{- - TODO This needs to be thought through carfully once the callsites - have stabilized. --} -execShutdown :: HasLogFunc e => Serf -> RIO e () -execShutdown serf = do - race_ (wait2sec >> forceKill) $ do - logTrace "Getting current serf state (taking lock, might block if in use)." - finalState <- takeMVar (serfLock serf) - logTrace "Got serf state (and took lock). Requesting shutdown." - io (shutdown serf 0) - logTrace "Sent shutdown request. Waiting for process to die." - io $ waitForProcess (serfProc serf) - logTrace "RIP Serf process." - where - wait2sec = threadDelay 5_000_000 - forceKill = do - logTrace "Serf taking too long to go down, kill with fire (SIGTERM)." - io (getPid $ serfProc serf) >>= \case - Nothing -> do - logTrace "Serf process already dead." - Just pid -> do - io $ signalProcess sigKILL pid - io $ waitForProcess (serfProc serf) - logTrace "Finished killing serf process with fire." - -execSnapshot :: forall e . HasLogFunc e => Serf -> RIO e () -execSnapshot serf = do - logTrace "execSnapshot: taking lock" - serfState <- takeMVar (serfLock serf) - io (sendSnapshotRequest serf (ssLast serfState)) - logTrace "execSnapshot: releasing lock" - putMVar (serfLock serf) serfState + kill serf = do + void $ rio $ shutdown serf execReplay :: forall e @@ -110,11 +76,13 @@ execReplay -> Maybe Word64 -> RIO e (Maybe PlayBail) execReplay serf log last = do - lastEventInSnap <- io (ssLast <$> serfCurrentStateBlocking serf) + lastEventInSnap <- io (serfLastEventBlocking serf) if lastEventInSnap == 0 then doBoot else doReplay where doBoot :: RIO e (Maybe PlayBail) doBoot = do + logTrace "Beginning boot sequence" + let bootSeqLen = lifecycleLen (Log.identity log) evs <- runConduit $ Log.streamEvents log 1 @@ -123,10 +91,9 @@ execReplay serf log last = do .| CC.sinkList let numEvs = fromIntegral (length evs) - let bootLn = bootSeqLen - when (numEvs /= bootLn) $ do - throwIO (MissingBootEventsInEventLog numEvs bootLn) + when (numEvs /= bootSeqLen) $ do + throwIO (MissingBootEventsInEventLog numEvs bootSeqLen) io (bootSeq serf evs) >>= \case Just err -> pure (Just err) @@ -136,7 +103,7 @@ execReplay serf log last = do doReplay = do logTrace "Beginning event log replay" - lastEventInSnap <- io (ssLast <$> serfCurrentStateBlocking serf) + lastEventInSnap <- io (serfLastEventBlocking serf) last & \case Nothing -> pure () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index f4b2df383..cda25646d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -2,6 +2,7 @@ |% :: +writ: from king to serf :: ++$ gang (unit (set ship)) +$ writ $% $: %live $% [%exit cod=@] @@ -29,23 +30,39 @@ [%bail lud=(list goof)] == == == --- -} -module Urbit.Vere.Serf.IPC where +module Urbit.Vere.Serf.IPC + ( Serf + , Config(..) + , PlayBail(..) + , Flag(..) + , RunError(..) + , RunInput(..) + , RunOutput(..) + , start + , serfLastEventBlocking + , shutdown + , snapshot + , bootSeq + , replay + , running + ) +where import Urbit.Prelude hiding ((<|)) +import Data.Bits import Data.Conduit +import System.Process import Urbit.Arvo import Urbit.Vere.Pier.Types hiding (Work) -import System.Process -import Data.Bits import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (castPtr) import Foreign.Storable (peek, poke) import RIO.Prelude (decodeUtf8Lenient) +import System.Posix.Signals (sigKILL, signalProcess) import Urbit.Time (Wen) import qualified Data.ByteString as BS @@ -61,7 +78,7 @@ type Gang = Maybe (HoonSet Ship) type Goof = (Term, [Tank]) data Live - = LExit Atom + = LExit Atom -- exit status code | LSave EventId | LPack EventId deriving (Show) @@ -125,6 +142,9 @@ deriveNoun ''SerfState deriveNoun ''SerfInfo deriveNoun ''Plea + +-- Serf API Types -------------------------------------------------------------- + data Serf = Serf { serfSend :: Handle , serfRecv :: Handle @@ -133,9 +153,6 @@ data Serf = Serf , serfLock :: MVar SerfState } - --- API Types ------------------------------------------------------------------- - data Flag = DebugRam | DebugCpu @@ -148,13 +165,13 @@ data Flag | Trace deriving (Eq, Ord, Show, Enum, Bounded) -data Config = Config -- binary, directory, &c - { scSerf :: FilePath - , scPier :: FilePath - , scFlag :: [Flag] - , scSlog :: Slog -> IO () - , scStdr :: Text -> IO () - , scDead :: IO () +data Config = Config + { scSerf :: FilePath -- Where is the urbit-worker executable? + , scPier :: FilePath -- Where is the pier directory? + , scFlag :: [Flag] -- Serf execution flags. + , scSlog :: Slog -> IO () -- What to do with slogs? + , scStdr :: Text -> IO () -- What to do with lines from stderr? + , scDead :: IO () -- What to do when the serf process goes down? } data RunError @@ -190,8 +207,9 @@ data SerfExn -- Access Current Serf State --------------------------------------------------- -serfCurrentStateBlocking :: Serf -> IO SerfState -serfCurrentStateBlocking Serf{serfLock} = readMVar serfLock +serfLastEventBlocking :: Serf -> IO EventId +serfLastEventBlocking Serf{serfLock} = ssLast <$> readMVar serfLock + -- Low Level IPC Functions ----------------------------------------------------- @@ -199,16 +217,17 @@ fromRightExn :: (Exception e, MonadIO m) => Either a b -> (a -> e) -> m b fromRightExn (Left m) exn = throwIO (exn m) fromRightExn (Right x) _ = pure x -withWord64AsByteString :: Word64 -> (ByteString -> IO a) -> IO a -withWord64AsByteString w k = alloca $ \wp -> do - poke wp w - bs <- BS.unsafePackCStringLen (castPtr wp, 8) - k bs - +-- TODO Support Big Endian sendLen :: Serf -> Int -> IO () sendLen s i = do w <- evaluate (fromIntegral i :: Word64) - withWord64AsByteString (fromIntegral i) (hPut (serfSend s)) + withWord64AsByteString w (hPut (serfSend s)) + where + withWord64AsByteString :: Word64 -> (ByteString -> IO a) -> IO a + withWord64AsByteString w k = alloca $ \wp -> do + poke wp w + bs <- BS.unsafePackCStringLen (castPtr wp, 8) + k bs sendBytes :: Serf -> ByteString -> IO () sendBytes s bs = handle onIOError $ do @@ -217,35 +236,34 @@ sendBytes s bs = handle onIOError $ do hFlush (serfSend s) where onIOError :: IOError -> IO () - onIOError = const (throwIO SerfConnectionClosed) + onIOError = const (throwIO SerfConnectionClosed) -- TODO call death callback? recvBytes :: Serf -> Word64 -> IO ByteString -recvBytes serf = io . BS.hGet (serfRecv serf) . fromIntegral +recvBytes serf = BS.hGet (serfRecv serf) . fromIntegral recvLen :: Serf -> IO Word64 recvLen w = do bs <- BS.hGet (serfRecv w) 8 case length bs of - 8 -> BS.unsafeUseAsCString bs (peek . castPtr) - _ -> throwIO SerfConnectionClosed + 8 -> BS.unsafeUseAsCString bs (peek @Word64 . castPtr) + _ -> throwIO SerfConnectionClosed -- TODO kill worker process and call the death callback. -recvAtom :: Serf -> IO Atom -recvAtom w = do - len <- recvLen w - bytesAtom <$> recvBytes w len +recvResp :: Serf -> IO ByteString +recvResp serf = do + len <- recvLen serf + recvBytes serf len -- Send Writ / Recv Plea ------------------------------------------------------- sendWrit :: Serf -> Writ -> IO () -sendWrit s w = do - sendBytes s $ jamBS $ toNoun w +sendWrit s = sendBytes s . jamBS . toNoun recvPlea :: Serf -> IO Plea recvPlea w = do - a <- recvAtom w - n <- fromRightExn (cue a) (const $ BadPleaAtom a) - p <- fromRightExn (fromNounErr n) (\(p, m) -> BadPleaNoun n p m) + b <- recvResp w + n <- fromRightExn (cueBS b) (const $ BadPleaAtom $ bytesAtom b) + p <- fromRightExn (fromNounErr @Plea n) (\(p, m) -> BadPleaNoun n p m) pure p recvPleaHandlingSlog :: Serf -> IO Plea @@ -286,23 +304,28 @@ recvPeek serf = do plea -> throwIO (UnexpectedPlea plea "expecting %peek") --- Request-Response Points ----------------------------------------------------- +-- Request-Response Points -- These don't touch the lock ----------------------- sendSnapshotRequest :: Serf -> EventId -> IO () sendSnapshotRequest serf eve = do sendWrit serf (WLive $ LSave eve) recvLive serf -compact :: Serf -> EventId -> IO () -compact serf eve = do +sendCompactRequest :: Serf -> EventId -> IO () +sendCompactRequest serf eve = do sendWrit serf (WLive $ LPack eve) recvLive serf -scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) -scry serf w g p = do +sendScryRequest :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) +sendScryRequest serf w g p = do sendWrit serf (WPeek w g p) recvPeek serf +sendShutdownRequest :: Serf -> Atom -> IO () +sendShutdownRequest serf exitCode = do + sendWrit serf (WLive $ LExit exitCode) + pure () + -- Serf Usage Flows ------------------------------------------------------------ @@ -320,10 +343,10 @@ readStdErr h onLine onClose = loop start :: Config -> IO (Serf, SerfInfo) start (Config exePax pierPath flags onSlog onStdr onDead) = do (Just i, Just o, Just e, p) <- createProcess pSpec - async (readStdErr e onStdr onDead) + void $ async (readStdErr e onStdr onDead) vLock <- newEmptyMVar let serf = Serf i o p onSlog vLock - info <- recvRipe serf -- Gross: recvRipe doesn't care about lock so this is fine. + info <- recvRipe serf putMVar vLock (siStat info) pure (serf, info) where @@ -335,16 +358,38 @@ start (Config exePax pierPath flags onSlog onStdr onDead) = do , std_err = CreatePipe } -{- - TODO wait for process exit? - TODO force shutdown after time period? Not our job? --} -shutdown :: Serf -> Atom -> IO () -shutdown serf exitCode = do - sendWrit serf (WLive $ LExit exitCode) - pure () +snapshot :: HasLogFunc e => Serf -> RIO e () +snapshot serf = do + logTrace "execSnapshot: taking lock" + serfState <- takeMVar (serfLock serf) + io (sendSnapshotRequest serf (ssLast serfState)) + logTrace "execSnapshot: releasing lock" + putMVar (serfLock serf) serfState -bootSeq :: Serf -> [Noun] -> IO (Maybe PlayBail) +shutdown :: HasLogFunc e => Serf -> RIO e () +shutdown serf = do + race_ (wait2sec >> forceKill) $ do + logTrace "Getting current serf state (taking lock, might block if in use)." + finalState <- takeMVar (serfLock serf) + logTrace "Got serf state (and took lock). Requesting shutdown." + io (sendShutdownRequest serf 0) + logTrace "Sent shutdown request. Waiting for process to die." + io $ waitForProcess (serfProc serf) + logTrace "RIP Serf process." + where + wait2sec = threadDelay 2_000_000 + forceKill = do + logTrace "Serf taking too long to go down, kill with fire (SIGTERM)." + io (getPid $ serfProc serf) >>= \case + Nothing -> do + logTrace "Serf process already dead." + Just pid -> do + io $ signalProcess sigKILL pid + io $ waitForProcess (serfProc serf) + logTrace "Finished killing serf process with fire." + + +bootSeq :: Serf -> [Noun] -> IO (Maybe PlayBail) -- TODO should this be an exception? bootSeq serf@Serf{..} seq = do oldInfo <- takeMVar serfLock sendWrit serf (WPlay 1 seq) @@ -358,40 +403,32 @@ bootSeq serf@Serf{..} seq = do If this throws an exception, the serf will be in an unusable state. Kill the process. + TODO *we* should probably kill the serf on exception? TODO Take advantage of IPC support for batching. TODO Maybe take snapshots -} -replay - :: forall m - . MonadIO m - => Serf - -> ConduitT Noun Void m (Maybe PlayBail) +replay :: forall m . MonadIO m => Serf -> ConduitT Noun Void m (Maybe PlayBail) replay serf = do - initState <- takeMVar (serfLock serf) + initState <- takeMVar (serfLock serf) (mErr, newState) <- loop initState putMVar (serfLock serf) newState pure mErr where loop :: SerfState -> ConduitT Noun Void m (Maybe PlayBail, SerfState) - loop (SerfState lastEve lastMug) = do - await >>= \case + loop (SerfState lastEve lastMug) = await >>= \case Nothing -> pure (Nothing, SerfState lastEve lastMug) Just ev -> do let newEve = lastEve + 1 io $ sendWrit serf (WPlay newEve [ev]) - res <- io (recvPlay serf) >>= \case + io (recvPlay serf) >>= \case PBail bail -> pure (Just bail, SerfState lastEve lastMug) PDone newMug -> loop (SerfState newEve newMug) - pure res - -whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () -whenJust Nothing _ = pure () -whenJust (Just a) act = act a {- If this throws an exception, the serf will be in an unusable state. Kill the process. + TODO *we* should probably kill the serf on exception? TODO callbacks on snapshot and compaction? TODO Take advantage of async IPC to fill pipe with more than one thing. -} @@ -409,10 +446,8 @@ running serf notice = do where loop :: Mug -> EventId -> ConduitT RunInput RunOutput m SerfState loop mug eve = do - print "Serf.running.loop" io (notice Nothing) nex <- await - print ("Serf.running.loop: Got something") io (notice nex) nex & \case Nothing -> do @@ -421,11 +456,10 @@ running serf notice = do io (sendSnapshotRequest serf eve) loop mug eve Just RunPack -> do - io (compact serf eve) + io (sendCompactRequest serf eve) loop mug eve Just (RunPeek wen gang pax act) -> do - res <- io (scry serf wen gang pax) - io (act res) + io (sendScryRequest serf wen gang pax >>= act) loop mug eve Just (RunWork evn err) -> do wen <- io Time.now From ca13d3f79b23670354c17e3146fe2e2bc55f2188 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 28 May 2020 00:08:53 +0000 Subject: [PATCH 098/257] king: Better handling of edge-cases around IPC failure. --- pkg/hs/TODO.md | 3 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 96 ++++++++++++-------- 2 files changed, 58 insertions(+), 41 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index 495b71678..d2f078e6c 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -2,7 +2,8 @@ Stubbed out: - [x] Handle replacement events (stubbed out now b/c interface can't handle unparsed nouns) -- [ ] Handle IPC errors by killing serf process. +- [x] Handle IPC errors by killing serf process. +- [ ] PlayBail should be an exception. - [ ] Write haddock docs for `Urbit.Vere.Serf.IPC`. - [ ] Unstub slog/stder/dead callbacks on serf config. - [ ] GoodParse hack in newRunCompute. diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index cda25646d..1f89c59ca 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -150,7 +150,7 @@ data Serf = Serf , serfRecv :: Handle , serfProc :: ProcessHandle , serfSlog :: Slog -> IO () - , serfLock :: MVar SerfState + , serfLock :: MVar (Either SomeException SerfState) } data Flag @@ -208,7 +208,9 @@ data SerfExn -- Access Current Serf State --------------------------------------------------- serfLastEventBlocking :: Serf -> IO EventId -serfLastEventBlocking Serf{serfLock} = ssLast <$> readMVar serfLock +serfLastEventBlocking Serf{serfLock} = readMVar serfLock >>= \case + Left err -> throwIO err + Right ss -> pure (ssLast ss) -- Low Level IPC Functions ----------------------------------------------------- @@ -347,7 +349,7 @@ start (Config exePax pierPath flags onSlog onStdr onDead) = do vLock <- newEmptyMVar let serf = Serf i o p onSlog vLock info <- recvRipe serf - putMVar vLock (siStat info) + putMVar vLock (Right $ siStat info) pure (serf, info) where diskKey = "" @@ -358,13 +360,33 @@ start (Config exePax pierPath flags onSlog onStdr onDead) = do , std_err = CreatePipe } +withSerfLock + :: MonadIO m + => (m (SerfState, a) -> m (Either SomeException (SerfState, a))) + -> Serf + -> (SerfState -> m (SerfState, a)) + -> m a +withSerfLock tryGen s f = do + ss <- takeLock + tryGen (f ss) >>= \case + Left e -> do + io (forceKillSerf s) + putMVar (serfLock s) (Left e) + throwIO e + Right (ss', x) -> do + putMVar (serfLock s) (Right ss') + pure x + where + takeLock = do + takeMVar (serfLock s) >>= \case + Left exn -> putMVar (serfLock s) (Left exn) >> throwIO exn + Right ss -> pure ss + snapshot :: HasLogFunc e => Serf -> RIO e () -snapshot serf = do - logTrace "execSnapshot: taking lock" - serfState <- takeMVar (serfLock serf) - io (sendSnapshotRequest serf (ssLast serfState)) - logTrace "execSnapshot: releasing lock" - putMVar (serfLock serf) serfState +snapshot serf = + withSerfLock try serf \ss -> do + io (sendSnapshotRequest serf (ssLast ss)) + pure (ss, ()) shutdown :: HasLogFunc e => Serf -> RIO e () shutdown serf = do @@ -380,39 +402,37 @@ shutdown serf = do wait2sec = threadDelay 2_000_000 forceKill = do logTrace "Serf taking too long to go down, kill with fire (SIGTERM)." - io (getPid $ serfProc serf) >>= \case - Nothing -> do - logTrace "Serf process already dead." - Just pid -> do - io $ signalProcess sigKILL pid - io $ waitForProcess (serfProc serf) - logTrace "Finished killing serf process with fire." + io (forceKillSerf serf) + logTrace "Serf process killed with SIGTERM." +forceKillSerf :: Serf -> IO () +forceKillSerf serf = do + getPid (serfProc serf) >>= \case + Nothing -> pure () + Just pid -> do + io $ signalProcess sigKILL pid + io $ void $ waitForProcess (serfProc serf) bootSeq :: Serf -> [Noun] -> IO (Maybe PlayBail) -- TODO should this be an exception? bootSeq serf@Serf{..} seq = do - oldInfo <- takeMVar serfLock - sendWrit serf (WPlay 1 seq) - (res, newInfo) <- recvPlay serf >>= \case - PBail bail -> pure (Just bail, oldInfo) - PDone newMug -> pure (Nothing, SerfState (fromIntegral $ length seq) newMug) - putMVar serfLock newInfo - pure res + withSerfLock try serf \ss -> do + recvPlay serf >>= \case + PBail bail -> pure (ss, Just bail) + PDone newMug -> pure (SerfState (fromIntegral $ length seq) newMug, Nothing) {- - If this throws an exception, the serf will be in an unusable state. Kill - the process. - - TODO *we* should probably kill the serf on exception? TODO Take advantage of IPC support for batching. TODO Maybe take snapshots -} -replay :: forall m . MonadIO m => Serf -> ConduitT Noun Void m (Maybe PlayBail) +replay + :: forall m + . (MonadUnliftIO m, MonadIO m) + => Serf + -> ConduitT Noun Void m (Maybe PlayBail) replay serf = do - initState <- takeMVar (serfLock serf) - (mErr, newState) <- loop initState - putMVar (serfLock serf) newState - pure mErr + withSerfLock tryC serf \ss -> do + (r, ss') <- loop ss + pure (ss', r) where loop :: SerfState -> ConduitT Noun Void m (Maybe PlayBail, SerfState) loop (SerfState lastEve lastMug) = await >>= \case @@ -425,24 +445,20 @@ replay serf = do PDone newMug -> loop (SerfState newEve newMug) {- - If this throws an exception, the serf will be in an unusable state. Kill - the process. - TODO *we* should probably kill the serf on exception? TODO callbacks on snapshot and compaction? TODO Take advantage of async IPC to fill pipe with more than one thing. -} running :: forall m - . MonadIO m + . (MonadIO m, MonadUnliftIO m) => Serf -> (Maybe RunInput -> IO ()) -> ConduitT RunInput RunOutput m () running serf notice = do - SerfState {..} <- takeMVar (serfLock serf) - newState <- loop ssHash ssLast - putMVar (serfLock serf) newState - pure () + withSerfLock tryC serf $ \SerfState{..} -> do + newState <- loop ssHash ssLast + pure (newState, ()) where loop :: Mug -> EventId -> ConduitT RunInput RunOutput m SerfState loop mug eve = do From d8f90ead07c39d7da3efb613589e67b0a2f561de Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 28 May 2020 18:21:43 +0000 Subject: [PATCH 099/257] king: Misc Small Cleanup. --- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 130 +++++++----------- .../urbit-king/lib/Urbit/Vere/Pier/Types.hs | 7 + pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 31 +---- 3 files changed, 59 insertions(+), 109 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index ebd044f8e..78ccaaa4b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -31,7 +31,7 @@ import Data.Conduit import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) -import Urbit.Time (Wen) +-- ort Urbit.Time (Wen) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -49,7 +49,7 @@ import qualified Urbit.Vere.Term as Term import qualified Urbit.Vere.Term.API as Term import qualified Urbit.Vere.Term.Demux as Term import qualified Urbit.Vere.Term.Render as Term -import qualified Data.Conduit.Combinators as CC +-- ort qualified Data.Conduit.Combinators as CC -------------------------------------------------------------------------------- @@ -275,15 +275,18 @@ pier (serf, log) vStderr mStart = do let stubErrCallback = \_ -> pure () - tExe <- startDrivers >>= router (readTQueue executeQ) - tDisk <- runPersist log persistQ (writeTQueue executeQ) - tCpu <- runCompute serf - ((,stubErrCallback) <$> readTQueue computeQ) - (takeTMVar saveM) - (takeTMVar shutdownM) - (Term.spin muxed) - (Term.stopSpin muxed) - (writeTQueue persistQ) + let computeConfig = ComputeConfig + { ccOnWork = (,stubErrCallback) <$> readTQueue computeQ + , ccOnKill = takeTMVar shutdownM + , ccOnSave = takeTMVar saveM + , ccPutResult = writeTQueue persistQ + , ccShowSpinner = Term.spin muxed + , ccHideSpinner = Term.stopSpin muxed + } + + tExe <- startDrivers >>= acquireWorker . router (readTQueue executeQ) + tDisk <- acquireWorkerBound (runPersist log persistQ (writeTQueue executeQ)) + tCpu <- acquireWorker (runCompute serf computeConfig) tSaveSignal <- saveSignalThread saveM @@ -359,29 +362,24 @@ drivers inst who isFake plan shutdownSTM termSys stderr = -- Route Effects to Drivers ---------------------------------------------------- -router :: HasLogFunc e => STM FX -> Drivers e -> RAcquire e (Async ()) -router waitFx Drivers{..} = - mkRAcquire start cancel - where - start = async $ forever $ do - fx <- atomically waitFx - for_ fx $ \ef -> do - logEffect ef - case ef of - GoodParse (EfVega _ _) -> error "TODO" - GoodParse (EfExit _ _) -> error "TODO" - GoodParse (EfVane (VEAmes ef)) -> dAmes ef - GoodParse (EfVane (VEBehn ef)) -> dBehn ef - GoodParse (EfVane (VEBoat ef)) -> dSync ef - GoodParse (EfVane (VEClay ef)) -> dSync ef - GoodParse (EfVane (VEHttpClient ef)) -> dHttpClient ef - GoodParse (EfVane (VEHttpServer ef)) -> dHttpServer ef - GoodParse (EfVane (VENewt ef)) -> dNewt ef - GoodParse (EfVane (VESync ef)) -> dSync ef - GoodParse (EfVane (VETerm ef)) -> dTerm ef - FailParse n -> logError - $ display - $ pack @Text (ppShow n) +router :: HasLogFunc e => STM FX -> Drivers e -> RIO e () +router waitFx Drivers {..} = forever $ do + fx <- atomically waitFx + for_ fx $ \ef -> do + logEffect ef + case ef of + GoodParse (EfVega _ _ ) -> error "TODO" + GoodParse (EfExit _ _ ) -> error "TODO" + GoodParse (EfVane (VEAmes ef)) -> dAmes ef + GoodParse (EfVane (VEBehn ef)) -> dBehn ef + GoodParse (EfVane (VEBoat ef)) -> dSync ef + GoodParse (EfVane (VEClay ef)) -> dSync ef + GoodParse (EfVane (VEHttpClient ef)) -> dHttpClient ef + GoodParse (EfVane (VEHttpServer ef)) -> dHttpServer ef + GoodParse (EfVane (VENewt ef)) -> dNewt ef + GoodParse (EfVane (VESync ef)) -> dSync ef + GoodParse (EfVane (VETerm ef)) -> dTerm ef + FailParse n -> logError $ display $ pack @Text (ppShow n) -- Compute Thread -------------------------------------------------------------- @@ -407,29 +405,6 @@ data ComputeRequest | CRSave () | CRShutdown () -runCompute - :: forall e - . HasLogFunc e - => Serf - -> STM (Ev, Serf.RunError -> IO ()) - -> STM () - -> STM () - -> (Maybe Text -> STM ()) - -> STM () - -> ((Fact, FX) -> STM ()) - -> RAcquire e (Async ()) -runCompute serf getEvent getSaveSignal getShutdownSignal showSpinner hideSpinner putResult = do - acquireWorker (newRunCompute serf config) - where - config = ComputeConfig - { ccOnWork = getEvent - , ccOnKill = getShutdownSignal - , ccOnSave = getSaveSignal - , ccPutResult = putResult - , ccShowSpinner = showSpinner - , ccHideSpinner = hideSpinner - } - {- TODO Pack and Peek -} @@ -460,17 +435,6 @@ ipcSource onEvent onSave onKill = loop yield (Serf.RunWork ev cb) loop -fromRightErr :: Either a b -> IO b -fromRightErr (Left l) = error "unexpected Left value" -fromRightErr (Right r) = pure r - -data Fact = Fact - { factEve :: EventId - , factMug :: Mug - , factWen :: Wen - , factNon :: Noun - } - data ComputeConfig = ComputeConfig { ccOnWork :: STM (Ev, Serf.RunError -> IO ()) , ccOnKill :: STM () @@ -480,10 +444,10 @@ data ComputeConfig = ComputeConfig , ccHideSpinner :: STM () } -newRunCompute +runCompute :: forall e . HasLogFunc e => Serf.Serf -> ComputeConfig -> RIO e () -newRunCompute serf ComputeConfig {..} = do - logTrace "newRunCompute" +runCompute serf ComputeConfig {..} = do + logTrace "runCompute" runConduit $ ipcSource ccOnWork ccOnSave ccOnKill .| Serf.running serf (atomically . onStatusChange) @@ -493,7 +457,7 @@ newRunCompute serf ComputeConfig {..} = do sendResults = await >>= \case Nothing -> pure () Just (Serf.RunOutput e m w nounEv fx) -> do - lift $ logTrace "newRunCompute: Got play result" + lift $ logTrace "runCompute: Got play result" atomically $ ccPutResult (Fact e m w nounEv, GoodParse <$> fx) -- TODO GoodParse sendResults @@ -521,19 +485,17 @@ runPersist => EventLog -> TQueue (Fact, FX) -> (FX -> STM ()) - -> RAcquire e (Async ()) -runPersist log inpQ out = mkRAcquire runThread cancel - where - runThread :: RIO e (Async ()) - runThread = asyncBound $ do - dryRun <- view dryRunL - forever $ do - writs <- atomically getBatchFromQueue - events <- validateFactsAndGetBytes (fst <$> toNullable writs) - unless dryRun (Log.appendEvents log events) - atomically $ for_ writs $ \(_, fx) -> do - out fx + -> RIO e () +runPersist log inpQ out = do + dryRun <- view dryRunL + forever $ do + writs <- atomically getBatchFromQueue + events <- validateFactsAndGetBytes (fst <$> toNullable writs) + unless dryRun (Log.appendEvents log events) + atomically $ for_ writs $ \(_, fx) -> do + out fx + where validateFactsAndGetBytes :: [Fact] -> RIO e (Vector ByteString) validateFactsAndGetBytes facts = do expect <- Log.nextEv log diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index eaa8df10d..1b402a0e1 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -95,6 +95,13 @@ data IODriver = IODriver , startDriver :: (Ev -> STM ()) -> IO (Async (), Perform) } +data Fact = Fact + { factEve :: EventId + , factMug :: Mug + , factWen :: Wen + , factNon :: Noun + } + -- Instances ------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 6a0bbab10..3596dc37b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -1,46 +1,27 @@ -{-# OPTIONS_GHC -Wwarn #-} - {-| - Serf Interface - - TODO: `recvLen` is not big-endian safe. + High-Level Serf Interface -} module Urbit.Vere.Serf ( module Urbit.Vere.Serf.IPC , withSerf , execReplay - , shutdown - , snapshot ) where import Urbit.Prelude import Data.Conduit -import System.Process -import System.ProgressBar -import Urbit.Arvo +-- ort System.ProgressBar +-- ort Urbit.Arvo import Urbit.Vere.Pier.Types import Urbit.Vere.Serf.IPC -import System.Posix.Signals -import Data.Bits (setBit) -import Data.ByteString (hGet) -import Data.ByteString.Unsafe (unsafeUseAsCString) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Ptr (castPtr) -import Foreign.Storable (peek, poke) -import System.Exit (ExitCode) -import Urbit.King.App (HasStderrLogFunc(..)) +-- ort Urbit.King.App (HasStderrLogFunc(..)) -import qualified Data.ByteString.Unsafe as BS import qualified Data.Conduit.Combinators as CC -import qualified Data.Text as T -import qualified System.IO as IO -import qualified System.IO.Error as IO -import qualified Urbit.Ob as Ob -import qualified Urbit.Time as Time +-- ort qualified Urbit.Ob as Ob +-- ort qualified Urbit.Time as Time import qualified Urbit.Vere.Log as Log From 80b905c239a4a8eccfe5f90024d152a6542d960c Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 28 May 2020 18:56:51 +0000 Subject: [PATCH 100/257] king: Slogs routed to both terminal and log output. --- pkg/hs/TODO.md | 2 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 37 +++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 100 ++++++++++++++--------- 3 files changed, 83 insertions(+), 56 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index d2f078e6c..b2dc9cf3a 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -5,7 +5,7 @@ Stubbed out: - [x] Handle IPC errors by killing serf process. - [ ] PlayBail should be an exception. - [ ] Write haddock docs for `Urbit.Vere.Serf.IPC`. -- [ ] Unstub slog/stder/dead callbacks on serf config. +- [x] Unstub slog/stder/dead callbacks on serf config. - [ ] GoodParse hack in newRunCompute. - [ ] Bring back tank printing. - [ ] Bring back code for handling serf stderr messages. diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 6d99b8ec7..a827f10b0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -144,6 +144,11 @@ toNetworkConfig CLI.Opts {..} = NetworkConfig { .. } _ncHttpsPort = oHttpsPort _ncLocalPort = oLoopbackPort +logSlogs :: HasLogFunc e => RIO e (TVar (Text -> IO ())) +logSlogs = do + env <- ask + newTVarIO (runRIO env . logTrace . ("SLOG: " <>) . display) + tryBootFromPill :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e , HasConfigDir e, HasStderrLogFunc e ) @@ -152,23 +157,25 @@ tryBootFromPill :: ( HasLogFunc e, HasNetworkConfig e, HasPierConfig e -> RIO e () tryBootFromPill oExit pill lite flags ship boot = do mStart <- newEmptyMVar - runOrExitImmediately bootedPier oExit mStart + vSlog <- logSlogs + runOrExitImmediately vSlog (bootedPier vSlog) oExit mStart where - bootedPier = do + bootedPier vSlog = do view pierPathL >>= lockFile rio $ logTrace "Starting boot" - sls <- Pier.booted pill lite flags ship boot + sls <- Pier.booted vSlog pill lite flags ship boot rio $ logTrace "Completed boot" pure sls runOrExitImmediately :: forall e . (HasLogFunc e, HasNetworkConfig e, HasPierConfig e, HasConfigDir e) - => RAcquire e (Serf, Log.EventLog) + => TVar (Text -> IO ()) + -> RAcquire e (Serf, Log.EventLog) -> Bool -> MVar () -> RIO e () -runOrExitImmediately getPier oExit mStart = do +runOrExitImmediately vSlog getPier oExit mStart = do rwith getPier (if oExit then shutdownImmediately else runPier) where shutdownImmediately :: (Serf, Log.EventLog) -> RIO e () @@ -179,9 +186,7 @@ runOrExitImmediately getPier oExit mStart = do runPier :: (Serf, Log.EventLog) -> RIO e () runPier serfLog = do - let defaultStderr txt = putStrLn "txt" -- TODO XX What did we do before? - vStderr <- newTVarIO defaultStderr - runRAcquire (Pier.pier serfLog vStderr mStart) + runRAcquire (Pier.pier serfLog vSlog mStart) tryPlayShip :: ( HasStderrLogFunc e, HasLogFunc e, HasNetworkConfig e , HasPierConfig e, HasConfigDir e @@ -189,7 +194,8 @@ tryPlayShip :: ( HasStderrLogFunc e, HasLogFunc e, HasNetworkConfig e => Bool -> Bool -> Maybe Word64 -> [Serf.Flag] -> MVar () -> RIO e () tryPlayShip exitImmediately fullReplay playFrom flags mStart = do when fullReplay wipeSnapshot - runOrExitImmediately resumeShip exitImmediately mStart + vSlog <- logSlogs + runOrExitImmediately vSlog (resumeShip vSlog) exitImmediately mStart where wipeSnapshot = do shipPath <- view pierPathL @@ -202,10 +208,10 @@ tryPlayShip exitImmediately fullReplay playFrom flags mStart = do north shipPath = shipPath <> "/.urb/chk/north.bin" south shipPath = shipPath <> "/.urb/chk/south.bin" - resumeShip = do + resumeShip vSlog = do view pierPathL >>= lockFile rio $ logTrace "RESUMING SHIP" - sls <- Pier.resumed playFrom flags + sls <- Pier.resumed vSlog playFrom flags rio $ logTrace "SHIP RESUMED" pure sls @@ -265,17 +271,18 @@ checkEvs pierPath first last = do collectAllFx :: ∀e. HasLogFunc e => FilePath -> RIO e () collectAllFx top = do logTrace $ display $ pack @Text top - rwith collectedFX $ \() -> + vSlog <- logSlogs + rwith (collectedFX vSlog) $ \() -> logTrace "Done collecting effects!" where tmpDir :: FilePath tmpDir = top ".tmpdir" - collectedFX :: RAcquire e () - collectedFX = do + collectedFX :: TVar (Text -> IO ()) -> RAcquire e () + collectedFX vSlog = do lockFile top log <- Log.existing (top <> "/.urb/log") - serf <- Pier.runSerf tmpDir serfFlags + serf <- Pier.runSerf vSlog tmpDir serfFlags rio $ error "Serf.collectFX" serf log serfFlags :: [Serf.Flag] diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 78ccaaa4b..5c5e427aa 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -104,16 +104,27 @@ writeJobs log !jobs = do -- Boot a new ship. ------------------------------------------------------------ -runSerf :: HasLogFunc e => FilePath -> [Serf.Flag] -> RAcquire e Serf -runSerf pax fax = Serf.withSerf config +printTank :: (Text -> IO ()) -> Atom -> Tank -> IO () +printTank f _ = io . f . unlines . fmap unTape . wash (WashCfg 0 80) + +runSerf + :: HasLogFunc e + => TVar (Text -> IO ()) + -> FilePath + -> [Serf.Flag] + -> RAcquire e Serf +runSerf vSlog pax fax = do + env <- ask + Serf.withSerf (config env) where - config = Serf.Config - { scSerf = "urbit-worker" + slog txt = join $ atomically (readTVar vSlog >>= pure . ($ txt)) + config env = Serf.Config + { scSerf = "urbit-worker" -- TODO Find the executable in some proper way. , scPier = pax , scFlag = fax - , scSlog = \slog -> print ("slog", slog) -- TODO error "TODO: slog" - , scStdr = \stdr -> print ("stdr", stdr) -- TODO error "TODO: stdr" - , scDead = pure () -- error "TODO: dead" + , scSlog = \(pri, tank) -> printTank slog pri tank + , scStdr = \line -> runRIO env $ logTrace (display ("SERF: " <> line)) + , scDead = pure () -- TODO: What can be done? } bootSeqJobs :: Time.Wen -> BootSeq -> [Job] @@ -152,22 +163,29 @@ bootNewShip pill lite flags ship bootEv = do logTrace "Finsihed populating event log with boot sequence" -booted :: (HasPierConfig e, HasStderrLogFunc e, HasLogFunc e) - => Pill -> Bool -> [Serf.Flag] -> Ship -> LegacyBootEvent - -> RAcquire e (Serf, EventLog) -booted pill lite flags ship boot = do +booted + :: (HasPierConfig e, HasStderrLogFunc e, HasLogFunc e) + => TVar (Text -> IO ()) + -> Pill + -> Bool + -> [Serf.Flag] + -> Ship + -> LegacyBootEvent + -> RAcquire e (Serf, EventLog) +booted vSlog pill lite flags ship boot = do rio $ bootNewShip pill lite flags ship boot - resumed Nothing flags + resumed vSlog Nothing flags -- Resume an existing ship. ---------------------------------------------------- resumed :: (HasStderrLogFunc e, HasPierConfig e, HasLogFunc e) - => Maybe Word64 + => TVar (Text -> IO ()) + -> Maybe Word64 -> [Serf.Flag] -> RAcquire e (Serf, EventLog) -resumed replayUntil flags = do +resumed vSlog replayUntil flags = do rio $ logTrace "Resuming ship" top <- view pierPathL tap <- fmap (fromMaybe top) $ rio $ runMaybeT $ do @@ -177,8 +195,8 @@ resumed replayUntil flags = do rio $ logTrace $ display @Text ("pier: " <> pack top) rio $ logTrace $ display @Text ("running serf in: " <> pack tap) - log <- Log.existing (top <> "/.urb/log") - serf <- runSerf tap flags + log <- Log.existing (top <> "/.urb/log") + serf <- runSerf vSlog tap flags rio $ do logTrace "Replaying events" @@ -217,7 +235,7 @@ pier :: ∀e. (HasConfigDir e, HasLogFunc e, HasNetworkConfig e, HasPierConfig e -> TVar (Text -> IO ()) -> MVar () -> RAcquire e () -pier (serf, log) vStderr mStart = do +pier (serf, log) vSlog mStart = do computeQ <- newTQueueIO persistQ <- newTQueueIO executeQ <- newTQueueIO @@ -248,13 +266,18 @@ pier (serf, log) vStderr mStart = do -- "TERMSERV Terminal Server running on port: " <> tshow termServPort acquireWorker $ forever $ do - logTrace "TERMSERV Waiting for external terminal." - atomically $ do - ext <- Term.connClient <$> readTQueue termApiQ - Term.addDemux ext demux - logTrace "TERMSERV External terminal connected." + logTrace "TERMSERV Waiting for external terminal." + atomically $ do + ext <- Term.connClient <$> readTQueue termApiQ + Term.addDemux ext demux + logTrace "TERMSERV External terminal connected." - atomically $ writeTVar vStderr (atomically . Term.trace muxed) + -- Slogs go to both stderr and to the terminal. + atomically $ do + oldSlog <- readTVar vSlog + writeTVar vSlog $ \txt -> do + atomically $ Term.trace muxed txt + oldSlog txt let logId = Log.identity log let ship = who logId @@ -385,25 +408,23 @@ router waitFx Drivers {..} = forever $ do -- Compute Thread -------------------------------------------------------------- logEvent :: HasLogFunc e => Ev -> RIO e () -logEvent ev = - logDebug $ display $ "[EVENT]\n" <> pretty - where - pretty :: Text - pretty = pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow ev +logEvent ev = logDebug $ display $ "[EVENT]\n" <> pretty + where + pretty :: Text + pretty = pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow ev logEffect :: HasLogFunc e => Lenient Ef -> RIO e () -logEffect ef = - logDebug $ display $ "[EFFECT]\n" <> pretty ef - where - pretty :: Lenient Ef -> Text - pretty = \case - GoodParse e -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow e - FailParse n -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow n +logEffect ef = logDebug $ display $ "[EFFECT]\n" <> pretty ef + where + pretty :: Lenient Ef -> Text + pretty = \case + GoodParse e -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow e + FailParse n -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow n data ComputeRequest - = CREvent (Ev, Serf.RunError -> IO ()) - | CRSave () - | CRShutdown () + = CREvent (Ev, Serf.RunError -> IO ()) + | CRSave () + | CRShutdown () {- TODO Pack and Peek @@ -444,8 +465,7 @@ data ComputeConfig = ComputeConfig , ccHideSpinner :: STM () } -runCompute - :: forall e . HasLogFunc e => Serf.Serf -> ComputeConfig -> RIO e () +runCompute :: forall e . HasLogFunc e => Serf.Serf -> ComputeConfig -> RIO e () runCompute serf ComputeConfig {..} = do logTrace "runCompute" runConduit From bc35ec04069d4e5c8d51743173647a58046f365c Mon Sep 17 00:00:00 2001 From: ~siprel Date: Fri, 29 May 2020 02:14:25 +0000 Subject: [PATCH 101/257] king: IPC Batching during replay and normal operation. --- pkg/hs/TODO.md | 9 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 76 ++----- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 8 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 202 +++++++++++++++++-- 5 files changed, 218 insertions(+), 79 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index b2dc9cf3a..1809b1846 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -16,13 +16,20 @@ King-Haskell specific features: Performance: -- [ ] Batching during replay and normal operation. +- [x] Batching during replay. +- [x] Batching during normal operation. Polish: +- [ ] Cleanup batching flow. - [ ] Logging for new IPC flow. - [ ] Logging for boot sequence. - [ ] Bring back progress bars. - [ ] Hook up error callbacks to IO Drivers. - [x] Think through how to shutdown the serf on exception. - [ ] Better exceptions in Serf error cases. + +Other bugs: + +- [ ] Handle ^c in connected terminals. +- [ ] Fix spinner in terminal driver. diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index a827f10b0..ace7d23ab 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -324,7 +324,7 @@ replayPartEvs top last = do case eSs of Just bail -> error (show bail) Nothing -> pure () - rio (Serf.snapshot serf) + io (Serf.snapshot serf) io $ threadDelay 500000 -- Copied from runOrExitImmediately pure () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 5c5e427aa..79584e900 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -26,7 +26,6 @@ import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Pier.Types import Control.Monad.Trans.Maybe -import Data.Conduit import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) @@ -38,7 +37,7 @@ import Urbit.Vere.Clay (clay) import Urbit.Vere.Http.Client (client) import Urbit.Vere.Http.Server (serv) import Urbit.Vere.Log (EventLog) -import Urbit.Vere.Serf (Serf) +import Urbit.Vere.Serf (Serf, ComputeRequest(..), SpinState, EvErr(..)) import qualified System.Entropy as Ent import qualified Urbit.King.API as King @@ -49,7 +48,6 @@ import qualified Urbit.Vere.Term as Term import qualified Urbit.Vere.Term.API as Term import qualified Urbit.Vere.Term.Demux as Term import qualified Urbit.Vere.Term.Render as Term --- ort qualified Data.Conduit.Combinators as CC -------------------------------------------------------------------------------- @@ -202,7 +200,7 @@ resumed vSlog replayUntil flags = do logTrace "Replaying events" Serf.execReplay serf log replayUntil logTrace "Taking snapshot" - Serf.snapshot serf + io (Serf.snapshot serf) logTrace "Shuting down the serf" pure (serf, log) @@ -299,7 +297,7 @@ pier (serf, log) vSlog mStart = do let stubErrCallback = \_ -> pure () let computeConfig = ComputeConfig - { ccOnWork = (,stubErrCallback) <$> readTQueue computeQ + { ccOnWork = (\x -> EvErr x stubErrCallback) <$> readTQueue computeQ , ccOnKill = takeTMVar shutdownM , ccOnSave = takeTMVar saveM , ccPutResult = writeTQueue persistQ @@ -421,43 +419,8 @@ logEffect ef = logDebug $ display $ "[EFFECT]\n" <> pretty ef GoodParse e -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow e FailParse n -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow n -data ComputeRequest - = CREvent (Ev, Serf.RunError -> IO ()) - | CRSave () - | CRShutdown () - -{- - TODO Pack and Peek --} -ipcSource - :: forall e - . HasLogFunc e - => STM (Ev, Serf.RunError -> IO ()) - -> STM () - -> STM () - -> ConduitT () Serf.RunInput (RIO e) () -ipcSource onEvent onSave onKill = loop - where - loop :: ConduitT () Serf.RunInput (RIO e) () - loop = do - lift $ logTrace "ipcSource waiting for work request." - let down = CRShutdown <$> onKill - let save = CRSave <$> onSave - let work = CREvent <$> onEvent - atomically (down <|> save <|> work) >>= \case - CRShutdown () -> do - pure () - CRSave () -> do - lift $ logTrace "ipcSource: requesting snapshot" - yield Serf.RunSnap - loop - CREvent (ev, cb) -> do - lift $ logTrace "ipcSource: requesting work" - yield (Serf.RunWork ev cb) - loop - data ComputeConfig = ComputeConfig - { ccOnWork :: STM (Ev, Serf.RunError -> IO ()) + { ccOnWork :: STM EvErr , ccOnKill :: STM () , ccOnSave :: STM () , ccPutResult :: (Fact, FX) -> STM () @@ -468,24 +431,21 @@ data ComputeConfig = ComputeConfig runCompute :: forall e . HasLogFunc e => Serf.Serf -> ComputeConfig -> RIO e () runCompute serf ComputeConfig {..} = do logTrace "runCompute" - runConduit - $ ipcSource ccOnWork ccOnSave ccOnKill - .| Serf.running serf (atomically . onStatusChange) - .| sendResults - where - sendResults :: ConduitT Serf.RunOutput Void (RIO e) () - sendResults = await >>= \case - Nothing -> pure () - Just (Serf.RunOutput e m w nounEv fx) -> do - lift $ logTrace "runCompute: Got play result" - atomically $ ccPutResult (Fact e m w nounEv, GoodParse <$> fx) -- TODO GoodParse - sendResults - onStatusChange :: Maybe Serf.RunInput -> STM () - onStatusChange = \case - Nothing -> ccHideSpinner - Just (Serf.RunWork ev _) -> ccShowSpinner (getSpinnerNameForEvent ev) - _ -> pure () + let onCR = asum [ CRKill <$> ccOnKill + , CRSave <$> ccOnSave + , CRWork <$> ccOnWork + ] + + let onOutput :: Serf.RunOutput -> STM () + onOutput (Serf.RunOutput e m w nounEv fx) = do + ccPutResult (Fact e m w nounEv, GoodParse <$> fx) -- TODO GoodParse + + let onSpin :: SpinState -> STM () + onSpin Nothing = ccHideSpinner + onSpin (Just ev) = ccShowSpinner (getSpinnerNameForEvent ev) + + io (Serf.swimming serf onCR onOutput onSpin) -- Persist Thread -------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 3596dc37b..1c34d819b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -44,8 +44,12 @@ bytesNouns = await >>= \case bytesNouns withSerf :: HasLogFunc e => Config -> RAcquire e Serf -withSerf config = mkRAcquire (io $ fmap fst $ start config) kill +withSerf config = mkRAcquire startup kill where + startup = do + (serf, st) <- io $ start config + logTrace (displayShow st) + pure serf kill serf = do void $ rio $ shutdown serf @@ -108,4 +112,4 @@ execReplay serf log last = do runConduit $ Log.streamEvents log (lastEventInSnap + 1) .| CC.take (fromIntegral numEvs) .| bytesNouns - .| replay serf + .| replay 10 serf diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 1f89c59ca..58823d997 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -47,6 +47,10 @@ module Urbit.Vere.Serf.IPC , bootSeq , replay , running + , swimming + , EvErr(..) + , ComputeRequest(..) + , SpinState ) where @@ -58,6 +62,8 @@ import System.Process import Urbit.Arvo import Urbit.Vere.Pier.Types hiding (Work) +import Control.Monad.STM (retry) +import Data.Sequence (Seq((:<|), (:|>))) import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (castPtr) import Foreign.Storable (peek, poke) @@ -179,13 +185,21 @@ data RunError | RunSwap EventId Mug Wen Noun [Ef] data RunInput - = RunSnap - | RunPack + = RunSnap (EventId -> STM ()) + | RunPack (EventId -> STM ()) | RunPeek Wen Gang Path (Maybe (Term, Noun) -> IO ()) | RunWork Ev (RunError -> IO ()) data RunOutput = RunOutput EventId Mug Wen Noun [Ef] +data EvErr = EvErr Ev (RunError -> IO ()) + +data ComputeRequest + = CRWork EvErr + | CRSave () + | CRKill () + +type SpinState = Maybe Ev -- Exceptions ------------------------------------------------------------------ @@ -382,10 +396,10 @@ withSerfLock tryGen s f = do Left exn -> putMVar (serfLock s) (Left exn) >> throwIO exn Right ss -> pure ss -snapshot :: HasLogFunc e => Serf -> RIO e () +snapshot :: Serf -> IO () snapshot serf = withSerfLock try serf \ss -> do - io (sendSnapshotRequest serf (ssLast ss)) + sendSnapshotRequest serf (ssLast ss) pure (ss, ()) shutdown :: HasLogFunc e => Serf -> RIO e () @@ -422,32 +436,50 @@ bootSeq serf@Serf{..} seq = do {- TODO Take advantage of IPC support for batching. - TODO Maybe take snapshots -} replay :: forall m . (MonadUnliftIO m, MonadIO m) - => Serf + => Int + -> Serf -> ConduitT Noun Void m (Maybe PlayBail) -replay serf = do +replay batchSize serf = do withSerfLock tryC serf \ss -> do (r, ss') <- loop ss pure (ss', r) where loop :: SerfState -> ConduitT Noun Void m (Maybe PlayBail, SerfState) - loop (SerfState lastEve lastMug) = await >>= \case - Nothing -> pure (Nothing, SerfState lastEve lastMug) - Just ev -> do - let newEve = lastEve + 1 - io $ sendWrit serf (WPlay newEve [ev]) - io (recvPlay serf) >>= \case - PBail bail -> pure (Just bail, SerfState lastEve lastMug) - PDone newMug -> loop (SerfState newEve newMug) + loop ss@(SerfState lastEve lastMug) = do + awaitBatch batchSize >>= \case + [] -> pure (Nothing, SerfState lastEve lastMug) + evs -> do + let nexEve = lastEve + 1 + let newEve = lastEve + fromIntegral (length evs) + print (ss, nexEve, newEve, length evs) + io $ sendWrit serf (WPlay nexEve evs) + io (recvPlay serf) >>= \case + PBail bail -> pure (Just bail, SerfState lastEve lastMug) + PDone newMug -> loop (SerfState newEve newMug) + +{- + TODO Use a mutable vector instead of reversing a list. +-} +awaitBatch :: Monad m => Int -> ConduitT i o m [i] +awaitBatch = go [] + where + go acc 0 = pure (reverse acc) + go acc n = await >>= \case + Nothing -> pure (reverse acc) + Just x -> go (x:acc) (n-1) {- TODO *we* should probably kill the serf on exception? TODO callbacks on snapshot and compaction? TODO Take advantage of async IPC to fill pipe with more than one thing. + + TODO Think this through: the caller *really* should not request + snapshots until all of the events leading up to a certain state + have been commited to disk in the event log. -} running :: forall m @@ -468,10 +500,12 @@ running serf notice = do nex & \case Nothing -> do pure $ SerfState eve mug - Just RunSnap -> do + Just (RunSnap blk) -> do + atomically (blk eve) io (sendSnapshotRequest serf eve) loop mug eve - Just RunPack -> do + Just (RunPack blk) -> do + atomically (blk eve) io (sendCompactRequest serf eve) loop mug eve Just (RunPeek wen gang pax act) -> do @@ -491,3 +525,137 @@ running serf notice = do WBail goofs -> do io $ err (RunBail goofs) loop mug eve + +workQueueSize :: Int +workQueueSize = 10 + +{- + TODO don't take snapshot until event log has processed current event. +-} +swimming + :: Serf + -> STM ComputeRequest + -> (RunOutput -> STM ()) + -> (SpinState -> STM ()) + -> IO () +swimming serf onInput sendOn spin = loop + where + loop :: IO () + loop = atomically onInput >>= \case + CRWork workErr -> doWork workErr + CRSave () -> doSnap + CRKill () -> pure () + + doSnap = snapshot serf >> loop + + doWork firstWorkErr = do + -- TODO Rethink this TBMQueue. Just use (TMVar (Maybe EvErr))? + q :: TBMQueue EvErr <- newTBMQueueIO 1 + atomically (writeTBMQueue q firstWorkErr) + + after <- withSerfLock try serf \ss -> do + + vState <- newIORef ss + + let cb :: Wen -> EvErr -> Work -> IO () + cb wen (EvErr evn err) = \case + WDone eid hash fx -> do + atomically $ sendOn (RunOutput eid hash wen (toNoun evn) fx) + writeIORef vState (SerfState eid hash) + WSwap eid hash (wen, noun) fx -> do + io $ err (RunSwap eid hash wen noun fx) + atomically $ sendOn (RunOutput eid hash wen noun fx) + writeIORef vState (SerfState eid hash) + WBail goofs -> do + io $ err (RunBail goofs) + + tWork <- async (processWork serf q cb spin) + + let workLoop :: IO (IO ()) + workLoop = atomically onInput >>= \case + CRWork workErr -> do + atomically (writeTBMQueue q workErr) + workLoop + CRSave () -> do + atomically (closeTBMQueue q) + wait tWork + pure doSnap + CRKill () -> do + pure (pure ()) + + after <- workLoop + + (, after) <$> readIORef vState + + after + +-- TODO Handle scry and peek. +processWork + :: Serf + -> TBMQueue EvErr + -> (Wen -> EvErr -> Work -> IO ()) + -> (SpinState -> STM ()) + -> IO () +processWork serf q onResp spin = do + vDone <- newTVarIO False + vWork <- newTVarIO empty + tRecv <- async (recvLoop serf vDone vWork) + + let pullFromQueue :: STM (Maybe EvErr) + pullFromQueue = do + inFlight <- length <$> readTVar vWork + if inFlight >= workQueueSize + then retry + else readTBMQueue q + + let loop = do + atomically pullFromQueue >>= \case + Nothing -> do + atomically (writeTVar vDone True) + wait tRecv + Just evErr@(EvErr ev _) -> do + now <- Time.now + + len <- length <$> atomically (readTVar vWork) + when (len == 0) $ do + print "SPIN" + atomically (spin (Just ev)) + + sendWrit serf (WWork now ev) + let callback work = do + len <- length <$> atomically (readTVar vWork) + print ("ASDFASDF workqueue size", len) + print "DO NOT SPIN" + atomically (spin Nothing) + atomically (readTVar vWork) >>= \case + (ev, _) :<| _ -> print "SPIN" >> atomically (spin (Just ev)) + _ -> pure () + onResp now evErr work + + atomically $ modifyTVar' vWork (:|> (ev, callback)) + + loop + + loop + +recvLoop :: Serf -> TVar Bool -> TVar (Seq (Ev, Work -> IO ())) -> IO () +recvLoop serf vDone vWork = loop + where + loop = atomically getCallback >>= \case + Nothing -> pure () + Just cb -> do + work <- recvWork serf + cb work + loop + + getCallback :: STM (Maybe (Work -> IO ())) + getCallback = do + pending <- readTVar vWork + done <- readTVar vDone + case (done, pending) of + (False, Empty) -> retry + (True, Empty) -> pure Nothing + (_, (_, x) :<| xs) -> do + writeTVar vWork xs + pure (Just x) + (_, _) -> error "impossible" From ba440c8e3ab641b020d34c3bfc85ea2001c49787 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Fri, 29 May 2020 19:19:56 +0000 Subject: [PATCH 102/257] king: Make sure spinner callbacks are handled correctly from serf. --- pkg/hs/TODO.md | 10 ++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 10 +++------- 2 files changed, 9 insertions(+), 11 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index 1809b1846..397c6dbac 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -3,7 +3,7 @@ Stubbed out: - [x] Handle replacement events (stubbed out now b/c interface can't handle unparsed nouns) - [x] Handle IPC errors by killing serf process. -- [ ] PlayBail should be an exception. +- [ ] PlayBail should be an exception for now. - [ ] Write haddock docs for `Urbit.Vere.Serf.IPC`. - [x] Unstub slog/stder/dead callbacks on serf config. - [ ] GoodParse hack in newRunCompute. @@ -29,7 +29,9 @@ Polish: - [x] Think through how to shutdown the serf on exception. - [ ] Better exceptions in Serf error cases. -Other bugs: +Unrelated bugs: -- [ ] Handle ^c in connected terminals. -- [ ] Fix spinner in terminal driver. +- [ ] Handle ^C in connected terminals. +- [ ] terminal driver seems to have a race condition when spinner changed + too quickly. +- [ ] King should shutdown promptly on ^C. Always takes 2s in practice./ diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 58823d997..5adb9e65f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -618,18 +618,14 @@ processWork serf q onResp spin = do len <- length <$> atomically (readTVar vWork) when (len == 0) $ do - print "SPIN" - atomically (spin (Just ev)) + atomically $ spin (Just ev) sendWrit serf (WWork now ev) let callback work = do len <- length <$> atomically (readTVar vWork) - print ("ASDFASDF workqueue size", len) - print "DO NOT SPIN" - atomically (spin Nothing) atomically (readTVar vWork) >>= \case - (ev, _) :<| _ -> print "SPIN" >> atomically (spin (Just ev)) - _ -> pure () + (ev, _) :<| _ -> atomically $ spin (Just ev) + _ -> atomically $ spin Nothing onResp now evErr work atomically $ modifyTVar' vWork (:|> (ev, callback)) From 7ece09c0d1bac24f035ad86973a26c4575da55a7 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Fri, 29 May 2020 20:10:17 +0000 Subject: [PATCH 103/257] king: Cleanup IPC batching in `swimming` flow. --- pkg/hs/TODO.md | 3 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 169 +++++++++---------- 2 files changed, 78 insertions(+), 94 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index 397c6dbac..c9224f950 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -3,6 +3,7 @@ Stubbed out: - [x] Handle replacement events (stubbed out now b/c interface can't handle unparsed nouns) - [x] Handle IPC errors by killing serf process. +- [ ] Handle `peek` and `pack` in `swimming` flow. - [ ] PlayBail should be an exception for now. - [ ] Write haddock docs for `Urbit.Vere.Serf.IPC`. - [x] Unstub slog/stder/dead callbacks on serf config. @@ -21,7 +22,7 @@ Performance: Polish: -- [ ] Cleanup batching flow. +- [x] Cleanup batching flow. - [ ] Logging for new IPC flow. - [ ] Logging for boot sequence. - [ ] Bring back progress bars. diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 5adb9e65f..3f27ed969 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -455,7 +455,6 @@ replay batchSize serf = do evs -> do let nexEve = lastEve + 1 let newEve = lastEve + fromIntegral (length evs) - print (ss, nexEve, newEve, length evs) io $ sendWrit serf (WPlay nexEve evs) io (recvPlay serf) >>= \case PBail bail -> pure (Just bail, SerfState lastEve lastMug) @@ -538,56 +537,48 @@ swimming -> (RunOutput -> STM ()) -> (SpinState -> STM ()) -> IO () -swimming serf onInput sendOn spin = loop +swimming serf onInput sendOn spin = topLoop where - loop :: IO () - loop = atomically onInput >>= \case + topLoop :: IO () + topLoop = atomically onInput >>= \case CRWork workErr -> doWork workErr CRSave () -> doSnap CRKill () -> pure () - doSnap = snapshot serf >> loop + doSnap :: IO () + doSnap = snapshot serf >> topLoop + doWork :: EvErr -> IO () doWork firstWorkErr = do - -- TODO Rethink this TBMQueue. Just use (TMVar (Maybe EvErr))? - q :: TBMQueue EvErr <- newTBMQueueIO 1 - atomically (writeTBMQueue q firstWorkErr) + que <- newTBMQueueIO 1 + () <- atomically (writeTBMQueue que firstWorkErr) + tWork <- async (processWork serf que onWorkResp spin) + nexSt <- workLoop que + wait tWork + nexSt - after <- withSerfLock try serf \ss -> do + workLoop :: TBMQueue EvErr -> IO (IO ()) + workLoop que = atomically onInput >>= \case + CRKill () -> atomically (closeTBMQueue que) >> pure (pure ()) + CRSave () -> atomically (closeTBMQueue que) >> pure doSnap + CRWork workErr -> atomically (writeTBMQueue que workErr) >> workLoop que - vState <- newIORef ss + onWorkResp :: Wen -> EvErr -> Work -> IO () + onWorkResp wen (EvErr evn err) = \case + WDone eid hash fx -> do + atomically $ sendOn (RunOutput eid hash wen (toNoun evn) fx) + WSwap eid hash (wen, noun) fx -> do + io $ err (RunSwap eid hash wen noun fx) + atomically $ sendOn (RunOutput eid hash wen noun fx) + WBail goofs -> do + io $ err (RunBail goofs) - let cb :: Wen -> EvErr -> Work -> IO () - cb wen (EvErr evn err) = \case - WDone eid hash fx -> do - atomically $ sendOn (RunOutput eid hash wen (toNoun evn) fx) - writeIORef vState (SerfState eid hash) - WSwap eid hash (wen, noun) fx -> do - io $ err (RunSwap eid hash wen noun fx) - atomically $ sendOn (RunOutput eid hash wen noun fx) - writeIORef vState (SerfState eid hash) - WBail goofs -> do - io $ err (RunBail goofs) - - tWork <- async (processWork serf q cb spin) - - let workLoop :: IO (IO ()) - workLoop = atomically onInput >>= \case - CRWork workErr -> do - atomically (writeTBMQueue q workErr) - workLoop - CRSave () -> do - atomically (closeTBMQueue q) - wait tWork - pure doSnap - CRKill () -> do - pure (pure ()) - - after <- workLoop - - (, after) <$> readIORef vState - - after +pullFromQueueBounded :: TVar (Seq a) -> TBMQueue b -> STM (Maybe b) +pullFromQueueBounded vInFlight queue = do + inFlight <- length <$> readTVar vInFlight + if inFlight >= workQueueSize + then retry + else readTBMQueue queue -- TODO Handle scry and peek. processWork @@ -597,61 +588,53 @@ processWork -> (SpinState -> STM ()) -> IO () processWork serf q onResp spin = do - vDone <- newTVarIO False - vWork <- newTVarIO empty - tRecv <- async (recvLoop serf vDone vWork) + vDoneFlag <- newTVarIO False + vInFlightQueue <- newTVarIO empty + recvThread <- async (recvLoop serf vDoneFlag vInFlightQueue) + loop vInFlightQueue vDoneFlag + wait recvThread + where + loop :: TVar (Seq (Ev, Work -> IO ())) -> TVar Bool -> IO () + loop vInFlight vDone = do + atomically (pullFromQueueBounded vInFlight q) >>= \case + Nothing -> do + atomically (writeTVar vDone True) + Just evErr@(EvErr ev _) -> do + now <- Time.now + let cb = onRecv (currentEv vInFlight) now evErr + atomically $ do + modifyTVar' vInFlight (:|> (ev, cb)) + currentEv vInFlight >>= spin + sendWrit serf (WWork now ev) + loop vInFlight vDone - let pullFromQueue :: STM (Maybe EvErr) - pullFromQueue = do - inFlight <- length <$> readTVar vWork - if inFlight >= workQueueSize - then retry - else readTBMQueue q + onRecv :: STM (Maybe Ev) -> Wen -> EvErr -> Work -> IO () + onRecv getCurrentEv now evErr work = do + atomically (getCurrentEv >>= spin) + onResp now evErr work - let loop = do - atomically pullFromQueue >>= \case - Nothing -> do - atomically (writeTVar vDone True) - wait tRecv - Just evErr@(EvErr ev _) -> do - now <- Time.now - - len <- length <$> atomically (readTVar vWork) - when (len == 0) $ do - atomically $ spin (Just ev) - - sendWrit serf (WWork now ev) - let callback work = do - len <- length <$> atomically (readTVar vWork) - atomically (readTVar vWork) >>= \case - (ev, _) :<| _ -> atomically $ spin (Just ev) - _ -> atomically $ spin Nothing - onResp now evErr work - - atomically $ modifyTVar' vWork (:|> (ev, callback)) - - loop - - loop + currentEv :: TVar (Seq (Ev, a)) -> STM (Maybe Ev) + currentEv vInFlight = readTVar vInFlight >>= \case + (ev, _) :<| _ -> pure (Just ev) + _ -> pure Nothing recvLoop :: Serf -> TVar Bool -> TVar (Seq (Ev, Work -> IO ())) -> IO () -recvLoop serf vDone vWork = loop +recvLoop serf vDone vWork = do + withSerfLock try serf \SerfState{..} -> do + loop ssLast ssHash where - loop = atomically getCallback >>= \case - Nothing -> pure () - Just cb -> do - work <- recvWork serf - cb work - loop + loop eve mug = do + atomically takeCallback >>= \case + Nothing -> pure (SerfState eve mug, ()) + Just cb -> recvWork serf >>= \case + work@(WDone eid hash _) -> cb work >> loop eid hash + work@(WSwap eid hash _ _) -> cb work >> loop eid hash + work@(WBail _) -> cb work >> loop eve mug - getCallback :: STM (Maybe (Work -> IO ())) - getCallback = do - pending <- readTVar vWork - done <- readTVar vDone - case (done, pending) of - (False, Empty) -> retry - (True, Empty) -> pure Nothing - (_, (_, x) :<| xs) -> do - writeTVar vWork xs - pure (Just x) - (_, _) -> error "impossible" + takeCallback :: STM (Maybe (Work -> IO ())) + takeCallback = do + ((,) <$> readTVar vDone <*> readTVar vWork) >>= \case + (False, Empty ) -> retry + (True , Empty ) -> pure Nothing + (_ , (_, x) :<| xs) -> writeTVar vWork xs $> Just x + (_ , _ ) -> error "impossible" From 3c0db10703711184d97f4ce226b995d230a15fbe Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Fri, 29 May 2020 15:57:35 -0700 Subject: [PATCH 104/257] king: Get tests to compile. --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 2 +- pkg/hs/urbit-king/test/AmesTests.hs | 58 ++++++++++++++++-------- pkg/hs/urbit-king/test/BehnTests.hs | 13 +++--- pkg/hs/urbit-king/test/LogTests.hs | 18 ++++---- 4 files changed, 55 insertions(+), 36 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 4dd7f47a8..6ab196bbe 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -81,7 +81,7 @@ netMode isFake = do (_ , _ , NMNormal ) -> Real (_ , _ , NMLocalhost) -> Localhost -udpPort :: Bool -> Ship -> HasNetworkConfig e => RIO e PortNumber +udpPort :: HasNetworkConfig e => Bool -> Ship -> RIO e PortNumber udpPort isFake who = do mode <- netMode isFake mPort <- view (networkConfigL . ncAmesPort) diff --git a/pkg/hs/urbit-king/test/AmesTests.hs b/pkg/hs/urbit-king/test/AmesTests.hs index a68bb9a0b..39d217323 100644 --- a/pkg/hs/urbit-king/test/AmesTests.hs +++ b/pkg/hs/urbit-king/test/AmesTests.hs @@ -20,10 +20,15 @@ import Control.Concurrent (runInBoundThread) import Data.LargeWord (LargeKey(..)) import GHC.Natural (Natural) import Network.Socket (tupleToHostAddress) +import Urbit.King.App (HasKingId(..)) import qualified Urbit.Vere.Log as Log +-------------------------------------------------------------------------------- + +type HasAmes e = (HasLogFunc e, HasNetworkConfig e, HasKingId e) + -- Utils ----------------------------------------------------------------------- pid :: KingId @@ -38,6 +43,7 @@ sendEf g w bs = NewtEfSend (0, ()) (EachYes g) bs data NetworkTestApp = NetworkTestApp { _ntaLogFunc :: !LogFunc , _ntaNetworkConfig :: !NetworkConfig + , _ntaKingId :: !Word16 } makeLenses ''NetworkTestApp @@ -48,24 +54,34 @@ instance HasLogFunc NetworkTestApp where instance HasNetworkConfig NetworkTestApp where networkConfigL = ntaNetworkConfig +instance HasKingId NetworkTestApp where + kingIdL = ntaKingId + runNetworkApp :: RIO NetworkTestApp a -> IO a runNetworkApp = runRIO NetworkTestApp - { _ntaLogFunc = mkLogFunc l - , _ntaNetworkConfig = NetworkConfig NMNormal Nothing Nothing Nothing Nothing + { _ntaLogFunc = mkLogFunc (\_ _ _ _ -> pure ()) + , _ntaKingId = 34 + , _ntaNetworkConfig = NetworkConfig { _ncNetMode = NMNormal + , _ncAmesPort = Nothing + , _ncNoAmes = False + , _ncNoHttp = False + , _ncNoHttps = False + , _ncHttpPort = Nothing + , _ncHttpsPort = Nothing + , _ncLocalPort = Nothing + } } - where - l _ _ _ _ = pure () -runGala :: forall e. (HasLogFunc e, HasNetworkConfig e) - => Word8 -> RAcquire e (TQueue Ev, EffCb e NewtEf) -runGala point = - do - q <- newTQueueIO +runGala + :: forall e . HasAmes e => Word8 -> RAcquire e (TQueue Ev, EffCb e NewtEf) +runGala point = do + env <- ask + que <- newTQueueIO let (_, runAmes) = - ames pid (fromIntegral point) True (writeTQueue q) noStderr - cb ← runAmes + ames env (fromIntegral point) True (writeTQueue que) noStderr + cb <- runAmes rio $ cb turfEf - pure (q, cb) + pure (que, cb) where noStderr _ = pure () @@ -91,24 +107,26 @@ sendThread cb (to, val) = void $ mkRAcquire start cancel zodSelfMsg :: Property zodSelfMsg = forAll arbitrary (ioProperty . runNetworkApp . runTest) - where - runTest :: (HasLogFunc e, HasNetworkConfig e) => Bytes -> RIO e Bool - runTest val = runRAcquire $ do - (zodQ, zod) <- runGala 0 - () <- sendThread zod (0, val) - liftIO (waitForPacket zodQ val) + where + runTest + :: (HasLogFunc e, HasNetworkConfig e, HasKingId e) => Bytes -> RIO e Bool + runTest val = runRAcquire $ do + env <- ask + (zodQ, zod) <- runGala 0 + () <- sendThread zod (0, val) + liftIO (waitForPacket zodQ val) twoTalk :: Property twoTalk = forAll arbitrary (ioProperty . runNetworkApp . runTest) where - runTest :: (HasLogFunc e, HasNetworkConfig e) + runTest :: (HasLogFunc e, HasNetworkConfig e, HasKingId e) => (Word8, Word8, Bytes) -> RIO e Bool runTest (aliceShip, bobShip, val) = if aliceShip == bobShip then pure True else go aliceShip bobShip val - go :: (HasLogFunc e, HasNetworkConfig e) + go :: (HasLogFunc e, HasNetworkConfig e, HasKingId e) => Word8 -> Word8 -> Bytes -> RIO e Bool go aliceShip bobShip val = runRAcquire $ do (aliceQ, alice) <- runGala aliceShip diff --git a/pkg/hs/urbit-king/test/BehnTests.hs b/pkg/hs/urbit-king/test/BehnTests.hs index 11b48ce48..cda8a3fb8 100644 --- a/pkg/hs/urbit-king/test/BehnTests.hs +++ b/pkg/hs/urbit-king/test/BehnTests.hs @@ -20,7 +20,7 @@ import Control.Concurrent (runInBoundThread, threadDelay) import Data.LargeWord (LargeKey(..)) import GHC.Natural (Natural) import Network.Socket (tupleToHostAddress) -import Urbit.King.App (runApp) +import Urbit.King.App (runKingEnvStderr, HasKingId(..)) import qualified Urbit.Time as Time import qualified Urbit.Vere.Log as Log @@ -28,17 +28,16 @@ import qualified Urbit.Vere.Log as Log -------------------------------------------------------------------------------- -king :: KingId -king = KingId 0 - -- TODO Timers always fire immediatly. Something is wrong! timerFires :: Property -timerFires = forAll arbitrary (ioProperty . runApp . runTest) +timerFires = forAll arbitrary (ioProperty . runKingEnvStderr . runTest) where - runTest :: () -> RIO e Bool + runTest :: HasKingId e => () -> RIO e Bool runTest () = do + envr <- ask + king <- fromIntegral <$> view kingIdL q <- newTQueueIO - rwith (liftAcquire $ snd $ behn king (writeTQueue q)) $ \cb -> do + rwith (liftAcquire $ snd $ behn envr (writeTQueue q)) $ \cb -> do cb (BehnEfDoze (king, ()) (Just (2^20))) t <- atomically $ readTQueue q pure True diff --git a/pkg/hs/urbit-king/test/LogTests.hs b/pkg/hs/urbit-king/test/LogTests.hs index 3e6509288..fe30e49b9 100644 --- a/pkg/hs/urbit-king/test/LogTests.hs +++ b/pkg/hs/urbit-king/test/LogTests.hs @@ -14,7 +14,7 @@ import Urbit.Vere.Pier.Types import Control.Concurrent (runInBoundThread, threadDelay) import Data.LargeWord (LargeKey(..)) import GHC.Natural (Natural) -import Urbit.King.App (App, runApp) +import Urbit.King.App (KingEnv, runKingEnvStderr) import qualified Urbit.Vere.Log as Log @@ -42,13 +42,13 @@ data Db = Db LogIdentity [ByteString] (Map Word64 ByteString) addEvents :: Db -> [ByteString] -> Db addEvents (Db id evs efs) new = Db id (evs <> new) efs -readDb :: EventLog -> RIO App Db +readDb :: EventLog -> RIO KingEnv Db readDb log = do events <- runConduit (streamEvents log 1 .| consume) effects <- runConduit (streamEffectsRows log 0 .| consume) pure $ Db (Log.identity log) events (mapFromList effects) -withDb :: FilePath -> Db -> (EventLog -> RIO App a) -> RIO App a +withDb :: FilePath -> Db -> (EventLog -> RIO KingEnv a) -> RIO KingEnv a withDb dir (Db dId dEvs dFx) act = do rwith (Log.new dir dId) $ \log -> do Log.appendEvents log (fromList dEvs) @@ -58,10 +58,12 @@ withDb dir (Db dId dEvs dFx) act = do -------------------------------------------------------------------------------- +runApp = runKingEnvStderr + tryReadIdentity :: Property tryReadIdentity = forAll arbitrary (ioProperty . runApp . runTest) where - runTest :: LogIdentity -> RIO App Bool + runTest :: LogIdentity -> RIO KingEnv Bool runTest ident = do env <- ask io $ runInBoundThread $ runRIO env $ @@ -77,7 +79,7 @@ tryReadIdentity = forAll arbitrary (ioProperty . runApp . runTest) tryReadDatabase :: Property tryReadDatabase = forAll arbitrary (ioProperty . runApp . runTest) where - runTest :: Db -> RIO App Bool + runTest :: Db -> RIO KingEnv Bool runTest db = do env <- ask io $ runInBoundThread $ runRIO env $ @@ -89,7 +91,7 @@ tryReadDatabase = forAll arbitrary (ioProperty . runApp . runTest) tryReadDatabaseFuzz :: Property tryReadDatabaseFuzz = forAll arbitrary (ioProperty . runApp . runTest) where - runTest :: Db -> RIO App Bool + runTest :: Db -> RIO KingEnv Bool runTest db = do env <- ask io $ runInBoundThread $ runRIO env $ @@ -106,7 +108,7 @@ tryReadDatabaseFuzz = forAll arbitrary (ioProperty . runApp . runTest) tryAppend :: Property tryAppend = forAll arbitrary (ioProperty . runApp . runTest) where - runTest :: ([ByteString], Db) -> RIO App Bool + runTest :: ([ByteString], Db) -> RIO KingEnv Bool runTest (extra, db) = do env <- ask io $ runInBoundThread $ runRIO env $ @@ -123,7 +125,7 @@ tryAppend = forAll arbitrary (ioProperty . runApp . runTest) tryAppendHuge :: Property tryAppendHuge = forAll arbitrary (ioProperty . runApp . runTest) where - runTest :: ([ByteString], Db) -> RIO App Bool + runTest :: ([ByteString], Db) -> RIO KingEnv Bool runTest (extra, db) = do env <- ask io $ runInBoundThread $ runRIO env $ do From fd72424b1266caeb7adb35517d68eb578abc6aa5 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Fri, 29 May 2020 17:23:10 -0700 Subject: [PATCH 105/257] Fix `make test` + no logging during king-haskell tests. --- pkg/hs/urbit-king/test/BehnTests.hs | 4 ++-- pkg/hs/urbit-king/test/LogTests.hs | 5 +++-- sh/test | 4 +--- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/pkg/hs/urbit-king/test/BehnTests.hs b/pkg/hs/urbit-king/test/BehnTests.hs index cda8a3fb8..40d5c2178 100644 --- a/pkg/hs/urbit-king/test/BehnTests.hs +++ b/pkg/hs/urbit-king/test/BehnTests.hs @@ -20,7 +20,7 @@ import Control.Concurrent (runInBoundThread, threadDelay) import Data.LargeWord (LargeKey(..)) import GHC.Natural (Natural) import Network.Socket (tupleToHostAddress) -import Urbit.King.App (runKingEnvStderr, HasKingId(..)) +import Urbit.King.App (runKingEnvNoLog, HasKingId(..)) import qualified Urbit.Time as Time import qualified Urbit.Vere.Log as Log @@ -30,7 +30,7 @@ import qualified Urbit.Vere.Log as Log -- TODO Timers always fire immediatly. Something is wrong! timerFires :: Property -timerFires = forAll arbitrary (ioProperty . runKingEnvStderr . runTest) +timerFires = forAll arbitrary (ioProperty . runKingEnvNoLog . runTest) where runTest :: HasKingId e => () -> RIO e Bool runTest () = do diff --git a/pkg/hs/urbit-king/test/LogTests.hs b/pkg/hs/urbit-king/test/LogTests.hs index fe30e49b9..47508016f 100644 --- a/pkg/hs/urbit-king/test/LogTests.hs +++ b/pkg/hs/urbit-king/test/LogTests.hs @@ -14,7 +14,7 @@ import Urbit.Vere.Pier.Types import Control.Concurrent (runInBoundThread, threadDelay) import Data.LargeWord (LargeKey(..)) import GHC.Natural (Natural) -import Urbit.King.App (KingEnv, runKingEnvStderr) +import Urbit.King.App (KingEnv, runKingEnvNoLog) import qualified Urbit.Vere.Log as Log @@ -58,7 +58,8 @@ withDb dir (Db dId dEvs dFx) act = do -------------------------------------------------------------------------------- -runApp = runKingEnvStderr +runApp :: RIO KingEnv a -> IO a +runApp = runKingEnvNoLog tryReadIdentity :: Property tryReadIdentity = forAll arbitrary (ioProperty . runApp . runTest) diff --git a/sh/test b/sh/test index 7bd6ba6d8..39c64fa6f 100755 --- a/sh/test +++ b/sh/test @@ -2,9 +2,7 @@ set -e -export STACK_YAML="`pwd`/pkg/hs/stack.yaml" - -stack test urbit-king --fast +(cd pkg/hs; stack test urbit-king --fast) pkg=$(nix-build nix/ops -A test --no-out-link "$@") From 2f852c2e9f550bf993cf17b6aa1a8ce4e6a4943d Mon Sep 17 00:00:00 2001 From: ~siprel Date: Sun, 31 May 2020 22:04:56 +0000 Subject: [PATCH 106/257] king: Remove `GoodParse` hack in `newRunCompute`. --- pkg/hs/TODO.md | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 8 +++----- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 8 ++++---- 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index c9224f950..6056dd69e 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -7,7 +7,7 @@ Stubbed out: - [ ] PlayBail should be an exception for now. - [ ] Write haddock docs for `Urbit.Vere.Serf.IPC`. - [x] Unstub slog/stder/dead callbacks on serf config. -- [ ] GoodParse hack in newRunCompute. +- [x] Remove GoodParse hack in newRunCompute. - [ ] Bring back tank printing. - [ ] Bring back code for handling serf stderr messages. diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 88b5b55c5..69040c89a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -28,9 +28,7 @@ import Urbit.Vere.Pier.Types import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) -import Urbit.King.App (HasPierEnv(..)) --- ort Urbit.Time (Wen) -import Urbit.King.App (HasKingEnv, HasPierEnv, PierEnv) +import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -38,7 +36,7 @@ import Urbit.Vere.Eyre (eyre) import Urbit.Vere.Eyre.Multi (MultiEyreApi) import Urbit.Vere.Http.Client (client) import Urbit.Vere.Log (EventLog) -import Urbit.Vere.Serf (Serf, ComputeRequest(..), SpinState, EvErr(..)) +import Urbit.Vere.Serf (ComputeRequest(..), EvErr(..), Serf, SpinState) import qualified System.Entropy as Ent import qualified Urbit.King.API as King @@ -446,7 +444,7 @@ runCompute serf ComputeConfig {..} = do let onOutput :: Serf.RunOutput -> STM () onOutput (Serf.RunOutput e m w nounEv fx) = do - ccPutResult (Fact e m w nounEv, GoodParse <$> fx) -- TODO GoodParse + ccPutResult (Fact e m w nounEv, fx) let onSpin :: SpinState -> STM () onSpin Nothing = ccHideSpinner diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 3f27ed969..72b1484cb 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -97,8 +97,8 @@ data Play deriving (Show) data Work - = WDone EventId Mug [Ef] - | WSwap EventId Mug (Wen, Noun) [Ef] + = WDone EventId Mug FX + | WSwap EventId Mug (Wen, Noun) FX | WBail [Goof] deriving (Show) @@ -182,7 +182,7 @@ data Config = Config data RunError = RunBail [Goof] - | RunSwap EventId Mug Wen Noun [Ef] + | RunSwap EventId Mug Wen Noun FX data RunInput = RunSnap (EventId -> STM ()) @@ -190,7 +190,7 @@ data RunInput | RunPeek Wen Gang Path (Maybe (Term, Noun) -> IO ()) | RunWork Ev (RunError -> IO ()) -data RunOutput = RunOutput EventId Mug Wen Noun [Ef] +data RunOutput = RunOutput EventId Mug Wen Noun FX data EvErr = EvErr Ev (RunError -> IO ()) From a4f5ea2e2f46fb668d451ffdf8c29ab5d3ac5647 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Sun, 31 May 2020 22:37:27 +0000 Subject: [PATCH 107/257] king: Urbit.Vere.King.IPC cleanup + handle scry/pack. --- pkg/hs/TODO.md | 6 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 8 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 225 ++++++++++--------- 3 files changed, 121 insertions(+), 118 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index 6056dd69e..bb906a7b6 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -3,13 +3,13 @@ Stubbed out: - [x] Handle replacement events (stubbed out now b/c interface can't handle unparsed nouns) - [x] Handle IPC errors by killing serf process. -- [ ] Handle `peek` and `pack` in `swimming` flow. +- [x] Handle `peek` and `pack` in `swimming` flow. - [ ] PlayBail should be an exception for now. -- [ ] Write haddock docs for `Urbit.Vere.Serf.IPC`. +- [ ] Documentation for `Urbit.Vere.Serf.IPC`. - [x] Unstub slog/stder/dead callbacks on serf config. - [x] Remove GoodParse hack in newRunCompute. - [ ] Bring back tank printing. -- [ ] Bring back code for handling serf stderr messages. +- [x] Handle serf stderr message correctly. King-Haskell specific features: diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 69040c89a..fd3a3737c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -442,15 +442,13 @@ runCompute serf ComputeConfig {..} = do , CRWork <$> ccOnWork ] - let onOutput :: Serf.RunOutput -> STM () - onOutput (Serf.RunOutput e m w nounEv fx) = do - ccPutResult (Fact e m w nounEv, fx) - let onSpin :: SpinState -> STM () onSpin Nothing = ccHideSpinner onSpin (Just ev) = ccShowSpinner (getSpinnerNameForEvent ev) - io (Serf.swimming serf onCR onOutput onSpin) + let maxBatchSize = 10 + + io (Serf.running serf maxBatchSize onCR ccPutResult onSpin) -- Persist Thread -------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 72b1484cb..a9d955706 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -37,9 +37,7 @@ module Urbit.Vere.Serf.IPC , Config(..) , PlayBail(..) , Flag(..) - , RunError(..) - , RunInput(..) - , RunOutput(..) + , WorkError(..) , start , serfLastEventBlocking , shutdown @@ -47,7 +45,6 @@ module Urbit.Vere.Serf.IPC , bootSeq , replay , running - , swimming , EvErr(..) , ComputeRequest(..) , SpinState @@ -180,31 +177,26 @@ data Config = Config , scDead :: IO () -- What to do when the serf process goes down? } -data RunError +data WorkError = RunBail [Goof] | RunSwap EventId Mug Wen Noun FX -data RunInput - = RunSnap (EventId -> STM ()) - | RunPack (EventId -> STM ()) - | RunPeek Wen Gang Path (Maybe (Term, Noun) -> IO ()) - | RunWork Ev (RunError -> IO ()) - -data RunOutput = RunOutput EventId Mug Wen Noun FX - -data EvErr = EvErr Ev (RunError -> IO ()) +data EvErr = EvErr Ev (WorkError -> IO ()) data ComputeRequest = CRWork EvErr | CRSave () | CRKill () + | CRPack () + | CRScry Wen Gang Path (Maybe (Term, Noun) -> IO ()) type SpinState = Maybe Ev + -- Exceptions ------------------------------------------------------------------ data SerfExn --- = BadComputeId EventId WorkResult +-- = BadComputeId EventId (Fact, FX) -- | BadReplacementId EventId ReplacementEv -- | UnexpectedPlay EventId (EventId, Mug) = UnexpectedPlea Plea Text @@ -252,7 +244,7 @@ sendBytes s bs = handle onIOError $ do hFlush (serfSend s) where onIOError :: IOError -> IO () - onIOError = const (throwIO SerfConnectionClosed) -- TODO call death callback? + onIOError = const (throwIO SerfConnectionClosed) recvBytes :: Serf -> Word64 -> IO ByteString recvBytes serf = BS.hGet (serfRecv serf) . fromIntegral @@ -262,7 +254,7 @@ recvLen w = do bs <- BS.hGet (serfRecv w) 8 case length bs of 8 -> BS.unsafeUseAsCString bs (peek @Word64 . castPtr) - _ -> throwIO SerfConnectionClosed -- TODO kill worker process and call the death callback. + _ -> throwIO SerfConnectionClosed recvResp :: Serf -> IO ByteString recvResp serf = do @@ -327,8 +319,8 @@ sendSnapshotRequest serf eve = do sendWrit serf (WLive $ LSave eve) recvLive serf -sendCompactRequest :: Serf -> EventId -> IO () -sendCompactRequest serf eve = do +sendCompactionRequest :: Serf -> EventId -> IO () +sendCompactionRequest serf eve = do sendWrit serf (WLive $ LPack eve) recvLive serf @@ -343,7 +335,7 @@ sendShutdownRequest serf exitCode = do pure () --- Serf Usage Flows ------------------------------------------------------------ +-- Starting the Serf ----------------------------------------------------------- compileFlags :: [Flag] -> Word compileFlags = foldl' (\acc flag -> setBit acc (fromEnum flag)) 0 @@ -374,6 +366,9 @@ start (Config exePax pierPath flags onSlog onStdr onDead) = do , std_err = CreatePipe } + +-- Taking the SerfState Lock --------------------------------------------------- + withSerfLock :: MonadIO m => (m (SerfState, a) -> m (Either SomeException (SerfState, a))) @@ -396,11 +391,23 @@ withSerfLock tryGen s f = do Left exn -> putMVar (serfLock s) (Left exn) >> throwIO exn Right ss -> pure ss + +-- Flows for Interacting with the Serf ----------------------------------------- + snapshot :: Serf -> IO () -snapshot serf = - withSerfLock try serf \ss -> do - sendSnapshotRequest serf (ssLast ss) - pure (ss, ()) +snapshot serf = withSerfLock try serf $ \ss -> do + sendSnapshotRequest serf (ssLast ss) + pure (ss, ()) + +compact :: Serf -> IO () +compact serf = withSerfLock try serf $ \ss -> do + sendCompactionRequest serf (ssLast ss) + pure (ss, ()) + +scry :: Serf -> Wen -> Gang -> Path -> (Maybe (Term, Noun) -> IO ()) -> IO () +scry serf w g p k = withSerfLock try serf $ \ss -> do + sendScryRequest serf w g p >>= k + pure (ss, ()) shutdown :: HasLogFunc e => Serf -> RIO e () shutdown serf = do @@ -413,7 +420,7 @@ shutdown serf = do io $ waitForProcess (serfProc serf) logTrace "RIP Serf process." where - wait2sec = threadDelay 2_000_000 + wait2sec = threadDelay 2_000_000 forceKill = do logTrace "Serf taking too long to go down, kill with fire (SIGTERM)." io (forceKillSerf serf) @@ -427,16 +434,13 @@ forceKillSerf serf = do io $ signalProcess sigKILL pid io $ void $ waitForProcess (serfProc serf) -bootSeq :: Serf -> [Noun] -> IO (Maybe PlayBail) -- TODO should this be an exception? -bootSeq serf@Serf{..} seq = do - withSerfLock try serf \ss -> do +bootSeq :: Serf -> [Noun] -> IO (Maybe PlayBail) +bootSeq serf@Serf {..} seq = do + withSerfLock try serf $ \ss -> do recvPlay serf >>= \case - PBail bail -> pure (ss, Just bail) - PDone newMug -> pure (SerfState (fromIntegral $ length seq) newMug, Nothing) + PBail bail -> pure (ss, Just bail) + PDone mug -> pure (SerfState (fromIntegral $ length seq) mug, Nothing) -{- - TODO Take advantage of IPC support for batching. --} replay :: forall m . (MonadUnliftIO m, MonadIO m) @@ -444,14 +448,14 @@ replay -> Serf -> ConduitT Noun Void m (Maybe PlayBail) replay batchSize serf = do - withSerfLock tryC serf \ss -> do + withSerfLock tryC serf $ \ss -> do (r, ss') <- loop ss pure (ss', r) where loop :: SerfState -> ConduitT Noun Void m (Maybe PlayBail, SerfState) loop ss@(SerfState lastEve lastMug) = do awaitBatch batchSize >>= \case - [] -> pure (Nothing, SerfState lastEve lastMug) + [] -> pure (Nothing, SerfState lastEve lastMug) evs -> do let nexEve = lastEve + 1 let newEve = lastEve + fromIntegral (length evs) @@ -461,7 +465,7 @@ replay batchSize serf = do PDone newMug -> loop (SerfState newEve newMug) {- - TODO Use a mutable vector instead of reversing a list. + TODO If this is slow, use a mutable vector instead of reversing a list. -} awaitBatch :: Monad m => Int -> ConduitT i o m [i] awaitBatch = go [] @@ -472,87 +476,39 @@ awaitBatch = go [] Just x -> go (x:acc) (n-1) {- - TODO *we* should probably kill the serf on exception? - TODO callbacks on snapshot and compaction? - TODO Take advantage of async IPC to fill pipe with more than one thing. - - TODO Think this through: the caller *really* should not request - snapshots until all of the events leading up to a certain state - have been commited to disk in the event log. + TODO Don't take snapshot until event log has processed current event. -} running - :: forall m - . (MonadIO m, MonadUnliftIO m) - => Serf - -> (Maybe RunInput -> IO ()) - -> ConduitT RunInput RunOutput m () -running serf notice = do - withSerfLock tryC serf $ \SerfState{..} -> do - newState <- loop ssHash ssLast - pure (newState, ()) - where - loop :: Mug -> EventId -> ConduitT RunInput RunOutput m SerfState - loop mug eve = do - io (notice Nothing) - nex <- await - io (notice nex) - nex & \case - Nothing -> do - pure $ SerfState eve mug - Just (RunSnap blk) -> do - atomically (blk eve) - io (sendSnapshotRequest serf eve) - loop mug eve - Just (RunPack blk) -> do - atomically (blk eve) - io (sendCompactRequest serf eve) - loop mug eve - Just (RunPeek wen gang pax act) -> do - io (sendScryRequest serf wen gang pax >>= act) - loop mug eve - Just (RunWork evn err) -> do - wen <- io Time.now - io (sendWrit serf (WWork wen evn)) - io (recvWork serf) >>= \case - WDone eid hash fx -> do - yield (RunOutput eid hash wen (toNoun evn) fx) - loop hash eid - WSwap eid hash (wen, noun) fx -> do - io $ err (RunSwap eid hash wen noun fx) - yield (RunOutput eid hash wen noun fx) - loop hash eid - WBail goofs -> do - io $ err (RunBail goofs) - loop mug eve - -workQueueSize :: Int -workQueueSize = 10 - -{- - TODO don't take snapshot until event log has processed current event. --} -swimming :: Serf + -> Int -> STM ComputeRequest - -> (RunOutput -> STM ()) + -> ((Fact, FX) -> STM ()) -> (SpinState -> STM ()) -> IO () -swimming serf onInput sendOn spin = topLoop +running serf maxBatchSize onInput sendOn spin = topLoop where topLoop :: IO () topLoop = atomically onInput >>= \case CRWork workErr -> doWork workErr - CRSave () -> doSnap + CRSave () -> doSave CRKill () -> pure () + CRPack () -> doPack + CRScry w g p k -> doScry w g p k - doSnap :: IO () - doSnap = snapshot serf >> topLoop + doPack :: IO () + doPack = compact serf >> topLoop + + doSave :: IO () + doSave = snapshot serf >> topLoop + + doScry :: Wen -> Gang -> Path -> (Maybe (Term, Noun) -> IO ()) -> IO () + doScry w g p k = scry serf w g p k >> topLoop doWork :: EvErr -> IO () doWork firstWorkErr = do que <- newTBMQueueIO 1 () <- atomically (writeTBMQueue que firstWorkErr) - tWork <- async (processWork serf que onWorkResp spin) + tWork <- async (processWork serf maxBatchSize que onWorkResp spin) nexSt <- workLoop que wait tWork nexSt @@ -560,34 +516,65 @@ swimming serf onInput sendOn spin = topLoop workLoop :: TBMQueue EvErr -> IO (IO ()) workLoop que = atomically onInput >>= \case CRKill () -> atomically (closeTBMQueue que) >> pure (pure ()) - CRSave () -> atomically (closeTBMQueue que) >> pure doSnap + CRSave () -> atomically (closeTBMQueue que) >> pure doSave + CRPack () -> atomically (closeTBMQueue que) >> pure doPack + CRScry w g p k -> atomically (closeTBMQueue que) >> pure (doScry w g p k) CRWork workErr -> atomically (writeTBMQueue que workErr) >> workLoop que onWorkResp :: Wen -> EvErr -> Work -> IO () onWorkResp wen (EvErr evn err) = \case WDone eid hash fx -> do - atomically $ sendOn (RunOutput eid hash wen (toNoun evn) fx) + atomically $ sendOn ((Fact eid hash wen (toNoun evn)), fx) WSwap eid hash (wen, noun) fx -> do io $ err (RunSwap eid hash wen noun fx) - atomically $ sendOn (RunOutput eid hash wen noun fx) + atomically $ sendOn (Fact eid hash wen noun, fx) WBail goofs -> do io $ err (RunBail goofs) -pullFromQueueBounded :: TVar (Seq a) -> TBMQueue b -> STM (Maybe b) -pullFromQueueBounded vInFlight queue = do +{- + Given: + + - A stream of incoming requests + - A sequence of in-flight requests that haven't been responded to + - A maximum number of in-flight requests. + + Wait until the number of in-fligh requests is smaller than the maximum, + and then take the next item from the stream of requests. +-} +pullFromQueueBounded :: Int -> TVar (Seq a) -> TBMQueue b -> STM (Maybe b) +pullFromQueueBounded maxSize vInFlight queue = do inFlight <- length <$> readTVar vInFlight - if inFlight >= workQueueSize + if inFlight >= maxSize then retry else readTBMQueue queue --- TODO Handle scry and peek. +{- + Given + + - `maxSize`: The maximum number of jobs to send to the serf before + getting a response. + - `q`: A bounded queue (which can be closed) + - `onResp`: a callback to call for each response from the serf. + - `spin`: a callback to tell the terminal driver which event is + currently being processed. + + Pull jobs from the queue and send them to the serf (eagerly, up to + `maxSize`) and call the callback with each response from the serf. + + When the queue is closed, wait for the serf to respond to all pending + work, and then return. + + Whenever the serf is idle, call `spin Nothing` and whenever the serf + is working on an event, call `spin (Just ev)`. +-} processWork :: Serf + -> Int -> TBMQueue EvErr -> (Wen -> EvErr -> Work -> IO ()) -> (SpinState -> STM ()) -> IO () -processWork serf q onResp spin = do +processWork serf maxSize q onResp spin = do vDoneFlag <- newTVarIO False vInFlightQueue <- newTVarIO empty recvThread <- async (recvLoop serf vDoneFlag vInFlightQueue) @@ -596,7 +583,7 @@ processWork serf q onResp spin = do where loop :: TVar (Seq (Ev, Work -> IO ())) -> TVar Bool -> IO () loop vInFlight vDone = do - atomically (pullFromQueueBounded vInFlight q) >>= \case + atomically (pullFromQueueBounded maxSize vInFlight q) >>= \case Nothing -> do atomically (writeTVar vDone True) Just evErr@(EvErr ev _) -> do @@ -618,9 +605,27 @@ processWork serf q onResp spin = do (ev, _) :<| _ -> pure (Just ev) _ -> pure Nothing +{-| + Given: + + - `vDone`: A flag that no more work will be sent to the serf. + + - `vWork`: A list of work requests that have been sent to the serf, + haven't been responded to yet. + + If the serf has responded to all work requests, and no more work is + going to be sent to the serf, then return. + + If we are going to send more work to the serf, but the queue is empty, + then wait. + + If work requests have been sent to the serf, take the first one, + wait for a response from the serf, call the associated callback, + and repeat the whole process. +-} recvLoop :: Serf -> TVar Bool -> TVar (Seq (Ev, Work -> IO ())) -> IO () recvLoop serf vDone vWork = do - withSerfLock try serf \SerfState{..} -> do + withSerfLock try serf \SerfState {..} -> do loop ssLast ssHash where loop eve mug = do From 75b97d9e60af9b13f01af0fbbc37863a6f5da6e9 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 1 Jun 2020 17:51:37 +0000 Subject: [PATCH 108/257] Docs and cleanup for `Urbit.Vere.Serf.IPC`. --- pkg/hs/TODO.md | 4 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 19 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 4 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 283 ++++++++++++------- 5 files changed, 187 insertions(+), 125 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index bb906a7b6..22e2e641f 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -4,12 +4,12 @@ Stubbed out: handle unparsed nouns) - [x] Handle IPC errors by killing serf process. - [x] Handle `peek` and `pack` in `swimming` flow. -- [ ] PlayBail should be an exception for now. -- [ ] Documentation for `Urbit.Vere.Serf.IPC`. +- [x] Documentation for `Urbit.Vere.Serf.IPC`. - [x] Unstub slog/stder/dead callbacks on serf config. - [x] Remove GoodParse hack in newRunCompute. - [ ] Bring back tank printing. - [x] Handle serf stderr message correctly. +- [ ] Snapshots should block until that event is commited to disk. King-Haskell specific features: diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 02a1b96f6..107d57bf6 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -207,7 +207,7 @@ runOrExitImmediately vSlog getPier oExit mStart multi = do shutdownImmediately :: (Serf, Log.EventLog) -> RIO PierEnv () shutdownImmediately (serf, log) = do logTrace "Sending shutdown signal" - Serf.shutdown serf + Serf.stop serf logTrace "Shutdown!" runPier :: (Serf, Log.EventLog) -> RIO PierEnv () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index fd3a3737c..86904a4fc 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -36,7 +36,7 @@ import Urbit.Vere.Eyre (eyre) import Urbit.Vere.Eyre.Multi (MultiEyreApi) import Urbit.Vere.Http.Client (client) import Urbit.Vere.Log (EventLog) -import Urbit.Vere.Serf (ComputeRequest(..), EvErr(..), Serf, SpinState) +import Urbit.Vere.Serf (Serf) import qualified System.Entropy as Ent import qualified Urbit.King.API as King @@ -297,7 +297,7 @@ pier (serf, log) vSlog mStart multi = do let stubErrCallback = \_ -> pure () let computeConfig = ComputeConfig - { ccOnWork = (\x -> EvErr x stubErrCallback) <$> readTQueue computeQ + { ccOnWork = (`Serf.EvErr` stubErrCallback) <$> readTQueue computeQ , ccOnKill = takeTMVar shutdownM , ccOnSave = takeTMVar saveM , ccPutResult = writeTQueue persistQ @@ -425,7 +425,7 @@ logEffect ef = logDebug $ display $ "[EFFECT]\n" <> pretty ef FailParse n -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow n data ComputeConfig = ComputeConfig - { ccOnWork :: STM EvErr + { ccOnWork :: STM Serf.EvErr , ccOnKill :: STM () , ccOnSave :: STM () , ccPutResult :: (Fact, FX) -> STM () @@ -437,18 +437,17 @@ runCompute :: forall e . HasKingEnv e => Serf.Serf -> ComputeConfig -> RIO e () runCompute serf ComputeConfig {..} = do logTrace "runCompute" - let onCR = asum [ CRKill <$> ccOnKill - , CRSave <$> ccOnSave - , CRWork <$> ccOnWork + let onCR = asum [ Serf.RRKill <$> ccOnKill + , Serf.RRSave <$> ccOnSave + , Serf.RRWork <$> ccOnWork ] - let onSpin :: SpinState -> STM () - onSpin Nothing = ccHideSpinner - onSpin (Just ev) = ccShowSpinner (getSpinnerNameForEvent ev) + let onSpin :: Maybe Ev -> STM () + onSpin = maybe ccHideSpinner (ccShowSpinner . getSpinnerNameForEvent) let maxBatchSize = 10 - io (Serf.running serf maxBatchSize onCR ccPutResult onSpin) + io (Serf.run serf maxBatchSize onCR ccPutResult onSpin) -- Persist Thread -------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 1c34d819b..b6ce82b23 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -51,7 +51,7 @@ withSerf config = mkRAcquire startup kill logTrace (displayShow st) pure serf kill serf = do - void $ rio $ shutdown serf + void $ rio $ stop serf execReplay :: forall e @@ -80,7 +80,7 @@ execReplay serf log last = do when (numEvs /= bootSeqLen) $ do throwIO (MissingBootEventsInEventLog numEvs bootSeqLen) - io (bootSeq serf evs) >>= \case + io (boot serf evs) >>= \case Just err -> pure (Just err) Nothing -> doReplay diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index a9d955706..554a53055 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -1,35 +1,50 @@ -{- -|% -:: +writ: from king to serf -:: -+$ gang (unit (set ship)) -+$ writ - $% $: %live - $% [%exit cod=@] - [%save eve=@] - [%pack eve=@] - == == - [%peek now=date lyc=gang pat=path] - [%play eve=@ lit=(list ?((pair date ovum) *))] - [%work job=(pair date ovum)] - == -:: +plea: from serf to king -:: -+$ plea - $% [%live ~] - [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] - [%slog pri=@ ?(cord tank)] - [%peek dat=(unit (cask))] - $: %play - $% [%done mug=@] - [%bail eve=@ mug=@ dud=goof] - == == - $: %work - $% [%done eve=@ mug=@ fec=(list ovum)] - [%swap eve=@ mug=@ job=(pair date ovum) fec=(list ovum)] - [%bail lud=(list goof)] - == == - == +{-| + Low-Level IPC flows for interacting with the serf process. + + - Serf process can be started and shutdown with `start` and `stop`. + - You can ask the serf what it's last event was with + `serfLastEventBlocking`. + - A running serf can be asked to compact it's heap or take a snapshot. + - You can scry into a running serf. + - A running serf can be asked to execute a boot sequence, replay from + existing events, and run a ship with `boot`, `replay`, and `run`. + + The running and replay flows will do batching of events to keep the + IPC pipe full. + + ``` + |% + :: +writ: from king to serf + :: + +$ gang (unit (set ship)) + +$ writ + $% $: %live + $% [%exit cod=@] + [%save eve=@] + [%pack eve=@] + == == + [%peek now=date lyc=gang pat=path] + [%play eve=@ lit=(list ?((pair date ovum) *))] + [%work job=(pair date ovum)] + == + :: +plea: from serf to king + :: + +$ plea + $% [%live ~] + [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] + [%slog pri=@ ?(cord tank)] + [%peek dat=(unit (cask))] + $: %play + $% [%done mug=@] + [%bail eve=@ mug=@ dud=goof] + == == + $: %work + $% [%done eve=@ mug=@ fec=(list ovum)] + [%swap eve=@ mug=@ job=(pair date ovum) fec=(list ovum)] + [%bail lud=(list goof)] + == == + == + ``` -} module Urbit.Vere.Serf.IPC @@ -38,16 +53,17 @@ module Urbit.Vere.Serf.IPC , PlayBail(..) , Flag(..) , WorkError(..) - , start - , serfLastEventBlocking - , shutdown - , snapshot - , bootSeq - , replay - , running , EvErr(..) - , ComputeRequest(..) - , SpinState + , RunReq(..) + , start + , stop + , serfLastEventBlocking + , snapshot + , compact + , scry + , boot + , replay + , run ) where @@ -177,39 +193,16 @@ data Config = Config , scDead :: IO () -- What to do when the serf process goes down? } -data WorkError - = RunBail [Goof] - | RunSwap EventId Mug Wen Noun FX - -data EvErr = EvErr Ev (WorkError -> IO ()) - -data ComputeRequest - = CRWork EvErr - | CRSave () - | CRKill () - | CRPack () - | CRScry Wen Gang Path (Maybe (Term, Noun) -> IO ()) - -type SpinState = Maybe Ev - -- Exceptions ------------------------------------------------------------------ data SerfExn --- = BadComputeId EventId (Fact, FX) --- | BadReplacementId EventId ReplacementEv --- | UnexpectedPlay EventId (EventId, Mug) - = UnexpectedPlea Plea Text - | BadPleaAtom Atom - | BadPleaNoun Noun [Text] Text --- | ReplacedEventDuringReplay EventId ReplacementEv --- | ReplacedEventDuringBoot EventId ReplacementEv --- | EffectsDuringBoot EventId FX - | SerfConnectionClosed --- | UnexpectedPleaOnNewShip Plea --- | InvalidInitialPlea Plea - deriving (Show, Exception) - + = UnexpectedPlea Plea Text + | BadPleaAtom Atom + | BadPleaNoun Noun [Text] Text + | SerfConnectionClosed + | SerfHasShutdown + deriving (Show, Exception) -- Access Current Serf State --------------------------------------------------- @@ -379,7 +372,7 @@ withSerfLock tryGen s f = do ss <- takeLock tryGen (f ss) >>= \case Left e -> do - io (forceKillSerf s) + io (forcefullyKillSerf s) putMVar (serfLock s) (Left e) throwIO e Right (ss', x) -> do @@ -394,53 +387,90 @@ withSerfLock tryGen s f = do -- Flows for Interacting with the Serf ----------------------------------------- +{-| + Ask the serf to write a snapshot to disk. +-} snapshot :: Serf -> IO () snapshot serf = withSerfLock try serf $ \ss -> do sendSnapshotRequest serf (ssLast ss) pure (ss, ()) +{-| + Ask the serf to de-duplicate and de-fragment it's heap. +-} compact :: Serf -> IO () compact serf = withSerfLock try serf $ \ss -> do sendCompactionRequest serf (ssLast ss) pure (ss, ()) -scry :: Serf -> Wen -> Gang -> Path -> (Maybe (Term, Noun) -> IO ()) -> IO () -scry serf w g p k = withSerfLock try serf $ \ss -> do - sendScryRequest serf w g p >>= k - pure (ss, ()) +{-| + Peek into the serf state. +-} +scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) +scry serf w g p = withSerfLock try serf $ \ss -> do + (ss,) <$> sendScryRequest serf w g p -shutdown :: HasLogFunc e => Serf -> RIO e () -shutdown serf = do - race_ (wait2sec >> forceKill) $ do - logTrace "Getting current serf state (taking lock, might block if in use)." - finalState <- takeMVar (serfLock serf) - logTrace "Got serf state (and took lock). Requesting shutdown." - io (sendShutdownRequest serf 0) - logTrace "Sent shutdown request. Waiting for process to die." - io $ waitForProcess (serfProc serf) - logTrace "RIP Serf process." +{-| + Ask the serf to shutdown. If it takes more than 2s, kill it with + SIGKILL. +-} +stop :: HasLogFunc e => Serf -> RIO e () +stop serf = do + race_ niceKill (wait2sec >> forceKill) where - wait2sec = threadDelay 2_000_000 + wait2sec = threadDelay 2_000_000 + + niceKill = do + logTrace "Asking serf to shut down" + io (gracefullyKillSerf serf) + logTrace "Serf went down when asked." + forceKill = do logTrace "Serf taking too long to go down, kill with fire (SIGTERM)." - io (forceKillSerf serf) + io (forcefullyKillSerf serf) logTrace "Serf process killed with SIGTERM." -forceKillSerf :: Serf -> IO () -forceKillSerf serf = do +{-| + Kill the serf by taking the lock, then asking for it to exit. +-} +gracefullyKillSerf :: Serf -> IO () +gracefullyKillSerf serf@Serf{..} = do + finalState <- takeMVar serfLock + sendShutdownRequest serf 0 + waitForProcess serfProc + pure () + +{-| + Kill the serf by sending it a SIGKILL. +-} +forcefullyKillSerf :: Serf -> IO () +forcefullyKillSerf serf = do getPid (serfProc serf) >>= \case Nothing -> pure () Just pid -> do io $ signalProcess sigKILL pid io $ void $ waitForProcess (serfProc serf) -bootSeq :: Serf -> [Noun] -> IO (Maybe PlayBail) -bootSeq serf@Serf {..} seq = do +{-| + Given a list of boot events, send them to to the serf in a single + %play message. They must all be sent in a single %play event so that + the serf can determine the length of the boot sequence. +-} +boot :: Serf -> [Noun] -> IO (Maybe PlayBail) +boot serf@Serf {..} seq = do withSerfLock try serf $ \ss -> do recvPlay serf >>= \case PBail bail -> pure (ss, Just bail) PDone mug -> pure (SerfState (fromIntegral $ length seq) mug, Nothing) +{-| + Given a stream of nouns (from the event log), feed them into the serf + in batches of size `batchSize`. + + - On `%bail` response, return early. + - On IPC errors, kill the serf and rethrow. + - On success, return `Nothing`. +-} replay :: forall m . (MonadUnliftIO m, MonadIO m) @@ -464,7 +494,7 @@ replay batchSize serf = do PBail bail -> pure (Just bail, SerfState lastEve lastMug) PDone newMug -> loop (SerfState newEve newMug) -{- +{-| TODO If this is slow, use a mutable vector instead of reversing a list. -} awaitBatch :: Monad m => Int -> ConduitT i o m [i] @@ -475,25 +505,58 @@ awaitBatch = go [] Nothing -> pure (reverse acc) Just x -> go (x:acc) (n-1) + +-- Running Ship Flow ----------------------------------------------------------- + +{-| + Two types of serf failures. + + - `RunSwap`: Event processing failed, but the serf replaced it with + another event which succeeded. + + - `RunBail`: Event processing failed and all attempt to replace it + with a failure-notice event also caused crashes. We are really fucked. +-} +data WorkError + = RunSwap EventId Mug Wen Noun FX + | RunBail [Goof] + {- + An event and a callback to inform the IO Driver about failures. +-} +data EvErr = EvErr Ev (WorkError -> IO ()) + +{- + - RRWork: Ask the serf to do work, will output (Fact, FX) if work + succeeded and call callback on failure. + - RRSave: Wait for the serf to finish all pending work +-} +data RunReq + = RRWork EvErr + | RRSave () + | RRKill () + | RRPack () + | RRScry Wen Gang Path (Maybe (Term, Noun) -> IO ()) + +{-| TODO Don't take snapshot until event log has processed current event. -} -running +run :: Serf -> Int - -> STM ComputeRequest + -> STM RunReq -> ((Fact, FX) -> STM ()) - -> (SpinState -> STM ()) + -> (Maybe Ev -> STM ()) -> IO () -running serf maxBatchSize onInput sendOn spin = topLoop +run serf maxBatchSize onInput sendOn spin = topLoop where topLoop :: IO () topLoop = atomically onInput >>= \case - CRWork workErr -> doWork workErr - CRSave () -> doSave - CRKill () -> pure () - CRPack () -> doPack - CRScry w g p k -> doScry w g p k + RRWork workErr -> doWork workErr + RRSave () -> doSave + RRKill () -> pure () + RRPack () -> doPack + RRScry w g p k -> doScry w g p k doPack :: IO () doPack = compact serf >> topLoop @@ -502,7 +565,7 @@ running serf maxBatchSize onInput sendOn spin = topLoop doSave = snapshot serf >> topLoop doScry :: Wen -> Gang -> Path -> (Maybe (Term, Noun) -> IO ()) -> IO () - doScry w g p k = scry serf w g p k >> topLoop + doScry w g p k = (scry serf w g p >>= k) >> topLoop doWork :: EvErr -> IO () doWork firstWorkErr = do @@ -515,11 +578,11 @@ running serf maxBatchSize onInput sendOn spin = topLoop workLoop :: TBMQueue EvErr -> IO (IO ()) workLoop que = atomically onInput >>= \case - CRKill () -> atomically (closeTBMQueue que) >> pure (pure ()) - CRSave () -> atomically (closeTBMQueue que) >> pure doSave - CRPack () -> atomically (closeTBMQueue que) >> pure doPack - CRScry w g p k -> atomically (closeTBMQueue que) >> pure (doScry w g p k) - CRWork workErr -> atomically (writeTBMQueue que workErr) >> workLoop que + RRKill () -> atomically (closeTBMQueue que) >> pure (pure ()) + RRSave () -> atomically (closeTBMQueue que) >> pure doSave + RRPack () -> atomically (closeTBMQueue que) >> pure doPack + RRScry w g p k -> atomically (closeTBMQueue que) >> pure (doScry w g p k) + RRWork workErr -> atomically (writeTBMQueue que workErr) >> workLoop que onWorkResp :: Wen -> EvErr -> Work -> IO () onWorkResp wen (EvErr evn err) = \case @@ -531,7 +594,7 @@ running serf maxBatchSize onInput sendOn spin = topLoop WBail goofs -> do io $ err (RunBail goofs) -{- +{-| Given: - A stream of incoming requests @@ -548,7 +611,7 @@ pullFromQueueBounded maxSize vInFlight queue = do then retry else readTBMQueue queue -{- +{-| Given - `maxSize`: The maximum number of jobs to send to the serf before @@ -572,7 +635,7 @@ processWork -> Int -> TBMQueue EvErr -> (Wen -> EvErr -> Work -> IO ()) - -> (SpinState -> STM ()) + -> (Maybe Ev -> STM ()) -> IO () processWork serf maxSize q onResp spin = do vDoneFlag <- newTVarIO False From 61bdb3cac0402a3cdd2d563a67bd8c75b2edca57 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 1 Jun 2020 21:31:24 +0000 Subject: [PATCH 109/257] king: Re-Implemenet collectFX and log events as passed to the serf. --- pkg/hs/TODO.md | 11 +++-- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 23 ++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 48 +++++++++++++------- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 38 ++++++++++++++++ 4 files changed, 90 insertions(+), 30 deletions(-) diff --git a/pkg/hs/TODO.md b/pkg/hs/TODO.md index 22e2e641f..4db564da7 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/TODO.md @@ -7,13 +7,15 @@ Stubbed out: - [x] Documentation for `Urbit.Vere.Serf.IPC`. - [x] Unstub slog/stder/dead callbacks on serf config. - [x] Remove GoodParse hack in newRunCompute. -- [ ] Bring back tank printing. +- [x] Bring back tank printing. - [x] Handle serf stderr message correctly. +- [x] Bring back `logEvent`. - [ ] Snapshots should block until that event is commited to disk. King-Haskell specific features: -- [ ] Re-implement "collect-fx" flow. +- [x] Re-implement `collectFX` flow. +- [ ] Test new `collectFX` flow Performance: @@ -23,16 +25,15 @@ Performance: Polish: - [x] Cleanup batching flow. +- [x] Think through how to shutdown the serf on exception. - [ ] Logging for new IPC flow. - [ ] Logging for boot sequence. - [ ] Bring back progress bars. - [ ] Hook up error callbacks to IO Drivers. -- [x] Think through how to shutdown the serf on exception. -- [ ] Better exceptions in Serf error cases. Unrelated bugs: - [ ] Handle ^C in connected terminals. - [ ] terminal driver seems to have a race condition when spinner changed too quickly. -- [ ] King should shutdown promptly on ^C. Always takes 2s in practice./ +- [ ] King should shutdown promptly on ^C. Always takes 2s in practice. diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 86904a4fc..4f59dc6c1 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -1,10 +1,8 @@ -{-# OPTIONS_GHC -Wwarn #-} - {-| Top-Level Pier Management - This is the code that starts the IO drivers and deals with - communication between the serf, the log, and the IO drivers. + This is the code that starts the IO drivers and deals with communication + between the serf, the event log, and the IO drivers. -} module Urbit.Vere.Pier ( booted @@ -425,10 +423,10 @@ logEffect ef = logDebug $ display $ "[EFFECT]\n" <> pretty ef FailParse n -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow n data ComputeConfig = ComputeConfig - { ccOnWork :: STM Serf.EvErr - , ccOnKill :: STM () - , ccOnSave :: STM () - , ccPutResult :: (Fact, FX) -> STM () + { ccOnWork :: STM Serf.EvErr + , ccOnKill :: STM () + , ccOnSave :: STM () + , ccPutResult :: (Fact, FX) -> STM () , ccShowSpinner :: Maybe Text -> STM () , ccHideSpinner :: STM () } @@ -442,8 +440,15 @@ runCompute serf ComputeConfig {..} = do , Serf.RRWork <$> ccOnWork ] + vEvProcessing :: TMVar Ev <- newEmptyTMVarIO + + void $ async $ forever (atomically (takeTMVar vEvProcessing) >>= logEvent) + let onSpin :: Maybe Ev -> STM () - onSpin = maybe ccHideSpinner (ccShowSpinner . getSpinnerNameForEvent) + onSpin Nothing = ccHideSpinner + onSpin (Just ev) = do + ccShowSpinner (getSpinnerNameForEvent ev) + putTMVar vEvProcessing ev let maxBatchSize = 10 diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index b6ce82b23..57c04bdda 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -3,26 +3,32 @@ -} module Urbit.Vere.Serf - ( module Urbit.Vere.Serf.IPC - , withSerf + ( withSerf , execReplay + , collectFX + , module X ) where import Urbit.Prelude import Data.Conduit --- ort System.ProgressBar --- ort Urbit.Arvo import Urbit.Vere.Pier.Types import Urbit.Vere.Serf.IPC --- ort Urbit.King.App (HasStderrLogFunc(..)) +import Urbit.Arvo (FX) import qualified Data.Conduit.Combinators as CC +import qualified Urbit.Vere.Log as Log + +import qualified Urbit.Vere.Serf.IPC as X (Config(..), EvErr(..), Flag(..), + RunReq(..), Serf, run, snapshot, + start, stop) + +-- ort System.ProgressBar +-- ort Urbit.King.App (HasStderrLogFunc(..)) -- ort qualified Urbit.Ob as Ob -- ort qualified Urbit.Time as Time -import qualified Urbit.Vere.Log as Log -------------------------------------------------------------------------------- @@ -34,14 +40,8 @@ data MissingBootEventsInEventLog = MissingBootEventsInEventLog Word Word -------------------------------------------------------------------------------- -bytesNouns :: MonadIO m => ConduitT ByteString Noun m () -bytesNouns = await >>= \case - Nothing -> pure () - Just bs -> do - noun <- cueBSExn bs - (mug :: Noun, bod) <- fromNounExn noun - yield bod - bytesNouns +parseLogRow :: MonadIO m => ByteString -> m (Mug, Noun) +parseLogRow = cueBSExn >=> fromNounExn withSerf :: HasLogFunc e => Config -> RAcquire e Serf withSerf config = mkRAcquire startup kill @@ -72,7 +72,7 @@ execReplay serf log last = do evs <- runConduit $ Log.streamEvents log 1 .| CC.take (fromIntegral bootSeqLen) - .| bytesNouns + .| CC.mapM (fmap snd . parseLogRow) .| CC.sinkList let numEvs = fromIntegral (length evs) @@ -111,5 +111,21 @@ execReplay serf log last = do runConduit $ Log.streamEvents log (lastEventInSnap + 1) .| CC.take (fromIntegral numEvs) - .| bytesNouns + .| CC.mapM (fmap snd . parseLogRow) .| replay 10 serf + + +-- Collect FX ------------------------------------------------------------------ + +collectFX :: HasLogFunc e => Serf -> Log.EventLog -> RIO e () +collectFX serf log = do + lastEv <- io (serfLastEventBlocking serf) + runConduit + $ Log.streamEvents log (lastEv + 1) + .| CC.mapM (parseLogRow >=> fromNounExn . snd) + .| swim serf + .| persistFX + where + persistFX :: ConduitT (EventId, FX) Void (RIO e) () + persistFX = CC.mapM_ $ \(eId, fx) -> do + Log.writeEffectsRow log eId $ jamBS $ toNoun fx diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 554a53055..51fef4fb6 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -64,6 +64,7 @@ module Urbit.Vere.Serf.IPC , boot , replay , run + , swim ) where @@ -202,6 +203,8 @@ data SerfExn | BadPleaNoun Noun [Text] Text | SerfConnectionClosed | SerfHasShutdown + | BailDuringReplay EventId [Goof] + | SwapDuringReplay EventId Mug (Wen, Noun) FX deriving (Show, Exception) -- Access Current Serf State --------------------------------------------------- @@ -506,6 +509,41 @@ awaitBatch = go [] Just x -> go (x:acc) (n-1) +-- Special Replay for Collecting FX -------------------------------------------- + +{-| + This does event-log replay using the running IPC flow so that we + can collect effects. + + We don't tolerate replacement events or bails since we are actually + replaying the log, so we just throw exceptions in those cases. +-} +swim + :: forall m + . (MonadIO m, MonadUnliftIO m) + => Serf + -> ConduitT (Wen, Ev) (EventId, FX) m () +swim serf = do + withSerfLock tryC serf $ \SerfState {..} -> do + (, ()) <$> loop ssHash ssLast + where + loop :: Mug -> EventId -> ConduitT (Wen, Ev) (EventId, FX) m SerfState + loop mug eve = await >>= \case + Nothing -> do + pure (SerfState eve mug) + Just (wen, evn) -> do + io (sendWrit serf (WWork wen evn)) + io (recvWork serf) >>= \case + WBail goofs -> do + throwIO (BailDuringReplay eve goofs) + WSwap eid hash (wen, noun) fx -> do + throwIO (SwapDuringReplay eid hash (wen, noun) fx) + WDone eid hash fx -> do + yield (eid, fx) + loop hash eid + + + -- Running Ship Flow ----------------------------------------------------------- {-| From 28f464fc42d71d3d4c48fc366a70c69eeb147d4b Mon Sep 17 00:00:00 2001 From: ~siprel Date: Tue, 2 Jun 2020 20:48:07 +0000 Subject: [PATCH 110/257] king: Each event comes with error callback, but all do nothing for now. --- pkg/hs/{ => urbit-king}/TODO.md | 24 +++++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 16 ++++++--- pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs | 14 ++++++-- pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs | 35 +++++++++++++------ pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 30 +++++++++++----- .../urbit-king/lib/Urbit/Vere/Http/Client.hs | 24 +++++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 12 +++---- .../urbit-king/lib/Urbit/Vere/Pier/Types.hs | 25 +++++++++++-- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 4 +-- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 22 ------------ pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 24 +++++++++---- pkg/hs/urbit-king/test/AmesTests.hs | 10 +++--- 12 files changed, 155 insertions(+), 85 deletions(-) rename pkg/hs/{ => urbit-king}/TODO.md (66%) diff --git a/pkg/hs/TODO.md b/pkg/hs/urbit-king/TODO.md similarity index 66% rename from pkg/hs/TODO.md rename to pkg/hs/urbit-king/TODO.md index 4db564da7..f9df4267e 100644 --- a/pkg/hs/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -1,7 +1,9 @@ +# New IPC + Stubbed out: - [x] Handle replacement events (stubbed out now b/c interface can't - handle unparsed nouns) + handle unparsed nouns) - [x] Handle IPC errors by killing serf process. - [x] Handle `peek` and `pack` in `swimming` flow. - [x] Documentation for `Urbit.Vere.Serf.IPC`. @@ -11,10 +13,12 @@ Stubbed out: - [x] Handle serf stderr message correctly. - [x] Bring back `logEvent`. - [ ] Snapshots should block until that event is commited to disk. +- [ ] Hook up error callbacks to IO Drivers. King-Haskell specific features: -- [x] Re-implement `collectFX` flow. +- [x] Re-implement `collectFX` flow in Serf/Pier. +- [ ] Hook up `collectFX` to CLI. - [ ] Test new `collectFX` flow Performance: @@ -29,11 +33,17 @@ Polish: - [ ] Logging for new IPC flow. - [ ] Logging for boot sequence. - [ ] Bring back progress bars. -- [ ] Hook up error callbacks to IO Drivers. -Unrelated bugs: +# Misc Bugs -- [ ] Handle ^C in connected terminals. -- [ ] terminal driver seems to have a race condition when spinner changed - too quickly. +- [ ] Handle ^C in connected terminals. It should interrupt current event. +- [ ] The terminal driver seems to have a race condition when spinner + changed too quickly. - [ ] King should shutdown promptly on ^C. Always takes 2s in practice. + +# Cleanup + +- [ ] Break most logic from `Main.hs` out into modules. +- [ ] Simplify `Main.hs` flows. +- [ ] Cleanup Terminal Driver code. +- [ ] Spin off `Urbit.Noun` into it's own package. diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 6ab196bbe..8c5ccbd9d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -95,6 +95,10 @@ udpServ isFake who = do Nothing -> fakeUdpServ Just host -> realUdpServ port host +bornFailed :: e -> WorkError -> IO () +bornFailed env _ = runRIO env $ do + pure () -- TODO What can we do? + {-| inst -- Process instance number. who -- Which ship are we? @@ -112,15 +116,15 @@ ames => e -> Ship -> Bool - -> QueueEv + -> (EvErr -> STM ()) -> (Text -> RIO e ()) - -> ([Ev], RAcquire e (EffCb e NewtEf)) + -> ([EvErr], RAcquire e (EffCb e NewtEf)) ames env who isFake enqueueEv stderr = (initialEvents, runAmes) where king = fromIntegral (env ^. kingIdL) - initialEvents :: [Ev] - initialEvents = [bornEv king] + initialEvents :: [EvErr] + initialEvents = [EvErr (bornEv king) (bornFailed env)] runAmes :: RAcquire e (EffCb e NewtEf) runAmes = do @@ -136,10 +140,12 @@ ames env who isFake enqueueEv stderr = (initialEvents, runAmes) aResolvr <- resolvServ aTurfs (usSend aUdpServ) stderr pure (AmesDrv { .. }) + hearFailed _ = pure () + queuePacketsThread :: UdpServ -> RIO e (Async ()) queuePacketsThread UdpServ {..} = async $ forever $ atomically $ do (p, a, b) <- usRecv - enqueueEv (hearEv p a b) + enqueueEv (EvErr (hearEv p a b) hearFailed) stop :: AmesDrv -> RIO e () stop AmesDrv {..} = io $ do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs index 1f4735158..cf58bc180 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs @@ -26,13 +26,21 @@ wakeEv = EvBlip $ BlipEvBehn $ BehnEvWake () () sysTime = view Time.systemTime -behn :: HasKingId e => e -> QueueEv -> ([Ev], Acquire (EffCb e BehnEf)) +bornFailed :: e -> WorkError -> IO () +bornFailed env _ = runRIO env $ do + pure () -- TODO Ship is fucked. Kill it? + +wakeErr :: WorkError -> IO () +wakeErr _ = pure () + +behn + :: HasKingId e => e -> (EvErr -> STM ()) -> ([EvErr], Acquire (EffCb e BehnEf)) behn env enqueueEv = (initialEvents, runBehn) where king = fromIntegral (env ^. kingIdL) - initialEvents = [bornEv king] + initialEvents = [EvErr (bornEv king) (bornFailed env)] runBehn :: Acquire (EffCb e BehnEf) runBehn = do @@ -48,4 +56,4 @@ behn env enqueueEv = doze :: Timer -> Maybe Wen -> IO () doze tim = \case Nothing -> Timer.stop tim - Just t -> Timer.start tim (sysTime t) $ atomically (enqueueEv wakeEv) + Just t -> Timer.start tim (sysTime t) $ atomically (enqueueEv (EvErr wakeEv wakeErr)) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs index 4e2116b6b..353ad4797 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs @@ -113,18 +113,26 @@ buildActionListFromDifferences fp snapshot = do -------------------------------------------------------------------------------- -clay :: forall e. (HasPierConfig e, HasLogFunc e, HasKingId e) - => e -> QueueEv -> ([Ev], RAcquire e (EffCb e SyncEf)) -clay env enqueueEv = +boatFailed :: e -> WorkError -> IO () +boatFailed env _ = runRIO env $ do + pure () -- TODO What can we do? + +clay + :: forall e + . (HasPierConfig e, HasLogFunc e, HasKingId e) + => e + -> (EvErr -> STM ()) + -> ([EvErr], RAcquire e (EffCb e SyncEf)) +clay env plan = (initialEvents, runSync) where king = fromIntegral (env ^. kingIdL) - initialEvents = [ - EvBlip $ BlipEvBoat $ BoatEvBoat () () - -- TODO: In the case of -A, we need to read all the data from the - -- specified directory and shove it into an %into event. - ] + boatEv = EvBlip $ BlipEvBoat $ BoatEvBoat () () + + -- TODO: In the case of -A, we need to read all the data from the + -- specified directory and shove it into an %into event. + initialEvents = [EvErr boatEv (boatFailed env)] runSync :: RAcquire e (EffCb e SyncEf) runSync = handleEffect <$> mkRAcquire start stop @@ -154,8 +162,15 @@ clay env enqueueEv = logDebug $ displayShow ("(clay) dirk actions: ", actions) let !intoList = map (actionsToInto dir) actions - atomically $ enqueueEv $ EvBlip $ BlipEvSync $ - SyncEvInto (Some (king, ())) desk False intoList + + let syncEv = EvBlip + $ BlipEvSync + $ SyncEvInto (Some (king, ())) desk False intoList + + let syncFailed _ = pure () + + atomically $ plan (EvErr syncEv syncFailed) + atomically $ modifyTVar (cdMountPoints cd) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 3e67abb0a..34df63330 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -70,8 +70,12 @@ bornEv king = servEv $ HttpServerEvBorn (king, ()) () liveEv :: ServId -> Ports -> Ev liveEv sId Ports {..} = servEv $ HttpServerEvLive (sId, ()) pHttp pHttps -cancelEv :: ServId -> ReqId -> Ev -cancelEv sId reqId = servEv $ HttpServerEvCancelRequest (sId, reqId, 1, ()) () +cancelEv :: ServId -> ReqId -> EvErr +cancelEv sId reqId = + EvErr (servEv (HttpServerEvCancelRequest (sId, reqId, 1, ()) ())) cancelFailed + +cancelFailed :: WorkError -> IO () +cancelFailed _ = pure () reqEv :: ServId -> ReqId -> WhichServer -> Address -> HttpRequest -> Ev reqEv sId reqId which addr req = case which of @@ -170,7 +174,7 @@ startServ -> Ship -> Bool -> HttpServerConf - -> (Ev -> STM ()) + -> (EvErr -> STM ()) -> RIO e Serv startServ multi who isFake conf plan = do logTrace (displayShow ("EYRE", "startServ")) @@ -205,9 +209,11 @@ startServ multi who isFake conf plan = do noHttp <- view (networkConfigL . ncNoHttp) noHttps <- view (networkConfigL . ncNoHttps) + let reqEvFailed _ = pure () + let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM () onReq which _ship reqId reqInfo = - plan (requestEvent srvId which reqId reqInfo) + plan $ EvErr (requestEvent srvId which reqId reqInfo) reqEvFailed let onKilReq :: Ship -> Word64 -> STM () onKilReq _ship = plan . cancelEv srvId . fromIntegral @@ -269,21 +275,25 @@ startServ multi who isFake conf plan = do -- Eyre Driver ----------------------------------------------------------------- +bornFailed :: e -> WorkError -> IO () +bornFailed env _ = runRIO env $ do + pure () -- TODO What should this do? + eyre :: forall e . (HasShipEnv e, HasKingId e) => e -> MultiEyreApi -> Ship - -> QueueEv + -> (EvErr -> STM ()) -> Bool - -> ([Ev], RAcquire e (EffCb e HttpServerEf)) + -> ([EvErr], RAcquire e (EffCb e HttpServerEf)) eyre env multi who plan isFake = (initialEvents, runHttpServer) where king = fromIntegral (env ^. kingIdL) - initialEvents :: [Ev] - initialEvents = [bornEv king] + initialEvents :: [EvErr] + initialEvents = [EvErr (bornEv king) (bornFailed env)] runHttpServer :: RAcquire e (EffCb e HttpServerEf) runHttpServer = handleEf <$> mkRAcquire @@ -306,13 +316,15 @@ eyre env multi who plan isFake = (initialEvents, runHttpServer) logDebug "Done restating http server" pure res + liveFailed _ = pure () + handleEf :: Drv -> HttpServerEf -> RIO e () handleEf drv = \case HSESetConfig (i, ()) conf -> do logDebug (displayShow ("EYRE", "%set-config")) Serv {..} <- restart drv conf logDebug (displayShow ("EYRE", "%set-config", "Sending %live")) - atomically $ plan (liveEv sServId sPorts) + atomically $ plan (EvErr (liveEv sServId sPorts) liveFailed) logDebug "Write ports file" io (writePortsFile sPortsFile sPorts) HSEResponse (i, req, _seq, ()) ev -> do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs index 038d8218d..0bf9abf38 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs @@ -57,18 +57,22 @@ bornEv king = -------------------------------------------------------------------------------- +bornFailed :: e -> WorkError -> IO () +bornFailed env _ = runRIO env $ do + pure () -- TODO What to do in this case? + client :: forall e . (HasLogFunc e, HasKingId e) => e - -> QueueEv - -> ([Ev], RAcquire e (EffCb e HttpClientEf)) -client env enqueueEv = (initialEvents, runHttpClient) + -> (EvErr -> STM ()) + -> ([EvErr], RAcquire e (EffCb e HttpClientEf)) +client env plan = (initialEvents, runHttpClient) where kingId = view (kingIdL . to fromIntegral) env - initialEvents :: [Ev] - initialEvents = [bornEv kingId] + initialEvents :: [EvErr] + initialEvents = [EvErr (bornEv kingId) (bornFailed env)] runHttpClient :: RAcquire e (EffCb e HttpClientEf) runHttpClient = handleEffect <$> mkRAcquire start stop @@ -133,8 +137,14 @@ client env enqueueEv = (initialEvents, runHttpClient) planEvent :: ReqId -> HttpEvent -> RIO e () planEvent id ev = do logDebug $ displayShow ("(http client response)", id, (describe ev)) - atomically $ enqueueEv $ EvBlip $ BlipEvHttpClient $ - HttpClientEvReceive (kingId, ()) (fromIntegral id) ev + + let recvEv = EvBlip + $ BlipEvHttpClient + $ HttpClientEvReceive (kingId, ()) (fromIntegral id) ev + + let recvFailed _ = pure () + + atomically $ plan (EvErr recvEv recvFailed) -- show an HttpEvent with byte count instead of raw data describe :: HttpEvent -> String diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 4f59dc6c1..cbf8eb8be 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -231,7 +231,7 @@ pier -> MultiEyreApi -> RAcquire PierEnv () pier (serf, log) vSlog mStart multi = do - computeQ <- newTQueueIO + computeQ <- newTQueueIO @_ @Serf.EvErr persistQ <- newTQueueIO executeQ <- newTQueueIO saveM <- newEmptyTMVarIO @@ -292,10 +292,8 @@ pier (serf, log) vSlog mStart multi = do io $ atomically $ for_ bootEvents (writeTQueue computeQ) - let stubErrCallback = \_ -> pure () - let computeConfig = ComputeConfig - { ccOnWork = (`Serf.EvErr` stubErrCallback) <$> readTQueue computeQ + { ccOnWork = readTQueue computeQ , ccOnKill = takeTMVar shutdownM , ccOnSave = takeTMVar saveM , ccPutResult = writeTQueue persistQ @@ -357,13 +355,13 @@ drivers -> MultiEyreApi -> Ship -> Bool - -> (Ev -> STM ()) + -> (EvErr -> STM ()) -> STM () -> (Term.TSize, Term.Client) -> (Text -> RIO e ()) - -> ([Ev], RAcquire e (Drivers e)) + -> ([EvErr], RAcquire e (Drivers e)) drivers env multi who isFake plan shutdownSTM termSys stderr = - (initialEvents, runDrivers) + (initialEvents, runDrivers) -- TODO where (behnBorn, runBehn) = behn env plan (amesBorn, runAmes) = ames env who isFake plan stderr diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index 1b402a0e1..5bc194ae8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -7,6 +7,7 @@ module Urbit.Vere.Pier.Types where import Urbit.Prelude hiding (Term) +import Urbit.Noun (Term) import Urbit.Arvo import Urbit.Time @@ -27,6 +28,28 @@ instance Show Nock where show _ = "Nock" +-- Events With Error Callbacks ------------------------------------------------- + +type Gang = Maybe (HoonSet Ship) + +type Goof = (Term, [Tank]) + +{-| + Two types of serf failures. + + - `RunSwap`: Event processing failed, but the serf replaced it with + another event which succeeded. + + - `RunBail`: Event processing failed and all attempt to replace it + with a failure-notice event also caused crashes. We are really fucked. +-} +data WorkError + = RunSwap EventId Mug Wen Noun FX + | RunBail [Goof] + +data EvErr = EvErr Ev (WorkError -> IO ()) + + -------------------------------------------------------------------------------- type EventId = Word64 @@ -84,8 +107,6 @@ data Order deriveToNoun ''Order -type QueueEv = Ev -> STM () - type EffCb e a = a -> RIO e () type Perform = Ef -> IO () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 57c04bdda..9609566e0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -22,8 +22,8 @@ import qualified Data.Conduit.Combinators as CC import qualified Urbit.Vere.Log as Log import qualified Urbit.Vere.Serf.IPC as X (Config(..), EvErr(..), Flag(..), - RunReq(..), Serf, run, snapshot, - start, stop) + RunReq(..), Serf, WorkError(..), run, + snapshot, start, stop) -- ort System.ProgressBar -- ort Urbit.King.App (HasStderrLogFunc(..)) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 51fef4fb6..a41174345 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -93,10 +93,6 @@ import qualified Urbit.Time as Time -- IPC Types ------------------------------------------------------------------- -type Gang = Maybe (HoonSet Ship) - -type Goof = (Term, [Tank]) - data Live = LExit Atom -- exit status code | LSave EventId @@ -546,24 +542,6 @@ swim serf = do -- Running Ship Flow ----------------------------------------------------------- -{-| - Two types of serf failures. - - - `RunSwap`: Event processing failed, but the serf replaced it with - another event which succeeded. - - - `RunBail`: Event processing failed and all attempt to replace it - with a failure-notice event also caused crashes. We are really fucked. --} -data WorkError - = RunSwap EventId Mug Wen Noun FX - | RunBail [Goof] - -{- - An event and a callback to inform the IO Driver about failures. --} -data EvErr = EvErr Ev (WorkError -> IO ()) - {- - RRWork: Ask the serf to do work, will output (Fact, FX) if work succeeded and call callback on failure. diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index dca916103..5f66401e8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -491,6 +491,14 @@ localClient doneSignal = fst <$> mkRAcquire start stop -------------------------------------------------------------------------------- +initialBlewFailed :: e -> WorkError -> IO () +initialBlewFailed env _ = runRIO env $ do + pure () -- TODO What do? + +initialHailFailed :: e -> WorkError -> IO () +initialHailFailed env _ = runRIO env $ do + pure () -- TODO What do? + {-| Terminal Driver -} @@ -498,14 +506,17 @@ term :: forall e. (HasPierConfig e, HasLogFunc e, HasKingId e) => e -> (T.TSize, Client) -> (STM ()) - -> QueueEv - -> ([Ev], RAcquire e (EffCb e TermEf)) -term env (tsize, Client{..}) shutdownSTM enqueueEv = + -> (EvErr -> STM ()) + -> ([EvErr], RAcquire e (EffCb e TermEf)) +term env (tsize, Client{..}) shutdownSTM plan = (initialEvents, runTerm) where T.TSize wi hi = tsize - initialEvents = [(initialBlew wi hi), initialHail] + initialEvents = + [ EvErr (initialBlew wi hi) (initialBlewFailed env) + , EvErr initialHail (initialHailFailed env) + ] runTerm :: RAcquire e (EffCb e TermEf) runTerm = do @@ -521,8 +532,9 @@ term env (tsize, Client{..}) shutdownSTM enqueueEv = atomically take >>= \case Nothing -> pure () Just b -> do - let blip = EvBlip $ BlipEvTerm $ TermEvBelt (UD 1, ()) $ b - atomically $ enqueueEv $ blip + let beltEv = EvBlip $ BlipEvTerm $ TermEvBelt (UD 1, ()) $ b + let beltFailed _ = pure () + atomically $ plan (EvErr beltEv beltFailed) handleEffect :: TermEf -> RIO e () handleEffect = \case diff --git a/pkg/hs/urbit-king/test/AmesTests.hs b/pkg/hs/urbit-king/test/AmesTests.hs index 39d217323..d254abe4f 100644 --- a/pkg/hs/urbit-king/test/AmesTests.hs +++ b/pkg/hs/urbit-king/test/AmesTests.hs @@ -73,7 +73,7 @@ runNetworkApp = runRIO NetworkTestApp } runGala - :: forall e . HasAmes e => Word8 -> RAcquire e (TQueue Ev, EffCb e NewtEf) + :: forall e . HasAmes e => Word8 -> RAcquire e (TQueue EvErr, EffCb e NewtEf) runGala point = do env <- ask que <- newTQueueIO @@ -85,14 +85,14 @@ runGala point = do where noStderr _ = pure () -waitForPacket :: TQueue Ev -> Bytes -> IO Bool +waitForPacket :: TQueue EvErr -> Bytes -> IO Bool waitForPacket q val = go where go = atomically (readTQueue q) >>= \case - EvBlip (BlipEvNewt (NewtEvBorn (_, ()) ())) -> go - EvBlip (BlipEvAmes (AmesEvHear () _ bs)) -> pure (bs == val) - _ -> pure False + EvErr (EvBlip (BlipEvNewt (NewtEvBorn (_, ()) ()))) _ -> go + EvErr (EvBlip (BlipEvAmes (AmesEvHear () _ bs))) _ -> pure (bs == val) + _ -> pure False runRAcquire :: RAcquire e a -> RIO e a runRAcquire acq = rwith acq pure From 45f475a17897d509a61343d5220a348f9d1209f5 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Tue, 2 Jun 2020 23:03:04 +0000 Subject: [PATCH 111/257] king: snapshot requests block until event log catches up to serf. --- pkg/hs/urbit-king/TODO.md | 38 +++++++++++++++++-- .../urbit-king/lib/Urbit/King/EventBrowser.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 14 +++---- pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs | 24 ++++++------ pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 8 ++-- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 12 +++++- 7 files changed, 70 insertions(+), 30 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index f9df4267e..62f892e7f 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -12,8 +12,9 @@ Stubbed out: - [x] Bring back tank printing. - [x] Handle serf stderr message correctly. - [x] Bring back `logEvent`. -- [ ] Snapshots should block until that event is commited to disk. -- [ ] Hook up error callbacks to IO Drivers. +- [x] Snapshots should block until that event is commited to disk. +- [x] Hook up error callbacks to IO Drivers. +- [x] Do something useful with error callbacks from IO Drivers. King-Haskell specific features: @@ -36,14 +37,45 @@ Polish: # Misc Bugs -- [ ] Handle ^C in connected terminals. It should interrupt current event. +- [ ] Handle ^C in connected terminals. It should interrupt current + event (send SIGINT to serf, which will cause the current event to + fail promptly). - [ ] The terminal driver seems to have a race condition when spinner changed too quickly. - [ ] King should shutdown promptly on ^C. Always takes 2s in practice. # Cleanup +- [ ] ShutdownSTM action that's passed to the terminal driver should + live in `PierEnv` and should be available to all drivers. - [ ] Break most logic from `Main.hs` out into modules. - [ ] Simplify `Main.hs` flows. - [ ] Cleanup Terminal Driver code. - [ ] Spin off `Urbit.Noun` into it's own package. + +# Event Prioritization + +- Instead of each IO driver being passed a TQueue EvErr, each IO driver + produces a (STM (Maybe RunReq)). + + - Each driver has it's own event queue that feeds this action. + + - Pier has a thread that pulls from these actions with prioritization. + +- Priority: + - If any terminal events are available, send it. + - If serf queue is full, abort transaction and retry. + - If no terminal events are available, do the same thing with sync driver. + - Next, same thing for behn. + - Next, same thing for iris. + - Next, same thing for ames. + - Next, same thing for eyre. + +# Better IO Driver Startup Flow Separation + +Should have a io-driver-boot stage. + +- IO drivers do their boot flows. +- When they're done, they signal that they're running. +- No semantically important communication without outside world can + happen until all drivers are up. diff --git a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs index 389728dcc..020cab13e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs @@ -39,7 +39,7 @@ run log = do hSetEcho stdin False logInfo $ displayShow (Log.identity log) let cycle = fromIntegral $ lifecycleLen $ Log.identity log - las <- Log.lastEv log + las <- atomically (Log.lastEv log) loop cycle las las where failRead cur = diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 107d57bf6..030dfd70a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -113,11 +113,6 @@ import qualified Urbit.Vere.Term as Term -------------------------------------------------------------------------------- -zod :: Ship -zod = 0 - --------------------------------------------------------------------------------- - removeFileIfExists :: HasLogFunc env => FilePath -> RIO env () removeFileIfExists pax = do exists <- doesFileExist pax @@ -222,7 +217,6 @@ tryPlayShip -> MVar () -> MultiEyreApi -> RIO PierEnv () - tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do when fullReplay wipeSnapshot vSlog <- logSlogs @@ -260,7 +254,7 @@ checkEvs pierPath first last = do let pbSty = PB.defStyle { PB.stylePostfix = PB.exact } logTrace (displayShow ident) - last <- Log.lastEv log <&> \lastReal -> min last lastReal + last <- atomically $ Log.lastEv log <&> \lastReal -> min last lastReal let evCount = fromIntegral (last - first) @@ -326,6 +320,7 @@ collectAllFx top = do serfFlags :: [Serf.Flag] serfFlags = [Serf.Hashless, Serf.DryRun] + -------------------------------------------------------------------------------- replayPartEvs :: FilePath -> Word64 -> RIO KingEnv () @@ -368,6 +363,7 @@ replayPartEvs top last = do serfFlags :: [Serf.Flag] serfFlags = [Serf.Hashless] + -------------------------------------------------------------------------------- {-| @@ -385,7 +381,7 @@ testPill pax showPil showSeq = do pill <- fromNounErr pillNoun & either (throwIO . uncurry ParseErr) pure logTrace "Using pill to generate boot sequence." - bootSeq <- generateBootSeq zod pill False (Fake $ Ship 0) + bootSeq <- generateBootSeq (Ship 0) pill False (Fake $ Ship 0) logTrace "Validate jam/cue and toNoun/fromNoun on pill value" reJam <- validateNounVal pill @@ -431,6 +427,7 @@ validateNounVal inpVal = do pure outByt + -------------------------------------------------------------------------------- pillFrom :: CLI.PillSource -> RIO KingEnv Pill @@ -679,6 +676,7 @@ runShips CLI.KingOpts {..} ships = do -- a king-wide option. } + {- TODO Need to rework RIO environment to fix this. Should have a bunch of nested contexts: diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs index 62dc7fe1d..244074678 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs @@ -39,14 +39,14 @@ data EventLog = EventLog , eventsTbl :: Dbi , effectsTbl :: Dbi , identity :: LogIdentity - , numEvents :: IORef EventId + , numEvents :: TVar EventId } -nextEv :: EventLog -> RIO e EventId -nextEv = fmap succ . readIORef . numEvents +nextEv :: EventLog -> STM EventId +nextEv = fmap (+1) . lastEv -lastEv :: EventLog -> RIO e EventId -lastEv = readIORef . numEvents +lastEv :: EventLog -> STM EventId +lastEv = readTVar . numEvents data EventLogExn = NoLogIdentity @@ -82,7 +82,7 @@ create dir id = do (m, e, f) <- createTables env clearEvents env e writeIdent env m id - EventLog env m e f id <$> newIORef 0 + EventLog env m e f id <$> newTVarIO 0 where createTables env = rwith (writeTxn env) $ \txn -> io $ @@ -98,7 +98,7 @@ open dir = do id <- getIdent env m logDebug $ display (pack @Text $ "Log Identity: " <> show id) numEvs <- getNumEvents env e - EventLog env m e f id <$> newIORef numEvs + EventLog env m e f id <$> newTVarIO numEvs where openTables env = rwith (writeTxn env) $ \txn -> io $ @@ -227,10 +227,10 @@ clearEvents env eventsTbl = appendEvents :: EventLog -> Vector ByteString -> RIO e () appendEvents log !events = do - numEvs <- readIORef (numEvents log) + numEvs <- atomically $ readTVar (numEvents log) next <- pure (numEvs + 1) doAppend $ zip [next..] $ toList events - writeIORef (numEvents log) (numEvs + word (length events)) + atomically $ writeTVar (numEvents log) (numEvs + word (length events)) where flags = compileWriteFlags [MDB_NOOVERWRITE] doAppend = \kvs -> @@ -254,7 +254,7 @@ writeEffectsRow log k v = do trimEvents :: HasLogFunc e => EventLog -> Word64 -> RIO e () trimEvents log start = do - last <- lastEv log + last <- atomically (lastEv log) rwith (writeTxn $ env log) $ \txn -> for_ [start..last] $ \eId -> withWordPtr eId $ \pKey -> do @@ -262,7 +262,7 @@ trimEvents log start = do found <- io $ mdb_del txn (eventsTbl log) key Nothing unless found $ throwIO (MissingEvent eId) - writeIORef (numEvents log) (pred start) + atomically $ writeTVar (numEvents log) (pred start) streamEvents :: HasLogFunc e => EventLog -> Word64 @@ -294,7 +294,7 @@ readBatch :: EventLog -> Word64 -> RIO e (V.Vector ByteString) readBatch log first = start where start = do - last <- lastEv log + last <- atomically (lastEv log) if (first > last) then pure mempty else readRows $ fromIntegral $ min 1000 $ ((last+1) - first) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index cbf8eb8be..7c35d8278 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -83,7 +83,7 @@ generateBootSeq ship Pill {..} lite boot = do writeJobs :: EventLog -> Vector Job -> RIO e () writeJobs log !jobs = do - expect <- Log.nextEv log + expect <- atomically (Log.nextEv log) events <- fmap fromList $ traverse fromJob (zip [expect ..] $ toList jobs) Log.appendEvents log events where @@ -299,6 +299,7 @@ pier (serf, log) vSlog mStart multi = do , ccPutResult = writeTQueue persistQ , ccShowSpinner = Term.spin muxed , ccHideSpinner = Term.stopSpin muxed + , ccLastEvInLog = Log.lastEv log } tExe <- startDrivers >>= acquireWorker . router (readTQueue executeQ) @@ -427,6 +428,7 @@ data ComputeConfig = ComputeConfig , ccPutResult :: (Fact, FX) -> STM () , ccShowSpinner :: Maybe Text -> STM () , ccHideSpinner :: STM () + , ccLastEvInLog :: STM EventId } runCompute :: forall e . HasKingEnv e => Serf.Serf -> ComputeConfig -> RIO e () @@ -450,7 +452,7 @@ runCompute serf ComputeConfig {..} = do let maxBatchSize = 10 - io (Serf.run serf maxBatchSize onCR ccPutResult onSpin) + io (Serf.run serf maxBatchSize ccLastEvInLog onCR ccPutResult onSpin) -- Persist Thread -------------------------------------------------------------- @@ -483,7 +485,7 @@ runPersist log inpQ out = do where validateFactsAndGetBytes :: [Fact] -> RIO e (Vector ByteString) validateFactsAndGetBytes facts = do - expect <- Log.nextEv log + expect <- atomically (Log.nextEv log) lis <- for (zip [expect ..] facts) $ \(expectedId, Fact eve mug wen non) -> do unless (expectedId == eve) $ do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 9609566e0..014d1b1aa 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -95,7 +95,7 @@ execReplay serf log last = do Just lt -> logTrace $ display $ "User requested to replay up to event #" <> tshow lt - logLastEv :: Word64 <- fromIntegral <$> Log.lastEv log + logLastEv :: Word64 <- atomically $ fromIntegral <$> Log.lastEv log logTrace $ display $ "Last event in event log is #" <> tshow logLastEv diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index a41174345..d08033a09 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -560,11 +560,12 @@ data RunReq run :: Serf -> Int + -> STM EventId -> STM RunReq -> ((Fact, FX) -> STM ()) -> (Maybe Ev -> STM ()) -> IO () -run serf maxBatchSize onInput sendOn spin = topLoop +run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop where topLoop :: IO () topLoop = atomically onInput >>= \case @@ -577,8 +578,15 @@ run serf maxBatchSize onInput sendOn spin = topLoop doPack :: IO () doPack = compact serf >> topLoop + waitForLog :: IO () + waitForLog = do + serfLast <- serfLastEventBlocking serf + atomically $ do + logLast <- getLastEvInLog + when (logLast < serfLast) retry + doSave :: IO () - doSave = snapshot serf >> topLoop + doSave = waitForLog >> snapshot serf >> topLoop doScry :: Wen -> Gang -> Path -> (Maybe (Term, Noun) -> IO ()) -> IO () doScry w g p k = (scry serf w g p >>= k) >> topLoop From 5748da9f8d7e1cca0d9e16fa81392b2911dd3edc Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 3 Jun 2020 00:28:31 +0000 Subject: [PATCH 112/257] king: TODO.md cleanup. --- pkg/hs/urbit-king/TODO.md | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 62f892e7f..692638ce7 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -1,4 +1,4 @@ -# New IPC +# New IPC Protocol Stubbed out: @@ -19,7 +19,7 @@ Stubbed out: King-Haskell specific features: - [x] Re-implement `collectFX` flow in Serf/Pier. -- [ ] Hook up `collectFX` to CLI. +- [x] Hook up `collectFX` to CLI. - [ ] Test new `collectFX` flow Performance: @@ -31,18 +31,19 @@ Polish: - [x] Cleanup batching flow. - [x] Think through how to shutdown the serf on exception. +- [ ] King should shutdown promptly on ^C. Always takes 2s in practice. - [ ] Logging for new IPC flow. - [ ] Logging for boot sequence. - [ ] Bring back progress bars. # Misc Bugs +- [ ] `king run --collect-fx` flag does nothing. Remove or implement. - [ ] Handle ^C in connected terminals. It should interrupt current event (send SIGINT to serf, which will cause the current event to fail promptly). - [ ] The terminal driver seems to have a race condition when spinner changed too quickly. -- [ ] King should shutdown promptly on ^C. Always takes 2s in practice. # Cleanup From 3838cf8abbeb0f6eef9dd0710063155d766bcb36 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 4 Jun 2020 21:10:33 +0000 Subject: [PATCH 113/257] ^C brings king/serf down cleanly and promptly. --- pkg/hs/urbit-king/TODO.md | 2 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 107 +++++++++++++----- pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs | 27 +++-- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 41 ++++--- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 26 +++-- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 108 ++++++++++--------- 6 files changed, 196 insertions(+), 115 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 692638ce7..828300e28 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -31,7 +31,7 @@ Polish: - [x] Cleanup batching flow. - [x] Think through how to shutdown the serf on exception. -- [ ] King should shutdown promptly on ^C. Always takes 2s in practice. +- [x] King should shutdown promptly on ^C. Always takes 2s in practice. - [ ] Logging for new IPC flow. - [ ] Logging for boot sequence. - [ ] Bring back progress bars. diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 030dfd70a..a6a570e01 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -179,8 +179,9 @@ tryBootFromPill -> RIO PierEnv () tryBootFromPill oExit pill lite flags ship boot multi = do mStart <- newEmptyMVar + vKill <- newEmptyTMVarIO vSlog <- logSlogs - runOrExitImmediately vSlog (bootedPier vSlog) oExit mStart multi + runOrExitImmediately vSlog (bootedPier vSlog) oExit mStart vKill multi where bootedPier vSlog = do view pierPathL >>= lockFile @@ -194,9 +195,10 @@ runOrExitImmediately -> RAcquire PierEnv (Serf, Log.EventLog) -> Bool -> MVar () + -> TMVar () -> MultiEyreApi -> RIO PierEnv () -runOrExitImmediately vSlog getPier oExit mStart multi = do +runOrExitImmediately vSlog getPier oExit mStart vKill multi = do rwith getPier (if oExit then shutdownImmediately else runPier) where shutdownImmediately :: (Serf, Log.EventLog) -> RIO PierEnv () @@ -207,7 +209,7 @@ runOrExitImmediately vSlog getPier oExit mStart multi = do runPier :: (Serf, Log.EventLog) -> RIO PierEnv () runPier serfLog = do - runRAcquire (Pier.pier serfLog vSlog mStart multi) + runRAcquire (Pier.pier serfLog vSlog mStart vKill multi) tryPlayShip :: Bool @@ -215,12 +217,13 @@ tryPlayShip -> Maybe Word64 -> [Serf.Flag] -> MVar () + -> TMVar () -> MultiEyreApi -> RIO PierEnv () -tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do +tryPlayShip exitImmediately fullReplay playFrom flags mStart vKill multi = do when fullReplay wipeSnapshot vSlog <- logSlogs - runOrExitImmediately vSlog (resumeShip vSlog) exitImmediately mStart multi + runOrExitImmediately vSlog (resumeShip vSlog) exitImmediately mStart vKill multi where wipeSnapshot = do shipPath <- view pierPathL @@ -315,7 +318,7 @@ collectAllFx top = do lockFile top log <- Log.existing (top <> "/.urb/log") serf <- Pier.runSerf vSlog tmpDir serfFlags - rio $ error "Serf.collectFX" serf log + rio $ Serf.collectFX serf log serfFlags :: [Serf.Flag] serfFlags = [Serf.Hashless, Serf.DryRun] @@ -535,8 +538,8 @@ newShip CLI.New{..} opts = do tryBootFromPill True pill nLite flags ship bootEvent multi ------ tryBootFromPill (CLI.oExit opts) pill nLite flags ship bootEvent -runShip :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO KingEnv () -runShip (CLI.Run pierPath) opts daemon multi = do +runShip :: CLI.Run -> CLI.Opts -> Bool -> TMVar () -> MultiEyreApi -> RIO KingEnv () +runShip (CLI.Run pierPath) opts daemon vKill multi = do tid <- io myThreadId let onTermExit = throwTo tid UserInterrupt mStart <- newEmptyMVar @@ -556,6 +559,7 @@ runShip (CLI.Run pierPath) opts daemon multi = do (CLI.oDryFrom opts) (toSerfFlags opts) mStart + vKill multi pierConfig = toPierConfig pierPath opts networkConfig = toNetworkConfig opts @@ -643,15 +647,15 @@ main = do TODO Use logging system instead of printing. -} runShipRestarting - :: STM () -> CLI.Run -> CLI.Opts -> MultiEyreApi -> RIO KingEnv () -runShipRestarting waitForKillRequ r o multi = do + :: TMVar () -> CLI.Run -> CLI.Opts -> MultiEyreApi -> RIO KingEnv () +runShipRestarting vKill r o multi = do let pier = pack (CLI.rPierPath r) - loop = runShipRestarting waitForKillRequ r o multi + loop = runShipRestarting vKill r o multi - tid <- asyncBound (runShip r o True multi) + tid <- asyncBound (runShip r o True vKill multi) let onShipExit = Left <$> waitCatchSTM tid - onKillRequ = Right <$> waitForKillRequ + onKillRequ = Right <$> readTMVar vKill atomically (onShipExit <|> onKillRequ) >>= \case Left exit -> do @@ -662,10 +666,37 @@ runShipRestarting waitForKillRequ r o multi = do threadDelay 250_000 loop Right () -> do - logTrace $ display ("King Shutdown requested. Killing: " <> pier) - cancel tid + logTrace $ display (pier <> " shutdown requested") + race_ (wait tid) $ do + threadDelay 5_000_000 + logTrace $ display (pier <> " not down after 5s, killing with fire.") + cancel tid logTrace $ display ("Ship terminated: " <> pier) +{- + TODO This is messy and shared a lot of logic with `runShipRestarting`. +-} +runShipNoRestart :: TMVar () -> CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO KingEnv () +runShipNoRestart vKill r o d multi = do + tid <- asyncBound (runShip r o d vKill multi) + + let pier = pack (CLI.rPierPath r) + + let onShipExit = Left <$> waitCatchSTM tid + onKillRequ = Right <$> readTMVar vKill + + atomically (onShipExit <|> onKillRequ) >>= \case + Left (Left err) -> do + logError $ display (tshow err <> ": " <> pier) + Left (Right ()) -> do + logError $ display (pier <> " exited on it's own. Why?") + Right () -> do + logTrace $ display (pier <> " shutdown requested") + race_ (wait tid) $ do + threadDelay 5_000_000 + logTrace $ display (pier <> " not down after 5s, killing with fire.") + cancel tid + logTrace $ display (pier <> " terminated.") runShips :: CLI.KingOpts -> [(CLI.Run, CLI.Opts, Bool)] -> RIO KingEnv () runShips CLI.KingOpts {..} ships = do @@ -690,19 +721,19 @@ runShips CLI.KingOpts {..} ships = do go multi ships where + go :: MultiEyreApi -> [(CLI.Run, CLI.Opts, Bool)] -> RIO KingEnv () go me = \case - [] -> pure () - [(r, o, d)] -> runShip r o d me - ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) me + [] -> pure () + [rod] -> runSingleShip rod me + ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) me -runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> RIO KingEnv () -runMultipleShips ships multi = do - killSignal <- newEmptyTMVarIO - let waitForKillRequ = readTMVar killSignal +-- TODO Duplicated logic. +runSingleShip :: (CLI.Run, CLI.Opts, Bool) -> MultiEyreApi -> RIO KingEnv () +runSingleShip (r, o, d) multi = do + vKill <- newEmptyTMVarIO - shipThreads <- for ships $ \(r, o) -> do - async (runShipRestarting waitForKillRequ r o multi) + shipThread <- async (runShipNoRestart vKill r o d multi) {- Since `spin` never returns, this will run until the main @@ -710,14 +741,38 @@ runMultipleShips ships multi = do `UserInterrupt` which will be raised on this thread upon SIGKILL or SIGTERM. - Once that happens, we write to `killSignal` which will cause + Once that happens, we write to `vKill` which will cause all ships to be shut down, and then we `wait` for them to finish before returning. -} let spin = forever (threadDelay maxBound) finally spin $ do logTrace "KING IS GOING DOWN" - atomically (putTMVar killSignal ()) + atomically (putTMVar vKill ()) + waitCatch shipThread + + +runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> RIO KingEnv () +runMultipleShips ships multi = do + vKill <- newEmptyTMVarIO + + shipThreads <- for ships $ \(r, o) -> do + async (runShipRestarting vKill r o multi) + + {- + Since `spin` never returns, this will run until the main + thread is killed with an async exception. The one we expect is + `UserInterrupt` which will be raised on this thread upon SIGKILL + or SIGTERM. + + Once that happens, we write to `vKill` which will cause + all ships to be shut down, and then we `wait` for them to finish + before returning. + -} + let spin = forever (threadDelay maxBound) + finally spin $ do + logTrace "KING IS GOING DOWN" + atomically (putTMVar vKill ()) for_ shipThreads waitCatch diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs index 244074678..5239dbeb7 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs @@ -240,14 +240,13 @@ appendEvents log !events = do True -> pure () False -> throwIO (BadWriteEvent k) -writeEffectsRow :: EventLog -> EventId -> ByteString -> RIO e () -writeEffectsRow log k v = do - rwith (writeTxn $ env log) $ \txn -> - putBytes flags txn (effectsTbl log) k v >>= \case - True -> pure () - False -> throwIO (BadWriteEffect k) - where - flags = compileWriteFlags [] +writeEffectsRow :: MonadIO m => EventLog -> EventId -> ByteString -> m () +writeEffectsRow log k v = io $ runRIO () $ do + let flags = compileWriteFlags [] + rwith (writeTxn $ env log) $ \txn -> + putBytes flags txn (effectsTbl log) k v >>= \case + True -> pure () + False -> throwIO (BadWriteEffect k) -- Read Events ----------------------------------------------------------------- @@ -264,14 +263,12 @@ trimEvents log start = do throwIO (MissingEvent eId) atomically $ writeTVar (numEvents log) (pred start) -streamEvents :: HasLogFunc e - => EventLog -> Word64 - -> ConduitT () ByteString (RIO e) () +streamEvents :: MonadIO m => EventLog -> Word64 -> ConduitT () ByteString m () streamEvents log first = do - batch <- lift $ readBatch log first - unless (null batch) $ do - for_ batch yield - streamEvents log (first + word (length batch)) + batch <- io $ runRIO () $ readBatch log first + unless (null batch) $ do + for_ batch yield + streamEvents log (first + word (length batch)) streamEffectsRows :: ∀e. HasLogFunc e => EventLog -> EventId diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 7c35d8278..cf23d766d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -218,24 +218,34 @@ getSnapshot top last = do -- Run Pier -------------------------------------------------------------------- -acquireWorker :: RIO e () -> RAcquire e (Async ()) -acquireWorker act = mkRAcquire (async act) cancel +acquireWorker :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) +acquireWorker nam act = mkRAcquire (async act) kill + where + kill tid = do + logTrace ("Killing worker thread: " <> display nam) + cancel tid + logTrace ("Killed worker thread: " <> display nam) -acquireWorkerBound :: RIO e () -> RAcquire e (Async ()) -acquireWorkerBound act = mkRAcquire (asyncBound act) cancel +acquireWorkerBound :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) +acquireWorkerBound nam act = mkRAcquire (asyncBound act) kill + where + kill tid = do + logTrace ("Killing worker thread: " <> display nam) + cancel tid + logTrace ("Killed worker thread: " <> display nam) pier :: (Serf, EventLog) -> TVar (Text -> IO ()) -> MVar () + -> TMVar () -> MultiEyreApi -> RAcquire PierEnv () -pier (serf, log) vSlog mStart multi = do +pier (serf, log) vSlog mStart vKilled multi = do computeQ <- newTQueueIO @_ @Serf.EvErr persistQ <- newTQueueIO executeQ <- newTQueueIO saveM <- newEmptyTMVarIO - shutdownM <- newEmptyTMVarIO kapi <- King.kingAPI @@ -244,7 +254,7 @@ pier (serf, log) vSlog mStart multi = do writeTVar (King.kTermConn kapi) (Just $ writeTQueue q) pure q - let shutdownEvent = putTMVar shutdownM () + let shutdownEvent = void (tryPutTMVar vKilled ()) -- (sz, local) <- Term.localClient @@ -258,7 +268,7 @@ pier (serf, log) vSlog mStart multi = do -- rio $ logInfo $ display $ -- "TERMSERV Terminal Server running on port: " <> tshow termServPort - acquireWorker $ forever $ do + acquireWorker "TERMINAL" $ forever $ do logTrace "TERMSERV Waiting for external terminal." atomically $ do ext <- Term.connClient <$> readTQueue termApiQ @@ -294,7 +304,7 @@ pier (serf, log) vSlog mStart multi = do let computeConfig = ComputeConfig { ccOnWork = readTQueue computeQ - , ccOnKill = takeTMVar shutdownM + , ccOnKill = readTMVar vKilled , ccOnSave = takeTMVar saveM , ccPutResult = writeTQueue persistQ , ccShowSpinner = Term.spin muxed @@ -302,9 +312,12 @@ pier (serf, log) vSlog mStart multi = do , ccLastEvInLog = Log.lastEv log } - tExe <- startDrivers >>= acquireWorker . router (readTQueue executeQ) - tDisk <- acquireWorkerBound (runPersist log persistQ (writeTQueue executeQ)) - tCpu <- acquireWorker (runCompute serf computeConfig) + let plan = writeTQueue executeQ + + drivz <- startDrivers + tExec <- acquireWorker "Effects" (router (readTQueue executeQ) drivz) + tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ plan) + tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) tSaveSignal <- saveSignalThread saveM @@ -312,9 +325,9 @@ pier (serf, log) vSlog mStart multi = do -- Wait for something to die. - let ded = asum [ death "effect thread" tExe + let ded = asum [ death "effects thread" tExec , death "persist thread" tDisk - , death "compute thread" tCpu + , death "compute thread" tSerf ] atomically ded >>= \case diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 014d1b1aa..3240f5fd5 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -16,7 +16,8 @@ import Data.Conduit import Urbit.Vere.Pier.Types import Urbit.Vere.Serf.IPC -import Urbit.Arvo (FX) +import Control.Monad.Trans.Resource (runResourceT) +import Urbit.Arvo (FX) import qualified Data.Conduit.Combinators as CC import qualified Urbit.Vere.Log as Log @@ -109,10 +110,12 @@ execReplay serf log last = do logTrace $ display $ "Replaying up to event #" <> tshow replayUpTo logTrace $ display $ "Will replay " <> tshow numEvs <> " in total." - runConduit $ Log.streamEvents log (lastEventInSnap + 1) - .| CC.take (fromIntegral numEvs) - .| CC.mapM (fmap snd . parseLogRow) - .| replay 10 serf + runResourceT + $ runConduit + $ Log.streamEvents log (lastEventInSnap + 1) + .| CC.take (fromIntegral numEvs) + .| CC.mapM (fmap snd . parseLogRow) + .| replay 10 serf -- Collect FX ------------------------------------------------------------------ @@ -120,12 +123,13 @@ execReplay serf log last = do collectFX :: HasLogFunc e => Serf -> Log.EventLog -> RIO e () collectFX serf log = do lastEv <- io (serfLastEventBlocking serf) - runConduit + runResourceT + $ runConduit $ Log.streamEvents log (lastEv + 1) .| CC.mapM (parseLogRow >=> fromNounExn . snd) .| swim serf - .| persistFX - where - persistFX :: ConduitT (EventId, FX) Void (RIO e) () - persistFX = CC.mapM_ $ \(eId, fx) -> do - Log.writeEffectsRow log eId $ jamBS $ toNoun fx + .| persistFX log + +persistFX :: MonadIO m => Log.EventLog -> ConduitT (EventId, FX) Void m () +persistFX log = CC.mapM_ $ \(eId, fx) -> do + Log.writeEffectsRow log eId $ jamBS $ toNoun fx diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index d08033a09..8b9d83089 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -76,14 +76,15 @@ import System.Process import Urbit.Arvo import Urbit.Vere.Pier.Types hiding (Work) -import Control.Monad.STM (retry) -import Data.Sequence (Seq((:<|), (:|>))) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Ptr (castPtr) -import Foreign.Storable (peek, poke) -import RIO.Prelude (decodeUtf8Lenient) -import System.Posix.Signals (sigKILL, signalProcess) -import Urbit.Time (Wen) +import Control.Monad.STM (retry) +import Control.Monad.Trans.Resource (MonadResource, allocate, runResourceT) +import Data.Sequence (Seq((:<|), (:|>))) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr (castPtr) +import Foreign.Storable (peek, poke) +import RIO.Prelude (decodeUtf8Lenient) +import System.Posix.Signals (sigKILL, signalProcess) +import Urbit.Time (Wen) import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS @@ -130,7 +131,7 @@ data SerfState = SerfState { ssLast :: EventId , ssHash :: Mug } - deriving (Show) + deriving (Show, Eq) data SerfInfo = SerfInfo { siRipe :: RipeInfo @@ -166,7 +167,7 @@ data Serf = Serf , serfRecv :: Handle , serfProc :: ProcessHandle , serfSlog :: Slog -> IO () - , serfLock :: MVar (Either SomeException SerfState) + , serfLock :: MVar (Maybe SerfState) } data Flag @@ -201,14 +202,15 @@ data SerfExn | SerfHasShutdown | BailDuringReplay EventId [Goof] | SwapDuringReplay EventId Mug (Wen, Noun) FX + | SerfNotRunning deriving (Show, Exception) -- Access Current Serf State --------------------------------------------------- serfLastEventBlocking :: Serf -> IO EventId serfLastEventBlocking Serf{serfLock} = readMVar serfLock >>= \case - Left err -> throwIO err - Right ss -> pure (ssLast ss) + Nothing -> throwIO SerfNotRunning + Just ss -> pure (ssLast ss) -- Low Level IPC Functions ----------------------------------------------------- @@ -347,7 +349,7 @@ start (Config exePax pierPath flags onSlog onStdr onDead) = do vLock <- newEmptyMVar let serf = Serf i o p onSlog vLock info <- recvRipe serf - putMVar vLock (Right $ siStat info) + putMVar vLock (Just $ siStat info) pure (serf, info) where diskKey = "" @@ -361,27 +363,32 @@ start (Config exePax pierPath flags onSlog onStdr onDead) = do -- Taking the SerfState Lock --------------------------------------------------- -withSerfLock - :: MonadIO m - => (m (SerfState, a) -> m (Either SomeException (SerfState, a))) - -> Serf - -> (SerfState -> m (SerfState, a)) - -> m a -withSerfLock tryGen s f = do - ss <- takeLock - tryGen (f ss) >>= \case - Left e -> do - io (forcefullyKillSerf s) - putMVar (serfLock s) (Left e) - throwIO e - Right (ss', x) -> do - putMVar (serfLock s) (Right ss') - pure x +takeLock :: MonadIO m => Serf -> m SerfState +takeLock serf = io $ do + takeMVar (serfLock serf) >>= \case + Nothing -> putMVar (serfLock serf) Nothing >> throwIO SerfNotRunning + Just ss -> pure ss + +serfLockTaken + :: MonadResource m => Serf -> m (IORef (Maybe SerfState), SerfState) +serfLockTaken serf = snd <$> allocate take release where - takeLock = do - takeMVar (serfLock s) >>= \case - Left exn -> putMVar (serfLock s) (Left exn) >> throwIO exn - Right ss -> pure ss + take = (,) <$> newIORef Nothing <*> takeLock serf + release (rv, _) = do + mRes <- readIORef rv + when (mRes == Nothing) (forcefullyKillSerf serf) + putMVar (serfLock serf) mRes + +withSerfLock + :: MonadResource m => Serf -> (SerfState -> m (SerfState, a)) -> m a +withSerfLock serf act = do + (vState , initialState) <- serfLockTaken serf + (newState, result ) <- act initialState + writeIORef vState (Just newState) + pure result + +withSerfLockIO :: Serf -> (SerfState -> IO (SerfState, a)) -> IO a +withSerfLockIO s a = runResourceT (withSerfLock s (io . a)) -- Flows for Interacting with the Serf ----------------------------------------- @@ -390,7 +397,7 @@ withSerfLock tryGen s f = do Ask the serf to write a snapshot to disk. -} snapshot :: Serf -> IO () -snapshot serf = withSerfLock try serf $ \ss -> do +snapshot serf = withSerfLockIO serf $ \ss -> do sendSnapshotRequest serf (ssLast ss) pure (ss, ()) @@ -398,7 +405,7 @@ snapshot serf = withSerfLock try serf $ \ss -> do Ask the serf to de-duplicate and de-fragment it's heap. -} compact :: Serf -> IO () -compact serf = withSerfLock try serf $ \ss -> do +compact serf = withSerfLockIO serf $ \ss -> do sendCompactionRequest serf (ssLast ss) pure (ss, ()) @@ -406,7 +413,7 @@ compact serf = withSerfLock try serf $ \ss -> do Peek into the serf state. -} scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) -scry serf w g p = withSerfLock try serf $ \ss -> do +scry serf w g p = withSerfLockIO serf $ \ss -> do (ss,) <$> sendScryRequest serf w g p {-| @@ -457,7 +464,7 @@ forcefullyKillSerf serf = do -} boot :: Serf -> [Noun] -> IO (Maybe PlayBail) boot serf@Serf {..} seq = do - withSerfLock try serf $ \ss -> do + withSerfLockIO serf $ \ss -> do recvPlay serf >>= \case PBail bail -> pure (ss, Just bail) PDone mug -> pure (SerfState (fromIntegral $ length seq) mug, Nothing) @@ -472,12 +479,12 @@ boot serf@Serf {..} seq = do -} replay :: forall m - . (MonadUnliftIO m, MonadIO m) + . (MonadResource m, MonadUnliftIO m, MonadIO m) => Int -> Serf -> ConduitT Noun Void m (Maybe PlayBail) replay batchSize serf = do - withSerfLock tryC serf $ \ss -> do + withSerfLock serf $ \ss -> do (r, ss') <- loop ss pure (ss', r) where @@ -516,14 +523,17 @@ awaitBatch = go [] -} swim :: forall m - . (MonadIO m, MonadUnliftIO m) + . (MonadIO m, MonadUnliftIO m, MonadResource m) => Serf -> ConduitT (Wen, Ev) (EventId, FX) m () swim serf = do - withSerfLock tryC serf $ \SerfState {..} -> do + withSerfLock serf $ \SerfState {..} -> do (, ()) <$> loop ssHash ssLast where - loop :: Mug -> EventId -> ConduitT (Wen, Ev) (EventId, FX) m SerfState + loop + :: Mug + -> EventId + -> ConduitT (Wen, Ev) (EventId, FX) m SerfState loop mug eve = await >>= \case Nothing -> do pure (SerfState eve mug) @@ -596,9 +606,10 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop que <- newTBMQueueIO 1 () <- atomically (writeTBMQueue que firstWorkErr) tWork <- async (processWork serf maxBatchSize que onWorkResp spin) - nexSt <- workLoop que - wait tWork - nexSt + flip onException (print "KILLING: run" >> cancel tWork) $ do + nexSt <- workLoop que + wait tWork + nexSt workLoop :: TBMQueue EvErr -> IO (IO ()) workLoop que = atomically onInput >>= \case @@ -665,8 +676,9 @@ processWork serf maxSize q onResp spin = do vDoneFlag <- newTVarIO False vInFlightQueue <- newTVarIO empty recvThread <- async (recvLoop serf vDoneFlag vInFlightQueue) - loop vInFlightQueue vDoneFlag - wait recvThread + flip onException (print "KILLING: processWork" >> cancel recvThread) $ do + loop vInFlightQueue vDoneFlag + wait recvThread where loop :: TVar (Seq (Ev, Work -> IO ())) -> TVar Bool -> IO () loop vInFlight vDone = do @@ -712,7 +724,7 @@ processWork serf maxSize q onResp spin = do -} recvLoop :: Serf -> TVar Bool -> TVar (Seq (Ev, Work -> IO ())) -> IO () recvLoop serf vDone vWork = do - withSerfLock try serf \SerfState {..} -> do + withSerfLockIO serf \SerfState {..} -> do loop ssLast ssHash where loop eve mug = do From 54acebb0c5a498db6dd72403cef3244f81a43f98 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 4 Jun 2020 23:49:56 +0000 Subject: [PATCH 114/257] Got bulshit scry working and hooked up replay progress callback. --- pkg/hs/urbit-king/TODO.md | 3 +- .../urbit-king/lib/Urbit/Noun/Conversions.hs | 1 + pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 51 +++++++++++++++++-- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 4 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 4 +- 5 files changed, 57 insertions(+), 6 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 828300e28..cc8a61a37 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -15,12 +15,13 @@ Stubbed out: - [x] Snapshots should block until that event is commited to disk. - [x] Hook up error callbacks to IO Drivers. - [x] Do something useful with error callbacks from IO Drivers. +- [ ] Make sure replay progress bars go to stderr. King-Haskell specific features: - [x] Re-implement `collectFX` flow in Serf/Pier. - [x] Hook up `collectFX` to CLI. -- [ ] Test new `collectFX` flow +- [ ] Get `collect-all-fx` flow working again. Performance: diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs b/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs index 77fe234d7..6a8b5fddf 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs @@ -713,6 +713,7 @@ instance (FromNoun a, FromNoun b) => FromNoun (Each a b) where 1 -> named "|" (EachNo <$> parseNoun v) n -> fail ("Each has invalid head-atom: " <> show n) + -- Tuple Conversions ----------------------------------------------------------- instance ToNoun () where diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index cf23d766d..8d3b86fdb 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -24,9 +24,14 @@ import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Pier.Types +import Data.Bits (shiftR) import Data.Text (append) +import Data.Time.Clock (DiffTime) +import Data.Time.Clock.System (systemToUTCTime) +import Data.Time.LocalTime (TimeOfDay(..), timeToTimeOfDay) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) +import Urbit.Time (Wen) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -37,6 +42,7 @@ import Urbit.Vere.Log (EventLog) import Urbit.Vere.Serf (Serf) import qualified System.Entropy as Ent +import qualified Urbit.Atom.Fast as Atom import qualified Urbit.King.API as King import qualified Urbit.Time as Time import qualified Urbit.Vere.Log as Log @@ -302,10 +308,13 @@ pier (serf, log) vSlog mStart vKilled multi = do io $ atomically $ for_ bootEvents (writeTQueue computeQ) + scryM <- newEmptyTMVarIO + let computeConfig = ComputeConfig { ccOnWork = readTQueue computeQ , ccOnKill = readTMVar vKilled , ccOnSave = takeTMVar saveM + , ccOnScry = takeTMVar scryM , ccPutResult = writeTQueue persistQ , ccShowSpinner = Term.spin muxed , ccHideSpinner = Term.stopSpin muxed @@ -321,6 +330,14 @@ pier (serf, log) vSlog mStart vKilled multi = do tSaveSignal <- saveSignalThread saveM + -- bullshit scry tester + void $ acquireWorker "bullshit scry tester" $ forever $ do + threadDelay 1_000_000 + wen <- io Time.now + let cb mTermNoun = print ("scry result: ", mTermNoun) + let pax = Path ["j", "~zod", "life", MkKnot $ pack $ showDate wen, "~zod"] + atomically $ putTMVar scryM (wen, Nothing, pax, cb) + putMVar mStart () -- Wait for something to die. @@ -438,6 +455,7 @@ data ComputeConfig = ComputeConfig { ccOnWork :: STM Serf.EvErr , ccOnKill :: STM () , ccOnSave :: STM () + , ccOnScry :: STM (Wen, Gang, Path, Maybe (Term, Noun) -> IO ()) , ccPutResult :: (Fact, FX) -> STM () , ccShowSpinner :: Maybe Text -> STM () , ccHideSpinner :: STM () @@ -448,9 +466,10 @@ runCompute :: forall e . HasKingEnv e => Serf.Serf -> ComputeConfig -> RIO e () runCompute serf ComputeConfig {..} = do logTrace "runCompute" - let onCR = asum [ Serf.RRKill <$> ccOnKill - , Serf.RRSave <$> ccOnSave - , Serf.RRWork <$> ccOnWork + let onCR = asum [ ccOnKill <&> Serf.RRKill + , ccOnSave <&> Serf.RRSave + , ccOnWork <&> Serf.RRWork + , ccOnScry <&> \(w,g,p,k) -> Serf.RRScry w g p k ] vEvProcessing :: TMVar Ev <- newEmptyTMVarIO @@ -512,3 +531,29 @@ runPersist log inpQ out = do go acc = tryReadTQueue inpQ >>= \case Nothing -> pure (reverse acc) Just item -> go (item <| acc) + +-- "~YYYY.MM.DD..HH.MM.SS..FRACTO" +showDate :: Wen -> String +showDate w = do + if fs == 0 + then printf "~%i.%u.%u..%02u.%02u.%02u" y m d h min s + else printf "~%i.%u.%u..%02u.%02u.%02u..%s" y m d h min s (showGap fs) + where + (y, m, d) = toGregorian (utctDay utc) + (h, min, s) = diffTimeSplit (utctDayTime utc) + fs = fromIntegral (Time._fractoSecs (Time._sinceUrbitEpoch w)) :: Word + utc = w ^. Time.systemTime . to systemToUTCTime + +showGap :: Word -> String +showGap gap = intercalate "." (printf "%04x" <$> bs) + where + bs = reverse $ dropWhile (== 0) [b4, b3, b2, b1] + b4 = Atom.takeBitsWord 16 gap + b3 = Atom.takeBitsWord 16 (shiftR gap 16) + b2 = Atom.takeBitsWord 16 (shiftR gap 32) + b1 = Atom.takeBitsWord 16 (shiftR gap 48) + +diffTimeSplit :: DiffTime -> (Int, Int, Int) +diffTimeSplit dt = (hours, mins, floor secs) + where + TimeOfDay hours mins secs = timeToTimeOfDay dt diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 3240f5fd5..f205eeb7b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -110,12 +110,14 @@ execReplay serf log last = do logTrace $ display $ "Replaying up to event #" <> tshow replayUpTo logTrace $ display $ "Will replay " <> tshow numEvs <> " in total." + let onProgress n = print ("Serf is at event# " <> tshow n) + runResourceT $ runConduit $ Log.streamEvents log (lastEventInSnap + 1) .| CC.take (fromIntegral numEvs) .| CC.mapM (fmap snd . parseLogRow) - .| replay 10 serf + .| replay 10 onProgress serf -- Collect FX ------------------------------------------------------------------ diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 8b9d83089..fe7914c48 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -481,15 +481,17 @@ replay :: forall m . (MonadResource m, MonadUnliftIO m, MonadIO m) => Int + -> (EventId -> IO ()) -> Serf -> ConduitT Noun Void m (Maybe PlayBail) -replay batchSize serf = do +replay batchSize cb serf = do withSerfLock serf $ \ss -> do (r, ss') <- loop ss pure (ss', r) where loop :: SerfState -> ConduitT Noun Void m (Maybe PlayBail, SerfState) loop ss@(SerfState lastEve lastMug) = do + io (cb lastEve) awaitBatch batchSize >>= \case [] -> pure (Nothing, SerfState lastEve lastMug) evs -> do From 45d7ac6150955203c170da49d993693db9a41946 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Fri, 5 Jun 2020 16:19:08 +0000 Subject: [PATCH 115/257] king: Cleanup date serialization and move to Urbit.Time. --- pkg/hs/urbit-king/TODO.md | 22 ++++++++++++ pkg/hs/urbit-king/lib/Urbit/Time.hs | 46 ++++++++++++++++++++++-- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 38 +++----------------- 3 files changed, 69 insertions(+), 37 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index cc8a61a37..a99928319 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -17,6 +17,10 @@ Stubbed out: - [x] Do something useful with error callbacks from IO Drivers. - [ ] Make sure replay progress bars go to stderr. +Bugs: + +- [ ] In non-daemon-mode, ^D doesn't bring down Urbit properly. + King-Haskell specific features: - [x] Re-implement `collectFX` flow in Serf/Pier. @@ -73,6 +77,7 @@ Polish: - Next, same thing for ames. - Next, same thing for eyre. + # Better IO Driver Startup Flow Separation Should have a io-driver-boot stage. @@ -81,3 +86,20 @@ Should have a io-driver-boot stage. - When they're done, they signal that they're running. - No semantically important communication without outside world can happen until all drivers are up. + +Something like: + +``` +data DriverConfig = DriverConfig + { onAllDriversUp :: STM () + } + +data DriverApi = DriverApi + { eventQueue :: STM (Maybe RunReq) + , effectSink :: Effect -> STM () + , blockUntilUp :: STM () + , killDriver :: STM () + } + +type Driver = DriverConfig -> RIO e DriverApi +``` diff --git a/pkg/hs/urbit-king/lib/Urbit/Time.hs b/pkg/hs/urbit-king/lib/Urbit/Time.hs index ba9cbfb55..a33fd982a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Time.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Time.hs @@ -7,11 +7,16 @@ module Urbit.Time where import Control.Lens import Prelude -import Data.Bits (shiftL, shiftR) -import Data.Time.Clock (DiffTime, UTCTime) +import Data.Bits (shiftL, shiftR, (.&.)) +import Data.List (intercalate) +import Data.Time.Calendar (toGregorian) +import Data.Time.Clock (DiffTime, UTCTime(..)) import Data.Time.Clock (diffTimeToPicoseconds, picosecondsToDiffTime) import Data.Time.Clock.System (SystemTime(..), getSystemTime) import Data.Time.Clock.System (systemToUTCTime, utcToSystemTime) +import Data.Time.LocalTime (TimeOfDay(..), timeToTimeOfDay) +import Data.Word (Word64) +import Text.Printf (printf) import Urbit.Noun (FromNoun, ToNoun) @@ -26,12 +31,47 @@ newtype Unix = Unix { _sinceUnixEpoch :: Gap } newtype Wen = Wen { _sinceUrbitEpoch :: Gap } deriving newtype (Eq, Ord, Show, Num, ToNoun, FromNoun) +newtype Date = MkDate { _dateWen :: Wen } + deriving newtype (Eq, Ord, Num, ToNoun, FromNoun) --- Lenses ---------------------------------------------------------------------- + +-- Record Lenses --------------------------------------------------------------- makeLenses ''Gap makeLenses ''Unix makeLenses ''Wen +makeLenses ''Date + + +-- Instances ------------------------------------------------------------------- + +instance Show Date where + show (MkDate wen) = if fs == 0 + then printf "~%i.%u.%u..%02u.%02u.%02u" y m d h min s + else printf "~%i.%u.%u..%02u.%02u.%02u..%s" y m d h min s (showGap fs) + where + utc = wen ^. systemTime . to systemToUTCTime + (y, m, d) = toGregorian (utctDay utc) + TimeOfDay h min (floor -> s::Int) = timeToTimeOfDay (utctDayTime utc) + fs = (wen ^. wenFracto . to (fromIntegral @Integer @Word64)) + + wenFracto :: Lens' Wen Integer + wenFracto = sinceUrbitEpoch . fractoSecs + + showGap :: Word64 -> String + showGap gap = intercalate "." (printf "%04x" <$> bs) + where + bs = reverse $ dropWhile (== 0) [b4, b3, b2, b1] + b4 = takeBits 16 gap + b3 = takeBits 16 (shiftR gap 16) + b2 = takeBits 16 (shiftR gap 32) + b1 = takeBits 16 (shiftR gap 48) + + takeBits :: Int -> Word64 -> Word64 + takeBits wid wor = wor .&. (shiftL 1 wid - 1) + + +-- Conversion Lenses ----------------------------------------------------------- diffTime :: Iso' Gap DiffTime diffTime = iso fromGap toGap diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 8d3b86fdb..c5b9398ad 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -24,11 +24,7 @@ import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Pier.Types -import Data.Bits (shiftR) import Data.Text (append) -import Data.Time.Clock (DiffTime) -import Data.Time.Clock.System (systemToUTCTime) -import Data.Time.LocalTime (TimeOfDay(..), timeToTimeOfDay) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) import Urbit.Time (Wen) @@ -42,7 +38,6 @@ import Urbit.Vere.Log (EventLog) import Urbit.Vere.Serf (Serf) import qualified System.Entropy as Ent -import qualified Urbit.Atom.Fast as Atom import qualified Urbit.King.API as King import qualified Urbit.Time as Time import qualified Urbit.Vere.Log as Log @@ -334,9 +329,10 @@ pier (serf, log) vSlog mStart vKilled multi = do void $ acquireWorker "bullshit scry tester" $ forever $ do threadDelay 1_000_000 wen <- io Time.now - let cb mTermNoun = print ("scry result: ", mTermNoun) - let pax = Path ["j", "~zod", "life", MkKnot $ pack $ showDate wen, "~zod"] - atomically $ putTMVar scryM (wen, Nothing, pax, cb) + let kal = \mTermNoun -> print ("scry result: ", mTermNoun) + let nkt = MkKnot $ tshow $ Time.MkDate wen + let pax = Path ["j", "~zod", "life", nkt, "~zod"] + atomically $ putTMVar scryM (wen, Nothing, pax, kal) putMVar mStart () @@ -531,29 +527,3 @@ runPersist log inpQ out = do go acc = tryReadTQueue inpQ >>= \case Nothing -> pure (reverse acc) Just item -> go (item <| acc) - --- "~YYYY.MM.DD..HH.MM.SS..FRACTO" -showDate :: Wen -> String -showDate w = do - if fs == 0 - then printf "~%i.%u.%u..%02u.%02u.%02u" y m d h min s - else printf "~%i.%u.%u..%02u.%02u.%02u..%s" y m d h min s (showGap fs) - where - (y, m, d) = toGregorian (utctDay utc) - (h, min, s) = diffTimeSplit (utctDayTime utc) - fs = fromIntegral (Time._fractoSecs (Time._sinceUrbitEpoch w)) :: Word - utc = w ^. Time.systemTime . to systemToUTCTime - -showGap :: Word -> String -showGap gap = intercalate "." (printf "%04x" <$> bs) - where - bs = reverse $ dropWhile (== 0) [b4, b3, b2, b1] - b4 = Atom.takeBitsWord 16 gap - b3 = Atom.takeBitsWord 16 (shiftR gap 16) - b2 = Atom.takeBitsWord 16 (shiftR gap 32) - b1 = Atom.takeBitsWord 16 (shiftR gap 48) - -diffTimeSplit :: DiffTime -> (Int, Int, Int) -diffTimeSplit dt = (hours, mins, floor secs) - where - TimeOfDay hours mins secs = timeToTimeOfDay dt From bd51337156ae3e2a419dec6cf5764a75a39ee8ad Mon Sep 17 00:00:00 2001 From: ~siprel Date: Sat, 6 Jun 2020 21:33:15 +0000 Subject: [PATCH 116/257] king: In non-daemon-mode, ^D now actually brings down the executable. --- pkg/hs/urbit-king/TODO.md | 2 +- pkg/hs/urbit-king/lib/Urbit/King/App.hs | 3 -- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 47 ++++++++++++-------- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 4 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 5 ++- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 2 +- 6 files changed, 37 insertions(+), 26 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index a99928319..19f508b9d 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -19,7 +19,7 @@ Stubbed out: Bugs: -- [ ] In non-daemon-mode, ^D doesn't bring down Urbit properly. +- [x] In non-daemon-mode, ^D doesn't bring down Urbit properly. King-Haskell specific features: diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs index 134c34fc0..2a51e1393 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs @@ -25,9 +25,6 @@ import System.Posix.Internals (c_getpid) import System.Posix.Types (CPid(..)) import System.Random (randomIO) --- Constraints ----------------------------------------------------------------- - - -- KingEnv --------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index a6a570e01..db5844d20 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -540,20 +540,25 @@ newShip CLI.New{..} opts = do runShip :: CLI.Run -> CLI.Opts -> Bool -> TMVar () -> MultiEyreApi -> RIO KingEnv () runShip (CLI.Run pierPath) opts daemon vKill multi = do - tid <- io myThreadId - let onTermExit = throwTo tid UserInterrupt - mStart <- newEmptyMVar + thisTid <- io myThreadId + mStart <- newEmptyMVar if daemon then runPier mStart else do + -- Wait until the pier has started up, then connect a terminal. If + -- the terminal ever shuts down, ask the ship to go down. connectionThread <- async $ do readMVar mStart - finally (connTerm pierPath) onTermExit - finally (runPier mStart) (cancel connectionThread) + finally (connTerm pierPath) $ do + atomically (tryPutTMVar vKill ()) + + -- Run the pier until it finishes, and then kill the terminal. + finally (runPier mStart) $ do + cancel connectionThread where - runPier mStart = - runPierEnv pierConfig networkConfig $ - tryPlayShip + runPier mStart = do + runPierEnv pierConfig networkConfig $ + tryPlayShip (CLI.oExit opts) (CLI.oFullReplay opts) (CLI.oDryFrom opts) @@ -736,20 +741,20 @@ runSingleShip (r, o, d) multi = do shipThread <- async (runShipNoRestart vKill r o d multi) {- - Since `spin` never returns, this will run until the main - thread is killed with an async exception. The one we expect is - `UserInterrupt` which will be raised on this thread upon SIGKILL - or SIGTERM. + Wait for the ship to go down. - Once that happens, we write to `vKill` which will cause - all ships to be shut down, and then we `wait` for them to finish - before returning. + Since `waitCatch` will never throw an exception, the `onException` + block will only happen if this thread is killed with an async + exception. The one we expect is `UserInterrupt` which will be raised + on this thread upon SIGKILL or SIGTERM. + + If this thread is killed, we first ask the ship to go down, wait + for the ship to actually go down, and then go down ourselves. -} - let spin = forever (threadDelay maxBound) - finally spin $ do + onException (void $ waitCatch shipThread) $ do logTrace "KING IS GOING DOWN" - atomically (putTMVar vKill ()) - waitCatch shipThread + void $ atomically $ tryPutTMVar vKill () + void $ waitCatch shipThread runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> RIO KingEnv () @@ -768,6 +773,10 @@ runMultipleShips ships multi = do Once that happens, we write to `vKill` which will cause all ships to be shut down, and then we `wait` for them to finish before returning. + + This is different than the single-ship flow, because ships never + go down on their own in this flow. If they go down, they just bring + themselves back up. -} let spin = forever (threadDelay maxBound) finally spin $ do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index c5b9398ad..a6cd0482c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -327,9 +327,11 @@ pier (serf, log) vSlog mStart vKilled multi = do -- bullshit scry tester void $ acquireWorker "bullshit scry tester" $ forever $ do + env <- ask threadDelay 1_000_000 wen <- io Time.now - let kal = \mTermNoun -> print ("scry result: ", mTermNoun) + let kal = \mTermNoun -> runRIO env $ do + logTrace $ displayShow ("scry result: ", mTermNoun) let nkt = MkKnot $ tshow $ Time.MkDate wen let pax = Path ["j", "~zod", "life", nkt, "~zod"] atomically $ putTMVar scryM (wen, Nothing, pax, kal) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index f205eeb7b..403226657 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -110,7 +110,10 @@ execReplay serf log last = do logTrace $ display $ "Replaying up to event #" <> tshow replayUpTo logTrace $ display $ "Will replay " <> tshow numEvs <> " in total." - let onProgress n = print ("Serf is at event# " <> tshow n) + env <- ask + + let onProgress n = do + runRIO env $ logTrace $ display ("Serf is at event# " <> tshow n) runResourceT $ runConduit diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index fe7914c48..5a5257103 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -608,7 +608,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop que <- newTBMQueueIO 1 () <- atomically (writeTBMQueue que firstWorkErr) tWork <- async (processWork serf maxBatchSize que onWorkResp spin) - flip onException (print "KILLING: run" >> cancel tWork) $ do + flip onException (cancel tWork) $ do nexSt <- workLoop que wait tWork nexSt From 648b0743c879a67cf78dcdf51eb826def7b0b997 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Sat, 6 Jun 2020 23:03:20 +0000 Subject: [PATCH 117/257] king: Shutdown TMVars now live in KingEnv/PierEnv. --- pkg/hs/urbit-king/TODO.md | 4 +- pkg/hs/urbit-king/lib/Urbit/King/App.hs | 36 ++++++- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 117 ++++++++++++----------- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 16 ++-- pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 10 +- 5 files changed, 108 insertions(+), 75 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 19f508b9d..1cadbef8b 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -52,8 +52,8 @@ Polish: # Cleanup -- [ ] ShutdownSTM action that's passed to the terminal driver should - live in `PierEnv` and should be available to all drivers. +- [x] ShutdownSTM action that's passed to the terminal driver should + live in `KingEnv` and should be available to all drivers. - [ ] Break most logic from `Main.hs` out into modules. - [ ] Simplify `Main.hs` flows. - [ ] Cleanup Terminal Driver code. diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs index 2a51e1393..73ef5ae7d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs @@ -6,8 +6,13 @@ module Urbit.King.App , runKingEnvStderr , runKingEnvLogFile , runKingEnvNoLog + , kingEnvKillSignal + , killKingActionL + , onKillKingSigL , PierEnv , runPierEnv + , killPierActionL + , onKillPierSigL , HasStderrLogFunc(..) , HasKingId(..) , HasProcId(..) @@ -47,6 +52,7 @@ data KingEnv = KingEnv , _kingEnvStderrLogFunc :: !LogFunc , _kingEnvKingId :: !Word16 , _kingEnvProcId :: !Int32 + , _kingEnvKillSignal :: !(TMVar ()) } makeLenses ''KingEnv @@ -104,7 +110,18 @@ runKingEnv :: LogFunc -> LogFunc -> RIO KingEnv a -> IO a runKingEnv logFunc stderr action = do kid <- randomIO CPid pid <- c_getpid - runRIO (KingEnv logFunc stderr kid pid) action + kil <- newEmptyTMVarIO + runRIO (KingEnv logFunc stderr kid pid kil) action + + +-- KingEnv Utils --------------------------------------------------------------- + +onKillKingSigL :: HasKingEnv e => Getter e (STM ()) +onKillKingSigL = kingEnvL . kingEnvKillSignal . to readTMVar + +killKingActionL :: HasKingEnv e => Getter e (STM ()) +killKingActionL = + kingEnvL . kingEnvKillSignal . to (\kil -> void (tryPutTMVar kil ())) -- PierEnv --------------------------------------------------------------------- @@ -116,6 +133,7 @@ data PierEnv = PierEnv { _pierEnvKingEnv :: !KingEnv , _pierEnvPierConfig :: !PierConfig , _pierEnvNetworkConfig :: !NetworkConfig + , _pierEnvKillSignal :: !(TMVar ()) } makeLenses ''PierEnv @@ -151,15 +169,27 @@ instance HasProcId PierEnv where procIdL = kingEnvL . kingEnvProcId +-- PierEnv Utils --------------------------------------------------------------- + +onKillPierSigL :: HasPierEnv e => Getter e (STM ()) +onKillPierSigL = pierEnvL . pierEnvKillSignal . to readTMVar + +killPierActionL :: HasPierEnv e => Getter e (STM ()) +killPierActionL = + pierEnvL . pierEnvKillSignal . to (\kil -> void (tryPutTMVar kil ())) + + -- Running Pier Envs ----------------------------------------------------------- -runPierEnv :: PierConfig -> NetworkConfig -> RIO PierEnv a -> RIO KingEnv a -runPierEnv pierConfig networkConfig action = do +runPierEnv + :: PierConfig -> NetworkConfig -> TMVar () -> RIO PierEnv a -> RIO KingEnv a +runPierEnv pierConfig networkConfig vKill action = do app <- ask let pierEnv = PierEnv { _pierEnvKingEnv = app , _pierEnvPierConfig = pierConfig , _pierEnvNetworkConfig = networkConfig + , _pierEnvKillSignal = vKill } io (runRIO pierEnv action) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index db5844d20..9af3a4f14 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -91,7 +91,9 @@ import Control.Exception (AsyncException(UserInterrupt)) import Control.Lens ((&)) import System.Process (system) import Text.Show.Pretty (pPrint) -import Urbit.King.App (KingEnv, PierEnv) +import Urbit.King.App (KingEnv, PierEnv, kingEnvKillSignal) +import Urbit.King.App (killKingActionL, onKillKingSigL) +import Urbit.King.App (killPierActionL) import Urbit.King.App (runKingEnvLogFile, runKingEnvStderr, runPierEnv) import Urbit.Noun.Conversions (cordToUW) import Urbit.Time (Wen) @@ -178,27 +180,25 @@ tryBootFromPill -> MultiEyreApi -> RIO PierEnv () tryBootFromPill oExit pill lite flags ship boot multi = do - mStart <- newEmptyMVar - vKill <- newEmptyTMVarIO - vSlog <- logSlogs - runOrExitImmediately vSlog (bootedPier vSlog) oExit mStart vKill multi - where - bootedPier vSlog = do - view pierPathL >>= lockFile - rio $ logTrace "Starting boot" - sls <- Pier.booted vSlog pill lite flags ship boot - rio $ logTrace "Completed boot" - pure sls + mStart <- newEmptyMVar + vSlog <- logSlogs + runOrExitImmediately vSlog (bootedPier vSlog) oExit mStart multi + where + bootedPier vSlog = do + view pierPathL >>= lockFile + rio $ logTrace "Starting boot" + sls <- Pier.booted vSlog pill lite flags ship boot + rio $ logTrace "Completed boot" + pure sls runOrExitImmediately :: TVar (Text -> IO ()) -> RAcquire PierEnv (Serf, Log.EventLog) -> Bool -> MVar () - -> TMVar () -> MultiEyreApi -> RIO PierEnv () -runOrExitImmediately vSlog getPier oExit mStart vKill multi = do +runOrExitImmediately vSlog getPier oExit mStart multi = do rwith getPier (if oExit then shutdownImmediately else runPier) where shutdownImmediately :: (Serf, Log.EventLog) -> RIO PierEnv () @@ -209,7 +209,7 @@ runOrExitImmediately vSlog getPier oExit mStart vKill multi = do runPier :: (Serf, Log.EventLog) -> RIO PierEnv () runPier serfLog = do - runRAcquire (Pier.pier serfLog vSlog mStart vKill multi) + runRAcquire (Pier.pier serfLog vSlog mStart multi) tryPlayShip :: Bool @@ -217,13 +217,12 @@ tryPlayShip -> Maybe Word64 -> [Serf.Flag] -> MVar () - -> TMVar () -> MultiEyreApi -> RIO PierEnv () -tryPlayShip exitImmediately fullReplay playFrom flags mStart vKill multi = do +tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do when fullReplay wipeSnapshot vSlog <- logSlogs - runOrExitImmediately vSlog (resumeShip vSlog) exitImmediately mStart vKill multi + runOrExitImmediately vSlog (resumeShip vSlog) exitImmediately mStart multi where wipeSnapshot = do shipPath <- view pierPathL @@ -532,15 +531,23 @@ newShip CLI.New{..} opts = do -- Now that we have all the information for running an application with a -- PierConfig, do so. runTryBootFromPill multi pill name ship bootEvent = do + vKill <- view kingEnvKillSignal let pierConfig = toPierConfig (pierPath name) opts let networkConfig = toNetworkConfig opts - runPierEnv pierConfig networkConfig $ + runPierEnv pierConfig networkConfig vKill $ tryBootFromPill True pill nLite flags ship bootEvent multi ------ tryBootFromPill (CLI.oExit opts) pill nLite flags ship bootEvent -runShip :: CLI.Run -> CLI.Opts -> Bool -> TMVar () -> MultiEyreApi -> RIO KingEnv () -runShip (CLI.Run pierPath) opts daemon vKill multi = do - thisTid <- io myThreadId +runShipEnv :: CLI.Run -> CLI.Opts -> TMVar () -> RIO PierEnv a -> RIO KingEnv a +runShipEnv (CLI.Run pierPath) opts vKill act = do + runPierEnv pierConfig netConfig vKill act + where + pierConfig = toPierConfig pierPath opts + netConfig = toNetworkConfig opts + +runShip + :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO PierEnv () +runShip (CLI.Run pierPath) opts daemon multi = do mStart <- newEmptyMVar if daemon then runPier mStart @@ -550,24 +557,20 @@ runShip (CLI.Run pierPath) opts daemon vKill multi = do connectionThread <- async $ do readMVar mStart finally (connTerm pierPath) $ do - atomically (tryPutTMVar vKill ()) + view killPierActionL >>= atomically -- Run the pier until it finishes, and then kill the terminal. finally (runPier mStart) $ do cancel connectionThread where runPier mStart = do - runPierEnv pierConfig networkConfig $ - tryPlayShip - (CLI.oExit opts) - (CLI.oFullReplay opts) - (CLI.oDryFrom opts) - (toSerfFlags opts) - mStart - vKill - multi - pierConfig = toPierConfig pierPath opts - networkConfig = toNetworkConfig opts + tryPlayShip + (CLI.oExit opts) + (CLI.oFullReplay opts) + (CLI.oDryFrom opts) + (toSerfFlags opts) + mStart + multi startBrowser :: HasLogFunc e => FilePath -> RIO e () @@ -652,15 +655,18 @@ main = do TODO Use logging system instead of printing. -} runShipRestarting - :: TMVar () -> CLI.Run -> CLI.Opts -> MultiEyreApi -> RIO KingEnv () -runShipRestarting vKill r o multi = do + :: CLI.Run -> CLI.Opts -> MultiEyreApi -> RIO KingEnv () +runShipRestarting r o multi = do let pier = pack (CLI.rPierPath r) - loop = runShipRestarting vKill r o multi + loop = runShipRestarting r o multi - tid <- asyncBound (runShip r o True vKill multi) + onKill <- view onKillKingSigL + vKillPier <- newEmptyTMVarIO + + tid <- asyncBound $ runShipEnv r o vKillPier $ runShip r o True multi let onShipExit = Left <$> waitCatchSTM tid - onKillRequ = Right <$> readTMVar vKill + onKillRequ = Right <$> onKill atomically (onShipExit <|> onKillRequ) >>= \case Left exit -> do @@ -681,14 +687,17 @@ runShipRestarting vKill r o multi = do {- TODO This is messy and shared a lot of logic with `runShipRestarting`. -} -runShipNoRestart :: TMVar () -> CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO KingEnv () -runShipNoRestart vKill r o d multi = do - tid <- asyncBound (runShip r o d vKill multi) +runShipNoRestart + :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO KingEnv () +runShipNoRestart r o d multi = do + vKill <- view kingEnvKillSignal -- killing ship same as killing king + tid <- asyncBound (runShipEnv r o vKill $ runShip r o d multi) + onKill <- view onKillKingSigL let pier = pack (CLI.rPierPath r) let onShipExit = Left <$> waitCatchSTM tid - onKillRequ = Right <$> readTMVar vKill + onKillRequ = Right <$> onKill atomically (onShipExit <|> onKillRequ) >>= \case Left (Left err) -> do @@ -736,9 +745,7 @@ runShips CLI.KingOpts {..} ships = do -- TODO Duplicated logic. runSingleShip :: (CLI.Run, CLI.Opts, Bool) -> MultiEyreApi -> RIO KingEnv () runSingleShip (r, o, d) multi = do - vKill <- newEmptyTMVarIO - - shipThread <- async (runShipNoRestart vKill r o d multi) + shipThread <- async (runShipNoRestart r o d multi) {- Wait for the ship to go down. @@ -753,16 +760,15 @@ runSingleShip (r, o, d) multi = do -} onException (void $ waitCatch shipThread) $ do logTrace "KING IS GOING DOWN" - void $ atomically $ tryPutTMVar vKill () - void $ waitCatch shipThread + atomically =<< view killKingActionL + waitCatch shipThread + pure () runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> RIO KingEnv () runMultipleShips ships multi = do - vKill <- newEmptyTMVarIO - shipThreads <- for ships $ \(r, o) -> do - async (runShipRestarting vKill r o multi) + async (runShipRestarting r o multi) {- Since `spin` never returns, this will run until the main @@ -770,9 +776,9 @@ runMultipleShips ships multi = do `UserInterrupt` which will be raised on this thread upon SIGKILL or SIGTERM. - Once that happens, we write to `vKill` which will cause - all ships to be shut down, and then we `wait` for them to finish - before returning. + Once that happens, we send a shutdown signal which will cause all + ships to be shut down, and then we `wait` for them to finish before + returning. This is different than the single-ship flow, because ships never go down on their own in this flow. If they go down, they just bring @@ -781,7 +787,7 @@ runMultipleShips ships multi = do let spin = forever (threadDelay maxBound) finally spin $ do logTrace "KING IS GOING DOWN" - atomically (putTMVar vKill ()) + view killKingActionL >>= atomically for_ shipThreads waitCatch @@ -790,6 +796,7 @@ runMultipleShips ships multi = do connTerm :: ∀e. HasLogFunc e => FilePath -> RIO e () connTerm = Term.runTerminalClient + -------------------------------------------------------------------------------- checkFx :: HasLogFunc e diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index a6cd0482c..5a380999f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -27,6 +27,7 @@ import Urbit.Vere.Pier.Types import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) +import Urbit.King.App (onKillPierSigL) import Urbit.Time (Wen) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) @@ -239,10 +240,9 @@ pier :: (Serf, EventLog) -> TVar (Text -> IO ()) -> MVar () - -> TMVar () -> MultiEyreApi -> RAcquire PierEnv () -pier (serf, log) vSlog mStart vKilled multi = do +pier (serf, log) vSlog mStart multi = do computeQ <- newTQueueIO @_ @Serf.EvErr persistQ <- newTQueueIO executeQ <- newTQueueIO @@ -255,8 +255,6 @@ pier (serf, log) vSlog mStart vKilled multi = do writeTVar (King.kTermConn kapi) (Just $ writeTQueue q) pure q - let shutdownEvent = void (tryPutTMVar vKilled ()) - -- (sz, local) <- Term.localClient -- (waitExternalTerm, termServPort) <- Term.termServer @@ -297,7 +295,6 @@ pier (serf, log) vSlog mStart vKilled multi = do let (bootEvents, startDrivers) = drivers env multi ship (isFake logId) (writeTQueue computeQ) - shutdownEvent (Term.TSize{tsWide=80, tsTall=24}, muxed) showErr @@ -305,9 +302,11 @@ pier (serf, log) vSlog mStart vKilled multi = do scryM <- newEmptyTMVarIO + onKill <- view onKillPierSigL + let computeConfig = ComputeConfig { ccOnWork = readTQueue computeQ - , ccOnKill = readTMVar vKilled + , ccOnKill = onKill , ccOnSave = takeTMVar saveM , ccOnScry = takeTMVar scryM , ccPutResult = writeTQueue persistQ @@ -385,11 +384,10 @@ drivers -> Ship -> Bool -> (EvErr -> STM ()) - -> STM () -> (Term.TSize, Term.Client) -> (Text -> RIO e ()) -> ([EvErr], RAcquire e (Drivers e)) -drivers env multi who isFake plan shutdownSTM termSys stderr = +drivers env multi who isFake plan termSys stderr = (initialEvents, runDrivers) -- TODO where (behnBorn, runBehn) = behn env plan @@ -397,7 +395,7 @@ drivers env multi who isFake plan shutdownSTM termSys stderr = (httpBorn, runHttp) = eyre env multi who plan isFake (clayBorn, runClay) = clay env plan (irisBorn, runIris) = client env plan - (termBorn, runTerm) = Term.term env termSys shutdownSTM plan + (termBorn, runTerm) = Term.term env termSys plan initialEvents = mconcat [behnBorn, clayBorn, amesBorn, httpBorn, termBorn, irisBorn] runDrivers = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index 5f66401e8..40fd1581b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -18,7 +18,6 @@ import RIO.FilePath import System.Posix.IO import System.Posix.Terminal import Urbit.Arvo hiding (Term) -import Urbit.King.Config import Urbit.Prelude hiding (getCurrentTime) import Urbit.Time import Urbit.Vere.Pier.Types @@ -26,7 +25,7 @@ import Urbit.Vere.Pier.Types import Data.List ((!!)) import RIO.Directory (createDirectoryIfMissing) import Urbit.King.API (readPortsFile) -import Urbit.King.App (HasKingId(..), HasPierPath(..)) +import Urbit.King.App (HasPierPath(..), HasPierEnv, killPierActionL) import Urbit.Vere.Term.API (Client(Client)) import qualified Data.ByteString.Internal as BS @@ -502,13 +501,12 @@ initialHailFailed env _ = runRIO env $ do {-| Terminal Driver -} -term :: forall e. (HasPierConfig e, HasLogFunc e, HasKingId e) +term :: forall e. (HasPierEnv e) => e -> (T.TSize, Client) - -> (STM ()) -> (EvErr -> STM ()) -> ([EvErr], RAcquire e (EffCb e TermEf)) -term env (tsize, Client{..}) shutdownSTM plan = +term env (tsize, Client{..}) plan = (initialEvents, runTerm) where T.TSize wi hi = tsize @@ -540,7 +538,7 @@ term env (tsize, Client{..}) shutdownSTM plan = handleEffect = \case TermEfInit _ _ -> pure () TermEfMass _ _ -> pure () - TermEfLogo _ _ -> atomically shutdownSTM + TermEfLogo _ _ -> atomically =<< view killPierActionL TermEfBlit _ blits -> do let (termBlits, fsWrites) = partition isTerminalBlit blits atomically $ give [Term.Blits termBlits] From 95df4b0764ff40b9a1148cd9e3ab0e922ef44800 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Sat, 6 Jun 2020 23:34:27 +0000 Subject: [PATCH 118/257] king: Pier cleanup pass. --- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 8 +- pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs | 6 +- pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs | 8 +- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 8 +- .../urbit-king/lib/Urbit/Vere/Http/Client.hs | 10 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 304 +++++++++--------- .../urbit-king/lib/Urbit/Vere/Pier/Types.hs | 10 +- pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 6 +- 9 files changed, 180 insertions(+), 182 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 9af3a4f14..25fd34007 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -383,7 +383,7 @@ testPill pax showPil showSeq = do pill <- fromNounErr pillNoun & either (throwIO . uncurry ParseErr) pure logTrace "Using pill to generate boot sequence." - bootSeq <- generateBootSeq (Ship 0) pill False (Fake $ Ship 0) + bootSeq <- genBootSeq (Ship 0) pill False (Fake (Ship 0)) logTrace "Validate jam/cue and toNoun/fromNoun on pill value" reJam <- validateNounVal pill diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 8c5ccbd9d..0c7367389 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -118,7 +118,7 @@ ames -> Bool -> (EvErr -> STM ()) -> (Text -> RIO e ()) - -> ([EvErr], RAcquire e (EffCb e NewtEf)) + -> ([EvErr], RAcquire e (NewtEf -> IO ())) ames env who isFake enqueueEv stderr = (initialEvents, runAmes) where king = fromIntegral (env ^. kingIdL) @@ -126,7 +126,7 @@ ames env who isFake enqueueEv stderr = (initialEvents, runAmes) initialEvents :: [EvErr] initialEvents = [EvErr (bornEv king) (bornFailed env)] - runAmes :: RAcquire e (EffCb e NewtEf) + runAmes :: RAcquire e (NewtEf -> IO ()) runAmes = do mode <- rio (netMode isFake) drv <- mkRAcquire start stop @@ -153,8 +153,8 @@ ames env who isFake enqueueEv stderr = (initialEvents, runAmes) rsKill aResolvr cancel aRecvTid - handleEffect :: AmesDrv -> NetworkMode -> NewtEf -> RIO e () - handleEffect drv@AmesDrv {..} mode = \case + handleEffect :: AmesDrv -> NetworkMode -> NewtEf -> IO () + handleEffect drv@AmesDrv {..} mode = runRIO env . \case NewtEfTurf (_id, ()) turfs -> do atomically $ writeTVar aTurfs (Just turfs) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs index cf58bc180..91d6fb70d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs @@ -34,7 +34,7 @@ wakeErr :: WorkError -> IO () wakeErr _ = pure () behn - :: HasKingId e => e -> (EvErr -> STM ()) -> ([EvErr], Acquire (EffCb e BehnEf)) + :: HasKingId e => e -> (EvErr -> STM ()) -> ([EvErr], Acquire (BehnEf -> IO ())) behn env enqueueEv = (initialEvents, runBehn) where @@ -42,10 +42,10 @@ behn env enqueueEv = initialEvents = [EvErr (bornEv king) (bornFailed env)] - runBehn :: Acquire (EffCb e BehnEf) + runBehn :: Acquire (BehnEf -> IO ()) runBehn = do tim <- mkAcquire Timer.init Timer.stop - pure (handleEf tim) + pure (runRIO env . handleEf tim) handleEf :: Timer -> BehnEf -> RIO e () handleEf b = io . \case diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs index 353ad4797..00d9a18dd 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs @@ -122,7 +122,7 @@ clay . (HasPierConfig e, HasLogFunc e, HasKingId e) => e -> (EvErr -> STM ()) - -> ([EvErr], RAcquire e (EffCb e SyncEf)) + -> ([EvErr], RAcquire e (SyncEf -> IO ())) clay env plan = (initialEvents, runSync) where @@ -134,15 +134,15 @@ clay env plan = -- specified directory and shove it into an %into event. initialEvents = [EvErr boatEv (boatFailed env)] - runSync :: RAcquire e (EffCb e SyncEf) + runSync :: RAcquire e (SyncEf -> IO ()) runSync = handleEffect <$> mkRAcquire start stop start :: RIO e ClayDrv start = ClayDrv <$> newTVarIO mempty stop c = pure () - handleEffect :: ClayDrv -> SyncEf -> RIO e () - handleEffect cd = \case + handleEffect :: ClayDrv -> SyncEf -> IO () + handleEffect cd = runRIO env . \case SyncEfHill _ mountPoints -> do logDebug $ displayShow ("(clay) known mount points:", mountPoints) pierPath <- view pierPathL diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 34df63330..7ef6180c8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -287,7 +287,7 @@ eyre -> Ship -> (EvErr -> STM ()) -> Bool - -> ([EvErr], RAcquire e (EffCb e HttpServerEf)) + -> ([EvErr], RAcquire e (HttpServerEf -> IO ())) eyre env multi who plan isFake = (initialEvents, runHttpServer) where king = fromIntegral (env ^. kingIdL) @@ -295,7 +295,7 @@ eyre env multi who plan isFake = (initialEvents, runHttpServer) initialEvents :: [EvErr] initialEvents = [EvErr (bornEv king) (bornFailed env)] - runHttpServer :: RAcquire e (EffCb e HttpServerEf) + runHttpServer :: RAcquire e (HttpServerEf -> IO ()) runHttpServer = handleEf <$> mkRAcquire (Drv <$> newMVar Nothing) (\(Drv v) -> stopService v kill >>= fromEither) @@ -318,8 +318,8 @@ eyre env multi who plan isFake = (initialEvents, runHttpServer) liveFailed _ = pure () - handleEf :: Drv -> HttpServerEf -> RIO e () - handleEf drv = \case + handleEf :: Drv -> HttpServerEf -> IO () + handleEf drv = runRIO env . \case HSESetConfig (i, ()) conf -> do logDebug (displayShow ("EYRE", "%set-config")) Serv {..} <- restart drv conf diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs index 0bf9abf38..1cd1007f8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs @@ -66,7 +66,7 @@ client . (HasLogFunc e, HasKingId e) => e -> (EvErr -> STM ()) - -> ([EvErr], RAcquire e (EffCb e HttpClientEf)) + -> ([EvErr], RAcquire e (HttpClientEf -> IO ())) client env plan = (initialEvents, runHttpClient) where kingId = view (kingIdL . to fromIntegral) env @@ -74,7 +74,7 @@ client env plan = (initialEvents, runHttpClient) initialEvents :: [EvErr] initialEvents = [EvErr (bornEv kingId) (bornFailed env)] - runHttpClient :: RAcquire e (EffCb e HttpClientEf) + runHttpClient :: RAcquire e (HttpClientEf -> IO ()) runHttpClient = handleEffect <$> mkRAcquire start stop start :: RIO e (HttpClientDrv) @@ -88,10 +88,10 @@ client env plan = (initialEvents, runHttpClient) liveThreads <- atomically $ readTVar hcdLive mapM_ cancel liveThreads - handleEffect :: HttpClientDrv -> HttpClientEf -> RIO e () + handleEffect :: HttpClientDrv -> HttpClientEf -> IO () handleEffect drv = \case - HCERequest _ id req -> newReq drv id req - HCECancelRequest _ id -> cancelReq drv id + HCERequest _ id req -> runRIO env (newReq drv id req) + HCECancelRequest _ id -> runRIO env (cancelReq drv id) newReq :: HttpClientDrv -> ReqId -> HttpClientReq -> RIO e () newReq drv id req = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 5a380999f..2a4666c5d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -12,7 +12,7 @@ module Urbit.Vere.Pier , pier , runPersist , runCompute - , generateBootSeq + , genBootSeq ) where @@ -49,7 +49,7 @@ import qualified Urbit.Vere.Term.Demux as Term import qualified Urbit.Vere.Term.Render as Term --------------------------------------------------------------------------------- +-- Initialize pier directory. -------------------------------------------------- setupPierDirectory :: FilePath -> RIO e () setupPierDirectory shipPath = do @@ -64,8 +64,8 @@ setupPierDirectory shipPath = do genEntropy :: RIO e Word512 genEntropy = fromIntegral . bytesAtom <$> io (Ent.getEntropy 64) -generateBootSeq :: Ship -> Pill -> Bool -> LegacyBootEvent -> RIO e BootSeq -generateBootSeq ship Pill {..} lite boot = do +genBootSeq :: Ship -> Pill -> Bool -> LegacyBootEvent -> RIO e BootSeq +genBootSeq ship Pill {..} lite boot = do ent <- genEntropy let ovums = preKern ent <> pKernelOvums <> postKern <> pUserspaceOvums pure $ BootSeq ident pBootFormulas ovums @@ -100,7 +100,7 @@ writeJobs log !jobs = do jobPayload (DoWork (Work _ m d o )) = toNoun (m, d, o) --- Boot a new ship. ------------------------------------------------------------ +-- Acquire a running serf. ----------------------------------------------------- printTank :: (Text -> IO ()) -> Atom -> Tank -> IO () printTank f _ = io . f . unlines . fmap unTape . wash (WashCfg 0 80) @@ -125,6 +125,9 @@ runSerf vSlog pax fax = do , scDead = pure () -- TODO: What can be done? } + +-- Boot a new ship. ------------------------------------------------------------ + booted :: TVar (Text -> IO ()) -> Pill @@ -158,7 +161,7 @@ bootNewShip -> LegacyBootEvent -> RIO e () bootNewShip pill lite flags ship bootEv = do - seq@(BootSeq ident x y) <- generateBootSeq ship pill lite bootEv + seq@(BootSeq ident x y) <- genBootSeq ship pill lite bootEv logTrace "BootSeq Computed" pierPath <- view pierPathL @@ -203,22 +206,22 @@ resumed vSlog replayUntil flags = do pure (serf, log) -getSnapshot :: forall e. FilePath -> Word64 -> RIO e (Maybe FilePath) +getSnapshot :: forall e . FilePath -> Word64 -> RIO e (Maybe FilePath) getSnapshot top last = do - lastSnapshot <- lastMay <$> listReplays - pure (replayToPath <$> lastSnapshot) - where - replayDir = top ".partial-replay" - replayToPath eId = replayDir show eId + lastSnapshot <- lastMay <$> listReplays + pure (replayToPath <$> lastSnapshot) + where + replayDir = top ".partial-replay" + replayToPath eId = replayDir show eId - listReplays :: RIO e [Word64] - listReplays = do - createDirectoryIfMissing True replayDir - snapshotNums <- mapMaybe readMay <$> listDirectory replayDir - pure $ sort (filter (<= fromIntegral last) snapshotNums) + listReplays :: RIO e [Word64] + listReplays = do + createDirectoryIfMissing True replayDir + snapshotNums <- mapMaybe readMay <$> listDirectory replayDir + pure $ sort (filter (<= fromIntegral last) snapshotNums) --- Run Pier -------------------------------------------------------------------- +-- Utils for Spawning Worker Threads ------------------------------------------- acquireWorker :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) acquireWorker nam act = mkRAcquire (async act) kill @@ -236,6 +239,9 @@ acquireWorkerBound nam act = mkRAcquire (asyncBound act) kill cancel tid logTrace ("Killed worker thread: " <> display nam) + +-- Run Pier -------------------------------------------------------------------- + pier :: (Serf, EventLog) -> TVar (Text -> IO ()) @@ -243,112 +249,106 @@ pier -> MultiEyreApi -> RAcquire PierEnv () pier (serf, log) vSlog mStart multi = do - computeQ <- newTQueueIO @_ @Serf.EvErr - persistQ <- newTQueueIO - executeQ <- newTQueueIO - saveM <- newEmptyTMVarIO + computeQ <- newTQueueIO @_ @Serf.EvErr + persistQ <- newTQueueIO + executeQ <- newTQueueIO + saveM <- newEmptyTMVarIO + kingApi <- King.kingAPI - kapi <- King.kingAPI + termApiQ <- atomically $ do + q <- newTQueue + writeTVar (King.kTermConn kingApi) (Just $ writeTQueue q) + pure q - termApiQ <- atomically $ do - q <- newTQueue - writeTVar (King.kTermConn kapi) (Just $ writeTQueue q) - pure q + (demux, muxed) <- atomically $ do + res <- Term.mkDemux + pure (res, Term.useDemux res) - -- (sz, local) <- Term.localClient - - -- (waitExternalTerm, termServPort) <- Term.termServer - - (demux, muxed) <- atomically $ do - res <- Term.mkDemux - -- Term.addDemux local res - pure (res, Term.useDemux res) - - -- rio $ logInfo $ display $ - -- "TERMSERV Terminal Server running on port: " <> tshow termServPort - - acquireWorker "TERMINAL" $ forever $ do - logTrace "TERMSERV Waiting for external terminal." - atomically $ do - ext <- Term.connClient <$> readTQueue termApiQ - Term.addDemux ext demux - logTrace "TERMSERV External terminal connected." - - -- Slogs go to both stderr and to the terminal. + acquireWorker "TERMSERV" $ forever $ do + logTrace "TERMSERV Waiting for external terminal." atomically $ do - oldSlog <- readTVar vSlog - writeTVar vSlog $ \txt -> do - atomically $ Term.trace muxed txt - oldSlog txt + ext <- Term.connClient <$> readTQueue termApiQ + Term.addDemux ext demux + logTrace "TERMSERV External terminal connected." - let logId = Log.identity log - let ship = who logId + -- Slogs go to both stderr and to the terminal. + atomically $ do + oldSlog <- readTVar vSlog + writeTVar vSlog $ \txt -> do + atomically $ Term.trace muxed txt + oldSlog txt - -- Our call above to set the logging function which echos errors from the - -- Serf doesn't have the appended \r\n because those \r\n s are added in - -- the c serf code. Logging output from our haskell process must manually - -- add them. - let showErr = atomically . Term.trace muxed . (flip append "\r\n") + let logId = Log.identity log + let ship = who logId + -- Our call above to set the logging function which echos errors from the + -- Serf doesn't have the appended \r\n because those \r\n s are added in + -- the c serf code. Logging output from our haskell process must manually + -- add them. + let showErr = atomically . Term.trace muxed . (flip append "\r\n") + + env <- ask + + let (bootEvents, startDrivers) = drivers + env + multi + ship + (isFake logId) + (writeTQueue computeQ) + (Term.TSize { tsWide = 80, tsTall = 24 }, muxed) + showErr + + io $ atomically $ for_ bootEvents (writeTQueue computeQ) + + scryM <- newEmptyTMVarIO + + onKill <- view onKillPierSigL + + let computeConfig = ComputeConfig { ccOnWork = readTQueue computeQ + , ccOnKill = onKill + , ccOnSave = takeTMVar saveM + , ccOnScry = takeTMVar scryM + , ccPutResult = writeTQueue persistQ + , ccShowSpinner = Term.spin muxed + , ccHideSpinner = Term.stopSpin muxed + , ccLastEvInLog = Log.lastEv log + } + + let plan = writeTQueue executeQ + + drivz <- startDrivers + tExec <- acquireWorker "Effects" (router (readTQueue executeQ) drivz) + tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ plan) + tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) + + tSaveSignal <- saveSignalThread saveM + + -- TODO bullshit scry tester + void $ acquireWorker "bullshit scry tester" $ forever $ do env <- ask + threadDelay 1_000_000 + wen <- io Time.now + let kal = \mTermNoun -> runRIO env $ do + logTrace $ displayShow ("scry result: ", mTermNoun) + let nkt = MkKnot $ tshow $ Time.MkDate wen + let pax = Path ["j", "~zod", "life", nkt, "~zod"] + atomically $ putTMVar scryM (wen, Nothing, pax, kal) - let (bootEvents, startDrivers) = - drivers env multi ship (isFake logId) - (writeTQueue computeQ) - (Term.TSize{tsWide=80, tsTall=24}, muxed) - showErr + putMVar mStart () - io $ atomically $ for_ bootEvents (writeTQueue computeQ) + -- Wait for something to die. - scryM <- newEmptyTMVarIO + let ded = asum + [ death "effects thread" tExec + , death "persist thread" tDisk + , death "compute thread" tSerf + ] - onKill <- view onKillPierSigL + atomically ded >>= \case + Left (txt, exn) -> logError $ displayShow ("Somthing died", txt, exn) + Right tag -> logError $ displayShow ("Something simply exited", tag) - let computeConfig = ComputeConfig - { ccOnWork = readTQueue computeQ - , ccOnKill = onKill - , ccOnSave = takeTMVar saveM - , ccOnScry = takeTMVar scryM - , ccPutResult = writeTQueue persistQ - , ccShowSpinner = Term.spin muxed - , ccHideSpinner = Term.stopSpin muxed - , ccLastEvInLog = Log.lastEv log - } - - let plan = writeTQueue executeQ - - drivz <- startDrivers - tExec <- acquireWorker "Effects" (router (readTQueue executeQ) drivz) - tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ plan) - tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) - - tSaveSignal <- saveSignalThread saveM - - -- bullshit scry tester - void $ acquireWorker "bullshit scry tester" $ forever $ do - env <- ask - threadDelay 1_000_000 - wen <- io Time.now - let kal = \mTermNoun -> runRIO env $ do - logTrace $ displayShow ("scry result: ", mTermNoun) - let nkt = MkKnot $ tshow $ Time.MkDate wen - let pax = Path ["j", "~zod", "life", nkt, "~zod"] - atomically $ putTMVar scryM (wen, Nothing, pax, kal) - - putMVar mStart () - - -- Wait for something to die. - - let ded = asum [ death "effects thread" tExec - , death "persist thread" tDisk - , death "compute thread" tSerf - ] - - atomically ded >>= \case - Left (txt, exn) -> logError $ displayShow ("Somthing died", txt, exn) - Right tag -> logError $ displayShow ("Something simply exited", tag) - - atomically $ (Term.spin muxed) (Just "shutdown") + atomically $ (Term.spin muxed) (Just "shutdown") death :: Text -> Async () -> STM (Either (Text, SomeException) Text) @@ -368,14 +368,14 @@ saveSignalThread tm = mkRAcquire start cancel -- Start All Drivers ----------------------------------------------------------- data Drivers e = Drivers - { dAmes :: EffCb e AmesEf - , dBehn :: EffCb e BehnEf - , dHttpClient :: EffCb e HttpClientEf - , dHttpServer :: EffCb e HttpServerEf - , dNewt :: EffCb e NewtEf - , dSync :: EffCb e SyncEf - , dTerm :: EffCb e TermEf - } + { dAmes :: AmesEf -> IO () + , dBehn :: BehnEf -> IO () + , dIris :: HttpClientEf -> IO () + , dEyre :: HttpServerEf -> IO () + , dNewt :: NewtEf -> IO () + , dSync :: SyncEf -> IO () + , dTerm :: TermEf -> IO () + } drivers :: HasPierEnv e @@ -388,25 +388,26 @@ drivers -> (Text -> RIO e ()) -> ([EvErr], RAcquire e (Drivers e)) drivers env multi who isFake plan termSys stderr = - (initialEvents, runDrivers) -- TODO - where - (behnBorn, runBehn) = behn env plan - (amesBorn, runAmes) = ames env who isFake plan stderr - (httpBorn, runHttp) = eyre env multi who plan isFake - (clayBorn, runClay) = clay env plan - (irisBorn, runIris) = client env plan - (termBorn, runTerm) = Term.term env termSys plan - initialEvents = mconcat [behnBorn, clayBorn, amesBorn, httpBorn, - termBorn, irisBorn] - runDrivers = do - dNewt <- runAmes - dBehn <- liftAcquire $ runBehn - dAmes <- pure $ const $ pure () - dHttpClient <- runIris - dHttpServer <- runHttp - dSync <- runClay - dTerm <- runTerm - pure (Drivers{..}) + (initialEvents, runDrivers) + where + (behnBorn, runBehn) = behn env plan + (amesBorn, runAmes) = ames env who isFake plan stderr + (httpBorn, runEyre) = eyre env multi who plan isFake + (clayBorn, runClay) = clay env plan + (irisBorn, runIris) = client env plan + (termBorn, runTerm) = Term.term env termSys plan + initialEvents = mconcat [behnBorn, clayBorn, amesBorn, httpBorn, + termBorn, irisBorn] + + runDrivers = do + dNewt <- runAmes + dBehn <- liftAcquire $ runBehn + dAmes <- pure $ const $ pure () + dIris <- runIris + dEyre <- runEyre + dSync <- runClay + dTerm <- runTerm + pure (Drivers{..}) -- Route Effects to Drivers ---------------------------------------------------- @@ -419,19 +420,19 @@ router waitFx Drivers {..} = forever $ do case ef of GoodParse (EfVega _ _ ) -> error "TODO" GoodParse (EfExit _ _ ) -> error "TODO" - GoodParse (EfVane (VEAmes ef)) -> dAmes ef - GoodParse (EfVane (VEBehn ef)) -> dBehn ef - GoodParse (EfVane (VEBoat ef)) -> dSync ef - GoodParse (EfVane (VEClay ef)) -> dSync ef - GoodParse (EfVane (VEHttpClient ef)) -> dHttpClient ef - GoodParse (EfVane (VEHttpServer ef)) -> dHttpServer ef - GoodParse (EfVane (VENewt ef)) -> dNewt ef - GoodParse (EfVane (VESync ef)) -> dSync ef - GoodParse (EfVane (VETerm ef)) -> dTerm ef + GoodParse (EfVane (VEAmes ef)) -> io (dAmes ef) + GoodParse (EfVane (VEBehn ef)) -> io (dBehn ef) + GoodParse (EfVane (VEBoat ef)) -> io (dSync ef) + GoodParse (EfVane (VEClay ef)) -> io (dSync ef) + GoodParse (EfVane (VEHttpClient ef)) -> io (dIris ef) + GoodParse (EfVane (VEHttpServer ef)) -> io (dEyre ef) + GoodParse (EfVane (VENewt ef)) -> io (dNewt ef) + GoodParse (EfVane (VESync ef)) -> io (dSync ef) + GoodParse (EfVane (VETerm ef)) -> io (dTerm ef) FailParse n -> logError $ display $ pack @Text (ppShow n) --- Compute Thread -------------------------------------------------------------- +-- Compute (Serf) Thread ------------------------------------------------------- logEvent :: HasLogFunc e => Ev -> RIO e () logEvent ev = logDebug $ display $ "[EVENT]\n" <> pretty @@ -473,8 +474,9 @@ runCompute serf ComputeConfig {..} = do void $ async $ forever (atomically (takeTMVar vEvProcessing) >>= logEvent) let onSpin :: Maybe Ev -> STM () - onSpin Nothing = ccHideSpinner - onSpin (Just ev) = do + onSpin = \case + Nothing -> ccHideSpinner + Just ev -> do ccShowSpinner (getSpinnerNameForEvent ev) putTMVar vEvProcessing ev @@ -483,7 +485,7 @@ runCompute serf ComputeConfig {..} = do io (Serf.run serf maxBatchSize ccLastEvInLog onCR ccPutResult onSpin) --- Persist Thread -------------------------------------------------------------- +-- Event-Log Persistence Thread ------------------------------------------------ data PersistExn = BadEventId EventId EventId deriving Show diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index 5bc194ae8..df479c94d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -107,14 +107,10 @@ data Order deriveToNoun ''Order -type EffCb e a = a -> RIO e () - -type Perform = Ef -> IO () - data IODriver = IODriver - { bornEvent :: IO Ev - , startDriver :: (Ev -> STM ()) -> IO (Async (), Perform) - } + { bornEvent :: IO Ev + , startDriver :: (Ev -> STM ()) -> IO (Async (), Ef -> IO ()) + } data Fact = Fact { factEve :: EventId diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index 40fd1581b..7fe9bb2b1 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -505,7 +505,7 @@ term :: forall e. (HasPierEnv e) => e -> (T.TSize, Client) -> (EvErr -> STM ()) - -> ([EvErr], RAcquire e (EffCb e TermEf)) + -> ([EvErr], RAcquire e (TermEf -> IO ())) term env (tsize, Client{..}) plan = (initialEvents, runTerm) where @@ -516,10 +516,10 @@ term env (tsize, Client{..}) plan = , EvErr initialHail (initialHailFailed env) ] - runTerm :: RAcquire e (EffCb e TermEf) + runTerm :: RAcquire e (TermEf -> IO ()) runTerm = do tim <- mkRAcquire (async readLoop) cancel - pure handleEffect + pure (runRIO env . handleEffect) {- Because our terminals are always `Demux`ed, we don't have to From 6ab2d78d7bdff3497edf79e470fb383ea6b5d17b Mon Sep 17 00:00:00 2001 From: ~siprel Date: Sun, 7 Jun 2020 00:26:59 +0000 Subject: [PATCH 119/257] king: Progress bars on replay. --- pkg/hs/urbit-king/TODO.md | 5 +-- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 37 ++++++++++++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 7 ++-- 4 files changed, 38 insertions(+), 13 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 1cadbef8b..1dacb9ff9 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -15,7 +15,6 @@ Stubbed out: - [x] Snapshots should block until that event is commited to disk. - [x] Hook up error callbacks to IO Drivers. - [x] Do something useful with error callbacks from IO Drivers. -- [ ] Make sure replay progress bars go to stderr. Bugs: @@ -37,9 +36,11 @@ Polish: - [x] Cleanup batching flow. - [x] Think through how to shutdown the serf on exception. - [x] King should shutdown promptly on ^C. Always takes 2s in practice. +- [x] Bring back progress bars. +- [x] Make sure replay progress bars go to stderr. - [ ] Logging for new IPC flow. - [ ] Logging for boot sequence. -- [ ] Bring back progress bars. +- [ ] Take snapshots on clean shutdown. # Misc Bugs diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 2a4666c5d..65c2e859f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -184,7 +184,7 @@ resumed -> Maybe Word64 -> [Serf.Flag] -> RAcquire PierEnv (Serf, EventLog) -resumed vSlog replayUntil flags = do +resumed vSlog replayUntil flags = do rio $ logTrace "Resuming ship" top <- view pierPathL tap <- fmap (fromMaybe top) $ rio $ runMaybeT $ do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 403226657..72ee1a04d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -20,14 +20,16 @@ import Control.Monad.Trans.Resource (runResourceT) import Urbit.Arvo (FX) import qualified Data.Conduit.Combinators as CC +import qualified System.ProgressBar as PB import qualified Urbit.Vere.Log as Log +import Urbit.King.App (HasStderrLogFunc(..)) + import qualified Urbit.Vere.Serf.IPC as X (Config(..), EvErr(..), Flag(..), RunReq(..), Serf, WorkError(..), run, snapshot, start, stop) -- ort System.ProgressBar --- ort Urbit.King.App (HasStderrLogFunc(..)) -- ort qualified Urbit.Ob as Ob -- ort qualified Urbit.Time as Time @@ -56,7 +58,7 @@ withSerf config = mkRAcquire startup kill execReplay :: forall e - . HasLogFunc e + . (HasLogFunc e, HasStderrLogFunc e) => Serf -> Log.EventLog -> Maybe Word64 @@ -107,20 +109,41 @@ execReplay serf log last = do when (numEvs < 0) $ do error "impossible" + incProgress <- logStderr (trackProgress (fromIntegral numEvs)) + logTrace $ display $ "Replaying up to event #" <> tshow replayUpTo logTrace $ display $ "Will replay " <> tshow numEvs <> " in total." env <- ask - let onProgress n = do - runRIO env $ logTrace $ display ("Serf is at event# " <> tshow n) - - runResourceT + res <- runResourceT $ runConduit $ Log.streamEvents log (lastEventInSnap + 1) .| CC.take (fromIntegral numEvs) .| CC.mapM (fmap snd . parseLogRow) - .| replay 10 onProgress serf + .| replay 5 incProgress serf + + pure res + +logStderr :: HasStderrLogFunc e => RIO LogFunc a -> RIO e a +logStderr action = do + logFunc <- view stderrLogFuncL + runRIO logFunc action + +trackProgress + :: HasLogFunc e + => Word64 + -> RIO e (Int -> IO ()) +trackProgress = \case + 0 -> pure $ const $ pure () + num -> do + let style = PB.defStyle { PB.stylePostfix = PB.exact } + let refresh = 10 + let init = PB.Progress 0 (fromIntegral num) () + bar <- PB.newProgressBar style refresh init + env <- ask + let incr = PB.incProgress bar + pure (runRIO env . incr) -- Collect FX ------------------------------------------------------------------ diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 5a5257103..50059e6dd 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -481,7 +481,7 @@ replay :: forall m . (MonadResource m, MonadUnliftIO m, MonadIO m) => Int - -> (EventId -> IO ()) + -> (Int -> IO ()) -> Serf -> ConduitT Noun Void m (Maybe PlayBail) replay batchSize cb serf = do @@ -491,7 +491,6 @@ replay batchSize cb serf = do where loop :: SerfState -> ConduitT Noun Void m (Maybe PlayBail, SerfState) loop ss@(SerfState lastEve lastMug) = do - io (cb lastEve) awaitBatch batchSize >>= \case [] -> pure (Nothing, SerfState lastEve lastMug) evs -> do @@ -500,7 +499,9 @@ replay batchSize cb serf = do io $ sendWrit serf (WPlay nexEve evs) io (recvPlay serf) >>= \case PBail bail -> pure (Just bail, SerfState lastEve lastMug) - PDone newMug -> loop (SerfState newEve newMug) + PDone newMug -> do + io (cb $ length evs) + loop (SerfState newEve newMug) {-| TODO If this is slow, use a mutable vector instead of reversing a list. From 21975cf92943a1f96d2d277595a3730e69d9767b Mon Sep 17 00:00:00 2001 From: ~siprel Date: Sun, 7 Jun 2020 23:35:54 +0000 Subject: [PATCH 120/257] King: Fixed a few bugs. --- pkg/hs/urbit-king/TODO.md | 6 +++++ pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 12 +++++++--- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 23 ++++++++------------ pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 6 ++++- 4 files changed, 29 insertions(+), 18 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 1dacb9ff9..36c48da82 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -18,6 +18,7 @@ Stubbed out: Bugs: +- [x] `king new` should reject pier directories that already exist. - [x] In non-daemon-mode, ^D doesn't bring down Urbit properly. King-Haskell specific features: @@ -104,3 +105,8 @@ data DriverApi = DriverApi type Driver = DriverConfig -> RIO e DriverApi ``` + +# Finding the Serf Executable + +Right now, `urbit-worker` is found by looking it up in the PATH. This +is wrong, but what is right? diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 65c2e859f..bb7dfd22a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -51,10 +51,17 @@ import qualified Urbit.Vere.Term.Render as Term -- Initialize pier directory. -------------------------------------------------- +data PierDirectoryAlreadyExists = PierDirectoryAlreadyExists + deriving (Show, Exception) + setupPierDirectory :: FilePath -> RIO e () setupPierDirectory shipPath = do + -- shipPath will already exist because we put a lock file there. + alreadyExists <- doesPathExist (shipPath ".urb") + when alreadyExists $ do + throwIO PierDirectoryAlreadyExists for_ ["put", "get", "log", "chk"] $ \seg -> do - let pax = shipPath <> "/.urb/" <> seg + let pax = shipPath ".urb" seg createDirectoryIfMissing True pax io $ setFileMode pax ownerModes @@ -301,7 +308,6 @@ pier (serf, log) vSlog mStart multi = do io $ atomically $ for_ bootEvents (writeTQueue computeQ) scryM <- newEmptyTMVarIO - onKill <- view onKillPierSigL let computeConfig = ComputeConfig { ccOnWork = readTQueue computeQ @@ -326,7 +332,7 @@ pier (serf, log) vSlog mStart multi = do -- TODO bullshit scry tester void $ acquireWorker "bullshit scry tester" $ forever $ do env <- ask - threadDelay 1_000_000 + threadDelay 15_000_000 wen <- io Time.now let kal = \mTermNoun -> runRIO env $ do logTrace $ displayShow ("scry result: ", mTermNoun) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 72ee1a04d..fc856ee65 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -29,17 +29,6 @@ import qualified Urbit.Vere.Serf.IPC as X (Config(..), EvErr(..), Flag(..), RunReq(..), Serf, WorkError(..), run, snapshot, start, stop) --- ort System.ProgressBar --- ort qualified Urbit.Ob as Ob --- ort qualified Urbit.Time as Time - - --------------------------------------------------------------------------------- - --- TODO XXX HACK FIXME -data MissingBootEventsInEventLog = MissingBootEventsInEventLog Word Word - deriving (Show, Exception) - -------------------------------------------------------------------------------- @@ -83,9 +72,15 @@ execReplay serf log last = do when (numEvs /= bootSeqLen) $ do throwIO (MissingBootEventsInEventLog numEvs bootSeqLen) + logTrace $ display ("Sending " <> tshow numEvs <> " boot events to serf") + io (boot serf evs) >>= \case - Just err -> pure (Just err) - Nothing -> doReplay + Just err -> do + logTrace "Finished boot events, nothing more to replay." + pure (Just err) + Nothing -> do + logTrace "Finished boot events, moving on to more events from log." + doReplay doReplay :: RIO e (Maybe PlayBail) doReplay = do @@ -107,7 +102,7 @@ execReplay serf log last = do let numEvs :: Int = fromIntegral replayUpTo - fromIntegral lastEventInSnap when (numEvs < 0) $ do - error "impossible" + throwIO (SnapshotAheadOfLog logLastEv lastEventInSnap) incProgress <- logStderr (trackProgress (fromIntegral numEvs)) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 50059e6dd..14db17e14 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -48,7 +48,8 @@ -} module Urbit.Vere.Serf.IPC - ( Serf + ( SerfExn(..) + , Serf , Config(..) , PlayBail(..) , Flag(..) @@ -203,6 +204,8 @@ data SerfExn | BailDuringReplay EventId [Goof] | SwapDuringReplay EventId Mug (Wen, Noun) FX | SerfNotRunning + | MissingBootEventsInEventLog Word Word + | SnapshotAheadOfLog EventId EventId deriving (Show, Exception) -- Access Current Serf State --------------------------------------------------- @@ -465,6 +468,7 @@ forcefullyKillSerf serf = do boot :: Serf -> [Noun] -> IO (Maybe PlayBail) boot serf@Serf {..} seq = do withSerfLockIO serf $ \ss -> do + sendWrit serf (WPlay 1 seq) recvPlay serf >>= \case PBail bail -> pure (ss, Just bail) PDone mug -> pure (SerfState (fromIntegral $ length seq) mug, Nothing) From a88849743c64e9adb4cacad12a82314fd1d817fb Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 8 Jun 2020 01:13:28 +0000 Subject: [PATCH 121/257] king: Module re-org in prepraration for new IO-Driver interface. --- pkg/hs/urbit-king/TODO.md | 21 ++- pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs | 30 ++- .../urbit-king/lib/Urbit/Vere/Pier/Types.hs | 66 ++----- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 176 +++++------------- .../urbit-king/lib/Urbit/Vere/Serf/Types.hs | 119 ++++++++++++ 5 files changed, 228 insertions(+), 184 deletions(-) create mode 100644 pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 36c48da82..c83e3451e 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -89,23 +89,26 @@ Should have a io-driver-boot stage. - No semantically important communication without outside world can happen until all drivers are up. -Something like: +Current IO Driver interface is something like: ``` -data DriverConfig = DriverConfig - { onAllDriversUp :: STM () - } +behn :: KingId -> (EvErr -> STM ()) -> ([EvErr], Acquire (BehnEf -> IO ())) +``` +New Interface should be something like: + +``` data DriverApi = DriverApi - { eventQueue :: STM (Maybe RunReq) - , effectSink :: Effect -> STM () - , blockUntilUp :: STM () - , killDriver :: STM () + { eventQueue :: STM (Maybe RunReq) + , effectSink :: Effect -> STM () + , blockUntilBorn :: STM () } -type Driver = DriverConfig -> RIO e DriverApi +behn :: HasPierEnv e => RAcquire e DriverApi ``` +where `PierEnv` contains `blockUntilAllDriversBorn :: STM ()`. + # Finding the Serf Executable Right now, `urbit-worker` is found by looking it up in the PATH. This diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs index 91d6fb70d..936d470a6 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs @@ -2,13 +2,13 @@ Behn: Timer Driver -} -module Urbit.Vere.Behn (behn) where +module Urbit.Vere.Behn (behn, DriverApi(..), behn') where import Urbit.Arvo hiding (Behn) import Urbit.Prelude import Urbit.Vere.Pier.Types -import Urbit.King.App (HasKingId(..)) +import Urbit.King.App (HasPierEnv(..), HasKingId(..)) import Urbit.Time (Wen) import Urbit.Timer (Timer) @@ -18,6 +18,27 @@ import qualified Urbit.Timer as Timer -- Behn Stuff ------------------------------------------------------------------ +behn' :: HasPierEnv e => RAcquire e DriverApi +behn' = do + ventQ <- newTQueueIO + bornM <- newEmptyTMVarIO + fectM <- newEmptyTMVarIO + + env <- ask + let (bootEvs, start) = behn env (writeTQueue ventQ) + for_ bootEvs (atomically . writeTQueue ventQ) + + diOnEffect <- liftAcquire start + + let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + + let diBlockUntilBorn = readTMVar bornM + + -- TODO Do this after successful born event. + atomically $ putTMVar bornM () + + pure (DriverApi {..}) + bornEv :: KingId -> Ev bornEv king = EvBlip $ BlipEvBehn $ BehnEvBorn (king, ()) () @@ -34,7 +55,10 @@ wakeErr :: WorkError -> IO () wakeErr _ = pure () behn - :: HasKingId e => e -> (EvErr -> STM ()) -> ([EvErr], Acquire (BehnEf -> IO ())) + :: HasKingId e + => e + -> (EvErr -> STM ()) + -> ([EvErr], Acquire (BehnEf -> IO ())) behn env enqueueEv = (initialEvents, runBehn) where diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index df479c94d..350c6b9f3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -3,14 +3,27 @@ TODO Most of these could probably find better homes. -} -module Urbit.Vere.Pier.Types where +module Urbit.Vere.Pier.Types + ( module Urbit.Vere.Serf.Types + , LogIdentity(..) + , Pill(..) + , Job(..) + , LifeCyc(..) + , BootSeq(..) + , Work(..) + , jobId + , jobMug + , DriverApi(..) + ) +where import Urbit.Prelude hiding (Term) -import Urbit.Noun (Term) import Urbit.Arvo import Urbit.Time +import Urbit.Vere.Serf.Types + -- Avoid touching Nock values. ------------------------------------------------- @@ -28,32 +41,8 @@ instance Show Nock where show _ = "Nock" --- Events With Error Callbacks ------------------------------------------------- - -type Gang = Maybe (HoonSet Ship) - -type Goof = (Term, [Tank]) - -{-| - Two types of serf failures. - - - `RunSwap`: Event processing failed, but the serf replaced it with - another event which succeeded. - - - `RunBail`: Event processing failed and all attempt to replace it - with a failure-notice event also caused crashes. We are really fucked. --} -data WorkError - = RunSwap EventId Mug Wen Noun FX - | RunBail [Goof] - -data EvErr = EvErr Ev (WorkError -> IO ()) - - -------------------------------------------------------------------------------- -type EventId = Word64 - data Pill = Pill { pBootFormulas :: [Nock] , pKernelOvums :: [Ev] @@ -96,27 +85,12 @@ jobMug (RunNok (LifeCyc _ mug _)) = mug jobMug (DoWork (Work _ mug _ _)) = mug --------------------------------------------------------------------------------- +-- API To IO Drivers ----------------------------------------------------------- -data Order - = OBoot Word -- lifecycle length - | OExit Word8 - | OSave EventId - | OWork Job - deriving (Eq, Show) - -deriveToNoun ''Order - -data IODriver = IODriver - { bornEvent :: IO Ev - , startDriver :: (Ev -> STM ()) -> IO (Async (), Ef -> IO ()) - } - -data Fact = Fact - { factEve :: EventId - , factMug :: Mug - , factWen :: Wen - , factNon :: Noun +data DriverApi = DriverApi + { diEventSource :: STM (Maybe RunReq) + , diOnEffect :: BehnEf -> IO () + , diBlockUntilBorn :: STM () } diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 14db17e14..c9302490a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -9,7 +9,7 @@ - A running serf can be asked to execute a boot sequence, replay from existing events, and run a ship with `boot`, `replay`, and `run`. - The running and replay flows will do batching of events to keep the + The `run` and `replay` flows will do batching of events to keep the IPC pipe full. ``` @@ -48,14 +48,7 @@ -} module Urbit.Vere.Serf.IPC - ( SerfExn(..) - , Serf - , Config(..) - , PlayBail(..) - , Flag(..) - , WorkError(..) - , EvErr(..) - , RunReq(..) + ( Serf , start , stop , serfLastEventBlocking @@ -66,6 +59,7 @@ module Urbit.Vere.Serf.IPC , replay , run , swim + , module Urbit.Vere.Serf.Types ) where @@ -74,8 +68,7 @@ import Urbit.Prelude hiding ((<|)) import Data.Bits import Data.Conduit import System.Process -import Urbit.Arvo -import Urbit.Vere.Pier.Types hiding (Work) +import Urbit.Vere.Serf.Types import Control.Monad.STM (retry) import Control.Monad.Trans.Resource (MonadResource, allocate, runResourceT) @@ -85,6 +78,7 @@ import Foreign.Ptr (castPtr) import Foreign.Storable (peek, poke) import RIO.Prelude (decodeUtf8Lenient) import System.Posix.Signals (sigKILL, signalProcess) +import Urbit.Arvo (Ev, FX) import Urbit.Time (Wen) import qualified Data.ByteString as BS @@ -93,7 +87,18 @@ import qualified System.IO.Error as IO import qualified Urbit.Time as Time --- IPC Types ------------------------------------------------------------------- +-- Serf API -------------------------------------------------------------------- + +data Serf = Serf + { serfSend :: Handle + , serfRecv :: Handle + , serfProc :: ProcessHandle + , serfSlog :: Slog -> IO () + , serfLock :: MVar (Maybe SerfState) + } + + +-- Internal Protocol Types ----------------------------------------------------- data Live = LExit Atom -- exit status code @@ -101,8 +106,6 @@ data Live | LPack EventId deriving (Show) -type PlayBail = (EventId, Mug, Goof) - data Play = PDone Mug | PBail PlayBail @@ -121,27 +124,6 @@ data Writ | WWork Wen Ev deriving (Show) -data RipeInfo = RipeInfo - { riProt :: Atom - , riHoon :: Atom - , riNock :: Atom - } - deriving (Show) - -data SerfState = SerfState - { ssLast :: EventId - , ssHash :: Mug - } - deriving (Show, Eq) - -data SerfInfo = SerfInfo - { siRipe :: RipeInfo - , siStat :: SerfState - } - deriving (Show) - -type Slog = (Atom, Tank) - data Plea = PLive () | PRipe SerfInfo @@ -155,59 +137,9 @@ deriveNoun ''Live deriveNoun ''Play deriveNoun ''Work deriveNoun ''Writ -deriveNoun ''RipeInfo -deriveNoun ''SerfState -deriveNoun ''SerfInfo deriveNoun ''Plea --- Serf API Types -------------------------------------------------------------- - -data Serf = Serf - { serfSend :: Handle - , serfRecv :: Handle - , serfProc :: ProcessHandle - , serfSlog :: Slog -> IO () - , serfLock :: MVar (Maybe SerfState) - } - -data Flag - = DebugRam - | DebugCpu - | CheckCorrupt - | CheckFatal - | Verbose - | DryRun - | Quiet - | Hashless - | Trace - deriving (Eq, Ord, Show, Enum, Bounded) - -data Config = Config - { scSerf :: FilePath -- Where is the urbit-worker executable? - , scPier :: FilePath -- Where is the pier directory? - , scFlag :: [Flag] -- Serf execution flags. - , scSlog :: Slog -> IO () -- What to do with slogs? - , scStdr :: Text -> IO () -- What to do with lines from stderr? - , scDead :: IO () -- What to do when the serf process goes down? - } - - --- Exceptions ------------------------------------------------------------------ - -data SerfExn - = UnexpectedPlea Plea Text - | BadPleaAtom Atom - | BadPleaNoun Noun [Text] Text - | SerfConnectionClosed - | SerfHasShutdown - | BailDuringReplay EventId [Goof] - | SwapDuringReplay EventId Mug (Wen, Noun) FX - | SerfNotRunning - | MissingBootEventsInEventLog Word Word - | SnapshotAheadOfLog EventId EventId - deriving (Show, Exception) - -- Access Current Serf State --------------------------------------------------- serfLastEventBlocking :: Serf -> IO EventId @@ -284,29 +216,29 @@ recvPleaHandlingSlog serf = loop recvRipe :: Serf -> IO SerfInfo recvRipe serf = recvPleaHandlingSlog serf >>= \case PRipe ripe -> pure ripe - plea -> throwIO (UnexpectedPlea plea "expecting %play") + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %play") recvPlay :: Serf -> IO Play recvPlay serf = recvPleaHandlingSlog serf >>= \case PPlay play -> pure play - plea -> throwIO (UnexpectedPlea plea "expecting %play") + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %play") recvLive :: Serf -> IO () recvLive serf = recvPleaHandlingSlog serf >>= \case PLive () -> pure () - plea -> throwIO (UnexpectedPlea plea "expecting %live") + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %live") recvWork :: Serf -> IO Work recvWork serf = do recvPleaHandlingSlog serf >>= \case PWork work -> pure work - plea -> throwIO (UnexpectedPlea plea "expecting %work") + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %work") recvPeek :: Serf -> IO (Maybe (Term, Noun)) recvPeek serf = do recvPleaHandlingSlog serf >>= \case PPeek peek -> pure peek - plea -> throwIO (UnexpectedPlea plea "expecting %peek") + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %peek") -- Request-Response Points -- These don't touch the lock ----------------------- @@ -394,30 +326,7 @@ withSerfLockIO :: Serf -> (SerfState -> IO (SerfState, a)) -> IO a withSerfLockIO s a = runResourceT (withSerfLock s (io . a)) --- Flows for Interacting with the Serf ----------------------------------------- - -{-| - Ask the serf to write a snapshot to disk. --} -snapshot :: Serf -> IO () -snapshot serf = withSerfLockIO serf $ \ss -> do - sendSnapshotRequest serf (ssLast ss) - pure (ss, ()) - -{-| - Ask the serf to de-duplicate and de-fragment it's heap. --} -compact :: Serf -> IO () -compact serf = withSerfLockIO serf $ \ss -> do - sendCompactionRequest serf (ssLast ss) - pure (ss, ()) - -{-| - Peek into the serf state. --} -scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) -scry serf w g p = withSerfLockIO serf $ \ss -> do - (ss,) <$> sendScryRequest serf w g p +-- Killing the Serf ------------------------------------------------------------ {-| Ask the serf to shutdown. If it takes more than 2s, kill it with @@ -460,6 +369,33 @@ forcefullyKillSerf serf = do io $ signalProcess sigKILL pid io $ void $ waitForProcess (serfProc serf) + +-- Flows for Interacting with the Serf ----------------------------------------- + +{-| + Ask the serf to write a snapshot to disk. +-} +snapshot :: Serf -> IO () +snapshot serf = withSerfLockIO serf $ \ss -> do + sendSnapshotRequest serf (ssLast ss) + pure (ss, ()) + +{-| + Ask the serf to de-duplicate and de-fragment it's heap. +-} +compact :: Serf -> IO () +compact serf = withSerfLockIO serf $ \ss -> do + sendCompactionRequest serf (ssLast ss) + pure (ss, ()) + +{-| + Peek into the serf state. +-} +scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) +scry serf w g p = withSerfLockIO serf $ \ss -> do + (ss,) <$> sendScryRequest serf w g p + + {-| Given a list of boot events, send them to to the serf in a single %play message. They must all be sent in a single %play event so that @@ -559,18 +495,6 @@ swim serf = do -- Running Ship Flow ----------------------------------------------------------- -{- - - RRWork: Ask the serf to do work, will output (Fact, FX) if work - succeeded and call callback on failure. - - RRSave: Wait for the serf to finish all pending work --} -data RunReq - = RRWork EvErr - | RRSave () - | RRKill () - | RRPack () - | RRScry Wen Gang Path (Maybe (Term, Noun) -> IO ()) - {-| TODO Don't take snapshot until event log has processed current event. -} diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs new file mode 100644 index 000000000..7949a1524 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs @@ -0,0 +1,119 @@ +module Urbit.Vere.Serf.Types where + +import Urbit.Prelude + +import Urbit.Arvo (Ev, FX) +import Urbit.Time (Wen) + + +-- Types ----------------------------------------------------------------------- + +type EventId = Word64 + +type PlayBail = (EventId, Mug, Goof) + +type Slog = (Atom, Tank) + +data SerfState = SerfState + { ssLast :: EventId + , ssHash :: Mug + } + deriving (Show, Eq) + +data RipeInfo = RipeInfo + { riProt :: Atom + , riHoon :: Atom + , riNock :: Atom + } + deriving (Show) + +data SerfInfo = SerfInfo + { siRipe :: RipeInfo + , siStat :: SerfState + } + deriving (Show) + +data Fact = Fact + { factEve :: EventId + , factMug :: Mug + , factWen :: Wen + , factNon :: Noun + } + +data Flag + = DebugRam + | DebugCpu + | CheckCorrupt + | CheckFatal + | Verbose + | DryRun + | Quiet + | Hashless + | Trace + deriving (Eq, Ord, Show, Enum, Bounded) + +data Config = Config + { scSerf :: FilePath -- Where is the urbit-worker executable? + , scPier :: FilePath -- Where is the pier directory? + , scFlag :: [Flag] -- Serf execution flags. + , scSlog :: Slog -> IO () -- What to do with slogs? + , scStdr :: Text -> IO () -- What to do with lines from stderr? + , scDead :: IO () -- What to do when the serf process goes down? + } + + +-- Serf Commands --------------------------------------------------------------- + +type Gang = Maybe (HoonSet Ship) + +type Goof = (Term, [Tank]) + +data EvErr = EvErr Ev (WorkError -> IO ()) + +{-| + Two types of serf failures. + + - `RunSwap`: Event processing failed, but the serf replaced it with + another event which succeeded. + + - `RunBail`: Event processing failed and all attempt to replace it + with a failure-notice event also caused crashes. We are really fucked. +-} +data WorkError + = RunSwap EventId Mug Wen Noun FX + | RunBail [Goof] + +{- + - RRWork: Ask the serf to do work, will output (Fact, FX) if work + succeeded and call callback on failure. + - RRSave: Wait for the serf to finish all pending work +-} +data RunReq + = RRWork EvErr + | RRSave () + | RRKill () + | RRPack () + | RRScry Wen Gang Path (Maybe (Term, Noun) -> IO ()) + + +-- Exceptions ------------------------------------------------------------------ + +data SerfExn + = UnexpectedPlea Noun Text + | BadPleaAtom Atom + | BadPleaNoun Noun [Text] Text + | SerfConnectionClosed + | SerfHasShutdown + | BailDuringReplay EventId [Goof] + | SwapDuringReplay EventId Mug (Wen, Noun) FX + | SerfNotRunning + | MissingBootEventsInEventLog Word Word + | SnapshotAheadOfLog EventId EventId + deriving (Show, Exception) + + +-- Instances ------------------------------------------------------------------- + +deriveNoun ''RipeInfo +deriveNoun ''SerfInfo +deriveNoun ''SerfState From f3e484d5cd9f5e26c167f0e33e84f6273aaa6e4f Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 8 Jun 2020 01:29:29 +0000 Subject: [PATCH 122/257] king: TODO notes about how to break into packages. --- pkg/hs/urbit-king/TODO.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index c83e3451e..3b2d74df0 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -59,7 +59,12 @@ Polish: - [ ] Break most logic from `Main.hs` out into modules. - [ ] Simplify `Main.hs` flows. - [ ] Cleanup Terminal Driver code. +- [ ] Spin off `RAcquire` into it's own package. - [ ] Spin off `Urbit.Noun` into it's own package. +- [ ] Spin off `Urbit.Vere.Log` into it's own package. +- [ ] Spin off `Urbit.Vere.Serf` into it's own package, and make it care + less about the shape of events and effects. +- [ ] Spin off per-pier logic into it's own package. # Event Prioritization From ba50eb94cdb7a4b721f6e9bd504760bd4606781c Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 8 Jun 2020 17:24:05 +0000 Subject: [PATCH 123/257] king: Spin off `urbit-noun-core` and `urbit-noun` packages. --- pkg/hs/stack.yaml | 2 + pkg/hs/urbit-king/TODO.md | 2 +- pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs | 2 +- .../urbit-king/lib/Urbit/King/EventBrowser.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs | 6 +- pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs | 10 +-- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 4 +- .../urbit-king/lib/Urbit/Vere/Pier/Types.hs | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 4 +- .../urbit-king/lib/Urbit/Vere/Serf/Types.hs | 4 +- pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 2 +- pkg/hs/urbit-king/package.yaml | 2 + pkg/hs/urbit-king/test/AmesTests.hs | 24 +++--- pkg/hs/urbit-king/test/ArvoTests.hs | 2 +- pkg/hs/urbit-king/test/BehnTests.hs | 8 +- pkg/hs/urbit-noun-core/.gitignore | 3 + pkg/hs/urbit-noun-core/LICENSE | 21 ++++++ .../lib/Urbit/Noun/Convert.hs | 0 .../lib/Urbit/Noun/Core.hs | 0 .../lib/Urbit/Noun/Cue.hs | 0 .../lib/Urbit/Noun/Jam.hs | 0 .../lib/Urbit/Noun/TH.hs | 0 pkg/hs/urbit-noun-core/package.yaml | 71 ++++++++++++++++++ pkg/hs/urbit-noun/.gitignore | 3 + pkg/hs/urbit-noun/LICENSE | 21 ++++++ .../lib/Urbit/Noun.hs | 0 .../lib/Urbit/Noun/Conversions.hs | 0 .../lib/Urbit/Noun/Tank.hs | 0 .../lib/Urbit/Noun}/Time.hs | 2 +- .../lib/Urbit/Noun/Tree.hs | 0 pkg/hs/urbit-noun/package.yaml | 73 +++++++++++++++++++ 32 files changed, 235 insertions(+), 37 deletions(-) create mode 100644 pkg/hs/urbit-noun-core/.gitignore create mode 100644 pkg/hs/urbit-noun-core/LICENSE rename pkg/hs/{urbit-king => urbit-noun-core}/lib/Urbit/Noun/Convert.hs (100%) rename pkg/hs/{urbit-king => urbit-noun-core}/lib/Urbit/Noun/Core.hs (100%) rename pkg/hs/{urbit-king => urbit-noun-core}/lib/Urbit/Noun/Cue.hs (100%) rename pkg/hs/{urbit-king => urbit-noun-core}/lib/Urbit/Noun/Jam.hs (100%) rename pkg/hs/{urbit-king => urbit-noun-core}/lib/Urbit/Noun/TH.hs (100%) create mode 100644 pkg/hs/urbit-noun-core/package.yaml create mode 100644 pkg/hs/urbit-noun/.gitignore create mode 100644 pkg/hs/urbit-noun/LICENSE rename pkg/hs/{urbit-king => urbit-noun}/lib/Urbit/Noun.hs (100%) rename pkg/hs/{urbit-king => urbit-noun}/lib/Urbit/Noun/Conversions.hs (100%) rename pkg/hs/{urbit-king => urbit-noun}/lib/Urbit/Noun/Tank.hs (100%) rename pkg/hs/{urbit-king/lib/Urbit => urbit-noun/lib/Urbit/Noun}/Time.hs (99%) rename pkg/hs/{urbit-king => urbit-noun}/lib/Urbit/Noun/Tree.hs (100%) create mode 100644 pkg/hs/urbit-noun/package.yaml diff --git a/pkg/hs/stack.yaml b/pkg/hs/stack.yaml index c18632ee3..e767dc5b8 100644 --- a/pkg/hs/stack.yaml +++ b/pkg/hs/stack.yaml @@ -7,6 +7,8 @@ packages: - urbit-atom - urbit-azimuth - urbit-king + - urbit-noun + - urbit-noun-core extra-deps: - flat-0.3.4@sha256:002a0e0ae656ea8cc02a772d0bcb6ea7dbd7f2e79070959cc748ad1e7138eb38 diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 3b2d74df0..51f7ba5a2 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -60,7 +60,7 @@ Polish: - [ ] Simplify `Main.hs` flows. - [ ] Cleanup Terminal Driver code. - [ ] Spin off `RAcquire` into it's own package. -- [ ] Spin off `Urbit.Noun` into it's own package. +- [x] Spin off `urbit-noun-core` and `urbit-noun` packages. - [ ] Spin off `Urbit.Vere.Log` into it's own package. - [ ] Spin off `Urbit.Vere.Serf` into it's own package, and make it care less about the shape of events and effects. diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs index e5c9be159..1f3ef9d50 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs @@ -3,8 +3,8 @@ -} module Urbit.Arvo.Effect where +import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Time import Urbit.Arvo.Common (KingId(..), ServId(..)) import Urbit.Arvo.Common (Header, HttpEvent, HttpServerConf, Method, Mime) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs index 020cab13e..75cb6fcf3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs @@ -10,7 +10,7 @@ import Urbit.Prelude import Data.Conduit import Urbit.Arvo -import Urbit.Time +import Urbit.Noun.Time import Urbit.Vere.Pier.Types import Control.Monad.Trans.Maybe (MaybeT(..)) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 25fd34007..6eeed7dd4 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -96,7 +96,7 @@ import Urbit.King.App (killKingActionL, onKillKingSigL) import Urbit.King.App (killPierActionL) import Urbit.King.App (runKingEnvLogFile, runKingEnvStderr, runPierEnv) import Urbit.Noun.Conversions (cordToUW) -import Urbit.Time (Wen) +import Urbit.Noun.Time (Wen) import Urbit.Vere.LockFile (lockFile) import qualified Data.Set as Set diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs index f6e5bd763..f16f6a55a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs @@ -64,9 +64,9 @@ import Urbit.Prelude import Network.Socket hiding (recvFrom, sendTo) import Urbit.Arvo hiding (Fake) -import qualified Data.Map as M -import qualified Urbit.Ob as Ob -import qualified Urbit.Time as Time +import qualified Data.Map as M +import qualified Urbit.Noun.Time as Time +import qualified Urbit.Ob as Ob -- Types ----------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs index 936d470a6..5facb8001 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs @@ -8,12 +8,12 @@ import Urbit.Arvo hiding (Behn) import Urbit.Prelude import Urbit.Vere.Pier.Types -import Urbit.King.App (HasPierEnv(..), HasKingId(..)) -import Urbit.Time (Wen) -import Urbit.Timer (Timer) +import Urbit.King.App (HasKingId(..), HasPierEnv(..)) +import Urbit.Noun.Time (Wen) +import Urbit.Timer (Timer) -import qualified Urbit.Time as Time -import qualified Urbit.Timer as Timer +import qualified Urbit.Noun.Time as Time +import qualified Urbit.Timer as Timer -- Behn Stuff ------------------------------------------------------------------ diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index bb7dfd22a..06fc38b56 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -28,7 +28,7 @@ import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) import Urbit.King.App (onKillPierSigL) -import Urbit.Time (Wen) +import Urbit.Noun.Time (Wen) import Urbit.Vere.Ames (ames) import Urbit.Vere.Behn (behn) import Urbit.Vere.Clay (clay) @@ -40,7 +40,7 @@ import Urbit.Vere.Serf (Serf) import qualified System.Entropy as Ent import qualified Urbit.King.API as King -import qualified Urbit.Time as Time +import qualified Urbit.Noun.Time as Time import qualified Urbit.Vere.Log as Log import qualified Urbit.Vere.Serf as Serf import qualified Urbit.Vere.Term as Term diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index 350c6b9f3..5136041d8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -20,7 +20,7 @@ where import Urbit.Prelude hiding (Term) import Urbit.Arvo -import Urbit.Time +import Urbit.Noun.Time import Urbit.Vere.Serf.Types diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index c9302490a..100b68a56 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -79,12 +79,12 @@ import Foreign.Storable (peek, poke) import RIO.Prelude (decodeUtf8Lenient) import System.Posix.Signals (sigKILL, signalProcess) import Urbit.Arvo (Ev, FX) -import Urbit.Time (Wen) +import Urbit.Noun.Time (Wen) import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS import qualified System.IO.Error as IO -import qualified Urbit.Time as Time +import qualified Urbit.Noun.Time as Time -- Serf API -------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs index 7949a1524..7d772a30d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs @@ -2,8 +2,8 @@ module Urbit.Vere.Serf.Types where import Urbit.Prelude -import Urbit.Arvo (Ev, FX) -import Urbit.Time (Wen) +import Urbit.Arvo (Ev, FX) +import Urbit.Noun.Time (Wen) -- Types ----------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index 7fe9bb2b1..d36ad0582 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -18,8 +18,8 @@ import RIO.FilePath import System.Posix.IO import System.Posix.Terminal import Urbit.Arvo hiding (Term) +import Urbit.Noun.Time import Urbit.Prelude hiding (getCurrentTime) -import Urbit.Time import Urbit.Vere.Pier.Types import Data.List ((!!)) diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml index 3128109bd..ca46db559 100644 --- a/pkg/hs/urbit-king/package.yaml +++ b/pkg/hs/urbit-king/package.yaml @@ -99,6 +99,8 @@ dependencies: - unliftio-core - unordered-containers - urbit-atom + - urbit-noun + - urbit-noun-core - urbit-azimuth - urbit-hob - utf8-string diff --git a/pkg/hs/urbit-king/test/AmesTests.hs b/pkg/hs/urbit-king/test/AmesTests.hs index d254abe4f..13e67546e 100644 --- a/pkg/hs/urbit-king/test/AmesTests.hs +++ b/pkg/hs/urbit-king/test/AmesTests.hs @@ -10,8 +10,8 @@ import Test.Tasty.TH import Urbit.Arvo import Urbit.King.Config import Urbit.Noun +import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Time import Urbit.Vere.Ames import Urbit.Vere.Log import Urbit.Vere.Pier.Types @@ -73,36 +73,38 @@ runNetworkApp = runRIO NetworkTestApp } runGala - :: forall e . HasAmes e => Word8 -> RAcquire e (TQueue EvErr, EffCb e NewtEf) + :: forall e + . HasAmes e + => Word8 + -> RAcquire e (TQueue EvErr, NewtEf -> IO ()) runGala point = do env <- ask que <- newTQueueIO let (_, runAmes) = ames env (fromIntegral point) True (writeTQueue que) noStderr cb <- runAmes - rio $ cb turfEf + io (cb turfEf) pure (que, cb) where noStderr _ = pure () waitForPacket :: TQueue EvErr -> Bytes -> IO Bool waitForPacket q val = go - where - go = - atomically (readTQueue q) >>= \case - EvErr (EvBlip (BlipEvNewt (NewtEvBorn (_, ()) ()))) _ -> go - EvErr (EvBlip (BlipEvAmes (AmesEvHear () _ bs))) _ -> pure (bs == val) - _ -> pure False + where + go = atomically (readTQueue q) >>= \case + EvErr (EvBlip (BlipEvNewt (NewtEvBorn (_, ()) ()))) _ -> go + EvErr (EvBlip (BlipEvAmes (AmesEvHear () _ bs))) _ -> pure (bs == val) + _ -> pure False runRAcquire :: RAcquire e a -> RIO e a runRAcquire acq = rwith acq pure -sendThread :: EffCb e NewtEf -> (Galaxy, Bytes) -> RAcquire e () +sendThread :: (NewtEf -> IO ()) -> (Galaxy, Bytes) -> RAcquire e () sendThread cb (to, val) = void $ mkRAcquire start cancel where start = async $ forever $ do threadDelay 1_000 wen <- io $ now - cb (sendEf to wen val) + io $ cb (sendEf to wen val) threadDelay 10_000 zodSelfMsg :: Property diff --git a/pkg/hs/urbit-king/test/ArvoTests.hs b/pkg/hs/urbit-king/test/ArvoTests.hs index 7dac215a3..6ee235746 100644 --- a/pkg/hs/urbit-king/test/ArvoTests.hs +++ b/pkg/hs/urbit-king/test/ArvoTests.hs @@ -10,8 +10,8 @@ import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.TH import Urbit.Arvo +import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Time import Urbit.Vere.Log import Urbit.Vere.Pier.Types diff --git a/pkg/hs/urbit-king/test/BehnTests.hs b/pkg/hs/urbit-king/test/BehnTests.hs index 40d5c2178..c207a71e6 100644 --- a/pkg/hs/urbit-king/test/BehnTests.hs +++ b/pkg/hs/urbit-king/test/BehnTests.hs @@ -10,8 +10,8 @@ import Test.Tasty.QuickCheck import Test.Tasty.TH import Urbit.Arvo import Urbit.Noun +import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Time import Urbit.Vere.Behn import Urbit.Vere.Log import Urbit.Vere.Pier.Types @@ -22,8 +22,8 @@ import GHC.Natural (Natural) import Network.Socket (tupleToHostAddress) import Urbit.King.App (runKingEnvNoLog, HasKingId(..)) -import qualified Urbit.Time as Time -import qualified Urbit.Vere.Log as Log +import qualified Urbit.Noun.Time as Time +import qualified Urbit.Vere.Log as Log -------------------------------------------------------------------------------- @@ -38,7 +38,7 @@ timerFires = forAll arbitrary (ioProperty . runKingEnvNoLog . runTest) king <- fromIntegral <$> view kingIdL q <- newTQueueIO rwith (liftAcquire $ snd $ behn envr (writeTQueue q)) $ \cb -> do - cb (BehnEfDoze (king, ()) (Just (2^20))) + io $ cb (BehnEfDoze (king, ()) (Just (2^20))) t <- atomically $ readTQueue q pure True diff --git a/pkg/hs/urbit-noun-core/.gitignore b/pkg/hs/urbit-noun-core/.gitignore new file mode 100644 index 000000000..65e7ea818 --- /dev/null +++ b/pkg/hs/urbit-noun-core/.gitignore @@ -0,0 +1,3 @@ +.stack-work +*.cabal +test/gold/*.writ diff --git a/pkg/hs/urbit-noun-core/LICENSE b/pkg/hs/urbit-noun-core/LICENSE new file mode 100644 index 000000000..bf9294e05 --- /dev/null +++ b/pkg/hs/urbit-noun-core/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 urbit + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Convert.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Convert.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Convert.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/Convert.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Core.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Core.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Core.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/Core.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Cue.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Cue.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Cue.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/Cue.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Jam.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/Jam.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Jam.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/Jam.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/TH.hs b/pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/TH.hs rename to pkg/hs/urbit-noun-core/lib/Urbit/Noun/TH.hs diff --git a/pkg/hs/urbit-noun-core/package.yaml b/pkg/hs/urbit-noun-core/package.yaml new file mode 100644 index 000000000..f9fee3374 --- /dev/null +++ b/pkg/hs/urbit-noun-core/package.yaml @@ -0,0 +1,71 @@ +name: urbit-noun-core +version: 0.10.4 +license: MIT +license-file: LICENSE + +library: + source-dirs: lib + ghc-options: + - -fwarn-incomplete-patterns + - -fwarn-unused-binds + - -fwarn-unused-imports + - -Werror + - -O2 + +dependencies: + - base + - QuickCheck + - ghc-prim + - hashable + - urbit-atom + - classy-prelude + - bytestring + - hashtables + - vector + - integer-gmp + - template-haskell + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - ConstraintKinds + - DataKinds + - DefaultSignatures + - DeriveAnyClass + - DeriveDataTypeable + - DeriveFoldable + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - EmptyCase + - EmptyDataDecls + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GADTs + - GeneralizedNewtypeDeriving + - LambdaCase + - MagicHash + - MultiParamTypeClasses + - NamedFieldPuns + - NoImplicitPrelude + - NumericUnderscores + - OverloadedStrings + - PackageImports + - PartialTypeSignatures + - PatternSynonyms + - QuasiQuotes + - Rank2Types + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TemplateHaskell + - TupleSections + - TypeApplications + - TypeFamilies + - TypeOperators + - UnboxedTuples + - UnicodeSyntax + - ViewPatterns diff --git a/pkg/hs/urbit-noun/.gitignore b/pkg/hs/urbit-noun/.gitignore new file mode 100644 index 000000000..65e7ea818 --- /dev/null +++ b/pkg/hs/urbit-noun/.gitignore @@ -0,0 +1,3 @@ +.stack-work +*.cabal +test/gold/*.writ diff --git a/pkg/hs/urbit-noun/LICENSE b/pkg/hs/urbit-noun/LICENSE new file mode 100644 index 000000000..bf9294e05 --- /dev/null +++ b/pkg/hs/urbit-noun/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 urbit + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Conversions.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Conversions.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Tank.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Tank.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs diff --git a/pkg/hs/urbit-king/lib/Urbit/Time.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs similarity index 99% rename from pkg/hs/urbit-king/lib/Urbit/Time.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs index a33fd982a..55122fcb3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Time.hs +++ b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs @@ -2,7 +2,7 @@ TODO This is slow. -} -module Urbit.Time where +module Urbit.Noun.Time where import Control.Lens import Prelude diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Tree.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Tree.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Tree.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Tree.hs diff --git a/pkg/hs/urbit-noun/package.yaml b/pkg/hs/urbit-noun/package.yaml new file mode 100644 index 000000000..d94be31f6 --- /dev/null +++ b/pkg/hs/urbit-noun/package.yaml @@ -0,0 +1,73 @@ +name: urbit-noun +version: 0.10.4 +license: MIT +license-file: LICENSE + +library: + source-dirs: lib + ghc-options: + - -fwarn-incomplete-patterns + - -fwarn-unused-binds + - -fwarn-unused-imports + - -Werror + - -O2 + +dependencies: + - base + - classy-prelude + - ghc-prim + - largeword + - lens + - murmur3 + - regex-tdfa + - regex-tdfa-text + - rio + - text + - time + - urbit-atom + - urbit-noun-core + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - ConstraintKinds + - DataKinds + - DefaultSignatures + - DeriveAnyClass + - DeriveDataTypeable + - DeriveFoldable + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - EmptyCase + - EmptyDataDecls + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GADTs + - GeneralizedNewtypeDeriving + - LambdaCase + - MagicHash + - MultiParamTypeClasses + - NamedFieldPuns + - NoImplicitPrelude + - NumericUnderscores + - OverloadedStrings + - PackageImports + - PartialTypeSignatures + - PatternSynonyms + - QuasiQuotes + - Rank2Types + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TemplateHaskell + - TupleSections + - TypeApplications + - TypeFamilies + - TypeOperators + - UnboxedTuples + - UnicodeSyntax + - ViewPatterns From ff646f4830c98317e1b3513337b9d7f52f9b62fa Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 8 Jun 2020 17:45:41 +0000 Subject: [PATCH 124/257] king: Snapshot on shutdown; no snapshot on start if no events to replay. --- pkg/hs/urbit-king/TODO.md | 6 +++--- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 6 +++--- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 12 ++++++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 18 +++++++++++------- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 7 +++++-- 5 files changed, 30 insertions(+), 19 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 51f7ba5a2..c9f671079 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -39,9 +39,9 @@ Polish: - [x] King should shutdown promptly on ^C. Always takes 2s in practice. - [x] Bring back progress bars. - [x] Make sure replay progress bars go to stderr. -- [ ] Logging for new IPC flow. -- [ ] Logging for boot sequence. -- [ ] Take snapshots on clean shutdown. +- [x] Logging for new IPC flow. +- [x] Logging for boot sequence. +- [x] Take snapshots on clean shutdown. # Misc Bugs diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 6eeed7dd4..f8bad8900 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -356,9 +356,9 @@ replayPartEvs top last = do rio $ do eSs <- Serf.execReplay serf log (Just last) case eSs of - Just bail -> error (show bail) - Nothing -> pure () - io (Serf.snapshot serf) + Left bail -> error (show bail) + Right 0 -> io (Serf.snapshot serf) + Right num -> pure () io $ threadDelay 500000 -- Copied from runOrExitImmediately pure () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 06fc38b56..e4b4dddb9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -206,10 +206,14 @@ resumed vSlog replayUntil flags = do rio $ do logTrace "Replaying events" - Serf.execReplay serf log replayUntil - logTrace "Taking snapshot" - io (Serf.snapshot serf) - logTrace "Shuting down the serf" + Serf.execReplay serf log replayUntil >>= \case + Left err -> error (show err) + Right 0 -> do + logTrace "No work during replay so no snapshot" + pure () + Right _ -> do + logTrace "Taking snapshot" + io (Serf.snapshot serf) pure (serf, log) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index fc856ee65..c6289b32d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -51,12 +51,12 @@ execReplay => Serf -> Log.EventLog -> Maybe Word64 - -> RIO e (Maybe PlayBail) + -> RIO e (Either PlayBail Word) execReplay serf log last = do lastEventInSnap <- io (serfLastEventBlocking serf) if lastEventInSnap == 0 then doBoot else doReplay where - doBoot :: RIO e (Maybe PlayBail) + doBoot :: RIO e (Either PlayBail Word) doBoot = do logTrace "Beginning boot sequence" @@ -76,13 +76,15 @@ execReplay serf log last = do io (boot serf evs) >>= \case Just err -> do - logTrace "Finished boot events, nothing more to replay." - pure (Just err) + logTrace "Error on replay, exiting" + pure (Left err) Nothing -> do logTrace "Finished boot events, moving on to more events from log." - doReplay + doReplay <&> \case + Left err -> Left err + Right num -> Right (num + numEvs) - doReplay :: RIO e (Maybe PlayBail) + doReplay :: RIO e (Either PlayBail Word) doReplay = do logTrace "Beginning event log replay" @@ -118,7 +120,9 @@ execReplay serf log last = do .| CC.mapM (fmap snd . parseLogRow) .| replay 5 incProgress serf - pure res + res & \case + Nothing -> pure (Right $ fromIntegral numEvs) + Just er -> pure (Left er) logStderr :: HasStderrLogFunc e => RIO LogFunc a -> RIO e a logStderr action = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 100b68a56..acd2610b4 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -512,7 +512,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop topLoop = atomically onInput >>= \case RRWork workErr -> doWork workErr RRSave () -> doSave - RRKill () -> pure () + RRKill () -> doKill RRPack () -> doPack RRScry w g p k -> doScry w g p k @@ -529,6 +529,9 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop doSave :: IO () doSave = waitForLog >> snapshot serf >> topLoop + doKill :: IO () + doKill = waitForLog >> snapshot serf >> pure () + doScry :: Wen -> Gang -> Path -> (Maybe (Term, Noun) -> IO ()) -> IO () doScry w g p k = (scry serf w g p >>= k) >> topLoop @@ -544,7 +547,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop workLoop :: TBMQueue EvErr -> IO (IO ()) workLoop que = atomically onInput >>= \case - RRKill () -> atomically (closeTBMQueue que) >> pure (pure ()) + RRKill () -> atomically (closeTBMQueue que) >> pure doKill RRSave () -> atomically (closeTBMQueue que) >> pure doSave RRPack () -> atomically (closeTBMQueue que) >> pure doPack RRScry w g p k -> atomically (closeTBMQueue que) >> pure (doScry w g p k) From 1f4c823d92cef72b2b4e46330d0e2703678021d5 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 8 Jun 2020 20:23:30 +0000 Subject: [PATCH 125/257] king: Separate package for `racquire` + small cleanup. --- pkg/hs/racquire/.gitignore | 3 + pkg/hs/racquire/LICENSE | 21 ++++++ .../lib/Data/RAcquire.hs | 0 pkg/hs/racquire/package.yaml | 66 +++++++++++++++++++ pkg/hs/stack.yaml | 1 + pkg/hs/urbit-king/TODO.md | 2 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 13 ++-- pkg/hs/urbit-king/package.yaml | 5 +- 8 files changed, 101 insertions(+), 10 deletions(-) create mode 100644 pkg/hs/racquire/.gitignore create mode 100644 pkg/hs/racquire/LICENSE rename pkg/hs/{urbit-king => racquire}/lib/Data/RAcquire.hs (100%) create mode 100644 pkg/hs/racquire/package.yaml diff --git a/pkg/hs/racquire/.gitignore b/pkg/hs/racquire/.gitignore new file mode 100644 index 000000000..65e7ea818 --- /dev/null +++ b/pkg/hs/racquire/.gitignore @@ -0,0 +1,3 @@ +.stack-work +*.cabal +test/gold/*.writ diff --git a/pkg/hs/racquire/LICENSE b/pkg/hs/racquire/LICENSE new file mode 100644 index 000000000..bf9294e05 --- /dev/null +++ b/pkg/hs/racquire/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 urbit + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/pkg/hs/urbit-king/lib/Data/RAcquire.hs b/pkg/hs/racquire/lib/Data/RAcquire.hs similarity index 100% rename from pkg/hs/urbit-king/lib/Data/RAcquire.hs rename to pkg/hs/racquire/lib/Data/RAcquire.hs diff --git a/pkg/hs/racquire/package.yaml b/pkg/hs/racquire/package.yaml new file mode 100644 index 000000000..36b562d11 --- /dev/null +++ b/pkg/hs/racquire/package.yaml @@ -0,0 +1,66 @@ +name: racquire +version: 0.10.4 +license: MIT +license-file: LICENSE + +library: + source-dirs: lib + ghc-options: + - -fwarn-incomplete-patterns + - -fwarn-unused-binds + - -fwarn-unused-imports + - -Werror + - -O2 + +dependencies: + - base + - mtl + - unliftio-core + - resourcet + - exceptions + - rio + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - ConstraintKinds + - DataKinds + - DefaultSignatures + - DeriveAnyClass + - DeriveDataTypeable + - DeriveFoldable + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - EmptyCase + - EmptyDataDecls + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GADTs + - GeneralizedNewtypeDeriving + - LambdaCase + - MagicHash + - MultiParamTypeClasses + - NamedFieldPuns + - NoImplicitPrelude + - NumericUnderscores + - OverloadedStrings + - PackageImports + - PartialTypeSignatures + - PatternSynonyms + - QuasiQuotes + - Rank2Types + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TemplateHaskell + - TupleSections + - TypeApplications + - TypeFamilies + - TypeOperators + - UnboxedTuples + - UnicodeSyntax + - ViewPatterns diff --git a/pkg/hs/stack.yaml b/pkg/hs/stack.yaml index e767dc5b8..5a3d0ba02 100644 --- a/pkg/hs/stack.yaml +++ b/pkg/hs/stack.yaml @@ -3,6 +3,7 @@ resolver: lts-14.21 packages: - lmdb-static - proto + - racquire - terminal-progress-bar - urbit-atom - urbit-azimuth diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index c9f671079..59a99f625 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -59,7 +59,7 @@ Polish: - [ ] Break most logic from `Main.hs` out into modules. - [ ] Simplify `Main.hs` flows. - [ ] Cleanup Terminal Driver code. -- [ ] Spin off `RAcquire` into it's own package. +- [x] Spin off `racquire` into it's own package. - [x] Spin off `urbit-noun-core` and `urbit-noun` packages. - [ ] Spin off `Urbit.Vere.Log` into it's own package. - [ ] Spin off `Urbit.Vere.Serf` into it's own package, and make it care diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index e4b4dddb9..6863f1cce 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -68,11 +68,11 @@ setupPierDirectory shipPath = do -- Load pill into boot sequence. ----------------------------------------------- -genEntropy :: RIO e Word512 +genEntropy :: MonadIO m => m Word512 genEntropy = fromIntegral . bytesAtom <$> io (Ent.getEntropy 64) -genBootSeq :: Ship -> Pill -> Bool -> LegacyBootEvent -> RIO e BootSeq -genBootSeq ship Pill {..} lite boot = do +genBootSeq :: MonadIO m => Ship -> Pill -> Bool -> LegacyBootEvent -> m BootSeq +genBootSeq ship Pill {..} lite boot = io $ do ent <- genEntropy let ovums = preKern ent <> pKernelOvums <> postKern <> pUserspaceOvums pure $ BootSeq ident pBootFormulas ovums @@ -289,14 +289,14 @@ pier (serf, log) vSlog mStart multi = do atomically $ Term.trace muxed txt oldSlog txt - let logId = Log.identity log - let ship = who logId + let logId = Log.identity log + let ship = who logId -- Our call above to set the logging function which echos errors from the -- Serf doesn't have the appended \r\n because those \r\n s are added in -- the c serf code. Logging output from our haskell process must manually -- add them. - let showErr = atomically . Term.trace muxed . (flip append "\r\n") + let showErr = atomically . Term.trace muxed . flip append "\r\n" env <- ask @@ -330,7 +330,6 @@ pier (serf, log) vSlog mStart multi = do tExec <- acquireWorker "Effects" (router (readTQueue executeQ) drivz) tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ plan) tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) - tSaveSignal <- saveSignalThread saveM -- TODO bullshit scry tester diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml index ca46db559..aa1d25367 100644 --- a/pkg/hs/urbit-king/package.yaml +++ b/pkg/hs/urbit-king/package.yaml @@ -72,6 +72,7 @@ dependencies: - primitive - process - QuickCheck + - racquire - random - regex-tdfa - regex-tdfa-text @@ -99,10 +100,10 @@ dependencies: - unliftio-core - unordered-containers - urbit-atom - - urbit-noun - - urbit-noun-core - urbit-azimuth - urbit-hob + - urbit-noun + - urbit-noun-core - utf8-string - vector - wai From 957f14ee4049fc0896ed439d4df9f7ade4f282df Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 8 Jun 2020 21:22:04 +0000 Subject: [PATCH 126/257] king: Minor cleanup. --- pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs | 40 ++++++++++---------- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 15 +++----- 2 files changed, 26 insertions(+), 29 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs index f82950da6..f23f82aa3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs @@ -55,24 +55,24 @@ wsConn :: (FromNoun i, ToNoun o, Show i, Show o, HasLogFunc e) -> WS.Connection -> RIO e () wsConn pre inp out wsc = do - logWarn (pre <> "(wcConn) Connected!") + logDebug (pre <> "(wcConn) Connected!") writer <- withRIOThread $ forever $ do - logWarn (pre <> "(wsConn) Waiting for data.") + logDebug (pre <> "(wsConn) Waiting for data.") byt <- io $ toStrict <$> WS.receiveData wsc - logWarn (pre <> "Got data") + logDebug (pre <> "Got data") dat <- cueBSExn byt >>= fromNounExn - logWarn (pre <> "(wsConn) Decoded data, writing to chan") + logDebug (pre <> "(wsConn) Decoded data, writing to chan") atomically $ writeTBMChan inp dat reader <- withRIOThread $ forever $ do - logWarn (pre <> "Waiting for data from chan") + logDebug (pre <> "Waiting for data from chan") atomically (readTBMChan out) >>= \case Nothing -> do - logWarn (pre <> "(wsConn) Connection closed") + logDebug (pre <> "(wsConn) Connection closed") error "dead-conn" Just msg -> do - logWarn (pre <> "(wsConn) Got message! " <> displayShow msg) + logDebug (pre <> "(wsConn) Got message! " <> displayShow msg) io $ WS.sendBinaryData wsc $ fromStrict $ jamBS $ toNoun msg let cleanup = do @@ -82,7 +82,7 @@ wsConn pre inp out wsc = do flip finally cleanup $ do res <- atomically (waitCatchSTM writer <|> waitCatchSTM reader) - logWarn $ displayShow (res :: Either SomeException ()) + logDebug $ displayShow (res :: Either SomeException ()) -------------------------------------------------------------------------------- @@ -111,7 +111,7 @@ wsServApp :: (HasLogFunc e, ToNoun o, FromNoun i, Show i, Show o) -> WS.PendingConnection -> RIO e () wsServApp cb pen = do - logError "NOUNSERV (wsServer) Got connection!" + logDebug "NOUNSERV (wsServer) Got connection!" wsc <- io $ WS.acceptRequest pen inp <- io $ newTBMChanIO 5 out <- io $ newTBMChanIO 5 @@ -125,10 +125,10 @@ wsServer = do tid <- async $ do env <- ask - logError "NOUNSERV (wsServer) Starting server" + logDebug "NOUNSERV (wsServer) Starting server" io $ WS.runServer "127.0.0.1" 9999 $ runRIO env . wsServApp (writeTBMChan con) - logError "NOUNSERV (wsServer) Server died" + logDebug "NOUNSERV (wsServer) Server died" atomically $ closeTBMChan con pure $ Server (readTBMChan con) tid 9999 @@ -147,34 +147,34 @@ example = Just (99, (), 44) testIt :: HasLogFunc e => RIO e () testIt = do - logTrace "(testIt) Starting Server" + logDebug "(testIt) Starting Server" Server{..} <- wsServer @Example @Example - logTrace "(testIt) Connecting" + logDebug "(testIt) Connecting" Client{..} <- wsClient @Example @Example "/" sData - logTrace "(testIt) Accepting connection" + logDebug "(testIt) Accepting connection" sConn <- fromJust "accept" =<< atomically sAccept let clientSend = do - logTrace "(testIt) Sending from client" + logDebug "(testIt) Sending from client" atomically (cSend cConn example) - logTrace "(testIt) Waiting for response" + logDebug "(testIt) Waiting for response" res <- atomically (cRecv sConn) print ("clientSend", res, example) unless (res == Just example) $ do error "Bad data" - logInfo "(testIt) Success" + logDebug "(testIt) Success" serverSend = do - logTrace "(testIt) Sending from server" + logDebug "(testIt) Sending from server" atomically (cSend sConn example) - logTrace "(testIt) Waiting for response" + logDebug "(testIt) Waiting for response" res <- atomically (cRecv cConn) print ("serverSend", res, example) unless (res == Just example) $ do error "Bad data" - logInfo "(testIt) Success" + logDebug "(testIt) Success" clientSend clientSend diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 6863f1cce..da39aa269 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -24,7 +24,6 @@ import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Pier.Types -import Data.Text (append) import System.Posix.Files (ownerModes, setFileMode) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) import Urbit.King.App (onKillPierSigL) @@ -240,7 +239,6 @@ acquireWorker nam act = mkRAcquire (async act) kill kill tid = do logTrace ("Killing worker thread: " <> display nam) cancel tid - logTrace ("Killed worker thread: " <> display nam) acquireWorkerBound :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) acquireWorkerBound nam act = mkRAcquire (asyncBound act) kill @@ -248,7 +246,6 @@ acquireWorkerBound nam act = mkRAcquire (asyncBound act) kill kill tid = do logTrace ("Killing worker thread: " <> display nam) cancel tid - logTrace ("Killed worker thread: " <> display nam) -- Run Pier -------------------------------------------------------------------- @@ -261,9 +258,9 @@ pier -> RAcquire PierEnv () pier (serf, log) vSlog mStart multi = do computeQ <- newTQueueIO @_ @Serf.EvErr - persistQ <- newTQueueIO - executeQ <- newTQueueIO - saveM <- newEmptyTMVarIO + persistQ <- newTQueueIO @_ @(Fact, FX) + executeQ <- newTQueueIO @_ @FX + saveM <- newEmptyTMVarIO @_ @() kingApi <- King.kingAPI termApiQ <- atomically $ do @@ -289,14 +286,14 @@ pier (serf, log) vSlog mStart multi = do atomically $ Term.trace muxed txt oldSlog txt - let logId = Log.identity log - let ship = who logId + let logId = Log.identity log :: LogIdentity + let ship = who logId :: Ship -- Our call above to set the logging function which echos errors from the -- Serf doesn't have the appended \r\n because those \r\n s are added in -- the c serf code. Logging output from our haskell process must manually -- add them. - let showErr = atomically . Term.trace muxed . flip append "\r\n" + let showErr = atomically . Term.trace muxed . (<> "\r\n") env <- ask From 528e1d29ff3f836fd87e6319b5dea173f3d17b44 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 8 Jun 2020 21:27:58 +0000 Subject: [PATCH 127/257] king: Separate out urbit-eventlog-lmdb package. --- pkg/hs/proto/package.yaml | 2 +- pkg/hs/stack.yaml | 1 + pkg/hs/urbit-eventlog-lmdb/.gitignore | 3 + pkg/hs/urbit-eventlog-lmdb/LICENSE | 21 ++++++ .../lib/Urbit/EventLog/LMDB.hs} | 72 +++++++++++++------ pkg/hs/urbit-eventlog-lmdb/package.yaml | 71 ++++++++++++++++++ pkg/hs/urbit-king/TODO.md | 7 +- .../urbit-king/lib/Urbit/King/EventBrowser.hs | 5 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 4 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 4 +- .../urbit-king/lib/Urbit/Vere/Pier/Types.hs | 10 +-- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 2 +- pkg/hs/urbit-king/package.yaml | 1 + pkg/hs/urbit-king/test/AmesTests.hs | 4 +- pkg/hs/urbit-king/test/ArvoTests.hs | 4 +- pkg/hs/urbit-king/test/BehnTests.hs | 6 +- pkg/hs/urbit-king/test/DeriveNounTests.hs | 4 +- pkg/hs/urbit-king/test/LogTests.hs | 4 +- 18 files changed, 175 insertions(+), 50 deletions(-) create mode 100644 pkg/hs/urbit-eventlog-lmdb/.gitignore create mode 100644 pkg/hs/urbit-eventlog-lmdb/LICENSE rename pkg/hs/{urbit-king/lib/Urbit/Vere/Log.hs => urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs} (90%) create mode 100644 pkg/hs/urbit-eventlog-lmdb/package.yaml diff --git a/pkg/hs/proto/package.yaml b/pkg/hs/proto/package.yaml index 046177079..4427b1161 100644 --- a/pkg/hs/proto/package.yaml +++ b/pkg/hs/proto/package.yaml @@ -19,7 +19,7 @@ dependencies: - transformers - transformers-compat - unordered-containers - - urbit-king + - urbit-noun default-extensions: - ApplicativeDo diff --git a/pkg/hs/stack.yaml b/pkg/hs/stack.yaml index 5a3d0ba02..f86094331 100644 --- a/pkg/hs/stack.yaml +++ b/pkg/hs/stack.yaml @@ -7,6 +7,7 @@ packages: - terminal-progress-bar - urbit-atom - urbit-azimuth + - urbit-eventlog-lmdb - urbit-king - urbit-noun - urbit-noun-core diff --git a/pkg/hs/urbit-eventlog-lmdb/.gitignore b/pkg/hs/urbit-eventlog-lmdb/.gitignore new file mode 100644 index 000000000..65e7ea818 --- /dev/null +++ b/pkg/hs/urbit-eventlog-lmdb/.gitignore @@ -0,0 +1,3 @@ +.stack-work +*.cabal +test/gold/*.writ diff --git a/pkg/hs/urbit-eventlog-lmdb/LICENSE b/pkg/hs/urbit-eventlog-lmdb/LICENSE new file mode 100644 index 000000000..bf9294e05 --- /dev/null +++ b/pkg/hs/urbit-eventlog-lmdb/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 urbit + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs b/pkg/hs/urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs similarity index 90% rename from pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs rename to pkg/hs/urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs index 5239dbeb7..38344fe43 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs +++ b/pkg/hs/urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs @@ -4,27 +4,51 @@ TODO Effects storage logic is messy. -} -module Urbit.Vere.Log ( EventLog, identity, nextEv, lastEv - , new, existing - , streamEvents, appendEvents, trimEvents - , streamEffectsRows, writeEffectsRow - ) where +module Urbit.EventLog.LMDB + ( LogIdentity(..) + , EventLog + , identity + , nextEv + , lastEv + , new + , existing + , streamEvents + , appendEvents + , trimEvents + , streamEffectsRows + , writeEffectsRow + ) +where -import Urbit.Prelude hiding (init) +import ClassyPrelude -import Data.Conduit import Data.RAcquire import Database.LMDB.Raw -import Foreign.Marshal.Alloc -import Foreign.Ptr -import Urbit.Vere.Pier.Types -import Foreign.Storable (peek, poke, sizeOf) +import Data.Conduit (ConduitT, yield) +import Foreign.Marshal.Alloc (allocaBytes) +import Foreign.Ptr (Ptr, castPtr, nullPtr) +import Foreign.Storable (peek, poke, sizeOf) +import RIO (HasLogFunc, RIO, display, logDebug, runRIO) +import Urbit.Noun (DecodeErr, Noun, Ship) +import Urbit.Noun (deriveNoun, fromNounExn, toNoun) +import Urbit.Noun (cueBS, jamBS) import qualified Data.ByteString.Unsafe as BU import qualified Data.Vector as V +-- Public Types ---------------------------------------------------------------- + +data LogIdentity = LogIdentity + { who :: Ship + , isFake :: Bool + , lifecycleLen :: Word + } deriving (Eq, Ord, Show) + +deriveNoun ''LogIdentity + + -- Types ----------------------------------------------------------------------- type Env = MDB_env @@ -39,23 +63,23 @@ data EventLog = EventLog , eventsTbl :: Dbi , effectsTbl :: Dbi , identity :: LogIdentity - , numEvents :: TVar EventId + , numEvents :: TVar Word64 } -nextEv :: EventLog -> STM EventId +nextEv :: EventLog -> STM Word64 nextEv = fmap (+1) . lastEv -lastEv :: EventLog -> STM EventId +lastEv :: EventLog -> STM Word64 lastEv = readTVar . numEvents data EventLogExn = NoLogIdentity - | MissingEvent EventId + | MissingEvent Word64 | BadNounInLogIdentity ByteString DecodeErr ByteString | BadKeyInEventLog | BadWriteLogIdentity LogIdentity - | BadWriteEvent EventId - | BadWriteEffect EventId + | BadWriteEvent Word64 + | BadWriteEffect Word64 deriving Show @@ -64,6 +88,12 @@ data EventLogExn instance Exception EventLogExn where +-- Utils ----------------------------------------------------------------------- + +io :: MonadIO m => IO a -> m a +io = liftIO + + -- Open/Close an Event Log ----------------------------------------------------- rawOpen :: MonadIO m => FilePath -> m Env @@ -240,7 +270,7 @@ appendEvents log !events = do True -> pure () False -> throwIO (BadWriteEvent k) -writeEffectsRow :: MonadIO m => EventLog -> EventId -> ByteString -> m () +writeEffectsRow :: MonadIO m => EventLog -> Word64 -> ByteString -> m () writeEffectsRow log k v = io $ runRIO () $ do let flags = compileWriteFlags [] rwith (writeTxn $ env log) $ \txn -> @@ -271,11 +301,11 @@ streamEvents log first = do streamEvents log (first + word (length batch)) streamEffectsRows :: ∀e. HasLogFunc e - => EventLog -> EventId + => EventLog -> Word64 -> ConduitT () (Word64, ByteString) (RIO e) () streamEffectsRows log = go where - go :: EventId -> ConduitT () (Word64, ByteString) (RIO e) () + go :: Word64 -> ConduitT () (Word64, ByteString) (RIO e) () go next = do batch <- lift $ readRowsBatch (env log) (effectsTbl log) next unless (null batch) $ do @@ -296,7 +326,7 @@ readBatch log first = start then pure mempty else readRows $ fromIntegral $ min 1000 $ ((last+1) - first) - assertFound :: EventId -> Bool -> RIO e () + assertFound :: Word64 -> Bool -> RIO e () assertFound id found = do unless found $ throwIO $ MissingEvent id diff --git a/pkg/hs/urbit-eventlog-lmdb/package.yaml b/pkg/hs/urbit-eventlog-lmdb/package.yaml new file mode 100644 index 000000000..9e53f1a11 --- /dev/null +++ b/pkg/hs/urbit-eventlog-lmdb/package.yaml @@ -0,0 +1,71 @@ +name: urbit-eventlog-lmdb +version: 0.10.4 +license: MIT +license-file: LICENSE + +library: + source-dirs: lib + ghc-options: + - -fwarn-incomplete-patterns + - -fwarn-unused-binds + - -fwarn-unused-imports + - -Werror + - -O2 + +dependencies: + - base + - classy-prelude + - stm + - rio + - vector + - bytestring + - lmdb-static + - conduit + - racquire + - urbit-noun-core + - urbit-noun + +default-extensions: + - ApplicativeDo + - BangPatterns + - BlockArguments + - ConstraintKinds + - DataKinds + - DefaultSignatures + - DeriveAnyClass + - DeriveDataTypeable + - DeriveFoldable + - DeriveGeneric + - DeriveTraversable + - DerivingStrategies + - EmptyCase + - EmptyDataDecls + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GADTs + - GeneralizedNewtypeDeriving + - LambdaCase + - MagicHash + - MultiParamTypeClasses + - NamedFieldPuns + - NoImplicitPrelude + - NumericUnderscores + - OverloadedStrings + - PackageImports + - PartialTypeSignatures + - PatternSynonyms + - QuasiQuotes + - Rank2Types + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TemplateHaskell + - TupleSections + - TypeApplications + - TypeFamilies + - TypeOperators + - UnboxedTuples + - UnicodeSyntax + - ViewPatterns diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 59a99f625..6ea513072 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -61,10 +61,11 @@ Polish: - [ ] Cleanup Terminal Driver code. - [x] Spin off `racquire` into it's own package. - [x] Spin off `urbit-noun-core` and `urbit-noun` packages. -- [ ] Spin off `Urbit.Vere.Log` into it's own package. -- [ ] Spin off `Urbit.Vere.Serf` into it's own package, and make it care - less about the shape of events and effects. +- [x] Spin off `urbit-eventlog-lmdb` into it's own package. +- [ ] Spin off `Urbit.Vere.Serf` into it's own package + - Make it care less about the shape of events and effects. - [ ] Spin off per-pier logic into it's own package. + - Probably `urbit-pier` # Event Prioritization diff --git a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs index 75cb6fcf3..49914aa36 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs @@ -14,10 +14,11 @@ import Urbit.Noun.Time import Urbit.Vere.Pier.Types import Control.Monad.Trans.Maybe (MaybeT(..)) -import Urbit.Vere.Log (EventLog) +import Urbit.EventLog.LMDB (EventLog) import qualified Data.Conduit.Combinators as C -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log + -------------------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index f8bad8900..d43360f6f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -105,14 +105,15 @@ import qualified Network.HTTP.Client as C import qualified System.Posix.Signals as Sys import qualified System.ProgressBar as PB import qualified System.Random as Sys +import qualified Urbit.EventLog.LMDB as Log import qualified Urbit.King.CLI as CLI import qualified Urbit.King.EventBrowser as EventBrowser import qualified Urbit.Ob as Ob -import qualified Urbit.Vere.Log as Log import qualified Urbit.Vere.Pier as Pier import qualified Urbit.Vere.Serf as Serf import qualified Urbit.Vere.Term as Term + -------------------------------------------------------------------------------- removeFileIfExists :: HasLogFunc env => FilePath -> RIO env () @@ -121,6 +122,7 @@ removeFileIfExists pax = do when exists $ do removeFile pax + -------------------------------------------------------------------------------- toSerfFlags :: CLI.Opts -> [Serf.Flag] diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index da39aa269..13badfce9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -25,6 +25,7 @@ import Urbit.King.Config import Urbit.Vere.Pier.Types import System.Posix.Files (ownerModes, setFileMode) +import Urbit.EventLog.LMDB (EventLog) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) import Urbit.King.App (onKillPierSigL) import Urbit.Noun.Time (Wen) @@ -34,13 +35,12 @@ import Urbit.Vere.Clay (clay) import Urbit.Vere.Eyre (eyre) import Urbit.Vere.Eyre.Multi (MultiEyreApi) import Urbit.Vere.Http.Client (client) -import Urbit.Vere.Log (EventLog) import Urbit.Vere.Serf (Serf) import qualified System.Entropy as Ent +import qualified Urbit.EventLog.LMDB as Log import qualified Urbit.King.API as King import qualified Urbit.Noun.Time as Time -import qualified Urbit.Vere.Log as Log import qualified Urbit.Vere.Serf as Serf import qualified Urbit.Vere.Term as Term import qualified Urbit.Vere.Term.API as Term diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index 5136041d8..6af28f011 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -21,9 +21,10 @@ import Urbit.Prelude hiding (Term) import Urbit.Arvo import Urbit.Noun.Time - import Urbit.Vere.Serf.Types +import Urbit.EventLog.LMDB (LogIdentity(..)) + -- Avoid touching Nock values. ------------------------------------------------- @@ -50,16 +51,9 @@ data Pill = Pill } deriving (Eq, Show) -data LogIdentity = LogIdentity - { who :: Ship - , isFake :: Bool - , lifecycleLen :: Word - } deriving (Eq, Ord, Show) - data BootSeq = BootSeq LogIdentity [Nock] [Ev] deriving (Eq, Show) -deriveNoun ''LogIdentity deriveNoun ''Pill diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index c6289b32d..1432d023e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -21,7 +21,7 @@ import Urbit.Arvo (FX) import qualified Data.Conduit.Combinators as CC import qualified System.ProgressBar as PB -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log import Urbit.King.App (HasStderrLogFunc(..)) diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml index aa1d25367..3999aeb6b 100644 --- a/pkg/hs/urbit-king/package.yaml +++ b/pkg/hs/urbit-king/package.yaml @@ -101,6 +101,7 @@ dependencies: - unordered-containers - urbit-atom - urbit-azimuth + - urbit-eventlog-lmdb - urbit-hob - urbit-noun - urbit-noun-core diff --git a/pkg/hs/urbit-king/test/AmesTests.hs b/pkg/hs/urbit-king/test/AmesTests.hs index 13e67546e..3d9dce19d 100644 --- a/pkg/hs/urbit-king/test/AmesTests.hs +++ b/pkg/hs/urbit-king/test/AmesTests.hs @@ -8,12 +8,12 @@ import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.TH import Urbit.Arvo +import Urbit.EventLog.LMDB import Urbit.King.Config import Urbit.Noun import Urbit.Noun.Time import Urbit.Prelude import Urbit.Vere.Ames -import Urbit.Vere.Log import Urbit.Vere.Pier.Types import Control.Concurrent (runInBoundThread) @@ -22,7 +22,7 @@ import GHC.Natural (Natural) import Network.Socket (tupleToHostAddress) import Urbit.King.App (HasKingId(..)) -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log -------------------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/test/ArvoTests.hs b/pkg/hs/urbit-king/test/ArvoTests.hs index 6ee235746..b2396b429 100644 --- a/pkg/hs/urbit-king/test/ArvoTests.hs +++ b/pkg/hs/urbit-king/test/ArvoTests.hs @@ -10,9 +10,9 @@ import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.TH import Urbit.Arvo +import Urbit.EventLog.LMDB import Urbit.Noun.Time import Urbit.Prelude -import Urbit.Vere.Log import Urbit.Vere.Pier.Types import Control.Concurrent (runInBoundThread, threadDelay) @@ -20,7 +20,7 @@ import Data.LargeWord (LargeKey(..)) import GHC.Natural (Natural) import Network.Socket (tupleToHostAddress) -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log -- Utils ----------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/test/BehnTests.hs b/pkg/hs/urbit-king/test/BehnTests.hs index c207a71e6..9ef803b29 100644 --- a/pkg/hs/urbit-king/test/BehnTests.hs +++ b/pkg/hs/urbit-king/test/BehnTests.hs @@ -9,11 +9,11 @@ import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.TH import Urbit.Arvo +import Urbit.EventLog.LMDB import Urbit.Noun import Urbit.Noun.Time import Urbit.Prelude import Urbit.Vere.Behn -import Urbit.Vere.Log import Urbit.Vere.Pier.Types import Control.Concurrent (runInBoundThread, threadDelay) @@ -22,8 +22,8 @@ import GHC.Natural (Natural) import Network.Socket (tupleToHostAddress) import Urbit.King.App (runKingEnvNoLog, HasKingId(..)) -import qualified Urbit.Noun.Time as Time -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log +import qualified Urbit.Noun.Time as Time -------------------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/test/DeriveNounTests.hs b/pkg/hs/urbit-king/test/DeriveNounTests.hs index 1cb43abf5..d883d29fa 100644 --- a/pkg/hs/urbit-king/test/DeriveNounTests.hs +++ b/pkg/hs/urbit-king/test/DeriveNounTests.hs @@ -7,15 +7,15 @@ import Test.QuickCheck hiding ((.&.)) import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.TH +import Urbit.EventLog.LMDB import Urbit.Prelude -import Urbit.Vere.Log import Urbit.Vere.Pier.Types import Control.Concurrent (runInBoundThread, threadDelay) import Data.LargeWord (LargeKey(..)) import GHC.Natural (Natural) -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log -- Sum Types ------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/test/LogTests.hs b/pkg/hs/urbit-king/test/LogTests.hs index 47508016f..d4317069e 100644 --- a/pkg/hs/urbit-king/test/LogTests.hs +++ b/pkg/hs/urbit-king/test/LogTests.hs @@ -7,8 +7,8 @@ import Test.QuickCheck hiding ((.&.)) import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.TH +import Urbit.EventLog.LMDB import Urbit.Prelude -import Urbit.Vere.Log import Urbit.Vere.Pier.Types import Control.Concurrent (runInBoundThread, threadDelay) @@ -16,7 +16,7 @@ import Data.LargeWord (LargeKey(..)) import GHC.Natural (Natural) import Urbit.King.App (KingEnv, runKingEnvNoLog) -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log -- Utils ----------------------------------------------------------------------- From cc772da03c8c76edf12bb9a1ea7d166645909ccf Mon Sep 17 00:00:00 2001 From: ~siprel Date: Mon, 8 Jun 2020 22:20:21 +0000 Subject: [PATCH 128/257] king: Urbit.Vere.Pier cleanup. --- pkg/hs/urbit-king/lib/Urbit/King/API.hs | 9 +- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 111 +++++++++--------- .../urbit-king/lib/Urbit/Vere/Pier/Types.hs | 30 ++--- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 3 +- 4 files changed, 77 insertions(+), 76 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/API.hs b/pkg/hs/urbit-king/lib/Urbit/King/API.hs index b62203016..adba47550 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/API.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/API.hs @@ -4,7 +4,14 @@ ships. Do it or strip it out. -} -module Urbit.King.API (King(..), kingAPI, readPortsFile) where +module Urbit.King.API + ( King(..) + , TermConn + , TermConnAPI + , kingAPI + , readPortsFile + ) +where import RIO.Directory import Urbit.Prelude diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 13badfce9..299d23520 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -26,6 +26,7 @@ import Urbit.Vere.Pier.Types import System.Posix.Files (ownerModes, setFileMode) import Urbit.EventLog.LMDB (EventLog) +import Urbit.King.API (TermConn) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) import Urbit.King.App (onKillPierSigL) import Urbit.Noun.Time (Wen) @@ -168,19 +169,19 @@ bootNewShip -> RIO e () bootNewShip pill lite flags ship bootEv = do seq@(BootSeq ident x y) <- genBootSeq ship pill lite bootEv - logTrace "BootSeq Computed" + logDebug "BootSeq Computed" pierPath <- view pierPathL liftRIO (setupPierDirectory pierPath) - logTrace "Directory setup." + logDebug "Directory setup." rwith (Log.new (pierPath <> "/.urb/log") ident) $ \log -> do - logTrace "Event log initialized." + logDebug "Event log initialized." jobs <- (\now -> bootSeqJobs now seq) <$> io Time.now writeJobs log (fromList jobs) - logTrace "Finsihed populating event log with boot sequence" + logDebug "Finsihed populating event log with boot sequence" -- Resume an existing ship. ---------------------------------------------------- @@ -204,14 +205,14 @@ resumed vSlog replayUntil flags = do serf <- runSerf vSlog tap flags rio $ do - logTrace "Replaying events" + logDebug "Replaying events" Serf.execReplay serf log replayUntil >>= \case Left err -> error (show err) Right 0 -> do - logTrace "No work during replay so no snapshot" + logDebug "No work during replay so no snapshot" pure () Right _ -> do - logTrace "Taking snapshot" + logDebug "Taking snapshot" io (Serf.snapshot serf) pure (serf, log) @@ -237,14 +238,14 @@ acquireWorker :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) acquireWorker nam act = mkRAcquire (async act) kill where kill tid = do - logTrace ("Killing worker thread: " <> display nam) + logDebug ("Killing worker thread: " <> display nam) cancel tid acquireWorkerBound :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) acquireWorkerBound nam act = mkRAcquire (asyncBound act) kill where kill tid = do - logTrace ("Killing worker thread: " <> display nam) + logDebug ("Killing worker thread: " <> display nam) cancel tid @@ -256,28 +257,31 @@ pier -> MVar () -> MultiEyreApi -> RAcquire PierEnv () -pier (serf, log) vSlog mStart multi = do - computeQ <- newTQueueIO @_ @Serf.EvErr - persistQ <- newTQueueIO @_ @(Fact, FX) - executeQ <- newTQueueIO @_ @FX - saveM <- newEmptyTMVarIO @_ @() - kingApi <- King.kingAPI +pier (serf, log) vSlog startedSig multi = do + let logId = Log.identity log :: LogIdentity + let ship = who logId :: Ship - termApiQ <- atomically $ do + computeQ :: TQueue Serf.EvErr <- newTQueueIO + persistQ :: TQueue (Fact, FX) <- newTQueueIO + executeQ :: TQueue FX <- newTQueueIO + saveSig :: TMVar () <- newEmptyTMVarIO + kingApi :: King.King <- King.kingAPI + + termApiQ :: TQueue TermConn <- atomically $ do q <- newTQueue writeTVar (King.kTermConn kingApi) (Just $ writeTQueue q) pure q - (demux, muxed) <- atomically $ do + (demux :: Term.Demux, muxed :: Term.Client) <- atomically $ do res <- Term.mkDemux pure (res, Term.useDemux res) - acquireWorker "TERMSERV" $ forever $ do - logTrace "TERMSERV Waiting for external terminal." + void $ acquireWorker "TERMSERV Listener" $ forever $ do + logDebug "TERMSERV Waiting for external terminal." atomically $ do ext <- Term.connClient <$> readTQueue termApiQ Term.addDemux ext demux - logTrace "TERMSERV External terminal connected." + logDebug "TERMSERV External terminal connected." -- Slogs go to both stderr and to the terminal. atomically $ do @@ -286,48 +290,47 @@ pier (serf, log) vSlog mStart multi = do atomically $ Term.trace muxed txt oldSlog txt - let logId = Log.identity log :: LogIdentity - let ship = who logId :: Ship - -- Our call above to set the logging function which echos errors from the -- Serf doesn't have the appended \r\n because those \r\n s are added in -- the c serf code. Logging output from our haskell process must manually -- add them. - let showErr = atomically . Term.trace muxed . (<> "\r\n") + let compute = writeTQueue computeQ + let execute = writeTQueue executeQ + let persist = writeTQueue persistQ - env <- ask + (bootEvents, startDrivers) <- do + env <- ask + let err = atomically . Term.trace muxed . (<> "\r\n") + let siz = Term.TSize { tsWide = 80, tsTall = 24 } + let fak = isFake logId + pure $ drivers env multi ship fak compute (siz, muxed) err - let (bootEvents, startDrivers) = drivers - env - multi - ship - (isFake logId) - (writeTQueue computeQ) - (Term.TSize { tsWide = 80, tsTall = 24 }, muxed) - showErr + -- Fill event queue with initial events. + io $ atomically $ for_ bootEvents compute - io $ atomically $ for_ bootEvents (writeTQueue computeQ) - - scryM <- newEmptyTMVarIO - onKill <- view onKillPierSigL + scrySig <- newEmptyTMVarIO + onKill <- view onKillPierSigL let computeConfig = ComputeConfig { ccOnWork = readTQueue computeQ , ccOnKill = onKill - , ccOnSave = takeTMVar saveM - , ccOnScry = takeTMVar scryM - , ccPutResult = writeTQueue persistQ + , ccOnSave = takeTMVar saveSig + , ccOnScry = takeTMVar scrySig + , ccPutResult = persist , ccShowSpinner = Term.spin muxed , ccHideSpinner = Term.stopSpin muxed , ccLastEvInLog = Log.lastEv log } - let plan = writeTQueue executeQ + drivz <- startDrivers + tExec <- acquireWorker "Effects" (router (readTQueue executeQ) drivz) + tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ execute) + tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) - drivz <- startDrivers - tExec <- acquireWorker "Effects" (router (readTQueue executeQ) drivz) - tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ plan) - tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) - tSaveSignal <- saveSignalThread saveM + let snapshotEverySecs = 120 + + void $ acquireWorker "Save" $ forever $ do + threadDelay (snapshotEverySecs * 1_000_000) + void $ atomically $ tryPutTMVar saveSig () -- TODO bullshit scry tester void $ acquireWorker "bullshit scry tester" $ forever $ do @@ -335,12 +338,12 @@ pier (serf, log) vSlog mStart multi = do threadDelay 15_000_000 wen <- io Time.now let kal = \mTermNoun -> runRIO env $ do - logTrace $ displayShow ("scry result: ", mTermNoun) + logDebug $ displayShow ("scry result: ", mTermNoun) let nkt = MkKnot $ tshow $ Time.MkDate wen let pax = Path ["j", "~zod", "life", nkt, "~zod"] - atomically $ putTMVar scryM (wen, Nothing, pax, kal) + atomically $ putTMVar scrySig (wen, Nothing, pax, kal) - putMVar mStart () + putMVar startedSig () -- Wait for something to die. @@ -356,20 +359,12 @@ pier (serf, log) vSlog mStart multi = do atomically $ (Term.spin muxed) (Just "shutdown") - death :: Text -> Async () -> STM (Either (Text, SomeException) Text) death tag tid = do waitCatchSTM tid <&> \case Left exn -> Left (tag, exn) Right () -> Right tag -saveSignalThread :: TMVar () -> RAcquire e (Async ()) -saveSignalThread tm = mkRAcquire start cancel - where - start = async $ forever $ do - threadDelay (120 * 1000000) -- 120 seconds - atomically $ putTMVar tm () - -- Start All Drivers ----------------------------------------------------------- @@ -467,7 +462,7 @@ data ComputeConfig = ComputeConfig runCompute :: forall e . HasKingEnv e => Serf.Serf -> ComputeConfig -> RIO e () runCompute serf ComputeConfig {..} = do - logTrace "runCompute" + logDebug "runCompute" let onCR = asum [ ccOnKill <&> Serf.RRKill , ccOnSave <&> Serf.RRSave diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index 6af28f011..138e60b81 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -45,11 +45,11 @@ instance Show Nock where -------------------------------------------------------------------------------- data Pill = Pill - { pBootFormulas :: [Nock] - , pKernelOvums :: [Ev] - , pUserspaceOvums :: [Ev] - } - deriving (Eq, Show) + { pBootFormulas :: [Nock] + , pKernelOvums :: [Ev] + , pUserspaceOvums :: [Ev] + } + deriving (Eq, Show) data BootSeq = BootSeq LogIdentity [Nock] [Ev] deriving (Eq, Show) @@ -66,17 +66,17 @@ data LifeCyc = LifeCyc EventId Mug Nock deriving (Eq, Show) data Job - = DoWork Work - | RunNok LifeCyc - deriving (Eq, Show) + = DoWork Work + | RunNok LifeCyc + deriving (Eq, Show) jobId :: Job -> EventId jobId (RunNok (LifeCyc eId _ _)) = eId -jobId (DoWork (Work eId _ _ _)) = eId +jobId (DoWork (Work eId _ _ _ )) = eId jobMug :: Job -> Mug jobMug (RunNok (LifeCyc _ mug _)) = mug -jobMug (DoWork (Work _ mug _ _)) = mug +jobMug (DoWork (Work _ mug _ _ )) = mug -- API To IO Drivers ----------------------------------------------------------- @@ -94,17 +94,17 @@ instance ToNoun Work where toNoun (Work eid m d o) = toNoun (eid, Jammed (m, d, o)) instance FromNoun Work where - parseNoun n = named "Work" $ do - (eid, Jammed (m, d, o)) <- parseNoun n - pure (Work eid m d o) + parseNoun n = named "Work" $ do + (eid, Jammed (m, d, o)) <- parseNoun n + pure (Work eid m d o) instance ToNoun LifeCyc where toNoun (LifeCyc eid m n) = toNoun (eid, Jammed (m, n)) instance FromNoun LifeCyc where parseNoun n = named "LifeCyc" $ do - (eid, Jammed (m, n)) <- parseNoun n - pure (LifeCyc eid m n) + (eid, Jammed (m, n)) <- parseNoun n + pure (LifeCyc eid m n) -- | No FromNoun instance, because it depends on context (lifecycle length) instance ToNoun Job where diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 1432d023e..36079170e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -18,13 +18,12 @@ import Urbit.Vere.Serf.IPC import Control.Monad.Trans.Resource (runResourceT) import Urbit.Arvo (FX) +import Urbit.King.App (HasStderrLogFunc(..)) import qualified Data.Conduit.Combinators as CC import qualified System.ProgressBar as PB import qualified Urbit.EventLog.LMDB as Log -import Urbit.King.App (HasStderrLogFunc(..)) - import qualified Urbit.Vere.Serf.IPC as X (Config(..), EvErr(..), Flag(..), RunReq(..), Serf, WorkError(..), run, snapshot, start, stop) From c57c3023f97fcaac19a3abac66fb8c9cda11f19f Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 19:22:45 +0000 Subject: [PATCH 129/257] king: Event prioritization and error handling for born events. --- .../lib/Urbit/EventLog/LMDB.hs | 30 +-- pkg/hs/urbit-king/TODO.md | 61 ++---- pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs | 17 -- pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs | 1 + pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 35 +++- pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs | 37 +--- pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs | 33 +++- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 46 ++++- .../urbit-king/lib/Urbit/Vere/Http/Client.hs | 42 ++++- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 176 +++++++++++------- .../urbit-king/lib/Urbit/Vere/Pier/Types.hs | 5 +- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 1 + .../urbit-king/lib/Urbit/Vere/Serf/Types.hs | 5 +- 13 files changed, 284 insertions(+), 205 deletions(-) diff --git a/pkg/hs/urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs b/pkg/hs/urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs index 38344fe43..ed53db19c 100644 --- a/pkg/hs/urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs +++ b/pkg/hs/urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs @@ -58,13 +58,13 @@ type Dbi = MDB_dbi type Cur = MDB_cursor data EventLog = EventLog - { env :: Env - , _metaTbl :: Dbi - , eventsTbl :: Dbi - , effectsTbl :: Dbi - , identity :: LogIdentity - , numEvents :: TVar Word64 - } + { env :: Env + , _metaTbl :: Dbi + , eventsTbl :: Dbi + , effectsTbl :: Dbi + , identity :: LogIdentity + , numEvents :: TVar Word64 + } nextEv :: EventLog -> STM Word64 nextEv = fmap (+1) . lastEv @@ -73,14 +73,14 @@ lastEv :: EventLog -> STM Word64 lastEv = readTVar . numEvents data EventLogExn - = NoLogIdentity - | MissingEvent Word64 - | BadNounInLogIdentity ByteString DecodeErr ByteString - | BadKeyInEventLog - | BadWriteLogIdentity LogIdentity - | BadWriteEvent Word64 - | BadWriteEffect Word64 - deriving Show + = NoLogIdentity + | MissingEvent Word64 + | BadNounInLogIdentity ByteString DecodeErr ByteString + | BadKeyInEventLog + | BadWriteLogIdentity LogIdentity + | BadWriteEvent Word64 + | BadWriteEffect Word64 + deriving Show -- Instances ------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 6ea513072..0ea535e8d 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -20,6 +20,8 @@ Bugs: - [x] `king new` should reject pier directories that already exist. - [x] In non-daemon-mode, ^D doesn't bring down Urbit properly. +- [ ] Spinner updated multiple times with the same event, and this causes + logging of events to contain duplicates. King-Haskell specific features: @@ -32,6 +34,10 @@ Performance: - [x] Batching during replay. - [x] Batching during normal operation. +Optimization: + +- [x] IO Driver Event Prioritization + Polish: - [x] Cleanup batching flow. @@ -67,55 +73,14 @@ Polish: - [ ] Spin off per-pier logic into it's own package. - Probably `urbit-pier` -# Event Prioritization - -- Instead of each IO driver being passed a TQueue EvErr, each IO driver - produces a (STM (Maybe RunReq)). - - - Each driver has it's own event queue that feeds this action. - - - Pier has a thread that pulls from these actions with prioritization. - -- Priority: - - If any terminal events are available, send it. - - If serf queue is full, abort transaction and retry. - - If no terminal events are available, do the same thing with sync driver. - - Next, same thing for behn. - - Next, same thing for iris. - - Next, same thing for ames. - - Next, same thing for eyre. - - -# Better IO Driver Startup Flow Separation - -Should have a io-driver-boot stage. - -- IO drivers do their boot flows. -- When they're done, they signal that they're running. -- No semantically important communication without outside world can - happen until all drivers are up. - -Current IO Driver interface is something like: - -``` -behn :: KingId -> (EvErr -> STM ()) -> ([EvErr], Acquire (BehnEf -> IO ())) -``` - -New Interface should be something like: - -``` -data DriverApi = DriverApi - { eventQueue :: STM (Maybe RunReq) - , effectSink :: Effect -> STM () - , blockUntilBorn :: STM () - } - -behn :: HasPierEnv e => RAcquire e DriverApi -``` - -where `PierEnv` contains `blockUntilAllDriversBorn :: STM ()`. - # Finding the Serf Executable Right now, `urbit-worker` is found by looking it up in the PATH. This is wrong, but what is right? + +# Further IO Driver Startup Flow Betterment + +- Implement Pier-wide process start events + - [ ] Entropy injection. + - [ ] Verbose flag. + - [ ] CLI event injection. diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs index 1f3ef9d50..0cb22a231 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs @@ -82,22 +82,6 @@ data SyncEf deriveNoun ''SyncEf --- UDP Effects ----------------------------------------------------------------- - -{-| - %init -- "I don't think that's something that can happen" - %west -- "Those also shouldn't happen" - %woot -- "Those also shouldn't happen" --} -data AmesEf - = AmesEfInit Path () - | AmesEfWest Path Ship Path Noun - | AmesEfWoot Path Ship (Maybe (Maybe (Term, [Tank]))) - deriving (Eq, Ord, Show) - -deriveNoun ''AmesEf - - -- Timer Effects --------------------------------------------------------------- {-| @@ -171,7 +155,6 @@ data VaneEf | VEHttpClient HttpClientEf | VEHttpServer HttpServerEf | VEBehn BehnEf - | VEAmes AmesEf | VETerm TermEf | VEClay SyncEf | VESync SyncEf diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs index 23e4aca16..83da5c6d5 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs @@ -350,6 +350,7 @@ instance FromNoun Ev where ReOrg "vane" s t p v -> fmap EvVane $ parseNoun $ toNoun (s,t,p,v) ReOrg _ _ _ _ _ -> fail "First path-elem must be ?($ %vane)" + -- Short Event Names ----------------------------------------------------------- {- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 0c7367389..471791bbd 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -2,7 +2,7 @@ Ames IO Driver -} -module Urbit.Vere.Ames (ames) where +module Urbit.Vere.Ames (ames, ames') where import Urbit.Prelude @@ -11,7 +11,7 @@ import Urbit.Arvo hiding (Fake) import Urbit.King.Config import Urbit.Vere.Pier.Types -import Urbit.King.App (HasKingId(..)) +import Urbit.King.App (HasKingId(..), HasPierEnv(..)) import Urbit.Vere.Ames.DNS (NetworkMode(..), ResolvServ(..)) import Urbit.Vere.Ames.DNS (galaxyPort, resolvServ) import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ) @@ -31,7 +31,7 @@ data AmesDrv = AmesDrv listenPort :: NetworkMode -> Ship -> PortNumber listenPort m s | s < 256 = galaxyPort m (fromIntegral s) -listenPort m _ = 0 +listenPort m _ = 0 -- I don't care, just give me any port. localhost :: HostAddress localhost = tupleToHostAddress (127, 0, 0, 1) @@ -95,10 +95,29 @@ udpServ isFake who = do Nothing -> fakeUdpServ Just host -> realUdpServ port host -bornFailed :: e -> WorkError -> IO () -bornFailed env _ = runRIO env $ do +_bornFailed :: e -> WorkError -> IO () +_bornFailed env _ = runRIO env $ do pure () -- TODO What can we do? +ames' + :: HasPierEnv e + => Ship + -> Bool + -> (Text -> RIO e ()) + -> RIO e ([Ev], RAcquire e (DriverApi NewtEf)) +ames' who isFake stderr = do + ventQ :: TQueue EvErr <- newTQueueIO + env <- ask + let (bornEvs, startDriver) = ames env who isFake (writeTQueue ventQ) stderr + + let runDriver = do + diOnEffect <- startDriver + let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + pure (DriverApi {..}) + + pure (bornEvs, runDriver) + + {-| inst -- Process instance number. who -- Which ship are we? @@ -118,13 +137,13 @@ ames -> Bool -> (EvErr -> STM ()) -> (Text -> RIO e ()) - -> ([EvErr], RAcquire e (NewtEf -> IO ())) + -> ([Ev], RAcquire e (NewtEf -> IO ())) ames env who isFake enqueueEv stderr = (initialEvents, runAmes) where king = fromIntegral (env ^. kingIdL) - initialEvents :: [EvErr] - initialEvents = [EvErr (bornEv king) (bornFailed env)] + initialEvents :: [Ev] + initialEvents = [bornEv king] runAmes :: RAcquire e (NewtEf -> IO ()) runAmes = do diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs index 5facb8001..72ae5218f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs @@ -18,26 +18,16 @@ import qualified Urbit.Timer as Timer -- Behn Stuff ------------------------------------------------------------------ -behn' :: HasPierEnv e => RAcquire e DriverApi +behn' :: HasPierEnv e => RIO e ([Ev], RAcquire e (DriverApi BehnEf)) behn' = do - ventQ <- newTQueueIO - bornM <- newEmptyTMVarIO - fectM <- newEmptyTMVarIO - env <- ask - let (bootEvs, start) = behn env (writeTQueue ventQ) - for_ bootEvs (atomically . writeTQueue ventQ) - - diOnEffect <- liftAcquire start - - let diEventSource = fmap RRWork <$> tryReadTQueue ventQ - - let diBlockUntilBorn = readTMVar bornM - - -- TODO Do this after successful born event. - atomically $ putTMVar bornM () - - pure (DriverApi {..}) + pure ([bornEv (fromIntegral (env ^. kingIdL))], runDriver env) + where + runDriver env = do + ventQ :: TQueue EvErr <- newTQueueIO + diOnEffect <- liftAcquire (behn env (writeTQueue ventQ)) + let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + pure (DriverApi {..}) bornEv :: KingId -> Ev bornEv king = EvBlip $ BlipEvBehn $ BehnEvBorn (king, ()) () @@ -47,10 +37,6 @@ wakeEv = EvBlip $ BlipEvBehn $ BehnEvWake () () sysTime = view Time.systemTime -bornFailed :: e -> WorkError -> IO () -bornFailed env _ = runRIO env $ do - pure () -- TODO Ship is fucked. Kill it? - wakeErr :: WorkError -> IO () wakeErr _ = pure () @@ -58,14 +44,11 @@ behn :: HasKingId e => e -> (EvErr -> STM ()) - -> ([EvErr], Acquire (BehnEf -> IO ())) -behn env enqueueEv = - (initialEvents, runBehn) + -> Acquire (BehnEf -> IO ()) +behn env enqueueEv = runBehn where king = fromIntegral (env ^. kingIdL) - initialEvents = [EvErr (bornEv king) (bornFailed env)] - runBehn :: Acquire (BehnEf -> IO ()) runBehn = do tim <- mkAcquire Timer.init Timer.stop diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs index 00d9a18dd..6b8272266 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs @@ -2,11 +2,14 @@ UNIX Filesystem Driver -} -module Urbit.Vere.Clay (clay) where +module Urbit.Vere.Clay + ( clay + , clay' + ) +where import Urbit.Arvo hiding (Term) -import Urbit.King.App (HasKingId(..)) -import Urbit.King.Config +import Urbit.King.App import Urbit.Prelude import Urbit.Vere.Pier.Types @@ -113,16 +116,32 @@ buildActionListFromDifferences fp snapshot = do -------------------------------------------------------------------------------- -boatFailed :: e -> WorkError -> IO () -boatFailed env _ = runRIO env $ do +_boatFailed :: e -> WorkError -> IO () +_boatFailed env _ = runRIO env $ do pure () -- TODO What can we do? +clay' + :: HasPierEnv e + => RIO e ([Ev], RAcquire e (DriverApi SyncEf)) +clay' = do + ventQ :: TQueue EvErr <- newTQueueIO + env <- ask + + let (bornEvs, startDriver) = clay env (writeTQueue ventQ) + + let runDriver = do + diOnEffect <- startDriver + let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + pure (DriverApi {..}) + + pure (bornEvs, runDriver) + clay :: forall e . (HasPierConfig e, HasLogFunc e, HasKingId e) => e -> (EvErr -> STM ()) - -> ([EvErr], RAcquire e (SyncEf -> IO ())) + -> ([Ev], RAcquire e (SyncEf -> IO ())) clay env plan = (initialEvents, runSync) where @@ -132,7 +151,7 @@ clay env plan = -- TODO: In the case of -A, we need to read all the data from the -- specified directory and shove it into an %into event. - initialEvents = [EvErr boatEv (boatFailed env)] + initialEvents = [boatEv] runSync :: RAcquire e (SyncEf -> IO ()) runSync = handleEffect <$> mkRAcquire start stop diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 7ef6180c8..4f69a4888 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -4,13 +4,14 @@ module Urbit.Vere.Eyre ( eyre + , eyre' ) where import Urbit.Prelude hiding (Builder) import Urbit.Arvo hiding (ServerId, reqUrl, secure) -import Urbit.King.App (HasKingId(..)) +import Urbit.King.App (HasKingId(..), HasPierEnv(..)) import Urbit.King.Config import Urbit.Vere.Eyre.Multi import Urbit.Vere.Eyre.PortsFile @@ -275,25 +276,56 @@ startServ multi who isFake conf plan = do -- Eyre Driver ----------------------------------------------------------------- -bornFailed :: e -> WorkError -> IO () -bornFailed env _ = runRIO env $ do +_bornFailed :: e -> WorkError -> IO () +_bornFailed env _ = runRIO env $ do pure () -- TODO What should this do? +eyre' + :: HasPierEnv e + => MultiEyreApi + -> Ship + -> Bool + -> RIO e ([Ev], RAcquire e (DriverApi HttpServerEf)) +eyre' multi who isFake = do + ventQ :: TQueue EvErr <- newTQueueIO + env <- ask + + let (bornEvs, startDriver) = eyre env multi who (writeTQueue ventQ) isFake + + let runDriver = do + diOnEffect <- startDriver + let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + pure (DriverApi {..}) + + pure (bornEvs, runDriver) + +{-| + Eyre -- HTTP Server Driver + + Inject born events. + Until born events succeeds, ignore effects. + Wait until born event callbacks invoked. + If success, signal success. + If failure, try again several times. + If still failure, bring down ship. + Once born event succeeds: + - Begin normal operation (start accepting requests) +-} eyre :: forall e - . (HasShipEnv e, HasKingId e) + . (HasPierEnv e) => e -> MultiEyreApi -> Ship -> (EvErr -> STM ()) -> Bool - -> ([EvErr], RAcquire e (HttpServerEf -> IO ())) + -> ([Ev], RAcquire e (HttpServerEf -> IO ())) eyre env multi who plan isFake = (initialEvents, runHttpServer) where king = fromIntegral (env ^. kingIdL) - initialEvents :: [EvErr] - initialEvents = [EvErr (bornEv king) (bornFailed env)] + initialEvents :: [Ev] + initialEvents = [bornEv king] runHttpServer :: RAcquire e (HttpServerEf -> IO ()) runHttpServer = handleEf <$> mkRAcquire diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs index 1cd1007f8..011ce86ac 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Client.hs @@ -11,11 +11,11 @@ import Urbit.Prelude hiding (Builder) import Urbit.Vere.Http import Urbit.Vere.Pier.Types +import Urbit.King.App import Urbit.Arvo (BlipEv(..), Ev(..), HttpClientEf(..), HttpClientEv(..), HttpClientReq(..), HttpEvent(..), KingId, ResponseHeader(..)) -import Urbit.King.App (HasKingId(..)) import qualified Data.Map as M import qualified Network.HTTP.Client as H @@ -57,22 +57,52 @@ bornEv king = -------------------------------------------------------------------------------- -bornFailed :: e -> WorkError -> IO () -bornFailed env _ = runRIO env $ do +_bornFailed :: e -> WorkError -> IO () +_bornFailed env _ = runRIO env $ do pure () -- TODO What to do in this case? +client' + :: HasPierEnv e + => RIO e ([Ev], RAcquire e (DriverApi HttpClientEf)) +client' = do + ventQ :: TQueue EvErr <- newTQueueIO + env <- ask + + let (bornEvs, startDriver) = client env (writeTQueue ventQ) + + let runDriver = do + diOnEffect <- startDriver + let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + pure (DriverApi {..}) + + pure (bornEvs, runDriver) + + +{-| + Iris -- HTTP Client Driver + + Until born events succeeds, ignore effects. + Wait until born event callbacks invoked. + If success, signal success. + If failure, try again several times. + If still failure, bring down ship. + Once born event succeeds, hold on to effects. + Once all other drivers have booted: + - Execute stashed effects. + - Begin normal operation (start accepting requests) +-} client :: forall e . (HasLogFunc e, HasKingId e) => e -> (EvErr -> STM ()) - -> ([EvErr], RAcquire e (HttpClientEf -> IO ())) + -> ([Ev], RAcquire e (HttpClientEf -> IO ())) client env plan = (initialEvents, runHttpClient) where kingId = view (kingIdL . to fromIntegral) env - initialEvents :: [EvErr] - initialEvents = [EvErr (bornEv kingId) (bornFailed env)] + initialEvents :: [Ev] + initialEvents = [bornEv kingId] runHttpClient :: RAcquire e (HttpClientEf -> IO ()) runHttpClient = handleEffect <$> mkRAcquire start stop diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 299d23520..0a08f6e3e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -24,24 +24,25 @@ import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Pier.Types +import Control.Monad.STM (retry) import System.Posix.Files (ownerModes, setFileMode) import Urbit.EventLog.LMDB (EventLog) import Urbit.King.API (TermConn) import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) import Urbit.King.App (onKillPierSigL) import Urbit.Noun.Time (Wen) -import Urbit.Vere.Ames (ames) -import Urbit.Vere.Behn (behn) -import Urbit.Vere.Clay (clay) -import Urbit.Vere.Eyre (eyre) +import Urbit.Vere.Behn (behn') import Urbit.Vere.Eyre.Multi (MultiEyreApi) -import Urbit.Vere.Http.Client (client) import Urbit.Vere.Serf (Serf) import qualified System.Entropy as Ent import qualified Urbit.EventLog.LMDB as Log import qualified Urbit.King.API as King import qualified Urbit.Noun.Time as Time +import qualified Urbit.Vere.Ames as Ames +import qualified Urbit.Vere.Clay as Clay +import qualified Urbit.Vere.Eyre as Eyre +import qualified Urbit.Vere.Http.Client as Iris import qualified Urbit.Vere.Serf as Serf import qualified Urbit.Vere.Term as Term import qualified Urbit.Vere.Term.API as Term @@ -88,8 +89,9 @@ genBootSeq ship Pill {..} lite boot = io $ do _ -> False --- Write a batch of jobs into the event log ------------------------------------ +-- Write to the log. ----------------------------------------------------------- +-- | Write a batch of jobs to the event log. writeJobs :: EventLog -> Vector Job -> RIO e () writeJobs log !jobs = do expect <- atomically (Log.nextEv log) @@ -110,7 +112,7 @@ writeJobs log !jobs = do -- Acquire a running serf. ----------------------------------------------------- printTank :: (Text -> IO ()) -> Atom -> Tank -> IO () -printTank f _ = io . f . unlines . fmap unTape . wash (WashCfg 0 80) +printTank f _priority = f . unlines . fmap unTape . wash (WashCfg 0 80) runSerf :: HasLogFunc e @@ -122,7 +124,7 @@ runSerf vSlog pax fax = do env <- ask Serf.withSerf (config env) where - slog txt = join $ atomically (readTVar vSlog >>= pure . ($ txt)) + slog txt = atomically (readTVar vSlog) >>= (\f -> f txt) config env = Serf.Config { scSerf = "urbit-worker" -- TODO Find the executable in some proper way. , scPier = pax @@ -154,10 +156,10 @@ bootSeqJobs now (BootSeq ident nocks ovums) = zipWith ($) bootSeqFns [1 ..] wen off = Time.addGap now ((fromIntegral off - 1) ^. from Time.microSecs) bootSeqFns :: [EventId -> Job] - bootSeqFns = fmap muckNock nocks <> fmap muckOvum ovums + bootSeqFns = fmap nockJob nocks <> fmap ovumJob ovums where - muckNock nok eId = RunNok $ LifeCyc eId 0 nok - muckOvum ov eId = DoWork $ Work eId 0 (wen eId) ov + nockJob nok eId = RunNok $ LifeCyc eId 0 nok + ovumJob ov eId = DoWork $ Work eId 0 (wen eId) ov bootNewShip :: HasPierEnv e @@ -173,10 +175,12 @@ bootNewShip pill lite flags ship bootEv = do pierPath <- view pierPathL - liftRIO (setupPierDirectory pierPath) + rio (setupPierDirectory pierPath) logDebug "Directory setup." - rwith (Log.new (pierPath <> "/.urb/log") ident) $ \log -> do + let logPath = (pierPath ".urb/log") + + rwith (Log.new logPath ident) $ \log -> do logDebug "Event log initialized." jobs <- (\now -> bootSeqJobs now seq) <$> io Time.now writeJobs log (fromList jobs) @@ -198,10 +202,11 @@ resumed vSlog replayUntil flags = do ev <- MaybeT (pure replayUntil) MaybeT (getSnapshot top ev) - rio $ logTrace $ display @Text ("pier: " <> pack top) - rio $ logTrace $ display @Text ("running serf in: " <> pack tap) + rio $ do + logTrace $ display @Text ("pier: " <> pack top) + logTrace $ display @Text ("running serf in: " <> pack tap) - log <- Log.existing (top <> "/.urb/log") + log <- Log.existing (top ".urb/log") serf <- runSerf vSlog tap flags rio $ do @@ -217,6 +222,7 @@ resumed vSlog replayUntil flags = do pure (serf, log) +-- | Get a fake pier directory for partial snapshots. getSnapshot :: forall e . FilePath -> Word64 -> RIO e (Maybe FilePath) getSnapshot top last = do lastSnapshot <- lastMay <$> listReplays @@ -261,7 +267,10 @@ pier (serf, log) vSlog startedSig multi = do let logId = Log.identity log :: LogIdentity let ship = who logId :: Ship - computeQ :: TQueue Serf.EvErr <- newTQueueIO + -- TODO Instead of using a TMVar, pull directly from the IO driver + -- event sources. + computeQ :: TMVar RunReq <- newEmptyTMVarIO + persistQ :: TQueue (Fact, FX) <- newTQueueIO executeQ :: TQueue FX <- newTQueueIO saveSig :: TMVar () <- newEmptyTMVarIO @@ -294,7 +303,7 @@ pier (serf, log) vSlog startedSig multi = do -- Serf doesn't have the appended \r\n because those \r\n s are added in -- the c serf code. Logging output from our haskell process must manually -- add them. - let compute = writeTQueue computeQ + let compute = putTMVar computeQ let execute = writeTQueue executeQ let persist = writeTQueue persistQ @@ -303,15 +312,12 @@ pier (serf, log) vSlog startedSig multi = do let err = atomically . Term.trace muxed . (<> "\r\n") let siz = Term.TSize { tsWide = 80, tsTall = 24 } let fak = isFake logId - pure $ drivers env multi ship fak compute (siz, muxed) err - - -- Fill event queue with initial events. - io $ atomically $ for_ bootEvents compute + drivers env multi ship fak compute (siz, muxed) err scrySig <- newEmptyTMVarIO onKill <- view onKillPierSigL - let computeConfig = ComputeConfig { ccOnWork = readTQueue computeQ + let computeConfig = ComputeConfig { ccOnWork = takeTMVar computeQ , ccOnKill = onKill , ccOnSave = takeTMVar saveSig , ccOnScry = takeTMVar scrySig @@ -321,10 +327,28 @@ pier (serf, log) vSlog startedSig multi = do , ccLastEvInLog = Log.lastEv log } + tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) + + -- Run all born events and retry them until they succeed. + rio $ for_ bootEvents $ \ev -> do + okaySig <- newEmptyMVar + + let inject n = atomically $ compute $ RRWork $ EvErr ev $ cb n + + -- TODO Make sure this dies cleanly. + cb :: Int -> WorkError -> IO () + cb n | n >= 3 = error ("boot event failed: " <> show ev) + cb n = \case + RunOkay _ -> putMVar okaySig () + RunSwap _ _ _ _ _ -> putMVar okaySig () + RunBail _ -> inject (n + 1) + + logTrace ("Boot Event" <> displayShow ev) + io (inject 0) + drivz <- startDrivers tExec <- acquireWorker "Effects" (router (readTQueue executeQ) drivz) tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ execute) - tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) let snapshotEverySecs = 120 @@ -333,15 +357,16 @@ pier (serf, log) vSlog startedSig multi = do void $ atomically $ tryPutTMVar saveSig () -- TODO bullshit scry tester - void $ acquireWorker "bullshit scry tester" $ forever $ do + void $ acquireWorker "bullshit scry tester" $ do env <- ask - threadDelay 15_000_000 - wen <- io Time.now - let kal = \mTermNoun -> runRIO env $ do - logDebug $ displayShow ("scry result: ", mTermNoun) - let nkt = MkKnot $ tshow $ Time.MkDate wen - let pax = Path ["j", "~zod", "life", nkt, "~zod"] - atomically $ putTMVar scrySig (wen, Nothing, pax, kal) + forever $ do + threadDelay 15_000_000 + wen <- io Time.now + let kal = \mTermNoun -> runRIO env $ do + logDebug $ displayShow ("scry result: ", mTermNoun) + let nkt = MkKnot $ tshow $ Time.MkDate wen + let pax = Path ["j", "~zod", "life", nkt, "~zod"] + atomically $ putTMVar scrySig (wen, Nothing, pax, kal) putMVar startedSig () @@ -354,8 +379,9 @@ pier (serf, log) vSlog startedSig multi = do ] atomically ded >>= \case - Left (txt, exn) -> logError $ displayShow ("Somthing died", txt, exn) - Right tag -> logError $ displayShow ("Something simply exited", tag) + Left (tag, exn) -> logError $ displayShow (tag, "crashed", exn) + Right "compute thread" -> pure () + Right tag -> logError $ displayShow (tag, "exited unexpectly") atomically $ (Term.spin muxed) (Just "shutdown") @@ -368,9 +394,8 @@ death tag tid = do -- Start All Drivers ----------------------------------------------------------- -data Drivers e = Drivers - { dAmes :: AmesEf -> IO () - , dBehn :: BehnEf -> IO () +data Drivers = Drivers + { dBehn :: BehnEf -> IO () , dIris :: HttpClientEf -> IO () , dEyre :: HttpServerEf -> IO () , dNewt :: NewtEf -> IO () @@ -384,36 +409,58 @@ drivers -> MultiEyreApi -> Ship -> Bool - -> (EvErr -> STM ()) + -> (RunReq -> STM ()) -> (Term.TSize, Term.Client) -> (Text -> RIO e ()) - -> ([EvErr], RAcquire e (Drivers e)) -drivers env multi who isFake plan termSys stderr = - (initialEvents, runDrivers) - where - (behnBorn, runBehn) = behn env plan - (amesBorn, runAmes) = ames env who isFake plan stderr - (httpBorn, runEyre) = eyre env multi who plan isFake - (clayBorn, runClay) = clay env plan - (irisBorn, runIris) = client env plan - (termBorn, runTerm) = Term.term env termSys plan - initialEvents = mconcat [behnBorn, clayBorn, amesBorn, httpBorn, - termBorn, irisBorn] + -> RAcquire e ([Ev], RAcquire e Drivers) +drivers env multi who isFake plan termSys stderr = do + (behnBorn, runBehn) <- rio behn' + (termBorn, runTerm) <- rio (Term.term' termSys) + (amesBorn, runAmes) <- rio (Ames.ames' who isFake stderr) + (httpBorn, runEyre) <- rio (Eyre.eyre' multi who isFake) + (clayBorn, runClay) <- rio Clay.clay' + (irisBorn, runIris) <- rio Iris.client' - runDrivers = do - dNewt <- runAmes - dBehn <- liftAcquire $ runBehn - dAmes <- pure $ const $ pure () - dIris <- runIris - dEyre <- runEyre - dSync <- runClay - dTerm <- runTerm - pure (Drivers{..}) + let initialEvents = mconcat [behnBorn,clayBorn,amesBorn,httpBorn,irisBorn,termBorn] + + let runDrivers = do + behn <- runBehn + term <- runTerm + ames <- runAmes + iris <- runIris + eyre <- runEyre + clay <- runClay + + -- Sources lower in the list are starved until sources above them + -- have no events to offer. + acquireWorker "Event Prioritization" $ forever $ atomically $ do + let x = diEventSource + let eventSources = [x term, x clay, x behn, x iris, x eyre, x ames] + pullEvent eventSources >>= \case + Nothing -> retry + Just rr -> plan rr + + pure $ Drivers + { dTerm = diOnEffect term + , dBehn = diOnEffect behn + , dNewt = diOnEffect ames + , dIris = diOnEffect iris + , dEyre = diOnEffect eyre + , dSync = diOnEffect clay + } + + pure (initialEvents, runDrivers) + where + pullEvent :: [STM (Maybe a)] -> STM (Maybe a) + pullEvent [] = pure Nothing + pullEvent (d:ds) = d >>= \case + Just r -> pure (Just r) + Nothing -> pullEvent ds -- Route Effects to Drivers ---------------------------------------------------- -router :: HasLogFunc e => STM FX -> Drivers e -> RIO e () +router :: HasLogFunc e => STM FX -> Drivers -> RIO e () router waitFx Drivers {..} = forever $ do fx <- atomically waitFx for_ fx $ \ef -> do @@ -421,7 +468,6 @@ router waitFx Drivers {..} = forever $ do case ef of GoodParse (EfVega _ _ ) -> error "TODO" GoodParse (EfExit _ _ ) -> error "TODO" - GoodParse (EfVane (VEAmes ef)) -> io (dAmes ef) GoodParse (EfVane (VEBehn ef)) -> io (dBehn ef) GoodParse (EfVane (VEBoat ef)) -> io (dSync ef) GoodParse (EfVane (VEClay ef)) -> io (dSync ef) @@ -450,7 +496,7 @@ logEffect ef = logDebug $ display $ "[EFFECT]\n" <> pretty ef FailParse n -> pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow n data ComputeConfig = ComputeConfig - { ccOnWork :: STM Serf.EvErr + { ccOnWork :: STM RunReq , ccOnKill :: STM () , ccOnSave :: STM () , ccOnScry :: STM (Wen, Gang, Path, Maybe (Term, Noun) -> IO ()) @@ -464,9 +510,9 @@ runCompute :: forall e . HasKingEnv e => Serf.Serf -> ComputeConfig -> RIO e () runCompute serf ComputeConfig {..} = do logDebug "runCompute" - let onCR = asum [ ccOnKill <&> Serf.RRKill + let onRR = asum [ ccOnKill <&> Serf.RRKill , ccOnSave <&> Serf.RRSave - , ccOnWork <&> Serf.RRWork + , ccOnWork , ccOnScry <&> \(w,g,p,k) -> Serf.RRScry w g p k ] @@ -483,7 +529,7 @@ runCompute serf ComputeConfig {..} = do let maxBatchSize = 10 - io (Serf.run serf maxBatchSize ccLastEvInLog onCR ccPutResult onSpin) + io (Serf.run serf maxBatchSize ccLastEvInLog onRR ccPutResult onSpin) -- Event-Log Persistence Thread ------------------------------------------------ diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index 138e60b81..6dbffa34c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -81,10 +81,9 @@ jobMug (DoWork (Work _ mug _ _ )) = mug -- API To IO Drivers ----------------------------------------------------------- -data DriverApi = DriverApi +data DriverApi ef = DriverApi { diEventSource :: STM (Maybe RunReq) - , diOnEffect :: BehnEf -> IO () - , diBlockUntilBorn :: STM () + , diOnEffect :: ef -> IO () } diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index acd2610b4..b53e0b53a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -556,6 +556,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop onWorkResp :: Wen -> EvErr -> Work -> IO () onWorkResp wen (EvErr evn err) = \case WDone eid hash fx -> do + io $ err (RunOkay eid) atomically $ sendOn ((Fact eid hash wen (toNoun evn)), fx) WSwap eid hash (wen, noun) fx -> do io $ err (RunSwap eid hash wen noun fx) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs index 7d772a30d..493a7efb0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs @@ -79,9 +79,10 @@ data EvErr = EvErr Ev (WorkError -> IO ()) - `RunBail`: Event processing failed and all attempt to replace it with a failure-notice event also caused crashes. We are really fucked. -} -data WorkError - = RunSwap EventId Mug Wen Noun FX +data WorkError -- TODO Rename type and constructors + = RunSwap EventId Mug Wen Noun FX -- TODO Maybe provide less info here? | RunBail [Goof] + | RunOkay EventId {- - RRWork: Ask the serf to do work, will output (Fact, FX) if work From e178ad353d2c0892f02106e43e960fde5fcd548d Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 19:25:51 +0000 Subject: [PATCH 130/257] king: Fix spinner bugs. --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 44 +++---- pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 131 +++++++++++-------- 2 files changed, 97 insertions(+), 78 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index b53e0b53a..a771d3a4e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -610,7 +610,7 @@ processWork processWork serf maxSize q onResp spin = do vDoneFlag <- newTVarIO False vInFlightQueue <- newTVarIO empty - recvThread <- async (recvLoop serf vDoneFlag vInFlightQueue) + recvThread <- async (recvLoop serf vDoneFlag vInFlightQueue spin) flip onException (print "KILLING: processWork" >> cancel recvThread) $ do loop vInFlightQueue vDoneFlag wait recvThread @@ -622,23 +622,11 @@ processWork serf maxSize q onResp spin = do atomically (writeTVar vDone True) Just evErr@(EvErr ev _) -> do now <- Time.now - let cb = onRecv (currentEv vInFlight) now evErr - atomically $ do - modifyTVar' vInFlight (:|> (ev, cb)) - currentEv vInFlight >>= spin + let cb = onResp now evErr + atomically $ modifyTVar' vInFlight (:|> (ev, cb)) sendWrit serf (WWork now ev) loop vInFlight vDone - onRecv :: STM (Maybe Ev) -> Wen -> EvErr -> Work -> IO () - onRecv getCurrentEv now evErr work = do - atomically (getCurrentEv >>= spin) - onResp now evErr work - - currentEv :: TVar (Seq (Ev, a)) -> STM (Maybe Ev) - currentEv vInFlight = readTVar vInFlight >>= \case - (ev, _) :<| _ -> pure (Just ev) - _ -> pure Nothing - {-| Given: @@ -657,23 +645,33 @@ processWork serf maxSize q onResp spin = do wait for a response from the serf, call the associated callback, and repeat the whole process. -} -recvLoop :: Serf -> TVar Bool -> TVar (Seq (Ev, Work -> IO ())) -> IO () -recvLoop serf vDone vWork = do +recvLoop + :: Serf + -> TVar Bool + -> TVar (Seq (Ev, Work -> IO ())) + -> (Maybe Ev -> STM ()) + -> IO () +recvLoop serf vDone vWork spin = do withSerfLockIO serf \SerfState {..} -> do loop ssLast ssHash where loop eve mug = do + atomically $ do + whenM (null <$> readTVar vWork) $ do + spin Nothing atomically takeCallback >>= \case Nothing -> pure (SerfState eve mug, ()) - Just cb -> recvWork serf >>= \case - work@(WDone eid hash _) -> cb work >> loop eid hash - work@(WSwap eid hash _ _) -> cb work >> loop eid hash - work@(WBail _) -> cb work >> loop eve mug + Just (curEve, cb) -> do + atomically (spin (Just curEve)) + recvWork serf >>= \case + work@(WDone eid hash _) -> cb work >> loop eid hash + work@(WSwap eid hash _ _) -> cb work >> loop eid hash + work@(WBail _) -> cb work >> loop eve mug - takeCallback :: STM (Maybe (Work -> IO ())) + takeCallback :: STM (Maybe (Ev, Work -> IO ())) takeCallback = do ((,) <$> readTVar vDone <*> readTVar vWork) >>= \case (False, Empty ) -> retry (True , Empty ) -> pure Nothing - (_ , (_, x) :<| xs) -> writeTVar vWork xs $> Just x + (_ , (e, x) :<| xs) -> writeTVar vWork xs $> Just (e, x) (_ , _ ) -> error "impossible" diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index d36ad0582..4c3da9319 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -8,6 +8,7 @@ module Urbit.Vere.Term , runTerminalClient , connClient , term + , term' ) where import Data.Char @@ -30,6 +31,7 @@ import Urbit.Vere.Term.API (Client(Client)) import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.UTF8 as BS +import qualified System.Console.ANSI as ANSI import qualified Urbit.Vere.NounServ as Serv import qualified Urbit.Vere.Term.API as Term import qualified Urbit.Vere.Term.Render as T @@ -73,20 +75,6 @@ initialHail = EvBlip $ BlipEvTerm $ TermEvHail (UD 1, ()) () -- Version one of this is punting on the ops_u.dem flag: whether we're running -- in daemon mode. -spinners :: [Text] -spinners = ["|", "/", "-", "\\"] - -leftBracket :: Text -leftBracket = "«" - -rightBracket :: Text -rightBracket = "»" - -_spin_cool_us = 500000 -_spin_warm_us = 50000 -_spin_rate_us = 250000 -_spin_idle_us = 500000 - -------------------------------------------------------------------------------- rioAllocaBytes :: (MonadIO m, MonadUnliftIO m) @@ -152,6 +140,33 @@ runTerminalClient pier = runRAcquire $ do runRAcquire :: RAcquire e () -> RIO e () runRAcquire act = rwith act $ const $ pure () + +-- Spinner --------------------------------------------------------------------- + +-- Call an STM action after delay of `first` microseconds and then every +-- `rest` microseconds after that. +repeatedly :: Int -> Int -> STM () -> IO () +repeatedly first rest action = do + threadDelay first + forever $ do + atomically action + threadDelay rest + +spinners :: [Text] +spinners = ["|", "/", "-", "\\"] + +leftBracket, rightBracket :: Text +leftBracket = "«" +rightBracket = "»" + +_spin_cool_us = 500000 +_spin_warm_us = 50000 +_spin_rate_us = 250000 +_spin_idle_us = 500000 + + +-- Client ---------------------------------------------------------------------- + {-| Initializes the generalized input/output parts of the terminal. -} @@ -162,10 +177,9 @@ localClient doneSignal = fst <$> mkRAcquire start stop where start :: HasLogFunc e => RIO e ((T.TSize, Client), Private) start = do - tsWriteQueue <- newTQueueIO - spinnerMVar <- newEmptyTMVarIO - pWriterThread <- - asyncBound (writeTerminal tsWriteQueue spinnerMVar) + tsWriteQueue <- newTQueueIO :: RIO e (TQueue [Term.Ev]) + spinnerMVar <- newEmptyTMVarIO :: RIO e (TMVar ()) + pWriterThread <- asyncBound (writeTerminal tsWriteQueue spinnerMVar) pPreviousConfiguration <- io $ getTerminalAttributes stdInput @@ -225,17 +239,6 @@ localClient doneSignal = fst <$> mkRAcquire start stop , ProcessOutput ] - -- An async which will put into an mvar after a delay. Used to spin the - -- spinner in writeTerminal. - spinnerHeartBeat :: Int -> Int -> TMVar () -> RIO e () - spinnerHeartBeat first rest mvar = do - threadDelay first - loop - where - loop = do - atomically $ putTMVar mvar () - threadDelay rest - loop -- Writes data to the terminal. Both the terminal reading, normal logging, -- and effect handling can all emit bytes which go to the terminal. @@ -245,9 +248,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop loop (LineState "" 0 Nothing Nothing True 0 currentTime) where writeBlank :: LineState -> RIO e LineState - writeBlank ls = do - putStr "\r\n" - pure ls + writeBlank ls = putStr "\r\n" $> ls writeTrace :: LineState -> Text -> RIO e LineState writeTrace ls p = do @@ -265,6 +266,8 @@ localClient doneSignal = fst <$> mkRAcquire start stop -} doSpin :: LineState -> Maybe Text -> RIO e LineState doSpin ls@LineState{..} mTxt = do + maybe (pure ()) cancel lsSpinTimer + current <- io $ now delay <- pure $ case mTxt of Nothing -> 0 @@ -273,7 +276,10 @@ localClient doneSignal = fst <$> mkRAcquire start stop then _spin_warm_us else _spin_cool_us - spinTimer <- async $ spinnerHeartBeat delay _spin_rate_us spinner + spinTimer <- io $ async + $ repeatedly delay _spin_rate_us + $ void + $ tryPutTMVar spinner () pure $ ls { lsSpinTimer = Just spinTimer , lsSpinCause = mTxt @@ -290,7 +296,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop -- If we ever actually ran the spinner display callback, we need -- to force a redisplay of the command prompt. - ls <- if not lsSpinFirstRender + ls <- if not lsSpinFirstRender || True then termRefreshLine ls else pure ls @@ -305,16 +311,16 @@ localClient doneSignal = fst <$> mkRAcquire start stop Term.Spinr (Just txt) -> doSpin ls (unCord <$> txt) Term.Spinr Nothing -> unspin ls + -- TODO What does this do? spin :: LineState -> RIO e LineState spin ls@LineState{..} = do let spinner = (spinners !! lsSpinFrame) ++ case lsSpinCause of Nothing -> "" Just str -> leftBracket ++ str ++ rightBracket - putStr spinner - termSpinnerMoveLeft (length spinner) + putStr (spinner <> pack (ANSI.cursorBackwardCode (length spinner))) - let newFrame = (lsSpinFrame + 1) `mod` (length spinners) + let newFrame = (lsSpinFrame + 1) `mod` length spinners pure $ ls { lsSpinFirstRender = False , lsSpinFrame = newFrame @@ -355,8 +361,8 @@ localClient doneSignal = fst <$> mkRAcquire start stop -- Moves the cursor left without any mutation of the LineState. Used only -- in cursor spinning. - termSpinnerMoveLeft :: Int → RIO e () - termSpinnerMoveLeft = T.cursorLeft + _termSpinnerMoveLeft :: Int → RIO e () + _termSpinnerMoveLeft = T.cursorLeft -- Displays and sets the current line termShowLine :: LineState -> Text -> RIO e LineState @@ -488,15 +494,38 @@ localClient doneSignal = fst <$> mkRAcquire start stop -- logDebug $ displayShow ("terminalBelt", b) atomically $ writeTQueue rq b + -------------------------------------------------------------------------------- -initialBlewFailed :: e -> WorkError -> IO () -initialBlewFailed env _ = runRIO env $ do - pure () -- TODO What do? +{-| + Terminal Driver -initialHailFailed :: e -> WorkError -> IO () -initialHailFailed env _ = runRIO env $ do - pure () -- TODO What do? + Until blew/hail events succeeds, ignore effects. + Wait until blew/hail event callbacks invoked. + If success, signal success. + If failure, try again several times. + If still failure, bring down ship. + Don't wait for other drivers to boot + Begin normal operation (start accepting requests) +-} +term' + :: HasPierEnv e + => (T.TSize, Client) + -> RIO e ([Ev], RAcquire e (DriverApi TermEf)) +term' (tsize, client) = do + let T.TSize wi hi = tsize + initEv = [initialBlew wi hi, initialHail] + + pure (initEv, runDriver) + where + runDriver = do + env <- ask + ventQ :: TQueue EvErr <- newTQueueIO + diOnEffect <- term env (tsize, client) (writeTQueue ventQ) + + let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + + pure (DriverApi {..}) {-| Terminal Driver @@ -505,17 +534,9 @@ term :: forall e. (HasPierEnv e) => e -> (T.TSize, Client) -> (EvErr -> STM ()) - -> ([EvErr], RAcquire e (TermEf -> IO ())) -term env (tsize, Client{..}) plan = - (initialEvents, runTerm) + -> RAcquire e (TermEf -> IO ()) +term env (tsize, Client{..}) plan = runTerm where - T.TSize wi hi = tsize - - initialEvents = - [ EvErr (initialBlew wi hi) (initialBlewFailed env) - , EvErr initialHail (initialHailFailed env) - ] - runTerm :: RAcquire e (TermEf -> IO ()) runTerm = do tim <- mkRAcquire (async readLoop) cancel From b552149610999c86e0d10ba1938d0ec6de124f6a Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 20:04:09 +0000 Subject: [PATCH 131/257] king: handle tanks that are just a cord. --- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 5 ++++- pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs | 26 ++++++++++++++++++------ 2 files changed, 24 insertions(+), 7 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 0a08f6e3e..0bfca042a 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -112,7 +112,9 @@ writeJobs log !jobs = do -- Acquire a running serf. ----------------------------------------------------- printTank :: (Text -> IO ()) -> Atom -> Tank -> IO () -printTank f _priority = f . unlines . fmap unTape . wash (WashCfg 0 80) +printTank f _priority = f . unlines . fmap unTape . wash (WashCfg 0 80) . tankTree + where + tankTree (Tank t) = t runSerf :: HasLogFunc e @@ -219,6 +221,7 @@ resumed vSlog replayUntil flags = do Right _ -> do logDebug "Taking snapshot" io (Serf.snapshot serf) + logDebug "SNAPSHOT TAKEN" pure (serf, log) diff --git a/pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs index 90a315ab6..bfba684c7 100644 --- a/pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs +++ b/pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs @@ -7,18 +7,32 @@ module Urbit.Noun.Tank where import ClassyPrelude import Urbit.Noun.Conversions import Urbit.Noun.TH +import Urbit.Noun.Convert +import Urbit.Noun.Core -------------------------------------------------------------------------------- type Tang = [Tank] -data Tank +data TankTree = Leaf Tape | Plum Plum - | Palm (Tape, Tape, Tape, Tape) [Tank] - | Rose (Tape, Tape, Tape) [Tank] + | Palm (Tape, Tape, Tape, Tape) [TankTree] + | Rose (Tape, Tape, Tape) [TankTree] deriving (Eq, Ord, Show) +newtype Tank = Tank { tankTree :: TankTree } + deriving newtype (Eq, Ord, Show) + +instance ToNoun Tank where + toNoun (Tank t) = toNoun t + +instance FromNoun Tank where + parseNoun n@(Atom _) = do + Cord txt <- parseNoun n + pure $ Tank $ Leaf $ Tape txt + parseNoun n = Tank <$> parseNoun n + data WideFmt = WideFmt { delimit :: Cord, enclose :: Maybe (Cord, Cord) } deriving (Eq, Ord, Show) @@ -39,7 +53,7 @@ data PlumTree deriveNoun ''WideFmt deriveNoun ''TallFmt deriveNoun ''PlumFmt -deriveNoun ''Tank +deriveNoun ''TankTree deriveNoun ''PlumTree -------------------------------------------------------------------------------- @@ -51,7 +65,7 @@ data WashCfg = WashCfg -------------------------------------------------------------------------------- -wash :: WashCfg -> Tank -> Wall +wash :: WashCfg -> TankTree -> Wall wash _cfg t = [ram t] -- win :: WashCfg -> Tank -> Wall @@ -60,7 +74,7 @@ wash _cfg t = [ram t] flat :: Plum -> Tape flat = Tape . tshow -ram :: Tank -> Tape +ram :: TankTree -> Tape ram = \case Leaf tape -> tape Plum plum -> flat plum From 7f780bbcd572e0e9378bc9fef45345b982cfae25 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 20:08:09 +0000 Subject: [PATCH 132/257] king: TODO.md updates. --- pkg/hs/urbit-king/TODO.md | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 0ea535e8d..48e65af80 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -18,9 +18,13 @@ Stubbed out: Bugs: +- [ ] In non-daemon mode, serf slogs/stderr output that happens *before* + the terminal connects should still go to stderr. +- [ ] Serf stderr should also be send (along with slogs) to all connected + terminals. - [x] `king new` should reject pier directories that already exist. - [x] In non-daemon-mode, ^D doesn't bring down Urbit properly. -- [ ] Spinner updated multiple times with the same event, and this causes +- [x] Spinner updated multiple times with the same event, and this causes logging of events to contain duplicates. King-Haskell specific features: @@ -55,7 +59,7 @@ Polish: - [ ] Handle ^C in connected terminals. It should interrupt current event (send SIGINT to serf, which will cause the current event to fail promptly). -- [ ] The terminal driver seems to have a race condition when spinner +- [x] The terminal driver seems to have a race condition when spinner changed too quickly. # Cleanup From cefc25cbe1c17e367cf4babfc0e18af8e2e6c957 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 20:53:55 +0000 Subject: [PATCH 133/257] king: ^C from connected terminals kills current event. --- pkg/hs/urbit-king/TODO.md | 4 ++-- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 8 +++++--- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 7 ++++--- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 14 +++++++++++++- pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs | 10 +++++++--- 5 files changed, 31 insertions(+), 12 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 48e65af80..ba3d1c996 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -79,8 +79,8 @@ Polish: # Finding the Serf Executable -Right now, `urbit-worker` is found by looking it up in the PATH. This -is wrong, but what is right? +- [ ] Right now, `urbit-worker` is found by looking it up in the PATH. This + is wrong, but what is right? # Further IO Driver Startup Flow Betterment diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 0bfca042a..43c586c51 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -309,13 +309,14 @@ pier (serf, log) vSlog startedSig multi = do let compute = putTMVar computeQ let execute = writeTQueue executeQ let persist = writeTQueue persistQ + let sigint = Serf.sendSIGINT serf (bootEvents, startDrivers) <- do env <- ask let err = atomically . Term.trace muxed . (<> "\r\n") let siz = Term.TSize { tsWide = 80, tsTall = 24 } let fak = isFake logId - drivers env multi ship fak compute (siz, muxed) err + drivers env multi ship fak compute (siz, muxed) err sigint scrySig <- newEmptyTMVarIO onKill <- view onKillPierSigL @@ -415,10 +416,11 @@ drivers -> (RunReq -> STM ()) -> (Term.TSize, Term.Client) -> (Text -> RIO e ()) + -> IO () -> RAcquire e ([Ev], RAcquire e Drivers) -drivers env multi who isFake plan termSys stderr = do +drivers env multi who isFake plan termSys stderr serfSIGINT = do (behnBorn, runBehn) <- rio behn' - (termBorn, runTerm) <- rio (Term.term' termSys) + (termBorn, runTerm) <- rio (Term.term' termSys serfSIGINT) (amesBorn, runAmes) <- rio (Ames.ames' who isFake stderr) (httpBorn, runEyre) <- rio (Eyre.eyre' multi who isFake) (clayBorn, runClay) <- rio Clay.clay' diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 36079170e..bc811a90b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -24,9 +24,10 @@ import qualified Data.Conduit.Combinators as CC import qualified System.ProgressBar as PB import qualified Urbit.EventLog.LMDB as Log -import qualified Urbit.Vere.Serf.IPC as X (Config(..), EvErr(..), Flag(..), - RunReq(..), Serf, WorkError(..), run, - snapshot, start, stop) +import qualified Urbit.Vere.Serf.IPC as X (Config (..), EvErr (..), Flag (..), + RunReq (..), Serf, WorkError (..), + run, sendSIGINT, snapshot, start, + stop) -------------------------------------------------------------------------------- diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index a771d3a4e..d7ae9e475 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -59,6 +59,7 @@ module Urbit.Vere.Serf.IPC , replay , run , swim + , sendSIGINT , module Urbit.Vere.Serf.Types ) where @@ -77,7 +78,7 @@ import Foreign.Marshal.Alloc (alloca) import Foreign.Ptr (castPtr) import Foreign.Storable (peek, poke) import RIO.Prelude (decodeUtf8Lenient) -import System.Posix.Signals (sigKILL, signalProcess) +import System.Posix.Signals (sigINT, sigKILL, signalProcess) import Urbit.Arvo (Ev, FX) import Urbit.Noun.Time (Wen) @@ -326,8 +327,19 @@ withSerfLockIO :: Serf -> (SerfState -> IO (SerfState, a)) -> IO a withSerfLockIO s a = runResourceT (withSerfLock s (io . a)) +-- SIGINT ---------------------------------------------------------------------- + +sendSIGINT :: Serf -> IO () +sendSIGINT serf = do + getPid (serfProc serf) >>= \case + Nothing -> pure () + Just pid -> do + io $ signalProcess sigINT pid + + -- Killing the Serf ------------------------------------------------------------ + {-| Ask the serf to shutdown. If it takes more than 2s, kill it with SIGKILL. diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index 4c3da9319..af7bd3881 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs @@ -511,8 +511,9 @@ localClient doneSignal = fst <$> mkRAcquire start stop term' :: HasPierEnv e => (T.TSize, Client) + -> IO () -> RIO e ([Ev], RAcquire e (DriverApi TermEf)) -term' (tsize, client) = do +term' (tsize, client) serfSIGINT = do let T.TSize wi hi = tsize initEv = [initialBlew wi hi, initialHail] @@ -521,7 +522,7 @@ term' (tsize, client) = do runDriver = do env <- ask ventQ :: TQueue EvErr <- newTQueueIO - diOnEffect <- term env (tsize, client) (writeTQueue ventQ) + diOnEffect <- term env (tsize, client) (writeTQueue ventQ) serfSIGINT let diEventSource = fmap RRWork <$> tryReadTQueue ventQ @@ -534,8 +535,9 @@ term :: forall e. (HasPierEnv e) => e -> (T.TSize, Client) -> (EvErr -> STM ()) + -> IO () -> RAcquire e (TermEf -> IO ()) -term env (tsize, Client{..}) plan = runTerm +term env (tsize, Client{..}) plan serfSIGINT = runTerm where runTerm :: RAcquire e (TermEf -> IO ()) runTerm = do @@ -551,6 +553,8 @@ term env (tsize, Client{..}) plan = runTerm atomically take >>= \case Nothing -> pure () Just b -> do + when (b == Ctl (Cord "c")) $ do + io serfSIGINT let beltEv = EvBlip $ BlipEvTerm $ TermEvBelt (UD 1, ()) $ b let beltFailed _ = pure () atomically $ plan (EvErr beltEv beltFailed) From c721baee7fcc6aa23b927775aaa46919125f54cf Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 21:03:46 +0000 Subject: [PATCH 134/257] king: serf stderr goes to terminals. --- pkg/hs/urbit-king/TODO.md | 4 ++-- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index ba3d1c996..d181d0b30 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -20,7 +20,7 @@ Bugs: - [ ] In non-daemon mode, serf slogs/stderr output that happens *before* the terminal connects should still go to stderr. -- [ ] Serf stderr should also be send (along with slogs) to all connected +- [x] Serf stderr should also be send (along with slogs) to all connected terminals. - [x] `king new` should reject pier directories that already exist. - [x] In non-daemon-mode, ^D doesn't bring down Urbit properly. @@ -56,7 +56,7 @@ Polish: # Misc Bugs - [ ] `king run --collect-fx` flag does nothing. Remove or implement. -- [ ] Handle ^C in connected terminals. It should interrupt current +- [x] Handle ^C in connected terminals. It should interrupt current event (send SIGINT to serf, which will cause the current event to fail promptly). - [x] The terminal driver seems to have a race condition when spinner diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 43c586c51..331ce7710 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -132,7 +132,7 @@ runSerf vSlog pax fax = do , scPier = pax , scFlag = fax , scSlog = \(pri, tank) -> printTank slog pri tank - , scStdr = \line -> runRIO env $ logTrace (display ("SERF: " <> line)) + , scStdr = \txt -> slog (txt <> "\r\n") , scDead = pure () -- TODO: What can be done? } From dabe38be0d0ed5aaa3aa7e4d6d060162b11f20ed Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 21:17:55 +0000 Subject: [PATCH 135/257] In non-daemon mode, initial serf slogs are user-visiable. --- pkg/hs/urbit-king/TODO.md | 2 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 16 +++++++++------- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 8 ++++---- 3 files changed, 14 insertions(+), 12 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index d181d0b30..d611dd33f 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -18,7 +18,7 @@ Stubbed out: Bugs: -- [ ] In non-daemon mode, serf slogs/stderr output that happens *before* +- [x] In non-daemon mode, serf slogs/stderr output that happens *before* the terminal connects should still go to stderr. - [x] Serf stderr should also be send (along with slogs) to all connected terminals. diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index d43360f6f..2bd97e555 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -85,16 +85,13 @@ import Urbit.Vere.Pier import Urbit.Vere.Eyre.Multi (multiEyre, MultiEyreApi, MultiEyreConf(..)) import Urbit.Vere.Pier.Types import Urbit.Vere.Serf +import Urbit.King.App import Control.Concurrent (myThreadId) import Control.Exception (AsyncException(UserInterrupt)) import Control.Lens ((&)) import System.Process (system) import Text.Show.Pretty (pPrint) -import Urbit.King.App (KingEnv, PierEnv, kingEnvKillSignal) -import Urbit.King.App (killKingActionL, onKillKingSigL) -import Urbit.King.App (killPierActionL) -import Urbit.King.App (runKingEnvLogFile, runKingEnvStderr, runPierEnv) import Urbit.Noun.Conversions (cordToUW) import Urbit.Noun.Time (Wen) import Urbit.Vere.LockFile (lockFile) @@ -167,10 +164,15 @@ toNetworkConfig CLI.Opts {..} = NetworkConfig { .. } _ncNoHttp = oNoHttp _ncNoHttps = oNoHttps -logSlogs :: HasLogFunc e => RIO e (TVar (Text -> IO ())) -logSlogs = do +logStderr :: HasStderrLogFunc e => RIO LogFunc a -> RIO e a +logStderr action = do + logFunc <- view stderrLogFuncL + runRIO logFunc action + +logSlogs :: HasStderrLogFunc e => RIO e (TVar (Text -> IO ())) +logSlogs = logStderr $ do env <- ask - newTVarIO (runRIO env . logTrace . ("SLOG: " <>) . display) + newTVarIO (runRIO env . logOther "serf" . display . T.strip) tryBootFromPill :: Bool diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 331ce7710..b8dbd5105 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -35,6 +35,7 @@ import Urbit.Vere.Behn (behn') import Urbit.Vere.Eyre.Multi (MultiEyreApi) import Urbit.Vere.Serf (Serf) +import qualified Data.Text as T import qualified System.Entropy as Ent import qualified Urbit.EventLog.LMDB as Log import qualified Urbit.King.API as King @@ -296,11 +297,10 @@ pier (serf, log) vSlog startedSig multi = do logDebug "TERMSERV External terminal connected." -- Slogs go to both stderr and to the terminal. - atomically $ do - oldSlog <- readTVar vSlog - writeTVar vSlog $ \txt -> do + env <- ask + atomically $ writeTVar vSlog $ \txt -> runRIO env $ do atomically $ Term.trace muxed txt - oldSlog txt + logOther "serf" (display $ T.strip txt) -- Our call above to set the logging function which echos errors from the -- Serf doesn't have the appended \r\n because those \r\n s are added in From f0f82d7e14de52f744942c979b6e210d98bb47af Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 22:00:31 +0000 Subject: [PATCH 136/257] king: Handle %vega/%exit, %wack on boot, and stop logging secrets. --- pkg/hs/urbit-king/TODO.md | 31 +++++++----- pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs | 5 +- pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs | 9 +++- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 57 +++++++++++++--------- 4 files changed, 64 insertions(+), 38 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index d611dd33f..45ec29c3e 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -62,6 +62,25 @@ Polish: - [x] The terminal driver seems to have a race condition when spinner changed too quickly. + +# Finding the Serf Executable + +- [ ] Right now, `urbit-worker` is found by looking it up in the PATH. This + is wrong, but what is right? + + +# Further IO Driver Startup Flow Betterment + +Implement Pier-wide process start events + +- [x] Handle %vega and exit effects. +- [x] Handle %trim effect +- [x] Inject entropy event on pier start: ``[//arvo [%wack ENT]]` +- [ ] Verbose flag: `-v` injects `[%verb ~]` +- [ ] CLI event injection: `-I file-path`. The `file-path` is a jammed + noun representing an event: `[wire card]`. + + # Cleanup - [x] ShutdownSTM action that's passed to the terminal driver should @@ -76,15 +95,3 @@ Polish: - Make it care less about the shape of events and effects. - [ ] Spin off per-pier logic into it's own package. - Probably `urbit-pier` - -# Finding the Serf Executable - -- [ ] Right now, `urbit-worker` is found by looking it up in the PATH. This - is wrong, but what is right? - -# Further IO Driver Startup Flow Betterment - -- Implement Pier-wide process start events - - [ ] Entropy injection. - - [ ] Verbose flag. - - [ ] CLI event injection. diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs index 49a8ce914..1b0b4ad4b 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs @@ -79,7 +79,10 @@ instance FromNoun H.StdMethod where -- Http Server Configuration --------------------------------------------------- newtype PEM = PEM { unPEM :: Wain } - deriving newtype (Eq, Ord, Show, ToNoun, FromNoun) + deriving newtype (Eq, Ord, ToNoun, FromNoun) + +instance Show PEM where + show _ = "\"PEM (secret)\"" type Key = PEM type Cert = PEM diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs index 83da5c6d5..ed4fbe0c7 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs @@ -202,9 +202,16 @@ deriveNoun ''AmesEv -- Arvo Events ----------------------------------------------------------------- +newtype Entropy = Entropy { entropyBits :: Word512 } + deriving newtype (Eq, Ord, FromNoun, ToNoun) + +instance Show Entropy where + show = const "\"ENTROPY (secret)\"" + + data ArvoEv = ArvoEvWhom () Ship - | ArvoEvWack () Word512 + | ArvoEvWack () Entropy | ArvoEvWarn Path Noun | ArvoEvCrud Path Noun | ArvoEvVeer Atom Noun diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index b8dbd5105..6751c9fe0 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -23,13 +23,12 @@ import RIO.Directory import Urbit.Arvo import Urbit.King.Config import Urbit.Vere.Pier.Types +import Urbit.King.App import Control.Monad.STM (retry) import System.Posix.Files (ownerModes, setFileMode) import Urbit.EventLog.LMDB (EventLog) import Urbit.King.API (TermConn) -import Urbit.King.App (HasKingEnv, HasPierEnv(..), PierEnv) -import Urbit.King.App (onKillPierSigL) import Urbit.Noun.Time (Wen) import Urbit.Vere.Behn (behn') import Urbit.Vere.Eyre.Multi (MultiEyreApi) @@ -70,8 +69,8 @@ setupPierDirectory shipPath = do -- Load pill into boot sequence. ----------------------------------------------- -genEntropy :: MonadIO m => m Word512 -genEntropy = fromIntegral . bytesAtom <$> io (Ent.getEntropy 64) +genEntropy :: MonadIO m => m Entropy +genEntropy = Entropy . fromIntegral . bytesAtom <$> io (Ent.getEntropy 64) genBootSeq :: MonadIO m => Ship -> Pill -> Bool -> LegacyBootEvent -> m BootSeq genBootSeq ship Pill {..} lite boot = io $ do @@ -184,7 +183,7 @@ bootNewShip pill lite flags ship bootEv = do let logPath = (pierPath ".urb/log") rwith (Log.new logPath ident) $ \log -> do - logDebug "Event log initialized." + logDebug "Event log onitialized." jobs <- (\now -> bootSeqJobs now seq) <$> io Time.now writeJobs log (fromList jobs) @@ -334,7 +333,8 @@ pier (serf, log) vSlog startedSig multi = do tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) -- Run all born events and retry them until they succeed. - rio $ for_ bootEvents $ \ev -> do + wackEv <- EvBlip . BlipEvArvo . ArvoEvWack () <$> genEntropy + rio $ for_ (wackEv : bootEvents) $ \ev -> do okaySig <- newEmptyMVar let inject n = atomically $ compute $ RRWork $ EvErr ev $ cb n @@ -350,8 +350,13 @@ pier (serf, log) vSlog startedSig multi = do logTrace ("Boot Event" <> displayShow ev) io (inject 0) + let slog :: Text -> IO () + slog txt = do + fn <- atomically (readTVar vSlog) + fn txt + drivz <- startDrivers - tExec <- acquireWorker "Effects" (router (readTQueue executeQ) drivz) + tExec <- acquireWorker "Effects" (router slog (readTQueue executeQ) drivz) tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ execute) let snapshotEverySecs = 120 @@ -465,23 +470,27 @@ drivers env multi who isFake plan termSys stderr serfSIGINT = do -- Route Effects to Drivers ---------------------------------------------------- -router :: HasLogFunc e => STM FX -> Drivers -> RIO e () -router waitFx Drivers {..} = forever $ do - fx <- atomically waitFx - for_ fx $ \ef -> do - logEffect ef - case ef of - GoodParse (EfVega _ _ ) -> error "TODO" - GoodParse (EfExit _ _ ) -> error "TODO" - GoodParse (EfVane (VEBehn ef)) -> io (dBehn ef) - GoodParse (EfVane (VEBoat ef)) -> io (dSync ef) - GoodParse (EfVane (VEClay ef)) -> io (dSync ef) - GoodParse (EfVane (VEHttpClient ef)) -> io (dIris ef) - GoodParse (EfVane (VEHttpServer ef)) -> io (dEyre ef) - GoodParse (EfVane (VENewt ef)) -> io (dNewt ef) - GoodParse (EfVane (VESync ef)) -> io (dSync ef) - GoodParse (EfVane (VETerm ef)) -> io (dTerm ef) - FailParse n -> logError $ display $ pack @Text (ppShow n) +router :: HasPierEnv e => (Text -> IO ()) -> STM FX -> Drivers -> RIO e () +router slog waitFx Drivers {..} = do + kill <- view killPierActionL + let exit = io (slog "<<>>\r\n") >> atomically kill + let vega = io (slog "<<>>\r\n") + forever $ do + fx <- atomically waitFx + for_ fx $ \ef -> do + logEffect ef + case ef of + GoodParse (EfVega _ _ ) -> vega + GoodParse (EfExit _ _ ) -> exit + GoodParse (EfVane (VEBehn ef)) -> io (dBehn ef) + GoodParse (EfVane (VEBoat ef)) -> io (dSync ef) + GoodParse (EfVane (VEClay ef)) -> io (dSync ef) + GoodParse (EfVane (VEHttpClient ef)) -> io (dIris ef) + GoodParse (EfVane (VEHttpServer ef)) -> io (dEyre ef) + GoodParse (EfVane (VENewt ef)) -> io (dNewt ef) + GoodParse (EfVane (VESync ef)) -> io (dSync ef) + GoodParse (EfVane (VETerm ef)) -> io (dTerm ef) + FailParse n -> logError $ display $ pack @Text (ppShow n) -- Compute (Serf) Thread ------------------------------------------------------- From ba5bd09724ae9bd24efb178862509afed60e9ba7 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Wed, 10 Jun 2020 23:41:09 +0000 Subject: [PATCH 137/257] CLI option for serf exe + serf exe/flags live in PierConfig. --- pkg/hs/urbit-king/TODO.md | 17 ++++++ pkg/hs/urbit-king/lib/Urbit/King/App.hs | 4 +- pkg/hs/urbit-king/lib/Urbit/King/App/Class.hs | 15 +++++ pkg/hs/urbit-king/lib/Urbit/King/CLI.hs | 20 ++++--- pkg/hs/urbit-king/lib/Urbit/King/Config.hs | 8 ++- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 55 +++++++++++-------- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 24 ++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 2 +- 8 files changed, 94 insertions(+), 51 deletions(-) create mode 100644 pkg/hs/urbit-king/lib/Urbit/King/App/Class.hs diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index 45ec29c3e..c295a6403 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -69,6 +69,20 @@ Polish: is wrong, but what is right? +# Take Advantage of New IPC Features + +- [ ] Hook up `scry` to drivers. + - Any immediate applications of this? + +- [ ] Allow scrys to go into the %work batching flow for better latency. + +- Handle event errors in other cases: + - [ ] Ames packet failures should print (but not too often). + - [ ] Incoming Http requests should produce 500 responses. + - [ ] Terminal event errors should be printed in connected terminals. + - [ ] Http client responses should be retried. + + # Further IO Driver Startup Flow Betterment Implement Pier-wide process start events @@ -79,6 +93,9 @@ Implement Pier-wide process start events - [ ] Verbose flag: `-v` injects `[%verb ~]` - [ ] CLI event injection: `-I file-path`. The `file-path` is a jammed noun representing an event: `[wire card]`. + 1. Just parse it as an `Ev` for now. + 2. Make the serf IPC code not care about the shape of events and effects. + 3. Support invalid events throughout the system (use `Lenient`?) # Cleanup diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs index 73ef5ae7d..263a596a5 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs @@ -29,13 +29,11 @@ import System.Directory (createDirectoryIfMissing, getHomeDirectory) import System.Posix.Internals (c_getpid) import System.Posix.Types (CPid(..)) import System.Random (randomIO) +import Urbit.King.App.Class (HasStderrLogFunc(..)) -- KingEnv --------------------------------------------------------------------- -class HasStderrLogFunc a where - stderrLogFuncL :: Lens' a LogFunc - class HasKingId a where kingIdL :: Lens' a Word16 diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App/Class.hs b/pkg/hs/urbit-king/lib/Urbit/King/App/Class.hs new file mode 100644 index 000000000..c4a4ec08b --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/King/App/Class.hs @@ -0,0 +1,15 @@ +{-| + Code for setting up the RIO environment. +-} +module Urbit.King.App.Class + ( HasStderrLogFunc(..) + ) +where + +import Urbit.Prelude + + +-- KingEnv --------------------------------------------------------------------- + +class HasStderrLogFunc a where + stderrLogFuncL :: Lens' a LogFunc diff --git a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs index bf8026820..15fee1691 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs @@ -40,6 +40,7 @@ data Opts = Opts , oHttpPort :: Maybe Word16 , oHttpsPort :: Maybe Word16 , oLoopbackPort :: Maybe Word16 + , oSerfExe :: Maybe Text } deriving (Show) @@ -272,13 +273,18 @@ opts = do <> help "Localhost-only HTTP port" <> hidden - -- Always disable hashboard. Right now, urbit is almost unusable with this - -- flag enabled and it is disabled in vere. - let oHashless = True - -- oHashless <- switch $ short 'S' - -- <> long "hashless" - -- <> help "Disable battery hashing" - -- <> hidden + oSerfExe <- + optional + $ option auto + $ metavar "PATH" + <> long "serf" + <> help "Path to Serf" + <> hidden + + oHashless <- switch $ short 'S' + <> long "hashless" + <> help "Disable battery hashing (Ignored for now)" + <> hidden oQuiet <- switch $ short 'q' <> long "quiet" diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs index cd9d0acb4..7cb9ceb2c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs @@ -5,13 +5,17 @@ module Urbit.King.Config where import Urbit.Prelude +import qualified Urbit.Vere.Serf as Serf + {-| All the configuration data revolving around a ship and the current execution options. -} data PierConfig = PierConfig - { _pcPierPath :: FilePath - , _pcDryRun :: Bool + { _pcPierPath :: FilePath + , _pcDryRun :: Bool + , _pcSerfExe :: Text + , _pcSerfFlags :: [Serf.Flag] } deriving (Show) makeLenses ''PierConfig diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 2bd97e555..b6043c5f8 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -120,28 +120,32 @@ removeFileIfExists pax = do removeFile pax --------------------------------------------------------------------------------- +-- Compile CLI Flags to Pier Configuration ------------------------------------- +{- + TODO: This is not all of the flags. + Urbit is basically useless with hashboard, so we ignore that flag. +-} toSerfFlags :: CLI.Opts -> [Serf.Flag] toSerfFlags CLI.Opts{..} = catMaybes m where - -- TODO: This is not all the flags. - m = [ from oQuiet Serf.Quiet - , from oTrace Serf.Trace - , from oHashless Serf.Hashless - , from oQuiet Serf.Quiet - , from oVerbose Serf.Verbose - , from (oDryRun || isJust oDryFrom) Serf.DryRun + m = [ setFrom oQuiet Serf.Quiet + , setFrom oTrace Serf.Trace + , setFrom (oHashless || True) Serf.Hashless + , setFrom oQuiet Serf.Quiet + , setFrom oVerbose Serf.Verbose + , setFrom (oDryRun || isJust oDryFrom) Serf.DryRun ] - from True flag = Just flag - from False _ = Nothing - + setFrom True flag = Just flag + setFrom False _ = Nothing toPierConfig :: FilePath -> CLI.Opts -> PierConfig -toPierConfig pierPath CLI.Opts {..} = PierConfig { .. } +toPierConfig pierPath o@(CLI.Opts{..}) = PierConfig { .. } where - _pcPierPath = pierPath - _pcDryRun = oDryRun || isJust oDryFrom + _pcPierPath = pierPath + _pcDryRun = oDryRun || isJust oDryFrom + _pcSerfExe = fromMaybe "urbit-worker" oSerfExe + _pcSerfFlags = toSerfFlags o toNetworkConfig :: CLI.Opts -> NetworkConfig toNetworkConfig CLI.Opts {..} = NetworkConfig { .. } @@ -178,12 +182,11 @@ tryBootFromPill :: Bool -> Pill -> Bool - -> [Serf.Flag] -> Ship -> LegacyBootEvent -> MultiEyreApi -> RIO PierEnv () -tryBootFromPill oExit pill lite flags ship boot multi = do +tryBootFromPill oExit pill lite ship boot multi = do mStart <- newEmptyMVar vSlog <- logSlogs runOrExitImmediately vSlog (bootedPier vSlog) oExit mStart multi @@ -191,7 +194,7 @@ tryBootFromPill oExit pill lite flags ship boot multi = do bootedPier vSlog = do view pierPathL >>= lockFile rio $ logTrace "Starting boot" - sls <- Pier.booted vSlog pill lite flags ship boot + sls <- Pier.booted vSlog pill lite ship boot rio $ logTrace "Completed boot" pure sls @@ -219,11 +222,10 @@ tryPlayShip :: Bool -> Bool -> Maybe Word64 - -> [Serf.Flag] -> MVar () -> MultiEyreApi -> RIO PierEnv () -tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do +tryPlayShip exitImmediately fullReplay playFrom mStart multi = do when fullReplay wipeSnapshot vSlog <- logSlogs runOrExitImmediately vSlog (resumeShip vSlog) exitImmediately mStart multi @@ -243,7 +245,7 @@ tryPlayShip exitImmediately fullReplay playFrom flags mStart multi = do resumeShip vSlog = do view pierPathL >>= lockFile rio $ logTrace "RESUMING SHIP" - sls <- Pier.resumed vSlog playFrom flags + sls <- Pier.resumed vSlog playFrom rio $ logTrace "SHIP RESUMED" pure sls @@ -251,6 +253,7 @@ runRAcquire :: (MonadUnliftIO (m e), MonadIO (m e), MonadReader e (m e)) => RAcquire e a -> m e a runRAcquire act = rwith act pure + -------------------------------------------------------------------------------- checkEvs :: FilePath -> Word64 -> Word64 -> RIO KingEnv () @@ -301,6 +304,10 @@ checkEvs pierPath first last = do -------------------------------------------------------------------------------- +collectAllFx :: FilePath -> RIO KingEnv () +collectAllFx = error "TODO" + +{- {-| This runs the serf at `$top/.tmpdir`, but we disable snapshots, so this should never actually be created. We just do this to avoid @@ -325,6 +332,7 @@ collectAllFx top = do serfFlags :: [Serf.Flag] serfFlags = [Serf.Hashless, Serf.DryRun] +-} -------------------------------------------------------------------------------- @@ -530,8 +538,6 @@ newShip CLI.New{..} opts = do name <- nameFromShip ship runTryBootFromPill multi pill name ship (Dawn dawn) - flags = toSerfFlags opts - -- Now that we have all the information for running an application with a -- PierConfig, do so. runTryBootFromPill multi pill name ship bootEvent = do @@ -539,7 +545,7 @@ newShip CLI.New{..} opts = do let pierConfig = toPierConfig (pierPath name) opts let networkConfig = toNetworkConfig opts runPierEnv pierConfig networkConfig vKill $ - tryBootFromPill True pill nLite flags ship bootEvent multi + tryBootFromPill True pill nLite ship bootEvent multi ------ tryBootFromPill (CLI.oExit opts) pill nLite flags ship bootEvent runShipEnv :: CLI.Run -> CLI.Opts -> TMVar () -> RIO PierEnv a -> RIO KingEnv a @@ -567,12 +573,12 @@ runShip (CLI.Run pierPath) opts daemon multi = do finally (runPier mStart) $ do cancel connectionThread where + runPier :: MVar () -> RIO PierEnv () runPier mStart = do tryPlayShip (CLI.oExit opts) (CLI.oFullReplay opts) (CLI.oDryFrom opts) - (toSerfFlags opts) mStart multi @@ -616,6 +622,7 @@ checkComet = do main :: IO () main = do args <- CLI.parseArgs + hSetBuffering stdout NoBuffering setupSignalHandlers diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 6751c9fe0..8303558fe 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -117,20 +117,19 @@ printTank f _priority = f . unlines . fmap unTape . wash (WashCfg 0 80) . tankTr tankTree (Tank t) = t runSerf - :: HasLogFunc e + :: HasPierEnv e => TVar (Text -> IO ()) -> FilePath - -> [Serf.Flag] -> RAcquire e Serf -runSerf vSlog pax fax = do +runSerf vSlog pax = do env <- ask Serf.withSerf (config env) where slog txt = atomically (readTVar vSlog) >>= (\f -> f txt) config env = Serf.Config - { scSerf = "urbit-worker" -- TODO Find the executable in some proper way. + { scSerf = env ^. pierConfigL . pcSerfExe . to unpack , scPier = pax - , scFlag = fax + , scFlag = env ^. pierConfigL . pcSerfFlags , scSlog = \(pri, tank) -> printTank slog pri tank , scStdr = \txt -> slog (txt <> "\r\n") , scDead = pure () -- TODO: What can be done? @@ -143,13 +142,12 @@ booted :: TVar (Text -> IO ()) -> Pill -> Bool - -> [Serf.Flag] -> Ship -> LegacyBootEvent -> RAcquire PierEnv (Serf, EventLog) -booted vSlog pill lite flags ship boot = do - rio $ bootNewShip pill lite flags ship boot - resumed vSlog Nothing flags +booted vSlog pill lite ship boot = do + rio $ bootNewShip pill lite ship boot + resumed vSlog Nothing bootSeqJobs :: Time.Wen -> BootSeq -> [Job] bootSeqJobs now (BootSeq ident nocks ovums) = zipWith ($) bootSeqFns [1 ..] @@ -167,11 +165,10 @@ bootNewShip :: HasPierEnv e => Pill -> Bool - -> [Serf.Flag] -> Ship -> LegacyBootEvent -> RIO e () -bootNewShip pill lite flags ship bootEv = do +bootNewShip pill lite ship bootEv = do seq@(BootSeq ident x y) <- genBootSeq ship pill lite bootEv logDebug "BootSeq Computed" @@ -195,9 +192,8 @@ bootNewShip pill lite flags ship bootEv = do resumed :: TVar (Text -> IO ()) -> Maybe Word64 - -> [Serf.Flag] -> RAcquire PierEnv (Serf, EventLog) -resumed vSlog replayUntil flags = do +resumed vSlog replayUntil = do rio $ logTrace "Resuming ship" top <- view pierPathL tap <- fmap (fromMaybe top) $ rio $ runMaybeT $ do @@ -209,7 +205,7 @@ resumed vSlog replayUntil flags = do logTrace $ display @Text ("running serf in: " <> pack tap) log <- Log.existing (top ".urb/log") - serf <- runSerf vSlog tap flags + serf <- runSerf vSlog tap rio $ do logDebug "Replaying events" diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index bc811a90b..2b73b2b8e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -18,7 +18,7 @@ import Urbit.Vere.Serf.IPC import Control.Monad.Trans.Resource (runResourceT) import Urbit.Arvo (FX) -import Urbit.King.App (HasStderrLogFunc(..)) +import Urbit.King.App.Class (HasStderrLogFunc(..)) import qualified Data.Conduit.Combinators as CC import qualified System.ProgressBar as PB From 7af96ab458e8e5541a50526ae0713dd8d57dbee4 Mon Sep 17 00:00:00 2001 From: Benjamin Summers Date: Wed, 10 Jun 2020 17:28:47 -0700 Subject: [PATCH 138/257] Use nix-2.3.6 in CI. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index c6dcc83c7..a58ba1a86 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,7 +2,7 @@ jobs: include: - os: linux language: nix - nix: 2.1.3 + nix: 2.3.6 env: STACK_YAML=pkg/hs/stack.yaml before_install: - git lfs pull From 2b3fb7a5685207189c9ba37237b009c633435e2e Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 11 Jun 2020 00:31:59 +0000 Subject: [PATCH 139/257] king: fix behn tests. --- pkg/hs/urbit-king/test/BehnTests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/hs/urbit-king/test/BehnTests.hs b/pkg/hs/urbit-king/test/BehnTests.hs index 9ef803b29..d8b18cb94 100644 --- a/pkg/hs/urbit-king/test/BehnTests.hs +++ b/pkg/hs/urbit-king/test/BehnTests.hs @@ -37,7 +37,7 @@ timerFires = forAll arbitrary (ioProperty . runKingEnvNoLog . runTest) envr <- ask king <- fromIntegral <$> view kingIdL q <- newTQueueIO - rwith (liftAcquire $ snd $ behn envr (writeTQueue q)) $ \cb -> do + rwith (liftAcquire $ behn envr (writeTQueue q)) $ \cb -> do io $ cb (BehnEfDoze (king, ()) (Just (2^20))) t <- atomically $ readTQueue q pure True From 849d25044acb58ae273b9bd383cc03eedbad9c6d Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 11 Jun 2020 00:32:15 +0000 Subject: [PATCH 140/257] king: disable "bullshit scry tester" --- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 8303558fe..568f03d8c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -362,16 +362,17 @@ pier (serf, log) vSlog startedSig multi = do void $ atomically $ tryPutTMVar saveSig () -- TODO bullshit scry tester - void $ acquireWorker "bullshit scry tester" $ do - env <- ask - forever $ do - threadDelay 15_000_000 - wen <- io Time.now - let kal = \mTermNoun -> runRIO env $ do - logDebug $ displayShow ("scry result: ", mTermNoun) - let nkt = MkKnot $ tshow $ Time.MkDate wen - let pax = Path ["j", "~zod", "life", nkt, "~zod"] - atomically $ putTMVar scrySig (wen, Nothing, pax, kal) + when False $ do + void $ acquireWorker "bullshit scry tester" $ do + env <- ask + forever $ do + threadDelay 15_000_000 + wen <- io Time.now + let kal = \mTermNoun -> runRIO env $ do + logDebug $ displayShow ("scry result: ", mTermNoun) + let nkt = MkKnot $ tshow $ Time.MkDate wen + let pax = Path ["j", "~zod", "life", nkt, "~zod"] + atomically $ putTMVar scrySig (wen, Nothing, pax, kal) putMVar startedSig () From f85355747258f8e5d4b9fc1fb6c90d517b43be00 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 11 Jun 2020 01:00:26 +0000 Subject: [PATCH 141/257] travis: Cache test results in cachix. --- nix/cachix/tests.nix | 4 ++++ sh/cachix | 1 + 2 files changed, 5 insertions(+) create mode 100644 nix/cachix/tests.nix diff --git a/nix/cachix/tests.nix b/nix/cachix/tests.nix new file mode 100644 index 000000000..430afdff2 --- /dev/null +++ b/nix/cachix/tests.nix @@ -0,0 +1,4 @@ +let + ops = import ../ops/default.nix {}; +in + { urbit-test-results = ops.test; } diff --git a/sh/cachix b/sh/cachix index a824ade41..6f205a4e9 100755 --- a/sh/cachix +++ b/sh/cachix @@ -31,6 +31,7 @@ nix-build --no-out-link \ --max-jobs 2 \ nix/cachix/local.nix \ nix/cachix/release.nix \ + nix/cachix/tests.nix \ > .cache.list cachix push urbit2 < .cache.list From 674c794bab026295cce73445f5ba818f35964775 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 11 Jun 2020 01:20:01 +0000 Subject: [PATCH 142/257] Updated solid pill --- bin/solid.pill | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/solid.pill b/bin/solid.pill index 95a51662b..637797052 100644 --- a/bin/solid.pill +++ b/bin/solid.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:f39f6f1c7de1bca5710731ca11664771280a54b72c61192a1416c9ea23b25e16 -size 13036410 +oid sha256:f1e0bc496d0aa3dc1c3ad1a9370dfd6684c59ffd164b5816cc24a97717f53178 +size 13709019 From eb81f5ca148e2aba3b5bc3aa1bb5a805a534546b Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 11 Jun 2020 02:02:09 +0000 Subject: [PATCH 143/257] Less verbose log output. --- pkg/hs/urbit-king/TODO.md | 5 ++ pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs | 7 ++ pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs | 7 ++ pkg/hs/urbit-king/lib/Urbit/King/App.hs | 14 ++-- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 72 ++++++++++--------- pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs | 26 +++---- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs | 14 ++-- .../urbit-king/lib/Urbit/Vere/Eyre/Multi.hs | 6 +- pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs | 30 ++++---- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 10 ++- pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs | 10 +-- 11 files changed, 113 insertions(+), 88 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index c295a6403..a5e8429dd 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -97,6 +97,11 @@ Implement Pier-wide process start events 2. Make the serf IPC code not care about the shape of events and effects. 3. Support invalid events throughout the system (use `Lenient`?) +# Polish + +- [x] Goot logging output in non-verbose mode. +- [ ] Command-Line flag to re-enable verbose output. + # Cleanup diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs index 0cb22a231..606539907 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs @@ -186,3 +186,10 @@ instance FromNoun Ef where ReOrg "" s "vega" p _ -> fail "%vega effect expects nil value" ReOrg "" s tag p val -> EfVane <$> parseNoun (toNoun (s, tag, p, val)) ReOrg _ _ _ _ _ -> fail "Non-empty first path-element" + +summarizeEffect :: Lenient Ef -> Text +summarizeEffect ef = + fromNoun (toNoun ef) & \case + Nothing -> "//invalid %effect" + Just (pax :: [Cord], tag :: Cord, val :: Noun) -> + "/" <> intercalate "/" (unCord <$> pax) <> " %" <> unCord tag diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs index ed4fbe0c7..39df141e1 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Event.hs @@ -382,3 +382,10 @@ getSpinnerNameForEvent = \case where isRet (TermEvBelt _ (Ret ())) = True isRet _ = False + +summarizeEvent :: Ev -> Text +summarizeEvent ev = + fromNoun (toNoun ev) & \case + Nothing -> "//invalid %event" + Just (pax :: [Cord], tag :: Cord, val :: Noun) -> + "/" <> intercalate "/" (unCord <$> pax) <> " %" <> unCord tag diff --git a/pkg/hs/urbit-king/lib/Urbit/King/App.hs b/pkg/hs/urbit-king/lib/Urbit/King/App.hs index 263a596a5..bd8b6b1a5 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs @@ -73,19 +73,19 @@ instance HasKingId KingEnv where -- Running KingEnvs ------------------------------------------------------------ -runKingEnvStderr :: RIO KingEnv a -> IO a -runKingEnvStderr inner = do +runKingEnvStderr :: Bool -> RIO KingEnv a -> IO a +runKingEnvStderr verb inner = do logOptions <- - logOptionsHandle stderr True <&> setLogUseTime True <&> setLogUseLoc False + logOptionsHandle stderr verb <&> setLogUseTime True <&> setLogUseLoc False withLogFunc logOptions $ \logFunc -> runKingEnv logFunc logFunc inner -runKingEnvLogFile :: RIO KingEnv a -> IO a -runKingEnvLogFile inner = withLogFileHandle $ \h -> do +runKingEnvLogFile :: Bool -> RIO KingEnv a -> IO a +runKingEnvLogFile verb inner = withLogFileHandle $ \h -> do logOptions <- - logOptionsHandle h True <&> setLogUseTime True <&> setLogUseLoc False + logOptionsHandle h verb <&> setLogUseTime True <&> setLogUseLoc False stderrLogOptions <- - logOptionsHandle stderr True <&> setLogUseTime False <&> setLogUseLoc False + logOptionsHandle stderr verb <&> setLogUseTime False <&> setLogUseLoc False withLogFunc stderrLogOptions $ \stderrLogFunc -> withLogFunc logOptions $ \logFunc -> runKingEnv logFunc stderrLogFunc inner diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index b6043c5f8..c64a09a1c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -193,9 +193,9 @@ tryBootFromPill oExit pill lite ship boot multi = do where bootedPier vSlog = do view pierPathL >>= lockFile - rio $ logTrace "Starting boot" + rio $ logDebug "Starting boot" sls <- Pier.booted vSlog pill lite ship boot - rio $ logTrace "Completed boot" + rio $ logDebug "Completed boot" pure sls runOrExitImmediately @@ -210,9 +210,9 @@ runOrExitImmediately vSlog getPier oExit mStart multi = do where shutdownImmediately :: (Serf, Log.EventLog) -> RIO PierEnv () shutdownImmediately (serf, log) = do - logTrace "Sending shutdown signal" + logDebug "Sending shutdown signal" Serf.stop serf - logTrace "Shutdown!" + logDebug "Shutdown!" runPier :: (Serf, Log.EventLog) -> RIO PierEnv () runPier serfLog = do @@ -232,7 +232,7 @@ tryPlayShip exitImmediately fullReplay playFrom mStart multi = do where wipeSnapshot = do shipPath <- view pierPathL - logTrace "wipeSnapshot" + logDebug "wipeSnapshot" logDebug $ display $ pack @Text ("Wiping " <> north shipPath) logDebug $ display $ pack @Text ("Wiping " <> south shipPath) removeFileIfExists (north shipPath) @@ -244,9 +244,9 @@ tryPlayShip exitImmediately fullReplay playFrom mStart multi = do resumeShip :: TVar (Text -> IO ()) -> RAcquire PierEnv (Serf, Log.EventLog) resumeShip vSlog = do view pierPathL >>= lockFile - rio $ logTrace "RESUMING SHIP" + rio $ logDebug "RESUMING SHIP" sls <- Pier.resumed vSlog playFrom - rio $ logTrace "SHIP RESUMED" + rio $ logDebug "SHIP RESUMED" pure sls runRAcquire :: (MonadUnliftIO (m e), MonadIO (m e), MonadReader e (m e)) @@ -261,7 +261,7 @@ checkEvs pierPath first last = do rwith (Log.existing logPath) $ \log -> do let ident = Log.identity log let pbSty = PB.defStyle { PB.stylePostfix = PB.exact } - logTrace (displayShow ident) + logDebug (displayShow ident) last <- atomically $ Log.lastEv log <&> \lastReal -> min last lastReal @@ -286,7 +286,7 @@ checkEvs pierPath first last = do showEvents pb eId cycle = await >>= \case Nothing -> do lift $ PB.killProgressBar pb - lift $ logTrace "Everything checks out." + lift $ logDebug "Everything checks out." Just bs -> do lift $ PB.incProgress pb 1 lift $ do @@ -315,10 +315,10 @@ collectAllFx = error "TODO" -} collectAllFx :: FilePath -> RIO KingEnv () collectAllFx top = do - logTrace $ display $ pack @Text top + logDebug $ display $ pack @Text top vSlog <- logSlogs rwith (collectedFX vSlog) $ \() -> - logTrace "Done collecting effects!" + logDebug "Done collecting effects!" where tmpDir :: FilePath tmpDir = top ".tmpdir" @@ -339,10 +339,10 @@ collectAllFx top = do replayPartEvs :: FilePath -> Word64 -> RIO KingEnv () replayPartEvs top last = do - logTrace $ display $ pack @Text top + logDebug $ display $ pack @Text top fetchSnapshot rwith replayedEvs $ \() -> - logTrace "Done replaying events!" + logDebug "Done replaying events!" where fetchSnapshot :: RIO KingEnv () fetchSnapshot = do @@ -385,57 +385,57 @@ replayPartEvs top last = do -} testPill :: HasLogFunc e => FilePath -> Bool -> Bool -> RIO e () testPill pax showPil showSeq = do - logTrace "Reading pill file." + logDebug "Reading pill file." pillBytes <- readFile pax - logTrace "Cueing pill file." + logDebug "Cueing pill file." pillNoun <- io $ cueBS pillBytes & either throwIO pure - logTrace "Parsing pill file." + logDebug "Parsing pill file." pill <- fromNounErr pillNoun & either (throwIO . uncurry ParseErr) pure - logTrace "Using pill to generate boot sequence." + logDebug "Using pill to generate boot sequence." bootSeq <- genBootSeq (Ship 0) pill False (Fake (Ship 0)) - logTrace "Validate jam/cue and toNoun/fromNoun on pill value" + logDebug "Validate jam/cue and toNoun/fromNoun on pill value" reJam <- validateNounVal pill - logTrace "Checking if round-trip matches input file:" + logDebug "Checking if round-trip matches input file:" unless (reJam == pillBytes) $ do - logTrace " Our jam does not match the file...\n" - logTrace " This is surprising, but it is probably okay." + logDebug " Our jam does not match the file...\n" + logDebug " This is surprising, but it is probably okay." when showPil $ do - logTrace "\n\n== Pill ==\n" + logDebug "\n\n== Pill ==\n" io $ pPrint pill when showSeq $ do - logTrace "\n\n== Boot Sequence ==\n" + logDebug "\n\n== Boot Sequence ==\n" io $ pPrint bootSeq validateNounVal :: (HasLogFunc e, Eq a, ToNoun a, FromNoun a) => a -> RIO e ByteString validateNounVal inpVal = do - logTrace " jam" + logDebug " jam" inpByt <- evaluate $ jamBS $ toNoun inpVal - logTrace " cue" + logDebug " cue" outNon <- cueBS inpByt & either throwIO pure - logTrace " fromNoun" + logDebug " fromNoun" outVal <- fromNounErr outNon & either (throwIO . uncurry ParseErr) pure - logTrace " toNoun" + logDebug " toNoun" outNon <- evaluate (toNoun outVal) - logTrace " jam" + logDebug " jam" outByt <- evaluate $ jamBS outNon - logTrace "Checking if: x == cue (jam x)" + logDebug "Checking if: x == cue (jam x)" unless (inpVal == outVal) $ error "Value fails test: x == cue (jam x)" - logTrace "Checking if: jam x == jam (cue (jam x))" + logDebug "Checking if: jam x == jam (cue (jam x))" unless (inpByt == outByt) $ error "Value fails test: jam x == jam (cue (jam x))" @@ -447,11 +447,11 @@ validateNounVal inpVal = do pillFrom :: CLI.PillSource -> RIO KingEnv Pill pillFrom = \case CLI.PillSourceFile pillPath -> do - logTrace $ display $ "boot: reading pill from " ++ (pack pillPath :: Text) + logDebug $ display $ "boot: reading pill from " ++ (pack pillPath :: Text) io (loadFile pillPath >>= either throwIO pure) CLI.PillSourceURL url -> do - logTrace $ display $ "boot: retrieving pill from " ++ (pack url :: Text) + logDebug $ display $ "boot: retrieving pill from " ++ (pack url :: Text) -- Get the jamfile with the list of stars accepting comets right now. manager <- io $ C.newManager tlsManagerSettings request <- io $ C.parseRequest url @@ -640,8 +640,10 @@ main = do CLI.CmdCon pier -> connTerm pier where - runKingEnv args | willRunTerminal args = runKingEnvLogFile - runKingEnv args | otherwise = runKingEnvStderr + verboseLogging = False + + runKingEnv args | willRunTerminal args = runKingEnvLogFile verboseLogging + runKingEnv args | otherwise = runKingEnvStderr verboseLogging setupSignalHandlers = do mainTid <- myThreadId @@ -691,7 +693,7 @@ runShipRestarting r o multi = do logTrace $ display (pier <> " shutdown requested") race_ (wait tid) $ do threadDelay 5_000_000 - logTrace $ display (pier <> " not down after 5s, killing with fire.") + logDebug $ display (pier <> " not down after 5s, killing with fire.") cancel tid logTrace $ display ("Ship terminated: " <> pier) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs index a1ae17ca0..47a9b24fb 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs @@ -79,14 +79,14 @@ forceBind :: HasLogFunc e => PortNumber -> HostAddress -> RIO e Socket forceBind por hos = go where go = do - logTrace (display ("AMES: UDP: Opening socket on port " <> tshow por)) + logDebug (display ("AMES: UDP: Opening socket on port " <> tshow por)) io (doBind por hos) >>= \case Right sk -> do - logTrace (display ("AMES: UDP: Opened socket on port " <> tshow por)) + logDebug (display ("AMES: UDP: Opened socket on port " <> tshow por)) pure sk Left err -> do - logTrace (display ("AMES: UDP: " <> tshow err)) - logTrace ("AMES: UDP: Failed to open UDP socket. Waiting") + logDebug (display ("AMES: UDP: " <> tshow err)) + logDebug ("AMES: UDP: Failed to open UDP socket. Waiting") threadDelay 250_000 go @@ -97,14 +97,14 @@ forceBind por hos = go -} sendPacket :: HasLogFunc e => ByteString -> SockAddr -> Socket -> RIO e Bool sendPacket fullBytes adr sok = do - logTrace $ displayShow ("AMES", "UDP", "Sending packet.") + logDebug $ displayShow ("AMES", "UDP", "Sending packet.") res <- io $ tryIOError $ go fullBytes case res of Left err -> do logError $ displayShow ("AMES", "UDP", "Failed to send packet", err) pure False Right () -> do - logTrace $ displayShow ("AMES", "UDP", "Packet sent.") + logDebug $ displayShow ("AMES", "UDP", "Packet sent.") pure True where go byt = do @@ -137,7 +137,7 @@ recvPacket sok = do -} fakeUdpServ :: HasLogFunc e => RIO e UdpServ fakeUdpServ = do - logTrace $ displayShow ("AMES", "UDP", "\"Starting\" fake UDP server.") + logDebug $ displayShow ("AMES", "UDP", "\"Starting\" fake UDP server.") pure UdpServ { .. } where usSend = \_ _ -> pure () @@ -153,7 +153,7 @@ fakeUdpServ = do realUdpServ :: forall e . HasLogFunc e => PortNumber -> HostAddress -> RIO e UdpServ realUdpServ por hos = do - logTrace $ displayShow ("AMES", "UDP", "Starting real UDP server.") + logDebug $ displayShow ("AMES", "UDP", "Starting real UDP server.") env <- ask @@ -173,7 +173,7 @@ realUdpServ por hos = do -} let signalBrokenSocket :: Socket -> RIO e () signalBrokenSocket sock = do - logTrace $ displayShow ("AMES", "UDP" + logDebug $ displayShow ("AMES", "UDP" , "Socket broken. Requesting new socket" ) atomically $ do @@ -200,7 +200,7 @@ realUdpServ por hos = do sk <- forceBind por hos atomically (writeTVar vSock (Just sk)) broken <- atomically (takeTMVar vFail) - logTrace "AMES: UDP: Closing broken socket." + logWarn "AMES: UDP: Closing broken socket." io (close broken) tSend <- async $ forever $ join $ atomically $ do @@ -223,15 +223,15 @@ realUdpServ por hos = do logError "AMES: UDP: Dropping non-ipv4 packet" pure () Right (Just (b, p, a)) -> do - logTrace "AMES: UDP: Received packet." + logDebug "AMES: UDP: Received packet." enqueueRecvPacket p a b let shutdown = do - logTrace "AMES: UDP: Shutting down. (killing threads)" + logDebug "AMES: UDP: Shutting down. (killing threads)" cancel tOpen cancel tSend cancel tRecv - logTrace "AMES: UDP: Shutting down. (closing socket)" + logDebug "AMES: UDP: Shutting down. (closing socket)" io $ join $ atomically $ do res <- readTVar vSock <&> maybe (pure ()) close writeTVar vSock Nothing diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs index 4f69a4888..2aeb33f63 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -165,7 +165,7 @@ execRespActs :: HasLogFunc e => Drv -> Ship -> Word64 -> HttpEvent -> RIO e () execRespActs (Drv v) who reqId ev = readMVar v >>= \case Nothing -> logError "Got a response to a request that does not exist." Just sv -> do - logTrace $ displayShow ev + logDebug $ displayShow ev for_ (parseHttpEvent ev) $ \act -> do atomically (routeRespAct who (sLiveReqs sv) reqId act) @@ -178,7 +178,7 @@ startServ -> (EvErr -> STM ()) -> RIO e Serv startServ multi who isFake conf plan = do - logTrace (displayShow ("EYRE", "startServ")) + logDebug (displayShow ("EYRE", "startServ")) let vLive = meaLive multi @@ -219,11 +219,11 @@ startServ multi who isFake conf plan = do let onKilReq :: Ship -> Word64 -> STM () onKilReq _ship = plan . cancelEv srvId . fromIntegral - logTrace (displayShow ("EYRE", "joinMultiEyre", who, mTls, mCre)) + logDebug (displayShow ("EYRE", "joinMultiEyre", who, mTls, mCre)) atomically (joinMultiEyre multi who mCre onReq onKilReq) - logTrace $ displayShow ("EYRE", "Starting loopback server") + logDebug $ displayShow ("EYRE", "Starting loopback server") lop <- serv vLive $ ServConf { scHost = soHost (pttLop ptt) , scPort = soWhich (pttLop ptt) @@ -235,7 +235,7 @@ startServ multi who isFake conf plan = do } } - logTrace $ displayShow ("EYRE", "Starting insecure server") + logDebug $ displayShow ("EYRE", "Starting insecure server") ins <- serv vLive $ ServConf { scHost = soHost (pttIns ptt) , scPort = soWhich (pttIns ptt) @@ -248,7 +248,7 @@ startServ multi who isFake conf plan = do } mSec <- for mTls $ \tls -> do - logTrace "Starting secure server" + logDebug "Starting secure server" serv vLive $ ServConf { scHost = soHost (pttSec ptt) , scPort = soWhich (pttSec ptt) @@ -269,7 +269,7 @@ startServ multi who isFake conf plan = do let por = Ports secPor insPor lopPor fil = pierPath <> "/.http.ports" - logTrace $ displayShow ("EYRE", "All Servers Started.", srvId, por, fil) + logDebug $ displayShow ("EYRE", "All Servers Started.", srvId, por, fil) pure (Serv srvId conf lop ins mSec por fil vLive) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs index 30b0298b8..706afb8f3 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -72,7 +72,7 @@ leaveMultiEyre MultiEyreApi {..} who = do multiEyre :: HasLogFunc e => MultiEyreConf -> RIO e MultiEyreApi multiEyre conf@MultiEyreConf {..} = do - logTrace (displayShow ("EYRE", "MULTI", conf)) + logDebug (displayShow ("EYRE", "MULTI", conf)) vLive <- io emptyLiveReqs >>= newTVarIO vPlan <- newTVarIO mempty @@ -96,7 +96,7 @@ multiEyre conf@MultiEyreConf {..} = do Just cb -> cb who reqId mIns <- for mecHttpPort $ \por -> do - logTrace (displayShow ("EYRE", "MULTI", "HTTP", por)) + logDebug (displayShow ("EYRE", "MULTI", "HTTP", por)) serv vLive $ ServConf { scHost = host , scPort = SPChoices $ singleton $ fromIntegral por @@ -109,7 +109,7 @@ multiEyre conf@MultiEyreConf {..} = do } mSec <- for mecHttpsPort $ \por -> do - logTrace (displayShow ("EYRE", "MULTI", "HTTPS", por)) + logDebug (displayShow ("EYRE", "MULTI", "HTTPS", por)) serv vLive $ ServConf { scHost = host , scPort = SPChoices $ singleton $ fromIntegral por diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs index a105befae..e007d6331 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -150,7 +150,7 @@ retry :: HasLogFunc e => RIO e (Either IOError a) -> RIO e a retry act = act >>= \case Right res -> pure res Left exn -> do - logTr ctx ("Failed to open ports. Waiting 5s, then trying again.", exn) + logDbg ctx ("Failed to open ports. Waiting 5s, then trying again.", exn) threadDelay 5_000_000 retry act where @@ -164,7 +164,7 @@ tryOpenChoices tryOpenChoices hos = go where go (p :| ps) = do - logTrace (displayShow ("EYRE", "Trying to open port.", p)) + logDebug (displayShow ("EYRE", "Trying to open port.", p)) io (tryOpen hos p) >>= \case Left err -> do logError (displayShow ("EYRE", "Failed to open port.", p)) @@ -178,14 +178,14 @@ tryOpenAny :: HasLogFunc e => String -> RIO e (Either IOError (W.Port, Net.Socket)) tryOpenAny hos = do let ctx = ["EYRE", "SERV", "tryOpenAny"] - logTr ctx "Asking the OS for any free port." + logDbg ctx "Asking the OS for any free port." io (openFreePort hos) >>= \case Left exn -> pure (Left exn) Right (p, s) -> do pure (Right (p, s)) -logTr :: (HasLogFunc e, Show a) => [Text] -> a -> RIO e () -logTr ctx msg = logTrace (prefix <> suffix) +logDbg :: (HasLogFunc e, Show a) => [Text] -> a -> RIO e () +logDbg ctx msg = logDebug (prefix <> suffix) where prefix = display (concat $ fmap (<> ": ") ctx) suffix = displayShow msg @@ -202,11 +202,11 @@ forceOpenSocket hos por = mkRAcquire opn kil opn = do let ctx = ["EYRE", "SERV", "forceOpenSocket"] - logTr ctx (hos, por) + logDbg ctx (hos, por) (p, s) <- retry $ case por of SPAnyPort -> tryOpenAny bind SPChoices ps -> tryOpenChoices bind ps - logTr ctx ("Opened port.", p) + logDbg ctx ("Opened port.", p) pure (p, s) bind = case hos of @@ -230,11 +230,11 @@ onSniHdr :: HasLogFunc e => e -> MultiTlsConfig -> Maybe String -> IO Credentials onSniHdr env (MTC mtls) mHos = do tabl <- atomically (readTVar mtls) - runRIO env $ logTr ctx (tabl, mHos) + runRIO env $ logDbg ctx (tabl, mHos) ship <- hostShip (encodeUtf8 . pack <$> mHos) - runRIO env $ logTr ctx ship + runRIO env $ logDbg ctx ship tcfg <- lookup ship tabl & maybe (notRunning ship) (pure . snd) - runRIO env $ logTr ctx tcfg + runRIO env $ logDbg ctx tcfg pure (Credentials [tcfg]) where notRunning ship = error ("Ship not running: ~" <> show ship) @@ -293,9 +293,9 @@ startServer typ hos por sok red vLive = do let app = \req resp -> do - runRIO envir $ logTr ctx "Got request" + runRIO envir $ logDbg ctx "Got request" who <- reqShip req - runRIO envir $ logTr ctx ("Parsed HOST", who) + runRIO envir $ logDbg ctx ("Parsed HOST", who) runAppl who (rcReq api who) (rcKil api who) req resp io (W.runTLSSocket tlsMany opts sok app) @@ -312,7 +312,7 @@ configCreds TlsConfig {..} = fakeServ :: HasLogFunc e => ServConf -> RIO e ServApi fakeServ conf = do let por = fakePort (scPort conf) - logTrace (displayShow ("EYRE", "SERV", "Running Fake Server", por)) + logDebug (displayShow ("EYRE", "SERV", "Running Fake Server", por)) pure $ ServApi { saKil = pure () , saPor = pure por @@ -331,7 +331,7 @@ getFirstTlsConfig (MTC var) = do realServ :: HasLogFunc e => TVar E.LiveReqs -> ServConf -> RIO e ServApi realServ vLive conf@ServConf {..} = do - logTrace (displayShow ("EYRE", "SERV", "Running Real Server")) + logDebug (displayShow ("EYRE", "SERV", "Running Real Server")) kil <- newEmptyTMVarIO por <- newEmptyTMVarIO @@ -344,7 +344,7 @@ realServ vLive conf@ServConf {..} = do } where runServ vPort = do - logTrace (displayShow ("EYRE", "SERV", "runServ")) + logDebug (displayShow ("EYRE", "SERV", "runServ")) rwith (forceOpenSocket scHost scPort) $ \(por, sok) -> do atomically (putTMVar vPort por) startServer scType scHost por sok scRedi vLive diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 568f03d8c..4d075875d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -343,7 +343,7 @@ pier (serf, log) vSlog startedSig multi = do RunSwap _ _ _ _ _ -> putMVar okaySig () RunBail _ -> inject (n + 1) - logTrace ("Boot Event" <> displayShow ev) + -- logTrace ("[BOOT EVENT]: " <> display (summarizeEvent ev)) io (inject 0) let slog :: Text -> IO () @@ -493,13 +493,17 @@ router slog waitFx Drivers {..} = do -- Compute (Serf) Thread ------------------------------------------------------- logEvent :: HasLogFunc e => Ev -> RIO e () -logEvent ev = logDebug $ display $ "[EVENT]\n" <> pretty +logEvent ev = do + logTrace $ "<- " <> display (summarizeEvent ev) + logDebug $ "[EVENT]\n" <> display pretty where pretty :: Text pretty = pack $ unlines $ fmap ("\t" <>) $ lines $ ppShow ev logEffect :: HasLogFunc e => Lenient Ef -> RIO e () -logEffect ef = logDebug $ display $ "[EFFECT]\n" <> pretty ef +logEffect ef = do + logTrace $ " -> " <> display (summarizeEffect ef) + logDebug $ display $ "[EFFECT]\n" <> pretty ef where pretty :: Lenient Ef -> Text pretty = \case diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs index 2b73b2b8e..e03512883 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -40,7 +40,7 @@ withSerf config = mkRAcquire startup kill where startup = do (serf, st) <- io $ start config - logTrace (displayShow st) + logDebug (displayShow ("serf state", st)) pure serf kill serf = do void $ rio $ stop serf @@ -58,7 +58,7 @@ execReplay serf log last = do where doBoot :: RIO e (Either PlayBail Word) doBoot = do - logTrace "Beginning boot sequence" + logDebug "Beginning boot sequence" let bootSeqLen = lifecycleLen (Log.identity log) @@ -72,14 +72,14 @@ execReplay serf log last = do when (numEvs /= bootSeqLen) $ do throwIO (MissingBootEventsInEventLog numEvs bootSeqLen) - logTrace $ display ("Sending " <> tshow numEvs <> " boot events to serf") + logDebug $ display ("Sending " <> tshow numEvs <> " boot events to serf") io (boot serf evs) >>= \case Just err -> do - logTrace "Error on replay, exiting" + logDebug "Error on replay, exiting" pure (Left err) Nothing -> do - logTrace "Finished boot events, moving on to more events from log." + logDebug "Finished boot events, moving on to more events from log." doReplay <&> \case Left err -> Left err Right num -> Right (num + numEvs) From 2f02a6d0e61cdd507df2cfa73cab9a7c0dd653ca Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 11 Jun 2020 02:07:10 +0000 Subject: [PATCH 144/257] king: Command line flag to enable verbose logging. --- pkg/hs/urbit-king/TODO.md | 2 +- pkg/hs/urbit-king/lib/Urbit/King/Main.hs | 14 ++++++++++---- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index a5e8429dd..f1a292b85 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -100,7 +100,7 @@ Implement Pier-wide process start events # Polish - [x] Goot logging output in non-verbose mode. -- [ ] Command-Line flag to re-enable verbose output. +- [x] Command-Line flag to re-enable verbose output. # Cleanup diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index c64a09a1c..2fb280d2d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -640,10 +640,11 @@ main = do CLI.CmdCon pier -> connTerm pier where - verboseLogging = False - - runKingEnv args | willRunTerminal args = runKingEnvLogFile verboseLogging - runKingEnv args | otherwise = runKingEnvStderr verboseLogging + runKingEnv args = + let verb = verboseLogging args + in if willRunTerminal args + then runKingEnvLogFile verb + else runKingEnvStderr verb setupSignalHandlers = do mainTid <- myThreadId @@ -651,6 +652,11 @@ main = do for_ [Sys.sigTERM, Sys.sigINT] $ \sig -> do Sys.installHandler sig (Sys.Catch onKillSig) Nothing + verboseLogging :: CLI.Cmd -> Bool + verboseLogging = \case + CLI.CmdRun ko ships -> any CLI.oVerbose (ships <&> \(_, o, _) -> o) + _ -> False + willRunTerminal :: CLI.Cmd -> Bool willRunTerminal = \case CLI.CmdCon _ -> True From 382ace5f23a70718ae0e7d1939c2e86779172ee6 Mon Sep 17 00:00:00 2001 From: ~siprel Date: Thu, 11 Jun 2020 20:34:47 +0000 Subject: [PATCH 145/257] travis: Various fixes and improvements. 1. Fix bug in test builds that was causing failures for some reason I still don't understand. `tee` output to stderr was failing with "resource temporarily unavailable". The hack that fixed it was to simply write the herb output to a file and dump it to stdout after it fully completes. 2. sh/cachix works without CACHIX keys. Simply doesn't upload in that case. 3. Write code to cache testbus builds (disabled for now) 4. fakeship builds get further in bootstrap sequence before committing. This fixes problems with PRs from forked repos and enables the scripts to be run locally. --- nix/cachix/tests.nix | 5 ++++- nix/ops/default.nix | 8 ++++---- nix/ops/fakeship/builder.sh | 2 +- nix/ops/test/builder.sh | 5 +++-- sh/cachix | 36 +++++++++++++++++++++++++----------- 5 files changed, 37 insertions(+), 19 deletions(-) diff --git a/nix/cachix/tests.nix b/nix/cachix/tests.nix index 430afdff2..2248a5cea 100644 --- a/nix/cachix/tests.nix +++ b/nix/cachix/tests.nix @@ -1,4 +1,7 @@ let ops = import ../ops/default.nix {}; in - { urbit-test-results = ops.test; } + { + results = ops.test; + fakebus = ops.bus; + } diff --git a/nix/ops/default.nix b/nix/ops/default.nix index 64f8c67a7..d048d783e 100644 --- a/nix/ops/default.nix +++ b/nix/ops/default.nix @@ -31,16 +31,16 @@ let ship = "zod"; }; +in + +rec { + bus = import ./fakeship { inherit pkgs herb urbit arvo; pill = bootsolid; ship = "bus"; }; -in - -rec { - test = import ./test { inherit pkgs herb urbit; ship = bus; diff --git a/nix/ops/fakeship/builder.sh b/nix/ops/fakeship/builder.sh index 94736ad0f..19ef10b87 100755 --- a/nix/ops/fakeship/builder.sh +++ b/nix/ops/fakeship/builder.sh @@ -13,7 +13,7 @@ check () { [ 3 -eq "$(herb $out -d 3)" ] } -if check +if check && sleep 10 && check then echo "Boot success." >&2 herb $out -p hood -d '+hood/exit' || true diff --git a/nix/ops/test/builder.sh b/nix/ops/test/builder.sh index ae5948e6a..822854bc8 100644 --- a/nix/ops/test/builder.sh +++ b/nix/ops/test/builder.sh @@ -38,8 +38,9 @@ herb ./ship -p test -d ':- %renders /' herb ./ship -d '~& %finish-test-renders ~' # Run the test generator -herb ./ship -d '+test, =seed `@uvI`(shaz %reproducible)' | - tee test-generator-output +herb ./ship -d '+test, =seed `@uvI`(shaz %reproducible)' >test-generator-output + +cat test-generator-output || true herb ./ship -p hood -d '+hood/mass' diff --git a/sh/cachix b/sh/cachix index 6f205a4e9..15394f45f 100755 --- a/sh/cachix +++ b/sh/cachix @@ -8,12 +8,20 @@ fail () { fi } +cache=1 + if [ -z "$CACHIX_SIGNING_KEY" ] -then fail "The CACHIX_SIGNING_KEY environment variable needs to be set." +then + echo "The CACHIX_SIGNING_KEY environment variable needs to be set." + echo "Disabling cachix uploads" + cache=0 fi if [ -z "$CACHIX_AUTH_TOKEN" ] -then fail "The CACHIX_AUTH_TOKEN environment variable needs to be set." +then + echo "The CACHIX_AUTH_TOKEN environment variable needs to be set." + echo "Disabling cachix uploads" + cache=0 fi cleanup () { @@ -24,14 +32,20 @@ trap cleanup EXIT set -ex -cachix authtoken "$CACHIX_AUTH_TOKEN" >/dev/null -cachix use urbit2 +if [ $cache = 1 ] +then cachix authtoken "$CACHIX_AUTH_TOKEN" >/dev/null +fi -nix-build --no-out-link \ - --max-jobs 2 \ - nix/cachix/local.nix \ - nix/cachix/release.nix \ - nix/cachix/tests.nix \ - > .cache.list +cachix use urbit2 || true -cachix push urbit2 < .cache.list +build () { + nix-build --no-out-link --max-jobs 3 "$@" > .cache.list + if [ $cache = 1 ] + then cachix push urbit2 < .cache.list + fi +} + +time build nix/cachix/local.nix +#time build nix/cachix/tests.nix -A fakebus +time build nix/cachix/tests.nix -A results +time build nix/cachix/release.nix From e7ff4550db6886d80ecd524c67653657613c5ffe Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 5 Jun 2020 18:01:07 -0700 Subject: [PATCH 146/257] u3: fixes use of system malloc in u3i_chubs --- pkg/urbit/noun/imprison.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/pkg/urbit/noun/imprison.c b/pkg/urbit/noun/imprison.c index be9decee5..897145d84 100644 --- a/pkg/urbit/noun/imprison.c +++ b/pkg/urbit/noun/imprison.c @@ -56,7 +56,9 @@ u3_atom u3i_chubs(c3_w a_w, const c3_d* b_d) { - c3_w *b_w = c3_malloc(a_w * 8); + // XX efficiency + // + c3_w *b_w = u3a_malloc(a_w * 8); c3_w i_w; u3_atom p; @@ -65,7 +67,7 @@ u3i_chubs(c3_w a_w, b_w[(2 * i_w) + 1] = b_d[i_w] >> 32ULL; } p = u3i_words((a_w * 2), b_w); - c3_free(b_w); + u3a_free(b_w); return p; } From c78bc697589b5a46f0c1d6cf91afad3355b2ecf1 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 6 Jun 2020 00:29:01 -0700 Subject: [PATCH 147/257] u3: cleans up imprison.h/c --- pkg/urbit/include/noun/imprison.h | 78 +++----- pkg/urbit/noun/imprison.c | 299 ++++++++++++------------------ 2 files changed, 151 insertions(+), 226 deletions(-) diff --git a/pkg/urbit/include/noun/imprison.h b/pkg/urbit/include/noun/imprison.h index 363feb42e..c45ea87a2 100644 --- a/pkg/urbit/include/noun/imprison.h +++ b/pkg/urbit/include/noun/imprison.h @@ -1,60 +1,62 @@ -/* include/n/i.h +/* include/noun/imprison.h ** ** This file is in the public domain. */ /* General constructors. */ - /* u3i_words(): - ** - ** Copy [a] words from [b] into an atom. - */ - u3_noun - u3i_words(c3_w a_w, - const c3_w* b_w); - - /* u3i_bytes(): - ** - ** Copy `a` bytes from `b` to an LSB first atom. + /* u3i_bytes(): Copy [a] bytes from [b] to an LSB first atom. */ u3_noun u3i_bytes(c3_w a_w, const c3_y* b_y); - /* u3i_mp(): - ** - ** Copy the GMP integer `a` into an atom, and clear it. + /* u3i_words(): Copy [a] words from [b] into an atom. + */ + u3_noun + u3i_words(c3_w a_w, + const c3_w* b_w); + + /* u3i_chubs(): Copy [a] chubs from [b] into an atom. + */ + u3_atom + u3i_chubs(c3_w a_w, + const c3_d* b_d); + + /* u3i_mp(): Copy the GMP integer [a] into an atom, and clear it. */ u3_noun u3i_mp(mpz_t a_mp); - /* u3i_vint(): - ** - ** Create `a + 1`. + /* u3i_vint(): increment [a]. */ u3_noun u3i_vint(u3_noun a); - /* u3i_cell(): - ** - ** Produce the cell `[a b]`. + /* u3i_cell(): Produce the cell `[a b]`. */ u3_noun u3i_cell(u3_noun a, u3_noun b); - /* u3i_trel(): - ** - ** Produce the triple `[a b c]`. + /* u3i_trel(): Produce the triple `[a b c]`. */ u3_noun u3i_trel(u3_noun a, u3_noun b, u3_noun c); - /* u3i_qual(): - ** - ** Produce the cell `[a b c d]`. + /* u3i_qual(): Produce the cell `[a b c d]`. */ u3_noun u3i_qual(u3_noun a, u3_noun b, u3_noun c, u3_noun d); + /* u3i_string(): Produce an LSB-first atom from the C string [a]. + */ + u3_noun + u3i_string(const c3_c* a_c); + + /* u3i_tape(): from a C string, to a list of bytes. + */ + u3_atom + u3i_tape(const c3_c* txt_c); + /* u3i_edit(): ** ** Mutate `big` at axis `axe` with new value `som` @@ -63,13 +65,6 @@ u3_noun u3i_edit(u3_noun big, u3_noun axe, u3_noun som); - /* u3i_string(): - ** - ** Produce an LSB-first atom from the C string `a`. - */ - u3_noun - u3i_string(const c3_c* a_c); - /* u3i_molt(): ** ** Mutate `som` with a 0-terminated list of axis, noun pairs. @@ -77,18 +72,3 @@ */ u3_noun u3i_molt(u3_noun som, ...); - - /* u3i_chubs(): - ** - ** Construct `a` double-words from `b`, LSD first, as an atom. - */ - u3_atom - u3i_chubs(c3_w a_w, - const c3_d* b_d); - - /* u3i_tape(): from a C string, to a list of bytes. - */ - u3_atom - u3i_tape(const c3_c* txt_c); - - diff --git a/pkg/urbit/noun/imprison.c b/pkg/urbit/noun/imprison.c index 897145d84..4b01b1a94 100644 --- a/pkg/urbit/noun/imprison.c +++ b/pkg/urbit/noun/imprison.c @@ -1,92 +1,22 @@ -/* g/i.c +/* noun/imprison.c ** */ #include "all.h" -/* u3i_words(): -** -** Copy [a] words from [b] into an atom. -*/ -u3_noun -u3i_words(c3_w a_w, - const c3_w* b_w) -{ - /* Strip trailing zeroes. - */ - while ( a_w && !b_w[a_w - 1] ) { - a_w--; - } - - /* Check for cat. - */ - if ( !a_w ) { - return 0; - } - else if ( (a_w == 1) && !(b_w[0] >> 31) ) { - return b_w[0]; - } - - /* Allocate, fill, return. - */ - { - c3_w* nov_w = u3a_walloc(a_w + c3_wiseof(u3a_atom)); - u3a_atom* nov_u = (void*)nov_w; - - nov_u->mug_w = 0; - nov_u->len_w = a_w; - - /* Fill the words. - */ - { - c3_w i_w; - - for ( i_w=0; i_w < a_w; i_w++ ) { - nov_u->buf_w[i_w] = b_w[i_w]; - } - } - return u3a_to_pug(u3a_outa(nov_w)); - } -} - -/* u3i_chubs(): -** -** Construct `a` double-words from `b`, LSD first, as an atom. -*/ -u3_atom -u3i_chubs(c3_w a_w, - const c3_d* b_d) -{ - // XX efficiency - // - c3_w *b_w = u3a_malloc(a_w * 8); - c3_w i_w; - u3_atom p; - - for ( i_w = 0; i_w < a_w; i_w++ ) { - b_w[(2 * i_w)] = b_d[i_w] & 0xffffffffULL; - b_w[(2 * i_w) + 1] = b_d[i_w] >> 32ULL; - } - p = u3i_words((a_w * 2), b_w); - u3a_free(b_w); - return p; -} - -/* u3i_bytes(): -** -** Copy `a` bytes from `b` to an LSB first atom. +/* u3i_bytes(): Copy [a] bytes from [b] to an LSB first atom. */ u3_noun u3i_bytes(c3_w a_w, - const c3_y* b_y) + const c3_y* b_y) { - /* Strip trailing zeroes. - */ + // Strip trailing zeroes. + // while ( a_w && !b_y[a_w - 1] ) { a_w--; } - /* Check for cat. - */ + // Check for cat. + // if ( a_w <= 4 ) { if ( !a_w ) { return 0; @@ -105,18 +35,18 @@ u3i_bytes(c3_w a_w, } } - /* Allocate, fill, return. - */ + // Allocate, fill, return. + // { - c3_w len_w = (a_w + 3) >> 2; - c3_w* nov_w = u3a_walloc((len_w + c3_wiseof(u3a_atom))); + c3_w len_w = (a_w + 3) >> 2; + c3_w* nov_w = u3a_walloc((len_w + c3_wiseof(u3a_atom))); u3a_atom* nov_u = (void*)nov_w; nov_u->mug_w = 0; nov_u->len_w = len_w; - /* Clear the words. - */ + // Clear the words. + // { c3_w i_w; @@ -125,8 +55,8 @@ u3i_bytes(c3_w a_w, } } - /* Fill the bytes. - */ + // Fill the bytes. + // { c3_w i_w; @@ -138,9 +68,71 @@ u3i_bytes(c3_w a_w, } } -/* u3i_mp(): -** -** Copy the GMP integer `a` into an atom, and clear it. +/* u3i_words(): Copy [a] words from [b] into an atom. +*/ +u3_noun +u3i_words(c3_w a_w, + const c3_w* b_w) +{ + // Strip trailing zeroes. + // + while ( a_w && !b_w[a_w - 1] ) { + a_w--; + } + + // Check for cat. + // + if ( !a_w ) { + return 0; + } + else if ( (a_w == 1) && !(b_w[0] >> 31) ) { + return b_w[0]; + } + + // Allocate, fill, return. + // + { + c3_w* nov_w = u3a_walloc(a_w + c3_wiseof(u3a_atom)); + u3a_atom* nov_u = (void*)nov_w; + + nov_u->mug_w = 0; + nov_u->len_w = a_w; + + // Fill the words. + // + { + c3_w i_w; + + for ( i_w=0; i_w < a_w; i_w++ ) { + nov_u->buf_w[i_w] = b_w[i_w]; + } + } + return u3a_to_pug(u3a_outa(nov_w)); + } +} + +/* u3i_chubs(): Copy [a] chubs from [b] into an atom. +*/ +u3_atom +u3i_chubs(c3_w a_w, + const c3_d* b_d) +{ + // XX efficiency + // + c3_w *b_w = u3a_malloc(a_w * 8); + c3_w i_w; + u3_atom p; + + for ( i_w = 0; i_w < a_w; i_w++ ) { + b_w[(2 * i_w)] = b_d[i_w] & 0xffffffffULL; + b_w[(2 * i_w) + 1] = b_d[i_w] >> 32ULL; + } + p = u3i_words((a_w * 2), b_w); + u3a_free(b_w); + return p; +} + +/* u3i_mp(): Copy the GMP integer [a] into an atom, and clear it. */ u3_noun u3i_mp(mpz_t a_mp) @@ -154,9 +146,7 @@ u3i_mp(mpz_t a_mp) return u3a_malt(buz_w); } -/* u3i_vint(): -** -** Create `a + 1`. +/* u3i_vint(): increment [a]. */ u3_noun u3i_vint(u3_noun a) @@ -178,18 +168,14 @@ u3i_vint(u3_noun a) mpz_t a_mp; u3r_mp(a_mp, a); - u3a_lose(a); + u3z(a); mpz_add_ui(a_mp, a_mp, 1); return u3i_mp(a_mp); } } -c3_w BAD; - -/* u3i_cell(): -** -** Produce the cell `[a b]`. +/* u3i_cell(): Produce the cell `[a b]`. */ u3_noun u3i_cell(u3_noun a, u3_noun b) @@ -199,9 +185,9 @@ u3i_cell(u3_noun a, u3_noun b) #ifdef U3_CPU_DEBUG u3R->pro.cel_d++; #endif + { - // c3_w* nov_w = u3a_walloc(c3_wiseof(u3a_cell)); - c3_w* nov_w = u3a_celloc(); + c3_w* nov_w = u3a_celloc(); u3a_cell* nov_u = (void *)nov_w; u3_noun pro; @@ -210,35 +196,13 @@ u3i_cell(u3_noun a, u3_noun b) nov_u->tel = b; pro = u3a_to_pom(u3a_outa(nov_w)); -#if 0 - if ( (0x730e66cc == u3r_mug(pro)) && - (c3__tssg == u3h(u3t(u3t(pro)))) ) { - static c3_w xuc_w; - u3l_log("BAD %x %p\r\n", pro, u3a_to_ptr(a)); - BAD = pro; - if ( xuc_w == 1 ) u3m_bail(c3__exit); - xuc_w++; - } -#endif -#if 1 + u3t_off(mal_o); return pro; -#else - if ( !FOO ) return u3a_to_pom(u3a_outa(nov_w)); - else { - u3_noun pro = u3a_to_pom(u3a_outa(nov_w)); - - u3m_p("leaked", pro); - u3l_log("pro %u, %x\r\n", pro, u3r_mug(pro)); - abort(); - } -#endif } } -/* u3i_trel(): -** -** Produce the triple `[a b c]`. +/* u3i_trel(): Produce the triple `[a b c]`. */ u3_noun u3i_trel(u3_noun a, u3_noun b, u3_noun c) @@ -246,9 +210,7 @@ u3i_trel(u3_noun a, u3_noun b, u3_noun c) return u3i_cell(a, u3i_cell(b, c)); } -/* u3i_qual(): -** -** Produce the cell `[a b c d]`. +/* u3i_qual(): Produce the cell `[a b c d]`. */ u3_noun u3i_qual(u3_noun a, u3_noun b, u3_noun c, u3_noun d) @@ -256,6 +218,32 @@ u3i_qual(u3_noun a, u3_noun b, u3_noun c, u3_noun d) return u3i_cell(a, u3i_trel(b, c, d)); } +/* u3i_string(): Produce an LSB-first atom from the C string [a]. +*/ +u3_noun +u3i_string(const c3_c* a_c) +{ + return u3i_bytes(strlen(a_c), (c3_y *)a_c); +} + +/* u3i_tape(): from a C string, to a list of bytes. +*/ +u3_atom +u3i_tape(const c3_c* txt_c) +{ + if ( !*txt_c ) { + return u3_nul; + } else return u3i_cell(*txt_c, u3i_tape(txt_c + 1)); +} + +/* u3i_list(): +** +** Generate a null-terminated list, with `u3_none` as terminator. +*/ +u3_noun +u3i_list(u3_weak one, ...); + + static u3_noun _edit_cat(u3_noun big, c3_l axe_l, u3_noun som) { @@ -400,48 +388,6 @@ u3i_edit(u3_noun big, u3_noun axe, u3_noun som) } } -/* u3i_string(): -** -** Produce an LSB-first atom from the C string `a`. -*/ -u3_noun -u3i_string(const c3_c* a_c) -{ - return u3i_bytes(strlen(a_c), (c3_y *)a_c); -} - -/* u3i_tape(): from a C string, to a list of bytes. -*/ -u3_atom -u3i_tape(const c3_c* txt_c) -{ - if ( !*txt_c ) { - return u3_nul; - } else return u3i_cell(*txt_c, u3i_tape(txt_c + 1)); -} - -/* u3i_decimal(): -** -** Parse `a` as a list of decimal digits. -*/ -u3_atom -u3i_decimal(u3_noun a); - -/* u3i_heximal(): -** -** Parse `a` as a list of hex digits. -*/ -u3_noun -u3i_heximal(u3_noun a); - -/* u3i_list(): -** -** Generate a null-terminated list, with `u3_none` as terminator. -*/ -u3_noun -u3i_list(u3_weak one, ...); - - /* u3i_molt(): ** ** Mutate `som` with a 0-terminated list of axis, noun pairs. @@ -478,7 +424,7 @@ u3i_list(u3_weak one, ...); struct _molt_pair* pms_m) // transfer { if ( len_w == 0 ) { - return u3a_gain(som); + return u3k(som); } else if ( (len_w == 1) && (1 == pms_m[0].axe_w) ) { return pms_m[0].som; @@ -505,8 +451,8 @@ u3i_molt(u3_noun som, ...) struct _molt_pair* pms_m; u3_noun pro; - /* Count. - */ + // Count. + // len_w = 0; { va_start(ap, som); @@ -523,8 +469,8 @@ u3i_molt(u3_noun som, ...) c3_assert( 0 != len_w ); pms_m = alloca(len_w * sizeof(struct _molt_pair)); - /* Install. - */ + // Install. + // { c3_w i_w; @@ -536,10 +482,9 @@ u3i_molt(u3_noun som, ...) va_end(ap); } - /* Apply. - */ + // Apply. + // pro = _molt_apply(som, len_w, pms_m); - u3a_lose(som); + u3z(som); return pro; } - From 1d1a263e489b4a7240f71020ae4aafc25436d105 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 6 Jun 2020 00:59:26 -0700 Subject: [PATCH 148/257] u3: rewrites u3i_chubs() for efficiency --- pkg/urbit/noun/imprison.c | 67 ++++++++++++++++++++++++++++++++------- 1 file changed, 56 insertions(+), 11 deletions(-) diff --git a/pkg/urbit/noun/imprison.c b/pkg/urbit/noun/imprison.c index 4b01b1a94..e36b2257a 100644 --- a/pkg/urbit/noun/imprison.c +++ b/pkg/urbit/noun/imprison.c @@ -117,19 +117,64 @@ u3_atom u3i_chubs(c3_w a_w, const c3_d* b_d) { - // XX efficiency + // Strip trailing zeroes. // - c3_w *b_w = u3a_malloc(a_w * 8); - c3_w i_w; - u3_atom p; - - for ( i_w = 0; i_w < a_w; i_w++ ) { - b_w[(2 * i_w)] = b_d[i_w] & 0xffffffffULL; - b_w[(2 * i_w) + 1] = b_d[i_w] >> 32ULL; + while ( a_w && !b_d[a_w - 1] ) { + a_w--; + } + + // Check for cat. + // + if ( !a_w ) { + return 0; + } + else if ( (1 == a_w) && !(b_d[0] >> 31) ) { + return (c3_w)b_d[0]; + } + + // Allocate, fill, return. + // + { + c3_w len_w = 2 * a_w; + + if ( !(b_d[a_w - 1] >> 32) ) { + len_w--; + } + + c3_w* nov_w = u3a_walloc(len_w + c3_wiseof(u3a_atom)); + u3a_atom* nov_u = (void*)nov_w; + + nov_u->mug_w = 0; + nov_u->len_w = len_w; + + // Fill the words. + // + { + c3_w i_w, x_w, max_w = a_w - 1; + c3_d i_d; + + for ( i_w = 0; i_w < max_w; i_w++ ) { + i_d = b_d[i_w]; + x_w = 2 * i_w; + nov_u->buf_w[x_w] = i_d & 0xffffffffULL; + x_w++; + nov_u->buf_w[x_w] = i_d >> 32; + } + + { + i_d = b_d[i_w]; + x_w = 2 * i_w; + nov_u->buf_w[x_w] = i_d & 0xffffffffULL; + x_w++; + } + + if ( x_w < len_w ) { + nov_u->buf_w[x_w] = i_d >> 32; + } + } + + return u3a_to_pug(u3a_outa(nov_w)); } - p = u3i_words((a_w * 2), b_w); - u3a_free(b_w); - return p; } /* u3i_mp(): Copy the GMP integer [a] into an atom, and clear it. From 406a823ddd7827598f6bbaaadd75a3fc91572c5e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 6 Jun 2020 01:00:24 -0700 Subject: [PATCH 149/257] u3: adds allocator profiling labels to u3i_* atom functions --- pkg/urbit/noun/imprison.c | 34 +++++++++++++++++++++++++++------- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/pkg/urbit/noun/imprison.c b/pkg/urbit/noun/imprison.c index e36b2257a..0baad7257 100644 --- a/pkg/urbit/noun/imprison.c +++ b/pkg/urbit/noun/imprison.c @@ -9,6 +9,9 @@ u3_noun u3i_bytes(c3_w a_w, const c3_y* b_y) { + u3_noun pro; + u3t_on(mal_o); + // Strip trailing zeroes. // while ( a_w && !b_y[a_w - 1] ) { @@ -64,8 +67,12 @@ u3i_bytes(c3_w a_w, nov_u->buf_w[i_w >> 2] |= (b_y[i_w] << ((i_w & 3) * 8)); } } - return u3a_to_pug(u3a_outa(nov_w)); + + pro = u3a_to_pug(u3a_outa(nov_w)); } + + u3t_off(mal_o); + return pro; } /* u3i_words(): Copy [a] words from [b] into an atom. @@ -74,6 +81,9 @@ u3_noun u3i_words(c3_w a_w, const c3_w* b_w) { + u3_noun pro; + u3t_on(mal_o); + // Strip trailing zeroes. // while ( a_w && !b_w[a_w - 1] ) { @@ -107,8 +117,12 @@ u3i_words(c3_w a_w, nov_u->buf_w[i_w] = b_w[i_w]; } } - return u3a_to_pug(u3a_outa(nov_w)); + + pro = u3a_to_pug(u3a_outa(nov_w)); } + + u3t_off(mal_o); + return pro; } /* u3i_chubs(): Copy [a] chubs from [b] into an atom. @@ -117,6 +131,9 @@ u3_atom u3i_chubs(c3_w a_w, const c3_d* b_d) { + u3_noun pro; + u3t_on(mal_o); + // Strip trailing zeroes. // while ( a_w && !b_d[a_w - 1] ) { @@ -173,8 +190,11 @@ u3i_chubs(c3_w a_w, } } - return u3a_to_pug(u3a_outa(nov_w)); + pro = u3a_to_pug(u3a_outa(nov_w)); } + + u3t_off(mal_o); + return pro; } /* u3i_mp(): Copy the GMP integer [a] into an atom, and clear it. @@ -225,6 +245,7 @@ u3i_vint(u3_noun a) u3_noun u3i_cell(u3_noun a, u3_noun b) { + u3_noun pro; u3t_on(mal_o); #ifdef U3_CPU_DEBUG @@ -234,17 +255,16 @@ u3i_cell(u3_noun a, u3_noun b) { c3_w* nov_w = u3a_celloc(); u3a_cell* nov_u = (void *)nov_w; - u3_noun pro; nov_u->mug_w = 0; nov_u->hed = a; nov_u->tel = b; pro = u3a_to_pom(u3a_outa(nov_w)); - - u3t_off(mal_o); - return pro; } + + u3t_off(mal_o); + return pro; } /* u3i_trel(): Produce the triple `[a b c]`. From e7eceba9652f708de2747a621cdfcf95e3c33265 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 6 Jun 2020 01:54:33 -0700 Subject: [PATCH 150/257] u3: implements u3i_list()/u3nl() varargs list constructor --- pkg/urbit/include/noun/aliases.h | 5 +++++ pkg/urbit/include/noun/imprison.h | 5 +++++ pkg/urbit/noun/imprison.c | 33 +++++++++++++++++++++++++++---- 3 files changed, 39 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/include/noun/aliases.h b/pkg/urbit/include/noun/aliases.h index c8d0e852f..5e98714d4 100644 --- a/pkg/urbit/include/noun/aliases.h +++ b/pkg/urbit/include/noun/aliases.h @@ -84,6 +84,11 @@ # define u3nt(a, b, c) u3i_trel(a, b, c) # define u3nq(a, b, c, d) u3i_qual(a, b, c, d) + + /* u3nl(), u3_none-terminated varargs list + */ +# define u3nl u3i_list + /* u3du(), u3ud(): noun/cell test. */ # define u3du(som) (u3r_du(som)) diff --git a/pkg/urbit/include/noun/imprison.h b/pkg/urbit/include/noun/imprison.h index c45ea87a2..714bf15c6 100644 --- a/pkg/urbit/include/noun/imprison.h +++ b/pkg/urbit/include/noun/imprison.h @@ -57,6 +57,11 @@ u3_atom u3i_tape(const c3_c* txt_c); + /* u3i_list(): list from `u3_none`-terminated varargs. + */ + u3_noun + u3i_list(u3_weak som, ...); + /* u3i_edit(): ** ** Mutate `big` at axis `axe` with new value `som` diff --git a/pkg/urbit/noun/imprison.c b/pkg/urbit/noun/imprison.c index 0baad7257..6eb533c43 100644 --- a/pkg/urbit/noun/imprison.c +++ b/pkg/urbit/noun/imprison.c @@ -301,13 +301,38 @@ u3i_tape(const c3_c* txt_c) } else return u3i_cell(*txt_c, u3i_tape(txt_c + 1)); } -/* u3i_list(): -** -** Generate a null-terminated list, with `u3_none` as terminator. +/* u3i_list(): list from `u3_none`-terminated varargs. */ u3_noun -u3i_list(u3_weak one, ...); +u3i_list(u3_weak som, ...) +{ + u3_noun lit = u3_nul; + va_list ap; + if ( u3_none == som ) { + return lit; + } + else { + lit = u3nc(som, lit); + } + + { + u3_noun tem; + + va_start(ap, som); + while ( 1 ) { + if ( u3_none == (tem = va_arg(ap, u3_weak)) ) { + break; + } + else { + lit = u3nc(tem, lit); + } + } + va_end(ap); + } + + return u3kb_flop(lit); +} static u3_noun _edit_cat(u3_noun big, c3_l axe_l, u3_noun som) From 2c5a1adea3d81887f7ab900ff05178dde17658cf Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 6 Jun 2020 16:50:00 -0700 Subject: [PATCH 151/257] u3: adds failing u3r_mug_words tests --- pkg/urbit/tests/mug_tests.c | 81 +++++++++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) diff --git a/pkg/urbit/tests/mug_tests.c b/pkg/urbit/tests/mug_tests.c index 760f20d06..ff7736bc0 100644 --- a/pkg/urbit/tests/mug_tests.c +++ b/pkg/urbit/tests/mug_tests.c @@ -94,6 +94,87 @@ _test_mug(void) c3_free(str_w); } + { + c3_w som_w[4]; + u3_noun som; + + { + som_w[0] = 0; + som_w[1] = 0; + som_w[2] = 0; + som_w[3] = 1; + som = u3i_words(4, som_w); + + if ( 0x519bd45c != u3r_mug(som) ) { + fprintf(stderr, "fail (j) (1)\r\n"); + exit(1); + } + + if ( 0x519bd45c != u3r_mug_words(som_w, 4) ) { + fprintf(stderr, "fail (j) (2)\r\n"); + exit(1); + } + u3z(som); + } + + { + som_w[0] = 0; + som_w[1] = 1; + som_w[2] = 0; + som_w[3] = 1; + som = u3i_words(4, som_w); + + if ( 0x540eb8a9 != u3r_mug(som) ) { + fprintf(stderr, "fail (k) (1)\r\n"); + exit(1); + } + + if ( 0x540eb8a9 != u3r_mug_words(som_w, 4) ) { + fprintf(stderr, "fail (k) (2)\r\n"); + exit(1); + } + u3z(som); + } + + { + som_w[0] = 1; + som_w[1] = 1; + som_w[2] = 0; + som_w[3] = 1; + som = u3i_words(4, som_w); + + if ( 0x319d28f9 != u3r_mug(som) ) { + fprintf(stderr, "fail (l) (1)\r\n"); + exit(1); + } + + if ( 0x319d28f9 != u3r_mug_words(som_w, 4) ) { + fprintf(stderr, "fail (l) (2)\r\n"); + exit(1); + } + u3z(som); + } + + { + som_w[0] = 0; + som_w[1] = 0; + som_w[2] = 0; + som_w[3] = 0xffff; + som = u3i_words(4, som_w); + + if ( 0x5230a260 != u3r_mug(som) ) { + fprintf(stderr, "fail (m) (1)\r\n"); + exit(1); + } + + if ( 0x5230a260 != u3r_mug_words(som_w, 4) ) { + fprintf(stderr, "fail (m) (2)\r\n"); + exit(1); + } + u3z(som); + } + } + fprintf(stderr, "test_mug: ok\n"); } From 9e305da03cb24bb2d015a4c4a9258be5b48890be Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 6 Jun 2020 16:51:21 -0700 Subject: [PATCH 152/257] u3: rewrites u3r_mug_words, correct for arbitrary input --- pkg/urbit/noun/retrieve.c | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/noun/retrieve.c b/pkg/urbit/noun/retrieve.c index 7da63cbcc..7015770d1 100644 --- a/pkg/urbit/noun/retrieve.c +++ b/pkg/urbit/noun/retrieve.c @@ -1405,14 +1405,30 @@ u3r_mug_string(const c3_c *a_c) c3_w u3r_mug_words(const c3_w* key_w, c3_w len_w) { - c3_w byt_w = 0; - c3_w wor_w; + c3_w byt_w; - while ( 0 < len_w ) { - wor_w = key_w[--len_w]; - byt_w += _(u3a_is_cat(wor_w)) ? u3r_met(3, wor_w) : 4; + // ignore trailing zeros + // + while ( len_w && !key_w[len_w - 1] ) { + len_w--; } + // calculate byte-width a la u3r_met(3, ...) + // + if ( !len_w ) { + byt_w = 0; + } + else { + c3_w gal_w = len_w - 1; + c3_w daz_w = key_w[gal_w]; + + byt_w = (gal_w << 2) + + ((daz_w >> 24) ? 4 : (daz_w >> 16) ? 3 : (daz_w >> 8) ? 2 : 1); + + } + + // XX: assumes little-endian + // return u3r_mug_bytes((c3_y*)key_w, byt_w); } From 27a9dbe1c0a7a95f7807db17f056377d98e39f65 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 6 Jun 2020 16:52:05 -0700 Subject: [PATCH 153/257] u3: use u3r_mug_words for all atoms --- pkg/urbit/noun/retrieve.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/noun/retrieve.c b/pkg/urbit/noun/retrieve.c index 7015770d1..14c0fe14c 100644 --- a/pkg/urbit/noun/retrieve.c +++ b/pkg/urbit/noun/retrieve.c @@ -1387,7 +1387,7 @@ u3r_mug_chub(c3_d num_d) c3_w buf_w[2]; buf_w[0] = (c3_w)(num_d & 0xffffffffULL); - buf_w[1] = (c3_w)(num_d >> 32ULL); + buf_w[1] = (c3_w)(num_d >> 32); return u3r_mug_words(buf_w, 2); } @@ -1438,8 +1438,7 @@ c3_w u3r_mug_both(c3_w lef_w, c3_w rit_w) { c3_w ham_w = lef_w ^ (0x7fffffff ^ rit_w); - - return u3r_mug_words(&ham_w, (0 == ham_w) ? 0 : 1); + return u3r_mug_words(&ham_w, 1); } /* u3r_mug_cell(): Compute the mug of the cell `[hed tel]`. @@ -1547,7 +1546,7 @@ u3r_mug(u3_noun veb) // veb is a direct atom, mug is not memoized // if ( _(u3a_is_cat(veb)) ) { - mug_w = u3r_mug_bytes((c3_y*)&veb, u3r_met(3, veb)); + mug_w = u3r_mug_words(&veb, 1); goto retreat; } // veb is indirect, a pointer into the loom @@ -1565,7 +1564,7 @@ u3r_mug(u3_noun veb) // else if ( _(u3a_is_atom(veb)) ) { u3a_atom* vat_u = (u3a_atom*)veb_u; - mug_w = u3r_mug_bytes((c3_y*)vat_u->buf_w, u3r_met(3, veb)); + mug_w = u3r_mug_words(vat_u->buf_w, vat_u->len_w); vat_u->mug_w = mug_w; goto retreat; } From 4cfaf083487c1d8e2bff887dfd978216c775faf6 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 4 Jun 2020 11:09:50 -0700 Subject: [PATCH 154/257] newt: print errors to stderr --- pkg/urbit/vere/newt.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/vere/newt.c b/pkg/urbit/vere/newt.c index c60083a44..8340c9033 100644 --- a/pkg/urbit/vere/newt.c +++ b/pkg/urbit/vere/newt.c @@ -87,9 +87,9 @@ _newt_gain_mess(u3_moat* mot_u) // very likely to be a bad write, we can't jam anything this big // if ( 0xFFFFFFFFULL < nel_d ) { - u3l_log("newt: %d warn: large read %" PRIu64 "\r\n", - getpid(), - nel_d); + fprintf(stderr, "newt: %d warn: large read %" PRIu64 "\r\n", + getpid(), + nel_d); } mot_u->len_d -= 8ULL; @@ -316,7 +316,7 @@ _newt_write_cb(uv_write_t* wri_u, c3_i sas_i) c3_free(req_u); if ( 0 != sas_i ) { - u3l_log("newt: bad write %d\r\n", sas_i); + fprintf(stderr, "newt: bad write %d\r\n", sas_i); moj_u->bal_f(vod_p, uv_strerror(sas_i)); } } From a31f27a57586f4cae9341a835a52b1362ac3eac5 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 5 Jun 2020 17:55:58 -0700 Subject: [PATCH 155/257] newt: cleans up api, allocates less on write --- pkg/urbit/include/vere/vere.h | 16 ++-- pkg/urbit/tests/newt_tests.c | 43 ++++++++--- pkg/urbit/vere/daemon.c | 6 +- pkg/urbit/vere/lord.c | 6 +- pkg/urbit/vere/newt.c | 137 ++++++++++++++++------------------ pkg/urbit/worker/main.c | 5 +- 6 files changed, 111 insertions(+), 102 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 1640ba924..79e75e329 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -68,7 +68,7 @@ typedef struct _u3_moat { uv_pipe_t pyp_u; // input stream u3_moor_bail bal_f; // error response function - void* vod_p; // callback pointer + void* ptr_v; // callback pointer u3_moor_poke pok_f; // action function struct _u3_mess* mes_u; // message in progress c3_d len_d; // length of stray bytes @@ -78,15 +78,16 @@ /* u3_mojo: outbound message stream. */ typedef struct _u3_mojo { - uv_pipe_t pyp_u; // output stream + uv_pipe_t pyp_u; // output stream u3_moor_bail bal_f; // error response function + void* ptr_v; // callback pointer } u3_mojo; /* u3_moor: two-way message stream, linked list */ typedef struct _u3_moor { uv_pipe_t pyp_u; u3_moor_bail bal_f; - void* vod_p; + void* ptr_v; u3_moor_poke pok_f; struct _u3_mess* mes_u; c3_d len_d; @@ -1057,11 +1058,6 @@ /** Stream messages. **/ - /* u3_newt_encode(): encode an atom to a length-prefixed byte buffer - */ - c3_y* - u3_newt_encode(u3_atom mat, c3_w* len_w); - /* u3_newt_decode(): decode a (partial) length-prefixed byte buffer */ void @@ -1070,9 +1066,7 @@ /* u3_newt_write(): write atom to stream; free atom. */ void - u3_newt_write(u3_mojo* moj_u, - u3_atom mat, - void* vod_p); + u3_newt_write(u3_mojo* moj_u, u3_atom mat); /* u3_newt_read(): activate reading on input stream. */ diff --git a/pkg/urbit/tests/newt_tests.c b/pkg/urbit/tests/newt_tests.c index 41f20eb40..f279fec23 100644 --- a/pkg/urbit/tests/newt_tests.c +++ b/pkg/urbit/tests/newt_tests.c @@ -13,6 +13,31 @@ _setup(void) static c3_w pok_w; static c3_w bal_w; +/* _newt_encode(): synchronous serialization into a single buffer, for test purposes +*/ +static c3_y* +_newt_encode(u3_atom mat, c3_w* len_w) +{ + c3_w met_w = u3r_met(3, mat); + c3_y* buf_y; + + *len_w = 8 + met_w; + buf_y = c3_malloc(*len_w); + + // write header; c3_d is futureproofing + // + buf_y[0] = ((met_w >> 0) & 0xff); + buf_y[1] = ((met_w >> 8) & 0xff); + buf_y[2] = ((met_w >> 16) & 0xff); + buf_y[3] = ((met_w >> 24) & 0xff); + buf_y[4] = buf_y[5] = buf_y[6] = buf_y[7] = 0; + + u3r_bytes(0, met_w, buf_y + 8, mat); + u3z(mat); + + return buf_y; +} + static void _moat_poke_cb(void* vod_p, u3_atom a) { @@ -48,7 +73,7 @@ _test_newt_smol(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); u3_newt_decode(&mot_u, buf_y, len_w); if ( 1 != pok_w ) { @@ -63,7 +88,7 @@ _test_newt_smol(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); buf_y = c3_realloc(buf_y, 2 * len_w); memcpy(buf_y + len_w, buf_y, len_w); @@ -84,7 +109,7 @@ _test_newt_smol(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); end_y = c3_malloc(1); end_y[0] = buf_y[len_w - 1]; @@ -113,7 +138,7 @@ _test_newt_smol(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); dub_w = 2 * len_w; haf_w = len_w / 2; @@ -168,7 +193,7 @@ _test_newt_vast(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); u3_newt_decode(&mot_u, buf_y, len_w); if ( 1 != pok_w ) { @@ -183,7 +208,7 @@ _test_newt_vast(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); buf_y = c3_realloc(buf_y, 2 * len_w); memcpy(buf_y + len_w, buf_y, len_w); @@ -203,7 +228,7 @@ _test_newt_vast(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); { c3_y* cop_y = c3_malloc(len_w); @@ -243,7 +268,7 @@ _test_newt_vast(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); dub_w = 2 * len_w; haf_w = len_w / 2; @@ -281,7 +306,7 @@ _test_newt_vast(void) pok_w = 0; bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); dub_w = 2 * len_w; diff --git a/pkg/urbit/vere/daemon.c b/pkg/urbit/vere/daemon.c index 844cb1c99..7e7bf44e7 100644 --- a/pkg/urbit/vere/daemon.c +++ b/pkg/urbit/vere/daemon.c @@ -413,14 +413,14 @@ _daemon_socket_connect(uv_stream_t *sock, int status) if ( u3K.cli_u == 0 ) { u3K.cli_u = c3_malloc(sizeof(u3_moor)); mor_u = u3K.cli_u; - mor_u->vod_p = 0; + mor_u->ptr_v = 0; mor_u->nex_u = 0; } else { for (mor_u = u3K.cli_u; mor_u->nex_u; mor_u = mor_u->nex_u); mor_u->nex_u = c3_malloc(sizeof(u3_moor)); - mor_u->nex_u->vod_p = mor_u; + mor_u->nex_u->ptr_v = mor_u; mor_u = mor_u->nex_u; mor_u->nex_u = 0; } @@ -841,7 +841,7 @@ _boothack_cb(uv_connect_t* con_u, c3_i sas_i) else { u3_noun dom = u3nc(c3__doom, _boothack_doom()); u3_atom mat = u3ke_jam(dom); - u3_newt_write(moj_u, mat, 0); + u3_newt_write(moj_u, mat); c3_free(con_u); diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 5e0b4757a..68bd83b0a 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -657,9 +657,8 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) static void _lord_writ_send(u3_lord* god_u, u3_writ* wit_u) { - _lord_writ_jam(god_u, wit_u); - u3_newt_write(&god_u->inn_u, wit_u->mat, 0); + u3_newt_write(&god_u->inn_u, wit_u->mat); wit_u->mat = 0; // ignore subprocess error on shutdown @@ -943,12 +942,13 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) // start reading from proc // { - god_u->out_u.vod_p = god_u; + god_u->out_u.ptr_v = god_u; god_u->out_u.pok_f = _lord_plea; god_u->out_u.bal_f = _lord_bail; // XX distinguish from out_u.bal_f ? // + god_u->inn_u.ptr_v = god_u; god_u->inn_u.bal_f = _lord_bail; u3_newt_read(&god_u->out_u); diff --git a/pkg/urbit/vere/newt.c b/pkg/urbit/vere/newt.c index 8340c9033..9aa6919b7 100644 --- a/pkg/urbit/vere/newt.c +++ b/pkg/urbit/vere/newt.c @@ -179,7 +179,7 @@ _newt_poke_mess(u3_moat* mot_u) // { u3_noun mat = u3i_bytes((c3_w)len_d, buf_y); - mot_u->pok_f(mot_u->vod_p, mat); + mot_u->pok_f(mot_u->ptr_v, mat); } c3_free(buf_y); @@ -238,21 +238,9 @@ u3_newt_decode(u3_moat* mot_u, c3_y* buf_y, c3_w len_w) } } -/* _raft_alloc(): libuv-style allocator for raft. -*/ -static void -_newt_alloc(uv_handle_t* had_u, - size_t len_i, - uv_buf_t* buf_u) -{ - void* ptr_v = c3_malloc(len_i); - - *buf_u = uv_buf_init(ptr_v, len_i); -} - /* _newt_read_cb(): stream input callback. */ -void +static void _newt_read_cb(uv_stream_t* str_u, ssize_t len_i, const uv_buf_t* buf_u) @@ -262,7 +250,8 @@ _newt_read_cb(uv_stream_t* str_u, if ( 0 > len_i ) { c3_free(buf_u->base); uv_read_stop(str_u); - mot_u->bal_f(mot_u->vod_p, uv_strerror(len_i)); + fprintf(stderr, "newt: read failed %s\r\n", uv_strerror(len_i)); + mot_u->bal_f(mot_u->ptr_v, uv_strerror(len_i)); } // EAGAIN/EWOULDBLOCK // @@ -274,100 +263,100 @@ _newt_read_cb(uv_stream_t* str_u, } } +/* _newt_alloc(): libuv-style allocator. +*/ +static void +_newt_alloc(uv_handle_t* had_u, + size_t len_i, + uv_buf_t* buf_u) +{ + // XX pick an appropriate size + // + void* ptr_v = c3_malloc(len_i); + + *buf_u = uv_buf_init(ptr_v, len_i); +} + /* u3_newt_read(): start stream reading. */ void u3_newt_read(u3_moat* mot_u) { - c3_i err_i; - mot_u->mes_u = 0; mot_u->len_d = 0; mot_u->rag_y = 0; - err_i = uv_read_start((uv_stream_t*) &mot_u->pyp_u, - _newt_alloc, - _newt_read_cb); + { + c3_i sas_i; - if ( err_i != 0 ) { - mot_u->bal_f(mot_u, uv_strerror(err_i)); + if ( 0 != (sas_i = uv_read_start((uv_stream_t*)&mot_u->pyp_u, + _newt_alloc, + _newt_read_cb)) ) + { + fprintf(stderr, "newt: read failed %s\r\n", uv_strerror(sas_i)); + mot_u->bal_f(mot_u->ptr_v, uv_strerror(sas_i)); + } } } -/* u3_write_t: write request for newt +/* n_req: write request for newt */ -typedef struct _u3_write_t { +typedef struct _n_req { uv_write_t wri_u; u3_mojo* moj_u; - void* vod_p; - c3_y* buf_y; -} u3_write_t; + c3_y buf_y[0]; +} n_req; /* _newt_write_cb(): generic write callback. */ static void _newt_write_cb(uv_write_t* wri_u, c3_i sas_i) { - u3_write_t* req_u = (struct _u3_write_t*)wri_u; - void* vod_p = req_u->vod_p; - u3_mojo* moj_u = req_u->moj_u; + n_req* req_u = (n_req*)wri_u; + u3_mojo* moj_u = req_u->moj_u; - c3_free(req_u->buf_y); c3_free(req_u); if ( 0 != sas_i ) { - fprintf(stderr, "newt: bad write %d\r\n", sas_i); - moj_u->bal_f(vod_p, uv_strerror(sas_i)); + fprintf(stderr, "newt: write failed %s\r\n", uv_strerror(sas_i)); + moj_u->bal_f(moj_u->ptr_v, uv_strerror(sas_i)); } } -/* u3_newt_encode(): encode an atom to a length-prefixed byte buffer -*/ -c3_y* -u3_newt_encode(u3_atom mat, c3_w* len_w) -{ - c3_w met_w = u3r_met(3, mat); - c3_y* buf_y; - - *len_w = 8 + met_w; - buf_y = c3_malloc(*len_w); - - // write header; c3_d is futureproofing - // - buf_y[0] = ((met_w >> 0) & 0xff); - buf_y[1] = ((met_w >> 8) & 0xff); - buf_y[2] = ((met_w >> 16) & 0xff); - buf_y[3] = ((met_w >> 24) & 0xff); - buf_y[4] = buf_y[5] = buf_y[6] = buf_y[7] = 0; - - u3r_bytes(0, met_w, buf_y + 8, mat); - u3z(mat); - - return buf_y; -} - /* u3_newt_write(): write atom to stream; free atom. */ void -u3_newt_write(u3_mojo* moj_u, - u3_atom mat, - void* vod_p) +u3_newt_write(u3_mojo* moj_u, u3_atom mat) { - u3_write_t* req_u = c3_malloc(sizeof(*req_u)); - c3_w len_w; - c3_y* buf_y = u3_newt_encode(mat, &len_w); - uv_buf_t buf_u; - c3_i err_i; - + c3_w len_w = u3r_met(3, mat); + n_req* req_u = c3_malloc(8 + len_w + sizeof(*req_u)); req_u->moj_u = moj_u; - req_u->buf_y = buf_y; - buf_u = uv_buf_init((c3_c*)buf_y, len_w); - if ( 0 != (err_i = uv_write((uv_write_t*)req_u, - (uv_stream_t*)&moj_u->pyp_u, - &buf_u, 1, - _newt_write_cb)) ) + // write header; c3_d is futureproofing + // + req_u->buf_y[0] = ((len_w >> 0) & 0xff); + req_u->buf_y[1] = ((len_w >> 8) & 0xff); + req_u->buf_y[2] = ((len_w >> 16) & 0xff); + req_u->buf_y[3] = ((len_w >> 24) & 0xff); + req_u->buf_y[4] = req_u->buf_y[5] = req_u->buf_y[6] = req_u->buf_y[7] = 0; + + // write payload + // + u3r_bytes(0, len_w, req_u->buf_y + 8, mat); + u3z(mat); + { - moj_u->bal_f(moj_u, uv_strerror(err_i)); + uv_buf_t buf_u = uv_buf_init((c3_c*)req_u->buf_y, 8 + len_w); + c3_i sas_i; + + if ( 0 != (sas_i = uv_write(&req_u->wri_u, + (uv_stream_t*)&moj_u->pyp_u, + &buf_u, 1, + _newt_write_cb)) ) + { + c3_free(req_u); + fprintf(stderr, "newt: write failed %s\r\n", uv_strerror(sas_i)); + moj_u->bal_f(moj_u->ptr_v, uv_strerror(sas_i)); + } } } diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index c50d12728..ccde6dda8 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -40,7 +40,7 @@ _newt_fail(void* vod_p, const c3_c* wut_c) static void _newt_send(u3_noun pel) { - u3_newt_write(&out_u, u3ke_jam(pel), 0); + u3_newt_write(&out_u, u3ke_jam(pel)); } /* _newt_send_slog(): send hint output (hod is [priority tank]). @@ -155,11 +155,12 @@ main(c3_i argc, c3_c* argv[]) // set up writing // + out_u.ptr_v = &u3V; out_u.bal_f = _newt_fail; // set up reading // - inn_u.vod_p = &u3V; + inn_u.ptr_v = &u3V; inn_u.pok_f = _newt_writ; inn_u.bal_f = _newt_fail; From 3f26140cf4721ae3e47dd3ac712f10cd134308cb Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 4 Jun 2020 11:09:22 -0700 Subject: [PATCH 156/257] newt: delivers inbound messages asynchronously --- pkg/urbit/include/vere/vere.h | 58 ++++--- pkg/urbit/tests/newt_tests.c | 82 ++++------ pkg/urbit/vere/daemon.c | 2 + pkg/urbit/vere/lord.c | 1 + pkg/urbit/vere/newt.c | 298 ++++++++++++++-------------------- pkg/urbit/worker/main.c | 2 + 6 files changed, 202 insertions(+), 241 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 79e75e329..4c8cee2f6 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -46,15 +46,6 @@ */ typedef void (*u3_moor_bail)(void*, const c3_c* err_c); - /* u3_mess: blob message in process. - */ - typedef struct _u3_mess { - c3_d len_d; // blob length in bytes - c3_d has_d; // currently held - struct _u3_meat* meq_u; // exit of message queue - struct _u3_meat* qem_u; // entry of message queue - } u3_mess; - /* u3_meat: blob message block. */ typedef struct _u3_meat { @@ -63,6 +54,29 @@ c3_y hun_y[0]; } u3_meat; + /* u3_mess_type: in-process message type. + */ + typedef enum { + u3_mess_head = 0, // awaiting header + u3_mess_tail = 1 // awaiting body + } u3_mess_type; + + /* u3_mess: blob message in process. + */ + typedef struct _u3_mess { + u3_mess_type sat_e; // msg type + union { // + struct { // awaiting header: + c3_y len_y[8]; // header bytes + c3_y has_y; // length + } hed_u; // + struct { // awaiting body + u3_meat* met_u; // partial message + c3_d has_d; // length + } tal_u; // + }; + } u3_mess; + /* u3_moat: inbound message stream. */ typedef struct _u3_moat { @@ -70,9 +84,10 @@ u3_moor_bail bal_f; // error response function void* ptr_v; // callback pointer u3_moor_poke pok_f; // action function - struct _u3_mess* mes_u; // message in progress - c3_d len_d; // length of stray bytes - c3_y* rag_y; // stray bytes + u3_mess mes_u; // message in progress + uv_timer_t tim_u; // queue timer + u3_meat* ent_u; // entry of message queue + u3_meat* ext_u; // exit of message queue } u3_moat; /* u3_mojo: outbound message stream. @@ -85,14 +100,15 @@ /* u3_moor: two-way message stream, linked list */ typedef struct _u3_moor { - uv_pipe_t pyp_u; - u3_moor_bail bal_f; - void* ptr_v; - u3_moor_poke pok_f; - struct _u3_mess* mes_u; - c3_d len_d; - c3_y* rag_y; - struct _u3_moor* nex_u; + uv_pipe_t pyp_u; // duplex stream + u3_moor_bail bal_f; // error response function + void* ptr_v; // callback pointer + u3_moor_poke pok_f; // action function + u3_mess mes_u; // message in progress + uv_timer_t tim_u; // queue timer + u3_meat* ent_u; // entry of message queue + u3_meat* ext_u; // exit of message queue + struct _u3_moor* nex_u; // next in list } u3_moor; /* u3_dent: directory entry. @@ -1061,7 +1077,7 @@ /* u3_newt_decode(): decode a (partial) length-prefixed byte buffer */ void - u3_newt_decode(u3_moat* mot_u, c3_y* buf_y, c3_w len_w); + u3_newt_decode(u3_moat* mot_u, c3_y* buf_y, c3_d len_d); /* u3_newt_write(): write atom to stream; free atom. */ diff --git a/pkg/urbit/tests/newt_tests.c b/pkg/urbit/tests/newt_tests.c index f279fec23..639cc80e5 100644 --- a/pkg/urbit/tests/newt_tests.c +++ b/pkg/urbit/tests/newt_tests.c @@ -10,9 +10,6 @@ _setup(void) u3m_pave(c3y, c3n); } -static c3_w pok_w; -static c3_w bal_w; - /* _newt_encode(): synchronous serialization into a single buffer, for test purposes */ static c3_y* @@ -38,17 +35,18 @@ _newt_encode(u3_atom mat, c3_w* len_w) return buf_y; } -static void -_moat_poke_cb(void* vod_p, u3_atom a) +static c3_w +_moat_length(u3_moat* mot_u) { - pok_w++; - u3z(a); -} + u3_meat* met_u = mot_u->ext_u; + c3_w len_w = 0; -static void -_moat_bail_cb(void* vod_p, const c3_c* err_c) -{ - bal_w++; + while ( met_u ) { + met_u = met_u->nex_u; + len_w++; + } + + return len_w; } /* _test_newt_smol(): various scenarios with small messages @@ -64,19 +62,16 @@ _test_newt_smol(void) c3_y* buf_y; memset(&mot_u, 0, sizeof(u3_moat)); - mot_u.pok_f = _moat_poke_cb; - mot_u.bal_f = _moat_bail_cb; // one message one buffer // { - pok_w = 0; - bal_w = 0; + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); u3_newt_decode(&mot_u, buf_y, len_w); - if ( 1 != pok_w ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt smol fail (a)\n"); exit(1); } @@ -85,8 +80,7 @@ _test_newt_smol(void) // two messages one buffer // { - pok_w = 0; - bal_w = 0; + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); @@ -96,7 +90,7 @@ _test_newt_smol(void) u3_newt_decode(&mot_u, buf_y, len_w); - if ( 2 != pok_w ) { + if ( 2 != _moat_length(&mot_u) ) { fprintf(stderr, "newt smol fail (b)\n"); exit(1); } @@ -106,8 +100,8 @@ _test_newt_smol(void) // { c3_y* end_y; - pok_w = 0; - bal_w = 0; + + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); @@ -116,14 +110,14 @@ _test_newt_smol(void) u3_newt_decode(&mot_u, buf_y, len_w - 1); - if ( 0 != pok_w ) { + if ( 0 != _moat_length(&mot_u) ) { fprintf(stderr, "newt smol fail (c)\n"); exit(1); } u3_newt_decode(&mot_u, end_y, 1); - if ( 1 != pok_w ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt smol fail (d)\n"); exit(1); } @@ -135,8 +129,7 @@ _test_newt_smol(void) c3_y* haf_y; c3_w haf_w, dub_w; - pok_w = 0; - bal_w = 0; + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); @@ -155,14 +148,14 @@ _test_newt_smol(void) u3_newt_decode(&mot_u, buf_y, dub_w - haf_w); - if ( 1 != pok_w ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt smol fail (e)\n"); exit(1); } u3_newt_decode(&mot_u, haf_y, haf_w); - if ( 2 != pok_w ) { + if ( 2 != _moat_length(&mot_u) ) { fprintf(stderr, "newt smol fail (f)\n"); exit(1); } @@ -184,19 +177,16 @@ _test_newt_vast(void) c3_y* buf_y; memset(&mot_u, 0, sizeof(u3_moat)); - mot_u.pok_f = _moat_poke_cb; - mot_u.bal_f = _moat_bail_cb; // one message one buffer // { - pok_w = 0; - bal_w = 0; + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); u3_newt_decode(&mot_u, buf_y, len_w); - if ( 1 != pok_w ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (a)\n"); exit(1); } @@ -205,8 +195,7 @@ _test_newt_vast(void) // two messages one buffer // { - pok_w = 0; - bal_w = 0; + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); @@ -216,7 +205,7 @@ _test_newt_vast(void) u3_newt_decode(&mot_u, buf_y, len_w); - if ( 2 != pok_w ) { + if ( 2 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (b)\n"); exit(1); } @@ -225,8 +214,7 @@ _test_newt_vast(void) // one message many buffers // { - pok_w = 0; - bal_w = 0; + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); @@ -241,7 +229,7 @@ _test_newt_vast(void) c3_y* end_y = c3_malloc(1); end_y[0] = cop_y[haf_w]; - if ( 0 != pok_w ) { + if ( 0 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (c) %u\n", haf_w); exit(1); } @@ -253,7 +241,7 @@ _test_newt_vast(void) c3_free(cop_y); } - if ( 1 != pok_w ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (d)\n"); exit(1); } @@ -265,8 +253,7 @@ _test_newt_vast(void) c3_y* haf_y; c3_w haf_w, dub_w; - pok_w = 0; - bal_w = 0; + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); @@ -285,14 +272,14 @@ _test_newt_vast(void) u3_newt_decode(&mot_u, buf_y, dub_w - haf_w); - if ( 1 != pok_w ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (e)\n"); exit(1); } u3_newt_decode(&mot_u, haf_y, haf_w); - if ( 2 != pok_w ) { + if ( 2 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (f)\n"); exit(1); } @@ -303,8 +290,7 @@ _test_newt_vast(void) { c3_w dub_w; - pok_w = 0; - bal_w = 0; + mot_u.ent_u = mot_u.ext_u = 0; buf_y = _newt_encode(u3k(a), &len_w); @@ -326,7 +312,7 @@ _test_newt_vast(void) c3_y* end_y = c3_malloc(1); end_y[0] = cop_y[haf_w]; - if ( 1 != pok_w ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (g) %u\n", haf_w); exit(1); } @@ -338,7 +324,7 @@ _test_newt_vast(void) c3_free(cop_y); } - if ( 2 != pok_w ) { + if ( 2 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (h)\n"); exit(1); } diff --git a/pkg/urbit/vere/daemon.c b/pkg/urbit/vere/daemon.c index 7e7bf44e7..bcb60e56b 100644 --- a/pkg/urbit/vere/daemon.c +++ b/pkg/urbit/vere/daemon.c @@ -425,6 +425,7 @@ _daemon_socket_connect(uv_stream_t *sock, int status) mor_u->nex_u = 0; } + uv_timer_init(u3L, &mor_u->tim_u); uv_pipe_init(u3L, &mor_u->pyp_u, 0); mor_u->pok_f = _daemon_fate; mor_u->bal_f = _daemon_bail; @@ -866,6 +867,7 @@ _daemon_loop_init() u3_moor* mor_u = c3_malloc(sizeof(u3_moor)); uv_connect_t* con_u = c3_malloc(sizeof(uv_connect_t)); con_u->data = mor_u; + uv_timer_init(u3L, &mor_u->tim_u); uv_pipe_init(u3L, &mor_u->pyp_u, 0); uv_pipe_connect(con_u, &mor_u->pyp_u, u3K.soc_c, _boothack_cb); } diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 68bd83b0a..ffa1fcc88 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -914,6 +914,7 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) arg_c[5] = 0; uv_pipe_init(u3L, &god_u->inn_u.pyp_u, 0); + uv_timer_init(u3L, &god_u->out_u.tim_u); uv_pipe_init(u3L, &god_u->out_u.pyp_u, 0); god_u->cod_u[0].flags = UV_CREATE_PIPE | UV_READABLE_PIPE; diff --git a/pkg/urbit/vere/newt.c b/pkg/urbit/vere/newt.c index 9aa6919b7..92618016f 100644 --- a/pkg/urbit/vere/newt.c +++ b/pkg/urbit/vere/newt.c @@ -31,209 +31,152 @@ #include "all.h" #include "vere/vere.h" -/* _newt_gain_meat(): add a block to an existing message +/* _newt_mess_head(): await next msg header. */ static void -_newt_gain_meat(u3_moat* mot_u) +_newt_mess_head(u3_mess* mes_u) { - c3_assert( 0 != mot_u->mes_u ); - - // create block - // - u3_meat* met_u = c3_malloc(mot_u->len_d + (c3_d) sizeof(u3_meat)); - met_u->nex_u = 0; - met_u->len_d = mot_u->len_d; - memcpy(met_u->hun_y, mot_u->rag_y, mot_u->len_d); - - // enqueue block - // - if ( !mot_u->mes_u->meq_u ) { - mot_u->mes_u->meq_u = mot_u->mes_u->qem_u = met_u; - } - else { - mot_u->mes_u->qem_u->nex_u = met_u; - mot_u->mes_u->qem_u = met_u; - } - mot_u->mes_u->has_d += met_u->len_d; - - // free consumed stray bytes - // - c3_free(mot_u->rag_y); - mot_u->len_d = 0; - mot_u->rag_y = 0; + mes_u->sat_e = u3_mess_head; + mes_u->hed_u.has_y = 0; } -/* _newt_gain_mess(): begin parsing a new message +/* _newt_mess_tail(): await msg body. */ static void -_newt_gain_mess(u3_moat* mot_u) +_newt_mess_tail(u3_mess* mes_u, c3_d len_d) { - c3_assert( 8ULL <= mot_u->len_d ); - c3_assert( 0 == mot_u->mes_u ); + u3_meat* met_u = c3_malloc(len_d + sizeof(*met_u)); + met_u->nex_u = 0; + met_u->len_d = len_d; - c3_d nel_d = 0ULL; + mes_u->sat_e = u3_mess_tail; + mes_u->tal_u.has_d = 0; + mes_u->tal_u.met_u = met_u; +} - nel_d |= ((c3_d) mot_u->rag_y[0]) << 0ULL; - nel_d |= ((c3_d) mot_u->rag_y[1]) << 8ULL; - nel_d |= ((c3_d) mot_u->rag_y[2]) << 16ULL; - nel_d |= ((c3_d) mot_u->rag_y[3]) << 24ULL; - nel_d |= ((c3_d) mot_u->rag_y[4]) << 32ULL; - nel_d |= ((c3_d) mot_u->rag_y[5]) << 40ULL; - nel_d |= ((c3_d) mot_u->rag_y[6]) << 48ULL; - nel_d |= ((c3_d) mot_u->rag_y[7]) << 56ULL; - - c3_assert( 0ULL != nel_d ); - - // very likely to be a bad write, we can't jam anything this big - // - if ( 0xFFFFFFFFULL < nel_d ) { - fprintf(stderr, "newt: %d warn: large read %" PRIu64 "\r\n", - getpid(), - nel_d); - } - - mot_u->len_d -= 8ULL; - - mot_u->mes_u = c3_malloc(sizeof(u3_mess)); - mot_u->mes_u->len_d = nel_d; - mot_u->mes_u->has_d = 0; - mot_u->mes_u->meq_u = mot_u->mes_u->qem_u = 0; - - if ( 0ULL == mot_u->len_d ) { - c3_free(mot_u->rag_y); - mot_u->rag_y = 0; +/* _newt_meat_plan(): enqueue complete msg. +*/ +static void +_newt_meat_plan(u3_moat* mot_u, u3_meat* met_u) +{ + if ( mot_u->ent_u ) { + mot_u->ent_u->nex_u = met_u; + mot_u->ent_u = met_u; } else { - // remove consumed length from stray bytes - // - c3_y* buf_y = c3_malloc(mot_u->len_d); - memcpy(buf_y, mot_u->rag_y + 8, mot_u->len_d); - - c3_free(mot_u->rag_y); - mot_u->rag_y = buf_y; + mot_u->ent_u = mot_u->ext_u = met_u; } } -/* _newt_poke_mess(): pass message to [mot_u] callback +static void +_newt_meat_next_cb(uv_timer_t* tim_u); + +/* _newt_meat_poke(): deliver completed msg. */ static void -_newt_poke_mess(u3_moat* mot_u) +_newt_meat_poke(u3_moat* mot_u) { - c3_assert( 0 != mot_u->mes_u ); - c3_assert( mot_u->mes_u->has_d >= mot_u->mes_u->len_d ); + u3_meat* met_u = mot_u->ext_u; - c3_d len_d = mot_u->mes_u->len_d; - c3_y* buf_y = c3_malloc(len_d); - c3_d pat_d = 0; - u3_meat* met_u; + if ( met_u ) { + mot_u->ext_u = met_u->nex_u; - // we should have just cleared this - // - c3_assert(!mot_u->rag_y); - c3_assert(!mot_u->len_d); - - // collect queue blocks, cleaning them up; return any spare meat - // to the rag. - // - { - met_u = mot_u->mes_u->meq_u; - - while ( met_u && (pat_d < len_d) ) { - u3_meat* nex_u = met_u->nex_u; - c3_d end_d = (pat_d + met_u->len_d); - c3_d eat_d; - c3_d rem_d; - - eat_d = c3_min(len_d, end_d) - pat_d; - memcpy(buf_y + pat_d, met_u->hun_y, eat_d); - pat_d += eat_d; - - rem_d = (met_u->len_d - eat_d); - if ( rem_d ) { - mot_u->rag_y = c3_malloc(rem_d); - memcpy(mot_u->rag_y, met_u->hun_y + eat_d, rem_d); - mot_u->len_d = rem_d; - - // one: unless we got a bad length, this has to be the last - // block in the message. - // - // two: bad data on a newt channel can cause us to assert. - // that's actually the right thing for a private channel. - /// - c3_assert(0 == nex_u); - } - - c3_free(met_u); - met_u = nex_u; + if ( mot_u->ext_u ) { + uv_timer_start(&mot_u->tim_u, _newt_meat_next_cb, 0, 0); + } + else { + mot_u->ent_u = 0; } - c3_assert(pat_d == len_d); - - // clear the message - // - c3_free(mot_u->mes_u); - mot_u->mes_u = 0; - } - - // build and send the object - // - { - u3_noun mat = u3i_bytes((c3_w)len_d, buf_y); + u3_noun mat = u3i_bytes((c3_w)met_u->len_d, met_u->hun_y); mot_u->pok_f(mot_u->ptr_v, mat); + c3_free(met_u); } +} - c3_free(buf_y); +/* _newt_meat_next_cb(): handle next msg after timer. +*/ +static void +_newt_meat_next_cb(uv_timer_t* tim_u) +{ + u3_moat* mot_u = tim_u->data; + _newt_meat_poke(mot_u); } /* u3_newt_decode(): decode a (partial) length-prefixed byte buffer */ void -u3_newt_decode(u3_moat* mot_u, c3_y* buf_y, c3_w len_w) +u3_newt_decode(u3_moat* mot_u, c3_y* buf_y, c3_d len_d) { - // grow read buffer by `len_d` bytes - // - if ( mot_u->rag_y ) { - // XX check SIZE_MAX? - // - c3_d nel_d = mot_u->len_d + len_w; + u3_mess* mes_u = &mot_u->mes_u; - mot_u->rag_y = c3_realloc(mot_u->rag_y, nel_d); - memcpy(mot_u->rag_y + mot_u->len_d, buf_y, len_w); + while ( len_d ) { + switch( mes_u->sat_e ) { - mot_u->len_d = nel_d; - c3_free(buf_y); - } - else { - mot_u->rag_y = buf_y; - mot_u->len_d = (c3_d)len_w; - } - - // process stray bytes, trying to create a new message - // or add a block to an existing one. - // - while ( mot_u->rag_y ) { - // no message - // - if ( !mot_u->mes_u ) { - // but enough stray bytes to start one + // read up to 8 length bytes as needed // - if ( 8ULL <= mot_u->len_d ) { - _newt_gain_mess(mot_u); - } - else { - break; - } - } - else { - // there is a live message, add a block to the queue. - // - _newt_gain_meat(mot_u); + case u3_mess_head: { + c3_y* len_y = mes_u->hed_u.len_y; + c3_y has_y = mes_u->hed_u.has_y; + c3_y ned_y = 8 - has_y; + c3_y cop_y = c3_min(ned_y, len_d); - // check for message completions - // - if ( mot_u->mes_u->has_d >= mot_u->mes_u->len_d ) { - _newt_poke_mess(mot_u); - } + memcpy(len_y + has_y, buf_y, cop_y); + buf_y += cop_y; + len_d -= cop_y; + ned_y -= cop_y; + + // moar bytes needed, yield + // + if ( ned_y ) { + mes_u->hed_u.has_y = (has_y + cop_y); + } + // length known, allocate message + // + else { + c3_d met_d = (((c3_d)len_y[0]) << 0) + | (((c3_d)len_y[1]) << 8) + | (((c3_d)len_y[2]) << 16) + | (((c3_d)len_y[3]) << 24) + | (((c3_d)len_y[4]) << 32) + | (((c3_d)len_y[5]) << 40) + | (((c3_d)len_y[6]) << 48) + | (((c3_d)len_y[7]) << 56); + + // must be non-zero, only 32 bits supported + // + c3_assert( met_d ); + c3_assert( 0xFFFFFFFFULL > met_d ); + + // await body + // + _newt_mess_tail(mes_u, met_d); + } + } break; + + case u3_mess_tail: { + u3_meat* met_u = mes_u->tal_u.met_u; + c3_d has_d = mes_u->tal_u.has_d; + c3_d ned_d = met_u->len_d - has_d; + c3_d cop_d = c3_min(ned_d, len_d); + + memcpy(met_u->hun_y + has_d, buf_y, cop_d); + buf_y += cop_d; + len_d -= cop_d; + ned_d -= cop_d; + + // moar bytes needed, yield + // + if ( ned_d ) { + mes_u->tal_u.has_d = (has_d + cop_d); + } + // message completed, enqueue and await next header + // + else { + _newt_meat_plan(mot_u, met_u); + _newt_mess_head(mes_u); + } + } break; } } } @@ -259,7 +202,10 @@ _newt_read_cb(uv_stream_t* str_u, c3_free(buf_u->base); } else { - u3_newt_decode(mot_u, (c3_y*)buf_u->base, (c3_w)len_i); + u3_newt_decode(mot_u, (c3_y*)buf_u->base, (c3_d)len_i); + c3_free(buf_u->base); + + _newt_meat_poke(mot_u); } } @@ -282,9 +228,17 @@ _newt_alloc(uv_handle_t* had_u, void u3_newt_read(u3_moat* mot_u) { - mot_u->mes_u = 0; - mot_u->len_d = 0; - mot_u->rag_y = 0; + // zero-initialize completed msg queue + // + mot_u->ent_u = mot_u->ext_u = 0; + + // store pointer for queue timer callback + // + mot_u->tim_u.data = mot_u; + + // await next msg header + // + _newt_mess_head(&mot_u->mes_u); { c3_i sas_i; diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index ccde6dda8..c4bca1c0d 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -144,6 +144,8 @@ main(c3_i argc, c3_c* argv[]) { c3_i err_i; + err_i = uv_timer_init(lup_u, &inn_u.tim_u); + c3_assert(!err_i); err_i = uv_pipe_init(lup_u, &inn_u.pyp_u, 0); c3_assert(!err_i); uv_pipe_open(&inn_u.pyp_u, inn_i); From 8ef8987b5432b458e8b36b2d3167eb0e6dc849df Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 8 Jun 2020 20:14:39 -0700 Subject: [PATCH 157/257] newt: adds synchronous read, used in serf with blocking writes --- pkg/urbit/include/vere/vere.h | 7 +- pkg/urbit/vere/newt.c | 125 ++++++++++++++++++++++++++-------- pkg/urbit/worker/main.c | 4 +- 3 files changed, 104 insertions(+), 32 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 4c8cee2f6..a61e497c8 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -1084,7 +1084,12 @@ void u3_newt_write(u3_mojo* moj_u, u3_atom mat); - /* u3_newt_read(): activate reading on input stream. + /* u3_newt_read_sync(): start reading; multiple msgs synchronous. + */ + void + u3_newt_read_sync(u3_moat* mot_u); + + /* u3_newt_read(): start reading; each msg asynchronous. */ void u3_newt_read(u3_moat* mot_u); diff --git a/pkg/urbit/vere/newt.c b/pkg/urbit/vere/newt.c index 92618016f..62ff6a218 100644 --- a/pkg/urbit/vere/newt.c +++ b/pkg/urbit/vere/newt.c @@ -68,13 +68,39 @@ _newt_meat_plan(u3_moat* mot_u, u3_meat* met_u) } } -static void -_newt_meat_next_cb(uv_timer_t* tim_u); - /* _newt_meat_poke(): deliver completed msg. */ static void -_newt_meat_poke(u3_moat* mot_u) +_newt_meat_poke(u3_moat* mot_u, u3_meat* met_u) +{ + u3_noun mat = u3i_bytes((c3_w)met_u->len_d, met_u->hun_y); + mot_u->pok_f(mot_u->ptr_v, mat); + c3_free(met_u); +} + +/* _newt_meat_next_sync(): deliver completed msgs, synchronously. +*/ +static void +_newt_meat_next_sync(u3_moat* mot_u) +{ + u3_meat* met_u = mot_u->ext_u; + + while ( met_u ) { + u3_meat* nex_u = met_u->nex_u; + _newt_meat_poke(mot_u, met_u); + met_u = nex_u; + } + + mot_u->ent_u = mot_u->ext_u = 0; +} + +static void +_newt_meat_next_cb(uv_timer_t* tim_u); + +/* _newt_meat_next(): deliver completed msgs, asynchronously. +*/ +static void +_newt_meat_next(u3_moat* mot_u) { u3_meat* met_u = mot_u->ext_u; @@ -88,9 +114,7 @@ _newt_meat_poke(u3_moat* mot_u) mot_u->ent_u = 0; } - u3_noun mat = u3i_bytes((c3_w)met_u->len_d, met_u->hun_y); - mot_u->pok_f(mot_u->ptr_v, mat); - c3_free(met_u); + _newt_meat_poke(mot_u, met_u); } } @@ -100,7 +124,7 @@ static void _newt_meat_next_cb(uv_timer_t* tim_u) { u3_moat* mot_u = tim_u->data; - _newt_meat_poke(mot_u); + _newt_meat_next(mot_u); } /* u3_newt_decode(): decode a (partial) length-prefixed byte buffer @@ -181,7 +205,48 @@ u3_newt_decode(u3_moat* mot_u, c3_y* buf_y, c3_d len_d) } } -/* _newt_read_cb(): stream input callback. +/* _newt_read(): handle async read result. +*/ +static c3_o +_newt_read(u3_moat* mot_u, + ssize_t len_i, + const uv_buf_t* buf_u) +{ + if ( 0 > len_i ) { + c3_free(buf_u->base); + uv_read_stop((uv_stream_t*)&mot_u->pyp_u); + fprintf(stderr, "newt: read failed %s\r\n", uv_strerror(len_i)); + mot_u->bal_f(mot_u->ptr_v, uv_strerror(len_i)); + return c3n; + } + // EAGAIN/EWOULDBLOCK + // + else if ( 0 == len_i ) { + c3_free(buf_u->base); + return c3n; + } + else { + u3_newt_decode(mot_u, (c3_y*)buf_u->base, (c3_d)len_i); + c3_free(buf_u->base); + return c3y; + } +} + +/* _newt_read_sync_cb(): async read callback, sync msg delivery. +*/ +static void +_newt_read_sync_cb(uv_stream_t* str_u, + ssize_t len_i, + const uv_buf_t* buf_u) +{ + u3_moat* mot_u = (void *)str_u; + + if ( c3y == _newt_read(mot_u, len_i, buf_u) ) { + _newt_meat_next_sync(mot_u); + } +} + +/* _newt_read_cb(): async read callback, async msg delivery. */ static void _newt_read_cb(uv_stream_t* str_u, @@ -190,22 +255,8 @@ _newt_read_cb(uv_stream_t* str_u, { u3_moat* mot_u = (void *)str_u; - if ( 0 > len_i ) { - c3_free(buf_u->base); - uv_read_stop(str_u); - fprintf(stderr, "newt: read failed %s\r\n", uv_strerror(len_i)); - mot_u->bal_f(mot_u->ptr_v, uv_strerror(len_i)); - } - // EAGAIN/EWOULDBLOCK - // - else if ( 0 == len_i ) { - c3_free(buf_u->base); - } - else { - u3_newt_decode(mot_u, (c3_y*)buf_u->base, (c3_d)len_i); - c3_free(buf_u->base); - - _newt_meat_poke(mot_u); + if ( c3y == _newt_read(mot_u, len_i, buf_u) ) { + _newt_meat_next(mot_u); } } @@ -223,10 +274,8 @@ _newt_alloc(uv_handle_t* had_u, *buf_u = uv_buf_init(ptr_v, len_i); } -/* u3_newt_read(): start stream reading. -*/ -void -u3_newt_read(u3_moat* mot_u) +static void +_newt_read_init(u3_moat* mot_u, uv_read_cb read_cb_f) { // zero-initialize completed msg queue // @@ -245,7 +294,7 @@ u3_newt_read(u3_moat* mot_u) if ( 0 != (sas_i = uv_read_start((uv_stream_t*)&mot_u->pyp_u, _newt_alloc, - _newt_read_cb)) ) + read_cb_f)) ) { fprintf(stderr, "newt: read failed %s\r\n", uv_strerror(sas_i)); mot_u->bal_f(mot_u->ptr_v, uv_strerror(sas_i)); @@ -253,6 +302,22 @@ u3_newt_read(u3_moat* mot_u) } } +/* u3_newt_read_sync(): start reading; multiple msgs synchronous. +*/ +void +u3_newt_read_sync(u3_moat* mot_u) +{ + _newt_read_init(mot_u, _newt_read_sync_cb); +} + +/* u3_newt_read(): start reading; each msg asynchronous. +*/ +void +u3_newt_read(u3_moat* mot_u) +{ + _newt_read_init(mot_u, _newt_read_cb); +} + /* n_req: write request for newt */ typedef struct _n_req { diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index c4bca1c0d..98fc6cbe9 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -153,6 +153,8 @@ main(c3_i argc, c3_c* argv[]) err_i = uv_pipe_init(lup_u, &out_u.pyp_u, 0); c3_assert(!err_i); uv_pipe_open(&out_u.pyp_u, out_i); + + uv_stream_set_blocking((uv_stream_t*)&out_u.pyp_u, 1); } // set up writing @@ -241,7 +243,7 @@ main(c3_i argc, c3_c* argv[]) // start reading // - u3_newt_read(&inn_u); + u3_newt_read_sync(&inn_u); // enter loop // From 00fefce3344d3c3f2e015b4b979292cb8cca3ca4 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 11 Jun 2020 14:45:36 -0700 Subject: [PATCH 158/257] serf: plugs leak of error-notification event --- pkg/urbit/worker/serf.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 9a22b937e..a0a4577a8 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -583,7 +583,7 @@ _serf_work(u3_serf* sef_u, u3_noun job) c3_assert( sef_u->sen_d == sef_u->dun_d); sef_u->sen_d++; - gon = _serf_poke(sef_u, "work", job); + gon = _serf_poke(sef_u, "work", job); // retain // event accepted // @@ -613,7 +613,7 @@ _serf_work(u3_serf* sef_u, u3_noun job) // job = _serf_make_crud(job, dud); - gon = _serf_poke(sef_u, "crud", u3k(job)); + gon = _serf_poke(sef_u, "crud", job); // retain // error notification accepted // From f48dd41ca8dd66063c23213915cf6a823f2452de Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 11 Jun 2020 15:14:03 -0700 Subject: [PATCH 159/257] serf: refactors %work $writ handling --- pkg/urbit/worker/serf.c | 61 +++++++++++++++++++++-------------------- 1 file changed, 32 insertions(+), 29 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index a0a4577a8..1c0ea2114 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -488,6 +488,24 @@ _serf_sure_core(u3_serf* sef_u, u3_noun cor) sef_u->mut_o = c3y; } +/* _serf_sure(): event succeeded, save state and process effects. +*/ +static u3_noun +_serf_sure(u3_serf* sef_u, c3_w pre_w, u3_noun par) +{ + // vir/(list ovum) list of effects + // cor/arvo arvo core + // + u3_noun vir, cor; + u3x_cell(par, &vir, &cor); + + _serf_sure_core(sef_u, u3k(cor)); + vir = _serf_sure_feck(sef_u, pre_w, u3k(vir)); + + u3z(par); + return vir; +} + /* _serf_make_crud(): */ static u3_noun @@ -572,11 +590,7 @@ static u3_noun _serf_work(u3_serf* sef_u, u3_noun job) { u3_noun gon; - c3_w pre_w = u3a_open(u3R); - - // %work must be performed against an extant kernel - // - c3_assert( 0 != sef_u->mug_l); + c3_w pre_w = u3a_open(u3R); // event numbers must be continuous // @@ -588,18 +602,11 @@ _serf_work(u3_serf* sef_u, u3_noun job) // event accepted // if ( u3_blip == u3h(gon) ) { - // vir/(list ovum) list of effects - // cor/arvo arvo core - // - u3_noun vir, cor; - u3x_trel(gon, 0, &vir, &cor); - - _serf_sure_core(sef_u, u3k(cor)); - vir = _serf_sure_feck(sef_u, pre_w, u3k(vir)); + u3_noun vir = _serf_sure(sef_u, pre_w, u3k(u3t(gon))); u3z(gon); u3z(job); return u3nc(c3__done, u3nt(u3i_chubs(1, &sef_u->dun_d), - u3i_words(1, &sef_u->mug_l), + sef_u->mug_l, vir)); } // event rejected @@ -609,7 +616,7 @@ _serf_work(u3_serf* sef_u, u3_noun job) // u3_noun dud = u3k(gon); - // XX reclaim/pack on %meme first? + // XX reclaim on %meme first? // job = _serf_make_crud(job, dud); @@ -618,18 +625,11 @@ _serf_work(u3_serf* sef_u, u3_noun job) // error notification accepted // if ( u3_blip == u3h(gon) ) { - // vir/(list ovum) list of effects - // cor/arvo arvo core - // - u3_noun vir, cor; - u3x_trel(gon, 0, &vir, &cor); - - _serf_sure_core(sef_u, u3k(cor)); - vir = _serf_sure_feck(sef_u, pre_w, u3k(vir)); + u3_noun vir = _serf_sure(sef_u, pre_w, u3k(u3t(gon))); u3z(gon); u3z(dud); return u3nc(c3__swap, u3nq(u3i_chubs(1, &sef_u->dun_d), - u3i_words(1, &sef_u->mug_l), + sef_u->mug_l, job, vir)); } @@ -638,7 +638,7 @@ _serf_work(u3_serf* sef_u, u3_noun job) else { sef_u->sen_d = sef_u->dun_d; - // XX reclaim/pack on %meme ? + // XX reclaim on %meme ? // u3z(job); @@ -673,6 +673,10 @@ u3_serf_work(u3_serf* sef_u, u3_noun job) u3t_event_trace(lab_c, 'B'); } + // %work must be performed against an extant kernel + // + c3_assert( 0 != sef_u->mug_l); + pro = u3nc(c3__work, _serf_work(sef_u, job)); if ( tac_t ) { @@ -810,13 +814,13 @@ _serf_play_list(u3_serf* sef_u, u3_noun eve) // u3z(vev); return u3nc(c3__bail, u3nt(u3i_chubs(1, &sef_u->dun_d), - u3i_words(1, &sef_u->mug_l), + sef_u->mug_l, dud)); } } u3z(vev); - return u3nc(c3__done, u3i_words(1, &sef_u->mug_l)); + return u3nc(c3__done, sef_u->mug_l); } /* u3_serf_play(): apply event list, producing status. @@ -1092,8 +1096,7 @@ _serf_ripe(u3_serf* sef_u) ? 0 : u3r_mug(u3A->roc); - return u3nc(u3i_chubs(1, &sef_u->dun_d), - u3i_words(1, &sef_u->mug_l)); + return u3nc(u3i_chubs(1, &sef_u->dun_d), sef_u->mug_l); } /* u3_serf_init(): init or restore, producing status. From 19da74d1460713069e2cffcc92d86bbf3b3ad06c Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 11 Jun 2020 16:01:19 -0700 Subject: [PATCH 160/257] serf: disables auto |pack, refactors loading from rock (-r) --- pkg/urbit/include/vere/serf.h | 7 ++- pkg/urbit/include/vere/vere.h | 5 ++ pkg/urbit/vere/pier.c | 3 - pkg/urbit/vere/term.c | 3 + pkg/urbit/worker/main.c | 49 +-------------- pkg/urbit/worker/serf.c | 113 ++++++++++++++++++++-------------- 6 files changed, 83 insertions(+), 97 deletions(-) diff --git a/pkg/urbit/include/vere/serf.h b/pkg/urbit/include/vere/serf.h index b49533e90..9fb6ef0c6 100644 --- a/pkg/urbit/include/vere/serf.h +++ b/pkg/urbit/include/vere/serf.h @@ -12,7 +12,7 @@ c3_d dun_d; // last event processed c3_l mug_l; // hash of state c3_o pac_o; // pack kernel - c3_o rec_o; // reclaim cash + c3_o rec_o; // reclaim cache c3_o mut_o; // mutated kerne u3_noun sac; // space measurementl } u3_serf; @@ -24,6 +24,11 @@ u3_noun u3_serf_init(u3_serf* sef_u); + /* u3_serf_unpack(): initialize from rock at [eve_d]. + */ + void + u3_serf_unpack(u3_serf* sef_u, c3_d eve_d); + /* u3_serf_writ(): apply writ [wit], producing plea [*pel] on c3y. */ c3_o diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index a61e497c8..32b5cfc84 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -1133,6 +1133,11 @@ c3_o u3_pier_save(u3_pier* pir_u); + /* u3_pier_pack(): save a portable snapshot. + */ + c3_o + u3_pier_pack(u3_pier* pir_u); + /* u3_pier_stub(): get the One Pier for unreconstructed code. */ u3_pier* diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 7b98fdfab..6932e641e 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -574,9 +574,6 @@ _pier_play_read(u3_play* pay_u) } } -c3_o -u3_pier_pack(u3_pier* pir_u); - /* _pier_play(): send a batch of events to the worker for log replay. */ static void diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index d29ee128b..36c3ce090 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -1401,6 +1401,9 @@ _term_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) // case c3__pack: { ret_o = c3y; + // XX would be + // + // u3_assure(u3_pier_pack(car_u->pir_u)); } break; } } diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index 98fc6cbe9..d4f89a0f8 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -175,54 +175,7 @@ main(c3_i argc, c3_c* argv[]) u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); if ( eve_d ) { - c3_o roc_o; - c3_c nam_c[8193]; - snprintf(nam_c, 8192, "%s/.urb/roc/%" PRIu64 ".jam", u3V.dir_c, eve_d); - - struct stat buf_b; - c3_i fid_i = open(nam_c, O_RDONLY, 0644); - - if ( (fid_i < 0) || (fstat(fid_i, &buf_b) < 0) ) { - fprintf(stderr, "serf: rock: %s not found\r\n", nam_c); - roc_o = c3n; - } - else { - fprintf(stderr, "serf: rock: %s found\r\n", nam_c); - roc_o = c3y; - } - - close(fid_i); - - - if ( c3y == roc_o ) { - if ( c3n == u3e_hold() ) { - fprintf(stderr, "serf: unable to backup checkpoint\r\n"); - } - else { - u3m_wipe(); - - if ( c3n == u3m_rock_load(u3V.dir_c, eve_d) ) { - fprintf(stderr, "serf: compaction failed, restoring checkpoint\r\n"); - - if ( c3n == u3e_fall() ) { - fprintf(stderr, "serf: unable to restore checkpoint\r\n"); - c3_assert(0); - } - } - - if ( c3n == u3e_drop() ) { - fprintf(stderr, "serf: warning: orphaned backup checkpoint file\r\n"); - } - - fprintf(stderr, "serf (%" PRIu64 "): compacted loom\r\n", eve_d); - - u3V.sen_d = u3V.dun_d = eve_d; - - // save now for flexibility - // - u3e_save(); - } - } + u3_serf_unpack(&u3V, eve_d); } } diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 1c0ea2114..0c0f6fd11 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -290,9 +290,7 @@ _serf_static_grab(void) static void _serf_pack(u3_serf* sef_u) { - // skip for now - // - // _serf_static_grab(); + _serf_static_grab(); u3l_log("serf (%" PRIu64 "): compacting loom\r\n", sef_u->dun_d); @@ -301,39 +299,11 @@ _serf_pack(u3_serf* sef_u) return; } - if ( c3n == u3e_hold() ) { - u3l_log("serf: unable to backup checkpoint\r\n"); - return; - } - - u3m_wipe(); - - if ( c3n == u3m_rock_load(sef_u->dir_c, sef_u->dun_d) ) { - u3l_log("serf: compaction failed, restoring checkpoint\r\n"); - - if ( c3n == u3e_fall() ) { - fprintf(stderr, "serf: unable to restore checkpoint\r\n"); - c3_assert(0); - } - } - - if ( c3n == u3e_drop() ) { - u3l_log("serf: warning: orphaned backup checkpoint file\r\n"); - } - - // leave these for now - // - // if ( c3n == u3m_rock_drop(sef_u->dir_c, sef_u->dun_d) ) { - // u3l_log("serf: warning: orphaned state file\r\n"); - // } + u3_serf_unpack(sef_u, sef_u->dun_d); u3l_log("serf (%" PRIu64 "): compacted loom\r\n", sef_u->dun_d); _serf_static_grab(); - - // save now for flexibility - // - u3e_save(); } /* u3_serf_post(): update serf state post-writ. @@ -346,7 +316,7 @@ u3_serf_post(u3_serf* sef_u) sef_u->rec_o = c3n; } - // XX this runs on replay too + // XX this runs on replay too, |mass s/b elsewhere // if ( c3y == sef_u->mut_o ) { sef_u->mut_o = c3n; @@ -432,14 +402,11 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) if ( (pre_w > low_w) && !(pos_w > low_w) ) { // XX set flag(s) in u3V so we don't repeat endlessly? - // XX pack here too? // - pac_o = c3y; rec_o = c3y; pri = 1; } else if ( (pre_w > hig_w) && !(pos_w > hig_w) ) { - pac_o = c3y; rec_o = c3y; pri = 0; } @@ -453,12 +420,6 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) rec_o = c3y; } - // pack every 20K events - // - if ( 0 == (sef_u->dun_d % 20000ULL) ) { - pac_o = c3y; - } - // notify daemon of memory pressure via "fake" effect // if ( u3_none != pri ) { @@ -782,7 +743,7 @@ _serf_play_list(u3_serf* sef_u, u3_noun eve) _serf_sure_core(sef_u, u3k(cor)); - // process effects to set pack/reclaim flags + // process effects to set u3_serf_post flags // u3z(_serf_sure_feck(sef_u, pre_w, u3k(vir))); @@ -806,8 +767,7 @@ _serf_play_list(u3_serf* sef_u, u3_noun eve) u3z(gon); - // XX reclaim/pack on meme - // XX retry? + // XX reclaim on meme ? // // send failure notification @@ -964,6 +924,8 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) return c3y; } + // NB: the %pack $writ only saves the rock, it doesn't load it + // case c3__pack: { c3_d eve_d; @@ -1099,6 +1061,67 @@ _serf_ripe(u3_serf* sef_u) return u3nc(u3i_chubs(1, &sef_u->dun_d), sef_u->mug_l); } +/* u3_serf_unpack(): initialize from rock at [eve_d]. +*/ +void +u3_serf_unpack(u3_serf* sef_u, c3_d eve_d) +{ + c3_o roc_o; + c3_c nam_c[8193]; + snprintf(nam_c, 8192, "%s/.urb/roc/%" PRIu64 ".jam", sef_u->dir_c, eve_d); + + struct stat buf_b; + c3_i fid_i = open(nam_c, O_RDONLY, 0644); + + if ( (fid_i < 0) || (fstat(fid_i, &buf_b) < 0) ) { + fprintf(stderr, "serf: rock: %s not found\r\n", nam_c); + roc_o = c3n; + } + else { + fprintf(stderr, "serf: rock: %s found\r\n", nam_c); + roc_o = c3y; + } + + close(fid_i); + + + if ( c3y == roc_o ) { + if ( c3n == u3e_hold() ) { + fprintf(stderr, "serf: unable to backup checkpoint\r\n"); + } + else { + u3m_wipe(); + + if ( c3n == u3m_rock_load(sef_u->dir_c, eve_d) ) { + fprintf(stderr, "serf: compaction failed, restoring checkpoint\r\n"); + + if ( c3n == u3e_fall() ) { + fprintf(stderr, "serf: unable to restore checkpoint\r\n"); + c3_assert(0); + } + } + + if ( c3n == u3e_drop() ) { + fprintf(stderr, "serf: warning: orphaned backup checkpoint file\r\n"); + } + + // leave rocks on disk + // + // if ( c3n == u3m_rock_drop(sef_u->dir_c, sef_u->dun_d) ) { + // u3l_log("serf: warning: orphaned state file\r\n"); + // } + + fprintf(stderr, "serf (%" PRIu64 "): compacted loom\r\n", eve_d); + + sef_u->sen_d = sef_u->dun_d = eve_d; + + // save now for flexibility + // + u3e_save(); + } + } +} + /* u3_serf_init(): init or restore, producing status. */ u3_noun From 6ea2acea86e94b91306b58a79061133712f9e279 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 11 Jun 2020 17:11:48 -0700 Subject: [PATCH 161/257] term: bypass terminfo, use direct ANSI escape sequences --- pkg/urbit/vere/term.c | 61 ++++++++++++++++--------------------------- 1 file changed, 23 insertions(+), 38 deletions(-) diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index 36c3ce090..a81180cfe 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -114,52 +114,37 @@ u3_term_log_init(void) uv_pipe_open(&(uty_u->pop_u), uty_u->fid_i); } - // Configure horrible stateful terminfo api. - // - { - if ( 0 != setupterm(0, 2, 0) ) { - c3_assert(!"init-setupterm"); - } - } - // Load terminfo strings. // { c3_w len_w; -# define _utfo(way, nam) \ - { \ - uty_u->ufo_u.way.nam##_y = (const c3_y *) tigetstr(#nam); \ - c3_assert(uty_u->ufo_u.way.nam##_y); \ - } - uty_u->ufo_u.inn.max_w = 0; - _utfo(inn, kcuu1); - _utfo(inn, kcud1); - _utfo(inn, kcub1); - _utfo(inn, kcuf1); - - _utfo(out, clear); - _utfo(out, el); - // _utfo(out, el1); - _utfo(out, ed); - _utfo(out, bel); - _utfo(out, cub1); - _utfo(out, cuf1); - _utfo(out, cuu1); - _utfo(out, cud1); - // _utfo(out, cub); - // _utfo(out, cuf); - - // Terminfo chronically reports the wrong sequence for arrow - // keys on xterms. Drastic fix for ridiculous unacceptable bug. - // Yes, we could fix this with smkx/rmkx, but this is retarded as well. + // escape sequences we use + // (as reported by the terminfo database we bundled) + // { - uty_u->ufo_u.inn.kcuu1_y = (const c3_y*)"\033[A"; - uty_u->ufo_u.inn.kcud1_y = (const c3_y*)"\033[B"; - uty_u->ufo_u.inn.kcuf1_y = (const c3_y*)"\033[C"; - uty_u->ufo_u.inn.kcub1_y = (const c3_y*)"\033[D"; + uty_u->ufo_u.out.clear_y = (const c3_y*)"\033[H\033[2J"; + uty_u->ufo_u.out.el_y = (const c3_y*)"\033[K"; + // uty_u->ufo_u.out.el1_y = (const c3_y*)"\033[1K"; + uty_u->ufo_u.out.ed_y = (const c3_y*)"\033[J"; + uty_u->ufo_u.out.bel_y = (const c3_y*)"\x7"; + uty_u->ufo_u.out.cub1_y = (const c3_y*)"\x8"; + uty_u->ufo_u.out.cuf1_y = (const c3_y*)"\033[C"; + uty_u->ufo_u.out.cuu1_y = (const c3_y*)"\033[A"; + uty_u->ufo_u.out.cud1_y = (const c3_y*)"\xa"; + // uty_u->ufo_u.out.cub_y = (const c3_y*)"\033[%p1%dD"; + // uty_u->ufo_u.out.cuf_y = (const c3_y*)"\033[%p1%dC"; + } + + // NB: terminfo reports the wrong sequence for arrow keys on xterms. + // + { + uty_u->ufo_u.inn.kcuu1_y = (const c3_y*)"\033[A"; // terminfo reports "\033OA" + uty_u->ufo_u.inn.kcud1_y = (const c3_y*)"\033[B"; // terminfo reports "\033OB" + uty_u->ufo_u.inn.kcuf1_y = (const c3_y*)"\033[C"; // terminfo reports "\033OC" + uty_u->ufo_u.inn.kcub1_y = (const c3_y*)"\033[D"; // terminfo reports "\033OD" } uty_u->ufo_u.inn.max_w = 0; From 8fac63661f1f64d80c95e5ed2aa5bf6c6998ffe1 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 11 Jun 2020 19:25:37 -0700 Subject: [PATCH 162/257] vere: removes ncurses dependency --- nix/deps-env.nix | 2 +- nix/pkgs/urbit/default.nix | 2 +- nix/pkgs/urbit/release.nix | 3 +-- nix/pkgs/urbit/release.sh | 1 - nix/release.nix | 2 +- pkg/urbit/configure | 2 +- pkg/urbit/daemon/main.c | 9 --------- pkg/urbit/vere/ames.c | 3 --- pkg/urbit/vere/behn.c | 3 --- pkg/urbit/vere/foil.c | 2 -- pkg/urbit/vere/fore.c | 3 --- pkg/urbit/vere/hind.c | 3 --- pkg/urbit/vere/newt.c | 3 --- pkg/urbit/vere/term.c | 2 -- pkg/urbit/vere/time.c | 3 --- pkg/urbit/vere/unix.c | 2 -- pkg/urbit/vere/walk.c | 3 --- pkg/urbit/worker/serf.c | 3 --- sh/cross | 3 --- 19 files changed, 5 insertions(+), 49 deletions(-) diff --git a/nix/deps-env.nix b/nix/deps-env.nix index cd945bceb..77a7d8bac 100644 --- a/nix/deps-env.nix +++ b/nix/deps-env.nix @@ -10,7 +10,7 @@ let libs = with pkgs; - [ openssl zlib curl gmp scrypt libsigsegv ncurses openssl zlib lmdb ]; + [ openssl zlib curl gmp scrypt libsigsegv openssl zlib lmdb ]; osx = with pkgs; diff --git a/nix/pkgs/urbit/default.nix b/nix/pkgs/urbit/default.nix index ada88ba96..3843be6bc 100644 --- a/nix/pkgs/urbit/default.nix +++ b/nix/pkgs/urbit/default.nix @@ -18,7 +18,7 @@ let deps = with pkgs; - [ curl gmp libsigsegv ncurses openssl zlib lmdb ]; + [ curl gmp libsigsegv openssl zlib lmdb ]; vendor = [ argon2 softfloat3 ed25519 ent ge-additions libaes_siv h2o scrypt uv murmur3 secp256k1 sni ivory-header ca-header ]; diff --git a/nix/pkgs/urbit/release.nix b/nix/pkgs/urbit/release.nix index b42bbc8cf..40517aba8 100644 --- a/nix/pkgs/urbit/release.nix +++ b/nix/pkgs/urbit/release.nix @@ -12,7 +12,7 @@ let crossdeps = with env; - [ curl libgmp libsigsegv ncurses openssl zlib lmdb ]; + [ curl libgmp libsigsegv openssl zlib lmdb ]; vendor = with deps; @@ -27,7 +27,6 @@ env.make_derivation { MEMORY_DEBUG = debug; CPU_DEBUG = debug; EVENT_TIME_DEBUG = false; - NCURSES = env.ncurses; name = "${name}-${env_name}"; exename = name; diff --git a/nix/pkgs/urbit/release.sh b/nix/pkgs/urbit/release.sh index 76b35040a..4bff817e4 100644 --- a/nix/pkgs/urbit/release.sh +++ b/nix/pkgs/urbit/release.sh @@ -17,6 +17,5 @@ bash ./configure make build/urbit build/urbit-worker -j8 mkdir -p $out/bin -cp -r $NCURSES/share/terminfo $out/bin/$exename-terminfo cp ./build/urbit $out/bin/$exename cp ./build/urbit-worker $out/bin/$exename-worker diff --git a/nix/release.nix b/nix/release.nix index f71589ea9..2ccd1098b 100644 --- a/nix/release.nix +++ b/nix/release.nix @@ -33,7 +33,7 @@ let builds-for-platform = plat: plat.deps // { - inherit (plat.env) curl libgmp libsigsegv ncurses openssl zlib lmdb; + inherit (plat.env) curl libgmp libsigsegv openssl zlib lmdb; inherit (plat.env) cmake_toolchain; ent = ent plat; ge-additions = ge-additions plat; diff --git a/pkg/urbit/configure b/pkg/urbit/configure index ebf59d23d..90e863463 100755 --- a/pkg/urbit/configure +++ b/pkg/urbit/configure @@ -6,7 +6,7 @@ URBIT_VERSION="0.10.5" deps=" \ curl gmp sigsegv argon2 ed25519 ent h2o scrypt sni uv murmur3 secp256k1 \ - softfloat3 ncurses ssl crypto z lmdb ge-additions aes_siv \ + softfloat3 ssl crypto z lmdb ge-additions aes_siv \ " headers=" \ diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 17de3f5f7..518946844 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -9,9 +9,7 @@ #include #include #include -#include #include -#include #include #include #include @@ -451,7 +449,6 @@ report(void) (libsigsegv_version >> 8) & 0xff, libsigsegv_version & 0xff); printf("openssl: %s\n", SSLeay_version(SSLEAY_VERSION)); - printf("curses: %s\n", curses_version()); printf("libuv: %s\n", uv_version_string()); printf("libh2o: %d.%d.%d\n", H2O_LIBRARY_VERSION_MAJOR, @@ -603,12 +600,6 @@ main(c3_i argc, u3_Host.wrk_c = c3_malloc(worker_exe_len); snprintf(u3_Host.wrk_c, worker_exe_len, "%s-worker", argv[0]); - // Set TERMINFO_DIRS environment variable - c3_i terminfo_len = 1 + strlen(argv[0]) + strlen("-terminfo"); - c3_c terminfo_dir[terminfo_len]; - snprintf(terminfo_dir, terminfo_len, "%s-terminfo", argv[0]); - setenv("TERMINFO_DIRS", terminfo_dir, 1); - if ( c3y == u3_Host.ops_u.dem ) { _fork_into_background_process(); } diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/ames.c index ce6be2ee0..59e306616 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/ames.c @@ -9,9 +9,6 @@ #include #include #include -#include -#include -#include #include "all.h" #include "vere/vere.h" diff --git a/pkg/urbit/vere/behn.c b/pkg/urbit/vere/behn.c index eed3bfb10..3d09f2ef1 100644 --- a/pkg/urbit/vere/behn.c +++ b/pkg/urbit/vere/behn.c @@ -6,9 +6,6 @@ #include #include #include -#include -#include -#include #include #include "all.h" diff --git a/pkg/urbit/vere/foil.c b/pkg/urbit/vere/foil.c index 4bd4a401a..b6647eb40 100644 --- a/pkg/urbit/vere/foil.c +++ b/pkg/urbit/vere/foil.c @@ -16,8 +16,6 @@ #include #include #include -#include -#include #include #include #include diff --git a/pkg/urbit/vere/fore.c b/pkg/urbit/vere/fore.c index 3666360a9..5cbac0144 100644 --- a/pkg/urbit/vere/fore.c +++ b/pkg/urbit/vere/fore.c @@ -6,9 +6,6 @@ #include #include #include -#include -#include -#include #include #include "all.h" diff --git a/pkg/urbit/vere/hind.c b/pkg/urbit/vere/hind.c index 342c7d33d..082a718ee 100644 --- a/pkg/urbit/vere/hind.c +++ b/pkg/urbit/vere/hind.c @@ -6,9 +6,6 @@ #include #include #include -#include -#include -#include #include #include "all.h" diff --git a/pkg/urbit/vere/newt.c b/pkg/urbit/vere/newt.c index 62ff6a218..93b343213 100644 --- a/pkg/urbit/vere/newt.c +++ b/pkg/urbit/vere/newt.c @@ -24,9 +24,6 @@ #include #include #include -#include -#include -#include #include "all.h" #include "vere/vere.h" diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/term.c index a81180cfe..9e30f3b23 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/term.c @@ -8,9 +8,7 @@ #include #include #include -#include #include -#include #include "all.h" #include "vere/vere.h" diff --git a/pkg/urbit/vere/time.c b/pkg/urbit/vere/time.c index 2a36cf822..e67046ba2 100644 --- a/pkg/urbit/vere/time.c +++ b/pkg/urbit/vere/time.c @@ -6,9 +6,6 @@ #include #include #include -#include -#include -#include #include "all.h" #include "vere/vere.h" diff --git a/pkg/urbit/vere/unix.c b/pkg/urbit/vere/unix.c index 381c7376c..77d3d9f0e 100644 --- a/pkg/urbit/vere/unix.c +++ b/pkg/urbit/vere/unix.c @@ -7,8 +7,6 @@ #include #include #include -#include -#include #include #include #include diff --git a/pkg/urbit/vere/walk.c b/pkg/urbit/vere/walk.c index 1456d9aa8..5ed14b016 100644 --- a/pkg/urbit/vere/walk.c +++ b/pkg/urbit/vere/walk.c @@ -6,9 +6,6 @@ #include #include #include -#include -#include -#include #include #include "all.h" diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 0c0f6fd11..8cb088efd 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -15,9 +15,6 @@ #include #include #include -#include -#include -#include #include "all.h" #include diff --git a/sh/cross b/sh/cross index c2f7f12e9..28d1aa877 100755 --- a/sh/cross +++ b/sh/cross @@ -26,6 +26,3 @@ res=$(release "$env.$pkg") mkdir -p ./cross/$env traced cp -f $res/bin/$pkg ./cross/$env/$pkg traced cp -f $res/bin/$pkg-worker ./cross/$env/$pkg-worker -traced cp -r $res/bin/$pkg-terminfo ./cross/$env/$pkg-terminfo - -chmod -R u+wr ./cross/$env/$pkg-terminfo From 6e4c8361dd2fe7dbcde1dd938b7caebf3afba173 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 11 Jun 2020 20:31:26 -0700 Subject: [PATCH 163/257] build: remove duplicate zlib dependency declaration --- nix/deps-env.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nix/deps-env.nix b/nix/deps-env.nix index 77a7d8bac..c5d9b8c21 100644 --- a/nix/deps-env.nix +++ b/nix/deps-env.nix @@ -10,7 +10,7 @@ let libs = with pkgs; - [ openssl zlib curl gmp scrypt libsigsegv openssl zlib lmdb ]; + [ openssl curl gmp scrypt libsigsegv openssl zlib lmdb ]; osx = with pkgs; From c523c90bf9019a0c944981a1dadd0f6a1949e6fa Mon Sep 17 00:00:00 2001 From: ~siprel Date: Fri, 12 Jun 2020 18:33:10 +0000 Subject: [PATCH 164/257] urbit-termsize: Change test executable name. --- pkg/hs/urbit-termsize/package.yaml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/pkg/hs/urbit-termsize/package.yaml b/pkg/hs/urbit-termsize/package.yaml index 843a0bbb5..83efc8c17 100644 --- a/pkg/hs/urbit-termsize/package.yaml +++ b/pkg/hs/urbit-termsize/package.yaml @@ -18,9 +18,8 @@ library: source-dirs: lib executables: - live-termsize: + urbit-test-termsize-updates: main: Main.hs source-dirs: app dependencies: - urbit-termsize - ghc-options: "-threaded -rtsopts -with-rtsopts=-N" From eaa926a0862b720ef94eb1c6ccebae2bd80498d5 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 12 Jun 2020 21:55:51 -0700 Subject: [PATCH 165/257] noun: road-size printfs on u3m_fall --- pkg/urbit/noun/manage.c | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/pkg/urbit/noun/manage.c b/pkg/urbit/noun/manage.c index 663d16c29..a7b8b803e 100644 --- a/pkg/urbit/noun/manage.c +++ b/pkg/urbit/noun/manage.c @@ -788,6 +788,13 @@ u3m_leap(c3_w pad_w) #endif } +void +_print_diff(c3_c* cap_c, c3_w a, c3_w b) +{ + c3_w diff = apar_p); #if 0 + /* If you're printing a lot of these you need to change + * u3a_print_memory from fprintf to u3l_log + */ fprintf(stderr, "fall: from %s %p, to %s %p (cap 0x%x, was 0x%x)\r\n", _(u3a_is_north(u3R)) ? "north" : "south", u3R, @@ -803,6 +813,9 @@ u3m_fall() u3to(u3_road, u3R->par_p), u3R->hat_p, u3R->rut_p); + _print_diff("unused free", u3R->hat_p, u3R->cap_p); + _print_diff("freeing", u3R->rut_p, u3R->hat_p); + _print_diff("stack", u3R->cap_p, u3R->mat_p); #endif u3to(u3_road, u3R->par_p)->pro.nox_d += u3R->pro.nox_d; From 6e0cd4ef1a3501de994b7cf25170bebd0055ecd2 Mon Sep 17 00:00:00 2001 From: Jared Tobin Date: Sat, 13 Jun 2020 10:08:12 +0400 Subject: [PATCH 166/257] vere: increase LMDB mapsize to 1TB on macOS, linux Many ships have been observed bumping up against the existing mapsize limits. This results in a Vere crash via LMDB, which necessitates compiling a new binary with a higher mapsize if one wants to relaunch. There doesn't seem to be any serious penalty to setting this somewhere in the terabyte range, though. [1] In cases where the mapsize exceeds the size of the disk, I infer from the LMDB docs that the database may simply be permitted to grow until it runs up against the disk limitations, which feels acceptable. I've tested this on macOS and Linux and the binary runs without issue, despite the mapsize being set far in excess of the disks I'm running on. [1]: https://lmdb.readthedocs.io/en/release/ --- pkg/urbit/vere/lmdb.c | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/pkg/urbit/vere/lmdb.c b/pkg/urbit/vere/lmdb.c index bf1e3b83f..36ba328c6 100644 --- a/pkg/urbit/vere/lmdb.c +++ b/pkg/urbit/vere/lmdb.c @@ -41,15 +41,12 @@ MDB_env* u3_lmdb_init(const char* log_path) return 0; } - // TODO: Start with forty gigabytes on macOS and sixty otherwise for the - // maximum event log size. We'll need to do something more sophisticated for - // real in the long term, though. + // Arbitrarily choosing 1TB as a "large enough" mapsize per the LMDB docs: // -#ifdef U3_OS_osx - const size_t lmdb_mapsize = 42949672960; -#else - const size_t lmdb_mapsize = 64424509440;; -#endif + // "[..] on 64-bit there is no penalty for making this huge (say 1TB)." + // + const size_t lmdb_mapsize = 1099511627776; + ret_w = mdb_env_set_mapsize(env, lmdb_mapsize); if (ret_w != 0) { u3l_log("lmdb: failed to set database size: %s\n", mdb_strerror(ret_w)); From 755b2f1347b376ffc1dec481361ecb05ec43306b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 16 Jun 2020 15:42:41 -0700 Subject: [PATCH 167/257] vere: track ovum queue depth per i/o driver --- pkg/urbit/include/vere/vere.h | 1 + pkg/urbit/vere/auto.c | 6 ++++++ 2 files changed, 7 insertions(+) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 32b5cfc84..870e75c64 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -529,6 +529,7 @@ c3_m nam_m; c3_o liv_o; u3_auto_cb io; // XX io_u; + c3_w dep_w; struct _u3_ovum* ent_u; struct _u3_ovum* ext_u; struct _u3_auto* nex_u; diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 743fdd528..7910fff2d 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -49,6 +49,7 @@ u3_auto_plan(u3_auto* car_u, egg_u->pre_u = egg_u->nex_u = 0; car_u->ent_u = car_u->ext_u = egg_u; + car_u->dep_w = 1; } else { egg_u->nex_u = 0; @@ -56,6 +57,7 @@ u3_auto_plan(u3_auto* car_u, car_u->ent_u->nex_u = egg_u; car_u->ent_u = egg_u; + car_u->dep_w++; } u3_pier_spin(car_u->pir_u); @@ -165,6 +167,8 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) egg_u->nex_u->pre_u = egg_u->pre_u; } + egg_u->car_u->dep_w--; + // notify driver if not self-caused // if ( egg_u->car_u && ( car_u != egg_u->car_u ) ) { @@ -196,9 +200,11 @@ u3_auto_next(u3_auto* car_u, u3_noun* ovo) if ( egg_u->nex_u ) { egg_u->nex_u->pre_u = 0; car_u->ext_u = egg_u->nex_u; + car_u->dep_w--; } else { car_u->ent_u = car_u->ext_u = 0; + car_u->dep_w = 0; } egg_u->nex_u = 0; From 82e06c31eb9e3a77e0a785898c44f8f74f97777b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 16 Jun 2020 15:42:58 -0700 Subject: [PATCH 168/257] ames: cap ovum queue at 1k, dropping oldest packets first --- pkg/urbit/vere/ames.c | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/ames.c index 59e306616..5d196f7a6 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/ames.c @@ -394,6 +394,22 @@ _ames_recv_cb(uv_udp_t* wax_u, } u3_auto_plan(&sam_u->car_u, 0, c3__a, wir, cad); + + // cap ovum queue at 1k, dropping oldest packets + // + { + u3_ovum* egg_u = sam_u->car_u.ext_u; + + while ( 1000 < sam_u->car_u.dep_w ) { + u3_ovum* nex_u = egg_u->nex_u; + + if ( c3__hear == u3h(egg_u->cad) ) { + u3_auto_drop(&sam_u->car_u, egg_u); + } + + egg_u = nex_u; + } + } } c3_free(buf_u->base); From 5e9b90f5a315435a428694d03e7f99331a84bcc9 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 16 Jun 2020 18:01:09 -0700 Subject: [PATCH 169/257] serf: disables incomplete "static grab" on boot --- pkg/urbit/worker/serf.c | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 8cb088efd..77d87d0ed 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -1135,17 +1135,19 @@ u3_serf_init(u3_serf* sef_u) rip = u3nt(c3__ripe, ver, _serf_ripe(sef_u)); } + // XX move to u3_serf_post() + // // measure/print static memory usage if < 1/2 of the loom is available // - { - c3_w pen_w = u3a_open(u3R); + // { + // c3_w pen_w = u3a_open(u3R); - if ( !(pen_w > (1 << 28)) ) { - fprintf(stderr, "\r\n"); - u3a_print_memory(stderr, "serf: contiguous free space", pen_w); - _serf_static_grab(); - } - } + // if ( !(pen_w > (1 << 28)) ) { + // fprintf(stderr, "\r\n"); + // u3a_print_memory(stderr, "serf: contiguous free space", pen_w); + // _serf_static_grab(); + // } + // } sef_u->pac_o = c3n; sef_u->rec_o = c3n; From 42213269ce3b25de3bccc9a5a8c28bc87999f46d Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 16 Jun 2020 18:47:12 -0700 Subject: [PATCH 170/257] ames: fix null-deref in capped queue --- pkg/urbit/vere/ames.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/ames.c index 5d196f7a6..edd2ac01b 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/ames.c @@ -400,7 +400,7 @@ _ames_recv_cb(uv_udp_t* wax_u, { u3_ovum* egg_u = sam_u->car_u.ext_u; - while ( 1000 < sam_u->car_u.dep_w ) { + while ( egg_u && (1000 < sam_u->car_u.dep_w) ) { u3_ovum* nex_u = egg_u->nex_u; if ( c3__hear == u3h(egg_u->cad) ) { From 5c9252e9861499553e434eb24810223e6cc115fd Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 16 Jun 2020 18:52:16 -0700 Subject: [PATCH 171/257] vere: fixes u3_auto_drop list-unlink implementation --- pkg/urbit/vere/auto.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 7910fff2d..080f0cf68 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -162,10 +162,16 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) if ( egg_u->pre_u ) { egg_u->pre_u->nex_u = egg_u->nex_u; } + else { + egg_u->car_u->ent_u = egg_u->nex_u; + } if ( egg_u->nex_u ) { egg_u->nex_u->pre_u = egg_u->pre_u; } + else { + egg_u->car_u->ext_u = egg_u->pre_u; + } egg_u->car_u->dep_w--; From e297458e74173e87f22f8f1a8820a91ec734cf86 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 17 Jun 2020 16:20:33 -0700 Subject: [PATCH 172/257] vere: stop leaking effects --- pkg/urbit/vere/pier.c | 1 + 1 file changed, 1 insertion(+) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 6932e641e..ded2d57b2 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -135,6 +135,7 @@ _pier_gift_kick(u3_work* wok_u) // XX dispose properly // + u3z(gif_u->act); c3_free(gif_u); } } From d23d518f48f48ade0296653ef0c7dbb47f932ef0 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 17 Jun 2020 16:31:09 -0700 Subject: [PATCH 173/257] vere: moves i/o drivers --- pkg/urbit/vere/{ => io}/ames.c | 0 pkg/urbit/vere/{ => io}/behn.c | 0 pkg/urbit/vere/{ => io}/cttp.c | 0 pkg/urbit/vere/{ => io}/fore.c | 0 pkg/urbit/vere/{ => io}/hind.c | 0 pkg/urbit/vere/{ => io}/http.c | 0 pkg/urbit/vere/{ => io}/term.c | 0 pkg/urbit/vere/{ => io}/unix.c | 0 8 files changed, 0 insertions(+), 0 deletions(-) rename pkg/urbit/vere/{ => io}/ames.c (100%) rename pkg/urbit/vere/{ => io}/behn.c (100%) rename pkg/urbit/vere/{ => io}/cttp.c (100%) rename pkg/urbit/vere/{ => io}/fore.c (100%) rename pkg/urbit/vere/{ => io}/hind.c (100%) rename pkg/urbit/vere/{ => io}/http.c (100%) rename pkg/urbit/vere/{ => io}/term.c (100%) rename pkg/urbit/vere/{ => io}/unix.c (100%) diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/io/ames.c similarity index 100% rename from pkg/urbit/vere/ames.c rename to pkg/urbit/vere/io/ames.c diff --git a/pkg/urbit/vere/behn.c b/pkg/urbit/vere/io/behn.c similarity index 100% rename from pkg/urbit/vere/behn.c rename to pkg/urbit/vere/io/behn.c diff --git a/pkg/urbit/vere/cttp.c b/pkg/urbit/vere/io/cttp.c similarity index 100% rename from pkg/urbit/vere/cttp.c rename to pkg/urbit/vere/io/cttp.c diff --git a/pkg/urbit/vere/fore.c b/pkg/urbit/vere/io/fore.c similarity index 100% rename from pkg/urbit/vere/fore.c rename to pkg/urbit/vere/io/fore.c diff --git a/pkg/urbit/vere/hind.c b/pkg/urbit/vere/io/hind.c similarity index 100% rename from pkg/urbit/vere/hind.c rename to pkg/urbit/vere/io/hind.c diff --git a/pkg/urbit/vere/http.c b/pkg/urbit/vere/io/http.c similarity index 100% rename from pkg/urbit/vere/http.c rename to pkg/urbit/vere/io/http.c diff --git a/pkg/urbit/vere/term.c b/pkg/urbit/vere/io/term.c similarity index 100% rename from pkg/urbit/vere/term.c rename to pkg/urbit/vere/io/term.c diff --git a/pkg/urbit/vere/unix.c b/pkg/urbit/vere/io/unix.c similarity index 100% rename from pkg/urbit/vere/unix.c rename to pkg/urbit/vere/io/unix.c From 8497cd65c645d0d76833bdd8f4bac19820b5d26c Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 17 Jun 2020 17:35:45 -0700 Subject: [PATCH 174/257] vere: switch lmdb back to the u3 prefix c3 is intended for language-level functionality. a prefix that communicates a lack of dependence on u3 remains desirable. --- pkg/urbit/include/vere/db/lmdb.h | 28 ++++++++++++++-------------- pkg/urbit/vere/db/lmdb.c | 28 ++++++++++++++-------------- pkg/urbit/vere/disk.c | 14 +++++++------- 3 files changed, 35 insertions(+), 35 deletions(-) diff --git a/pkg/urbit/include/vere/db/lmdb.h b/pkg/urbit/include/vere/db/lmdb.h index 11889eebb..cedec4185 100644 --- a/pkg/urbit/include/vere/db/lmdb.h +++ b/pkg/urbit/include/vere/db/lmdb.h @@ -6,51 +6,51 @@ /* lmdb api wrapper */ - /* c3_lmdb_init(): open lmdb at [pax_c], mmap up to [siz_i]. + /* u3_lmdb_init(): open lmdb at [pax_c], mmap up to [siz_i]. */ MDB_env* - c3_lmdb_init(const c3_c* pax_c, size_t siz_i); + u3_lmdb_init(const c3_c* pax_c, size_t siz_i); - /* c3_lmdb_exit(): close lmdb. + /* u3_lmdb_exit(): close lmdb. */ void - c3_lmdb_exit(MDB_env* env_u); + u3_lmdb_exit(MDB_env* env_u); - /* c3_lmdb_gulf(): read first and last event numbers. + /* u3_lmdb_gulf(): read first and last event numbers. */ c3_o - c3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d); + u3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d); - /* c3_lmdb_read(): read [len_d] events starting at [eve_d]. + /* u3_lmdb_read(): read [len_d] events starting at [eve_d]. */ c3_o - c3_lmdb_read(MDB_env* env_u, + u3_lmdb_read(MDB_env* env_u, void* vod_p, c3_d eve_d, c3_d len_d, c3_o (*read_f)(void*, c3_d, size_t , void*)); - /* c3_lmdb_save(): save [len_d] events starting at [eve_d]. + /* u3_lmdb_save(): save [len_d] events starting at [eve_d]. */ c3_o - c3_lmdb_save(MDB_env* env_u, + u3_lmdb_save(MDB_env* env_u, c3_d eve_d, c3_d len_d, void** byt_p, size_t* siz_i); - /* c3_lmdb_read_meta(): read by string from the META db. + /* u3_lmdb_read_meta(): read by string from the META db. */ void - c3_lmdb_read_meta(MDB_env* env_u, + u3_lmdb_read_meta(MDB_env* env_u, void* vod_p, const c3_c* key_c, void (*read_f)(void*, size_t, void*)); - /* c3_lmdb_save_meta(): save by string into the META db. + /* u3_lmdb_save_meta(): save by string into the META db. */ c3_o - c3_lmdb_save_meta(MDB_env* env_u, + u3_lmdb_save_meta(MDB_env* env_u, const c3_c* key_c, size_t val_i, void* val_p); diff --git a/pkg/urbit/vere/db/lmdb.c b/pkg/urbit/vere/db/lmdb.c index a8305fa31..7b9164826 100644 --- a/pkg/urbit/vere/db/lmdb.c +++ b/pkg/urbit/vere/db/lmdb.c @@ -29,10 +29,10 @@ // - read/save ranges of events // -/* c3_lmdb_init(): open lmdb at [pax_c], mmap up to [siz_i]. +/* u3_lmdb_init(): open lmdb at [pax_c], mmap up to [siz_i]. */ MDB_env* -c3_lmdb_init(const c3_c* pax_c, size_t siz_i) +u3_lmdb_init(const c3_c* pax_c, size_t siz_i) { MDB_env* env_u; c3_w ret_w; @@ -71,18 +71,18 @@ c3_lmdb_init(const c3_c* pax_c, size_t siz_i) return env_u; } -/* c3_lmdb_exit(): close lmdb. +/* u3_lmdb_exit(): close lmdb. */ void -c3_lmdb_exit(MDB_env* env_u) +u3_lmdb_exit(MDB_env* env_u) { mdb_env_close(env_u); } -/* c3_lmdb_gulf(): read first and last event numbers. +/* u3_lmdb_gulf(): read first and last event numbers. */ c3_o -c3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d) +u3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d) { MDB_txn* txn_u; MDB_dbi mdb_u; @@ -175,10 +175,10 @@ c3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d) } } -/* c3_lmdb_read(): read [len_d] events starting at [eve_d]. +/* u3_lmdb_read(): read [len_d] events starting at [eve_d]. */ c3_o -c3_lmdb_read(MDB_env* env_u, +u3_lmdb_read(MDB_env* env_u, void* vod_p, c3_d eve_d, c3_d len_d, @@ -296,10 +296,10 @@ c3_lmdb_read(MDB_env* env_u, } } -/* c3_lmdb_save(): save [len_d] events starting at [eve_d]. +/* u3_lmdb_save(): save [len_d] events starting at [eve_d]. */ c3_o -c3_lmdb_save(MDB_env* env_u, +u3_lmdb_save(MDB_env* env_u, c3_d eve_d, // first event c3_d len_d, // number of events void** byt_p, // array of bytes @@ -361,10 +361,10 @@ c3_lmdb_save(MDB_env* env_u, return c3y; } -/* c3_lmdb_read_meta(): read by string from the META db. +/* u3_lmdb_read_meta(): read by string from the META db. */ void -c3_lmdb_read_meta(MDB_env* env_u, +u3_lmdb_read_meta(MDB_env* env_u, void* vod_p, const c3_c* key_c, void (*read_f)(void*, size_t, void*)) @@ -410,10 +410,10 @@ c3_lmdb_read_meta(MDB_env* env_u, } } -/* c3_lmdb_save_meta(): save by string into the META db. +/* u3_lmdb_save_meta(): save by string into the META db. */ c3_o -c3_lmdb_save_meta(MDB_env* env_u, +u3_lmdb_save_meta(MDB_env* env_u, const c3_c* key_c, size_t val_i, void* val_p) diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index a0d32f4f7..31e824363 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -137,7 +137,7 @@ static void _disk_commit_cb(uv_work_t* ted_u) { struct _cd_save* req_u = ted_u->data; - req_u->ret_o = c3_lmdb_save(req_u->log_u->mdb_u, + req_u->ret_o = u3_lmdb_save(req_u->log_u->mdb_u, req_u->eve_d, req_u->len_d, (void**)req_u->byt_y, // XX safe? @@ -363,7 +363,7 @@ _disk_read_start_cb(uv_timer_t* tim_u) // read events synchronously // - if ( c3n == c3_lmdb_read(log_u->mdb_u, + if ( c3n == u3_lmdb_read(log_u->mdb_u, red_u, red_u->eve_d, red_u->len_d, @@ -417,7 +417,7 @@ _disk_save_meta(u3_disk* log_u, const c3_c* key_c, u3_atom dat) u3r_bytes(0, len_w, byt_y, mat); - ret_o = c3_lmdb_save_meta(log_u->mdb_u, key_c, len_w, byt_y); + ret_o = u3_lmdb_save_meta(log_u->mdb_u, key_c, len_w, byt_y); u3z(mat); c3_free(byt_y); @@ -466,7 +466,7 @@ _disk_read_meta(u3_disk* log_u, const c3_c* key_c) u3_weak dat = u3_none; u3_noun pro; - c3_lmdb_read_meta(log_u->mdb_u, &mat, key_c, _disk_meta_read_cb); + u3_lmdb_read_meta(log_u->mdb_u, &mat, key_c, _disk_meta_read_cb); if ( u3_none != mat ) { pro = u3m_soft(0, u3ke_cue, mat); @@ -542,7 +542,7 @@ u3_disk_read_meta(u3_disk* log_u, void u3_disk_exit(u3_disk* log_u) { - c3_lmdb_exit(log_u->mdb_u); + u3_lmdb_exit(log_u->mdb_u); // XX dispose // } @@ -625,7 +625,7 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) { const size_t siz_i = 1099511627776; - if ( 0 == (log_u->mdb_u = c3_lmdb_init(log_c, siz_i)) ) { + if ( 0 == (log_u->mdb_u = u3_lmdb_init(log_c, siz_i)) ) { fprintf(stderr, "disk: failed to initialize database"); c3_free(log_c); c3_free(log_u); @@ -642,7 +642,7 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) log_u->dun_d = 0; c3_d fir_d; - if ( c3n == c3_lmdb_gulf(log_u->mdb_u, &fir_d, &log_u->dun_d) ) { + if ( c3n == u3_lmdb_gulf(log_u->mdb_u, &fir_d, &log_u->dun_d) ) { fprintf(stderr, "disk: failed to load latest event from database"); c3_free(log_u); return 0; From df7cd2a673e7a2118eccff3a08715ba13788578e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 17 Jun 2020 17:41:27 -0700 Subject: [PATCH 175/257] vere: adds common structure management in ward.c --- pkg/urbit/include/vere/vere.h | 22 +++++++++++ pkg/urbit/vere/disk.c | 30 +++++++-------- pkg/urbit/vere/lord.c | 16 +++----- pkg/urbit/vere/pier.c | 13 ++----- pkg/urbit/vere/ward.c | 71 +++++++++++++++++++++++++++++++++++ 5 files changed, 118 insertions(+), 34 deletions(-) create mode 100644 pkg/urbit/vere/ward.c diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 870e75c64..9abfe5ad6 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -683,6 +683,28 @@ c3_d u3_time_gap_ms(u3_noun now, u3_noun wen); + /** ward: common structure lifecycle + **/ + /* u3_fact_init(): initialize completed event. + */ + u3_fact* + u3_fact_init(c3_d eve_d, c3_l mug_l, u3_noun job); + + /* u3_fact_free(): dispose completed event. + */ + void + u3_fact_free(u3_fact *tac_u); + + /* u3_gift_init(): initialize effect list. + */ + u3_gift* + u3_gift_init(c3_d eve_d, u3_noun act); + + /* u3_gift_free(): dispose effect list. + */ + void + u3_gift_free(u3_gift* gif_u); + /** New vere **/ /* u3_auto_init(): initialize all drivers. diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 31e824363..4628b6263 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -99,11 +99,10 @@ _disk_commit_done(struct _cd_save* req_u) { u3_fact* tac_u = log_u->put_u.ext_u; - + while ( tac_u && (tac_u->eve_d <= log_u->dun_d) ) { log_u->put_u.ext_u = tac_u->nex_u; - u3z(tac_u->job); - c3_free(tac_u); + u3_fact_free(tac_u); tac_u = log_u->put_u.ext_u; } } @@ -257,21 +256,18 @@ u3_disk_plan(u3_disk* log_u, u3_fact* tac_u) void u3_disk_boot_plan(u3_disk* log_u, u3_noun job) { - u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); - tac_u->mug_l = 0; //u3r_mug(job); XX - tac_u->eve_d = ++log_u->sen_d; - tac_u->nex_u = 0; - tac_u->job = job; + // NB, boot mugs are 0 + // + u3_fact* tac_u = u3_fact_init(++log_u->sen_d, 0, job); + tac_u->bug_l = 0; // XX if ( !log_u->put_u.ent_u ) { c3_assert( !log_u->put_u.ext_u ); c3_assert( 1ULL == log_u->sen_d ); - tac_u->bug_l = 0; // XX log_u->put_u.ent_u = log_u->put_u.ext_u = tac_u; } else { - tac_u->bug_l = log_u->put_u.ent_u->mug_l; // XX log_u->put_u.ent_u->nex_u = tac_u; log_u->put_u.ent_u = tac_u; } @@ -313,26 +309,30 @@ _disk_read_one_cb(void* vod_p, c3_d eve_d, size_t val_i, void* val_p) { struct _cd_read* red_u = vod_p; u3_disk* log_u = red_u->log_u; - u3_fact* tac_u = c3_calloc(sizeof(*tac_u)); - tac_u->eve_d = eve_d; + u3_fact* tac_u; { // XX u3m_soft? // u3_noun dat = u3ke_cue(u3i_bytes(val_i, val_p)); u3_noun mug, job; + c3_l bug_l; + if ( (c3n == u3r_cell(dat, &mug, &job)) - || (c3n == u3r_safe_word(mug, &tac_u->bug_l)) ) // XX + || (c3n == u3r_safe_word(mug, &bug_l)) ) // XX { // failure here triggers cleanup in _disk_read_start_cb() // - c3_free(tac_u); u3z(dat); return c3n; } - tac_u->job = u3k(job); + // NB: mug is unknown due to log format + // + tac_u = u3_fact_init(eve_d, 0, u3k(job)); + tac_u->bug_l = bug_l; + u3z(dat); } diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index ffa1fcc88..1f0a63d3b 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -409,17 +409,13 @@ _lord_work_done(u3_lord* god_u, u3_noun job, u3_noun act) { - u3_fact* tac_u = c3_malloc(sizeof(*tac_u)); - tac_u->bug_l = god_u->mug_l; - tac_u->mug_l = god_u->mug_l = mug_l; - tac_u->eve_d = god_u->eve_d = eve_d; - tac_u->nex_u = 0; - tac_u->job = job; + u3_fact* tac_u = u3_fact_init(eve_d, mug_l, job); + tac_u->bug_l = god_u->mug_l; // XX - u3_gift* gif_u = c3_malloc(sizeof(*gif_u)); - gif_u->eve_d = eve_d; - gif_u->nex_u = 0; - gif_u->act = act; + god_u->mug_l = mug_l; + god_u->eve_d = eve_d; + + u3_gift* gif_u = u3_gift_init(eve_d, act); _lord_work_spin(god_u); diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index ded2d57b2..7e6ead75b 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -131,12 +131,9 @@ _pier_gift_kick(u3_work* wok_u) #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", gif_u->eve_d); #endif - u3_auto_kick(wok_u->car_u, gif_u->act); - // XX dispose properly - // - u3z(gif_u->act); - c3_free(gif_u); + u3_auto_kick(wok_u->car_u, gif_u->act); + u3_gift_free(gif_u); } } @@ -644,8 +641,7 @@ _pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) while ( tac_u ) { nex_u = tac_u->nex_u; - u3z(tac_u->job); - c3_free(tac_u); + u3_fact_free(tac_u); tac_u = nex_u; } } @@ -673,8 +669,7 @@ _pier_on_lord_play_bail(void* vod_p, u3_info fon_u, while ( tac_u->eve_d < eve_d ) { nex_u = tac_u->nex_u; las_l = tac_u->mug_l; - u3z(tac_u->job); - c3_free(tac_u); + u3_fact_free(tac_u); tac_u = nex_u; } diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c new file mode 100644 index 000000000..8b4850a7c --- /dev/null +++ b/pkg/urbit/vere/ward.c @@ -0,0 +1,71 @@ +/* vere/ward.c +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +// ward: lifecycle management for common structures +// +// should contain anything allocated in multiple modules, +// or allocated in one and freed in another +// + +/* u3_fact_init(): initialize completed event. +*/ +u3_fact* +u3_fact_init(c3_d eve_d, c3_l mug_l, u3_noun job) +{ + u3_fact *tac_u = c3_malloc(sizeof(*tac_u)); + tac_u->eve_d = eve_d; + tac_u->mug_l = mug_l; + tac_u->nex_u = 0; + tac_u->job = job; + + return tac_u; +} + +/* u3_fact_free(): dispose completed event. +*/ +void +u3_fact_free(u3_fact *tac_u) +{ + u3z(tac_u->job); + c3_free(tac_u); +} + +/* u3_gift_init(): initialize effect list. +*/ +u3_gift* +u3_gift_init(c3_d eve_d, u3_noun act) +{ + u3_gift *gif_u = c3_malloc(sizeof(*gif_u)); + gif_u->eve_d = eve_d; + gif_u->nex_u = 0; + gif_u->act = act; + + return gif_u; +} + +/* u3_gift_free(): dispose effect list. +*/ +void +u3_gift_free(u3_gift* gif_u) +{ + u3z(gif_u->act); + c3_free(gif_u); +} From 5d71e0a804df75a19094287d06f13cf23c828432 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 17 Jun 2020 22:22:38 -0700 Subject: [PATCH 176/257] vere: properly dispose disk resources on exit --- pkg/urbit/include/vere/vere.h | 43 +++++++++- pkg/urbit/vere/disk.c | 149 ++++++++++++++++++++++++++++------ pkg/urbit/vere/foil.c | 12 +-- pkg/urbit/vere/ward.c | 55 +++++++++++++ 4 files changed, 223 insertions(+), 36 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 9abfe5ad6..16b7e3dc4 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -459,6 +459,22 @@ struct _u3_writ* ext_u; // queue exit } u3_lord; + /* u3_read: event log read request + */ + typedef struct _u3_read { + union { // read timer/handle + uv_timer_t tim_u; // + uv_handle_t had_u; // + }; // + c3_d eve_d; // first event + c3_d len_d; // read stride + struct _u3_fact* ent_u; // response entry + struct _u3_fact* ext_u; // response exit + struct _u3_read* nex_u; // next read + struct _u3_read* pre_u; // previous read + struct _u3_disk* log_u; // disk backpointer + } u3_read; + /* u3_disk_cb: u3_disk callbacks */ typedef struct _u3_disk_cb { @@ -480,8 +496,11 @@ c3_d sen_d; // commit requested c3_d dun_d; // committed u3_disk_cb cb_u; // callbacks - uv_timer_t tim_u; // read timer - uv_work_t ted_u; // write thread + u3_read* red_u; // read requests + union { // write thread/request + uv_work_t ted_u; // + uv_req_t req_u; // + }; // c3_o ted_o; // c3y == active u3_info put_u; // write queue } u3_disk; @@ -685,6 +704,26 @@ /** ward: common structure lifecycle **/ + /* u3_dent_init(): initialize file record. + */ + u3_dent* + u3_dent_init(const c3_c* nam_c); + + /* u3_dent_free(): dispose file record. + */ + void + u3_dent_free(u3_dent *det_u); + + /* u3_dire_init(): initialize directory record. + */ + u3_dire* + u3_dire_init(const c3_c* pax_c); + + /* u3_dire_free(): dispose directory record. + */ + void + u3_dire_free(u3_dire *dir_u); + /* u3_fact_init(): initialize completed event. */ u3_fact* diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 4628b6263..66b9c2639 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -121,13 +121,16 @@ _disk_commit_done(struct _cd_save* req_u) static void _disk_commit_after_cb(uv_work_t* ted_u, c3_i sas_i) { - // XX UV_ECANCELED == sas_i? - // struct _cd_save* req_u = ted_u->data; - ted_u->data = 0; - req_u->log_u->ted_o = c3n; - _disk_commit_done(req_u); + if ( UV_ECANCELED == sas_i ) { + _disk_free_save(req_u); + } + else { + ted_u->data = 0; + req_u->log_u->ted_o = c3n; + _disk_commit_done(req_u); + } } /* _disk_commit_cb(): off the main thread, write event-batch. @@ -286,20 +289,73 @@ u3_disk_boot_save(u3_disk* log_u) _disk_commit(log_u); } +static void +_disk_read_free(u3_read* red_u) +{ + // free facts (if the read failed) + // + { + u3_fact* tac_u = red_u->ext_u; + u3_fact* nex_u; + + while ( tac_u ) { + nex_u = tac_u->nex_u; + u3_fact_free(tac_u); + tac_u = nex_u; + } + } + + c3_free(red_u); +} + +/* _disk_read_close_cb(): +*/ +static void +_disk_read_close_cb(uv_handle_t* had_u) +{ + u3_read* red_u = had_u->data; + _disk_read_free(red_u); +} + +static void +_disk_read_close(u3_read* red_u) +{ + u3_disk* log_u = red_u->log_u; + + // unlink request + // + { + if ( red_u->pre_u ) { + red_u->pre_u->nex_u = red_u->nex_u; + } + else { + log_u->red_u = red_u->nex_u; + } + + if ( red_u->nex_u ) { + red_u->nex_u->pre_u = red_u->pre_u; + } + } + + uv_close(&red_u->had_u, _disk_read_close_cb); +} + /* _disk_read_done_cb(): finalize read, invoke callback with response. */ static void _disk_read_done_cb(uv_timer_t* tim_u) { - struct _cd_read* red_u = tim_u->data; + u3_read* red_u = tim_u->data; u3_disk* log_u = red_u->log_u; u3_info pay_u = { .ent_u = red_u->ent_u, .ext_u = red_u->ext_u }; c3_assert( red_u->ent_u ); c3_assert( red_u->ext_u ); + red_u->ent_u = 0; + red_u->ext_u = 0; log_u->cb_u.read_done_f(log_u->cb_u.vod_p, pay_u); - uv_close((uv_handle_t*)tim_u, (uv_close_cb)free); + _disk_read_close(red_u); } /* _disk_read_one_cb(): lmdb read callback, invoked for each event in order @@ -307,7 +363,7 @@ _disk_read_done_cb(uv_timer_t* tim_u) static c3_o _disk_read_one_cb(void* vod_p, c3_d eve_d, size_t val_i, void* val_p) { - struct _cd_read* red_u = vod_p; + u3_read* red_u = vod_p; u3_disk* log_u = red_u->log_u; u3_fact* tac_u; @@ -358,7 +414,7 @@ _disk_read_one_cb(void* vod_p, c3_d eve_d, size_t val_i, void* val_p) static void _disk_read_start_cb(uv_timer_t* tim_u) { - struct _cd_read* red_u = tim_u->data; + u3_read* red_u = tim_u->data; u3_disk* log_u = red_u->log_u; // read events synchronously @@ -370,16 +426,13 @@ _disk_read_start_cb(uv_timer_t* tim_u) _disk_read_one_cb) ) { log_u->cb_u.read_bail_f(log_u->cb_u.vod_p, red_u->eve_d); - // XX dispose all facts in red_u - // - c3_free(red_u); - tim_u->data = 0; - return; + _disk_read_close(red_u); } - // finish the read asynchronously // - uv_timer_start(&red_u->tim_u, _disk_read_done_cb, 0, 0); + else { + uv_timer_start(&red_u->tim_u, _disk_read_done_cb, 0, 0); + } } /* u3_disk_read(): read [len_d] events starting at [eve_d]. @@ -387,18 +440,21 @@ _disk_read_start_cb(uv_timer_t* tim_u) void u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d) { - // XX enqueue [red_u] in [log_u] for cancellation - // - struct _cd_read* red_u = c3_malloc(sizeof(*red_u)); + u3_read* red_u = c3_malloc(sizeof(*red_u)); red_u->log_u = log_u; red_u->eve_d = eve_d; red_u->len_d = len_d; red_u->ent_u = red_u->ext_u = 0; + red_u->pre_u = 0; + red_u->nex_u = log_u->red_u; + + if ( log_u->red_u ) { + log_u->red_u->pre_u = red_u; + } + log_u->red_u = red_u; // perform the read asynchronously // - // XX queue reads for cancelation - // uv_timer_init(u3L, &red_u->tim_u); red_u->tim_u.data = red_u; @@ -542,9 +598,52 @@ u3_disk_read_meta(u3_disk* log_u, void u3_disk_exit(u3_disk* log_u) { - u3_lmdb_exit(log_u->mdb_u); - // XX dispose + // cancel all outstanding reads // + { + u3_read* red_u = log_u->red_u; + + while ( red_u ) { + _disk_read_close(red_u); + red_u = red_u->nex_u; + } + } + + // cancel write thread + // + if ( c3y == log_u->ted_o ) { + c3_i sas_i; + + do { + sas_i = uv_cancel(&log_u->req_u); + fprintf(stderr, "disk canceling\r\n"); + } + while ( UV_EBUSY == sas_i ); + } + + // close database + // + u3_lmdb_exit(log_u->mdb_u); + + // dispose planned writes + // + + { + u3_fact* tac_u = log_u->put_u.ext_u; + u3_fact* nex_u; + + while ( tac_u ) { + nex_u = tac_u->nex_u; + u3_fact_free(tac_u); + tac_u = nex_u; + } + } + + u3_dire_free(log_u->dir_u); + u3_dire_free(log_u->urb_u); + u3_dire_free(log_u->com_u); + + c3_free(log_u); } /* u3_disk_init(): load or create pier directories and event log. @@ -556,8 +655,8 @@ u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u) log_u->liv_o = c3n; log_u->ted_o = c3n; log_u->cb_u = cb_u; - - // uv_timer_init(u3L, &log_u->tim_u); + log_u->red_u = 0; + log_u->put_u.ent_u = log_u->put_u.ext_u = 0; // create/load pier directory // diff --git a/pkg/urbit/vere/foil.c b/pkg/urbit/vere/foil.c index b6647eb40..9c78cd296 100644 --- a/pkg/urbit/vere/foil.c +++ b/pkg/urbit/vere/foil.c @@ -121,21 +121,15 @@ u3_foil_folder(const c3_c* pax_c) } } } - dir_u = c3_malloc(sizeof *dir_u); - dir_u->all_u = 0; - dir_u->pax_c = c3_malloc(1 + strlen(pax_c)); - strcpy(dir_u->pax_c, pax_c); + + dir_u = u3_dire_init(pax_c); } /* create entries for all files */ while ( UV_EOF != uv_fs_scandir_next(&ruq_u, &den_u) ) { if ( UV_DIRENT_FILE == den_u.type ) { - u3_dent* det_u = c3_malloc(sizeof(*det_u)); - - det_u->nam_c = c3_malloc(1 + strlen(den_u.name)); - strcpy(det_u->nam_c, den_u.name); - + u3_dent* det_u = u3_dent_init(den_u.name); det_u->nex_u = dir_u->all_u; dir_u->all_u = det_u; } diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c index 8b4850a7c..59eef7dab 100644 --- a/pkg/urbit/vere/ward.c +++ b/pkg/urbit/vere/ward.c @@ -25,6 +25,61 @@ // or allocated in one and freed in another // +/* u3_dent_init(): initialize file record. +*/ +u3_dent* +u3_dent_init(const c3_c* nam_c) +{ + u3_dent *det_u = c3_malloc(sizeof(*det_u)); + det_u->nex_u = 0; + det_u->nam_c = c3_malloc(1 + strlen(nam_c)); + strcpy(det_u->nam_c, nam_c); + + return det_u; +} + +/* u3_dent_free(): dispose file record. +*/ +void +u3_dent_free(u3_dent *det_u) +{ + c3_free(det_u->nam_c); + c3_free(det_u); +} + +/* u3_dire_init(): initialize directory record. +*/ +u3_dire* +u3_dire_init(const c3_c* pax_c) +{ + u3_dire *dir_u = c3_malloc(sizeof *dir_u); + dir_u->all_u = 0; + dir_u->pax_c = c3_malloc(1 + strlen(pax_c)); + strcpy(dir_u->pax_c, pax_c); + + return dir_u; +} + +/* u3_dire_free(): dispose directory record. +*/ +void +u3_dire_free(u3_dire *dir_u) +{ + { + u3_dent *det_u = dir_u->all_u; + u3_dent *nex_u; + + while ( det_u ) { + nex_u = det_u->nex_u; + u3_dent_free(det_u); + det_u = nex_u; + } + } + + c3_free(dir_u->pax_c); + c3_free(dir_u); +} + /* u3_fact_init(): initialize completed event. */ u3_fact* From b75d42c33512d72d9ca0e2a44ccccb76af5088e5 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 19 Jun 2020 11:05:57 -0700 Subject: [PATCH 177/257] vere: adds u3_ovum init/dispose to ward.c --- pkg/urbit/include/vere/vere.h | 14 +++++++++++ pkg/urbit/vere/auto.c | 45 +++++++++++------------------------ pkg/urbit/vere/lord.c | 12 ++++------ pkg/urbit/vere/ward.c | 45 ++++++++++++++++++++++++++++++++++- 4 files changed, 76 insertions(+), 40 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 16b7e3dc4..f9138e3c3 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -744,6 +744,20 @@ void u3_gift_free(u3_gift* gif_u); + /* u3_ovum_init: initialize an unlinked potential event + */ + u3_ovum* + u3_ovum_init(u3_auto* car_u, + c3_l msc_l, + u3_noun tar, + u3_noun wir, + u3_noun cad); + + /* u3_ovum_free: dispose an unlinked potential event + */ + void + u3_ovum_free(u3_ovum *egg_u); + /** New vere **/ /* u3_auto_init(): initialize all drivers. diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 080f0cf68..8a7ea08be 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -28,21 +28,7 @@ u3_auto_plan(u3_auto* car_u, u3_noun wir, u3_noun cad) { - u3_ovum* egg_u = c3_malloc(sizeof(*egg_u)); - egg_u->car_u = car_u; - egg_u->vod_p = 0; - egg_u->msc_l = msc_l; - egg_u->tar = tar; - egg_u->wir = wir; - egg_u->cad = cad; - - // spinner defaults - // - egg_u->pin_u.lab = u3k(u3h(wir)); - egg_u->pin_u.del_o = c3y; - - egg_u->cb_u.news_f = 0; - egg_u->cb_u.bail_f = 0; + u3_ovum *egg_u = u3_ovum_init(car_u, msc_l, tar, wir, cad); if ( !car_u->ent_u ) { c3_assert(!car_u->ext_u); @@ -114,9 +100,7 @@ u3_auto_bail(u3_ovum* egg_u, u3_noun lud) u3_auto_bail_slog(egg_u, lud); } - // XX confirm - // - u3_auto_drop(0, egg_u); + u3_ovum_free(egg_u); } /* _auto_news(): notify driver of ovum status @@ -139,11 +123,7 @@ void u3_auto_done(u3_ovum* egg_u) { _auto_news(egg_u, u3_ovum_done); - - // XX confirm - // - u3_auto_drop(0, egg_u); - // + u3_ovum_free(egg_u); } /* u3_auto_work(): notify driver of [egg_u] commencement. @@ -181,11 +161,7 @@ u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) _auto_news(egg_u, u3_ovum_drop); } - u3z(egg_u->pin_u.lab); - u3z(egg_u->tar); - u3z(egg_u->wir); - u3z(egg_u->cad); - c3_free(egg_u); + u3_ovum_free(egg_u); } /* u3_auto_next(): select an ovum, dequeue and construct. @@ -329,9 +305,16 @@ u3_auto_exit(u3_auto* car_u) while ( car_u ) { nex_u = car_u->nex_u; - // while ( car_u->ext_u ) { - // u3_auto_drop(car_u, car_u->ext_u); - // } + { + u3_ovum *egg_u = car_u->ext_u; + u3_ovum *xen_u; + + while ( egg_u ) { + xen_u = egg_u->nex_u; + u3_ovum_free(egg_u); + egg_u = xen_u; + } + } cod_l = u3a_lush(car_u->nam_m); car_u->io.exit_f(car_u); diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 1f0a63d3b..3f918535f 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -447,9 +447,8 @@ _lord_plea_work_swap(u3_lord* god_u, u3_ovum* egg_u, u3_noun dat) || (c3n == u3r_safe_word(mug, &mug_l)) || (c3n == u3a_is_cell(job)) ) { - // XX dispose egg_u - // u3z(job); + u3_ovum_free(egg_u); fprintf(stderr, "lord: invalid %%work\r\n"); return _lord_plea_foul(god_u, c3__swap, dat); } @@ -476,9 +475,8 @@ _lord_plea_work_done(u3_lord* god_u, || (c3n == u3r_safe_chub(eve, &eve_d)) || (c3n == u3r_safe_word(mug, &mug_l)) ) { - // XX dispose egg_u - // u3z(job); + u3_ovum_free(egg_u); fprintf(stderr, "lord: invalid %%work\r\n"); return _lord_plea_foul(god_u, c3__done, dat); } @@ -505,17 +503,15 @@ _lord_plea_work(u3_lord* god_u, u3_noun dat) } if ( c3n == u3a_is_cell(dat) ) { - // XX dispose egg_u - // u3z(job); + u3_ovum_free(egg_u); return _lord_plea_foul(god_u, c3__work, dat); } switch ( u3h(dat) ) { default: { - // XX dispose egg_u - // u3z(job); + u3_ovum_free(egg_u); return _lord_plea_foul(god_u, c3__work, dat); } break; diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c index 59eef7dab..25ebf6ac1 100644 --- a/pkg/urbit/vere/ward.c +++ b/pkg/urbit/vere/ward.c @@ -119,8 +119,51 @@ u3_gift_init(c3_d eve_d, u3_noun act) /* u3_gift_free(): dispose effect list. */ void -u3_gift_free(u3_gift* gif_u) +u3_gift_free(u3_gift *gif_u) { u3z(gif_u->act); c3_free(gif_u); } + +/* u3_ovum_init: initialize an unlinked potential event +*/ +u3_ovum* +u3_ovum_init(u3_auto* car_u, + c3_l msc_l, + u3_noun tar, + u3_noun wir, + u3_noun cad) +{ + u3_ovum* egg_u = c3_malloc(sizeof(*egg_u)); + egg_u->car_u = car_u; + egg_u->vod_p = 0; + egg_u->msc_l = msc_l; + egg_u->tar = tar; + egg_u->wir = wir; + egg_u->cad = cad; + + egg_u->pre_u = egg_u->nex_u = 0; + + egg_u->cb_u.news_f = 0; + egg_u->cb_u.bail_f = 0; + + // spinner defaults + // + egg_u->pin_u.lab = u3k(u3h(wir)); + egg_u->pin_u.del_o = c3y; + + return egg_u; +} + +/* u3_ovum_free: dispose an unlinked potential event +*/ +void +u3_ovum_free(u3_ovum *egg_u) +{ + u3z(egg_u->pin_u.lab); + u3z(egg_u->tar); + u3z(egg_u->wir); + u3z(egg_u->cad); + + c3_free(egg_u); +} From 71d679394388377aaa0b5681b7f7d2e82ff4861b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 19 Jun 2020 00:12:21 -0700 Subject: [PATCH 178/257] vere: renames "daemon" to king, removes command socket --- pkg/urbit/daemon/main.c | 4 +- pkg/urbit/include/vere/vere.h | 33 ++- pkg/urbit/vere/io/term.c | 2 +- pkg/urbit/vere/{daemon.c => king.c} | 305 ++++------------------------ 4 files changed, 52 insertions(+), 292 deletions(-) rename pkg/urbit/vere/{daemon.c => king.c} (73%) diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 518946844..1c1c66fa1 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -473,7 +473,7 @@ _stop_exit(c3_i int_i) // explicit fprintf to avoid allocation in u3l_log // fprintf(stderr, "\r\n[received keyboard stop signal, exiting]\r\n"); - u3_daemon_bail(); + u3_king_bail(); } /* _stop_signal(): handle termination signal. @@ -759,7 +759,7 @@ main(c3_i argc, exit(1); } - u3_daemon_commence(); + u3_king_commence(); // uninitialize curl // diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index f9138e3c3..993786e9d 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -604,16 +604,13 @@ /* u3_king: all executing piers. */ - typedef struct _u3_daemon { - c3_c* soc_c; // socket name - c3_c* certs_c; // ssl certificate dump - c3_w len_w; // number used - c3_w all_w; // number allocated - u3_pier** tab_u; // pier table - uv_pipe_t cmd_u; // command socket - u3_moor* cli_u; // connected clients - uv_timer_t tim_u; // gc timer - } u3_daemon; + typedef struct _u3_king { + c3_c* certs_c; // ssl certificate dump + c3_w len_w; // number used + c3_w all_w; // number allocated + u3_pier** tab_u; // pier table + uv_timer_t tim_u; // gc timer + } u3_king; /* u3_pier_spin(): (re-)activate idle handler */ @@ -622,13 +619,13 @@ # define u3L u3_Host.lup_u // global event loop # define u3Z (&(u3_Raft)) -# define u3K u3_Daemon +# define u3K u3_King /** Global variables. **/ c3_global u3_host u3_Host; c3_global c3_c* u3_Local; - c3_global u3_daemon u3_Daemon; + c3_global u3_king u3_King; /** Functions. **/ @@ -1273,20 +1270,20 @@ u3_noun u3_dawn_vent(u3_noun seed); - /* u3_daemon_commence(): start the daemon + /* u3_king_commence(): start the daemon */ void - u3_daemon_commence(); + u3_king_commence(); - /* u3_daemon_bail(): immediately shutdown. + /* u3_king_bail(): immediately shutdown. */ void - u3_daemon_bail(void); + u3_king_bail(void); - /* u3_daemon_grab(): gc the daemon + /* u3_king_grab(): gc the daemon */ void - u3_daemon_grab(void* vod_p); + u3_king_grab(void* vod_p); c3_w diff --git a/pkg/urbit/vere/io/term.c b/pkg/urbit/vere/io/term.c index 9e30f3b23..f92c3748d 100644 --- a/pkg/urbit/vere/io/term.c +++ b/pkg/urbit/vere/io/term.c @@ -1377,7 +1377,7 @@ _term_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) // // XX disabled due to known leaks; uncomment for dev // - // uv_timer_start(&u3K.tim_u, (uv_timer_cb)u3_daemon_grab, 0, 0); + // uv_timer_start(&u3K.tim_u, (uv_timer_cb)u3_king_grab, 0, 0); } break; // ignore pack (processed in worker) diff --git a/pkg/urbit/vere/daemon.c b/pkg/urbit/vere/king.c similarity index 73% rename from pkg/urbit/vere/daemon.c rename to pkg/urbit/vere/king.c index b84d1cd8b..021e61573 100644 --- a/pkg/urbit/vere/daemon.c +++ b/pkg/urbit/vere/king.c @@ -15,38 +15,9 @@ static c3_w sag_w; /* -:: daemon to worker protocol +:: skeleton client->king protocol :: |% -:: +fate: worker to daemon -:: -+$ fate - $% :: authenticate client - :: - [%auth p=(unit ship) q=@] - :: ship action - :: - [%wyrd p=ship q=wyrd] - :: daemon command - :: - [%doom p=doom] - == -:: +wyrd: ship action -:: -:: Should require auth to a single relevant ship -:: -+$ wyrd - $% :: release this pier - :: - :: XX not implemented - :: - [%susp ~] - :: generate event - :: - :: XX partially implemented - :: - [%vent p=ovum] - == :: +doom: daemon command :: :: Should require auth to the daemon itself @@ -114,41 +85,15 @@ static c3_w sag_w; :: r: userspace ova :: [p=@ q=(list ovum) r=(list ovum)] -:: +cede: daemon to client -:: -:: XX not implemented -:: -+$ cede - $% :: send cards - :: - :: XX presumably the effects of %vent in +wyrd - :: - [%cede p=ship q=(list ovum)] - :: accept command - :: - [%firm ~] - :: reject command - :: - [%deny p=@t] - == -- */ -void _daemon_auth(u3_noun auth); - -void _daemon_wyrd(u3_noun ship_wyrd); - void _daemon_susp(u3_atom ship, u3_noun susp); - void _daemon_vent(u3_atom ship, u3_noun vent); - void _daemon_doom(u3_noun doom); void _daemon_boot(u3_noun boot); void _daemon_come(u3_noun star, u3_noun pill, u3_noun path); void _daemon_dawn(u3_noun seed, u3_noun pill, u3_noun path); void _daemon_fake(u3_noun ship, u3_noun pill, u3_noun path); - void _daemon_exit(u3_noun exit); void _daemon_pier(u3_noun pier); - void _daemon_root(u3_noun root); - /* _daemon_defy_fate(): invalid fate */ @@ -158,93 +103,6 @@ _daemon_defy_fate() exit(1); } -/* _daemon_fate(): top-level fate parser -*/ -void -_daemon_fate(void *vod_p, u3_noun mat) -{ - u3_noun fate = u3ke_cue(mat); - u3_noun load; - void (*next)(u3_noun); - - c3_assert(_(u3a_is_cell(fate))); - c3_assert(_(u3a_is_cat(u3h(fate)))); - - switch ( u3h(fate) ) { - case c3__auth: - next = _daemon_auth; - break; - case c3__wyrd: - next = _daemon_wyrd; - break; - case c3__doom: - next = _daemon_doom; - break; - default: - _daemon_defy_fate(); - } - - load = u3k(u3t(fate)); - u3z(fate); - next(load); -} - -/* _daemon_auth(): auth parser -*/ -void -_daemon_auth(u3_noun auth) -{ -} - -/* _daemon_wyrd(): wyrd parser -*/ -void -_daemon_wyrd(u3_noun ship_wyrd) -{ - u3_atom ship; - u3_noun wyrd; - u3_noun load; - void (*next)(u3_atom, u3_noun); - - c3_assert(_(u3a_is_cell(ship_wyrd))); - c3_assert(_(u3a_is_atom(u3h(ship_wyrd)))); - ship = u3k(u3h(ship_wyrd)); - wyrd = u3k(u3t(ship_wyrd)); - u3z(ship_wyrd); - - c3_assert(_(u3a_is_cell(wyrd))); - c3_assert(_(u3a_is_cat(u3h(wyrd)))); - - switch ( u3h(wyrd) ) { - case c3__susp: - next = _daemon_susp; - break; - case c3__vent: - next = _daemon_vent; - break; - default: - _daemon_defy_fate(); - } - - load = u3k(u3t(wyrd)); - u3z(wyrd); - next(ship, load); -} - -/* _daemon_susp(): susp parser -*/ -void -_daemon_susp(u3_atom ship, u3_noun susp) -{ -} - -/* _daemon_vent(): vent parser -*/ -void -_daemon_vent(u3_atom ship, u3_noun vent) -{ -} - /* _daemon_doom(): doom parser */ void @@ -260,15 +118,9 @@ _daemon_doom(u3_noun doom) case c3__boot: next = _daemon_boot; break; - case c3__exit: - next = _daemon_exit; - break; case c3__pier: next = _daemon_pier; break; - case c3__root: - next = _daemon_root; - break; default: _daemon_defy_fate(); } @@ -352,13 +204,6 @@ _daemon_dawn(u3_noun seed, u3_noun pill, u3_noun path) u3C.slog_f = 0; } -/* _daemon_exit(): exit parser -*/ -void -_daemon_exit(u3_noun exit) -{ -} - /* _daemon_pier(): pier parser */ void @@ -374,66 +219,6 @@ _daemon_pier(u3_noun pier) u3z(pier); } -/* _daemon_root(): root parser -*/ -void -_daemon_root(u3_noun root) -{ -} - -/* _daemon_bail(): bail for command socket newt -*/ -void -_daemon_bail(void* vod_p, const c3_c *err_c) -{ - u3_moor* mor_p = vod_p; - u3_moor* fre_p; - - u3l_log("_daemon_bail: %s\r\n", err_c); - - if ( !mor_p ) { - fre_p = u3K.cli_u; - u3K.cli_u = u3K.cli_u->nex_u; - } - else { - fre_p = mor_p->nex_u; - mor_p->nex_u = fre_p->nex_u; - } - - c3_free(fre_p); -} - -/* _daemon_socket_connect(): callback for new connections -*/ -void -_daemon_socket_connect(uv_stream_t *sock, int status) -{ - u3_moor *mor_u; - - if ( u3K.cli_u == 0 ) { - u3K.cli_u = c3_malloc(sizeof(u3_moor)); - mor_u = u3K.cli_u; - mor_u->ptr_v = 0; - mor_u->nex_u = 0; - } - else { - for (mor_u = u3K.cli_u; mor_u->nex_u; mor_u = mor_u->nex_u); - - mor_u->nex_u = c3_malloc(sizeof(u3_moor)); - mor_u->nex_u->ptr_v = mor_u; - mor_u = mor_u->nex_u; - mor_u->nex_u = 0; - } - - uv_timer_init(u3L, &mor_u->tim_u); - uv_pipe_init(u3L, &mor_u->pyp_u, 0); - mor_u->pok_f = _daemon_fate; - mor_u->bal_f = _daemon_bail; - - uv_accept(sock, (uv_stream_t *)&mor_u->pyp_u); - u3_newt_read((u3_moat *)mor_u); -} - /* _daemon_curl_alloc(): allocate a response buffer for curl ** XX deduplicate with dawn.c */ @@ -654,7 +439,7 @@ _boothack_key(u3_noun kef) return seed; } -/* _boothack_doom(): parse CLI arguments into c3__doom +/* _boothack_doom(): parse CLI arguments into $doom */ static u3_noun _boothack_doom(void) @@ -834,30 +619,23 @@ _daemon_sign_hold(void) } } -/* _boothack_cb(): callback for the boothack self-connection -** (as if we were a client process) +/* _daemon_sign_close(): dispose daemon signal handlers +*/ +static void +_daemon_sign_close(void) +{ + u3_usig* sig_u; + + for ( sig_u = u3_Host.sig_u; sig_u; sig_u = sig_u->nex_u ) { + uv_close((uv_handle_t*)&sig_u->sil_u, (uv_close_cb)free); + } +} +/* _boothack_cb(): setup pier via message as if from client. */ void -_boothack_cb(uv_connect_t* con_u, c3_i sas_i) +_boothack_cb(uv_timer_t* tim_u) { - u3_mojo *moj_u = con_u->data; - - if ( 0 != sas_i ) { - u3l_log("boot: doom failed: %s\r\n", uv_strerror(sas_i)); - u3_daemon_bail(); - } - else { - u3_noun dom = u3nc(c3__doom, _boothack_doom()); - u3_atom mat = u3ke_jam(dom); - u3_newt_write(moj_u, mat); - - c3_free(con_u); - - // XX [moj_u] is leaked, newt.c doesn't give us a callback - // after which we could close and free it ... - // - // uv_close((uv_handle_t*)&moj_u->pyp_u, (uv_close_cb)c3_free); - } + _daemon_doom(_boothack_doom()); } /* _daemon_loop_init(): stuff that comes before the event loop @@ -865,21 +643,18 @@ _boothack_cb(uv_connect_t* con_u, c3_i sas_i) void _daemon_loop_init() { + // initialize terminal/logging + // + u3_term_log_init(); + + // start signal handlers + // _daemon_sign_init(); _daemon_sign_move(); - // boot hack: send pier %boot command via %doom cmd socket msg - // - { - u3_moor* mor_u = c3_malloc(sizeof(u3_moor)); - uv_connect_t* con_u = c3_malloc(sizeof(uv_connect_t)); - con_u->data = mor_u; - uv_timer_init(u3L, &mor_u->tim_u); - uv_pipe_init(u3L, &mor_u->pyp_u, 0); - uv_pipe_connect(con_u, &mor_u->pyp_u, u3K.soc_c, _boothack_cb); - } - - u3_term_log_init(); + // async "boothack" + // / + uv_timer_start(&u3K.tim_u, _boothack_cb, 0, 0); } /* _daemon_loop_exit(): cleanup after event loop @@ -887,14 +662,13 @@ _daemon_loop_init() void _daemon_loop_exit() { - unlink(u3K.soc_c); unlink(u3K.certs_c); } -/* u3_daemon_commence(): start the daemon +/* u3_king_commence(): start the daemon */ void -u3_daemon_commence() +u3_king_commence() { u3_Host.lup_u = uv_default_loop(); @@ -937,42 +711,31 @@ u3_daemon_commence() } } - // listen on command socket + // initialize top-level timer // - { - c3_c buf_c[256]; - - sprintf(buf_c, "/tmp/urbit-sock-%d", getpid()); - u3K.soc_c = strdup(buf_c); - } - uv_timer_init(u3L, &u3K.tim_u); - uv_pipe_init(u3L, &u3K.cmd_u, 0); - uv_pipe_bind(&u3K.cmd_u, u3K.soc_c); - uv_listen((uv_stream_t *)&u3K.cmd_u, 128, _daemon_socket_connect); - + // run the loop + // _daemon_loop_init(); - uv_run(u3L, UV_RUN_DEFAULT); - _daemon_loop_exit(); } -/* u3_daemon_bail(): immediately shutdown. +/* u3_king_bail(): immediately shutdown. */ void -u3_daemon_bail(void) +u3_king_bail(void) { _daemon_loop_exit(); u3_pier_bail(); exit(1); } -/* u3_daemon_grab(): gc the daemon +/* u3_king_grab(): gc the daemon */ void -u3_daemon_grab(void* vod_p) +u3_king_grab(void* vod_p) { c3_w tot_w = 0; FILE* fil_u; From 98040ffa2dcb34ad7cf3a82e08bceb87d6f4817e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 19 Jun 2020 00:35:52 -0700 Subject: [PATCH 179/257] newt: adds stop/dispose functions for read and write --- pkg/urbit/include/vere/vere.h | 10 ++++ pkg/urbit/vere/newt.c | 86 +++++++++++++++++++++++++++++++++-- 2 files changed, 92 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 993786e9d..85b97a29e 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -1167,6 +1167,16 @@ void u3_newt_read(u3_moat* mot_u); + /* u3_newt_moat_stop(); newt stop/close input stream. + */ + void + u3_newt_moat_stop(u3_moat* mot_u, u3_moor_bail bal_f); + + /* u3_newt_mojo_stop(); newt stop/close output stream. + */ + void + u3_newt_mojo_stop(u3_mojo* moj_u, u3_moor_bail bal_f); + /** Pier control. **/ /* u3_pier_db_shutdown(): close the log. diff --git a/pkg/urbit/vere/newt.c b/pkg/urbit/vere/newt.c index 93b343213..9af6fcae7 100644 --- a/pkg/urbit/vere/newt.c +++ b/pkg/urbit/vere/newt.c @@ -212,7 +212,11 @@ _newt_read(u3_moat* mot_u, if ( 0 > len_i ) { c3_free(buf_u->base); uv_read_stop((uv_stream_t*)&mot_u->pyp_u); - fprintf(stderr, "newt: read failed %s\r\n", uv_strerror(len_i)); + + if ( UV_EOF != len_i ) { + fprintf(stderr, "newt: read failed %s\r\n", uv_strerror(len_i)); + } + mot_u->bal_f(mot_u->ptr_v, uv_strerror(len_i)); return c3n; } @@ -278,8 +282,9 @@ _newt_read_init(u3_moat* mot_u, uv_read_cb read_cb_f) // mot_u->ent_u = mot_u->ext_u = 0; - // store pointer for queue timer callback + // store pointer for libuv handle callback // + mot_u->pyp_u.data = mot_u; mot_u->tim_u.data = mot_u; // await next msg header @@ -299,6 +304,51 @@ _newt_read_init(u3_moat* mot_u, uv_read_cb read_cb_f) } } +/* _moat_stop_cb(): finalize stop/close input stream.. +*/ +static void +_moat_stop_cb(uv_handle_t* han_u) +{ + u3_moat* mot_u = han_u->data; + mot_u->bal_f(mot_u->ptr_v, ""); +} + +/* u3_newt_moat_stop(); newt stop/close input stream. +*/ +void +u3_newt_moat_stop(u3_moat* mot_u, u3_moor_bail bal_f) +{ + mot_u->pyp_u.data = mot_u; + + if ( bal_f ) { + mot_u->bal_f = bal_f; + } + + uv_close((uv_handle_t*)&mot_u->pyp_u, _moat_stop_cb); + uv_close((uv_handle_t*)&mot_u->tim_u, 0); + + // dispose in-process message + // + if ( u3_mess_tail == mot_u->mes_u.sat_e ) { + c3_free(mot_u->mes_u.tal_u.met_u); + _newt_mess_head(&mot_u->mes_u); + } + + // dispose pending messages + { + u3_meat* met_u = mot_u->ext_u; + u3_meat* nex_u; + + while ( met_u ) { + nex_u = met_u->nex_u; + c3_free(met_u); + met_u = nex_u; + } + + mot_u->ent_u = mot_u->ext_u = 0; + } +} + /* u3_newt_read_sync(): start reading; multiple msgs synchronous. */ void @@ -334,11 +384,39 @@ _newt_write_cb(uv_write_t* wri_u, c3_i sas_i) c3_free(req_u); if ( 0 != sas_i ) { - fprintf(stderr, "newt: write failed %s\r\n", uv_strerror(sas_i)); - moj_u->bal_f(moj_u->ptr_v, uv_strerror(sas_i)); + if ( UV_ECANCELED == sas_i ) { + fprintf(stderr, "newt: write canceled\r\n"); + } + else { + fprintf(stderr, "newt: write failed %s\r\n", uv_strerror(sas_i)); + moj_u->bal_f(moj_u->ptr_v, uv_strerror(sas_i)); + } } } +/* _mojo_stop_cb(): finalize stop/close output stream.. +*/ +static void +_mojo_stop_cb(uv_handle_t* han_u) +{ + u3_mojo* moj_u = han_u->data; + moj_u->bal_f(moj_u->ptr_v, ""); +} + +/* u3_newt_mojo_stop(); newt stop/close output stream. +*/ +void +u3_newt_mojo_stop(u3_mojo* moj_u, u3_moor_bail bal_f) +{ + moj_u->pyp_u.data = moj_u; + + if ( bal_f ) { + moj_u->bal_f = bal_f; + } + + uv_close((uv_handle_t*)&moj_u->pyp_u, _mojo_stop_cb); +} + /* u3_newt_write(): write atom to stream; free atom. */ void From 4a48e16f414ed809efb6313c5846d1d5875a9491 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 19 Jun 2020 14:32:07 -0700 Subject: [PATCH 180/257] vere: refactors king/pier/lord shutdown --- pkg/urbit/daemon/main.c | 4 +- pkg/urbit/include/vere/vere.h | 56 +++++-- pkg/urbit/vere/io/ames.c | 2 +- pkg/urbit/vere/io/term.c | 5 +- pkg/urbit/vere/king.c | 109 ++++++++++++- pkg/urbit/vere/lord.c | 259 ++++++++++++++++++++++-------- pkg/urbit/vere/pier.c | 294 ++++++++++++++++++---------------- 7 files changed, 495 insertions(+), 234 deletions(-) diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 1c1c66fa1..dec85ab8c 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -483,7 +483,7 @@ _stop_signal(c3_i int_i) { // if we have a pier, unmap the event log before dumping core // - u3_pier_halt(); + u3_king_halt(); } /* @@ -581,7 +581,7 @@ _fork_into_background_process() static void _stop_on_boot_completed_cb() { - u3_pier_exit(u3_pier_stub()); + u3_king_exit(); } c3_i diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 85b97a29e..aceb09a64 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -413,7 +413,6 @@ u3_peek* pek_u; // peek u3_info fon_u; // recompute c3_d eve_d; // save/pack at - c3_w xit_w; // exit code }; } u3_writ; @@ -431,7 +430,8 @@ void (*work_bail_f)(void*, u3_ovum*, u3_noun lud); void (*save_f)(void*); void (*pack_f)(void*); - void (*exit_f)(void*, c3_o); + void (*bail_f)(void*); + void (*exit_f)(void*); } u3_lord_cb; /* u3_lord: serf controller. @@ -600,15 +600,14 @@ // XX remove c3_s por_s; // UDP port u3_save* sav_u; // autosave + struct _u3_pier* nex_u; // next in list } u3_pier; /* u3_king: all executing piers. */ typedef struct _u3_king { c3_c* certs_c; // ssl certificate dump - c3_w len_w; // number used - c3_w all_w; // number allocated - u3_pier** tab_u; // pier table + u3_pier* pir_u; // pier list uv_timer_t tim_u; // gc timer } u3_king; @@ -885,7 +884,17 @@ /* u3_lord_exit(): shutdown gracefully. */ void - u3_lord_exit(u3_lord* god_u, c3_w cod_w); + u3_lord_exit(u3_lord* god_u); + + /* u3_lord_stall(): send SIGINT + */ + void + u3_lord_stall(u3_lord* god_u); + + /* u3_lord_halt(): shutdown immediately + */ + void + u3_lord_halt(u3_lord* god_u); /* u3_lord_save(): save a snapshot. */ @@ -1204,12 +1213,12 @@ /* u3_pier_bail(): immediately shutdown.. */ void - u3_pier_bail(void); + u3_pier_bail(u3_pier* pir_u); - /* u3_pier_halt(): emergency release. + /* u3_pier_halt(): emergency resource release (ie, on SIGABRT). */ void - u3_pier_halt(void); + u3_pier_halt(u3_pier* pir_u); /* u3_pier_save(): request checkpoint. */ @@ -1221,14 +1230,9 @@ c3_o u3_pier_pack(u3_pier* pir_u); - /* u3_pier_stub(): get the One Pier for unreconstructed code. - */ - u3_pier* - u3_pier_stub(void); - /* u3_pier_boot(): start the new pier system. */ - void + u3_pier* u3_pier_boot(c3_w wag_w, // config flags u3_noun who, // identity u3_noun ven, // boot event @@ -1237,7 +1241,7 @@ /* u3_pier_stay(): restart the new pier system. */ - void + u3_pier* u3_pier_stay(c3_w wag_w, u3_noun pax); /* u3_pier_tank(): dump single tank. @@ -1285,6 +1289,26 @@ void u3_king_commence(); + /* u3_king_stub(): get the One Pier for unreconstructed code. + */ + u3_pier* + u3_king_stub(void); + + /* u3_king_done(): all piers closed + */ + void + u3_king_done(void); + + /* u3_king_exit(): shutdown gracefully + */ + void + u3_king_exit(void); + + /* u3_king_halt(): emergency release. + */ + void + u3_king_halt(void); + /* u3_king_bail(): immediately shutdown. */ void diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c index edd2ac01b..67de82bf2 100644 --- a/pkg/urbit/vere/io/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -463,7 +463,7 @@ _ames_io_start(u3_ames* sam_u) // XX revise // - u3_pier_exit(u3_pier_stub()); + u3_pier_bail(u3_king_stub()); } uv_udp_getsockname(&sam_u->wax_u, (struct sockaddr *)&add_u, &add_i); diff --git a/pkg/urbit/vere/io/term.c b/pkg/urbit/vere/io/term.c index f92c3748d..890bd407c 100644 --- a/pkg/urbit/vere/io/term.c +++ b/pkg/urbit/vere/io/term.c @@ -737,7 +737,10 @@ _term_suck(u3_utty* uty_u, const c3_y* buf, ssize_t siz_i) // then corrupts the event log), so we force shutdown. // u3l_log("term: hangup (EOF)\r\n"); - u3_pier_exit(u3_pier_stub()); + + // XX revise + // + u3_pier_bail(u3_king_stub()); } else if ( siz_i < 0 ) { u3l_log("term %d: read: %s\n", uty_u->tid_l, uv_strerror(siz_i)); diff --git a/pkg/urbit/vere/king.c b/pkg/urbit/vere/king.c index 021e61573..a859cc06d 100644 --- a/pkg/urbit/vere/king.c +++ b/pkg/urbit/vere/king.c @@ -168,7 +168,10 @@ _daemon_boot(u3_noun bul) void _daemon_fake(u3_noun ship, u3_noun pill, u3_noun path) { - u3_pier_boot(sag_w, ship, u3nc(c3__fake, u3k(ship)), pill, path); + // XX link properly + // + u3_noun vent = u3nc(c3__fake, u3k(ship)); + u3K.pir_u = u3_pier_boot(sag_w, ship, vent, pill, path); } /* _daemon_come(): mine a comet under star (unit) @@ -197,7 +200,10 @@ _daemon_dawn(u3_noun seed, u3_noun pill, u3_noun path) // u3C.slog_f = _daemon_slog; - u3_pier_boot(sag_w, u3k(u3h(seed)), u3_dawn_vent(seed), pill, path); + // XX link properly + // + u3_noun vent = u3_dawn_vent(seed); + u3K.pir_u = u3_pier_boot(sag_w, u3k(u3h(seed)), vent, pill, path); // disable ivory slog printfs // @@ -215,7 +221,7 @@ _daemon_pier(u3_noun pier) exit(1); } - u3_pier_stay(sag_w, u3k(u3t(pier))); + u3K.pir_u = u3_pier_stay(sag_w, u3k(u3t(pier))); u3z(pier); } @@ -574,7 +580,7 @@ _daemon_sign_cb(uv_signal_t* sil_u, c3_i num_i) } case SIGTERM: { - u3_pier_exit(u3_pier_stub()); + u3_king_exit(); break; } @@ -722,13 +728,104 @@ u3_king_commence() _daemon_loop_exit(); } +/* u3_king_stub(): get the One Pier for unreconstructed code. +*/ +u3_pier* +u3_king_stub(void) +{ + if ( !u3K.pir_u ) { + c3_assert(!"king: no pier"); + } + else { + return u3K.pir_u; + } +} + +/* _king_forall(): run on all piers +*/ +static void +_king_forall(void (*pir_f)(u3_pier*)) +{ + u3_pier* pir_u = u3K.pir_u; + + while ( pir_u ) { + pir_f(pir_u); + pir_u = pir_u->nex_u; + } +} + +/* _king_forall_unlink(): run on all piers, unlinking from king. +*/ +static void +_king_forall_unlink(void (*pir_f)(u3_pier*)) +{ + u3_pier* pir_u = u3K.pir_u; + + while ( u3K.pir_u ) { + u3_pier* pir_u = u3K.pir_u; + u3K.pir_u = pir_u->nex_u; + pir_f(pir_u); + } +} + +/* _king_done_cb(): +*/ +static void +_king_done_cb(uv_handle_t* han_u) +{ + if( UV_EBUSY == uv_loop_close(u3L) ) { + // XX uncomment to debug + // + // fprintf(stderr, "\r\nking: open libuv handles\r\n"); + // uv_print_all_handles(u3L, stderr); + // fprintf(stderr, "\r\nking: force shutdown\r\n"); + + uv_stop(u3L); + } +} + +/* u3_king_done(): all piers closed. s/b callback +*/ +void +u3_king_done(void) +{ + uv_handle_t* han_u = (uv_handle_t*)&u3K.tim_u; + + // XX hack, if pier's are still linked, we're not actually done + // + if ( !u3K.pir_u && !uv_is_closing(han_u) ) { + uv_close((uv_handle_t*)&u3K.tim_u, _king_done_cb); + _daemon_sign_close(); + + u3_term_log_exit(); + fflush(stdout); + } +} + +/* u3_king_exit(): shutdown gracefully +*/ +void +u3_king_exit(void) +{ + _king_forall(u3_pier_exit); +} + +/* u3_king_halt(): emergency release +*/ +void +u3_king_halt(void) +{ + _king_forall_unlink(u3_pier_halt); +} + /* u3_king_bail(): immediately shutdown. */ void u3_king_bail(void) { + _king_forall_unlink(u3_pier_bail); _daemon_loop_exit(); - u3_pier_bail(); + u3_king_done(); exit(1); } @@ -750,7 +847,7 @@ u3_king_grab(void* vod_p) c3_c* wen_c = u3r_string(wen); c3_c nam_c[2048]; - snprintf(nam_c, 2048, "%s/.urb/put/mass", u3_pier_stub()->pax_c); + snprintf(nam_c, 2048, "%s/.urb/put/mass", u3_king_stub()->pax_c); struct stat st; if ( -1 == stat(nam_c, &st) ) { diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 3f918535f..640ae0306 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -53,6 +53,112 @@ -- */ +/* _lord_stop_cb(): finally all done. +*/ +static void +_lord_stop_cb(void* ptr_v, + const c3_c* err_c) +{ + u3_lord* god_u = ptr_v; + + void (*exit_f)(void*) = god_u->cb_u.exit_f; + void* exit_v = god_u->cb_u.vod_p; + + c3_free(god_u); + + if ( exit_f ) { + exit_f(exit_v); + } +} + +/* _lord_writ_free(): dispose of pending writ. +*/ +static void +_lord_writ_free(u3_writ* wit_u) +{ + switch ( wit_u->typ_e ) { + default: c3_assert(0); + + case u3_writ_work: { + // XX confirm + // + u3_ovum* egg_u = wit_u->wok_u.egg_u; + u3_auto_drop(egg_u->car_u, egg_u); + u3z(wit_u->wok_u.job); + } break; + + case u3_writ_peek: { + u3z(wit_u->pek_u->now); + u3z(wit_u->pek_u->gan); + u3z(wit_u->pek_u->ful); + } break; + + case u3_writ_play: { + u3_fact* tac_u = wit_u->fon_u.ext_u; + u3_fact* nex_u; + + while ( tac_u ) { + nex_u = tac_u->nex_u; + u3_fact_free(tac_u); + tac_u = nex_u; + } + } break; + + case u3_writ_save: + case u3_writ_pack: + case u3_writ_exit: { + } break; + } + + c3_free(wit_u); +} + +/* _lord_bail_noop(): ignore subprocess error on shutdown +*/ +static void +_lord_bail_noop(void* ptr_v, + const c3_c* err_c) +{ +} + +/* _lord_stop(): close and dispose all resources. +*/ +static void +_lord_stop(u3_lord* god_u) +{ + // dispose outstanding writs + // + { + u3_writ* wit_u = god_u->ext_u; + u3_writ* nex_u; + + while ( wit_u ) { + nex_u = wit_u->nex_u; + _lord_writ_free(wit_u); + wit_u = nex_u; + } + + god_u->ent_u = god_u->ext_u = 0; + } + + u3_newt_moat_stop(&god_u->out_u, _lord_stop_cb); + u3_newt_mojo_stop(&god_u->inn_u, _lord_bail_noop); + + uv_close((uv_handle_t*)&god_u->cub_u, 0); +} + +/* _lord_bail(): serf/lord error. +*/ +static void +_lord_bail(u3_lord* god_u) +{ + void (*bail_f)(void*) = god_u->cb_u.bail_f; + void* bail_v = god_u->cb_u.vod_p; + + u3_lord_halt(god_u); + bail_f(bail_v); +} + /* _lord_writ_pop(): pop the writ stack. */ static u3_writ* @@ -103,58 +209,13 @@ _lord_writ_need(u3_lord* god_u, u3_writ_type typ_e) fprintf(stderr, "lord: unexpected %%%s, expected %%%s\r\n", _lord_writ_str(typ_e), _lord_writ_str(wit_u->typ_e)); - u3_pier_bail(); - exit(1); + _lord_bail(god_u); + return 0; } return wit_u; } -/* _lord_on_k(): handle subprocess exit. -*/ -static void -_lord_on_exit(uv_process_t* req_u, - c3_ds sas_i, - c3_i sig_i) -{ - u3_lord* god_u = (void*)req_u; - - { - void (*exit_f)(void*, c3_o) = god_u->cb_u.exit_f; - void* vod_p = god_u->cb_u.vod_p; - - // XX correct comparison? - // - c3_o ret_o = ( u3_writ_exit != god_u->ext_u->typ_e ) - ? c3n - : ( god_u->ext_u->xit_w == sas_i ) - ? c3y : c3n; - - // XX dispose god_u - // - exit_f(vod_p, c3y); - } -} - -/* _lord_bail_noop(): ignore subprocess error on shutdown -*/ -static void -_lord_bail_noop(void* vod_p, - const c3_c* err_c) -{ -} - -/* _lord_bail(): handle subprocess error. -*/ -static void -_lord_bail(void* vod_p, - const c3_c* err_c) -{ - // XX exit? - // - fprintf(stderr, "\rpier: work error: %s\r\n", err_c); -} - /* _lord_plea_foul(): */ static void @@ -167,9 +228,11 @@ _lord_plea_foul(u3_lord* god_u, c3_m mot_m, u3_noun dat) fprintf(stderr, "lord: received invalid %%%.4s $plea\r\n", (c3_c*)&mot_m); } - u3m_p("plea", dat); - u3_pier_bail(); - exit(1); + // XX can't unconditionally print + // + // u3m_p("plea", dat); + + _lord_bail(god_u); } /* _lord_plea_live(): hear serf %live ack @@ -207,8 +270,8 @@ _lord_plea_ripe(u3_lord* god_u, u3_noun dat) { if ( c3y == god_u->liv_o ) { fprintf(stderr, "lord: received unexpected %%ripe\n"); - u3_pier_bail(); - exit(1); + _lord_bail(god_u); + return; } { @@ -230,8 +293,8 @@ _lord_plea_ripe(u3_lord* god_u, u3_noun dat) if ( 1 != pro_y ) { fprintf(stderr, "pier: unsupported ipc protocol version %u\r\n", pro_y); - u3_pier_bail(); - exit(1); + _lord_bail(god_u); + return; } god_u->eve_d = eve_d; @@ -276,6 +339,7 @@ _lord_plea_peek(u3_lord* god_u, u3_noun dat) { u3_writ* wit_u = _lord_writ_need(god_u, u3_writ_peek); pek_u = wit_u->pek_u; + c3_free(wit_u); } // XX cache [dat] (unless last) @@ -533,12 +597,12 @@ _lord_plea_work(u3_lord* god_u, u3_noun dat) u3z(dat); } -/* _lord_plea(): handle plea from serf. +/* _lord_on_plea(): handle plea from serf. */ static void -_lord_plea(void* vod_p, u3_noun mat) +_lord_on_plea(void* ptr_v, u3_noun mat) { - u3_lord* god_u = vod_p; + u3_lord* god_u = ptr_v; u3_noun jar = u3ke_cue(mat); u3_noun tag, dat; @@ -634,9 +698,9 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) } break; case u3_writ_exit: { - // XX u3_newt_close on send + // requested exit code is always 0 // - msg = u3nt(c3__live, c3__exit, u3i_words(1, &wit_u->xit_w)); + msg = u3nt(c3__live, c3__exit, 0); } break; } @@ -649,16 +713,16 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) static void _lord_writ_send(u3_lord* god_u, u3_writ* wit_u) { - _lord_writ_jam(god_u, wit_u); - u3_newt_write(&god_u->inn_u, wit_u->mat); - wit_u->mat = 0; - - // ignore subprocess error on shutdown + // exit expected // if ( u3_writ_exit == wit_u->typ_e ) { god_u->out_u.bal_f = _lord_bail_noop; god_u->inn_u.bal_f = _lord_bail_noop; } + + _lord_writ_jam(god_u, wit_u); + u3_newt_write(&god_u->inn_u, wit_u->mat); + wit_u->mat = 0; } /* _lord_writ_plan(): enqueue a writ and send. @@ -848,12 +912,67 @@ u3_lord_pack(u3_lord* god_u) /* u3_lord_exit(): shutdown gracefully. */ void -u3_lord_exit(u3_lord* god_u, c3_w cod_w) +u3_lord_exit(u3_lord* god_u) { u3_writ* wit_u = _lord_writ_new(god_u); wit_u->typ_e = u3_writ_exit; - wit_u->xit_w = cod_w; _lord_writ_plan(god_u, wit_u); + + // XX set timer, then halt +} + +/* u3_lord_stall(): send SIGINT +*/ +void +u3_lord_stall(u3_lord* god_u) +{ + uv_process_kill(&god_u->cub_u, SIGINT); +} + +/* u3_lord_halt(): shutdown immediately +*/ +void +u3_lord_halt(u3_lord* god_u) +{ + // no exit callback on halt + // + god_u->cb_u.exit_f = 0; + + uv_process_kill(&god_u->cub_u, SIGKILL); + _lord_stop(god_u); +} + +/* _lord_on_serf_exit(): handle subprocess exit. +*/ +static void +_lord_on_serf_exit(uv_process_t* req_u, + c3_ds sas_i, + c3_i sig_i) +{ + + u3_lord* god_u = (void*)req_u; + + if ( !god_u->ext_u + || !(u3_writ_exit == god_u->ext_u->typ_e) ) + { + fprintf(stderr, "pier: work exit: status %" PRId64 ", signal %d\r\n", + sas_i, sig_i); + _lord_bail(god_u); + } + else { + _lord_stop(god_u); + } +} + +/* _lord_on_serf_bail(): handle subprocess error. +*/ +static void +_lord_on_serf_bail(void* ptr_v, + const c3_c* err_c) +{ + u3_lord* god_u = ptr_v; + u3l_log("pier: serf error: %s\r\n", err_c); + _lord_bail(god_u); } /* u3_lord_init(): instantiate child process. @@ -921,7 +1040,7 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) god_u->ops_u.stdio = god_u->cod_u; god_u->ops_u.stdio_count = 3; - god_u->ops_u.exit_cb = _lord_on_exit; + god_u->ops_u.exit_cb = _lord_on_serf_exit; god_u->ops_u.file = arg_c[0]; god_u->ops_u.args = arg_c; @@ -936,13 +1055,13 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) // { god_u->out_u.ptr_v = god_u; - god_u->out_u.pok_f = _lord_plea; - god_u->out_u.bal_f = _lord_bail; + god_u->out_u.pok_f = _lord_on_plea; + god_u->out_u.bal_f = _lord_on_serf_bail; // XX distinguish from out_u.bal_f ? // god_u->inn_u.ptr_v = god_u; - god_u->inn_u.bal_f = _lord_bail; + god_u->inn_u.bal_f = _lord_on_serf_bail; u3_newt_read(&god_u->out_u); } diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 7e6ead75b..d12dd843d 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -592,7 +592,7 @@ _pier_play(u3_play* pay_u) // // XX graceful shutdown // // // u3_lord_save(pir_u->god_u); - // u3_pier_bail(); + // u3_pier_bail(pir_u); // exit(0); // XX temporary hack @@ -631,7 +631,7 @@ _pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) tac_u->eve_d, tac_u->mug_l, mug_l); - // u3_pier_bail(); + // u3_pier_bail(pir_u); } // dispose successful @@ -680,7 +680,7 @@ _pier_on_lord_play_bail(void* vod_p, u3_info fon_u, (c3_d)(eve_d - 1ULL), las_l, mug_l); - // u3_pier_bail(); + // u3_pier_bail(pir_u); } // XX enable to retry @@ -716,7 +716,7 @@ _pier_on_lord_play_bail(void* vod_p, u3_info fon_u, u3_pier_punt_ovum("play", u3k(wir), u3k(tag)); } - u3_pier_bail(); + u3_pier_bail(pir_u); exit(1); } #endif @@ -785,7 +785,7 @@ _pier_on_disk_read_bail(void* vod_p, c3_d eve_d) // fprintf(stderr, "pier: disk read bail\r\n"); u3_term_stop_spinner(); - u3_pier_bail(); + u3_pier_bail(pir_u); } /* _pier_on_disk_write_done(): event log write success. @@ -833,7 +833,7 @@ _pier_on_disk_write_bail(void* vod_p, c3_d eve_d) // XX // fprintf(stderr, "pier: disk write bail\r\n"); - u3_pier_bail(); + u3_pier_bail(pir_u); } /* _pier_on_lord_slog(): debug printf from worker. @@ -883,35 +883,56 @@ _pier_on_lord_pack(void* vod_p) // if ( u3_psat_play == pir_u->sat_e ) { u3l_log("pier: pack complete, shutting down\r\n"); - u3_pier_bail(); + u3_pier_bail(pir_u); exit(0); } // if ( u3_psat_done == pir_u->sat_e ) { // fprintf(stderr, "snap cb exit\r\n"); - // u3_lord_exit(pir_u->god_u, 0); + // u3_lord_exit(pir_u->god_u); // } // else { // _pier_next(pir_u); // } } +static void +_pier_done(u3_pier* pir_u); + /* _pier_on_lord_exit(): worker shutdown. */ static void -_pier_on_lord_exit(void* vod_p, c3_o ret_o) +_pier_on_lord_exit(void* vod_p) { u3_pier* pir_u = vod_p; - if ( u3_psat_done == pir_u->sat_e ) { - if ( c3n == ret_o ) { - u3l_log("pier: serf shutdown dirty\r\n"); - } - } - else { + // the lord has already gone + // + pir_u->god_u = 0; + + if ( u3_psat_done != pir_u->sat_e ) { u3l_log("pier: serf shutdown unexpected\r\n"); - u3_pier_bail(); + u3_pier_bail(pir_u); } + // if we made it all the way here, it's our jab to wrap up + // + else { + _pier_done(pir_u); + } +} + +/* _pier_on_lord_bail(): worker error. +*/ +static void +_pier_on_lord_bail(void* vod_p) +{ + u3_pier* pir_u = vod_p; + + // the lord has already gone + // + pir_u->god_u = 0; + + u3_pier_bail(pir_u); } /* _pier_on_lord_live(): worker is ready. @@ -1031,6 +1052,7 @@ _pier_init(c3_w wag_w, c3_c* pax_c) .work_bail_f = _pier_on_lord_work_bail, .save_f = _pier_on_lord_save, .pack_f = _pier_on_lord_pack, + .bail_f = _pier_on_lord_bail, .exit_f = _pier_on_lord_exit }; @@ -1042,26 +1064,12 @@ _pier_init(c3_w wag_w, c3_c* pax_c) } } - // install in the pier table - // - // XX u3_king_plan - // - if ( 0 == u3K.all_w ) { - u3K.all_w = 16; - u3K.tab_u = c3_malloc(16 * sizeof(u3_pier*)); - } - if ( u3K.len_w == u3K.all_w ) { - u3K.all_w = 2 * u3K.all_w; - u3K.tab_u = c3_realloc(u3K.tab_u, u3K.all_w * sizeof(u3_pier*)); - } - u3K.tab_u[u3K.len_w++] = pir_u; - return pir_u; } /* u3_pier_stay(): restart an existing pier. */ -void +u3_pier* u3_pier_stay(c3_w wag_w, u3_noun pax) { u3_pier* pir_u = _pier_init(wag_w, u3r_string(pax)); @@ -1072,11 +1080,13 @@ u3_pier_stay(c3_w wag_w, u3_noun pax) fprintf(stderr, "pier: disk read meta fail\r\n"); // XX dispose // - u3_pier_bail(); + u3_pier_bail(pir_u); exit(1); } u3z(pax); + + return pir_u; } /* _pier_pill_parse(): extract boot formulas and module/userspace ova from pill @@ -1265,7 +1275,7 @@ _pier_boot_plan(u3_pier* pir_u, u3_noun who, u3_noun ven, u3_noun pil) /* u3_pier_boot(): start a new pier. */ -void +u3_pier* u3_pier_boot(c3_w wag_w, // config flags u3_noun who, // identity u3_noun ven, // boot event @@ -1278,11 +1288,13 @@ u3_pier_boot(c3_w wag_w, // config flags fprintf(stderr, "pier: boot plan fail\r\n"); // XX dispose // - u3_pier_bail(); + u3_pier_bail(pir_u); exit(1); } u3z(pax); + + return pir_u; } static void @@ -1353,29 +1365,51 @@ u3_pier_pack(u3_pier* pir_u) } static void -_pier_exit_work_cb(uv_handle_t* idl_u) +_pier_work_close_cb(uv_handle_t* idl_u) { u3_work* wok_u = idl_u->data; c3_free(wok_u); } -/* _pier_exit_cb(): synchronous shutdown. +static void +_pier_work_close(u3_work* wok_u) +{ + u3_auto_exit(wok_u->car_u); + + // free pending effects + // + { + u3_gift* gif_u = wok_u->fec_u.ext_u; + u3_gift* nex_u; + + while ( gif_u ) { + nex_u = gif_u->nex_u; + u3_gift_free(gif_u); + gif_u = nex_u; + } + } + + uv_close((uv_handle_t*)&wok_u->pep_u, _pier_work_close_cb); + uv_close((uv_handle_t*)&wok_u->cek_u, 0); + uv_close((uv_handle_t*)&wok_u->idl_u, 0); + wok_u->pep_u.data = wok_u; +} + +static void +_pier_done(u3_pier* pir_u) +{ + // XX unlink properly + // + u3K.pir_u = 0; + u3_king_done(); +} + +/* _pier_exit(): synchronous shutdown. */ static void -_pier_exit_cb(void* vod_p, c3_d eve_d) +_pier_exit(u3_pier* pir_u) { - u3_pier* pir_u = vod_p; - - if ( pir_u->wok_u ) { - u3_work* wok_u = pir_u->wok_u; - u3_auto_exit(wok_u->car_u); - // XX confirm, libuv close callback are fired with a stack discipline - // - uv_close((uv_handle_t*)&wok_u->pep_u, _pier_exit_work_cb); - uv_close((uv_handle_t*)&wok_u->cek_u, 0); - uv_close((uv_handle_t*)&wok_u->idl_u, 0); - pir_u->wok_u = 0; - } + c3_assert( u3_psat_done == pir_u->sat_e ); if ( pir_u->log_u ) { u3_disk_exit(pir_u->log_u); @@ -1383,17 +1417,46 @@ _pier_exit_cb(void* vod_p, c3_d eve_d) } if ( pir_u->god_u ) { - u3_lord_exit(pir_u->god_u, 0); + u3_lord_exit(pir_u->god_u); pir_u->god_u = 0; } + else { + // otherwise called in _pier_on_lord_exit() + // + _pier_done(pir_u); + } +} - u3_term_log_exit(); +/* _pier_work_exit(): commence graceful shutdown. +*/ +static void +_pier_work_exit_cb(void* vod_p, c3_d eve_d) +{ + u3_pier* pir_u = vod_p; - // XX uninstall pier from u3K.tab_u, dispose + _pier_work_close(pir_u->wok_u); + pir_u->wok_u = 0; - // XX no can do + _pier_exit(pir_u); +} + +/* _pier_work_exit(): setup graceful shutdown callbacks. +*/ +static void +_pier_work_exit(u3_pier* pir_u) +{ + _pier_wall_plan(pir_u, 0, pir_u, _pier_save_cb); + _pier_wall_plan(pir_u, 0, pir_u, _pier_work_exit_cb); + + // XX moveme, XX bails if not started // - uv_stop(u3L); + { + c3_l cod_l = u3a_lush(c3__save); + u3_save_io_exit(pir_u); + u3a_lop(cod_l); + } + + pir_u->sat_e = u3_psat_done; } /* u3_pier_exit(): graceful shutdown. @@ -1401,60 +1464,21 @@ _pier_exit_cb(void* vod_p, c3_d eve_d) void u3_pier_exit(u3_pier* pir_u) { - // fprintf(stderr, "pier: exit\r\n"); - switch ( pir_u->sat_e ) { - // XX specifically handle init/done? - // default: { - fprintf(stderr, "pier: unexpected exit: %u\r\n", pir_u->sat_e); + fprintf(stderr, "pier: unknown exit: %u\r\n", pir_u->sat_e); c3_assert(0); } - case u3_psat_boot: { - // XX properly dispose boot - // - c3_free(pir_u->bot_u); - pir_u->bot_u = 0; - _pier_exit_cb(pir_u, 0); - } break; + case u3_psat_done: return; - case u3_psat_play: { - // XX dispose play q - // - c3_free(pir_u->pay_u); - pir_u->pay_u = 0; - _pier_exit_cb(pir_u, 0); - } break; + case u3_psat_work: return _pier_work_exit(pir_u); - case u3_psat_work: { - _pier_wall_plan(pir_u, 0, pir_u, _pier_save_cb); - _pier_wall_plan(pir_u, 0, pir_u, _pier_exit_cb); - - // XX moveme - // - { - c3_l cod_l = u3a_lush(c3__save); - u3_save_io_exit(pir_u); - u3a_lop(cod_l); - } - } break; - } - - u3K.len_w = 0; - pir_u->sat_e = u3_psat_done; -} - -/* _pier_exit_done(): force synchronous shut down. -*/ -static void -_pier_exit_done(u3_pier* pir_u) -{ - switch ( pir_u->sat_e ) { - default: break; + case u3_psat_init: break; case u3_psat_boot: { // XX properly dispose boot + // XX also on actual boot // c3_free(pir_u->bot_u); pir_u->bot_u = 0; @@ -1466,47 +1490,54 @@ _pier_exit_done(u3_pier* pir_u) c3_free(pir_u->pay_u); pir_u->pay_u = 0; } break; - - case u3_psat_work: { - // XX moveme - // - { - c3_l cod_l = u3a_lush(c3__save); - u3_save_io_exit(pir_u); - u3a_lop(cod_l); - } - } break; } - u3K.len_w = 0; pir_u->sat_e = u3_psat_done; - _pier_exit_cb(pir_u, 0); + _pier_exit(pir_u); } -/* u3_pier_bail(): immediately shutdown. +/* u3_pier_bail(): immediately shutdown due to error. */ void -u3_pier_bail(void) +u3_pier_bail(u3_pier* pir_u) { - if ( 0 != u3K.len_w ) { - _pier_exit_done(u3_pier_stub()); + pir_u->sat_e = u3_psat_done; + + // + if ( pir_u->god_u ) { + u3_lord_halt(pir_u->god_u); + pir_u->god_u = 0; } - fflush(stdout); - exit(1); + // exig i/o drivers + // + if ( pir_u->wok_u ) { + _pier_work_close(pir_u->wok_u); + pir_u->wok_u = 0; + } + + // close db + // + if ( pir_u->log_u ) { + u3_disk_exit(pir_u->log_u); + pir_u->log_u = 0; + } + + _pier_done(pir_u); } -/* u3_pier_halt(): emergency release. +/* u3_pier_halt(): emergency resource release (ie, on SIGABRT). */ void -u3_pier_halt(void) +u3_pier_halt(u3_pier* pir_u) { - if ( 0 != u3K.len_w ) { - u3_disk_exit(u3_pier_stub()->log_u); - - // we should only ever try this trick once - // - u3K.len_w = 0; + // unmap disk if present + // + // XX maybe skip close/cancel/free. and just unmap + // + if ( pir_u->log_u ) { + u3_disk_exit(pir_u->log_u); + pir_u->log_u = 0; } } @@ -1519,7 +1550,7 @@ c3_rand(c3_w* rad_w) fprintf(stderr, "c3_rand getentropy: %s\n", strerror(errno)); // XX review // - u3_pier_bail(); + u3_king_bail(); } } @@ -1691,19 +1722,6 @@ u3_pier_sway(c3_l tab_l, u3_noun tax) u3z(mok); } -/* u3_pier_stub(): get the One Pier for unreconstructed code. -*/ -u3_pier* -u3_pier_stub(void) -{ - if ( 0 == u3K.len_w ) { - c3_assert(!"plan: no pier"); - } - else { - return u3K.tab_u[0]; - } -} - /* u3_pier_mark(): mark all Loom allocations in all u3_pier structs. */ c3_w From 37cf2135bc31fd20288a4fddd41e6f052858bf25 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 22 Jun 2020 10:32:08 -0700 Subject: [PATCH 181/257] term: ignore SIGWINCH if there's no active terminal driver --- pkg/urbit/vere/io/term.c | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/vere/io/term.c b/pkg/urbit/vere/io/term.c index 890bd407c..3bd3da929 100644 --- a/pkg/urbit/vere/io/term.c +++ b/pkg/urbit/vere/io/term.c @@ -977,13 +977,16 @@ u3_term_get_blew(c3_l tid_l) void u3_term_ef_winc(void) { - u3_noun wir = u3nt(c3__term, '1', u3_nul); - u3_noun cad = u3nc(c3__blew, u3_term_get_blew(1)); + // XX groace, this should be a global handler sent to each pier + // + if ( u3_Host.uty_u->car_u ) { + u3_noun wir = u3nt(c3__term, '1', u3_nul); + u3_noun cad = u3nc(c3__blew, u3_term_get_blew(1)); - c3_assert( 1 == u3_Host.uty_u->tid_l ); - c3_assert( u3_Host.uty_u->car_u ); + c3_assert( 1 == u3_Host.uty_u->tid_l ); - _term_ovum_plan(u3_Host.uty_u->car_u, wir, cad); + _term_ovum_plan(u3_Host.uty_u->car_u, wir, cad); + } } /* u3_term_ef_ctlc(): send ^C on console. From 98164348908558217e9aaaa397b130259f5e6fbd Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 19 Jun 2020 16:01:13 -0700 Subject: [PATCH 182/257] vere: cleans up i/o driver shutdown --- pkg/urbit/vere/io/fore.c | 1 + pkg/urbit/vere/io/term.c | 36 ++++++++++++++++++++++++------------ 2 files changed, 25 insertions(+), 12 deletions(-) diff --git a/pkg/urbit/vere/io/fore.c b/pkg/urbit/vere/io/fore.c index 5cbac0144..fd2a3962a 100644 --- a/pkg/urbit/vere/io/fore.c +++ b/pkg/urbit/vere/io/fore.c @@ -58,6 +58,7 @@ _fore_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) static void _fore_io_exit(u3_auto* car_u) { + c3_free(car_u); } /* u3_fore_io_init(): initialize fore diff --git a/pkg/urbit/vere/io/term.c b/pkg/urbit/vere/io/term.c index 3bd3da929..e89a7419f 100644 --- a/pkg/urbit/vere/io/term.c +++ b/pkg/urbit/vere/io/term.c @@ -261,10 +261,7 @@ u3_term_log_init(void) void u3_term_log_exit(void) { - if ( c3y == u3_Host.ops_u.tem ) { - uv_close((uv_handle_t*)&u3_Host.uty_u->pop_u, 0); - } - else { + if ( c3n == u3_Host.ops_u.tem ) { u3_utty* uty_u; for ( uty_u = u3_Host.uty_u; uty_u; uty_u = uty_u->nex_u ) { @@ -276,12 +273,11 @@ u3_term_log_exit(void) c3_assert(!"exit-fcntl"); } _write(uty_u->fid_i, "\r\n", 2); - - uv_close((uv_handle_t*)&uty_u->tat_u.sun_u.tim_u, 0); } } -} + uv_close((uv_handle_t*)&u3_Host.uty_u->pop_u, 0); +} /* _term_tcsetattr(): tcsetattr w/retry on EINTR. */ @@ -1402,17 +1398,33 @@ _term_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) return ret_o; } +static void +_term_io_exit_cb(uv_handle_t* han_u) +{ + u3_auto* car_u = han_u->data; + c3_free(car_u); +} + /* _term_io_exit(): clean up terminal. */ static void _term_io_exit(u3_auto* car_u) { - if ( c3n == u3_Host.ops_u.tem ) { - u3_utty* uty_u = _term_main(); - uv_read_stop((uv_stream_t*)&(uty_u->pop_u)); - } + u3_utty* uty_u = _term_main(); - c3_free(car_u); + // NB, closed in u3_term_log_exit() + // + uv_read_stop((uv_stream_t*)&(uty_u->pop_u)); + + if ( c3n == u3_Host.ops_u.tem ) { + uv_timer_t* han_u = &(uty_u->tat_u.sun_u.tim_u); + han_u->data = car_u; + + uv_close((uv_handle_t*)han_u, _term_io_exit_cb); + } + else { + c3_free(car_u); + } } /* u3_term_io_init(): initialize terminal From e7a95f6d6bf04989591e7cb355fa9c5a15210289 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 22 Jun 2020 13:07:34 -0700 Subject: [PATCH 183/257] ames: count dropped packets (and print every 1k with -v) --- pkg/urbit/vere/io/ames.c | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c index 67de82bf2..41f6edaa1 100644 --- a/pkg/urbit/vere/io/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -38,6 +38,7 @@ c3_o fak_o; // fake keys c3_s por_s; // public IPv4 port c3_c* dns_c; // domain XX multiple/fallback + c3_d dop_d; // drop count (since last print) c3_w imp_w[256]; // imperial IPs time_t imp_t[256]; // imperial IP timestamps c3_o imp_o[256]; // imperial print status @@ -405,11 +406,18 @@ _ames_recv_cb(uv_udp_t* wax_u, if ( c3__hear == u3h(egg_u->cad) ) { u3_auto_drop(&sam_u->car_u, egg_u); + sam_u->dop_d++; } egg_u = nex_u; } } + + if ( 0 == (sam_u->dop_d % 1000) ) { + if ( (u3C.wag_w & u3o_verbose) ) { + u3l_log("ames: dropped 1.000 packets\r\n"); + } + } } c3_free(buf_u->base); @@ -703,6 +711,7 @@ u3_ames_io_init(u3_pier* pir_u) sam_u->who_d[1] = pir_u->who_d[1]; sam_u->por_s = pir_u->por_s; sam_u->fak_o = pir_u->fak_o; + sam_u->dop_d = 0; c3_assert( !uv_udp_init(u3L, &sam_u->wax_u) ); sam_u->wax_u.data = sam_u; From 76cd93486425319a95440e1351a02b6978801c80 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 22 Jun 2020 14:00:17 -0700 Subject: [PATCH 184/257] pier: further limit activity in emergency exit (SIGABRT) --- pkg/urbit/include/vere/vere.h | 5 +++++ pkg/urbit/vere/disk.c | 12 +++++++++++- pkg/urbit/vere/pier.c | 2 +- 3 files changed, 17 insertions(+), 2 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index aceb09a64..eb0ec3a91 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -832,6 +832,11 @@ u3_disk* u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u); + /* u3_disk_halt(): emergency close. + */ + void + u3_disk_halt(u3_disk* log_u); + /* u3_disk_exit(): close [log_u] and dispose. */ void diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 66b9c2639..2aa323192 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -593,6 +593,17 @@ u3_disk_read_meta(u3_disk* log_u, return c3y; } +/* u3_disk_halt(): emergency close. +*/ +void +u3_disk_halt(u3_disk* log_u) +{ + if ( log_u->mdb_u ) { + u3_lmdb_exit(log_u->mdb_u); + log_u->mdb_u = 0; + } +} + /* u3_disk_exit(): close the log. */ void @@ -616,7 +627,6 @@ u3_disk_exit(u3_disk* log_u) do { sas_i = uv_cancel(&log_u->req_u); - fprintf(stderr, "disk canceling\r\n"); } while ( UV_EBUSY == sas_i ); } diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index d12dd843d..4ae5866f4 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -1536,7 +1536,7 @@ u3_pier_halt(u3_pier* pir_u) // XX maybe skip close/cancel/free. and just unmap // if ( pir_u->log_u ) { - u3_disk_exit(pir_u->log_u); + u3_disk_halt(pir_u->log_u); pir_u->log_u = 0; } } From 829d402dc933814e098238f30d487c8622508da0 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 22 Jun 2020 14:11:38 -0700 Subject: [PATCH 185/257] Revert "TMP kill -9 urbit in test" This reverts commit 6e98bdd3d3eb1343a95f4da8d6309051ef6d8e59. --- nix/ops/test/builder.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/nix/ops/test/builder.sh b/nix/ops/test/builder.sh index 30b968c8f..4a852ab3f 100644 --- a/nix/ops/test/builder.sh +++ b/nix/ops/test/builder.sh @@ -12,7 +12,7 @@ tailproc=$! shutdown () { if [ -e ./ship/.vere.lock ] - then kill -9 $(< ./ship/.vere.lock) || true; + then kill $(< ./ship/.vere.lock) || true; fi kill "$tailproc" || true; From 3330c3eaac125db0d534783cbcb8df6df6d03194 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 22 Jun 2020 15:34:33 -0700 Subject: [PATCH 186/257] vere: disable core dumps in king lmdb size makes these impractical, and unmapping on SIGABRT requires canceling threads, which is undefined --- pkg/urbit/daemon/main.c | 14 -------------- pkg/urbit/include/vere/vere.h | 15 --------------- pkg/urbit/vere/disk.c | 11 ----------- pkg/urbit/vere/king.c | 22 ++++++++++++++-------- pkg/urbit/vere/pier.c | 15 --------------- 5 files changed, 14 insertions(+), 63 deletions(-) diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index dec85ab8c..225fc00c9 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -476,16 +476,6 @@ _stop_exit(c3_i int_i) u3_king_bail(); } -/* _stop_signal(): handle termination signal. -*/ -static void -_stop_signal(c3_i int_i) -{ - // if we have a pier, unmap the event log before dumping core - // - u3_king_halt(); -} - /* This is set to the the write-end of a pipe when Urbit is started in daemon mode. It's meant to be used as a signal to the parent process @@ -642,10 +632,6 @@ main(c3_i argc, // signal(SIGTSTP, _stop_exit); - // Cleanup on SIGABRT. - // - signal(SIGABRT, _stop_signal); - printf("~\n"); // printf("welcome.\n"); printf("urbit %s\n", URBIT_VERSION); diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index eb0ec3a91..3a2103be8 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -832,11 +832,6 @@ u3_disk* u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u); - /* u3_disk_halt(): emergency close. - */ - void - u3_disk_halt(u3_disk* log_u); - /* u3_disk_exit(): close [log_u] and dispose. */ void @@ -1220,11 +1215,6 @@ void u3_pier_bail(u3_pier* pir_u); - /* u3_pier_halt(): emergency resource release (ie, on SIGABRT). - */ - void - u3_pier_halt(u3_pier* pir_u); - /* u3_pier_save(): request checkpoint. */ c3_o @@ -1309,11 +1299,6 @@ void u3_king_exit(void); - /* u3_king_halt(): emergency release. - */ - void - u3_king_halt(void); - /* u3_king_bail(): immediately shutdown. */ void diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 2aa323192..de24c93f8 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -593,17 +593,6 @@ u3_disk_read_meta(u3_disk* log_u, return c3y; } -/* u3_disk_halt(): emergency close. -*/ -void -u3_disk_halt(u3_disk* log_u) -{ - if ( log_u->mdb_u ) { - u3_lmdb_exit(log_u->mdb_u); - log_u->mdb_u = 0; - } -} - /* u3_disk_exit(): close the log. */ void diff --git a/pkg/urbit/vere/king.c b/pkg/urbit/vere/king.c index a859cc06d..a6c53b9c7 100644 --- a/pkg/urbit/vere/king.c +++ b/pkg/urbit/vere/king.c @@ -717,6 +717,20 @@ u3_king_commence() } } + // disable core dumps (due to lmdb size) + // + { + struct rlimit rlm; + + getrlimit(RLIMIT_CORE, &rlm); + rlm.rlim_cur = 0; + + if ( 0 != setrlimit(RLIMIT_CORE, &rlm) ) { + u3l_log("king: unable to disable core dumps: %s\r\n", strerror(errno)); + exit(1); + } + } + // initialize top-level timer // uv_timer_init(u3L, &u3K.tim_u); @@ -810,14 +824,6 @@ u3_king_exit(void) _king_forall(u3_pier_exit); } -/* u3_king_halt(): emergency release -*/ -void -u3_king_halt(void) -{ - _king_forall_unlink(u3_pier_halt); -} - /* u3_king_bail(): immediately shutdown. */ void diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 4ae5866f4..de6eb2340 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -1526,21 +1526,6 @@ u3_pier_bail(u3_pier* pir_u) _pier_done(pir_u); } -/* u3_pier_halt(): emergency resource release (ie, on SIGABRT). -*/ -void -u3_pier_halt(u3_pier* pir_u) -{ - // unmap disk if present - // - // XX maybe skip close/cancel/free. and just unmap - // - if ( pir_u->log_u ) { - u3_disk_halt(pir_u->log_u); - pir_u->log_u = 0; - } -} - /* c3_rand(): fill a 512-bit (16-word) buffer. */ void From cc93aed354e75fa51b28635511fd7dadb39fbd91 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 22 Jun 2020 16:35:15 -0700 Subject: [PATCH 187/257] vere: fixes doubly-linked list handling in u3_auto_drop --- pkg/urbit/include/vere/vere.h | 3 +-- pkg/urbit/vere/auto.c | 43 +++++++++++++++++++++++------------ pkg/urbit/vere/ward.c | 5 ++-- 3 files changed, 32 insertions(+), 19 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 3a2103be8..241620347 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -743,8 +743,7 @@ /* u3_ovum_init: initialize an unlinked potential event */ u3_ovum* - u3_ovum_init(u3_auto* car_u, - c3_l msc_l, + u3_ovum_init(c3_l msc_l, u3_noun tar, u3_noun wir, u3_noun cad); diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 8a7ea08be..839bb2143 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -28,8 +28,13 @@ u3_auto_plan(u3_auto* car_u, u3_noun wir, u3_noun cad) { - u3_ovum *egg_u = u3_ovum_init(car_u, msc_l, tar, wir, cad); + u3_ovum *egg_u = u3_ovum_init(msc_l, tar, wir, cad); + egg_u->car_u = car_u; + + // [pre_u] points towards [ext_u] (back in time) + // [nex_u] points towards [ent_u] (forward in time) + // if ( !car_u->ent_u ) { c3_assert(!car_u->ext_u); @@ -139,21 +144,31 @@ u3_auto_work(u3_ovum* egg_u) void u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) { - if ( egg_u->pre_u ) { - egg_u->pre_u->nex_u = egg_u->nex_u; - } - else { - egg_u->car_u->ent_u = egg_u->nex_u; - } + { + c3_assert( egg_u->car_u ); - if ( egg_u->nex_u ) { - egg_u->nex_u->pre_u = egg_u->pre_u; - } - else { - egg_u->car_u->ext_u = egg_u->pre_u; - } + // the previous ovum (or [ext_u]) will point to our next ovum + // + if ( !egg_u->pre_u ) { + egg_u->car_u->ext_u = egg_u->nex_u; + } + else { + egg_u->pre_u->nex_u = egg_u->nex_u; + } - egg_u->car_u->dep_w--; + // the next ovum (or [ent_u]) will point to our previous ovum + // + if ( !egg_u->nex_u ) { + egg_u->car_u->ent_u = egg_u->pre_u; + } + else { + egg_u->nex_u->pre_u = egg_u->pre_u; + } + + egg_u->car_u->dep_w--; + + egg_u->nex_u = egg_u->pre_u = 0; + } // notify driver if not self-caused // diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c index 25ebf6ac1..e47ccae76 100644 --- a/pkg/urbit/vere/ward.c +++ b/pkg/urbit/vere/ward.c @@ -128,14 +128,13 @@ u3_gift_free(u3_gift *gif_u) /* u3_ovum_init: initialize an unlinked potential event */ u3_ovum* -u3_ovum_init(u3_auto* car_u, - c3_l msc_l, +u3_ovum_init(c3_l msc_l, u3_noun tar, u3_noun wir, u3_noun cad) { u3_ovum* egg_u = c3_malloc(sizeof(*egg_u)); - egg_u->car_u = car_u; + egg_u->car_u = 0; egg_u->vod_p = 0; egg_u->msc_l = msc_l; egg_u->tar = tar; From 5e0f185df2f965fb2719a441a2a7650c9a32ce64 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Mon, 22 Jun 2020 16:09:15 -0700 Subject: [PATCH 188/257] king: Build release tarballs with both king and vere. This adds a new build stage called combine which takes the results of the previous compile builds and packages them up into one release tarball per platform. --- .travis.yml | 19 +++++++++++++++--- sh/combine-release-builds | 41 +++++++++++++++++++++++++++++++++++++++ sh/release | 8 ++++---- 3 files changed, 61 insertions(+), 7 deletions(-) create mode 100755 sh/combine-release-builds diff --git a/.travis.yml b/.travis.yml index 6fbfc591e..6d8d45c44 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,10 +1,15 @@ +stages: + - compile + - combine jobs: include: - - os: linux + - stage: compile + os: linux language: nix nix: 2.3.6 before_install: - git lfs pull + - echo "trusted-users = root travis" | sudo tee -a /etc/nix/nix.conf && sudo pkill nix-daemon install: - nix-env -iA cachix -f https://cachix.org/api/v1/install script: @@ -14,7 +19,8 @@ jobs: - make release - sh/ci-tests - - os: linux + - stage: compile + os: linux language: generic env: STACK_YAML=pkg/hs/stack.yaml cache: @@ -31,7 +37,8 @@ jobs: - stack test - sh/release-king-linux64-dynamic - - os: osx + - stage: compile + os: osx language: generic sudo: required env: STACK_YAML=pkg/hs/stack.yaml @@ -49,6 +56,12 @@ jobs: - stack test - sh/release-king-darwin-dynamic + - stage: combine + os: linux + language: generic + script: + - sh/combine-release-builds + deploy: - skip_cleanup: true provider: gcs diff --git a/sh/combine-release-builds b/sh/combine-release-builds new file mode 100755 index 000000000..844b542f0 --- /dev/null +++ b/sh/combine-release-builds @@ -0,0 +1,41 @@ +#!/usr/bin/env bash + +set -ex + +if [ -n "${TRAVIS_TAG-}" ] +then + ver="$TRAVIS_TAG" +elif [ -n "${TRAVIS_COMMIT-}" ] +then + ver="$TRAVIS_COMMIT" +else + ver="$(git rev-parse HEAD)" +fi + +traced () { + echo '$' "$@" >&2; "$@" +} + +buildTarball () { + local plat=${1} + local haskbin=${2} + + tmp=$(mktemp -d) + mkdir -p $tmp/$ver-$plat + + # Fetch the vere binary and unpack it into its destination + wget "https://bootstrap.urbit.org/vere-$ver-$plat.tgz" + tar xzvf vere-$ver-$plat.tgz --strip=1 -C $tmp/$ver-$plat + + # Fetch king haskell and give it executable permissions. + wget "https://bootstrap.urbit.org/$haskbin-$ver" -O $tmp/$ver-$plat/urbit-king + chmod 555 $tmp/$ver-$plat/urbit-king + + echo "packaging release/$ver-$plat.tgz" + (cd $tmp; tar cz $ver-$plat) > release/$ver-$plat.tgz +} + +mkdir -p release + +buildTarball "linux64" "king-linux64-dynamic" +buildTarball "darwin" "king-darwin-dynamic" diff --git a/sh/release b/sh/release index 10f6ed1b6..0207a9390 100755 --- a/sh/release +++ b/sh/release @@ -23,11 +23,11 @@ do sh/cross urbit "$plat" tmp=$(mktemp -d) - mkdir -p $tmp/$ver-$plat - traced cp -r cross/$plat/* $tmp/$ver-$plat + mkdir -p $tmp/vere-$ver-$plat + traced cp -r cross/$plat/* $tmp/vere-$ver-$plat - echo "packaging release/$ver-$plat.tgz" - (cd $tmp; tar cz $ver-$plat) > release/$ver-$plat.tgz + echo "packaging release/vere-$ver-$plat.tgz" + (cd $tmp; tar cz vere-$ver-$plat) > release/vere-$ver-$plat.tgz rm -rf $tmp done From 7744111486c996bd838860668493e151135e23cb Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Tue, 23 Jun 2020 14:29:36 -0700 Subject: [PATCH 189/257] Don't run combine in pull requests. --- .travis.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 6d8d45c44..68e985d08 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,9 @@ stages: - compile - - combine + # Don't run the combine stage in pull requests, because deploy is disabled there. + - name: combine + if: env(TRAVIS_PULL_REQUEST) = false + jobs: include: - stage: compile From 596f089e2014db44ed6eeb52edefcb64af86dda7 Mon Sep 17 00:00:00 2001 From: Elliot Glaysher Date: Tue, 23 Jun 2020 14:56:21 -0700 Subject: [PATCH 190/257] Change how we detect pull requests. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 68e985d08..e9f7b659f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,7 +2,7 @@ stages: - compile # Don't run the combine stage in pull requests, because deploy is disabled there. - name: combine - if: env(TRAVIS_PULL_REQUEST) = false + if: type != pull_request jobs: include: From dcdd1e4be99fc4a5c6682587fbde5dbddfb1cea6 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 23 Jun 2020 14:31:58 -0700 Subject: [PATCH 191/257] vere: removes now-unused sniproxy dependency --- nix/cachix/local.nix | 1 - nix/crossdeps.nix | 1 - nix/deps-env.nix | 2 +- nix/deps/default.nix | 1 - nix/deps/sni/builder.sh | 13 ------------- nix/deps/sni/cross.nix | 18 ------------------ nix/deps/sni/default.nix | 12 ------------ nix/pkgs/default.nix | 2 +- nix/pkgs/urbit/default.nix | 4 ++-- nix/pkgs/urbit/release.nix | 2 +- nix/pkgs/urbit/shell.nix | 2 +- pkg/urbit/configure | 6 +++--- pkg/urbit/vere/io/http.c | 6 ------ 13 files changed, 9 insertions(+), 61 deletions(-) delete mode 100644 nix/deps/sni/builder.sh delete mode 100644 nix/deps/sni/cross.nix delete mode 100644 nix/deps/sni/default.nix diff --git a/nix/cachix/local.nix b/nix/cachix/local.nix index a1dac3150..753a00a0c 100644 --- a/nix/cachix/local.nix +++ b/nix/cachix/local.nix @@ -13,7 +13,6 @@ let murmur3-src = deps.murmur3.src; scrypt-src = deps.scrypt.src; secp256k1-src = deps.secp256k1.src; - sni-src = deps.sni.src; softfloat3-src = deps.softfloat3.src; uv-src = deps.uv.src; }; diff --git a/nix/crossdeps.nix b/nix/crossdeps.nix index df2829fd9..e942b842b 100644 --- a/nix/crossdeps.nix +++ b/nix/crossdeps.nix @@ -5,7 +5,6 @@ rec { murmur3 = import ./deps/murmur3/cross.nix { inherit crossenv; }; uv = import ./deps/uv/cross.nix { inherit crossenv; }; ed25519 = import ./deps/ed25519/cross.nix { inherit crossenv; }; - sni = import ./deps/sni/cross.nix { inherit crossenv; }; scrypt = import ./deps/scrypt/cross.nix { inherit crossenv; }; softfloat3 = import ./deps/softfloat3/cross.nix { inherit crossenv; }; secp256k1 = import ./deps/secp256k1/cross.nix { inherit crossenv; }; diff --git a/nix/deps-env.nix b/nix/deps-env.nix index c5d9b8c21..6f7357b4f 100644 --- a/nix/deps-env.nix +++ b/nix/deps-env.nix @@ -20,7 +20,7 @@ let vendor = with deps; - [ argon2 ed25519 h2o murmur3 scrypt secp256k1 sni softfloat3 uv ent ge-additions ivory-header ca-header ]; + [ argon2 ed25519 h2o murmur3 scrypt secp256k1 softfloat3 uv ent ge-additions ivory-header ca-header ]; in diff --git a/nix/deps/default.nix b/nix/deps/default.nix index b14746f1a..8f44e7501 100644 --- a/nix/deps/default.nix +++ b/nix/deps/default.nix @@ -5,7 +5,6 @@ rec { murmur3 = import ./murmur3 { inherit pkgs; }; uv = import ./uv { inherit pkgs; }; ed25519 = import ./ed25519 { inherit pkgs; }; - sni = import ./sni { inherit pkgs; }; scrypt = import ./scrypt { inherit pkgs; }; softfloat3 = import ./softfloat3 { inherit pkgs; }; secp256k1 = import ./secp256k1 { inherit pkgs; }; diff --git a/nix/deps/sni/builder.sh b/nix/deps/sni/builder.sh deleted file mode 100644 index c726b58c5..000000000 --- a/nix/deps/sni/builder.sh +++ /dev/null @@ -1,13 +0,0 @@ -source $stdenv/setup - -CFLAGS="-O3 -Wall -ffast-math -Wno-unused-const-variable" - -echo $CC $CFLAGS -c $src/src/tls.c -o tls.o -$CC $CFLAGS -c $src/src/tls.c -o tls.o - -echo $AR rcs libsni.a tls.o -$AR rcs libsni.a tls.o - -mkdir -p $out/{lib,include} -cp libsni.a $out/lib/ -cp $src/src/tls.h $out/include/ diff --git a/nix/deps/sni/cross.nix b/nix/deps/sni/cross.nix deleted file mode 100644 index 69d11152e..000000000 --- a/nix/deps/sni/cross.nix +++ /dev/null @@ -1,18 +0,0 @@ -{ crossenv }: - -crossenv.make_derivation rec { - name = "sni"; - builder = ./builder.sh; - - CC = "${crossenv.host}-gcc"; - AR = "${crossenv.host}-ar"; - - src = crossenv.nixpkgs.fetchFromGitHub { - owner = "urbit"; - repo = "sniproxy"; - rev = "173beb88ee62bddd13874ca04ab338cdec704928"; - sha256 = "1ib6p7vhpvbg6d5a2aimppsb09kjg4px4vlw5h3ys9zf9c1if5z4"; - }; -} - - diff --git a/nix/deps/sni/default.nix b/nix/deps/sni/default.nix deleted file mode 100644 index 506a5df63..000000000 --- a/nix/deps/sni/default.nix +++ /dev/null @@ -1,12 +0,0 @@ -{ pkgs }: - -pkgs.stdenv.mkDerivation rec { - name = "sni"; - builder = ./builder.sh; - src = pkgs.fetchFromGitHub { - owner = "urbit"; - repo = "sniproxy"; - rev = "173beb88ee62bddd13874ca04ab338cdec704928"; - sha256 = "1ib6p7vhpvbg6d5a2aimppsb09kjg4px4vlw5h3ys9zf9c1if5z4"; - }; -} diff --git a/nix/pkgs/default.nix b/nix/pkgs/default.nix index 8356f6eb8..ba1129dd3 100644 --- a/nix/pkgs/default.nix +++ b/nix/pkgs/default.nix @@ -21,7 +21,7 @@ let mkUrbit = { debug }: import ./urbit { inherit pkgs ent debug ge-additions libaes_siv; - inherit (deps) argon2 murmur3 uv ed25519 sni scrypt softfloat3; + inherit (deps) argon2 murmur3 uv ed25519 scrypt softfloat3; inherit (deps) secp256k1 h2o ivory-header ca-header; }; diff --git a/nix/pkgs/urbit/default.nix b/nix/pkgs/urbit/default.nix index 3843be6bc..f9aac848f 100644 --- a/nix/pkgs/urbit/default.nix +++ b/nix/pkgs/urbit/default.nix @@ -1,7 +1,7 @@ { pkgs, debug, - argon2, ed25519, ent, ge-additions, libaes_siv, h2o, murmur3, scrypt, secp256k1, sni, softfloat3, uv, ivory-header, ca-header + argon2, ed25519, ent, ge-additions, libaes_siv, h2o, murmur3, scrypt, secp256k1, softfloat3, uv, ivory-header, ca-header }: let @@ -21,7 +21,7 @@ let [ curl gmp libsigsegv openssl zlib lmdb ]; vendor = - [ argon2 softfloat3 ed25519 ent ge-additions libaes_siv h2o scrypt uv murmur3 secp256k1 sni ivory-header ca-header ]; + [ argon2 softfloat3 ed25519 ent ge-additions libaes_siv h2o scrypt uv murmur3 secp256k1 ivory-header ca-header ]; urbit = pkgs.stdenv.mkDerivation { inherit name meta; diff --git a/nix/pkgs/urbit/release.nix b/nix/pkgs/urbit/release.nix index 40517aba8..9d486f3df 100644 --- a/nix/pkgs/urbit/release.nix +++ b/nix/pkgs/urbit/release.nix @@ -16,7 +16,7 @@ let vendor = with deps; - [ argon2 softfloat3 ed25519 ge-additions libaes_siv h2o scrypt uv murmur3 secp256k1 sni ivory-header ca-header ]; + [ argon2 softfloat3 ed25519 ge-additions libaes_siv h2o scrypt uv murmur3 secp256k1 ivory-header ca-header ]; in diff --git a/nix/pkgs/urbit/shell.nix b/nix/pkgs/urbit/shell.nix index e603ba728..dee99d962 100644 --- a/nix/pkgs/urbit/shell.nix +++ b/nix/pkgs/urbit/shell.nix @@ -12,5 +12,5 @@ import ./default.nix { inherit (tlon) ent ge-additions libaes_siv; inherit (deps) - argon2 ed25519 h2o murmur3 scrypt secp256k1 sni softfloat3 uv ivory-header ca-header; + argon2 ed25519 h2o murmur3 scrypt secp256k1 softfloat3 uv ivory-header ca-header; } diff --git a/pkg/urbit/configure b/pkg/urbit/configure index 90e863463..850b8e13a 100755 --- a/pkg/urbit/configure +++ b/pkg/urbit/configure @@ -4,9 +4,9 @@ set -e URBIT_VERSION="0.10.5" -deps=" \ - curl gmp sigsegv argon2 ed25519 ent h2o scrypt sni uv murmur3 secp256k1 \ - softfloat3 ssl crypto z lmdb ge-additions aes_siv \ +deps=" \ + curl gmp sigsegv argon2 ed25519 ent h2o scrypt uv murmur3 secp256k1 \ + softfloat3 ssl crypto z lmdb ge-additions aes_siv \ " headers=" \ diff --git a/pkg/urbit/vere/io/http.c b/pkg/urbit/vere/io/http.c index 29987d402..a8a3adc60 100644 --- a/pkg/urbit/vere/io/http.c +++ b/pkg/urbit/vere/io/http.c @@ -12,8 +12,6 @@ #include #include #include -#include -#include #include "all.h" #include "vere/vere.h" @@ -111,10 +109,6 @@ static void _http_form_free(u3_httd* htd_u); static const c3_i TCP_BACKLOG = 16; -// XX temporary, add to u3_http_ef_form -// -#define PROXY_DOMAIN "arvo.network" - /* _http_close_cb(): uv_close_cb that just free's handle */ static void From a3ae21ea5bd4a6f8a110d3690a19ab28f9c109da Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 23 Jun 2020 16:25:03 -0700 Subject: [PATCH 192/257] vere: removes SIGQUIT handler we were turning these into SIGABRT in order to catch them and unmap the lmdb database, but that's neither safe nor reliable. --- pkg/urbit/vere/king.c | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/pkg/urbit/vere/king.c b/pkg/urbit/vere/king.c index a6c53b9c7..85fdd0222 100644 --- a/pkg/urbit/vere/king.c +++ b/pkg/urbit/vere/king.c @@ -553,19 +553,6 @@ _daemon_sign_init(void) sig_u->nex_u = u3_Host.sig_u; u3_Host.sig_u = sig_u; } - - // handle SIGQUIT (turn it into SIGABRT) - // - { - u3_usig* sig_u; - - sig_u = c3_malloc(sizeof(u3_usig)); - uv_signal_init(u3L, &sig_u->sil_u); - - sig_u->num_i = SIGQUIT; - sig_u->nex_u = u3_Host.sig_u; - u3_Host.sig_u = sig_u; - } } /* _daemon_sign_cb: signal callback. @@ -594,10 +581,6 @@ _daemon_sign_cb(uv_signal_t* sil_u, c3_i num_i) u3_term_ef_winc(); break; } - - case SIGQUIT: { - abort(); - } } } From 46f3a1765823c3b921d9c020125e39bbbba56d31 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 23 Jun 2020 16:55:38 -0700 Subject: [PATCH 193/257] vere: free pier on graceful shutdown --- pkg/urbit/vere/pier.c | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index de6eb2340..e4da5e2f9 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -1395,12 +1395,29 @@ _pier_work_close(u3_work* wok_u) wok_u->pep_u.data = wok_u; } +/* _pier_done(): dispose pier. +*/ +static void +_pier_free(u3_pier* pir_u) +{ + c3_free(pir_u->pax_c); + + // XX remove + // + c3_free(pir_u->sav_u); + + c3_free(pir_u); +} + +/* _pier_done(): graceful shutdown complete, notify king. +*/ static void _pier_done(u3_pier* pir_u) { // XX unlink properly // u3K.pir_u = 0; + _pier_free(pir_u); u3_king_done(); } From abf9652628c0f510612b82ed64253b154d1de278 Mon Sep 17 00:00:00 2001 From: Fang Date: Wed, 24 Jun 2020 14:23:56 +0200 Subject: [PATCH 194/257] vere: add -X flag for running a scry Tries to get a scry result from a /vanecare/desk/path formatted path, and jams the result to disk (.urb/put/) if it succeeds. Optionally use -Y to specify a name for the resulting file. --- pkg/urbit/daemon/main.c | 12 ++++++- pkg/urbit/include/vere/vere.h | 2 ++ pkg/urbit/vere/pier.c | 68 ++++++++++++++++++++++++++++++++--- 3 files changed, 77 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 225fc00c9..e39b6c5b1 100644 --- a/pkg/urbit/daemon/main.c +++ b/pkg/urbit/daemon/main.c @@ -95,9 +95,17 @@ _main_getopt(c3_i argc, c3_c** argv) u3_Host.ops_u.kno_w = DefaultKernel; while ( -1 != (ch_i=getopt(argc, argv, - "G:J:B:K:A:H:I:w:u:e:F:k:n:p:r:LljacdgqstvxPDRS")) ) + "X:Y:G:J:B:K:A:H:I:w:u:e:F:k:n:p:r:LljacdgqstvxPDRS")) ) { switch ( ch_i ) { + case 'X': { + u3_Host.ops_u.pek_c = strdup(optarg); + break; + } + case 'Y': { + u3_Host.ops_u.puk_c = strdup(optarg); + break; + } case 'J': { u3_Host.ops_u.lit_c = strdup(optarg); break; @@ -398,7 +406,9 @@ u3_ve_usage(c3_i argc, c3_c** argv) "-u url URL from which to download pill\n", "-v Verbose\n", "-w name Boot as ~name\n", + "-X path Scry, jam to file, then exit\n" "-x Exit immediately\n", + "-Y file Optional name of jamfile (for -X)\n" "\n", "Development Usage:\n", " To create a development ship, use a fakezod:\n", diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 241620347..f090c2058 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -289,6 +289,8 @@ c3_o veb; // -v, verbose (inverse of -q) c3_c* who_c; // -w, begin with ticket c3_o tex; // -x, exit after loading + c3_c* pek_c; // -X, scry path (/vc/desk/path) + c3_c* puk_c; // -Y, scry result filename } u3_opts; /* u3_host: entire host. diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index de6eb2340..a1f2c670b 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -782,7 +782,7 @@ _pier_on_disk_read_bail(void* vod_p, c3_d eve_d) c3_assert( u3_psat_play == pir_u->sat_e ); // XX s/b play_bail_cb - // + // fprintf(stderr, "pier: disk read bail\r\n"); u3_term_stop_spinner(); u3_pier_bail(pir_u); @@ -935,6 +935,47 @@ _pier_on_lord_bail(void* vod_p) u3_pier_bail(pir_u); } +/* _pier_on_scry_done(): scry callback. +*/ +static void +_pier_on_scry_done(void* vod_p, u3_noun nun) +{ + u3_pier* pir_u = vod_p; + u3_weak res = u3r_at(7, nun); + + if (u3_none == res) { + u3l_log("pier: scry failed\n"); + } + else { + u3l_log("pier: scry succeeded\n"); + + u3_atom jam = u3qe_jam(res); + c3_w siz_w = u3r_met(3, jam); + c3_y* dat_y = c3_malloc(siz_w); + u3r_bytes(0, siz_w, dat_y, jam); + + c3_c* nam_c = u3_Host.ops_u.puk_c; + if (!nam_c) { + nam_c = "scry"; + } + c3_c fil_c[2048]; + snprintf(fil_c, 2048, "%s/.urb/put/%s.jam", pir_u->pax_c, nam_c); + FILE* fil_u = fopen(fil_c, "w"); + fwrite(dat_y, 1, siz_w, fil_u); + + u3l_log("pier: scry in .urb/put/%s.jam\n", nam_c); + fclose(fil_u); + c3_free(dat_y); + + u3z(jam); + } + + u3l_log("pier: exit"); + u3_pier_exit(pir_u); + + u3z(nun); +} + /* _pier_on_lord_live(): worker is ready. */ static void @@ -965,7 +1006,26 @@ _pier_on_lord_live(void* vod_p) c3_assert( u3_psat_init == pir_u->sat_e ); c3_assert( log_u->sen_d == log_u->dun_d ); - if ( god_u->eve_d < log_u->dun_d ) { + if (u3_Host.ops_u.pek_c) { + u3_noun pex = u3do("stab", u3i_string(u3_Host.ops_u.pek_c)); + u3_noun car; + u3_noun dek; + u3_noun pax; + if ( c3n == u3r_trel(pex, &car, &dek, &pax) + || c3n == u3a_is_cat(car) ) + { + u3m_p("pier: invalid scry", pex); + _pier_on_scry_done(pir_u, c3__null); + } else { + // run the requested scry, jam to disk, then exit + // + u3l_log("pier: scry\n"); + u3_lord_peek_last(god_u, u3_nul, u3k(car), u3k(dek), u3k(pax), + pir_u, _pier_on_scry_done); + } + u3z(pex); + } + else if ( god_u->eve_d < log_u->dun_d ) { c3_d eve_d; // XX revisit @@ -1190,7 +1250,7 @@ _pier_boot_make(u3_noun who, u3_noun ven, u3_noun pil) u3_noun wir = u3nq(u3_blip, c3__term, '1', u3_nul); u3_noun cad = u3nt(c3__boot, u3_Host.ops_u.lit, ven); // transfer - + bot_u.use = u3nc(u3nc(wir, cad), bot_u.use); } @@ -1410,7 +1470,7 @@ static void _pier_exit(u3_pier* pir_u) { c3_assert( u3_psat_done == pir_u->sat_e ); - + if ( pir_u->log_u ) { u3_disk_exit(pir_u->log_u); pir_u->log_u = 0; From f714d90b15a2c0cb88c377c0f3dfa7b128b8c70c Mon Sep 17 00:00:00 2001 From: Fang Date: Wed, 24 Jun 2020 16:26:32 +0200 Subject: [PATCH 195/257] arvo: allow the empty desk (%$) in scries +slaw fails to parse empty strings as %tas, so we special-case it here. --- pkg/arvo/sys/arvo.hoon | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/arvo/sys/arvo.hoon b/pkg/arvo/sys/arvo.hoon index 20b5147ce..51c08a62a 100644 --- a/pkg/arvo/sys/arvo.hoon +++ b/pkg/arvo/sys/arvo.hoon @@ -191,7 +191,7 @@ ?. ?=({@ @ @ @ *} u.pux) ~ =+ :* hyr=(slaw %tas i.u.pux) fal=(slaw %p i.t.u.pux) - dyc=(slaw %tas i.t.t.u.pux) + dyc=?~(i.t.t.u.pux (some %$) (slaw %tas i.t.t.u.pux)) ved=(slay i.t.t.t.u.pux) tyl=t.t.t.t.u.pux == From a94285208aa7fd97a40a3fb0935d3490dff84f92 Mon Sep 17 00:00:00 2001 From: Fang Date: Wed, 24 Jun 2020 16:34:36 +0200 Subject: [PATCH 196/257] behn: improve scry interface No longer abuse the desk field, instead making use of the path. Reject any scries outside of the local ship, empty desk and current time as invalid. Expose ducts only under a debug endpoint, nothing else should care about being able to inspect them. Add scry endpoints for the very next timer (if any), and all timers up to and including a specified timestamp. --- pkg/arvo/app/dbug.hoon | 2 +- pkg/arvo/gen/timers.hoon | 4 ++-- pkg/arvo/sys/vane/behn.hoon | 45 ++++++++++++++++++++++++++++++++----- 3 files changed, 43 insertions(+), 8 deletions(-) diff --git a/pkg/arvo/app/dbug.hoon b/pkg/arvo/app/dbug.hoon index 90124315b..320a03dba 100644 --- a/pkg/arvo/app/dbug.hoon +++ b/pkg/arvo/app/dbug.hoon @@ -767,7 +767,7 @@ ++ v-behn |% ++ timers - (scry ,(list [date=@da =duct]) %b %timers ~) + (scry ,(list [date=@da =duct]) %bx %$ /debug/timers) -- :: :: clay diff --git a/pkg/arvo/gen/timers.hoon b/pkg/arvo/gen/timers.hoon index f53710f58..715104fda 100644 --- a/pkg/arvo/gen/timers.hoon +++ b/pkg/arvo/gen/timers.hoon @@ -1,5 +1,5 @@ :: Find list of currently running Behn timers :- %say -|= * +|= [[now=@da *] *] :- %tang -[>.^((list [date=@da =duct]) %b /=timers=)< ~] +[>.^((list [date=@da =duct]) %bx /=//(scot %da now)/debug/timers)< ~] diff --git a/pkg/arvo/sys/vane/behn.hoon b/pkg/arvo/sys/vane/behn.hoon index a9dcfa8b7..d5aaec0f9 100644 --- a/pkg/arvo/sys/vane/behn.hoon +++ b/pkg/arvo/sys/vane/behn.hoon @@ -389,18 +389,53 @@ ++ scry |= [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path] ^- (unit (unit cage)) + :: only respond for the local identity, %$ desk, current timestamp :: - ?. ?=(%& -.why) + ?. ?& =(&+our why) + =([%$ %da now] lot) + =(%$ syd) + == ~ - ?. ?=(%timers syd) - [~ ~] - =/ tiz=(list [@da duct]) + :: /bx/debug/timers (list [@da duct]) all timers and their ducts + :: /bx/timers (list @da) all timer timestamps + :: /bx/timers/next (unit @da) the very next timer to fire + :: /bx/timers/[da] (list @da) all timers up to and including da + :: + ?. ?=(%x ren) ~ + ?+ tyl [~ ~] + [%debug %timers ~] + :^ ~ ~ %noun + !> ^- (list [@da duct]) %- zing %+ turn (tap:timer-map timers) |= [date=@da q=(qeu duct)] %+ turn ~(tap to q) |=(d=duct [date d]) - [~ ~ %noun !>(tiz)] + :: + [%timers ~] + :^ ~ ~ %noun + !> ^- (list @da) + %- zing + %+ turn (tap:timer-map timers) + |= [date=@da q=(qeu duct)] + (reap ~(wyt in q) date) + :: + [%timers %next ~] + :^ ~ ~ %noun + !> ^- (unit @da) + (bind (peek:timer-map timers) head) + :: + [%timers @ ~] + ?~ til=(slaw %da i.t.tyl) + [~ ~] + :^ ~ ~ %noun + !> ^- (list @da) + %- zing + %+ turn (tap:timer-map timers) + |= [date=@da q=(qeu duct)] + ?: (gth date u.til) ~ + (reap ~(wyt in q) date) + == :: ++ stay state ++ take From 2be266de8c723175655075439eadb07d15e5aaa0 Mon Sep 17 00:00:00 2001 From: Fang Date: Wed, 24 Jun 2020 23:26:31 +0200 Subject: [PATCH 197/257] vere: warn on invalid behn doze --- pkg/urbit/vere/io/behn.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index 3d09f2ef1..7e616bd6b 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -64,8 +64,7 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) teh_u->alm = c3n; } - if ( (u3_nul != wen) && - (c3y == u3du(wen)) && + if ( (c3y == u3du(wen)) && (c3y == u3ud(u3t(wen))) ) { struct timeval tim_tv; @@ -76,6 +75,8 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) teh_u->alm = c3y; uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); + } else if (u3_nul != wen) { + u3m_p("behn: invalid doze", wen); } u3z(wen); From afd180874503075bca02e93991ed787ca3d15f92 Mon Sep 17 00:00:00 2001 From: Fang Date: Wed, 24 Jun 2020 23:31:08 +0200 Subject: [PATCH 198/257] vere: scry out next behn timer for backstop Instead of potentially waiting ten minutes in the problematic case, we scry out the next timer from behn and set to that (if we haven't set a new timer while we were waiting for the scry). --- pkg/urbit/vere/io/behn.c | 34 ++++++++++++++++++++++++++++++---- 1 file changed, 30 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index 7e616bd6b..38ea2ac79 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -19,6 +19,8 @@ c3_o alm; // alarm } u3_behn; +static void _behn_scry_cb(void* vod_p, u3_noun nun); + /* _behn_time_cb(): timer callback. */ static void @@ -27,7 +29,7 @@ _behn_time_cb(uv_timer_t* tim_u) u3_behn* teh_u = tim_u->data; teh_u->alm = c3n; - // start another timer for 10 minutes + // take initiative to start the next timer, just in case // // This is a backstop to deal with the case where a %doze is not // properly sent, for example after a crash. If the timer continues @@ -35,9 +37,10 @@ _behn_time_cb(uv_timer_t* tim_u) // transient error, this will get us past it. // { - c3_d gap_d = 10 * 60 * 1000; - teh_u->alm = c3y; - uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); + u3_noun pax = u3i_trel(u3i_string("timers"), u3i_string("next"), u3_nul); + u3_lord_peek_last(teh_u->car_u.pir_u->god_u, u3_nul, + c3_s2('b', 'x'), u3_nul, pax, + teh_u, _behn_scry_cb); } // send timer event @@ -82,6 +85,29 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) u3z(wen); } +/* _behn_scry_cb(): next timer scry result callback. +*/ +static void +_behn_scry_cb(void* vod_p, u3_noun nun) +{ + u3_behn* teh_u = vod_p; + u3_weak tim = u3r_at(7, nun); + + if (c3y == teh_u->alm) { + // timer already set while we were scrying, no-op + } + else if (u3_none == tim) { + // fall back to a timer for 10 minutes + // + c3_d gap_d = 10 * 60 * 1000; + teh_u->alm = c3y; + uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); + } else { + _behn_ef_doze(teh_u, u3k(tim)); + } + u3z(nun); +} + /* _behn_io_talk(): notify %behn that we're live */ static void From e7ab3c037d5bda05c6bbfd2300490e66fae5fe53 Mon Sep 17 00:00:00 2001 From: Fang Date: Wed, 24 Jun 2020 23:33:22 +0200 Subject: [PATCH 199/257] vere: rename behn.c's alm -> alm_o To adhere to the naming conventions. --- pkg/urbit/vere/io/behn.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index 38ea2ac79..ce0bd5af2 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -16,7 +16,7 @@ typedef struct _u3_behn { u3_auto car_u; // driver uv_timer_t tim_u; // behn timer - c3_o alm; // alarm + c3_o alm_o; // alarm } u3_behn; static void _behn_scry_cb(void* vod_p, u3_noun nun); @@ -27,7 +27,7 @@ static void _behn_time_cb(uv_timer_t* tim_u) { u3_behn* teh_u = tim_u->data; - teh_u->alm = c3n; + teh_u->alm_o = c3n; // take initiative to start the next timer, just in case // @@ -62,9 +62,9 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) teh_u->car_u.liv_o = c3y; } - if ( c3y == teh_u->alm ) { + if ( c3y == teh_u->alm_o ) { uv_timer_stop(&teh_u->tim_u); - teh_u->alm = c3n; + teh_u->alm_o = c3n; } if ( (c3y == u3du(wen)) && @@ -76,7 +76,7 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) u3_noun now = u3_time_in_tv(&tim_tv); c3_d gap_d = u3_time_gap_ms(now, u3k(u3t(wen))); - teh_u->alm = c3y; + teh_u->alm_o = c3y; uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); } else if (u3_nul != wen) { u3m_p("behn: invalid doze", wen); @@ -93,14 +93,14 @@ _behn_scry_cb(void* vod_p, u3_noun nun) u3_behn* teh_u = vod_p; u3_weak tim = u3r_at(7, nun); - if (c3y == teh_u->alm) { + if (c3y == teh_u->alm_o) { // timer already set while we were scrying, no-op } else if (u3_none == tim) { // fall back to a timer for 10 minutes // c3_d gap_d = 10 * 60 * 1000; - teh_u->alm = c3y; + teh_u->alm_o = c3y; uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); } else { _behn_ef_doze(teh_u, u3k(tim)); @@ -170,7 +170,7 @@ u3_auto* u3_behn_io_init(u3_pier* pir_u) { u3_behn* teh_u = c3_calloc(sizeof(*teh_u)); - teh_u->alm = c3n; + teh_u->alm_o = c3n; uv_timer_init(u3L, &teh_u->tim_u); teh_u->tim_u.data = teh_u; From 202de122abd850c6772e69b57fccbc8a2b3c286e Mon Sep 17 00:00:00 2001 From: Fang Date: Thu, 25 Jun 2020 01:01:33 +0200 Subject: [PATCH 200/257] vere: if behn scry fails, don't try again Instead, always fall back to the 10 minute timer as backstop. --- pkg/urbit/vere/io/behn.c | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index ce0bd5af2..469036edc 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -17,6 +17,7 @@ u3_auto car_u; // driver uv_timer_t tim_u; // behn timer c3_o alm_o; // alarm + c3_o see_o; // can scry } u3_behn; static void _behn_scry_cb(void* vod_p, u3_noun nun); @@ -36,12 +37,16 @@ _behn_time_cb(uv_timer_t* tim_u) // to fail, we can't proceed with the timers, but if it was a // transient error, this will get us past it. // - { + if (c3y == teh_u->see_o) { u3_noun pax = u3i_trel(u3i_string("timers"), u3i_string("next"), u3_nul); u3_lord_peek_last(teh_u->car_u.pir_u->god_u, u3_nul, c3_s2('b', 'x'), u3_nul, pax, teh_u, _behn_scry_cb); } + else { + // if scry is known to not work, short-circuit + _behn_scry_cb(teh_u, u3_nul); + } // send timer event // @@ -97,8 +102,9 @@ _behn_scry_cb(void* vod_p, u3_noun nun) // timer already set while we were scrying, no-op } else if (u3_none == tim) { - // fall back to a timer for 10 minutes + // remember scry doesn't work, fall back to a timer for 10 minutes // + teh_u->see_o = c3n; c3_d gap_d = 10 * 60 * 1000; teh_u->alm_o = c3y; uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); @@ -171,6 +177,7 @@ u3_behn_io_init(u3_pier* pir_u) { u3_behn* teh_u = c3_calloc(sizeof(*teh_u)); teh_u->alm_o = c3n; + teh_u->see_o = c3y; uv_timer_init(u3L, &teh_u->tim_u); teh_u->tim_u.data = teh_u; From e087374cf0ccdd199060f2c8d1161a13af37d29e Mon Sep 17 00:00:00 2001 From: Fang Date: Thu, 25 Jun 2020 14:17:48 +0200 Subject: [PATCH 201/257] vere: u3_nul in place of c3__null We want ~, not %null. --- pkg/urbit/vere/pier.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index a1f2c670b..3e2363055 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -1015,7 +1015,7 @@ _pier_on_lord_live(void* vod_p) || c3n == u3a_is_cat(car) ) { u3m_p("pier: invalid scry", pex); - _pier_on_scry_done(pir_u, c3__null); + _pier_on_scry_done(pir_u, u3_nul); } else { // run the requested scry, jam to disk, then exit // From 2976b5303c63214473b462cd6f9843bea65ed4bf Mon Sep 17 00:00:00 2001 From: Fang Date: Thu, 25 Jun 2020 17:13:19 +0200 Subject: [PATCH 202/257] vere: support saving scry jam to directory And default to the scry path, instead of just "scry.jam". --- pkg/urbit/vere/pier.c | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 3e2363055..f0ed54344 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -949,25 +949,26 @@ _pier_on_scry_done(void* vod_p, u3_noun nun) else { u3l_log("pier: scry succeeded\n"); - u3_atom jam = u3qe_jam(res); - c3_w siz_w = u3r_met(3, jam); - c3_y* dat_y = c3_malloc(siz_w); - u3r_bytes(0, siz_w, dat_y, jam); - - c3_c* nam_c = u3_Host.ops_u.puk_c; - if (!nam_c) { - nam_c = "scry"; + c3_c* pac_c = u3_Host.ops_u.puk_c; + if (!pac_c) { + pac_c = u3_Host.ops_u.pek_c; } + + u3_noun pad; + { + u3_noun pax = u3do("stab", u3i_string(pac_c)); + c3_w len_w = u3kb_lent(u3k(pax)); + pad = u3nt(c3_s4('.','u','r','b'), + c3_s3('p','u','t'), + u3qb_scag(len_w - 1, pax)); + u3z(pax); + } + c3_c fil_c[2048]; - snprintf(fil_c, 2048, "%s/.urb/put/%s.jam", pir_u->pax_c, nam_c); - FILE* fil_u = fopen(fil_c, "w"); - fwrite(dat_y, 1, siz_w, fil_u); + snprintf(fil_c, 2048, "%s/.urb/put/%s.jam", pir_u->pax_c, pac_c+1); - u3l_log("pier: scry in .urb/put/%s.jam\n", nam_c); - fclose(fil_u); - c3_free(dat_y); - - u3z(jam); + u3_walk_save(fil_c, 0, u3qe_jam(res), pir_u->pax_c, pad); + u3l_log("pier: scry in %s\n", fil_c); } u3l_log("pier: exit"); From 7cc1b4f3ca5a4710eb9422114020edabc2a3a0c2 Mon Sep 17 00:00:00 2001 From: Fang Date: Thu, 25 Jun 2020 19:25:44 +0200 Subject: [PATCH 203/257] behn: optimize bounded timers scry --- pkg/arvo/sys/vane/behn.hoon | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/pkg/arvo/sys/vane/behn.hoon b/pkg/arvo/sys/vane/behn.hoon index d5aaec0f9..34b8f7a8f 100644 --- a/pkg/arvo/sys/vane/behn.hoon +++ b/pkg/arvo/sys/vane/behn.hoon @@ -430,11 +430,14 @@ [~ ~] :^ ~ ~ %noun !> ^- (list @da) - %- zing - %+ turn (tap:timer-map timers) - |= [date=@da q=(qeu duct)] - ?: (gth date u.til) ~ - (reap ~(wyt in q) date) + =/ tiz=(list [date=@da q=(qeu duct)]) + (tap:timer-map timers) + |- ^- (list @da) + ?~ tiz ~ + ?: (gth date.i.tiz u.til) ~ + %+ weld + (reap ~(wyt in q.i.tiz) date.i.tiz) + $(tiz t.tiz) == :: ++ stay state From d96a05e387830e881a32d0ded04eeb9ddf9796af Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 24 Jun 2020 15:27:09 -0700 Subject: [PATCH 204/257] vere: fix use-after-free on exit in cttp --- pkg/urbit/vere/io/cttp.c | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/pkg/urbit/vere/io/cttp.c b/pkg/urbit/vere/io/cttp.c index 41ffc2d2b..125b8a725 100644 --- a/pkg/urbit/vere/io/cttp.c +++ b/pkg/urbit/vere/io/cttp.c @@ -62,6 +62,7 @@ typedef struct _u3_cttp { u3_auto car_u; // driver u3_creq* ceq_u; // request list + uv_async_t nop_u; // unused handle (async close) h2o_timeout_t tim_u; // request timeout h2o_http1client_ctx_t // ctx_u; // h2o client ctx @@ -1102,6 +1103,17 @@ _cttp_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) return ret_o; } +/* _cttp_io_exit_cb(): free cttp. +*/ +static void +_cttp_io_exit_cb(uv_handle_t* han_u) +{ + u3_cttp* ctp_u = han_u->data; + + SSL_CTX_free(ctp_u->tls_u); + c3_free(ctp_u); +} + /* _cttp_io_exit(): shut down cttp. */ static void @@ -1109,6 +1121,10 @@ _cttp_io_exit(u3_auto* car_u) { u3_cttp* ctp_u = (u3_cttp*)car_u; + // close unused handle to free [ctp_u] after h2o is done + // + uv_close((uv_handle_t*)&ctp_u->nop_u, _cttp_io_exit_cb); + // cancel requests // { @@ -1121,8 +1137,6 @@ _cttp_io_exit(u3_auto* car_u) } h2o_timeout_dispose(u3L, &ctp_u->tim_u); - SSL_CTX_free(ctp_u->tls_u); - c3_free(ctp_u); } /* u3_cttp_io_init(): initialize http client I/O. @@ -1136,6 +1150,11 @@ u3_cttp_io_init(u3_pier* pir_u) // ctp_u->ctx_u.loop = u3L; + // unused handle for async close + // + uv_async_init(u3L, &ctp_u->nop_u, 0); + ctp_u->nop_u.data = ctp_u; + // link to initialized request timeout // h2o_timeout_init(u3L, &ctp_u->tim_u, 300 * 1000); From b860e8cd63d6c3226d795c63e054e3f2cc026149 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 01:37:31 -0700 Subject: [PATCH 205/257] vere: adds basic info printfs on SIGINFO/SIGUSR1 --- pkg/urbit/include/vere/vere.h | 26 ++++++++++++ pkg/urbit/vere/auto.c | 32 ++++++++++++++- pkg/urbit/vere/disk.c | 31 +++++++++++++++ pkg/urbit/vere/io/ames.c | 15 +++++-- pkg/urbit/vere/king.c | 14 +++++++ pkg/urbit/vere/lord.c | 12 ++++++ pkg/urbit/vere/pier.c | 75 +++++++++++++++++++++++++++++++++++ 7 files changed, 201 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 241620347..8b6eedb4b 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -538,6 +538,7 @@ */ typedef struct _u3_auto_cb { void (*talk_f)(struct _u3_auto*); + void (*info_f)(struct _u3_auto*); c3_o (*kick_f)(struct _u3_auto*, u3_noun, u3_noun); void (*exit_f)(struct _u3_auto*); // XX close_cb? } u3_auto_cb; @@ -760,6 +761,11 @@ u3_auto* u3_auto_init(u3_pier* pir_u); + /* u3_auto_info(): print status info. + */ + void + u3_auto_info(u3_auto* car_u); + /* u3_auto_exit(): close all drivers. */ void @@ -831,6 +837,11 @@ u3_disk* u3_disk_init(c3_c* pax_c, u3_disk_cb cb_u); + /* u3_disk_info(): print status info. + */ + void + u3_disk_info(u3_disk* log_u); + /* u3_disk_exit(): close [log_u] and dispose. */ void @@ -880,6 +891,11 @@ c3_d key_d[4], u3_lord_cb cb_u); + /* u3_lord_info(): print status info. + */ + void + u3_lord_info(u3_lord* god_u); + /* u3_lord_exit(): shutdown gracefully. */ void @@ -1224,6 +1240,11 @@ c3_o u3_pier_pack(u3_pier* pir_u); + /* u3_pier_info(): print status info. + */ + void + u3_pier_info(u3_pier* pir_u); + /* u3_pier_boot(): start the new pier system. */ u3_pier* @@ -1288,6 +1309,11 @@ u3_pier* u3_king_stub(void); + /* u3_king_info(): print status info. + */ + void + u3_king_info(void); + /* u3_king_done(): all piers closed */ void diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 839bb2143..137ca01e3 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -339,12 +339,42 @@ u3_auto_exit(u3_auto* car_u) } } +/* u3_auto_info(): print status info. +*/ +void +u3_auto_info(u3_auto* car_u) +{ + u3_auto* nex_u; + + u3l_log(" drivers:\n"); + + while ( car_u ) { + nex_u = car_u->nex_u; + + u3l_log(" %.*s: live=%s, queue=%u\n", + u3r_met(3, car_u->nam_m), + (c3_c*)&car_u->nam_m, + ( c3y == car_u->liv_o ) ? "&" : "|", + car_u->dep_w); + + // XX details + // + if ( car_u->io.info_f ) { + c3_l cod_l = u3a_lush(car_u->nam_m); + car_u->io.info_f(car_u); + u3a_lop(cod_l); + } + + car_u = nex_u; + } +} + /* _auto_link(): validate and link initalized [car_u] */ static u3_auto* _auto_link(u3_auto* car_u, u3_pier* pir_u, u3_auto* nex_u) { - // assert that io callbacks are present + // assert that io callbacks are present (info_f is optional) // c3_assert( car_u->io.talk_f ); c3_assert( car_u->io.kick_f ); diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index de24c93f8..0463698dd 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -645,6 +645,37 @@ u3_disk_exit(u3_disk* log_u) c3_free(log_u); } +/* u3_disk_info(): print status info. +*/ +void +u3_disk_info(u3_disk* log_u) +{ + u3l_log(" disk: live=%s, event=%" PRIu64 "\n", + ( c3y == log_u->liv_o ) ? "&" : "|", + log_u->dun_d); + + { + u3_read* red_u = log_u->red_u; + + while ( red_u ) { + u3l_log(" read: %" PRIu64 "-%" PRIu64 "\n", + red_u->eve_d, + (red_u->eve_d + red_u->len_d) - 1); + } + } + + if ( log_u->put_u.ext_u ) { + if ( log_u->put_u.ext_u != log_u->put_u.ent_u ) { + u3l_log(" save: %" PRIu64 "-%" PRIu64 "\n", + log_u->put_u.ext_u->eve_d, + log_u->put_u.ent_u->eve_d); + } + else { + u3l_log(" save: %" PRIu64 "\n", log_u->put_u.ext_u->eve_d); + } + } +} + /* u3_disk_init(): load or create pier directories and event log. */ u3_disk* diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c index 41f6edaa1..c0475a17d 100644 --- a/pkg/urbit/vere/io/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -29,7 +29,7 @@ /* u3_ames: ames networking. */ typedef struct _u3_ames { // packet network state - u3_auto car_u; // driver + u3_auto car_u; // driver union { // uv_udp_t wax_u; // uv_handle_t had_u; // @@ -701,6 +701,15 @@ _ames_io_exit(u3_auto* car_u) uv_close(&sam_u->had_u, _ames_exit_cb); } +/* _ames_io_info(): print status info. +*/ +static void +_ames_io_info(u3_auto* car_u) +{ + u3_ames* sam_u = (u3_ames*)car_u; + u3l_log(" dropped: %" PRIu64 "\n", sam_u->dop_d); +} + /* u3_ames_io_init(): initialize ames I/O. */ u3_auto* @@ -727,6 +736,7 @@ u3_ames_io_init(u3_pier* pir_u) car_u->nam_m = c3__ames; car_u->liv_o = c3n; car_u->io.talk_f = _ames_io_talk; + car_u->io.info_f = _ames_io_info; car_u->io.kick_f = _ames_io_kick; car_u->io.exit_f = _ames_io_exit; @@ -735,5 +745,4 @@ u3_ames_io_init(u3_pier* pir_u) // car_u->ev.bail_f = ...; return car_u; - -} \ No newline at end of file +} diff --git a/pkg/urbit/vere/king.c b/pkg/urbit/vere/king.c index 85fdd0222..2ff1d51ca 100644 --- a/pkg/urbit/vere/king.c +++ b/pkg/urbit/vere/king.c @@ -581,6 +581,12 @@ _daemon_sign_cb(uv_signal_t* sil_u, c3_i num_i) u3_term_ef_winc(); break; } + + case SIGUSR1: + case SIGINFO: { + u3_king_info(); + break; + } } } @@ -751,6 +757,14 @@ _king_forall(void (*pir_f)(u3_pier*)) } } +/* u3_king_info(): print status info. +*/ +void +u3_king_info(void) +{ + _king_forall(u3_pier_info); +} + /* _king_forall_unlink(): run on all piers, unlinking from king. */ static void diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 640ae0306..bce742d3d 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -975,6 +975,18 @@ _lord_on_serf_bail(void* ptr_v, _lord_bail(god_u); } +/* u3_lord_info(): print status info. +*/ +void +u3_lord_info(u3_lord* god_u) +{ + u3l_log(" lord: live=%s, event=%" PRIu64 ", mug=%x, queue=%u\n", + ( c3y == god_u->liv_o ) ? "&" : "|", + god_u->eve_d, + god_u->mug_l, + god_u->dep_w); +} + /* u3_lord_init(): instantiate child process. */ u3_lord* diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index e4da5e2f9..1ac8eae0b 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -992,6 +992,81 @@ _pier_on_lord_live(void* vod_p) } } +/* u3_pier_info(): print status info. +*/ +void +u3_pier_info(u3_pier* pir_u) +{ + switch ( pir_u->sat_e ) { + default: { + u3l_log("pier: unknown state: %u\r\n", pir_u->sat_e); + } break; + + case u3_psat_init: { + u3l_log("pier: init\n"); + } break; + + case u3_psat_boot: { + u3l_log("pier: boot\n"); + } break; + + case u3_psat_play: { + u3l_log("pier: play\n"); + + { + u3_play* pay_u = pir_u->pay_u; + + u3l_log(" target: %" PRIu64 "\n", pay_u->eve_d); + u3l_log(" sent: %" PRIu64 "\n", pay_u->sen_d); + u3l_log(" read: %" PRIu64 "\n", pay_u->req_d); + } + } break; + + case u3_psat_work: { + u3l_log("pier: work\n"); + + { + u3_work* wok_u = pir_u->wok_u; + + u3l_log(" effects:\n"); + u3l_log(" released: %" PRIu64 "\n", wok_u->fec_u.rel_d); + + if ( wok_u->fec_u.ext_u ) { + if ( wok_u->fec_u.ext_u != wok_u->fec_u.ent_u ) { + u3l_log(" pending %" PRIu64 "-%" PRIu64 "\n", + wok_u->fec_u.ext_u->eve_d, + wok_u->fec_u.ent_u->eve_d); + + } + else { + u3l_log(" pending %" PRIu64 "\n", wok_u->fec_u.ext_u->eve_d); + } + } + + if ( wok_u->wal_u ) { + u3l_log("wall: %" PRIu64 "\n", wok_u->wal_u->eve_d); + } + + if ( wok_u->car_u ) { + u3_auto_info(wok_u->car_u); + } + } + } break; + + case u3_psat_done: { + u3l_log("pier: done\n"); + } break; + } + + if ( pir_u->log_u ) { + u3_disk_info(pir_u->log_u); + } + + if ( pir_u->god_u ) { + u3_lord_info(pir_u->god_u); + } +} + /* _pier_init(): create a pier, loading existing. */ static u3_pier* From 078b2744913fe683fd4c9ebd71515f49d27e3e18 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 01:38:20 -0700 Subject: [PATCH 206/257] vere: completes daemon->king re-renaming --- pkg/urbit/vere/king.c | 146 +++++++++++++++++++++++++----------------- 1 file changed, 86 insertions(+), 60 deletions(-) diff --git a/pkg/urbit/vere/king.c b/pkg/urbit/vere/king.c index 2ff1d51ca..a1d3bc0a5 100644 --- a/pkg/urbit/vere/king.c +++ b/pkg/urbit/vere/king.c @@ -88,25 +88,25 @@ static c3_w sag_w; -- */ -void _daemon_doom(u3_noun doom); - void _daemon_boot(u3_noun boot); - void _daemon_come(u3_noun star, u3_noun pill, u3_noun path); - void _daemon_dawn(u3_noun seed, u3_noun pill, u3_noun path); - void _daemon_fake(u3_noun ship, u3_noun pill, u3_noun path); - void _daemon_pier(u3_noun pier); +void _king_doom(u3_noun doom); + void _king_boot(u3_noun boot); + void _king_come(u3_noun star, u3_noun pill, u3_noun path); + void _king_dawn(u3_noun seed, u3_noun pill, u3_noun path); + void _king_fake(u3_noun ship, u3_noun pill, u3_noun path); + void _king_pier(u3_noun pier); -/* _daemon_defy_fate(): invalid fate +/* _king_defy_fate(): invalid fate */ void -_daemon_defy_fate() +_king_defy_fate() { exit(1); } -/* _daemon_doom(): doom parser +/* _king_doom(): doom parser */ void -_daemon_doom(u3_noun doom) +_king_doom(u3_noun doom) { u3_noun load; void (*next)(u3_noun); @@ -116,13 +116,13 @@ _daemon_doom(u3_noun doom) switch ( u3h(doom) ) { case c3__boot: - next = _daemon_boot; + next = _king_boot; break; case c3__pier: - next = _daemon_pier; + next = _king_pier; break; default: - _daemon_defy_fate(); + _king_defy_fate(); } load = u3k(u3t(doom)); @@ -130,10 +130,10 @@ _daemon_doom(u3_noun doom) next(load); } -/* _daemon_boot(): boot parser +/* _king_boot(): boot parser */ void -_daemon_boot(u3_noun bul) +_king_boot(u3_noun bul) { u3_noun boot, pill, path; void (*next)(u3_noun, u3_noun, u3_noun); @@ -144,29 +144,29 @@ _daemon_boot(u3_noun bul) switch ( u3h(boot) ) { case c3__fake: { - next = _daemon_fake; + next = _king_fake; break; } case c3__come: { - next = _daemon_come; + next = _king_come; break; } case c3__dawn: { - next = _daemon_dawn; + next = _king_dawn; break; } default: - return _daemon_defy_fate(); + return _king_defy_fate(); } next(u3k(u3t(boot)), u3k(pill), u3k(path)); u3z(bul); } -/* _daemon_fake(): boot with fake keys +/* _king_fake(): boot with fake keys */ void -_daemon_fake(u3_noun ship, u3_noun pill, u3_noun path) +_king_fake(u3_noun ship, u3_noun pill, u3_noun path) { // XX link properly // @@ -174,31 +174,31 @@ _daemon_fake(u3_noun ship, u3_noun pill, u3_noun path) u3K.pir_u = u3_pier_boot(sag_w, ship, vent, pill, path); } -/* _daemon_come(): mine a comet under star (unit) +/* _king_come(): mine a comet under star (unit) ** ** XX revise to exclude star argument */ void -_daemon_come(u3_noun star, u3_noun pill, u3_noun path) +_king_come(u3_noun star, u3_noun pill, u3_noun path) { - _daemon_dawn(u3_dawn_come(), pill, path); + _king_dawn(u3_dawn_come(), pill, path); } static void -_daemon_slog(u3_noun hod) +_king_slog(u3_noun hod) { u3_pier_tank(0, 0, u3k(u3t(hod))); u3z(hod); } -/* _daemon_dawn(): boot from keys, validating +/* _king_dawn(): boot from keys, validating */ void -_daemon_dawn(u3_noun seed, u3_noun pill, u3_noun path) +_king_dawn(u3_noun seed, u3_noun pill, u3_noun path) { // enable ivory slog printfs // - u3C.slog_f = _daemon_slog; + u3C.slog_f = _king_slog; // XX link properly // @@ -210,10 +210,10 @@ _daemon_dawn(u3_noun seed, u3_noun pill, u3_noun path) u3C.slog_f = 0; } -/* _daemon_pier(): pier parser +/* _king_pier(): pier parser */ void -_daemon_pier(u3_noun pier) +_king_pier(u3_noun pier) { if ( (c3n == u3du(pier)) || (c3n == u3ud(u3t(pier))) ) { @@ -225,11 +225,11 @@ _daemon_pier(u3_noun pier) u3z(pier); } -/* _daemon_curl_alloc(): allocate a response buffer for curl +/* _king_curl_alloc(): allocate a response buffer for curl ** XX deduplicate with dawn.c */ static size_t -_daemon_curl_alloc(void* dat_v, size_t uni_t, size_t mem_t, uv_buf_t* buf_u) +_king_curl_alloc(void* dat_v, size_t uni_t, size_t mem_t, uv_buf_t* buf_u) { size_t siz_t = uni_t * mem_t; buf_u->base = c3_realloc(buf_u->base, 1 + siz_t + buf_u->len); @@ -241,11 +241,11 @@ _daemon_curl_alloc(void* dat_v, size_t uni_t, size_t mem_t, uv_buf_t* buf_u) return siz_t; } -/* _daemon_get_atom(): HTTP GET url_c, produce the response body as an atom. +/* _king_get_atom(): HTTP GET url_c, produce the response body as an atom. ** XX deduplicate with dawn.c */ static u3_noun -_daemon_get_atom(c3_c* url_c) +_king_get_atom(c3_c* url_c) { CURL *curl; CURLcode result; @@ -260,7 +260,7 @@ _daemon_get_atom(c3_c* url_c) curl_easy_setopt(curl, CURLOPT_CAINFO, u3K.certs_c); curl_easy_setopt(curl, CURLOPT_URL, url_c); - curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, _daemon_curl_alloc); + curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, _king_curl_alloc); curl_easy_setopt(curl, CURLOPT_WRITEDATA, (void*)&buf_u); result = curl_easy_perform(curl); @@ -371,7 +371,7 @@ _boothack_pill(void) } u3l_log("boot: downloading pill %s\r\n", url_c); - pil = _daemon_get_atom(url_c); + pil = _king_get_atom(url_c); } if ( 0 != u3_Host.ops_u.arv_c ) { @@ -510,10 +510,10 @@ _boothack_doom(void) return u3nq(c3__boot, bot, _boothack_pill(), pax); } -/* _daemon_sign_init(): initialize daemon signal handlers +/* _king_sign_init(): initialize daemon signal handlers */ static void -_daemon_sign_init(void) +_king_sign_init(void) { // gracefully shutdown on SIGTERM // @@ -553,12 +553,38 @@ _daemon_sign_init(void) sig_u->nex_u = u3_Host.sig_u; u3_Host.sig_u = sig_u; } + + // handle SIGINFO (if available) + // + { + u3_usig* sig_u; + + sig_u = c3_malloc(sizeof(u3_usig)); + uv_signal_init(u3L, &sig_u->sil_u); + + sig_u->num_i = SIGINFO; + sig_u->nex_u = u3_Host.sig_u; + u3_Host.sig_u = sig_u; + } + + // handle SIGUSR1 (fallback for SIGINFO) + // + { + u3_usig* sig_u; + + sig_u = c3_malloc(sizeof(u3_usig)); + uv_signal_init(u3L, &sig_u->sil_u); + + sig_u->num_i = SIGUSR1; + sig_u->nex_u = u3_Host.sig_u; + u3_Host.sig_u = sig_u; + } } -/* _daemon_sign_cb: signal callback. +/* _king_sign_cb: signal callback. */ static void -_daemon_sign_cb(uv_signal_t* sil_u, c3_i num_i) +_king_sign_cb(uv_signal_t* sil_u, c3_i num_i) { switch ( num_i ) { default: { @@ -590,22 +616,22 @@ _daemon_sign_cb(uv_signal_t* sil_u, c3_i num_i) } } -/* _daemon_sign_move(): enable daemon signal handlers +/* _king_sign_move(): enable daemon signal handlers */ static void -_daemon_sign_move(void) +_king_sign_move(void) { u3_usig* sig_u; for ( sig_u = u3_Host.sig_u; sig_u; sig_u = sig_u->nex_u ) { - uv_signal_start(&sig_u->sil_u, _daemon_sign_cb, sig_u->num_i); + uv_signal_start(&sig_u->sil_u, _king_sign_cb, sig_u->num_i); } } -/* _daemon_sign_hold(): disable daemon signal handlers +/* _king_sign_hold(): disable daemon signal handlers */ static void -_daemon_sign_hold(void) +_king_sign_hold(void) { u3_usig* sig_u; @@ -614,10 +640,10 @@ _daemon_sign_hold(void) } } -/* _daemon_sign_close(): dispose daemon signal handlers +/* _king_sign_close(): dispose daemon signal handlers */ static void -_daemon_sign_close(void) +_king_sign_close(void) { u3_usig* sig_u; @@ -630,13 +656,13 @@ _daemon_sign_close(void) void _boothack_cb(uv_timer_t* tim_u) { - _daemon_doom(_boothack_doom()); + _king_doom(_boothack_doom()); } -/* _daemon_loop_init(): stuff that comes before the event loop +/* _king_loop_init(): stuff that comes before the event loop */ void -_daemon_loop_init() +_king_loop_init() { // initialize terminal/logging // @@ -644,18 +670,18 @@ _daemon_loop_init() // start signal handlers // - _daemon_sign_init(); - _daemon_sign_move(); + _king_sign_init(); + _king_sign_move(); // async "boothack" // / uv_timer_start(&u3K.tim_u, _boothack_cb, 0, 0); } -/* _daemon_loop_exit(): cleanup after event loop +/* _king_loop_exit(): cleanup after event loop */ void -_daemon_loop_exit() +_king_loop_exit() { unlink(u3K.certs_c); } @@ -677,8 +703,8 @@ u3_king_commence() // wire up signal controls // - u3C.sign_hold_f = _daemon_sign_hold; - u3C.sign_move_f = _daemon_sign_move; + u3C.sign_hold_f = _king_sign_hold; + u3C.sign_move_f = _king_sign_move; // Ignore SIGPIPE signals. { @@ -726,9 +752,9 @@ u3_king_commence() // run the loop // - _daemon_loop_init(); + _king_loop_init(); uv_run(u3L, UV_RUN_DEFAULT); - _daemon_loop_exit(); + _king_loop_exit(); } /* u3_king_stub(): get the One Pier for unreconstructed code. @@ -806,7 +832,7 @@ u3_king_done(void) // if ( !u3K.pir_u && !uv_is_closing(han_u) ) { uv_close((uv_handle_t*)&u3K.tim_u, _king_done_cb); - _daemon_sign_close(); + _king_sign_close(); u3_term_log_exit(); fflush(stdout); @@ -827,7 +853,7 @@ void u3_king_bail(void) { _king_forall_unlink(u3_pier_bail); - _daemon_loop_exit(); + _king_loop_exit(); u3_king_done(); exit(1); } From 81ff98c5d41c965bc8b02ae05105c88fb4a24b99 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 11:35:58 -0700 Subject: [PATCH 207/257] vere/king/serf: adds and enables event timeouts --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 8 ++--- pkg/urbit/include/noun/manage.h | 2 +- pkg/urbit/include/vere/serf.h | 2 +- pkg/urbit/include/vere/vere.h | 6 ++-- pkg/urbit/noun/manage.c | 38 +++++++++++--------- pkg/urbit/vere/auto.c | 4 +-- pkg/urbit/vere/lord.c | 5 +-- pkg/urbit/vere/ward.c | 4 +-- pkg/urbit/worker/serf.c | 38 +++++++++++--------- 9 files changed, 59 insertions(+), 48 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index d7ae9e475..7321c1300 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -25,7 +25,7 @@ == == [%peek now=date lyc=gang pat=path] [%play eve=@ lit=(list ?((pair date ovum) *))] - [%work job=(pair date ovum)] + [%work mil=@ job=(pair date ovum)] == :: +plea: from serf to king :: @@ -122,7 +122,7 @@ data Writ = WLive Live | WPeek Wen Gang Path | WPlay EventId [Noun] - | WWork Wen Ev + | WWork Atom Wen Ev deriving (Show) data Plea @@ -493,7 +493,7 @@ swim serf = do Nothing -> do pure (SerfState eve mug) Just (wen, evn) -> do - io (sendWrit serf (WWork wen evn)) + io (sendWrit serf (WWork 0 wen evn)) io (recvWork serf) >>= \case WBail goofs -> do throwIO (BailDuringReplay eve goofs) @@ -636,7 +636,7 @@ processWork serf maxSize q onResp spin = do now <- Time.now let cb = onResp now evErr atomically $ modifyTVar' vInFlight (:|> (ev, cb)) - sendWrit serf (WWork now ev) + sendWrit serf (WWork 0 now ev) loop vInFlight vDone {-| diff --git a/pkg/urbit/include/noun/manage.h b/pkg/urbit/include/noun/manage.h index 7da08e629..3f8203b7c 100644 --- a/pkg/urbit/include/noun/manage.h +++ b/pkg/urbit/include/noun/manage.h @@ -66,7 +66,7 @@ ** Produces [%$ result] or [%error (list tank)]. */ u3_noun - u3m_soft(c3_w sec_w, u3_funk fun_f, u3_noun arg); + u3m_soft(c3_w mil_w, u3_funk fun_f, u3_noun arg); /* u3m_soft_slam: top-level call. */ diff --git a/pkg/urbit/include/vere/serf.h b/pkg/urbit/include/vere/serf.h index 9fb6ef0c6..e9fa790ea 100644 --- a/pkg/urbit/include/vere/serf.h +++ b/pkg/urbit/include/vere/serf.h @@ -52,7 +52,7 @@ /* u3_serf_work(): apply event, producing effects. */ u3_noun - u3_serf_work(u3_serf* sef_u, u3_noun job); + u3_serf_work(u3_serf* sef_u, c3_w mil_w, u3_noun job); /* u3_serf_post(): update serf state post-writ. */ diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 8b6eedb4b..1dc30f981 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -331,7 +331,7 @@ */ typedef struct _u3_ovum { void* vod_p; // context - c3_l msc_l; // ms to timeout + c3_w mil_w; // timeout ms u3_noun tar; // target (in arvo) u3_noun wir; // wire u3_noun cad; // card @@ -744,7 +744,7 @@ /* u3_ovum_init: initialize an unlinked potential event */ u3_ovum* - u3_ovum_init(c3_l msc_l, + u3_ovum_init(c3_w mil_w, u3_noun tar, u3_noun wir, u3_noun cad); @@ -820,7 +820,7 @@ */ u3_ovum* u3_auto_plan(u3_auto* car_u, - c3_l msc_l, + c3_w mil_w, u3_noun tar, u3_noun wir, u3_noun cad); diff --git a/pkg/urbit/noun/manage.c b/pkg/urbit/noun/manage.c index bf87bd96a..df9042028 100644 --- a/pkg/urbit/noun/manage.c +++ b/pkg/urbit/noun/manage.c @@ -68,10 +68,10 @@ /* u3m_soft_top(): top-level safety wrapper. */ u3_noun - u3m_soft_top(c3_w sec_w, // timer seconds + u3m_soft_top(c3_w mil_w, // timer ms c3_w pad_w, // base memory pad u3_funk fun_f, - u3_noun arg); + u3_noun arg); static sigjmp_buf u3_Signal; @@ -323,10 +323,10 @@ _cm_signal_recover(c3_l sig_l, u3_noun arg) } } -/* _cm_signal_deep(): start deep processing; set timer for sec_w or 0. +/* _cm_signal_deep(): start deep processing; set timer for [mil_w] or 0. */ static void -_cm_signal_deep(c3_w sec_w) +_cm_signal_deep(c3_w mil_w) { // disable outer system signal handling // @@ -347,15 +347,19 @@ _cm_signal_deep(c3_w sec_w) u3H->rod_u.bug.mer = u3i_string("emergency buffer"); } - if ( sec_w ) { + if ( mil_w ) { struct itimerval itm_u; timerclear(&itm_u.it_interval); - itm_u.it_value.tv_sec = sec_w; - itm_u.it_value.tv_usec = 0; + itm_u.it_value.tv_sec = (mil_w / 1000); + itm_u.it_value.tv_usec = 1000 * (mil_w % 1000); - setitimer(ITIMER_VIRTUAL, &itm_u, 0); - signal(SIGVTALRM, _cm_signal_handle_alrm); + if ( setitimer(ITIMER_VIRTUAL, &itm_u, 0) ) { + u3l_log("loom: set timer failed %s\r\n", strerror(errno)); + } + else { + signal(SIGVTALRM, _cm_signal_handle_alrm); + } } u3t_boot(); @@ -379,7 +383,9 @@ _cm_signal_done() timerclear(&itm_u.it_interval); timerclear(&itm_u.it_value); - setitimer(ITIMER_VIRTUAL, &itm_u, 0); + if ( setitimer(ITIMER_VIRTUAL, &itm_u, 0) ) { + u3l_log("loom: clear timer failed %s\r\n", strerror(errno)); + } } // restore outer system signal handling @@ -927,17 +933,17 @@ u3m_water(c3_w* low_w, c3_w* hig_w) /* u3m_soft_top(): top-level safety wrapper. */ u3_noun -u3m_soft_top(c3_w sec_w, // timer seconds +u3m_soft_top(c3_w mil_w, // timer ms c3_w pad_w, // base memory pad u3_funk fun_f, - u3_noun arg) + u3_noun arg) { u3_noun why, pro; c3_l sig_l; /* Enter internal signal regime. */ - _cm_signal_deep(0); + _cm_signal_deep(mil_w); if ( 0 != (sig_l = sigsetjmp(u3_Signal, 1)) ) { // reinitialize trace state @@ -1210,13 +1216,13 @@ u3m_grab(u3_noun som, ...) // terminate with u3_none ** Produces [0 product] or [%error (list tank)], top last. */ u3_noun -u3m_soft(c3_w sec_w, +u3m_soft(c3_w mil_w, u3_funk fun_f, - u3_noun arg) + u3_noun arg) { u3_noun why; - why = u3m_soft_top(sec_w, (1 << 20), fun_f, arg); // 2MB pad + why = u3m_soft_top(mil_w, (1 << 20), fun_f, arg); // 2MB pad if ( 0 == u3h(why) ) { return why; diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 137ca01e3..d163d576f 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -23,12 +23,12 @@ */ u3_ovum* u3_auto_plan(u3_auto* car_u, - c3_l msc_l, + c3_w mil_w, u3_noun tar, u3_noun wir, u3_noun cad) { - u3_ovum *egg_u = u3_ovum_init(msc_l, tar, wir, cad); + u3_ovum *egg_u = u3_ovum_init(mil_w, tar, wir, cad); egg_u->car_u = car_u; diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index bce742d3d..268bb1bf1 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -31,7 +31,7 @@ == == [%peek now=date lyc=gang pat=path] [%play eve=@ lit=(list ?((pair date ovum) *))] - [%work job=(pair date ovum)] + [%work mil=@ job=(pair date ovum)] == :: +plea: from serf to king :: @@ -666,7 +666,8 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) default: c3_assert(0); case u3_writ_work: { - msg = u3nc(c3__work, u3k(wit_u->wok_u.job)); + u3_noun mil = u3i_words(1, &wit_u->wok_u.egg_u->mil_w); + msg = u3nt(c3__work, mil, u3k(wit_u->wok_u.job)); } break; case u3_writ_peek: { diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c index e47ccae76..9df12dbd0 100644 --- a/pkg/urbit/vere/ward.c +++ b/pkg/urbit/vere/ward.c @@ -128,7 +128,7 @@ u3_gift_free(u3_gift *gif_u) /* u3_ovum_init: initialize an unlinked potential event */ u3_ovum* -u3_ovum_init(c3_l msc_l, +u3_ovum_init(c3_w mil_w, u3_noun tar, u3_noun wir, u3_noun cad) @@ -136,7 +136,7 @@ u3_ovum_init(c3_l msc_l, u3_ovum* egg_u = c3_malloc(sizeof(*egg_u)); egg_u->car_u = 0; egg_u->vod_p = 0; - egg_u->msc_l = msc_l; + egg_u->mil_w = mil_w; egg_u->tar = tar; egg_u->wir = wir; egg_u->cad = cad; diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 77d87d0ed..76825d4ac 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -32,7 +32,7 @@ == == [%peek now=date lyc=gang pat=path] [%play eve=@ lit=(list ?((pair date ovum) *))] - [%work job=(pair date ovum)] + [%work mil=@ job=(pair date ovum)] == :: +plea: from serf to king :: @@ -60,13 +60,7 @@ questions: - %play - expect lifecycle on [%ripe ... eve=0 mug=0] - eve identifies failed event on [%play @ %bail ...] -- %pack - - could just be [%save %full ...] followed by a restart -- %mass - - is technically a query of the serf directly -- milliseconds - - in $writ for timeouts - - in $plea for measurement +- %mass is technically a query of the serf directly - duct or vane stack for spinner */ @@ -481,7 +475,7 @@ _serf_make_crud(u3_noun job, u3_noun dud) /* _serf_poke(): RETAIN */ static u3_noun -_serf_poke(u3_serf* sef_u, c3_c* cap_c, u3_noun job) +_serf_poke(u3_serf* sef_u, c3_c* cap_c, c3_w mil_w, u3_noun job) { u3_noun now, ovo, wen, gon; u3x_cell(job, &now, &ovo); @@ -507,7 +501,7 @@ _serf_poke(u3_serf* sef_u, c3_c* cap_c, u3_noun job) } #endif - gon = u3m_soft(0, u3v_poke, u3k(ovo)); + gon = u3m_soft(mil_w, u3v_poke, u3k(ovo)); #ifdef U3_EVENT_TIME_DEBUG { @@ -545,7 +539,7 @@ _serf_poke(u3_serf* sef_u, c3_c* cap_c, u3_noun job) /* _serf_work(): apply event, capture effects. */ static u3_noun -_serf_work(u3_serf* sef_u, u3_noun job) +_serf_work(u3_serf* sef_u, c3_w mil_w, u3_noun job) { u3_noun gon; c3_w pre_w = u3a_open(u3R); @@ -555,7 +549,7 @@ _serf_work(u3_serf* sef_u, u3_noun job) c3_assert( sef_u->sen_d == sef_u->dun_d); sef_u->sen_d++; - gon = _serf_poke(sef_u, "work", job); // retain + gon = _serf_poke(sef_u, "work", mil_w, job); // retain // event accepted // @@ -578,7 +572,7 @@ _serf_work(u3_serf* sef_u, u3_noun job) // job = _serf_make_crud(job, dud); - gon = _serf_poke(sef_u, "crud", job); // retain + gon = _serf_poke(sef_u, "crud", mil_w, job); // retain // error notification accepted // @@ -608,7 +602,7 @@ _serf_work(u3_serf* sef_u, u3_noun job) /* u3_serf_work(): apply event, producing effects. */ u3_noun -u3_serf_work(u3_serf* sef_u, u3_noun job) +u3_serf_work(u3_serf* sef_u, c3_w mil_w, u3_noun job) { c3_t tac_t = ( 0 != u3_Host.tra_u.fil_u ); c3_c lab_c[2048]; @@ -635,7 +629,7 @@ u3_serf_work(u3_serf* sef_u, u3_noun job) // c3_assert( 0 != sef_u->mug_l); - pro = u3nc(c3__work, _serf_work(sef_u, job)); + pro = u3nc(c3__work, _serf_work(sef_u, mil_w, job)); if ( tac_t ) { u3t_event_trace(lab_c, 'E'); @@ -1034,8 +1028,18 @@ u3_serf_writ(u3_serf* sef_u, u3_noun wit, u3_noun* pel) } break; case c3__work: { - *pel = u3_serf_work(sef_u, u3k(com)); - ret_o = c3y; + u3_noun job, tim; + c3_w mil_w; + + if ( (c3n == u3r_cell(com, &tim, &job)) || + (c3n == u3r_safe_word(tim, &mil_w)) ) + { + ret_o = c3n; + } + else { + *pel = u3_serf_work(sef_u, mil_w, u3k(job)); + ret_o = c3y; + } } break; } } From 6e9f8ec34b09ad4abaed99a8eda94ec107055ab6 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 11:37:09 -0700 Subject: [PATCH 208/257] king: fixes --serf worker-path cli parser --- pkg/hs/urbit-king/lib/Urbit/King/CLI.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs index 15fee1691..b5edbcd2f 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/CLI.hs @@ -275,7 +275,7 @@ opts = do oSerfExe <- optional - $ option auto + $ strOption $ metavar "PATH" <> long "serf" <> help "Path to Serf" From 48add92ca5ffc0e19b38bfcab894a900e6d85a97 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 11:58:25 -0700 Subject: [PATCH 209/257] vere: skip SIGINFO on linux (unavailable) --- pkg/urbit/vere/king.c | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/pkg/urbit/vere/king.c b/pkg/urbit/vere/king.c index a1d3bc0a5..e1be8c4cd 100644 --- a/pkg/urbit/vere/king.c +++ b/pkg/urbit/vere/king.c @@ -556,6 +556,7 @@ _king_sign_init(void) // handle SIGINFO (if available) // +#ifndef U3_OS_linux { u3_usig* sig_u; @@ -566,6 +567,7 @@ _king_sign_init(void) sig_u->nex_u = u3_Host.sig_u; u3_Host.sig_u = sig_u; } +#endif // handle SIGUSR1 (fallback for SIGINFO) // @@ -608,8 +610,12 @@ _king_sign_cb(uv_signal_t* sil_u, c3_i num_i) break; } - case SIGUSR1: - case SIGINFO: { + // fallthru if defined + // +#ifndef U3_OS_linux + case SIGINFO: +#endif + case SIGUSR1: { u3_king_info(); break; } From 1762412162335f7436d5025d36c100f1b80d9ff6 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 14:07:59 -0700 Subject: [PATCH 210/257] vere: handle partial writes and retry in the terminal --- pkg/urbit/vere/io/term.c | 32 +++++++++++++++++++++++++++----- 1 file changed, 27 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/vere/io/term.c b/pkg/urbit/vere/io/term.c index e89a7419f..e9cd30bbe 100644 --- a/pkg/urbit/vere/io/term.c +++ b/pkg/urbit/vere/io/term.c @@ -19,14 +19,36 @@ static void _term_read_cb(uv_stream_t* tcp_u, const uv_buf_t* buf_u); static c3_i _term_tcsetattr(c3_i, c3_i, const struct termios*); -/* _write(): wraps write(), asserting length +/* _write(): retry interrupts, continue partial writes, assert errors. */ static void -_write(c3_i fid_i, const void* buf_v, size_t len) +_write(c3_i fid_i, const void* buf_v, size_t len_i) { - if ( len != write(fid_i, buf_v, len) ){ - u3l_log("write failed\r\n"); - c3_assert(0); + ssize_t ret_i; + + while ( len_i > 0 ) { + // retry interrupt/async errors + // + do { + ret_i = write(fid_i, buf_v, len_i); + } + while ( (ret_i < 0) + && ( (errno == EINTR) + || (errno == EAGAIN) + || (errno == EWOULDBLOCK) )); + + // assert on true errors + // + if ( ret_i < 0 ) { + u3l_log("term: write failed %s\r\n", strerror(errno)); + c3_assert(0); + } + // continue partial writes + // + else { + len_i -= ret_i; + buf_v += ret_i; + } } } From 9177b3ea878cf1229bbe7a3643eee7184977417f Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 14:22:44 -0700 Subject: [PATCH 211/257] vere: initialize king timer early (for reliable early-exit) --- pkg/urbit/vere/king.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/pkg/urbit/vere/king.c b/pkg/urbit/vere/king.c index e1be8c4cd..c0df14592 100644 --- a/pkg/urbit/vere/king.c +++ b/pkg/urbit/vere/king.c @@ -699,6 +699,10 @@ u3_king_commence() { u3_Host.lup_u = uv_default_loop(); + // initialize top-level timer + // + uv_timer_init(u3L, &u3K.tim_u); + // start up a "fast-compile" arvo for internal use only // (with hashboard always disabled) // @@ -752,10 +756,6 @@ u3_king_commence() } } - // initialize top-level timer - // - uv_timer_init(u3L, &u3K.tim_u); - // run the loop // _king_loop_init(); From 5a3dbde218f6139296e952571ff63e50ab6d374b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 16:36:10 -0700 Subject: [PATCH 212/257] vere: factors common _mcut functions into ward --- pkg/urbit/include/vere/vere.h | 20 +++++++++ pkg/urbit/vere/io/ames.c | 60 +-------------------------- pkg/urbit/vere/io/cttp.c | 78 +++++------------------------------ pkg/urbit/vere/io/http.c | 52 +---------------------- pkg/urbit/vere/ward.c | 56 +++++++++++++++++++++++++ 5 files changed, 91 insertions(+), 175 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 1dc30f981..2f84ac50b 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -754,6 +754,26 @@ void u3_ovum_free(u3_ovum *egg_u); + /* u3_mcut_char(): measure/cut character. + */ + c3_w + u3_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c); + + /* u3_mcut_cord(): measure/cut cord. + */ + c3_w + u3_mcut_cord(c3_c* buf_c, c3_w len_w, u3_noun san); + + /* u3_mcut_path(): measure/cut cord list. + */ + c3_w + u3_mcut_path(c3_c* buf_c, c3_w len_w, c3_c sep_c, u3_noun pax); + + /* u3_mcut_host(): measure/cut host. + */ + c3_w + u3_mcut_host(c3_c* buf_c, c3_w len_w, u3_noun hot); + /** New vere **/ /* u3_auto_init(): initialize all drivers. diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c index c0475a17d..3206ee7e8 100644 --- a/pkg/urbit/vere/io/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -494,62 +494,6 @@ _ames_io_start(u3_ames* sam_u) u3z(who); } -/* _cttp_mcut_char(): measure/cut character. -*/ -static c3_w -_cttp_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c) -{ - if ( buf_c ) { - buf_c[len_w] = chr_c; - } - return len_w + 1; -} - -/* _cttp_mcut_cord(): measure/cut cord. -*/ -static c3_w -_cttp_mcut_cord(c3_c* buf_c, c3_w len_w, u3_noun san) -{ - c3_w ten_w = u3r_met(3, san); - - if ( buf_c ) { - u3r_bytes(0, ten_w, (c3_y *)(buf_c + len_w), san); - } - u3z(san); - return (len_w + ten_w); -} - -/* _cttp_mcut_path(): measure/cut cord list. -*/ -static c3_w -_cttp_mcut_path(c3_c* buf_c, c3_w len_w, c3_c sep_c, u3_noun pax) -{ - u3_noun axp = pax; - - while ( u3_nul != axp ) { - u3_noun h_axp = u3h(axp); - - len_w = _cttp_mcut_cord(buf_c, len_w, u3k(h_axp)); - axp = u3t(axp); - - if ( u3_nul != axp ) { - len_w = _cttp_mcut_char(buf_c, len_w, sep_c); - } - } - u3z(pax); - return len_w; -} - -/* _cttp_mcut_host(): measure/cut host. -*/ -static c3_w -_cttp_mcut_host(c3_c* buf_c, c3_w len_w, u3_noun hot) -{ - len_w = _cttp_mcut_path(buf_c, len_w, '.', u3kb_flop(u3k(hot))); - u3z(hot); - return len_w; -} - /* _ames_ef_turf(): initialize ames I/O on domain(s). */ static void @@ -559,10 +503,10 @@ _ames_ef_turf(u3_ames* sam_u, u3_noun tuf) // XX save all for fallback, not just first // u3_noun hot = u3k(u3h(tuf)); - c3_w len_w = _cttp_mcut_host(0, 0, u3k(hot)); + c3_w len_w = u3_mcut_host(0, 0, u3k(hot)); sam_u->dns_c = c3_malloc(1 + len_w); - _cttp_mcut_host(sam_u->dns_c, 0, hot); + u3_mcut_host(sam_u->dns_c, 0, hot); sam_u->dns_c[len_w] = 0; // XX invalidate sam_u->imp_w &c ? diff --git a/pkg/urbit/vere/io/cttp.c b/pkg/urbit/vere/io/cttp.c index 125b8a725..81ad44384 100644 --- a/pkg/urbit/vere/io/cttp.c +++ b/pkg/urbit/vere/io/cttp.c @@ -340,62 +340,6 @@ _cttp_cres_fire_body(u3_cres* res_u, u3_hbod* bod_u) } } -/* _cttp_mcut_char(): measure/cut character. -*/ -static c3_w -_cttp_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c) -{ - if ( buf_c ) { - buf_c[len_w] = chr_c; - } - return len_w + 1; -} - -/* _cttp_mcut_cord(): measure/cut cord. -*/ -static c3_w -_cttp_mcut_cord(c3_c* buf_c, c3_w len_w, u3_noun san) -{ - c3_w ten_w = u3r_met(3, san); - - if ( buf_c ) { - u3r_bytes(0, ten_w, (c3_y *)(buf_c + len_w), san); - } - u3z(san); - return (len_w + ten_w); -} - -/* _cttp_mcut_path(): measure/cut cord list. -*/ -static c3_w -_cttp_mcut_path(c3_c* buf_c, c3_w len_w, c3_c sep_c, u3_noun pax) -{ - u3_noun axp = pax; - - while ( u3_nul != axp ) { - u3_noun h_axp = u3h(axp); - - len_w = _cttp_mcut_cord(buf_c, len_w, u3k(h_axp)); - axp = u3t(axp); - - if ( u3_nul != axp ) { - len_w = _cttp_mcut_char(buf_c, len_w, sep_c); - } - } - u3z(pax); - return len_w; -} - -/* _cttp_mcut_host(): measure/cut host. -*/ -static c3_w -_cttp_mcut_host(c3_c* buf_c, c3_w len_w, u3_noun hot) -{ - len_w = _cttp_mcut_path(buf_c, len_w, '.', u3kb_flop(u3k(hot))); - u3z(hot); - return len_w; -} - /* _cttp_mcut_pork(): measure/cut path/extension. */ static c3_w @@ -404,10 +348,10 @@ _cttp_mcut_pork(c3_c* buf_c, c3_w len_w, u3_noun pok) u3_noun h_pok = u3h(pok); u3_noun t_pok = u3t(pok); - len_w = _cttp_mcut_path(buf_c, len_w, '/', u3k(t_pok)); + len_w = u3_mcut_path(buf_c, len_w, '/', u3k(t_pok)); if ( u3_nul != h_pok ) { - len_w = _cttp_mcut_char(buf_c, len_w, '.'); - len_w = _cttp_mcut_cord(buf_c, len_w, u3k(u3t(h_pok))); + len_w = u3_mcut_char(buf_c, len_w, '.'); + len_w = u3_mcut_cord(buf_c, len_w, u3k(u3t(h_pok))); } u3z(pok); return len_w; @@ -423,11 +367,11 @@ _cttp_mcut_quay(c3_c* buf_c, c3_w len_w, u3_noun quy) while ( u3_nul != quy ) { if ( c3y == fir_o ) { - len_w = _cttp_mcut_char(buf_c, len_w, '?'); + len_w = u3_mcut_char(buf_c, len_w, '?'); fir_o = c3n; } else { - len_w = _cttp_mcut_char(buf_c, len_w, '&'); + len_w = u3_mcut_char(buf_c, len_w, '&'); } { @@ -436,9 +380,9 @@ _cttp_mcut_quay(c3_c* buf_c, c3_w len_w, u3_noun quy) u3x_cell(quy, &i_quy, &t_quy); u3x_cell(i_quy, &pi_quy, &qi_quy); - len_w = _cttp_mcut_cord(buf_c, len_w, u3k(pi_quy)); - len_w = _cttp_mcut_char(buf_c, len_w, '='); - len_w = _cttp_mcut_cord(buf_c, len_w, u3k(qi_quy)); + len_w = u3_mcut_cord(buf_c, len_w, u3k(pi_quy)); + len_w = u3_mcut_char(buf_c, len_w, '='); + len_w = u3_mcut_cord(buf_c, len_w, u3k(qi_quy)); quy = t_quy; } @@ -456,7 +400,7 @@ _cttp_mcut_url(c3_c* buf_c, c3_w len_w, u3_noun pul) u3_noun q_pul = u3h(u3t(pul)); u3_noun r_pul = u3t(u3t(pul)); - len_w = _cttp_mcut_char(buf_c, len_w, '/'); + len_w = u3_mcut_char(buf_c, len_w, '/'); len_w = _cttp_mcut_pork(buf_c, len_w, u3k(q_pul)); if ( u3_nul != r_pul ) { @@ -495,10 +439,10 @@ _cttp_creq_url(u3_noun pul) static c3_c* _cttp_creq_host(u3_noun hot) { - c3_w len_w = _cttp_mcut_host(0, 0, u3k(hot)); + c3_w len_w = u3_mcut_host(0, 0, u3k(hot)); c3_c* hot_c = c3_malloc(1 + len_w); - _cttp_mcut_host(hot_c, 0, hot); + u3_mcut_host(hot_c, 0, hot); hot_c[len_w] = 0; return hot_c; diff --git a/pkg/urbit/vere/io/http.c b/pkg/urbit/vere/io/http.c index a8a3adc60..f74da5a96 100644 --- a/pkg/urbit/vere/io/http.c +++ b/pkg/urbit/vere/io/http.c @@ -1325,61 +1325,13 @@ _http_serv_start(u3_http* htp_u) } } -//XX deduplicate these with cttp - -/* _cttp_mcut_char(): measure/cut character. -*/ -static c3_w -_cttp_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c) -{ - if ( buf_c ) { - buf_c[len_w] = chr_c; - } - return len_w + 1; -} - -/* _cttp_mcut_cord(): measure/cut cord. -*/ -static c3_w -_cttp_mcut_cord(c3_c* buf_c, c3_w len_w, u3_noun san) -{ - c3_w ten_w = u3r_met(3, san); - - if ( buf_c ) { - u3r_bytes(0, ten_w, (c3_y *)(buf_c + len_w), san); - } - u3z(san); - return (len_w + ten_w); -} - -/* _cttp_mcut_path(): measure/cut cord list. -*/ -static c3_w -_cttp_mcut_path(c3_c* buf_c, c3_w len_w, c3_c sep_c, u3_noun pax) -{ - u3_noun axp = pax; - - while ( u3_nul != axp ) { - u3_noun h_axp = u3h(axp); - - len_w = _cttp_mcut_cord(buf_c, len_w, u3k(h_axp)); - axp = u3t(axp); - - if ( u3_nul != axp ) { - len_w = _cttp_mcut_char(buf_c, len_w, sep_c); - } - } - u3z(pax); - return len_w; -} - static uv_buf_t _http_wain_to_buf(u3_noun wan) { - c3_w len_w = _cttp_mcut_path(0, 0, (c3_c)10, u3k(wan)); + c3_w len_w = u3_mcut_path(0, 0, (c3_c)10, u3k(wan)); c3_c* buf_c = c3_malloc(1 + len_w); - _cttp_mcut_path(buf_c, 0, (c3_c)10, wan); + u3_mcut_path(buf_c, 0, (c3_c)10, wan); buf_c[len_w] = 0; return uv_buf_init(buf_c, len_w); diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c index 9df12dbd0..e39284a43 100644 --- a/pkg/urbit/vere/ward.c +++ b/pkg/urbit/vere/ward.c @@ -166,3 +166,59 @@ u3_ovum_free(u3_ovum *egg_u) c3_free(egg_u); } + +/* u3_mcut_char(): measure/cut character. +*/ +c3_w +u3_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c) +{ + if ( buf_c ) { + buf_c[len_w] = chr_c; + } + return len_w + 1; +} + +/* u3_mcut_cord(): measure/cut cord. +*/ +c3_w +u3_mcut_cord(c3_c* buf_c, c3_w len_w, u3_noun san) +{ + c3_w ten_w = u3r_met(3, san); + + if ( buf_c ) { + u3r_bytes(0, ten_w, (c3_y *)(buf_c + len_w), san); + } + u3z(san); + return (len_w + ten_w); +} + +/* u3_mcut_path(): measure/cut cord list. +*/ +c3_w +u3_mcut_path(c3_c* buf_c, c3_w len_w, c3_c sep_c, u3_noun pax) +{ + u3_noun axp = pax; + + while ( u3_nul != axp ) { + u3_noun h_axp = u3h(axp); + + len_w = u3_mcut_cord(buf_c, len_w, u3k(h_axp)); + axp = u3t(axp); + + if ( u3_nul != axp ) { + len_w = u3_mcut_char(buf_c, len_w, sep_c); + } + } + u3z(pax); + return len_w; +} + +/* u3_mcut_host(): measure/cut host. +*/ +c3_w +u3_mcut_host(c3_c* buf_c, c3_w len_w, u3_noun hot) +{ + len_w = u3_mcut_path(buf_c, len_w, '.', u3kb_flop(u3k(hot))); + u3z(hot); + return len_w; +} From 0f54d25d8e21f18ca102d18f2256fc4a71f84705 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 25 Jun 2020 18:34:48 -0700 Subject: [PATCH 213/257] vere: silence ames errors unless -v, prints stats every 1k --- pkg/urbit/vere/io/ames.c | 111 +++++++++++++++++++++++++++++---------- 1 file changed, 83 insertions(+), 28 deletions(-) diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c index 3206ee7e8..d2b632860 100644 --- a/pkg/urbit/vere/io/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -38,7 +38,8 @@ c3_o fak_o; // fake keys c3_s por_s; // public IPv4 port c3_c* dns_c; // domain XX multiple/fallback - c3_d dop_d; // drop count (since last print) + c3_d dop_d; // drop count + c3_d fal_d; // crash count c3_w imp_w[256]; // imperial IPs time_t imp_t[256]; // imperial IP timestamps c3_o imp_o[256]; // imperial print status @@ -357,6 +358,82 @@ _ames_ef_send(u3_ames* sam_u, u3_noun lan, u3_noun pac) u3z(lan); u3z(pac); } +/* _ames_cap_queue(): cap ovum queue at 1k, dropping oldest packets. +*/ +static void +_ames_cap_queue(u3_ames* sam_u) +{ + u3_ovum* egg_u = sam_u->car_u.ext_u; + + while ( egg_u && (1000 < sam_u->car_u.dep_w) ) { + u3_ovum* nex_u = egg_u->nex_u; + + if ( c3__hear == u3h(egg_u->cad) ) { + u3_auto_drop(&sam_u->car_u, egg_u); + sam_u->dop_d++; + + if ( u3C.wag_w & u3o_verbose ) { + u3l_log("ames: packet dropped (%" PRIu64 " total)\n", sam_u->dop_d); + } + } + + egg_u = nex_u; + } + + if ( (sam_u->dop_d && (0 == (sam_u->dop_d % 1000))) + && !(u3C.wag_w & u3o_verbose) ) + { + u3l_log("ames: packet dropped (%" PRIu64 " total)\n", sam_u->dop_d); + } +} + +/* _ames_punt_goof(): print %bail error report(s). +*/ +static void +_ames_punt_goof(u3_noun lud) +{ + u3_noun dul = lud; + + if ( 2 == u3qb_lent(dul) ) { + u3_pier_punt_goof("hear", u3k(u3h(dul))); + u3_pier_punt_goof("crud", u3k(u3h(u3t(dul)))); + } + else { + c3_w len_w = 1; + + while ( u3_nul != dul ) { + u3l_log("ames: bail %u\r\n", len_w++); + u3_pier_punt_goof("ames", u3k(u3h(dul))); + dul = u3t(dul); + } + } + + u3z(lud); +} + +/* _ames_hear_bail(): handle packet failure. +*/ +static void +_ames_hear_bail(u3_ovum* egg_u, u3_noun lud) +{ + u3_ames* sam_u = (u3_ames*)egg_u->car_u; + sam_u->fal_d++; + + if ( (u3C.wag_w & u3o_verbose) + || (0 == (sam_u->fal_d % 1000)) ) + { + _ames_punt_goof(lud); + u3l_log("ames: packet failed (%" PRIu64 " total)\n\n", sam_u->fal_d); + } + else { + u3z(lud); + + if ( 0 == (sam_u->fal_d % 1000) ) { + u3l_log("ames: packet failed (%" PRIu64 " total)\n\n", sam_u->fal_d); + } + } +} + /* _ames_recv_cb(): receive callback. */ static void @@ -394,30 +471,11 @@ _ames_recv_cb(uv_udp_t* wax_u, cad = u3nt(c3__hear, u3nc(c3n, lan), msg); } - u3_auto_plan(&sam_u->car_u, 0, c3__a, wir, cad); + u3_auto_peer( + u3_auto_plan(&sam_u->car_u, 0, c3__a, wir, cad), + 0, _ames_hear_bail); - // cap ovum queue at 1k, dropping oldest packets - // - { - u3_ovum* egg_u = sam_u->car_u.ext_u; - - while ( egg_u && (1000 < sam_u->car_u.dep_w) ) { - u3_ovum* nex_u = egg_u->nex_u; - - if ( c3__hear == u3h(egg_u->cad) ) { - u3_auto_drop(&sam_u->car_u, egg_u); - sam_u->dop_d++; - } - - egg_u = nex_u; - } - } - - if ( 0 == (sam_u->dop_d % 1000) ) { - if ( (u3C.wag_w & u3o_verbose) ) { - u3l_log("ames: dropped 1.000 packets\r\n"); - } - } + _ames_cap_queue(sam_u); } c3_free(buf_u->base); @@ -652,6 +710,7 @@ _ames_io_info(u3_auto* car_u) { u3_ames* sam_u = (u3_ames*)car_u; u3l_log(" dropped: %" PRIu64 "\n", sam_u->dop_d); + u3l_log(" crashed: %" PRIu64 "\n", sam_u->fal_d); } /* u3_ames_io_init(): initialize ames I/O. @@ -684,9 +743,5 @@ u3_ames_io_init(u3_pier* pir_u) car_u->io.kick_f = _ames_io_kick; car_u->io.exit_f = _ames_io_exit; - // XX track and print every N? - // - // car_u->ev.bail_f = ...; - return car_u; } From 57967b35fbaa78c02d620f877fd6c983b667fe51 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 10:25:24 -0700 Subject: [PATCH 214/257] vere: tweaks pier/lord info printfs --- pkg/urbit/include/vere/vere.h | 5 +++++ pkg/urbit/vere/newt.c | 18 ++++++++++++++++++ pkg/urbit/vere/pier.c | 5 ++--- 3 files changed, 25 insertions(+), 3 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 2f84ac50b..2059e0459 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -1211,6 +1211,11 @@ void u3_newt_read(u3_moat* mot_u); + /* u3_newt_moat_info(); print status info. + */ + void + u3_newt_moat_info(u3_moat* mot_u); + /* u3_newt_moat_stop(); newt stop/close input stream. */ void diff --git a/pkg/urbit/vere/newt.c b/pkg/urbit/vere/newt.c index 9af6fcae7..e7cfe2be5 100644 --- a/pkg/urbit/vere/newt.c +++ b/pkg/urbit/vere/newt.c @@ -365,6 +365,24 @@ u3_newt_read(u3_moat* mot_u) _newt_read_init(mot_u, _newt_read_cb); } +/* u3_newt_moat_info(); print status info. +*/ +void +u3_newt_moat_info(u3_moat* mot_u) +{ + u3_meat* met_u = mot_u->ext_u; + c3_w len_w = 0; + + while ( met_u ) { + len_w++; + met_u = met_u->nex_u; + } + + if ( len_w ) { + u3l_log(" newt: %u inbound ipc messages pending\n", len_w); + } +} + /* n_req: write request for newt */ typedef struct _n_req { diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 1ac8eae0b..22dab8096 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -1028,8 +1028,7 @@ u3_pier_info(u3_pier* pir_u) { u3_work* wok_u = pir_u->wok_u; - u3l_log(" effects:\n"); - u3l_log(" released: %" PRIu64 "\n", wok_u->fec_u.rel_d); + u3l_log(" effects: released=%" PRIu64 "\n", wok_u->fec_u.rel_d); if ( wok_u->fec_u.ext_u ) { if ( wok_u->fec_u.ext_u != wok_u->fec_u.ent_u ) { @@ -1044,7 +1043,7 @@ u3_pier_info(u3_pier* pir_u) } if ( wok_u->wal_u ) { - u3l_log("wall: %" PRIu64 "\n", wok_u->wal_u->eve_d); + u3l_log(" wall: %" PRIu64 "\n", wok_u->wal_u->eve_d); } if ( wok_u->car_u ) { From 49bea37049d9ba4c309eb7a16a928a62318ae57e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 11:20:08 -0700 Subject: [PATCH 215/257] vere: adds pending ipc message to lord status printfs --- pkg/urbit/vere/lord.c | 1 + 1 file changed, 1 insertion(+) diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 268bb1bf1..b8e4d26d5 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -986,6 +986,7 @@ u3_lord_info(u3_lord* god_u) god_u->eve_d, god_u->mug_l, god_u->dep_w); + u3_newt_moat_info(&god_u->out_u); } /* u3_lord_init(): instantiate child process. From 6148c87525661212d364d7f155480c8a42118557 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 11:31:42 -0700 Subject: [PATCH 216/257] vere: restores arbitrary event injection with -I --- pkg/urbit/vere/io/fore.c | 62 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/pkg/urbit/vere/io/fore.c b/pkg/urbit/vere/io/fore.c index fd2a3962a..32b5436e4 100644 --- a/pkg/urbit/vere/io/fore.c +++ b/pkg/urbit/vere/io/fore.c @@ -11,6 +11,62 @@ #include "all.h" #include "vere/vere.h" +/* _fore_inject_bail(): handle failure on arbitrary injection. +*/ +static void +_fore_inject_bail(u3_ovum* egg_u, u3_noun lud) +{ + u3_auto_bail_slog(egg_u, lud); + u3l_log("pier: injected event failed\n"); +} + +/* _fore_inject(): inject an arbitrary ovum from a jammed file at [pax_c]. +*/ +static void +_fore_inject(u3_auto* car_u, c3_c* pax_c) +{ + // XX soft + // + u3_noun ovo = u3ke_cue(u3m_file(pax_c)); + u3_noun riw, cad, tar, wir; + + if ( c3n == u3r_cell(ovo, &riw, &cad) ) { + u3l_log("pier: invalid ovum in -I\n"); + } + else if ( (c3n == u3a_is_cell(cad)) + || (c3n == u3a_is_atom(u3h(cad))) ) + { + u3l_log("pier: invalid card in -I ovum\n"); + } + else if ( c3n == u3r_cell(riw, &tar, &wir) ) { + u3l_log("pier: invalid wire in -I ovum\n"); + } + else if ( (c3n == u3a_is_atom(tar)) + || (1 < u3r_met(3, tar)) ) + { + u3l_log("pier: invalid target in -I wire\n"); + } + else { + { + c3_c* tag_c = u3r_string(u3h(cad)); + u3_noun ser = u3do("spat", u3k(riw)); + c3_c* wir_c = u3r_string(ser); + + u3l_log("pier: injecting %%%s event on %s\n", tag_c, wir_c); + + c3_free(tag_c); + c3_free(wir_c); + u3z(ser); + } + + u3_auto_peer( + u3_auto_plan(car_u, 0, u3k(tar), u3k(wir), u3k(cad)), + 0, _fore_inject_bail); + } + + u3z(ovo); +} + /* _fore_io_talk(): */ static void @@ -42,6 +98,12 @@ _fore_io_talk(u3_auto* car_u) u3_auto_plan(car_u, 0, u3_blip, wir, cad); } + + // inject arbitrary + // + if ( u3_Host.ops_u.jin_c ) { + _fore_inject(car_u, u3_Host.ops_u.jin_c); + } } /* _fore_io_kick(): handle no effects. From 55dd1e2cf7645fd53f834f0311e50363eeca238f Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 11:32:04 -0700 Subject: [PATCH 217/257] vere: fixes re-entrancy bug in term.c write() wrapper --- pkg/urbit/vere/io/term.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/pkg/urbit/vere/io/term.c b/pkg/urbit/vere/io/term.c index e9cd30bbe..e3c7f4cb2 100644 --- a/pkg/urbit/vere/io/term.c +++ b/pkg/urbit/vere/io/term.c @@ -39,8 +39,10 @@ _write(c3_i fid_i, const void* buf_v, size_t len_i) // assert on true errors // + // NB: can't call u3l_log here or we would re-enter _write() + // if ( ret_i < 0 ) { - u3l_log("term: write failed %s\r\n", strerror(errno)); + fprintf(stderr, "term: write failed %s\r\n", strerror(errno)); c3_assert(0); } // continue partial writes From db9472dbe2cf41f604a7cf4ea45f9beb64683275 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 12:29:18 -0700 Subject: [PATCH 218/257] vere/king: tweaks serf startup args (unconditionally send all) --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 3 ++- pkg/urbit/vere/lord.c | 2 +- pkg/urbit/worker/main.c | 8 +++----- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 7321c1300..442c1b30d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -290,7 +290,8 @@ start (Config exePax pierPath flags onSlog onStdr onDead) = do where diskKey = "" config = show (compileFlags flags) - args = [pierPath, diskKey, config] + rock = "0" -- XX support loading from rock + args = [pierPath, diskKey, config, rock] pSpec = (proc exePax args) { std_in = CreatePipe , std_out = CreatePipe , std_err = CreatePipe diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index b8e4d26d5..5ca9e3681 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -1033,7 +1033,7 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) arg_c[4] = u3_Host.ops_u.roc_c; } else { - arg_c[4] = 0; + arg_c[4] = "0"; } arg_c[5] = 0; diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index d4f89a0f8..d21e2e2af 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -101,12 +101,10 @@ main(c3_i argc, c3_c* argv[]) c3_c* wag_c = argv[3]; c3_d eve_d = 0; - c3_assert( (4 == argc) || (5 == argc) ); + c3_assert( 5 == argc ); - if ( 5 == argc ) { - if ( 1 != sscanf(argv[4], "%" PRIu64 "", &eve_d) ) { - fprintf(stderr, "serf: rock: invalid number '%s'\r\n", argv[4]); - } + if ( 1 != sscanf(argv[4], "%" PRIu64 "", &eve_d) ) { + fprintf(stderr, "serf: rock: invalid number '%s'\r\n", argv[4]); } memset(&u3V, 0, sizeof(u3V)); From 7f61b5a4916c73cd2197f6de566ff10c7e5cad2d Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 16:23:38 -0700 Subject: [PATCH 219/257] Revert "Merge pull request #3050 from urbit/m/behn-improvements" This reverts commit ed808614aa05035bd1447270341afa88160b948b, reversing changes made to a6db3add835c7b7e6a690aea24a28b8a9e03e623. --- pkg/arvo/app/dbug.hoon | 2 +- pkg/arvo/gen/timers.hoon | 4 +-- pkg/arvo/sys/arvo.hoon | 2 +- pkg/arvo/sys/vane/behn.hoon | 48 ++++------------------------- pkg/urbit/vere/io/behn.c | 60 ++++++++----------------------------- 5 files changed, 22 insertions(+), 94 deletions(-) diff --git a/pkg/arvo/app/dbug.hoon b/pkg/arvo/app/dbug.hoon index 320a03dba..90124315b 100644 --- a/pkg/arvo/app/dbug.hoon +++ b/pkg/arvo/app/dbug.hoon @@ -767,7 +767,7 @@ ++ v-behn |% ++ timers - (scry ,(list [date=@da =duct]) %bx %$ /debug/timers) + (scry ,(list [date=@da =duct]) %b %timers ~) -- :: :: clay diff --git a/pkg/arvo/gen/timers.hoon b/pkg/arvo/gen/timers.hoon index 715104fda..f53710f58 100644 --- a/pkg/arvo/gen/timers.hoon +++ b/pkg/arvo/gen/timers.hoon @@ -1,5 +1,5 @@ :: Find list of currently running Behn timers :- %say -|= [[now=@da *] *] +|= * :- %tang -[>.^((list [date=@da =duct]) %bx /=//(scot %da now)/debug/timers)< ~] +[>.^((list [date=@da =duct]) %b /=timers=)< ~] diff --git a/pkg/arvo/sys/arvo.hoon b/pkg/arvo/sys/arvo.hoon index 3cd018199..0bbf9622f 100644 --- a/pkg/arvo/sys/arvo.hoon +++ b/pkg/arvo/sys/arvo.hoon @@ -191,7 +191,7 @@ ?. ?=({@ @ @ @ *} u.pux) ~ =+ :* hyr=(slaw %tas i.u.pux) fal=(slaw %p i.t.u.pux) - dyc=?~(i.t.t.u.pux (some %$) (slaw %tas i.t.t.u.pux)) + dyc=(slaw %tas i.t.t.u.pux) ved=(slay i.t.t.t.u.pux) tyl=t.t.t.t.u.pux == diff --git a/pkg/arvo/sys/vane/behn.hoon b/pkg/arvo/sys/vane/behn.hoon index 34b8f7a8f..a9dcfa8b7 100644 --- a/pkg/arvo/sys/vane/behn.hoon +++ b/pkg/arvo/sys/vane/behn.hoon @@ -389,56 +389,18 @@ ++ scry |= [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path] ^- (unit (unit cage)) - :: only respond for the local identity, %$ desk, current timestamp :: - ?. ?& =(&+our why) - =([%$ %da now] lot) - =(%$ syd) - == + ?. ?=(%& -.why) ~ - :: /bx/debug/timers (list [@da duct]) all timers and their ducts - :: /bx/timers (list @da) all timer timestamps - :: /bx/timers/next (unit @da) the very next timer to fire - :: /bx/timers/[da] (list @da) all timers up to and including da - :: - ?. ?=(%x ren) ~ - ?+ tyl [~ ~] - [%debug %timers ~] - :^ ~ ~ %noun - !> ^- (list [@da duct]) + ?. ?=(%timers syd) + [~ ~] + =/ tiz=(list [@da duct]) %- zing %+ turn (tap:timer-map timers) |= [date=@da q=(qeu duct)] %+ turn ~(tap to q) |=(d=duct [date d]) - :: - [%timers ~] - :^ ~ ~ %noun - !> ^- (list @da) - %- zing - %+ turn (tap:timer-map timers) - |= [date=@da q=(qeu duct)] - (reap ~(wyt in q) date) - :: - [%timers %next ~] - :^ ~ ~ %noun - !> ^- (unit @da) - (bind (peek:timer-map timers) head) - :: - [%timers @ ~] - ?~ til=(slaw %da i.t.tyl) - [~ ~] - :^ ~ ~ %noun - !> ^- (list @da) - =/ tiz=(list [date=@da q=(qeu duct)]) - (tap:timer-map timers) - |- ^- (list @da) - ?~ tiz ~ - ?: (gth date.i.tiz u.til) ~ - %+ weld - (reap ~(wyt in q.i.tiz) date.i.tiz) - $(tiz t.tiz) - == + [~ ~ %noun !>(tiz)] :: ++ stay state ++ take diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index 469036edc..3d09f2ef1 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -16,36 +16,28 @@ typedef struct _u3_behn { u3_auto car_u; // driver uv_timer_t tim_u; // behn timer - c3_o alm_o; // alarm - c3_o see_o; // can scry + c3_o alm; // alarm } u3_behn; -static void _behn_scry_cb(void* vod_p, u3_noun nun); - /* _behn_time_cb(): timer callback. */ static void _behn_time_cb(uv_timer_t* tim_u) { u3_behn* teh_u = tim_u->data; - teh_u->alm_o = c3n; + teh_u->alm = c3n; - // take initiative to start the next timer, just in case + // start another timer for 10 minutes // // This is a backstop to deal with the case where a %doze is not // properly sent, for example after a crash. If the timer continues // to fail, we can't proceed with the timers, but if it was a // transient error, this will get us past it. // - if (c3y == teh_u->see_o) { - u3_noun pax = u3i_trel(u3i_string("timers"), u3i_string("next"), u3_nul); - u3_lord_peek_last(teh_u->car_u.pir_u->god_u, u3_nul, - c3_s2('b', 'x'), u3_nul, pax, - teh_u, _behn_scry_cb); - } - else { - // if scry is known to not work, short-circuit - _behn_scry_cb(teh_u, u3_nul); + { + c3_d gap_d = 10 * 60 * 1000; + teh_u->alm = c3y; + uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); } // send timer event @@ -67,12 +59,13 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) teh_u->car_u.liv_o = c3y; } - if ( c3y == teh_u->alm_o ) { + if ( c3y == teh_u->alm ) { uv_timer_stop(&teh_u->tim_u); - teh_u->alm_o = c3n; + teh_u->alm = c3n; } - if ( (c3y == u3du(wen)) && + if ( (u3_nul != wen) && + (c3y == u3du(wen)) && (c3y == u3ud(u3t(wen))) ) { struct timeval tim_tv; @@ -81,39 +74,13 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) u3_noun now = u3_time_in_tv(&tim_tv); c3_d gap_d = u3_time_gap_ms(now, u3k(u3t(wen))); - teh_u->alm_o = c3y; + teh_u->alm = c3y; uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); - } else if (u3_nul != wen) { - u3m_p("behn: invalid doze", wen); } u3z(wen); } -/* _behn_scry_cb(): next timer scry result callback. -*/ -static void -_behn_scry_cb(void* vod_p, u3_noun nun) -{ - u3_behn* teh_u = vod_p; - u3_weak tim = u3r_at(7, nun); - - if (c3y == teh_u->alm_o) { - // timer already set while we were scrying, no-op - } - else if (u3_none == tim) { - // remember scry doesn't work, fall back to a timer for 10 minutes - // - teh_u->see_o = c3n; - c3_d gap_d = 10 * 60 * 1000; - teh_u->alm_o = c3y; - uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); - } else { - _behn_ef_doze(teh_u, u3k(tim)); - } - u3z(nun); -} - /* _behn_io_talk(): notify %behn that we're live */ static void @@ -176,8 +143,7 @@ u3_auto* u3_behn_io_init(u3_pier* pir_u) { u3_behn* teh_u = c3_calloc(sizeof(*teh_u)); - teh_u->alm_o = c3n; - teh_u->see_o = c3y; + teh_u->alm = c3n; uv_timer_init(u3L, &teh_u->tim_u); teh_u->tim_u.data = teh_u; From 47796f812e35093ad2e11138f2ecf6ceeb27a03b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 16:10:53 -0700 Subject: [PATCH 220/257] pill: solid --- bin/solid.pill | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bin/solid.pill b/bin/solid.pill index 4f574a7fb..ebce0c52c 100644 --- a/bin/solid.pill +++ b/bin/solid.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:a6402e6f2645a0b590f74dea8947329affabcc3b4ea45532727aded07c03d32b -size 17696206 +oid sha256:541c253fc41f0010a8d1e5d3ac30b12f83a850a5e0b73ce88eafa2dbf1b536a4 +size 17689765 From 1d7c361b06059ff3de847b270a9a1624507c5bc4 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 16:14:48 -0700 Subject: [PATCH 221/257] vere: adds/improves error messages for term syscall retry loops --- pkg/urbit/vere/io/term.c | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/pkg/urbit/vere/io/term.c b/pkg/urbit/vere/io/term.c index e3c7f4cb2..c21f5f5b8 100644 --- a/pkg/urbit/vere/io/term.c +++ b/pkg/urbit/vere/io/term.c @@ -27,9 +27,16 @@ _write(c3_i fid_i, const void* buf_v, size_t len_i) ssize_t ret_i; while ( len_i > 0 ) { + c3_w lop_w = 0; // retry interrupt/async errors // do { + // abort pathological retry loop + // + if ( 100 == ++lop_w ) { + fprintf(stderr, "term: write loop: %s\r\n", strerror(errno)); + return; + } ret_i = write(fid_i, buf_v, len_i); } while ( (ret_i < 0) @@ -315,7 +322,7 @@ _term_tcsetattr(c3_i fil_i, c3_i act_i, const struct termios* tms_u) // abort pathological retry loop // if ( 100 == ++len_w ) { - fprintf(stderr, "term: tcsetattr loop\r\n"); + fprintf(stderr, "term: tcsetattr loop: %s\r\n", strerror(errno)); return -1; } ret_i = tcsetattr(fil_i, act_i, tms_u); From 14faa22e0f9e9f3f2a9179aeb3ca2562fa7ccf7e Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 26 Jun 2020 15:14:40 -0700 Subject: [PATCH 222/257] nix: add explicit shutdown to solid-pill derivation --- nix/ops/solid/builder.sh | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/nix/ops/solid/builder.sh b/nix/ops/solid/builder.sh index 579266fed..f5b39a057 100755 --- a/nix/ops/solid/builder.sh +++ b/nix/ops/solid/builder.sh @@ -7,13 +7,13 @@ chmod -R u+rw ./pier $URBIT -d ./pier -cleanup () { +shutdown () { if [ -e ./pier/.vere.lock ] then kill $(< ./pier/.vere.lock) || true; fi } -trap cleanup EXIT +trap shutdown EXIT # update pill strategy to ensure correct staging # @@ -75,6 +75,8 @@ herb ./pier -p hood -d "+hood/unmount %stage" herb ./pier -P solid.pill -d '+solid /=stage=/sys, =dub &' +herb ./pier -p hood -d '+hood/exit' || true + mv solid.pill $out set +x From a53f688d01262403a5c61bb9a68ca243cf080411 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 27 Jun 2020 00:12:53 -0700 Subject: [PATCH 223/257] vere/serf/king: support timeouts and error response in %peek --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 33 ++++--- .../urbit-king/lib/Urbit/Vere/Serf/Types.hs | 1 + pkg/urbit/include/vere/serf.h | 2 +- pkg/urbit/noun/vortex.c | 69 +++---------- pkg/urbit/vere/lord.c | 78 +++++++++++---- pkg/urbit/vere/pier.c | 3 + pkg/urbit/worker/serf.c | 99 ++++++++++++------- 7 files changed, 169 insertions(+), 116 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 36700297e..f8d8b4d47 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -23,24 +23,27 @@ [%save eve=@] [%pack eve=@] == == - [%peek now=date lyc=gang pat=path] - [%play eve=@ lit=(list ?((pair date ovum) *))] - [%work mil=@ job=(pair date ovum)] + [%peek mil=@ now=@da lyc=gang pat=path] + [%play eve=@ lit=(list ?((pair @da ovum) *))] + [%work mil=@ job=(pair @da ovum)] == :: +plea: from serf to king :: +$ plea $% [%live ~] - [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] + [%ripe [pro=%1 hon=@ nok=@] eve=@ mug=@] [%slog pri=@ ?(cord tank)] - [%peek dat=(unit (cask))] + $: %peek + $% [%done dat=(unit (cask))] + [%bail dud=goof] + == == $: %play $% [%done mug=@] [%bail eve=@ mug=@ dud=goof] == == $: %work $% [%done eve=@ mug=@ fec=(list ovum)] - [%swap eve=@ mug=@ job=(pair date ovum) fec=(list ovum)] + [%swap eve=@ mug=@ job=(pair @da ovum) fec=(list ovum)] [%bail lud=(list goof)] == == == @@ -112,6 +115,11 @@ data Play | PBail PlayBail deriving (Show) +data Scry + = SDone (Maybe (Term, Noun)) + | SBail Goof + deriving (Show) + data Work = WDone EventId Mug FX | WSwap EventId Mug (Wen, Noun) FX @@ -120,7 +128,7 @@ data Work data Writ = WLive Live - | WPeek Wen Gang Path + | WPeek Atom Wen Gang Path | WPlay EventId [Noun] | WWork Atom Wen Ev deriving (Show) @@ -129,13 +137,14 @@ data Plea = PLive () | PRipe SerfInfo | PSlog Slog - | PPeek (Maybe (Term, Noun)) + | PPeek Scry | PPlay Play | PWork Work deriving (Show) deriveNoun ''Live deriveNoun ''Play +deriveNoun ''Scry deriveNoun ''Work deriveNoun ''Writ deriveNoun ''Plea @@ -238,8 +247,10 @@ recvWork serf = do recvPeek :: Serf -> IO (Maybe (Term, Noun)) recvPeek serf = do recvPleaHandlingSlog serf >>= \case - PPeek peek -> pure peek - plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %peek") + PPeek (SDone peek) -> pure peek + -- XX produce error + PPeek (SBail dud) -> throwIO (PeekBail dud) + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %peek") -- Request-Response Points -- These don't touch the lock ----------------------- @@ -256,7 +267,7 @@ sendCompactionRequest serf eve = do sendScryRequest :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) sendScryRequest serf w g p = do - sendWrit serf (WPeek w g p) + sendWrit serf (WPeek 0 w g p) recvPeek serf sendShutdownRequest :: Serf -> Atom -> IO () diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs index 493a7efb0..1544a56fe 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs @@ -103,6 +103,7 @@ data SerfExn = UnexpectedPlea Noun Text | BadPleaAtom Atom | BadPleaNoun Noun [Text] Text + | PeekBail Goof | SerfConnectionClosed | SerfHasShutdown | BailDuringReplay EventId [Goof] diff --git a/pkg/urbit/include/vere/serf.h b/pkg/urbit/include/vere/serf.h index e9fa790ea..b1a1fdde3 100644 --- a/pkg/urbit/include/vere/serf.h +++ b/pkg/urbit/include/vere/serf.h @@ -42,7 +42,7 @@ /* u3_serf_peek(): read namespace. */ u3_noun - u3_serf_peek(u3_serf* sef_u, u3_noun sam); + u3_serf_peek(u3_serf* sef_u, c3_w mil_w, u3_noun sam); /* u3_serf_play(): apply event list, producing status. */ diff --git a/pkg/urbit/noun/vortex.c b/pkg/urbit/noun/vortex.c index e10c19af3..ad12ab404 100644 --- a/pkg/urbit/noun/vortex.c +++ b/pkg/urbit/noun/vortex.c @@ -128,58 +128,6 @@ u3v_wish(const c3_c* str_c) return exp; } -/* _cv_nock_poke(): call poke through hardcoded interface. -*/ -static u3_noun -_cv_nock_poke(u3_noun ovo) -{ - u3_noun fun = u3n_nock_on(u3k(u3A->roc), u3k(u3x_at(_CVX_POKE, u3A->roc))); - u3_noun sam, pro; - u3_noun cod_w; - - sam = u3nc(u3k(u3A->now), ovo); -#if 0 - { - c3_c* ovi_c = u3r_string(u3h(u3t(ovo))); - u3_noun tox = u3do("spat", u3k(u3h(ovo))); - c3_c* tox_c = u3r_string(tox); - - u3l_log("poke: %%%s (%x) on %s\r\n", ovi_c, u3r_mug(ovo), tox_c); - c3_free(tox_c); c3_free(ovi_c); u3z(tox); - } -#endif - - cod_w = u3a_lush(u3h(u3t(ovo))); - pro = u3n_slam_on(fun, sam); - u3a_lop(cod_w); - -#if 0 - { - c3_c* ovi_c = u3r_string(u3h(u3t(ovo))); - - if ( u3_nul == u3h(pro) ) { - u3l_log(" blank: %s\r\n", ovi_c); - } else { - u3l_log(" happy: %s: %d\r\n", ovi_c, u3kb_lent(u3k(u3h(pro)))); - } - c3_free(ovi_c); - } -#endif - - return pro; -} - -/* _cv_nock_peek(): call peek through hardcoded interface. -*/ -static u3_noun -_cv_nock_peek(u3_noun hap) -{ - u3_noun fun = u3n_nock_on(u3k(u3A->roc), u3k(u3x_at(_CVX_PEEK, u3A->roc))); - u3_noun sam = u3nc(u3k(u3A->now), hap); - - return u3n_slam_on(fun, sam); -} - /* u3v_do(): use a kernel gate. */ u3_noun @@ -249,7 +197,10 @@ _cv_time_bump(u3_reck* rec_u) u3_noun u3v_peek(u3_noun hap) { - return u3m_soft_sure(_cv_nock_peek, hap); + u3_noun fun = u3n_nock_on(u3k(u3A->roc), u3k(u3x_at(_CVX_PEEK, u3A->roc))); + u3_noun sam = u3nc(u3k(u3A->now), hap); + + return u3n_slam_on(fun, sam); } #if 0 @@ -305,7 +256,17 @@ _cv_lily(u3_noun fot, u3_noun txt, c3_l* tid_l) u3_noun u3v_poke(u3_noun ovo) { - return _cv_nock_poke(ovo); + u3_noun fun = u3n_nock_on(u3k(u3A->roc), u3k(u3x_at(_CVX_POKE, u3A->roc))); + u3_noun sam = u3nc(u3k(u3A->now), ovo); + u3_noun pro; + + { + c3_w cod_w = u3a_lush(u3h(u3t(ovo))); + pro = u3n_slam_on(fun, sam); + u3a_lop(cod_w); + } + + return pro; } /* u3v_tank(): dump single tank. diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 3ed0e260e..5f0ae2a80 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -29,24 +29,27 @@ [%save eve=@] [%pack eve=@] == == - [%peek now=date lyc=gang pat=path] - [%play eve=@ lit=(list ?((pair date ovum) *))] - [%work mil=@ job=(pair date ovum)] + [%peek mil=@ now=@da lyc=gang pat=path] + [%play eve=@ lit=(list ?((pair @da ovum) *))] + [%work mil=@ job=(pair @da ovum)] == :: +plea: from serf to king :: +$ plea $% [%live ~] - [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] + [%ripe [pro=%1 hon=@ nok=@] eve=@ mug=@] [%slog pri=@ ?(cord tank)] - [%peek dat=(unit (cask))] + $: %peek + $% [%done dat=(unit (cask))] + [%bail dud=goof] + == == $: %play $% [%done mug=@] [%bail eve=@ mug=@ dud=goof] == == $: %work $% [%done eve=@ mug=@ fec=(list ovum)] - [%swap eve=@ mug=@ job=(pair date ovum) fec=(list ovum)] + [%swap eve=@ mug=@ job=(pair @da ovum) fec=(list ovum)] [%bail lud=(list goof)] == == == @@ -330,6 +333,36 @@ _lord_plea_slog(u3_lord* god_u, u3_noun dat) u3z(dat); } +/* _lord_plea_peek_bail(): hear serf %peek %bail +*/ +static void +_lord_plea_peek_bail(u3_lord* god_u, u3_peek* pek_u, u3_noun dud) +{ + u3_pier_punt_goof("peek", dud); + + u3z(pek_u->now); + u3z(pek_u->gan); + u3z(pek_u->ful); + c3_free(pek_u); + + _lord_bail(god_u); +} + +/* _lord_plea_peek_done(): hear serf %peek %done +*/ +static void +_lord_plea_peek_done(u3_lord* god_u, u3_peek* pek_u, u3_noun rep) +{ + // XX cache [dat] (unless last) + // + pek_u->fun_f(pek_u->vod_p, rep); + + u3z(pek_u->now); + u3z(pek_u->gan); + u3z(pek_u->ful); + c3_free(pek_u); +} + /* _lord_plea_peek(): hear serf %peek response */ static void @@ -342,15 +375,25 @@ _lord_plea_peek(u3_lord* god_u, u3_noun dat) c3_free(wit_u); } - // XX cache [dat] (unless last) - // - pek_u->fun_f(pek_u->vod_p, dat); + if ( c3n == u3a_is_cell(dat) ) { + return _lord_plea_foul(god_u, c3__peek, dat); + } - u3z(pek_u->now); - u3z(pek_u->gan); - u3z(pek_u->ful); - c3_free(pek_u); - // god_u->cb_u.peek_f(god_u->cb_u.vod_p, pek_u, dat); + switch ( u3h(dat) ) { + default: { + return _lord_plea_foul(god_u, c3__peek, dat); + } + + case c3__done: { + _lord_plea_peek_done(god_u, pek_u, u3k(u3t(dat))); + } break; + + case c3__bail: { + _lord_plea_peek_bail(god_u, pek_u, u3k(u3t(dat))); + } break; + } + + u3z(dat); } /* _lord_plea_play_bail(): hear serf %play %bail @@ -671,9 +714,10 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) } break; case u3_writ_peek: { - msg = u3nq(c3__peek, u3k(wit_u->pek_u->now), - u3k(wit_u->pek_u->gan), - u3k(wit_u->pek_u->ful)); + msg = u3nc(c3__peek, u3nq(0, // XX support timeouts + u3k(wit_u->pek_u->now), + u3k(wit_u->pek_u->gan), + u3k(wit_u->pek_u->ful))); } break; case u3_writ_play: { diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index d5da0ad2f..1dcd76319 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -956,6 +956,9 @@ _pier_on_scry_done(void* vod_p, u3_noun nun) u3_noun pad; { + // XX crashes if [pac_c] is not a valid path + // XX virtualize or fix + // u3_noun pax = u3do("stab", u3i_string(pac_c)); c3_w len_w = u3kb_lent(u3k(pax)); pad = u3nt(c3_s4('.','u','r','b'), diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 76825d4ac..e18bae794 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -24,44 +24,42 @@ |% :: +writ: from king to serf :: +:: next steps: +:: - %peek persistent dates (in arvo or serf)? +:: - |mass should be a query of the serf directly +:: - add duct or vane stack for spinner +:: +$ writ $% $: %live $% [%exit cod=@] [%save eve=@] [%pack eve=@] == == - [%peek now=date lyc=gang pat=path] - [%play eve=@ lit=(list ?((pair date ovum) *))] - [%work mil=@ job=(pair date ovum)] + [%peek mil=@ now=@da lyc=gang pat=path] + [%play eve=@ lit=(list ?((pair @da ovum) *))] + [%work mil=@ job=(pair @da ovum)] == :: +plea: from serf to king :: +$ plea $% [%live ~] - [%ripe [pro=@ hon=@ nok=@] eve=@ mug=@] + [%ripe [pro=%1 hon=@ nok=@] eve=@ mug=@] [%slog pri=@ ?(cord tank)] - [%peek dat=(unit (cask))] + $: %peek + $% [%done dat=(unit (cask))] + [%bail dud=goof] + == == $: %play $% [%done mug=@] [%bail eve=@ mug=@ dud=goof] == == $: %work $% [%done eve=@ mug=@ fec=(list ovum)] - [%swap eve=@ mug=@ job=(pair date ovum) fec=(list ovum)] + [%swap eve=@ mug=@ job=(pair @da ovum) fec=(list ovum)] [%bail lud=(list goof)] == == == -- - -questions: - -- %peek - - persistent dates? (in arvo or serf) -- %play - - expect lifecycle on [%ripe ... eve=0 mug=0] - - eve identifies failed event on [%play @ %bail ...] -- %mass is technically a query of the serf directly -- duct or vane stack for spinner */ /* _serf_space(): print n spaces. @@ -791,31 +789,56 @@ u3_serf_play(u3_serf* sef_u, c3_d eve_d, u3_noun lit) /* u3_serf_peek(): dereference namespace. */ u3_noun -u3_serf_peek(u3_serf* sef_u, u3_noun sam) +u3_serf_peek(u3_serf* sef_u, c3_w mil_w, u3_noun sam) { - u3_noun now, lyc, pat, wen, gon, pro; - u3x_trel(sam, &now, &lyc, &pat); + u3_noun wen, pat, gon, pro; - wen = u3A->now; - u3A->now = u3k(now); - - // XX pass lyc as well + // stash the previous date and set current // - gon = u3v_peek(u3k(pat)); - - // XX preserve mark in arvo + // XX incomplete interface, arvo should track the date // - if ( u3_nul == gon ) { - pro = u3_nul; + wen = u3A->now; + + { + u3_noun now, lyc; + u3x_trel(sam, &now, &lyc, &pat); + u3A->now = u3k(now); } + + // XX incomplete interface, should pass [lyc] as well + // + gon = u3m_soft(mil_w, u3v_peek, u3k(pat)); + + // read succeeded, produce result + // + if ( u3_blip == u3h(gon) ) { + if ( u3_nul == gon ) { + pro = u3nc(c3__done, u3_nul); + } + else { + // prepend the %noun mark + // + // XX incomplete interface, should recv mark from arvo + // + pro = u3nq(c3__done, u3_nul, c3__noun, u3k(u3t(gon))); + } + } + // read failed, produce trace + // + // NB, reads should *not* fail deterministically + // else { - pro = u3nt(u3_nul, c3__noun, u3k(u3t(gon))); - u3z(gon); + pro = u3nc(c3__bail, u3k(gon)); } + // restore the previous date + // + // XX incomplete interface, arvo should track the date + // u3z(u3A->now); u3A->now = wen; + u3z(gon); u3z(sam); return u3nc(c3__peek, pro); } @@ -1007,8 +1030,18 @@ u3_serf_writ(u3_serf* sef_u, u3_noun wit, u3_noun* pel) } break; case c3__peek: { - *pel = u3_serf_peek(sef_u, u3k(com)); - ret_o = c3y; + u3_noun tim, sam; + c3_w mil_w; + + if ( (c3n == u3r_cell(com, &tim, &sam)) || + (c3n == u3r_safe_word(tim, &mil_w)) ) + { + ret_o = c3n; + } + else { + *pel = u3_serf_peek(sef_u, mil_w, u3k(sam)); + ret_o = c3y; + } } break; case c3__play: { @@ -1028,7 +1061,7 @@ u3_serf_writ(u3_serf* sef_u, u3_noun wit, u3_noun* pel) } break; case c3__work: { - u3_noun job, tim; + u3_noun tim, job; c3_w mil_w; if ( (c3n == u3r_cell(com, &tim, &job)) || From b3cb7453cc29134fa3648b7af23da9036a834514 Mon Sep 17 00:00:00 2001 From: Fang Date: Wed, 24 Jun 2020 23:33:22 +0200 Subject: [PATCH 224/257] vere: rename behn.c's alm -> alm_o To adhere to the naming conventions. --- pkg/urbit/vere/io/behn.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index 3d09f2ef1..df5f4ad42 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -16,7 +16,7 @@ typedef struct _u3_behn { u3_auto car_u; // driver uv_timer_t tim_u; // behn timer - c3_o alm; // alarm + c3_o alm_o; // alarm } u3_behn; /* _behn_time_cb(): timer callback. @@ -25,7 +25,7 @@ static void _behn_time_cb(uv_timer_t* tim_u) { u3_behn* teh_u = tim_u->data; - teh_u->alm = c3n; + teh_u->alm_o = c3n; // start another timer for 10 minutes // @@ -36,7 +36,7 @@ _behn_time_cb(uv_timer_t* tim_u) // { c3_d gap_d = 10 * 60 * 1000; - teh_u->alm = c3y; + teh_u->alm_o = c3y; uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); } @@ -59,9 +59,9 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) teh_u->car_u.liv_o = c3y; } - if ( c3y == teh_u->alm ) { + if ( c3y == teh_u->alm_o ) { uv_timer_stop(&teh_u->tim_u); - teh_u->alm = c3n; + teh_u->alm_o = c3n; } if ( (u3_nul != wen) && @@ -74,7 +74,7 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) u3_noun now = u3_time_in_tv(&tim_tv); c3_d gap_d = u3_time_gap_ms(now, u3k(u3t(wen))); - teh_u->alm = c3y; + teh_u->alm_o = c3y; uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); } @@ -143,7 +143,7 @@ u3_auto* u3_behn_io_init(u3_pier* pir_u) { u3_behn* teh_u = c3_calloc(sizeof(*teh_u)); - teh_u->alm = c3n; + teh_u->alm_o = c3n; uv_timer_init(u3L, &teh_u->tim_u); teh_u->tim_u.data = teh_u; From 7c245aa85ce0612e6da889b3e4954dba65a6acd8 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 27 Jun 2020 00:49:43 -0700 Subject: [PATCH 225/257] vere: retry %behn %born event failures --- pkg/urbit/vere/io/behn.c | 63 +++++++++++++++++++++++++++++++++++----- 1 file changed, 56 insertions(+), 7 deletions(-) diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index df5f4ad42..4885c1c3b 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -17,6 +17,7 @@ u3_auto car_u; // driver uv_timer_t tim_u; // behn timer c3_o alm_o; // alarm + c3_w bon_w; // %born retry count } u3_behn; /* _behn_time_cb(): timer callback. @@ -81,6 +82,56 @@ _behn_ef_doze(u3_behn* teh_u, u3_noun wen) u3z(wen); } +/* _behn_born_news(): initialization complete on %born. +*/ +static void +_behn_born_news(u3_ovum* egg_u, u3_ovum_news new_e) +{ + u3_auto* car_u = egg_u->car_u; + + if ( u3_ovum_done == new_e ) { + car_u->liv_o = c3y; + } +} + +static void +_behn_io_talk(u3_auto* car_u); + +/* _behn_born_bail(): %born is essential, retry failures. +*/ +static void +_behn_born_bail(u3_ovum* egg_u, u3_noun lud) +{ + u3_auto* car_u = egg_u->car_u; + u3_behn* teh_u = (u3_behn*)car_u; + + if ( teh_u->bon_w == 2 ) { + u3l_log("behn: initialization failed\n"); + + if ( 2 == u3qb_lent(lud) ) { + u3_pier_punt_goof("born", u3k(u3h(lud))); + u3_pier_punt_goof("crud", u3k(u3h(u3t(lud)))); + } + else { + u3_noun dul = lud; + c3_w len_w = 1; + + while ( u3_nul != dul ) { + u3l_log("behn: bail %u\r\n", len_w++); + u3_pier_punt_goof("behn", u3k(u3h(dul))); + dul = u3t(dul); + } + } + + u3_pier_bail(car_u->pir_u); + } + else { + _behn_io_talk(car_u); + teh_u->bon_w++; + } + + u3z(lud); +} /* _behn_io_talk(): notify %behn that we're live */ static void @@ -91,7 +142,10 @@ _behn_io_talk(u3_auto* car_u) u3_noun wir = u3nt(c3__behn, u3k(u3A->sen), u3_nul); u3_noun cad = u3nc(c3__born, u3_nul); - u3_auto_plan(car_u, 0, c3__b, wir, cad); + u3_auto_peer( + u3_auto_plan(car_u, 0, c3__b, wir, cad), + _behn_born_news, + _behn_born_bail); } /* _behn_io_kick(): apply effects. @@ -151,15 +205,10 @@ u3_behn_io_init(u3_pier* pir_u) u3_auto* car_u = &teh_u->car_u; car_u->nam_m = c3__behn; - // XX set in done_cb for %born - // - car_u->liv_o = c3y; + car_u->liv_o = c3n; car_u->io.talk_f = _behn_io_talk; car_u->io.kick_f = _behn_io_kick; car_u->io.exit_f = _behn_io_exit; - // XX retry up to N? - // - // car_u->ev.bail_f = ...; return car_u; } From b4ff9888b5ac5b6fc7c80efd87d7078d07b70822 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 27 Jun 2020 00:50:11 -0700 Subject: [PATCH 226/257] vere: refactors %ames packet failure callback --- pkg/urbit/vere/io/ames.c | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c index d2b632860..45c8689cc 100644 --- a/pkg/urbit/vere/io/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -392,13 +392,12 @@ _ames_cap_queue(u3_ames* sam_u) static void _ames_punt_goof(u3_noun lud) { - u3_noun dul = lud; - - if ( 2 == u3qb_lent(dul) ) { - u3_pier_punt_goof("hear", u3k(u3h(dul))); - u3_pier_punt_goof("crud", u3k(u3h(u3t(dul)))); + if ( 2 == u3qb_lent(lud) ) { + u3_pier_punt_goof("hear", u3k(u3h(lud))); + u3_pier_punt_goof("crud", u3k(u3h(u3t(lud)))); } else { + u3_noun dul = lud; c3_w len_w = 1; while ( u3_nul != dul ) { From 3965b261d1f945741a18d2628c4199a6e6013847 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 27 Jun 2020 00:59:31 -0700 Subject: [PATCH 227/257] vere: refactors ovum scheduling api --- pkg/urbit/include/vere/vere.h | 6 +----- pkg/urbit/vere/auto.c | 8 +------- pkg/urbit/vere/io/ames.c | 5 +++-- pkg/urbit/vere/io/behn.c | 4 ++-- pkg/urbit/vere/io/cttp.c | 4 ++-- pkg/urbit/vere/io/fore.c | 6 +++--- pkg/urbit/vere/io/hind.c | 2 +- pkg/urbit/vere/io/http.c | 8 ++++---- pkg/urbit/vere/io/term.c | 2 +- pkg/urbit/vere/io/unix.c | 4 ++-- 10 files changed, 20 insertions(+), 29 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 38e3d4aba..f3e12e865 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -842,11 +842,7 @@ /* u3_auto_plan(): create and enqueue an ovum. */ u3_ovum* - u3_auto_plan(u3_auto* car_u, - c3_w mil_w, - u3_noun tar, - u3_noun wir, - u3_noun cad); + u3_auto_plan(u3_auto* car_u, u3_ovum* egg_u); /* u3_auto_peer(): subscribe to updates. */ diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index d163d576f..9fedc7017 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -22,14 +22,8 @@ /* u3_auto_plan(): create and enqueue an ovum. */ u3_ovum* -u3_auto_plan(u3_auto* car_u, - c3_w mil_w, - u3_noun tar, - u3_noun wir, - u3_noun cad) +u3_auto_plan(u3_auto* car_u, u3_ovum *egg_u) { - u3_ovum *egg_u = u3_ovum_init(mil_w, tar, wir, cad); - egg_u->car_u = car_u; // [pre_u] points towards [ext_u] (back in time) diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c index 45c8689cc..be2c970a2 100644 --- a/pkg/urbit/vere/io/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -471,7 +471,8 @@ _ames_recv_cb(uv_udp_t* wax_u, } u3_auto_peer( - u3_auto_plan(&sam_u->car_u, 0, c3__a, wir, cad), + u3_auto_plan(&sam_u->car_u, + u3_ovum_init(0, c3__a, wir, cad)), 0, _ames_hear_bail); _ames_cap_queue(sam_u); @@ -596,7 +597,7 @@ _ames_io_talk(u3_auto* car_u) u3_noun wir = u3nt(c3__newt, u3k(u3A->sen), u3_nul); u3_noun cad = u3nc(c3__born, u3_nul); - u3_auto_plan(car_u, 0, c3__a, wir, cad); + u3_auto_plan(car_u, u3_ovum_init(0, c3__a, wir, cad)); } } diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index 4885c1c3b..5fa639da2 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -47,7 +47,7 @@ _behn_time_cb(uv_timer_t* tim_u) u3_noun wir = u3nc(c3__behn, u3_nul); u3_noun cad = u3nc(c3__wake, u3_nul); - u3_auto_plan(&teh_u->car_u, 0, c3__b, wir, cad); + u3_auto_plan(&teh_u->car_u, u3_ovum_init(0, c3__b, wir, cad)); } } @@ -143,7 +143,7 @@ _behn_io_talk(u3_auto* car_u) u3_noun cad = u3nc(c3__born, u3_nul); u3_auto_peer( - u3_auto_plan(car_u, 0, c3__b, wir, cad), + u3_auto_plan(car_u, u3_ovum_init(0, c3__b, wir, cad)), _behn_born_news, _behn_born_bail); } diff --git a/pkg/urbit/vere/io/cttp.c b/pkg/urbit/vere/io/cttp.c index 81ad44384..691278b3a 100644 --- a/pkg/urbit/vere/io/cttp.c +++ b/pkg/urbit/vere/io/cttp.c @@ -721,7 +721,7 @@ _cttp_http_client_receive(u3_creq* ceq_u, c3_w sas_w, u3_noun mes, u3_noun uct) ceq_u->num_l, u3nq(u3i_string("start"), u3nc(sas_w, mes), uct, c3y)); - u3_auto_plan(&ceq_u->ctp_u->car_u, 0, c3__i, wir, cad); + u3_auto_plan(&ceq_u->ctp_u->car_u, u3_ovum_init(0, c3__i, wir, cad)); } /* _cttp_creq_fail(): dispatch error response @@ -1020,7 +1020,7 @@ _cttp_io_talk(u3_auto* car_u) u3_noun wir = u3nt(u3i_string("http-client"), u3k(u3A->sen), u3_nul); u3_noun cad = u3nc(c3__born, u3_nul); - u3_auto_plan(car_u, 0, c3__i, wir, cad); + u3_auto_plan(car_u, u3_ovum_init(0, c3__i, wir, cad)); } /* _cttp_io_kick(): apply effects diff --git a/pkg/urbit/vere/io/fore.c b/pkg/urbit/vere/io/fore.c index 32b5436e4..4691e8a6e 100644 --- a/pkg/urbit/vere/io/fore.c +++ b/pkg/urbit/vere/io/fore.c @@ -60,7 +60,7 @@ _fore_inject(u3_auto* car_u, c3_c* pax_c) } u3_auto_peer( - u3_auto_plan(car_u, 0, u3k(tar), u3k(wir), u3k(cad)), + u3_auto_plan(car_u, u3_ovum_init(0, u3k(tar), u3k(wir), u3k(cad))), 0, _fore_inject_bail); } @@ -83,7 +83,7 @@ _fore_io_talk(u3_auto* car_u) wir = u3nc(c3__arvo, u3_nul); cad = u3nc(c3__wack, u3i_words(16, eny_w)); - u3_auto_plan(car_u, 0, u3_blip, wir, cad); + u3_auto_plan(car_u, u3_ovum_init(0, u3_blip, wir, cad)); } // set verbose as per -v @@ -96,7 +96,7 @@ _fore_io_talk(u3_auto* car_u) wir = u3nt(c3__term, '1', u3_nul); cad = u3nc(c3__verb, u3_nul); - u3_auto_plan(car_u, 0, u3_blip, wir, cad); + u3_auto_plan(car_u, u3_ovum_init(0, u3_blip, wir, cad)); } // inject arbitrary diff --git a/pkg/urbit/vere/io/hind.c b/pkg/urbit/vere/io/hind.c index 082a718ee..be83a9f66 100644 --- a/pkg/urbit/vere/io/hind.c +++ b/pkg/urbit/vere/io/hind.c @@ -45,7 +45,7 @@ _hind_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) // case c3__trim: { ret_o = c3y; - u3_auto_plan(car_u, 0, u3_blip, u3k(wir), u3k(cad)); + u3_auto_plan(car_u, u3_ovum_init(0, u3_blip, u3k(wir), u3k(cad))); } case c3__vega: { diff --git a/pkg/urbit/vere/io/http.c b/pkg/urbit/vere/io/http.c index f74da5a96..42c2d9b8a 100644 --- a/pkg/urbit/vere/io/http.c +++ b/pkg/urbit/vere/io/http.c @@ -382,7 +382,7 @@ _http_req_kill(u3_hreq* req_u) u3_noun wir = _http_req_to_duct(req_u); u3_noun cad = u3nc(u3i_string("cancel-request"), u3_nul); - u3_auto_plan(&htd_u->car_u, 0, c3__e, wir, cad); + u3_auto_plan(&htd_u->car_u, u3_ovum_init(0, c3__e, wir, cad)); } typedef struct _u3_hgen { @@ -475,7 +475,7 @@ _http_req_dispatch(u3_hreq* req_u, u3_noun req) : u3nc(u3i_string("request"), dat); } - u3_auto_plan(&htd_u->car_u, 0, c3__e, wir, cad); + u3_auto_plan(&htd_u->car_u, u3_ovum_init(0, c3__e, wir, cad)); } } @@ -1556,7 +1556,7 @@ _http_serv_start_all(u3_httd* htd_u) u3_noun wir = u3nt(u3i_string("http-server"), u3k(u3A->sen), u3_nul); u3_noun cad = u3nt(c3__live, non, sec); - u3_auto_plan(&htd_u->car_u, 0, c3__e, wir, cad); + u3_auto_plan(&htd_u->car_u, u3_ovum_init(0, c3__e, wir, cad)); } _http_write_ports_file(htd_u, u3_Host.dir_c); @@ -1668,7 +1668,7 @@ _http_io_talk(u3_auto* car_u) u3_noun wir = u3nt(u3i_string("http-server"), u3k(u3A->sen), u3_nul); u3_noun cad = u3nc(c3__born, u3_nul); - u3_auto_plan(car_u, 0, c3__e, wir, cad); + u3_auto_plan(car_u, u3_ovum_init(0, c3__e, wir, cad)); // XX set liv_o on done/swap? // diff --git a/pkg/urbit/vere/io/term.c b/pkg/urbit/vere/io/term.c index c21f5f5b8..3eb24050c 100644 --- a/pkg/urbit/vere/io/term.c +++ b/pkg/urbit/vere/io/term.c @@ -607,7 +607,7 @@ _term_it_save(u3_noun pax, u3_noun pad) static u3_ovum* _term_ovum_plan(u3_auto* car_u, u3_noun wir, u3_noun cad) { - u3_ovum* egg_u = u3_auto_plan(car_u, 0, c3__d, wir, cad); + u3_ovum* egg_u = u3_auto_plan(car_u, u3_ovum_init(0, c3__d, wir, cad)); // term events have no spinner label // diff --git a/pkg/urbit/vere/io/unix.c b/pkg/urbit/vere/io/unix.c index 77d3d9f0e..9376d4671 100644 --- a/pkg/urbit/vere/io/unix.c +++ b/pkg/urbit/vere/io/unix.c @@ -959,7 +959,7 @@ _unix_update_mount(u3_unix* unx_u, u3_umon* mon_u, u3_noun all) u3_noun wir = u3nt(c3__sync, u3k(u3A->sen), u3_nul); u3_noun cad = u3nq(c3__into, u3i_string(mon_u->nam_c), all, can); - u3_auto_plan(&unx_u->car_u, 0, c3__c, wir, cad); + u3_auto_plan(&unx_u->car_u, u3_ovum_init(0, c3__c, wir, cad)); } } } @@ -1377,7 +1377,7 @@ _unix_io_talk(u3_auto* car_u) u3_noun wir = u3nc(c3__boat, u3_nul); u3_noun cad = u3nc(c3__boat, u3_nul); - u3_auto_plan(car_u, 0, c3__c, wir, cad); + u3_auto_plan(car_u, u3_ovum_init(0, c3__c, wir, cad)); } /* _unix_io_kick(): apply effects. From b6a0487d7a0660a2cf6e6f8ebb545f794a31c9c1 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 27 Jun 2020 01:04:03 -0700 Subject: [PATCH 228/257] vere: corrects all uses of [vod_p] to [ptr_v] --- pkg/urbit/include/vere/db/lmdb.h | 4 +- pkg/urbit/include/vere/vere.h | 18 +++---- pkg/urbit/vere/db/lmdb.c | 14 ++--- pkg/urbit/vere/disk.c | 18 +++---- pkg/urbit/vere/lord.c | 44 +++++++-------- pkg/urbit/vere/pier.c | 92 ++++++++++++++++---------------- pkg/urbit/vere/ward.c | 2 +- 7 files changed, 96 insertions(+), 96 deletions(-) diff --git a/pkg/urbit/include/vere/db/lmdb.h b/pkg/urbit/include/vere/db/lmdb.h index cedec4185..53453419d 100644 --- a/pkg/urbit/include/vere/db/lmdb.h +++ b/pkg/urbit/include/vere/db/lmdb.h @@ -25,7 +25,7 @@ */ c3_o u3_lmdb_read(MDB_env* env_u, - void* vod_p, + void* ptr_v, c3_d eve_d, c3_d len_d, c3_o (*read_f)(void*, c3_d, size_t , void*)); @@ -43,7 +43,7 @@ */ void u3_lmdb_read_meta(MDB_env* env_u, - void* vod_p, + void* ptr_v, const c3_c* key_c, void (*read_f)(void*, size_t, void*)); diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index f3e12e865..8f2d5ae5b 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -333,7 +333,7 @@ /* u3_ovum: potential event */ typedef struct _u3_ovum { - void* vod_p; // context + void* ptr_v; // context c3_w mil_w; // timeout ms u3_noun tar; // target (in arvo) u3_noun wir; // wire @@ -383,7 +383,7 @@ /* u3_peek: namespace read request */ typedef struct _u3_peek { - void* vod_p; // context + void* ptr_v; // context u3_peek_cb fun_f; // callback u3_noun now; // XX u3_noun gan; // leakset @@ -422,7 +422,7 @@ /* u3_lord_cb: u3_lord callbacks */ typedef struct _u3_lord_cb { - void* vod_p; + void* ptr_v; void (*live_f)(void*); void (*slog_f)(void*, c3_w, u3_noun); void (*spin_f)(void*, u3_atom, c3_o); @@ -481,7 +481,7 @@ /* u3_disk_cb: u3_disk callbacks */ typedef struct _u3_disk_cb { - void* vod_p; + void* ptr_v; void (*read_done_f)(void*, u3_info); void (*read_bail_f)(void*, c3_d eve_d); void (*write_done_f)(void*, c3_d eve_d); @@ -562,7 +562,7 @@ /* u3_wall: pier barrier */ typedef struct _u3_wall { - void* vod_p; + void* ptr_v; c3_d eve_d; void (*wal_f)(void*, c3_d); struct _u3_wall* nex_u; @@ -956,7 +956,7 @@ u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun ful, - void* vod_p, + void* ptr_v, u3_peek_cb fun_f); /* u3_lord_peek_mine(): read namespace, injecting ship. @@ -966,7 +966,7 @@ u3_noun gan, c3_m car_m, u3_noun pax, - void* vod_p, + void* ptr_v, u3_peek_cb fun_f); /* u3_lord_peek_last(): read namespace, injecting ship and case. @@ -977,7 +977,7 @@ c3_m car_m, u3_atom des, u3_noun pax, - void* vod_p, + void* ptr_v, u3_peek_cb fun_f); /** Filesystem (new api). @@ -1356,7 +1356,7 @@ /* u3_king_grab(): gc the daemon */ void - u3_king_grab(void* vod_p); + u3_king_grab(void* ptr_v); c3_w diff --git a/pkg/urbit/vere/db/lmdb.c b/pkg/urbit/vere/db/lmdb.c index 7b9164826..ef77ba01f 100644 --- a/pkg/urbit/vere/db/lmdb.c +++ b/pkg/urbit/vere/db/lmdb.c @@ -179,7 +179,7 @@ u3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d) */ c3_o u3_lmdb_read(MDB_env* env_u, - void* vod_p, + void* ptr_v, c3_d eve_d, c3_d len_d, c3_o (*read_f)(void*, c3_d, size_t, void*)) @@ -268,7 +268,7 @@ u3_lmdb_read(MDB_env* env_u, // invoke read callback with [val_u] // - if ( c3n == read_f(vod_p, cur_d, val_u.mv_size, val_u.mv_data) ) { + if ( c3n == read_f(ptr_v, cur_d, val_u.mv_size, val_u.mv_data) ) { ret_o = c3n; break; } @@ -365,7 +365,7 @@ u3_lmdb_save(MDB_env* env_u, */ void u3_lmdb_read_meta(MDB_env* env_u, - void* vod_p, + void* ptr_v, const c3_c* key_c, void (*read_f)(void*, size_t, void*)) { @@ -378,7 +378,7 @@ u3_lmdb_read_meta(MDB_env* env_u, if ( (ret_w = mdb_txn_begin(env_u, 0, MDB_RDONLY, &txn_u)) ) { fprintf(stderr, "lmdb: meta read: txn_begin fail: %s\n", mdb_strerror(ret_w)); - return read_f(vod_p, 0, 0); + return read_f(ptr_v, 0, 0); } // open the database in the transaction @@ -387,7 +387,7 @@ u3_lmdb_read_meta(MDB_env* env_u, fprintf(stderr, "lmdb: meta read: dbi_open fail: %s\n", mdb_strerror(ret_w)); mdb_txn_abort(txn_u); - return read_f(vod_p, 0, 0); + return read_f(ptr_v, 0, 0); } // read by string key, invoking callback with result @@ -398,10 +398,10 @@ u3_lmdb_read_meta(MDB_env* env_u, if ( (ret_w = mdb_get(txn_u, mdb_u, &key_u, &val_u)) ) { fprintf(stderr, "lmdb: read failed: %s\n", mdb_strerror(ret_w)); mdb_txn_abort(txn_u); - return read_f(vod_p, 0, 0); + return read_f(ptr_v, 0, 0); } else { - read_f(vod_p, val_u.mv_size, val_u.mv_data); + read_f(ptr_v, val_u.mv_size, val_u.mv_data); // read-only transactions are aborted when complete // diff --git a/pkg/urbit/vere/disk.c b/pkg/urbit/vere/disk.c index 0463698dd..feea9697f 100644 --- a/pkg/urbit/vere/disk.c +++ b/pkg/urbit/vere/disk.c @@ -68,7 +68,7 @@ _disk_commit_done(struct _cd_save* req_u) c3_o ret_o = req_u->ret_o; if ( c3n == ret_o ) { - log_u->cb_u.write_bail_f(log_u->cb_u.vod_p, eve_d + (len_d - 1ULL)); + log_u->cb_u.write_bail_f(log_u->cb_u.ptr_v, eve_d + (len_d - 1ULL)); #ifdef VERBOSE_DISK if ( 1ULL == len_d ) { @@ -83,7 +83,7 @@ _disk_commit_done(struct _cd_save* req_u) } else { log_u->dun_d = eve_d + (len_d - 1ULL); - log_u->cb_u.write_done_f(log_u->cb_u.vod_p, log_u->dun_d); + log_u->cb_u.write_done_f(log_u->cb_u.ptr_v, log_u->dun_d); #ifdef VERBOSE_DISK if ( 1ULL == len_d ) { @@ -354,16 +354,16 @@ _disk_read_done_cb(uv_timer_t* tim_u) red_u->ent_u = 0; red_u->ext_u = 0; - log_u->cb_u.read_done_f(log_u->cb_u.vod_p, pay_u); + log_u->cb_u.read_done_f(log_u->cb_u.ptr_v, pay_u); _disk_read_close(red_u); } /* _disk_read_one_cb(): lmdb read callback, invoked for each event in order */ static c3_o -_disk_read_one_cb(void* vod_p, c3_d eve_d, size_t val_i, void* val_p) +_disk_read_one_cb(void* ptr_v, c3_d eve_d, size_t val_i, void* val_p) { - u3_read* red_u = vod_p; + u3_read* red_u = ptr_v; u3_disk* log_u = red_u->log_u; u3_fact* tac_u; @@ -425,7 +425,7 @@ _disk_read_start_cb(uv_timer_t* tim_u) red_u->len_d, _disk_read_one_cb) ) { - log_u->cb_u.read_bail_f(log_u->cb_u.vod_p, red_u->eve_d); + log_u->cb_u.read_bail_f(log_u->cb_u.ptr_v, red_u->eve_d); _disk_read_close(red_u); } // finish the read asynchronously @@ -501,12 +501,12 @@ u3_disk_save_meta(u3_disk* log_u, return c3y; } -/* _disk_meta_read_cb(): copy [val_p] to atom [vod_p] if present. +/* _disk_meta_read_cb(): copy [val_p] to atom [ptr_v] if present. */ static void -_disk_meta_read_cb(void* vod_p, size_t val_i, void* val_p) +_disk_meta_read_cb(void* ptr_v, size_t val_i, void* val_p) { - u3_weak* mat = vod_p; + u3_weak* mat = ptr_v; if ( val_p ) { *mat = u3i_bytes(val_i, val_p); diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 5f0ae2a80..ac1be4b8a 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -65,7 +65,7 @@ _lord_stop_cb(void* ptr_v, u3_lord* god_u = ptr_v; void (*exit_f)(void*) = god_u->cb_u.exit_f; - void* exit_v = god_u->cb_u.vod_p; + void* exit_v = god_u->cb_u.ptr_v; c3_free(god_u); @@ -156,7 +156,7 @@ static void _lord_bail(u3_lord* god_u) { void (*bail_f)(void*) = god_u->cb_u.bail_f; - void* bail_v = god_u->cb_u.vod_p; + void* bail_v = god_u->cb_u.ptr_v; u3_lord_halt(god_u); bail_f(bail_v); @@ -255,11 +255,11 @@ _lord_plea_live(u3_lord* god_u, u3_noun dat) } break; case u3_writ_save: { - god_u->cb_u.save_f(god_u->cb_u.vod_p); + god_u->cb_u.save_f(god_u->cb_u.ptr_v); } break; case u3_writ_pack: { - god_u->cb_u.pack_f(god_u->cb_u.vod_p); + god_u->cb_u.pack_f(god_u->cb_u.ptr_v); } break; } @@ -307,7 +307,7 @@ _lord_plea_ripe(u3_lord* god_u, u3_noun dat) } god_u->liv_o = c3y; - god_u->cb_u.live_f(god_u->cb_u.vod_p); + god_u->cb_u.live_f(god_u->cb_u.ptr_v); u3z(dat); } @@ -329,7 +329,7 @@ _lord_plea_slog(u3_lord* god_u, u3_noun dat) // XX per-writ slog_f? // - god_u->cb_u.slog_f(god_u->cb_u.vod_p, pri_w, u3k(tan)); + god_u->cb_u.slog_f(god_u->cb_u.ptr_v, pri_w, u3k(tan)); u3z(dat); } @@ -355,7 +355,7 @@ _lord_plea_peek_done(u3_lord* god_u, u3_peek* pek_u, u3_noun rep) { // XX cache [dat] (unless last) // - pek_u->fun_f(pek_u->vod_p, rep); + pek_u->fun_f(pek_u->ptr_v, rep); u3z(pek_u->now); u3z(pek_u->gan); @@ -417,7 +417,7 @@ _lord_plea_play_bail(u3_lord* god_u, u3_info fon_u, u3_noun dat) god_u->eve_d = (eve_d - 1ULL); god_u->mug_l = mug_l; - god_u->cb_u.play_bail_f(god_u->cb_u.vod_p, + god_u->cb_u.play_bail_f(god_u->cb_u.ptr_v, fon_u, mug_l, eve_d, u3k(dud)); u3z(dat); @@ -437,7 +437,7 @@ _lord_plea_play_done(u3_lord* god_u, u3_info fon_u, u3_noun dat) god_u->eve_d = fon_u.ent_u->eve_d; god_u->mug_l = mug_l; - god_u->cb_u.play_done_f(god_u->cb_u.vod_p, fon_u, mug_l); + god_u->cb_u.play_done_f(god_u->cb_u.ptr_v, fon_u, mug_l); u3z(dat); } @@ -485,7 +485,7 @@ _lord_work_spin(u3_lord* god_u) // complete spinner // c3_assert( c3y == god_u->pin_o ); - god_u->cb_u.spun_f(god_u->cb_u.vod_p); + god_u->cb_u.spun_f(god_u->cb_u.ptr_v); god_u->pin_o = c3n; // restart spinner if more work @@ -497,7 +497,7 @@ _lord_work_spin(u3_lord* god_u) else { u3_ovum* egg_u = wit_u->wok_u.egg_u; - god_u->cb_u.spin_f(god_u->cb_u.vod_p, + god_u->cb_u.spin_f(god_u->cb_u.ptr_v, egg_u->pin_u.lab, egg_u->pin_u.del_o); god_u->pin_o = c3y; @@ -526,7 +526,7 @@ _lord_work_done(u3_lord* god_u, _lord_work_spin(god_u); - god_u->cb_u.work_done_f(god_u->cb_u.vod_p, egg_u, tac_u, gif_u); + god_u->cb_u.work_done_f(god_u->cb_u.ptr_v, egg_u, tac_u, gif_u); } @@ -537,7 +537,7 @@ _lord_plea_work_bail(u3_lord* god_u, u3_ovum* egg_u, u3_noun lud) { _lord_work_spin(god_u); - god_u->cb_u.work_bail_f(god_u->cb_u.vod_p, egg_u, lud); + god_u->cb_u.work_bail_f(god_u->cb_u.ptr_v, egg_u, lud); } /* _lord_plea_work_swap(): hear serf %work %swap @@ -796,13 +796,13 @@ void u3_lord_peek(u3_lord* god_u, u3_noun gan, u3_noun ful, - void* vod_p, + void* ptr_v, u3_peek_cb fun_f) { u3_writ* wit_u = _lord_writ_new(god_u); wit_u->typ_e = u3_writ_peek; wit_u->pek_u = c3_calloc(sizeof(*wit_u->pek_u)); - wit_u->pek_u->vod_p = vod_p; + wit_u->pek_u->ptr_v = ptr_v; wit_u->pek_u->fun_f = fun_f; wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_u); wit_u->pek_u->gan = gan; @@ -821,13 +821,13 @@ u3_lord_peek_mine(u3_lord* god_u, u3_noun gan, c3_m car_m, u3_noun pax, - void* vod_p, + void* ptr_v, u3_peek_cb fun_f) { u3_writ* wit_u = _lord_writ_new(god_u); wit_u->typ_e = u3_writ_peek; wit_u->pek_u = c3_calloc(sizeof(*wit_u->pek_u)); - wit_u->pek_u->vod_p = vod_p; + wit_u->pek_u->ptr_v = ptr_v; wit_u->pek_u->fun_f = fun_f; wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_u); wit_u->pek_u->gan = gan; @@ -835,7 +835,7 @@ u3_lord_peek_mine(u3_lord* god_u, { // XX cache // - u3_pier* pir_u = god_u->cb_u.vod_p; // XX do better + u3_pier* pir_u = god_u->cb_u.ptr_v; // XX do better u3_noun our = u3dc("scot", 'p', u3i_chubs(2, pir_u->who_d)); wit_u->pek_u->ful = u3nt(car_m, our, pax); } @@ -854,13 +854,13 @@ u3_lord_peek_last(u3_lord* god_u, c3_m car_m, u3_atom des, u3_noun pax, - void* vod_p, + void* ptr_v, u3_peek_cb fun_f) { u3_writ* wit_u = _lord_writ_new(god_u); wit_u->typ_e = u3_writ_peek; wit_u->pek_u = c3_calloc(sizeof(*wit_u->pek_u)); - wit_u->pek_u->vod_p = vod_p; + wit_u->pek_u->ptr_v = ptr_v; wit_u->pek_u->fun_f = fun_f; wit_u->pek_u->now = u3_time_in_tv(&wit_u->tim_u); wit_u->pek_u->gan = gan; @@ -868,7 +868,7 @@ u3_lord_peek_last(u3_lord* god_u, { // XX cache // - u3_pier* pir_u = god_u->cb_u.vod_p; // XX do better + u3_pier* pir_u = god_u->cb_u.ptr_v; // XX do better u3_noun our = u3dc("scot", 'p', u3i_chubs(2, pir_u->who_d)); u3_noun cas = u3dc("scot", c3__da, u3k(wit_u->pek_u->now)); @@ -913,7 +913,7 @@ u3_lord_work(u3_lord* god_u, u3_ovum* egg_u, u3_noun ovo) // if not spinning, start // if ( c3n == god_u->pin_o ) { - god_u->cb_u.spin_f(god_u->cb_u.vod_p, + god_u->cb_u.spin_f(god_u->cb_u.ptr_v, egg_u->pin_u.lab, egg_u->pin_u.del_o); god_u->pin_o = c3y; diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index 1dcd76319..ec7668990 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -141,12 +141,12 @@ _pier_gift_kick(u3_work* wok_u) */ static void _pier_wall_plan(u3_pier* pir_u, c3_d eve_d, - void* vod_p, void (*wal_f)(void*, c3_d)) + void* ptr_v, void (*wal_f)(void*, c3_d)) { c3_assert( u3_psat_work == pir_u->sat_e ); u3_wall* wal_u = c3_malloc(sizeof(*wal_u)); - wal_u->vod_p = vod_p; + wal_u->ptr_v = ptr_v; wal_u->eve_d = eve_d; wal_u->wal_f = wal_f; @@ -180,7 +180,7 @@ _pier_wall(u3_work* wok_u) && (wal_u->eve_d <= god_u->eve_d) ) { wok_u->wal_u = wal_u->nex_u; - wal_u->wal_f(wal_u->vod_p, god_u->eve_d); + wal_u->wal_f(wal_u->ptr_v, god_u->eve_d); c3_free(wal_u); } } @@ -226,9 +226,9 @@ _pier_work(u3_work* wok_u) /* _pier_on_lord_work_spin(): start spinner */ static void -_pier_on_lord_work_spin(void* vod_p, u3_atom pin, c3_o del_o) +_pier_on_lord_work_spin(void* ptr_v, u3_atom pin, c3_o del_o) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; c3_assert( (u3_psat_work == pir_u->sat_e) || (u3_psat_done == pir_u->sat_e) ); @@ -239,9 +239,9 @@ _pier_on_lord_work_spin(void* vod_p, u3_atom pin, c3_o del_o) /* _pier_on_lord_work_spin(): stop spinner */ static void -_pier_on_lord_work_spun(void* vod_p) +_pier_on_lord_work_spun(void* ptr_v) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; c3_assert( (u3_psat_work == pir_u->sat_e) || (u3_psat_done == pir_u->sat_e) ); @@ -252,12 +252,12 @@ _pier_on_lord_work_spun(void* vod_p) /* _pier_on_lord_work_done(): event completion from worker. */ static void -_pier_on_lord_work_done(void* vod_p, +_pier_on_lord_work_done(void* ptr_v, u3_ovum* egg_u, u3_fact* tac_u, u3_gift* gif_u) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; c3_assert( (u3_psat_work == pir_u->sat_e) || (u3_psat_done == pir_u->sat_e) ); @@ -279,9 +279,9 @@ _pier_on_lord_work_done(void* vod_p, /* _pier_on_lord_work_bail(): event failure from worker. */ static void -_pier_on_lord_work_bail(void* vod_p, u3_ovum* egg_u, u3_noun lud) +_pier_on_lord_work_bail(void* ptr_v, u3_ovum* egg_u, u3_noun lud) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; #ifdef VERBOSE_PIER fprintf(stderr, "pier: work: bail\r\n"); @@ -413,7 +413,7 @@ _pier_work_init(u3_pier* pir_u) // // setup u3_lord work callbacks // // // u3_lord_work_cb cb_u = { - // .vod_p = wok_u, + // .ptr_v = wok_u, // .spin_f = _pier_on_lord_work_spin, // .spun_f = _pier_on_lord_work_spun, // .done_f = _pier_on_lord_work_done, @@ -614,9 +614,9 @@ _pier_play(u3_play* pay_u) /* _pier_on_lord_play_done(): log replay batch completion from worker. */ static void -_pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) +_pier_on_lord_play_done(void* ptr_v, u3_info fon_u, c3_l mug_l) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; u3_fact* tac_u = fon_u.ent_u; u3_fact* nex_u; @@ -652,10 +652,10 @@ _pier_on_lord_play_done(void* vod_p, u3_info fon_u, c3_l mug_l) /* _pier_on_lord_play_bail(): log replay batch failure from worker. */ static void -_pier_on_lord_play_bail(void* vod_p, u3_info fon_u, +_pier_on_lord_play_bail(void* ptr_v, u3_info fon_u, c3_l mug_l, c3_d eve_d, u3_noun dud) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; c3_assert( u3_psat_play == pir_u->sat_e ); @@ -762,9 +762,9 @@ _pier_play_init(u3_pier* pir_u, c3_d eve_d) /* _pier_on_disk_read_done(): event log read success. */ static void -_pier_on_disk_read_done(void* vod_p, u3_info fon_u) +_pier_on_disk_read_done(void* ptr_v, u3_info fon_u) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; c3_assert( u3_psat_play == pir_u->sat_e ); @@ -775,9 +775,9 @@ _pier_on_disk_read_done(void* vod_p, u3_info fon_u) /* _pier_on_disk_read_bail(): event log read failure. */ static void -_pier_on_disk_read_bail(void* vod_p, c3_d eve_d) +_pier_on_disk_read_bail(void* ptr_v, c3_d eve_d) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; c3_assert( u3_psat_play == pir_u->sat_e ); @@ -791,9 +791,9 @@ _pier_on_disk_read_bail(void* vod_p, c3_d eve_d) /* _pier_on_disk_write_done(): event log write success. */ static void -_pier_on_disk_write_done(void* vod_p, c3_d eve_d) +_pier_on_disk_write_done(void* ptr_v, c3_d eve_d) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; u3_disk* log_u = pir_u->log_u; #ifdef VERBOSE_PIER @@ -821,9 +821,9 @@ _pier_on_disk_write_done(void* vod_p, c3_d eve_d) /* _pier_on_disk_write_bail(): event log write failure. */ static void -_pier_on_disk_write_bail(void* vod_p, c3_d eve_d) +_pier_on_disk_write_bail(void* ptr_v, c3_d eve_d) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; if ( u3_psat_boot == pir_u->sat_e ) { // XX nice message @@ -839,9 +839,9 @@ _pier_on_disk_write_bail(void* vod_p, c3_d eve_d) /* _pier_on_lord_slog(): debug printf from worker. */ static void -_pier_on_lord_slog(void* vod_p, c3_w pri_w, u3_noun tan) +_pier_on_lord_slog(void* ptr_v, c3_w pri_w, u3_noun tan) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; if ( c3y == u3a_is_atom(tan) ) { c3_c* tan_c = u3r_string(tan); @@ -857,9 +857,9 @@ _pier_on_lord_slog(void* vod_p, c3_w pri_w, u3_noun tan) /* _pier_on_lord_save(): worker (non-portable) snapshot complete. */ static void -_pier_on_lord_save(void* vod_p) +_pier_on_lord_save(void* ptr_v) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): lord: save\r\n", pir_u->god_u->eve_d); @@ -871,9 +871,9 @@ _pier_on_lord_save(void* vod_p) /* _pier_on_lord_pack(): worker state-export complete (portable snapshot). */ static void -_pier_on_lord_pack(void* vod_p) +_pier_on_lord_pack(void* ptr_v) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): lord: pack\r\n", pir_u->god_u->eve_d); @@ -902,9 +902,9 @@ _pier_done(u3_pier* pir_u); /* _pier_on_lord_exit(): worker shutdown. */ static void -_pier_on_lord_exit(void* vod_p) +_pier_on_lord_exit(void* ptr_v) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; // the lord has already gone // @@ -924,9 +924,9 @@ _pier_on_lord_exit(void* vod_p) /* _pier_on_lord_bail(): worker error. */ static void -_pier_on_lord_bail(void* vod_p) +_pier_on_lord_bail(void* ptr_v) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; // the lord has already gone // @@ -938,9 +938,9 @@ _pier_on_lord_bail(void* vod_p) /* _pier_on_scry_done(): scry callback. */ static void -_pier_on_scry_done(void* vod_p, u3_noun nun) +_pier_on_scry_done(void* ptr_v, u3_noun nun) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; u3_weak res = u3r_at(7, nun); if (u3_none == res) { @@ -983,9 +983,9 @@ _pier_on_scry_done(void* vod_p, u3_noun nun) /* _pier_on_lord_live(): worker is ready. */ static void -_pier_on_lord_live(void* vod_p) +_pier_on_lord_live(void* ptr_v) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; u3_lord* god_u = pir_u->god_u; u3_disk* log_u = pir_u->log_u; @@ -1154,7 +1154,7 @@ _pier_init(c3_w wag_w, c3_c* pax_c) // XX load/set secrets // u3_disk_cb cb_u = { - .vod_p = pir_u, + .ptr_v = pir_u, .read_done_f = _pier_on_disk_read_done, .read_bail_f = _pier_on_disk_read_bail, .write_done_f = _pier_on_disk_write_done, @@ -1179,7 +1179,7 @@ _pier_init(c3_w wag_w, c3_c* pax_c) key_d[0] = key_d[1] = key_d[2] = key_d[3] = 0; u3_lord_cb cb_u = { - .vod_p = pir_u, + .ptr_v = pir_u, .live_f = _pier_on_lord_live, .spin_f = _pier_on_lord_work_spin, .spun_f = _pier_on_lord_work_spun, @@ -1436,9 +1436,9 @@ u3_pier_boot(c3_w wag_w, // config flags } static void -_pier_save_cb(void* vod_p, c3_d eve_d) +_pier_save_cb(void* ptr_v, c3_d eve_d) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): save: send at %" PRIu64 "\r\n", pir_u->god_u->eve_d, eve_d); @@ -1469,9 +1469,9 @@ u3_pier_save(u3_pier* pir_u) } static void -_pier_pack_cb(void* vod_p, c3_d eve_d) +_pier_pack_cb(void* ptr_v, c3_d eve_d) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; #ifdef VERBOSE_PIER fprintf(stderr, "pier: (%" PRIu64 "): snap: send at %" PRIu64 "\r\n", pir_u->god_u->eve_d, eve_d); @@ -1585,9 +1585,9 @@ _pier_exit(u3_pier* pir_u) /* _pier_work_exit(): commence graceful shutdown. */ static void -_pier_work_exit_cb(void* vod_p, c3_d eve_d) +_pier_work_exit_cb(void* ptr_v, c3_d eve_d) { - u3_pier* pir_u = vod_p; + u3_pier* pir_u = ptr_v; _pier_work_close(pir_u->wok_u); pir_u->wok_u = 0; diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c index e39284a43..993d132c6 100644 --- a/pkg/urbit/vere/ward.c +++ b/pkg/urbit/vere/ward.c @@ -135,7 +135,7 @@ u3_ovum_init(c3_w mil_w, { u3_ovum* egg_u = c3_malloc(sizeof(*egg_u)); egg_u->car_u = 0; - egg_u->vod_p = 0; + egg_u->ptr_v = 0; egg_u->mil_w = mil_w; egg_u->tar = tar; egg_u->wir = wir; From 49444e86c5f3fd82fa40b97b278d5e27cb518e49 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 27 Jun 2020 01:13:06 -0700 Subject: [PATCH 229/257] vere: refactors ovum and callbacks to support retry --- pkg/urbit/include/vere/vere.h | 2 ++ pkg/urbit/vere/auto.c | 5 +++-- pkg/urbit/vere/io/ames.c | 4 +++- pkg/urbit/vere/io/behn.c | 13 +++++-------- pkg/urbit/vere/io/fore.c | 4 +++- pkg/urbit/vere/ward.c | 1 + 6 files changed, 17 insertions(+), 12 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 8f2d5ae5b..d8a81438a 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -334,6 +334,7 @@ */ typedef struct _u3_ovum { void* ptr_v; // context + c3_w try_w; // retry count c3_w mil_w; // timeout ms u3_noun tar; // target (in arvo) u3_noun wir; // wire @@ -848,6 +849,7 @@ */ void u3_auto_peer(u3_ovum* egg_u, + void* ptr_v, u3_ovum_peer news_f, u3_ovum_bail bail_f); diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 9fedc7017..49b04b935 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -54,9 +54,11 @@ u3_auto_plan(u3_auto* car_u, u3_ovum *egg_u) */ void u3_auto_peer(u3_ovum* egg_u, + void* ptr_v, u3_ovum_peer news_f, u3_ovum_bail bail_f) { + egg_u->ptr_v = ptr_v; egg_u->cb_u.news_f = news_f; egg_u->cb_u.bail_f = bail_f; } @@ -97,9 +99,8 @@ u3_auto_bail(u3_ovum* egg_u, u3_noun lud) } else { u3_auto_bail_slog(egg_u, lud); + u3_ovum_free(egg_u); } - - u3_ovum_free(egg_u); } /* _auto_news(): notify driver of ovum status diff --git a/pkg/urbit/vere/io/ames.c b/pkg/urbit/vere/io/ames.c index be2c970a2..a4bad0127 100644 --- a/pkg/urbit/vere/io/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -431,6 +431,8 @@ _ames_hear_bail(u3_ovum* egg_u, u3_noun lud) u3l_log("ames: packet failed (%" PRIu64 " total)\n\n", sam_u->fal_d); } } + + u3_ovum_free(egg_u); } /* _ames_recv_cb(): receive callback. @@ -473,7 +475,7 @@ _ames_recv_cb(uv_udp_t* wax_u, u3_auto_peer( u3_auto_plan(&sam_u->car_u, u3_ovum_init(0, c3__a, wir, cad)), - 0, _ames_hear_bail); + 0, 0, _ames_hear_bail); _ames_cap_queue(sam_u); } diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index 5fa639da2..dbe99e65d 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -17,7 +17,6 @@ u3_auto car_u; // driver uv_timer_t tim_u; // behn timer c3_o alm_o; // alarm - c3_w bon_w; // %born retry count } u3_behn; /* _behn_time_cb(): timer callback. @@ -94,18 +93,14 @@ _behn_born_news(u3_ovum* egg_u, u3_ovum_news new_e) } } -static void -_behn_io_talk(u3_auto* car_u); - /* _behn_born_bail(): %born is essential, retry failures. */ static void _behn_born_bail(u3_ovum* egg_u, u3_noun lud) { u3_auto* car_u = egg_u->car_u; - u3_behn* teh_u = (u3_behn*)car_u; - if ( teh_u->bon_w == 2 ) { + if ( 2 == egg_u->try_w ) { u3l_log("behn: initialization failed\n"); if ( 2 == u3qb_lent(lud) ) { @@ -123,11 +118,12 @@ _behn_born_bail(u3_ovum* egg_u, u3_noun lud) } } + u3_ovum_free(egg_u); u3_pier_bail(car_u->pir_u); } else { - _behn_io_talk(car_u); - teh_u->bon_w++; + egg_u->try_w++; + u3_auto_plan(car_u, egg_u); } u3z(lud); @@ -144,6 +140,7 @@ _behn_io_talk(u3_auto* car_u) u3_auto_peer( u3_auto_plan(car_u, u3_ovum_init(0, c3__b, wir, cad)), + 0, _behn_born_news, _behn_born_bail); } diff --git a/pkg/urbit/vere/io/fore.c b/pkg/urbit/vere/io/fore.c index 4691e8a6e..96f6dd53b 100644 --- a/pkg/urbit/vere/io/fore.c +++ b/pkg/urbit/vere/io/fore.c @@ -18,6 +18,8 @@ _fore_inject_bail(u3_ovum* egg_u, u3_noun lud) { u3_auto_bail_slog(egg_u, lud); u3l_log("pier: injected event failed\n"); + + u3_ovum_free(egg_u); } /* _fore_inject(): inject an arbitrary ovum from a jammed file at [pax_c]. @@ -61,7 +63,7 @@ _fore_inject(u3_auto* car_u, c3_c* pax_c) u3_auto_peer( u3_auto_plan(car_u, u3_ovum_init(0, u3k(tar), u3k(wir), u3k(cad))), - 0, _fore_inject_bail); + 0, 0, _fore_inject_bail); } u3z(ovo); diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c index 993d132c6..bb9b09212 100644 --- a/pkg/urbit/vere/ward.c +++ b/pkg/urbit/vere/ward.c @@ -135,6 +135,7 @@ u3_ovum_init(c3_w mil_w, { u3_ovum* egg_u = c3_malloc(sizeof(*egg_u)); egg_u->car_u = 0; + egg_u->try_w = 0; egg_u->ptr_v = 0; egg_u->mil_w = mil_w; egg_u->tar = tar; From 3969e78612f2a47a80c0a2800d3ec3fa61a853bb Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 27 Jun 2020 01:15:32 -0700 Subject: [PATCH 230/257] vere: retry behn timer failures --- pkg/urbit/vere/io/behn.c | 40 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 39 insertions(+), 1 deletion(-) diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index dbe99e65d..2f8534b95 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -19,6 +19,42 @@ c3_o alm_o; // alarm } u3_behn; +/* _behn_wake_bail(): %wake is essential, retry failures. +*/ +static void +_behn_wake_bail(u3_ovum* egg_u, u3_noun lud) +{ + u3_auto* car_u = egg_u->car_u; + + if ( 2 == egg_u->try_w ) { + u3l_log("behn: timer failed\n"); + + if ( 2 == u3qb_lent(lud) ) { + u3_pier_punt_goof("wake", u3k(u3h(lud))); + u3_pier_punt_goof("crud", u3k(u3h(u3t(lud)))); + } + else { + u3_noun dul = lud; + c3_w len_w = 1; + + while ( u3_nul != dul ) { + u3l_log("behn: bail %u\r\n", len_w++); + u3_pier_punt_goof("behn", u3k(u3h(dul))); + dul = u3t(dul); + } + } + + u3_ovum_free(egg_u); + u3_pier_bail(car_u->pir_u); + } + else { + egg_u->try_w++; + u3_auto_plan(car_u, egg_u); + } + + u3z(lud); +} + /* _behn_time_cb(): timer callback. */ static void @@ -46,7 +82,9 @@ _behn_time_cb(uv_timer_t* tim_u) u3_noun wir = u3nc(c3__behn, u3_nul); u3_noun cad = u3nc(c3__wake, u3_nul); - u3_auto_plan(&teh_u->car_u, u3_ovum_init(0, c3__b, wir, cad)); + u3_auto_peer( + u3_auto_plan(&teh_u->car_u, u3_ovum_init(0, c3__b, wir, cad)), + 0, 0, _behn_wake_bail); } } From a5a148e66d556ab81490e1ecf75b61d047b0e1a5 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Sat, 27 Jun 2020 22:32:52 -0700 Subject: [PATCH 231/257] vere: remove stale function declarations --- pkg/urbit/include/vere/vere.h | 51 ----------------------------------- 1 file changed, 51 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index d8a81438a..d75c75e51 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -999,11 +999,6 @@ void u3_walk_save(c3_c* pas_c, u3_noun tim, u3_atom pad, c3_c* bas_c, u3_noun pax); - /* u3_sync_reck(): traverse filesystem for changes -> lamb - */ - u3_noun - u3_sync_reck(void); - /* u3_walk(): traverse `dir_c` to produce an arch, updating `old`. */ u3_noun @@ -1014,35 +1009,6 @@ c3_c* u3_path(c3_o fyl, u3_noun pax); - /** Filesystem (old api). - **/ - /* u3_ve_file(): load internal file as atom from local or system. - */ - u3_weak - u3_ve_file(c3_c* ext_c, u3_noun tah); - - /* u3_ve_frep(): load [.~ %rep myp {now} tah]. - ** - ** File is either ~ or [nbytes mdate atom]. - */ - u3_noun - u3_ve_frep(u3_noun myp, u3_noun tah); - - /* u3_ve_date(): date internal file. - */ - c3_d - u3_ve_date(c3_c* ext_c, u3_noun tah); - - /* u3_ve_save(): save internal file as atom. - */ - c3_o - u3_ve_save(c3_c* ext_c, u3_noun tah, u3_noun dat); - - /* u3_ve_zeus(): prayer to internal file path. Return unit. - */ - u3_noun - u3_ve_zeus(u3_noun hap); - /** Filesystem (async) **/ /* u3_foil_folder(): load directory, blockingly. create if nonexistent. @@ -1229,23 +1195,6 @@ /** Pier control. **/ - /* u3_pier_db_shutdown(): close the log. - */ - void - u3_pier_db_shutdown(u3_pier* pir_u); - - /* u3_pier_interrupt(): interrupt running process. - */ - void - u3_pier_interrupt(u3_pier* pir_u); - - /* u3_pier_discover(): insert task into process controller. - */ - void - u3_pier_discover(u3_pier* pir_u, - c3_l msc_l, - u3_noun job); - /* u3_pier_exit(): trigger a gentle shutdown. */ void From 6e8a91479140a8ab0ca81820903ccc99fc90928c Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Mon, 29 Jun 2020 01:41:00 -0700 Subject: [PATCH 232/257] vere: refactor %behn's retries of failed events --- pkg/urbit/include/vere/vere.h | 7 ++- pkg/urbit/vere/auto.c | 42 ++++++++++++++-- pkg/urbit/vere/io/behn.c | 92 +++++++++++++++++------------------ 3 files changed, 88 insertions(+), 53 deletions(-) diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index d75c75e51..d86f21cd4 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -840,11 +840,16 @@ void u3_auto_bail_slog(u3_ovum* egg_u, u3_noun lud); - /* u3_auto_plan(): create and enqueue an ovum. + /* u3_auto_plan(): enqueue an ovum. */ u3_ovum* u3_auto_plan(u3_auto* car_u, u3_ovum* egg_u); + /* u3_auto_redo(): retry an ovum. + */ + u3_ovum* + u3_auto_redo(u3_auto* car_u, u3_ovum* egg_u); + /* u3_auto_peer(): subscribe to updates. */ void diff --git a/pkg/urbit/vere/auto.c b/pkg/urbit/vere/auto.c index 49b04b935..cca6fae14 100644 --- a/pkg/urbit/vere/auto.c +++ b/pkg/urbit/vere/auto.c @@ -19,16 +19,13 @@ #include "all.h" #include "vere/vere.h" -/* u3_auto_plan(): create and enqueue an ovum. +/* u3_auto_plan(): enqueue an ovum. */ u3_ovum* u3_auto_plan(u3_auto* car_u, u3_ovum *egg_u) { egg_u->car_u = car_u; - // [pre_u] points towards [ext_u] (back in time) - // [nex_u] points towards [ent_u] (forward in time) - // if ( !car_u->ent_u ) { c3_assert(!car_u->ext_u); @@ -36,6 +33,11 @@ u3_auto_plan(u3_auto* car_u, u3_ovum *egg_u) car_u->ent_u = car_u->ext_u = egg_u; car_u->dep_w = 1; } + // enqueue at driver entry (back of the line) + // + // [pre_u] points towards [ext_u] (back in time) + // [nex_u] points towards [ent_u] (forward in time) + // else { egg_u->nex_u = 0; egg_u->pre_u = car_u->ent_u; @@ -50,6 +52,38 @@ u3_auto_plan(u3_auto* car_u, u3_ovum *egg_u) return egg_u; } +/* u3_auto_redo(): retry an ovum. +*/ +u3_ovum* +u3_auto_redo(u3_auto* car_u, u3_ovum *egg_u) +{ + c3_assert( egg_u->car_u == car_u ); + + egg_u->try_w++; + + if ( !car_u->ent_u ) { + c3_assert(!car_u->ext_u); + + egg_u->pre_u = egg_u->nex_u = 0; + car_u->ent_u = car_u->ext_u = egg_u; + car_u->dep_w = 1; + } + // enqueue at driver exit (front of the line) + // + else { + egg_u->nex_u = car_u->ext_u; + egg_u->pre_u = 0; + + car_u->ext_u->pre_u = egg_u; + car_u->ext_u = egg_u; + car_u->dep_w++; + } + + u3_pier_spin(car_u->pir_u); + + return egg_u; +} + /* u3_auto_peer(): subscribe to updates. */ void diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c index 2f8534b95..7e13c05b3 100644 --- a/pkg/urbit/vere/io/behn.c +++ b/pkg/urbit/vere/io/behn.c @@ -19,6 +19,24 @@ c3_o alm_o; // alarm } u3_behn; +// XX review, move +// +/* _behn_bail_dire(): c3y if fatal error. RETAIN +*/ +static c3_o +_behn_bail_dire(u3_noun lud) +{ + u3_noun mot = u3r_at(4, lud); + + if ( (c3__meme == mot) + || (c3__intr == mot) ) + { + return c3n; + } + + return c3y; +} + /* _behn_wake_bail(): %wake is essential, retry failures. */ static void @@ -26,33 +44,22 @@ _behn_wake_bail(u3_ovum* egg_u, u3_noun lud) { u3_auto* car_u = egg_u->car_u; - if ( 2 == egg_u->try_w ) { - u3l_log("behn: timer failed\n"); - - if ( 2 == u3qb_lent(lud) ) { - u3_pier_punt_goof("wake", u3k(u3h(lud))); - u3_pier_punt_goof("crud", u3k(u3h(u3t(lud)))); - } - else { - u3_noun dul = lud; - c3_w len_w = 1; - - while ( u3_nul != dul ) { - u3l_log("behn: bail %u\r\n", len_w++); - u3_pier_punt_goof("behn", u3k(u3h(dul))); - dul = u3t(dul); - } - } - - u3_ovum_free(egg_u); - u3_pier_bail(car_u->pir_u); + if ( (2 > egg_u->try_w) + && (c3n == _behn_bail_dire(lud)) ) + { + u3z(lud); + u3_auto_redo(car_u, egg_u); } else { - egg_u->try_w++; - u3_auto_plan(car_u, egg_u); - } + u3_auto_bail_slog(egg_u, lud); + u3_ovum_free(egg_u); - u3z(lud); + u3l_log("behn: timer failed; queue blocked\n"); + + // XX review, add flag to continue? + // + u3_pier_bail(car_u->pir_u); + } } /* _behn_time_cb(): timer callback. @@ -138,33 +145,22 @@ _behn_born_bail(u3_ovum* egg_u, u3_noun lud) { u3_auto* car_u = egg_u->car_u; - if ( 2 == egg_u->try_w ) { - u3l_log("behn: initialization failed\n"); - - if ( 2 == u3qb_lent(lud) ) { - u3_pier_punt_goof("born", u3k(u3h(lud))); - u3_pier_punt_goof("crud", u3k(u3h(u3t(lud)))); - } - else { - u3_noun dul = lud; - c3_w len_w = 1; - - while ( u3_nul != dul ) { - u3l_log("behn: bail %u\r\n", len_w++); - u3_pier_punt_goof("behn", u3k(u3h(dul))); - dul = u3t(dul); - } - } - - u3_ovum_free(egg_u); - u3_pier_bail(car_u->pir_u); + if ( (2 > egg_u->try_w) + && (c3n == _behn_bail_dire(lud)) ) + { + u3z(lud); + u3_auto_redo(car_u, egg_u); } else { - egg_u->try_w++; - u3_auto_plan(car_u, egg_u); - } + u3_auto_bail_slog(egg_u, lud); + u3_ovum_free(egg_u); - u3z(lud); + u3l_log("behn: initialization failed\n"); + + // XX review, add flag to continue? + // + u3_pier_bail(car_u->pir_u); + } } /* _behn_io_talk(): notify %behn that we're live */ From da25fc22bec00f34a012f30a87d7cafd61a27172 Mon Sep 17 00:00:00 2001 From: Fang Date: Fri, 3 Jul 2020 13:52:03 +0200 Subject: [PATCH 233/257] vere: more readable http server status Not touching the proxy message because that seems gone on ipc-redux. --- pkg/urbit/vere/http.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/pkg/urbit/vere/http.c b/pkg/urbit/vere/http.c index 5ca88a7e6..61208a9b2 100644 --- a/pkg/urbit/vere/http.c +++ b/pkg/urbit/vere/http.c @@ -1267,9 +1267,9 @@ _http_serv_start(u3_http* htp_u) htp_u->rox_u->por_s); } else { - u3l_log("http: live (%s, %s) on %d\n", - (c3y == htp_u->sec) ? "secure" : "insecure", - (c3y == htp_u->lop) ? "loopback" : "public", + u3l_log("http: %s live on %s://localhost:%d\n", + (c3y == htp_u->lop) ? "loopback" : "web interface", + (c3y == htp_u->sec) ? "https" : "http", htp_u->por_s); } From e8a307ae67f19e74effe6aa0cd20633703afda14 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Tue, 30 Jun 2020 03:57:47 -0700 Subject: [PATCH 234/257] noun: first pass at memory compaction --- nix/nixcrpkgs/pkgs.nix | 4 - pkg/urbit/include/noun/allocate.h | 25 ++++ pkg/urbit/include/noun/hashtable.h | 5 + pkg/urbit/include/noun/jets.h | 15 +++ pkg/urbit/include/noun/nock.h | 5 + pkg/urbit/include/noun/vortex.h | 5 + pkg/urbit/noun/allocate.c | 201 +++++++++++++++++++++++++++++ pkg/urbit/noun/events.c | 2 +- pkg/urbit/noun/hashtable.c | 81 ++++++++++++ pkg/urbit/noun/jets.c | 98 ++++++++++++++ pkg/urbit/noun/nock.c | 45 +++++++ pkg/urbit/noun/vortex.c | 21 +++ pkg/urbit/worker/serf.c | 4 + 13 files changed, 506 insertions(+), 5 deletions(-) diff --git a/nix/nixcrpkgs/pkgs.nix b/nix/nixcrpkgs/pkgs.nix index b08387670..2fb612a27 100644 --- a/nix/nixcrpkgs/pkgs.nix +++ b/nix/nixcrpkgs/pkgs.nix @@ -24,10 +24,6 @@ rec { inherit crossenv; }; - ncurses = import ./pkgs/ncurses { - inherit crossenv; - }; - pdcurses = import ./pkgs/pdcurses { inherit crossenv; }; diff --git a/pkg/urbit/include/noun/allocate.h b/pkg/urbit/include/noun/allocate.h index 934b70328..989891fba 100644 --- a/pkg/urbit/include/noun/allocate.h +++ b/pkg/urbit/include/noun/allocate.h @@ -465,6 +465,31 @@ c3_w u3a_mark_road(FILE* fil_u); + /* u3a_rewrite_ptr(): mark a pointer as already having been rewritten + */ + c3_o + u3a_rewrite_ptr(void* ptr_v); + + /* u3a_rewrite_noun(): rewrite a noun for compaction. + */ + void + u3a_rewrite_noun(u3_noun som); + + /* u3a_rewritten(): rewrite a pointer for compaction. + */ + u3_post + u3a_rewritten(u3_post som_p); + + /* u3a_rewritten(): rewritten noun pointer for compaction. + */ + u3_noun + u3a_rewritten_noun(u3_noun som); + + /* u3a_compact(): compact (north) road. + */ + void + u3a_compact(); + /* u3a_count_noun(): count size of noun. */ c3_w diff --git a/pkg/urbit/include/noun/hashtable.h b/pkg/urbit/include/noun/hashtable.h index a6457ad95..bf9f50e17 100644 --- a/pkg/urbit/include/noun/hashtable.h +++ b/pkg/urbit/include/noun/hashtable.h @@ -139,6 +139,11 @@ c3_w u3h_mark(u3p(u3h_root) har_p); + /* u3h_rewrite(): rewrite hashtable for compaction. + */ + void + u3h_rewrite(u3p(u3h_root) har_p); + /* u3h_count(): count hashtable for gc. */ c3_w diff --git a/pkg/urbit/include/noun/jets.h b/pkg/urbit/include/noun/jets.h index aa3934284..214376d76 100644 --- a/pkg/urbit/include/noun/jets.h +++ b/pkg/urbit/include/noun/jets.h @@ -287,6 +287,21 @@ c3_w u3j_mark(FILE* fil_u); + /* u3j_rite_rewrite(): rewrite u3j_rite for compaction. + */ + void + u3j_rite_rewrite(u3j_rite* rit_u); + + /* u3j_site_rewrite(): rewrite u3j_site for compaction. + */ + void + u3j_site_rewrite(u3j_site* sit_u); + + /* u3j_rewrite_compact(): rewrite jet state for compaction. + */ + void + u3j_rewrite_compact(); + /* u3j_free_hank(): free an entry from the hank cache. */ void diff --git a/pkg/urbit/include/noun/nock.h b/pkg/urbit/include/noun/nock.h index 243932fa1..3de1f1977 100644 --- a/pkg/urbit/include/noun/nock.h +++ b/pkg/urbit/include/noun/nock.h @@ -117,6 +117,11 @@ c3_w u3n_mark(FILE* fil_u); + /* u3n_rewrite_compact(): rewrite bytecode cache for compaction. + */ + void + u3n_rewrite_compact(); + /* u3n_free(): free bytecode cache. */ void diff --git a/pkg/urbit/include/noun/vortex.h b/pkg/urbit/include/noun/vortex.h index c1f1e7270..4da1a135f 100644 --- a/pkg/urbit/include/noun/vortex.h +++ b/pkg/urbit/include/noun/vortex.h @@ -103,3 +103,8 @@ */ c3_w u3v_mark(FILE* fil_u); + + /* u3v_rewrite_compact(): rewrite arvo kernel for compaction. + */ + void + u3v_rewrite_compact(); diff --git a/pkg/urbit/noun/allocate.c b/pkg/urbit/noun/allocate.c index ea44ef168..06096d2c0 100644 --- a/pkg/urbit/noun/allocate.c +++ b/pkg/urbit/noun/allocate.c @@ -1679,6 +1679,29 @@ u3a_mark_ptr(void* ptr_v) } } +u3_post +u3a_rewritten(u3_post ptr_v) +{ + u3a_box* box_u = u3a_botox(u3a_into(ptr_v)); + c3_w* box_w = (c3_w*) box_u; + return (u3_post)box_w[box_u->siz_w - 1]; +} + +u3_noun +u3a_rewritten_noun(u3_noun som) +{ + if ( c3y == u3a_is_cat(som) ) { + return som; + } + u3_post som_p = u3a_rewritten(u3a_to_off(som)); + if ( c3y == u3a_is_pug(som) ) { + return u3a_to_pug(som_p); + } + else { + return u3a_to_pom(som_p); + } +} + /* u3a_mark_mptr(): mark a malloc-allocated ptr for gc. */ c3_w @@ -1928,6 +1951,28 @@ u3a_mark_road(FILE* fil_u) return u3a_maid(fil_u, "total road stuff", tot_w); } +/* u3a_rewrite_compact(): rewrite pointers in ad-hoc persistent road structures. +*/ +void +u3a_rewrite_compact() +{ + u3a_rewrite_noun(u3R->ski.gul); + u3a_rewrite_noun(u3R->bug.tax); + u3a_rewrite_noun(u3R->bug.mer); + u3a_rewrite_noun(u3R->pro.don); + u3a_rewrite_noun(u3R->pro.day); + u3a_rewrite_noun(u3R->pro.trace); + u3h_rewrite(u3R->cax.har_p); + + u3R->ski.gul = u3a_rewritten_noun(u3R->ski.gul); + u3R->bug.tax = u3a_rewritten_noun(u3R->bug.tax); + u3R->bug.mer = u3a_rewritten_noun(u3R->bug.mer); + u3R->pro.don = u3a_rewritten_noun(u3R->pro.don); + u3R->pro.day = u3a_rewritten_noun(u3R->pro.day); + u3R->pro.trace = u3a_rewritten_noun(u3R->pro.trace); + u3R->cax.har_p = u3a_rewritten(u3R->cax.har_p); +} + /* _ca_print_box(): heuristically print the contents of an allocation box. */ static c3_c* @@ -2180,6 +2225,162 @@ u3a_sweep(void) return neg_w; } + +/* u3a_compact(): compact road. +*/ +void +u3a_compact(void) +{ + sleep(10); + u3m_reclaim(); + assert(c3y == u3a_is_north(u3R)); + u3_post box_p = _(u3a_is_north(u3R)) ? u3R->rut_p : u3R->hat_p; + u3_post end_p = _(u3a_is_north(u3R)) ? u3R->hat_p : u3R->rut_p; + + /* Sweep through arena, recording new address + * + * Don't trace to preserve memory locality + */ + { + u3_post new_p = c3_wiseof(u3a_box) + 1; + c3_w* box_w = u3a_into(box_p); + c3_w* end_w = u3a_into(end_p); + + while ( box_w < end_w ) { + u3a_box* box_u = (void *)box_w; + + /* If not free, rewrite trailing size word to be new pointer. + * + * Another option would be to use the refcount and just + * regenerate it by tracing. + */ + if ( box_u->use_w > 0 ) { + //fprintf(stderr, "compact: found size %d at box_u %p, setting to new_p %x\r\n", box_u->siz_w, box_u, new_p); + box_w[box_u->siz_w - 1] = new_p; + new_p += box_u->siz_w; + //fprintf(stderr, "compact: adding to new_p %x\r\n", new_p); + } + + box_w += box_u->siz_w; + } + } + + fprintf(stderr, "compact: sweep 1 complete\r\n"); + + /* Trace through arena, rewriting pointers + * + * Don't sweep because it's ad-hoc polymorphic + */ + { + u3v_rewrite_compact(); + u3j_rewrite_compact(); + u3n_rewrite_compact(); + u3a_rewrite_compact(); + } + + fprintf(stderr, "compact: trace complete\r\n"); + + c3_w* new_w = (void*)u3a_botox(u3a_into(c3_wiseof(u3a_box) + 1)); + + /* Sweep through arena, moving nouns + * + * Don't trace because you need to move in order + */ + { + c3_w* box_w = u3a_into(box_p); + c3_w* end_w = u3a_into(end_p); + + while ( box_w < end_w ) { + u3a_box* old_u = (void *)box_w; + c3_w siz_w = old_u->siz_w; // store because we're about to overwrite + + /* Unmark if marked + */ + old_u->use_w &= 0x7fffffff; + + //fprintf(stderr, "compact: 364 == %d\r\n", *((c3_w*)0x200000364)); + //fprintf(stderr, "compact: found size %d at old_u %p\r\n", old_u->siz_w, old_u); + + + /* If not free, move to new home + */ + if ( old_u->use_w > 0 ) { + //fprintf(stderr, "compact: writing to %p from %p\r\n", u3a_botox(u3a_into(box_w[siz_w - 1])), box_w); + assert(new_w == (c3_w*)u3a_botox(u3a_into(box_w[siz_w - 1]))); + new_w = (c3_w*)u3a_botox(u3a_into(box_w[siz_w - 1])); + c3_w i_w; + if ( new_w > box_w ) { + fprintf(stderr, "compact: whoa new_w %p, i_w %d\r\n", new_w, i_w); + } + for ( i_w = 0; i_w < siz_w - 1; i_w++ ) { + new_w[i_w] = box_w[i_w]; + } + new_w[siz_w - 1] = siz_w; + new_w += siz_w; + } + + box_w += siz_w; + } + fprintf(stderr, "compact: box_w %lx new_w %lx\r\n", u3a_outa(box_w), u3a_outa(new_w)); + } + + fprintf(stderr, "compact: sweep 2 complete\r\n"); + + /* Set new end of heap. + */ + { + u3R->hat_p = u3a_outa(new_w); + + c3_w i_w; + for ( i_w = 0; i_w < u3a_fbox_no; i_w++ ) { + u3R->all.fre_p[i_w] = 0; + } + + u3R->all.cel_p = 0; + u3R->all.fre_w = 0; + + u3n_ream(); + + u3m_mark(stderr); + fprintf(stderr, "compact: marked\r\n"); + u3a_sweep(); + fprintf(stderr, "compact: swept\r\n"); + } +} + +/* u3a_rewrite_ptr(): mark a pointer as already having been rewritten +*/ +c3_o +u3a_rewrite_ptr(void* ptr_v) +{ + u3a_box* box_u = u3a_botox(ptr_v); + if ( box_u->use_w & 0x80000000 ) { + /* Already rewritten. + */ + return c3n; + } + box_u->use_w |= 0x80000000; + return c3y; +} + +void +u3a_rewrite_noun(u3_noun som) +{ + if ( c3n == u3a_is_cell(som) ) { + return; + } + + if ( c3n == u3a_rewrite_ptr(u3a_to_ptr((som))) ) return; + + u3a_cell* cel = u3a_to_ptr(som); + + u3a_rewrite_noun(cel->hed); + u3a_rewrite_noun(cel->tel); + + cel->hed = u3a_rewritten_noun(cel->hed); + cel->tel = u3a_rewritten_noun(cel->tel); +} + /* u3a_slab(): create a length-bounded proto-atom. */ c3_w* diff --git a/pkg/urbit/noun/events.c b/pkg/urbit/noun/events.c index 86162741d..8bae1891d 100644 --- a/pkg/urbit/noun/events.c +++ b/pkg/urbit/noun/events.c @@ -148,7 +148,7 @@ u3e_fault(void* adr_v, c3_i ser_i) if ( 0 != (u3P.dit_w[blk_w] & (1 << bit_w)) ) { fprintf(stderr, "strange page: %d, at %p, off %x\r\n", pag_w, adr_w, off_w); - c3_assert(0); + // c3_assert(0); return 0; } diff --git a/pkg/urbit/noun/hashtable.c b/pkg/urbit/noun/hashtable.c index 3eb7152be..e57c47be9 100644 --- a/pkg/urbit/noun/hashtable.c +++ b/pkg/urbit/noun/hashtable.c @@ -913,6 +913,58 @@ _ch_mark_node(u3h_node* han_u, c3_w lef_w) return tot_w; } +// XXX reorg +/* _ch_rewrite_buck(): rewrite buck for compaction. +*/ +void +_ch_rewrite_buck(u3h_buck* hab_u) +{ + if ( c3n == u3a_rewrite_ptr(hab_u) ) return; + c3_w i_w; + + for ( i_w = 0; i_w < hab_u->len_w; i_w++ ) { + u3_noun som = u3h_slot_to_noun(hab_u->sot_w[i_w]); + hab_u->sot_w[i_w] = u3h_noun_to_slot(u3a_rewritten_noun(som)); + u3a_rewrite_noun(som); + } +} + +/* _ch_rewrite_node(): rewrite node for compaction. +*/ +void +_ch_rewrite_node(u3h_node* han_u, c3_w lef_w) +{ + if ( c3n == u3a_rewrite_ptr(han_u) ) return; + + c3_w len_w = _ch_popcount(han_u->map_w); + c3_w i_w; + + lef_w -= 5; + + for ( i_w = 0; i_w < len_w; i_w++ ) { + c3_w sot_w = han_u->sot_w[i_w]; + + if ( _(u3h_slot_is_noun(sot_w)) ) { + u3_noun kev = u3h_slot_to_noun(sot_w); + han_u->sot_w[i_w] = u3h_noun_to_slot(u3a_rewritten_noun(kev)); + + u3a_rewrite_noun(kev); + } + else { + void* hav_v = u3h_slot_to_node(sot_w); + u3h_node* nod_u = u3to(u3h_node,u3a_rewritten(u3of(u3h_node,hav_v))); + han_u->sot_w[i_w] = u3h_node_to_slot(nod_u); + + if ( 0 == lef_w ) { + _ch_rewrite_buck(hav_v); + } else { + _ch_rewrite_node(hav_v, lef_w); + } + } + } +} + + /* u3h_mark(): mark hashtable for gc. */ c3_w @@ -942,6 +994,35 @@ u3h_mark(u3p(u3h_root) har_p) return tot_w; } +/* u3h_rewrite(): rewrite pointers during compaction. +*/ +void +u3h_rewrite(u3p(u3h_root) har_p) +{ + u3h_root* har_u = u3to(u3h_root, har_p); + c3_w i_w; + + if ( c3n == u3a_rewrite_ptr(har_u) ) return; + + for ( i_w = 0; i_w < 64; i_w++ ) { + c3_w sot_w = har_u->sot_w[i_w]; + + if ( _(u3h_slot_is_noun(sot_w)) ) { + u3_noun kev = u3h_slot_to_noun(sot_w); + har_u->sot_w[i_w] = u3h_noun_to_slot(u3a_rewritten_noun(kev)); + + u3a_rewrite_noun(kev); + } + else if ( _(u3h_slot_is_node(sot_w)) ) { + u3h_node* han_u = u3h_slot_to_node(sot_w); + u3h_node* nod_u = u3to(u3h_node,u3a_rewritten(u3of(u3h_node,han_u))); + har_u->sot_w[i_w] = u3h_node_to_slot(nod_u); + + _ch_rewrite_node(han_u, 25); + } + } +} + /* _ch_count_buck(): count bucket for gc. */ c3_w diff --git a/pkg/urbit/noun/jets.c b/pkg/urbit/noun/jets.c index 2ae4aea40..aaadd2ce5 100644 --- a/pkg/urbit/noun/jets.c +++ b/pkg/urbit/noun/jets.c @@ -2339,6 +2339,104 @@ u3j_mark(FILE* fil_u) return u3a_maid(fil_u, "total jet stuff", tot_w); } +/* _cj_fink_rewrite(): rewrite a u3j_fink for compaction. +*/ +static void +_cj_fink_rewrite(u3j_fink* fin_u) +{ + if ( c3n == u3a_rewrite_ptr(fin_u) ) return; + c3_w i_w; + u3a_rewrite_noun(fin_u->sat); + fin_u->sat = u3a_rewritten_noun(fin_u->sat); + + for ( i_w = 0; i_w < fin_u->len_w; ++i_w ) { + u3j_fist* fis_u = &(fin_u->fis_u[i_w]); + u3a_rewrite_noun(fis_u->bat); + u3a_rewrite_noun(fis_u->pax); + fis_u->bat = u3a_rewritten_noun(fis_u->bat); + fis_u->pax = u3a_rewritten_noun(fis_u->pax); + } +} + +/* u3j_rite_rewrite(): rewrite u3j_rite for compaction. +*/ +void +u3j_rite_rewrite(u3j_rite* rit_u) +{ + if ( (c3y == rit_u->own_o) && u3_none != rit_u->clu ) { + u3a_rewrite_noun(rit_u->clu); + _cj_fink_rewrite(u3to(u3j_fink, rit_u->fin_p)); + rit_u->clu = u3a_rewritten_noun(rit_u->clu); + rit_u->fin_p = u3a_rewritten(rit_u->fin_p); + } +} + +/* u3j_site_rewrite(): rewrite u3j_site for compaction. +*/ +void +u3j_site_rewrite(u3j_site* sit_u) +{ + u3a_rewrite_noun(sit_u->axe); + sit_u->axe = u3a_rewritten_noun(sit_u->axe); + + if ( u3_none != sit_u->bat ) { + u3a_rewrite_noun(sit_u->bat); + sit_u->bat = u3a_rewritten_noun(sit_u->bat); + } + if ( u3_none != sit_u->bas ) { + u3a_rewrite_noun(sit_u->bas); + sit_u->bas = u3a_rewritten_noun(sit_u->bas); + } + if ( u3_none != sit_u->loc ) { + u3a_rewrite_noun(sit_u->loc); + u3a_rewrite_noun(sit_u->lab); + sit_u->loc = u3a_rewritten_noun(sit_u->loc); + sit_u->lab = u3a_rewritten_noun(sit_u->lab); + if ( c3y == sit_u->fon_o ) { + _cj_fink_rewrite(u3to(u3j_fink, sit_u->fin_p)); + sit_u->fin_p = u3a_rewritten(sit_u->fin_p); + } + } +} + +/* _cj_rewrite_hank(): rewrite hank cache for compaction. +*/ +static void +_cj_rewrite_hank(u3_noun kev) +{ + _cj_hank* han_u = u3to(_cj_hank, u3t(kev)); + if ( c3n == u3a_rewrite_ptr(han_u) ) return; + if ( u3_none != han_u->hax ) { + u3a_rewrite_noun(han_u->hax); + u3j_site_rewrite(&(han_u->sit_u)); + + han_u->hax = u3a_rewritten_noun(han_u->hax); + } +} + +/* u3j_rewrite_compact(): rewrite jet state for compaction. +*/ +void +u3j_rewrite_compact() +{ + u3h_walk(u3R->jed.han_p, _cj_rewrite_hank); + + u3h_rewrite(u3R->jed.war_p); + u3h_rewrite(u3R->jed.cod_p); + u3h_rewrite(u3R->jed.han_p); + u3h_rewrite(u3R->jed.bas_p); + + if ( u3R == &(u3H->rod_u) ) { + u3h_rewrite(u3R->jed.hot_p); + u3R->jed.hot_p = u3a_rewritten(u3R->jed.hot_p); + } + + u3R->jed.war_p = u3a_rewritten(u3R->jed.war_p); + u3R->jed.cod_p = u3a_rewritten(u3R->jed.cod_p); + u3R->jed.han_p = u3a_rewritten(u3R->jed.han_p); + u3R->jed.bas_p = u3a_rewritten(u3R->jed.bas_p); +} + /* u3j_free_hank(): free an entry from the hank cache. */ void diff --git a/pkg/urbit/noun/nock.c b/pkg/urbit/noun/nock.c index e2bfc0f7d..6a449d6ad 100644 --- a/pkg/urbit/noun/nock.c +++ b/pkg/urbit/noun/nock.c @@ -2597,6 +2597,51 @@ u3n_mark(FILE* fil_u) return u3a_maid(fil_u, "total nock stuff", bam_w + har_w); } +/* _n_prog_rewrite(): rewrite program for compaction. +*/ +static void +_n_prog_rewrite(u3n_prog* pog_u) +{ + c3_w i_w; + + for ( i_w = 0; i_w < pog_u->lit_u.len_w; ++i_w ) { + u3a_rewrite_noun(pog_u->lit_u.non[i_w]); + } + + for ( i_w = 0; i_w < pog_u->mem_u.len_w; ++i_w ) { + u3a_rewrite_noun(pog_u->mem_u.sot_u[i_w].key); + } + + for ( i_w = 0; i_w < pog_u->cal_u.len_w; ++i_w ) { + u3j_site_rewrite(&(pog_u->cal_u.sit_u[i_w])); + } + + for ( i_w = 0; i_w < pog_u->reg_u.len_w; ++i_w ) { + u3j_rite_rewrite(&(pog_u->reg_u.rit_u[i_w])); + } +} + +/* _n_rewrite(): u3h_walk_with helper for u3n_rewrite_compact + */ +static void +_n_rewrite(u3_noun kev) +{ + u3n_prog* pog = u3to(u3n_prog, u3t(kev)); + _n_prog_rewrite(pog); +} + +/* u3n_rewrite_compact(): rewrite the bytecode cache for compaction. + */ +void +u3n_rewrite_compact() +{ + u3h_walk(u3R->byc.har_p, _n_rewrite); + + u3h_rewrite(u3R->byc.har_p); + u3R->byc.har_p = u3a_rewritten(u3R->byc.har_p); +} + + /* _n_feb(): u3h_walk helper for u3n_free */ static void diff --git a/pkg/urbit/noun/vortex.c b/pkg/urbit/noun/vortex.c index ad12ab404..65db02bae 100644 --- a/pkg/urbit/noun/vortex.c +++ b/pkg/urbit/noun/vortex.c @@ -326,3 +326,24 @@ u3v_mark(FILE* fil_u) tot_w += u3a_maid(fil_u, " wish cache", u3a_mark_noun(arv_u->yot)); return u3a_maid(fil_u, "total arvo stuff", tot_w); } + +/* u3v_rewrite_compact(): rewrite arvo kernel for compaction. +*/ +void +u3v_rewrite_compact() +{ + u3v_arvo* arv_u = &(u3H->arv_u); + + u3a_rewrite_noun(arv_u->roc); + u3a_rewrite_noun(arv_u->now); + u3a_rewrite_noun(arv_u->wen); + u3a_rewrite_noun(arv_u->sen); + u3a_rewrite_noun(arv_u->yot); + + arv_u->roc = u3a_rewritten_noun(arv_u->roc); + arv_u->now = u3a_rewritten_noun(arv_u->now); + arv_u->wen = u3a_rewritten_noun(arv_u->wen); + arv_u->sen = u3a_rewritten_noun(arv_u->sen); + arv_u->yot = u3a_rewritten_noun(arv_u->yot); +} + diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index e18bae794..054c4c881 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -256,6 +256,10 @@ _serf_grab(u3_serf* sef_u) u3z(sef_u->sac); sef_u->sac = u3_nul; + + { + u3a_compact(); + } } } From c184752f8dd9ed0b0c8175570f9c9209f78b1fcc Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 6 Jul 2020 22:56:33 -0700 Subject: [PATCH 235/257] noun: clean up memory compaction --- pkg/urbit/include/noun/jets.h | 10 ---- pkg/urbit/noun/allocate.c | 22 ++++++++- pkg/urbit/noun/events.c | 2 +- pkg/urbit/noun/hashtable.c | 60 ++++++++++++------------ pkg/urbit/noun/jets.c | 86 ++++------------------------------- pkg/urbit/noun/nock.c | 46 +++++-------------- pkg/urbit/worker/main.c | 6 +++ pkg/urbit/worker/serf.c | 4 -- 8 files changed, 76 insertions(+), 160 deletions(-) diff --git a/pkg/urbit/include/noun/jets.h b/pkg/urbit/include/noun/jets.h index 214376d76..3381facab 100644 --- a/pkg/urbit/include/noun/jets.h +++ b/pkg/urbit/include/noun/jets.h @@ -287,16 +287,6 @@ c3_w u3j_mark(FILE* fil_u); - /* u3j_rite_rewrite(): rewrite u3j_rite for compaction. - */ - void - u3j_rite_rewrite(u3j_rite* rit_u); - - /* u3j_site_rewrite(): rewrite u3j_site for compaction. - */ - void - u3j_site_rewrite(u3j_site* sit_u); - /* u3j_rewrite_compact(): rewrite jet state for compaction. */ void diff --git a/pkg/urbit/noun/allocate.c b/pkg/urbit/noun/allocate.c index 06096d2c0..d5aff71f3 100644 --- a/pkg/urbit/noun/allocate.c +++ b/pkg/urbit/noun/allocate.c @@ -2231,12 +2231,20 @@ u3a_sweep(void) void u3a_compact(void) { - sleep(10); + // sleep(10); // in case you need to attach a debugger + + /* Note if u3m_reclaim changes to not reclaim something, or if other + * things are added to the loom, they will need to be added to the + * tracing step + */ u3m_reclaim(); + assert(c3y == u3a_is_north(u3R)); u3_post box_p = _(u3a_is_north(u3R)) ? u3R->rut_p : u3R->hat_p; u3_post end_p = _(u3a_is_north(u3R)) ? u3R->hat_p : u3R->rut_p; + fprintf(stderr, "compact: sweep 1 beginning\r\n"); + /* Sweep through arena, recording new address * * Don't trace to preserve memory locality @@ -2311,6 +2319,7 @@ u3a_compact(void) c3_w i_w; if ( new_w > box_w ) { fprintf(stderr, "compact: whoa new_w %p, i_w %d\r\n", new_w, i_w); + c3_assert(0); } for ( i_w = 0; i_w < siz_w - 1; i_w++ ) { new_w[i_w] = box_w[i_w]; @@ -2321,7 +2330,6 @@ u3a_compact(void) box_w += siz_w; } - fprintf(stderr, "compact: box_w %lx new_w %lx\r\n", u3a_outa(box_w), u3a_outa(new_w)); } fprintf(stderr, "compact: sweep 2 complete\r\n"); @@ -2341,10 +2349,20 @@ u3a_compact(void) u3n_ream(); + fprintf(stderr, "compact: running |mass to verify correct compaction\r\n"); u3m_mark(stderr); fprintf(stderr, "compact: marked\r\n"); u3a_sweep(); fprintf(stderr, "compact: swept\r\n"); + c3_w lid_w = u3a_idle(u3R); + if ( 0 == lid_w ) { + fprintf(stderr, "free lists: B/0\r\n"); + } + else { + u3a_print_memory(stderr, "free lists", u3a_idle(u3R)); + } + + fprintf(stderr, "compact: done\r\n"); } } diff --git a/pkg/urbit/noun/events.c b/pkg/urbit/noun/events.c index 8bae1891d..86162741d 100644 --- a/pkg/urbit/noun/events.c +++ b/pkg/urbit/noun/events.c @@ -148,7 +148,7 @@ u3e_fault(void* adr_v, c3_i ser_i) if ( 0 != (u3P.dit_w[blk_w] & (1 << bit_w)) ) { fprintf(stderr, "strange page: %d, at %p, off %x\r\n", pag_w, adr_w, off_w); - // c3_assert(0); + c3_assert(0); return 0; } diff --git a/pkg/urbit/noun/hashtable.c b/pkg/urbit/noun/hashtable.c index e57c47be9..1838c8945 100644 --- a/pkg/urbit/noun/hashtable.c +++ b/pkg/urbit/noun/hashtable.c @@ -913,7 +913,35 @@ _ch_mark_node(u3h_node* han_u, c3_w lef_w) return tot_w; } -// XXX reorg +/* u3h_mark(): mark hashtable for gc. +*/ +c3_w +u3h_mark(u3p(u3h_root) har_p) +{ + c3_w tot_w = 0; + u3h_root* har_u = u3to(u3h_root, har_p); + c3_w i_w; + + for ( i_w = 0; i_w < 64; i_w++ ) { + c3_w sot_w = har_u->sot_w[i_w]; + + if ( _(u3h_slot_is_noun(sot_w)) ) { + u3_noun kev = u3h_slot_to_noun(sot_w); + + tot_w += u3a_mark_noun(kev); + } + else if ( _(u3h_slot_is_node(sot_w)) ) { + u3h_node* han_u = u3h_slot_to_node(sot_w); + + tot_w += _ch_mark_node(han_u, 25); + } + } + + tot_w += u3a_mark_ptr(har_u); + + return tot_w; +} + /* _ch_rewrite_buck(): rewrite buck for compaction. */ void @@ -964,36 +992,6 @@ _ch_rewrite_node(u3h_node* han_u, c3_w lef_w) } } - -/* u3h_mark(): mark hashtable for gc. -*/ -c3_w -u3h_mark(u3p(u3h_root) har_p) -{ - c3_w tot_w = 0; - u3h_root* har_u = u3to(u3h_root, har_p); - c3_w i_w; - - for ( i_w = 0; i_w < 64; i_w++ ) { - c3_w sot_w = har_u->sot_w[i_w]; - - if ( _(u3h_slot_is_noun(sot_w)) ) { - u3_noun kev = u3h_slot_to_noun(sot_w); - - tot_w += u3a_mark_noun(kev); - } - else if ( _(u3h_slot_is_node(sot_w)) ) { - u3h_node* han_u = u3h_slot_to_node(sot_w); - - tot_w += _ch_mark_node(han_u, 25); - } - } - - tot_w += u3a_mark_ptr(har_u); - - return tot_w; -} - /* u3h_rewrite(): rewrite pointers during compaction. */ void diff --git a/pkg/urbit/noun/jets.c b/pkg/urbit/noun/jets.c index aaadd2ce5..ad1d6bbd7 100644 --- a/pkg/urbit/noun/jets.c +++ b/pkg/urbit/noun/jets.c @@ -2339,88 +2339,20 @@ u3j_mark(FILE* fil_u) return u3a_maid(fil_u, "total jet stuff", tot_w); } -/* _cj_fink_rewrite(): rewrite a u3j_fink for compaction. -*/ -static void -_cj_fink_rewrite(u3j_fink* fin_u) -{ - if ( c3n == u3a_rewrite_ptr(fin_u) ) return; - c3_w i_w; - u3a_rewrite_noun(fin_u->sat); - fin_u->sat = u3a_rewritten_noun(fin_u->sat); - - for ( i_w = 0; i_w < fin_u->len_w; ++i_w ) { - u3j_fist* fis_u = &(fin_u->fis_u[i_w]); - u3a_rewrite_noun(fis_u->bat); - u3a_rewrite_noun(fis_u->pax); - fis_u->bat = u3a_rewritten_noun(fis_u->bat); - fis_u->pax = u3a_rewritten_noun(fis_u->pax); - } -} - -/* u3j_rite_rewrite(): rewrite u3j_rite for compaction. -*/ -void -u3j_rite_rewrite(u3j_rite* rit_u) -{ - if ( (c3y == rit_u->own_o) && u3_none != rit_u->clu ) { - u3a_rewrite_noun(rit_u->clu); - _cj_fink_rewrite(u3to(u3j_fink, rit_u->fin_p)); - rit_u->clu = u3a_rewritten_noun(rit_u->clu); - rit_u->fin_p = u3a_rewritten(rit_u->fin_p); - } -} - -/* u3j_site_rewrite(): rewrite u3j_site for compaction. -*/ -void -u3j_site_rewrite(u3j_site* sit_u) -{ - u3a_rewrite_noun(sit_u->axe); - sit_u->axe = u3a_rewritten_noun(sit_u->axe); - - if ( u3_none != sit_u->bat ) { - u3a_rewrite_noun(sit_u->bat); - sit_u->bat = u3a_rewritten_noun(sit_u->bat); - } - if ( u3_none != sit_u->bas ) { - u3a_rewrite_noun(sit_u->bas); - sit_u->bas = u3a_rewritten_noun(sit_u->bas); - } - if ( u3_none != sit_u->loc ) { - u3a_rewrite_noun(sit_u->loc); - u3a_rewrite_noun(sit_u->lab); - sit_u->loc = u3a_rewritten_noun(sit_u->loc); - sit_u->lab = u3a_rewritten_noun(sit_u->lab); - if ( c3y == sit_u->fon_o ) { - _cj_fink_rewrite(u3to(u3j_fink, sit_u->fin_p)); - sit_u->fin_p = u3a_rewritten(sit_u->fin_p); - } - } -} - -/* _cj_rewrite_hank(): rewrite hank cache for compaction. -*/ -static void -_cj_rewrite_hank(u3_noun kev) -{ - _cj_hank* han_u = u3to(_cj_hank, u3t(kev)); - if ( c3n == u3a_rewrite_ptr(han_u) ) return; - if ( u3_none != han_u->hax ) { - u3a_rewrite_noun(han_u->hax); - u3j_site_rewrite(&(han_u->sit_u)); - - han_u->hax = u3a_rewritten_noun(han_u->hax); - } -} - /* u3j_rewrite_compact(): rewrite jet state for compaction. + * + * NB: u3R->jed.han_p *must* be cleared (currently via u3m_reclaim) + * since it contains hanks which are not nouns but have loom pointers. + * Alternately, rewrite the entries with u3h_walk, using u3j_mark as a + * template for how to walk. There's an untested attempt at this in git + * history at e8a307a. + * + * bas_p is also cleared in u3m_reclaim, but I think it would be + * rewritten just fine. */ void u3j_rewrite_compact() { - u3h_walk(u3R->jed.han_p, _cj_rewrite_hank); - u3h_rewrite(u3R->jed.war_p); u3h_rewrite(u3R->jed.cod_p); u3h_rewrite(u3R->jed.han_p); diff --git a/pkg/urbit/noun/nock.c b/pkg/urbit/noun/nock.c index 6a449d6ad..19a7f1f37 100644 --- a/pkg/urbit/noun/nock.c +++ b/pkg/urbit/noun/nock.c @@ -2597,46 +2597,22 @@ u3n_mark(FILE* fil_u) return u3a_maid(fil_u, "total nock stuff", bam_w + har_w); } -/* _n_prog_rewrite(): rewrite program for compaction. -*/ -static void -_n_prog_rewrite(u3n_prog* pog_u) -{ - c3_w i_w; - - for ( i_w = 0; i_w < pog_u->lit_u.len_w; ++i_w ) { - u3a_rewrite_noun(pog_u->lit_u.non[i_w]); - } - - for ( i_w = 0; i_w < pog_u->mem_u.len_w; ++i_w ) { - u3a_rewrite_noun(pog_u->mem_u.sot_u[i_w].key); - } - - for ( i_w = 0; i_w < pog_u->cal_u.len_w; ++i_w ) { - u3j_site_rewrite(&(pog_u->cal_u.sit_u[i_w])); - } - - for ( i_w = 0; i_w < pog_u->reg_u.len_w; ++i_w ) { - u3j_rite_rewrite(&(pog_u->reg_u.rit_u[i_w])); - } -} - -/* _n_rewrite(): u3h_walk_with helper for u3n_rewrite_compact - */ -static void -_n_rewrite(u3_noun kev) -{ - u3n_prog* pog = u3to(u3n_prog, u3t(kev)); - _n_prog_rewrite(pog); -} - /* u3n_rewrite_compact(): rewrite the bytecode cache for compaction. + * + * NB: u3R->byc.har_p *must* be cleared (currently via u3m_reclaim, + * which calls u3n_free) since it contains things that look like nouns + * but aren't. Specifically, it contains "cells" where the tail is a + * pointer to a u3a_malloc'ed block that contains loom pointers. + * + * You should be able to walk this with u3h_walk and rewrite the + * pointers, but you need to be careful to handle that u3a_malloc + * pointers can't be turned into a box by stepping back two words. You + * must step back one word to get the padding, step then step back that + * many more words (plus one?). */ void u3n_rewrite_compact() { - u3h_walk(u3R->byc.har_p, _n_rewrite); - u3h_rewrite(u3R->byc.har_p); u3R->byc.har_p = u3a_rewritten(u3R->byc.har_p); } diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index bdc9f39b5..e5d47c96d 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -188,6 +188,12 @@ main(c3_i argc, c3_c* argv[]) u3C.slog_f = _newt_send_slog; } + if (u3_Host.ops_u.hap_w == 1337) { + u3a_compact(); + u3e_save(); + return 0; + } + // start serf // { diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 054c4c881..e18bae794 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -256,10 +256,6 @@ _serf_grab(u3_serf* sef_u) u3z(sef_u->sac); sef_u->sac = u3_nul; - - { - u3a_compact(); - } } } From 7ded3f127c19469d63a62a837a7460b2308ead5b Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 15 Jul 2020 12:33:54 -0700 Subject: [PATCH 236/257] noun: don't add identical values to song_x_cape's hashtable We were unconditionally adding equal items to the hashtable of already-compared pointers. This table exists so that if we've already determined two non-pointer-equal nouns are value-equal, we don't have to check them again. However, atoms (especially direct) ended up in this hashtable even though we don't look those up. This makes sure we don't add items to the hashtable if they're "pointer"-equal (which for direct atoms is value-equal). The impact of this inefficiency was greatly magnified by the issue with +mug where (mug a a) = (mug b b) for all a, b. For this reason, these identical pairs added to the hashtable always had the same mug, so they were added to the same bucket, which meant adding to that list required linearly traversing the entire bucket. This was the first barrier that was causing |pack to take a long time on ships which distribute OTAs, but it isn't a complete solution for |pack. --- pkg/urbit/noun/retrieve.c | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/noun/retrieve.c b/pkg/urbit/noun/retrieve.c index f7f32e19d..341fe5ea3 100644 --- a/pkg/urbit/noun/retrieve.c +++ b/pkg/urbit/noun/retrieve.c @@ -373,11 +373,13 @@ _song_x_cape(c3_ys mov, c3_ys off, // we cons [a] and [b] as posts so that we don't // touch their reference counts. // - key = u3nc(u3a_to_off(a), u3a_to_off(b)); - u3t_off(euq_o); - u3h_put(har_p, key, c3y); - u3t_on(euq_o); - u3z(key); + if ( a != b ) { + key = u3nc(u3a_to_off(a), u3a_to_off(b)); + u3t_off(euq_o); + u3h_put(har_p, key, c3y); + u3t_on(euq_o); + u3z(key); + } fam = _eq_pop(mov, off); } From 406c86568900b7be0c2bea0239fe8806a7a0f010 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 16 Jul 2020 14:39:47 -0700 Subject: [PATCH 237/257] serf: fix incorrect structure in %peek response --- pkg/urbit/worker/serf.c | 51 +++++++++++++++++++++++------------------ 1 file changed, 29 insertions(+), 22 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index e18bae794..f3ae9e010 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -791,7 +791,7 @@ u3_serf_play(u3_serf* sef_u, c3_d eve_d, u3_noun lit) u3_noun u3_serf_peek(u3_serf* sef_u, c3_w mil_w, u3_noun sam) { - u3_noun wen, pat, gon, pro; + u3_noun wen, pat, pro; // stash the previous date and set current // @@ -805,31 +805,39 @@ u3_serf_peek(u3_serf* sef_u, c3_w mil_w, u3_noun sam) u3A->now = u3k(now); } - // XX incomplete interface, should pass [lyc] as well - // - gon = u3m_soft(mil_w, u3v_peek, u3k(pat)); - // read succeeded, produce result - // - if ( u3_blip == u3h(gon) ) { - if ( u3_nul == gon ) { - pro = u3nc(c3__done, u3_nul); + { + u3_noun tag, dat; + + // XX incomplete interface, should pass [lyc] as well + // + u3_noun gon = u3m_soft(mil_w, u3v_peek, u3k(pat)); + u3x_cell(gon, &tag, &dat); + + // read succeeded, produce result + // + if ( u3_blip == tag ) { + if ( u3_nul == dat ) { + pro = u3nc(c3__done, u3_nul); + } + else { + // prepend the %noun mark + // + // XX incomplete interface, should recv mark from arvo + // + pro = u3nq(c3__done, u3_nul, c3__noun, u3k(u3t(dat))); + } + + u3z(gon); } + // read failed, produce trace + // + // NB, reads should *not* fail deterministically + // else { - // prepend the %noun mark - // - // XX incomplete interface, should recv mark from arvo - // - pro = u3nq(c3__done, u3_nul, c3__noun, u3k(u3t(gon))); + pro = u3nc(c3__bail, gon); } } - // read failed, produce trace - // - // NB, reads should *not* fail deterministically - // - else { - pro = u3nc(c3__bail, u3k(gon)); - } // restore the previous date // @@ -838,7 +846,6 @@ u3_serf_peek(u3_serf* sef_u, c3_w mil_w, u3_noun sam) u3z(u3A->now); u3A->now = wen; - u3z(gon); u3z(sam); return u3nc(c3__peek, pro); } From dc518607d9e04c4f6db20f6fc81db223abd40257 Mon Sep 17 00:00:00 2001 From: Brendan Hay Date: Mon, 8 Jun 2020 10:49:39 +0200 Subject: [PATCH 238/257] build: add pthread dependency to LDFLAGS libuv has a dependency on pthread which doesn't seem to get picked up through any other configure steps. The errors returned during linking are: libuv.a(libuv_la-thread.o): undefined reference to symbol 'pthread_rwlock_trywrlock@@GLIBC_2.2.5' libpthread.so.0: error adding symbols: DSO missing from command line --- pkg/urbit/configure | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/urbit/configure b/pkg/urbit/configure index 1cf80c972..f0f8f1e0d 100755 --- a/pkg/urbit/configure +++ b/pkg/urbit/configure @@ -6,7 +6,7 @@ URBIT_VERSION="0.10.7" deps=" \ curl gmp sigsegv argon2 ed25519 ent h2o scrypt uv murmur3 secp256k1 \ - softfloat3 ssl crypto z lmdb ge-additions aes_siv \ + softfloat3 ssl crypto z lmdb ge-additions aes_siv pthread \ " headers=" \ From 4794029b9cca288f1545e75581dfdcfa88607c9f Mon Sep 17 00:00:00 2001 From: Brendan Hay Date: Mon, 8 Jun 2020 10:23:29 +0200 Subject: [PATCH 239/257] u3: fix format-truncation errors in GCC 8 --- pkg/urbit/noun/events.c | 6 +++--- pkg/urbit/noun/trace.c | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/pkg/urbit/noun/events.c b/pkg/urbit/noun/events.c index 86162741d..b010fd13e 100644 --- a/pkg/urbit/noun/events.c +++ b/pkg/urbit/noun/events.c @@ -883,9 +883,9 @@ static c3_o _ce_image_move(u3e_image* img_u, c3_o bak_o) { c3_c old_c[8193]; - c3_c new_c[8193]; - snprintf(old_c, 8192, "%s/.urb/chk/%s.bin", u3P.dir_c, img_u->nam_c); - snprintf(new_c, 8192, "%s.bak", old_c); + c3_c new_c[8197]; + snprintf(old_c, 8193, "%s/.urb/chk/%s.bin", u3P.dir_c, img_u->nam_c); + snprintf(new_c, 8197, "%s.bak", old_c); c3_i ret_i; diff --git a/pkg/urbit/noun/trace.c b/pkg/urbit/noun/trace.c index 1350adc0e..f8fe81320 100644 --- a/pkg/urbit/noun/trace.c +++ b/pkg/urbit/noun/trace.c @@ -285,8 +285,8 @@ u3t_trace_open(c3_c* dir_c) mkdir(fil_c, 0700); } - c3_c lif_c[2048]; - snprintf(lif_c, 2048, "%s/%d.json", fil_c, u3_Host.tra_u.fun_w); + c3_c lif_c[2056]; + snprintf(lif_c, 2056, "%s/%d.json", fil_c, u3_Host.tra_u.fun_w); u3_Host.tra_u.fil_u = fopen(lif_c, "w"); u3_Host.tra_u.nid_w = (int)getpid(); From 6fb743bb4c1442ca1268cf89abcb80dbbf79d910 Mon Sep 17 00:00:00 2001 From: Brendan Hay Date: Mon, 8 Jun 2020 10:24:04 +0200 Subject: [PATCH 240/257] serf: fix format-truncation errors in GCC 8 --- pkg/urbit/worker/serf.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index f3ae9e010..d40c53547 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -220,8 +220,8 @@ _serf_grab(u3_serf* sef_u) mkdir(nam_c, 0700); } - c3_c man_c[2048]; - snprintf(man_c, 2048, "%s/%s-serf.txt", nam_c, wen_c); + c3_c man_c[2054]; + snprintf(man_c, 2053, "%s/%s-serf.txt", nam_c, wen_c); fil_u = fopen(man_c, "w"); fprintf(fil_u, "%s\r\n", wen_c); @@ -603,7 +603,7 @@ u3_noun u3_serf_work(u3_serf* sef_u, c3_w mil_w, u3_noun job) { c3_t tac_t = ( 0 != u3_Host.tra_u.fil_u ); - c3_c lab_c[2048]; + c3_c lab_c[2056]; u3_noun pro; // XX refactor tracing @@ -615,7 +615,7 @@ u3_serf_work(u3_serf* sef_u, c3_w mil_w, u3_noun job) { c3_c* cad_c = u3m_pretty(cad); c3_c* wir_c = u3m_pretty_path(wir); - snprintf(lab_c, 2048, "work [%s %s]", wir_c, cad_c); + snprintf(lab_c, 2056, "work [%s %s]", wir_c, cad_c); c3_free(cad_c); c3_free(wir_c); } @@ -870,8 +870,8 @@ _serf_writ_live_exit(c3_w cod_w) mkdir(nam_c, 0700); } - c3_c man_c[2048]; - snprintf(man_c, 2048, "%s/%s.txt", nam_c, wen_c); + c3_c man_c[2054]; + snprintf(man_c, 2053, "%s/%s.txt", nam_c, wen_c); fil_u = fopen(man_c, "w"); From 4136ab432961ea31b82b3a9548197d49a9bcbae0 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Fri, 17 Jul 2020 12:53:39 -0700 Subject: [PATCH 241/257] vere: replaces "irrelevant" uses of strncpy --- pkg/urbit/vere/io/cttp.c | 6 +----- pkg/urbit/vere/io/unix.c | 14 +++++++------- pkg/urbit/vere/walk.c | 3 ++- 3 files changed, 10 insertions(+), 13 deletions(-) diff --git a/pkg/urbit/vere/io/cttp.c b/pkg/urbit/vere/io/cttp.c index 691278b3a..5c6e3eae0 100644 --- a/pkg/urbit/vere/io/cttp.c +++ b/pkg/urbit/vere/io/cttp.c @@ -850,12 +850,8 @@ _cttp_creq_connect(u3_creq* ceq_u) // set hostname for TLS handshake if ( ceq_u->hot_c && c3y == ceq_u->sec ) { - c3_w len_w = 1 + strlen(ceq_u->hot_c); - c3_c* hot_c = c3_malloc(len_w); - strncpy(hot_c, ceq_u->hot_c, len_w); - c3_free(ceq_u->cli_u->ssl.server_name); - ceq_u->cli_u->ssl.server_name = hot_c; + ceq_u->cli_u->ssl.server_name = strdup(ceq_u->hot_c); } _cttp_creq_fire(ceq_u); diff --git a/pkg/urbit/vere/io/unix.c b/pkg/urbit/vere/io/unix.c index 9376d4671..debca0c83 100644 --- a/pkg/urbit/vere/io/unix.c +++ b/pkg/urbit/vere/io/unix.c @@ -108,9 +108,9 @@ _unix_down(c3_c* pax_c, c3_c* sub_c) c3_w sub_w = strlen(sub_c); c3_c* don_c = c3_malloc(pax_w + sub_w + 2); - strncpy(don_c, pax_c, pax_w); + strcpy(don_c, pax_c); don_c[pax_w] = '/'; - strncpy(don_c + pax_w + 1, sub_c, sub_w); + strcpy(don_c + pax_w + 1, sub_c); don_c[pax_w + 1 + sub_w] = '\0'; return don_c; @@ -666,9 +666,9 @@ _unix_create_dir(u3_udir* dir_u, u3_udir* par_u, u3_noun nam) c3_w pax_w = strlen(par_u->pax_c); c3_c* pax_c = c3_malloc(pax_w + 1 + nam_w + 1); - strncpy(pax_c, par_u->pax_c, pax_w); + strcpy(pax_c, par_u->pax_c); pax_c[pax_w] = '/'; - strncpy(pax_c + pax_w + 1, nam_c, nam_w); + strcpy(pax_c + pax_w + 1, nam_c); pax_c[pax_w + 1 + nam_w] = '\0'; c3_free(nam_c); @@ -1111,11 +1111,11 @@ _unix_sync_file(u3_unix* unx_u, u3_udir* par_u, u3_noun nam, u3_noun ext, u3_nou c3_w ext_w = strlen(ext_c); c3_c* pax_c = c3_malloc(par_w + 1 + nam_w + 1 + ext_w + 1); - strncpy(pax_c, par_u->pax_c, par_w); + strcpy(pax_c, par_u->pax_c); pax_c[par_w] = '/'; - strncpy(pax_c + par_w + 1, nam_c, nam_w); + strcpy(pax_c + par_w + 1, nam_c); pax_c[par_w + 1 + nam_w] = '.'; - strncpy(pax_c + par_w + 1 + nam_w + 1, ext_c, ext_w); + strcpy(pax_c + par_w + 1 + nam_w + 1, ext_c); pax_c[par_w + 1 + nam_w + 1 + ext_w] = '\0'; c3_free(nam_c); c3_free(ext_c); diff --git a/pkg/urbit/vere/walk.c b/pkg/urbit/vere/walk.c index 5ed14b016..892636a93 100644 --- a/pkg/urbit/vere/walk.c +++ b/pkg/urbit/vere/walk.c @@ -115,7 +115,8 @@ _walk_mkdirp(c3_c* bas_c, u3_noun pax) len_w = 1 + fas_w + pax_w; pax_c = c3_malloc(1 + len_w); - strncpy(pax_c, bas_c, len_w); + strcpy(pax_c, bas_c); + pax_c[fas_w] = '/'; waq_y = (void*)(1 + pax_c + fas_w); u3r_bytes(0, pax_w, waq_y, u3h(pax)); From 69eeb6309efdeea8c56d06e600aebd0044255244 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 21 Jul 2020 14:09:47 -0700 Subject: [PATCH 242/257] vere: fixes driver exit in u3_pier_bail() --- pkg/urbit/vere/pier.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index ec7668990..fb2c220a9 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -1666,7 +1666,9 @@ u3_pier_bail(u3_pier* pir_u) // exig i/o drivers // - if ( pir_u->wok_u ) { + if ( (u3_psat_work == pir_u->sat_e) + && pir_u->wok_u ) + { _pier_work_close(pir_u->wok_u); pir_u->wok_u = 0; } From 2994e0e44e9e43faf2c2e67418e5785a6bcdbb34 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 21 Jul 2020 14:08:49 -0700 Subject: [PATCH 243/257] vere: wires |pack to new compaction; renames old |pack to |cram --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 16 +++++---- pkg/urbit/include/c/motes.h | 1 + pkg/urbit/include/vere/serf.h | 4 +-- pkg/urbit/include/vere/vere.h | 15 ++++---- pkg/urbit/vere/lord.c | 27 ++++++++++---- pkg/urbit/vere/pier.c | 30 ++++++++-------- pkg/urbit/worker/main.c | 2 +- pkg/urbit/worker/serf.c | 37 +++++++++++++------- 8 files changed, 81 insertions(+), 51 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index f8d8b4d47..418284b58 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -19,9 +19,10 @@ +$ gang (unit (set ship)) +$ writ $% $: %live - $% [%exit cod=@] + $% [%cram eve=@] + [%exit cod=@] [%save eve=@] - [%pack eve=@] + [%pack ~] == == [%peek mil=@ now=@da lyc=gang pat=path] [%play eve=@ lit=(list ?((pair @da ovum) *))] @@ -107,7 +108,8 @@ data Serf = Serf data Live = LExit Atom -- exit status code | LSave EventId - | LPack EventId + | LCram EventId + | LPack () deriving (Show) data Play @@ -260,9 +262,9 @@ sendSnapshotRequest serf eve = do sendWrit serf (WLive $ LSave eve) recvLive serf -sendCompactionRequest :: Serf -> EventId -> IO () -sendCompactionRequest serf eve = do - sendWrit serf (WLive $ LPack eve) +sendCompactionRequest :: Serf -> IO () +sendCompactionRequest serf = do + sendWrit serf (WLive $ LPack ()) recvLive serf sendScryRequest :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) @@ -410,7 +412,7 @@ snapshot serf = withSerfLockIO serf $ \ss -> do -} compact :: Serf -> IO () compact serf = withSerfLockIO serf $ \ss -> do - sendCompactionRequest serf (ssLast ss) + sendCompactionRequest serf pure (ss, ()) {-| diff --git a/pkg/urbit/include/c/motes.h b/pkg/urbit/include/c/motes.h index 516b2d268..8f9f04013 100644 --- a/pkg/urbit/include/c/motes.h +++ b/pkg/urbit/include/c/motes.h @@ -248,6 +248,7 @@ # define c3__cow c3_s3('c','o','w') # define c3__cpu c3_s3('c','p','u') # define c3__crad c3_s4('c','r','a','d') +# define c3__cram c3_s4('c','r','a','m') # define c3__crap c3_s4('c','r','a','p') # define c3__cret c3_s4('c','r','e','t') # define c3__crib c3_s4('c','r','i','b') diff --git a/pkg/urbit/include/vere/serf.h b/pkg/urbit/include/vere/serf.h index b1a1fdde3..b931a761a 100644 --- a/pkg/urbit/include/vere/serf.h +++ b/pkg/urbit/include/vere/serf.h @@ -24,10 +24,10 @@ u3_noun u3_serf_init(u3_serf* sef_u); - /* u3_serf_unpack(): initialize from rock at [eve_d]. + /* u3_serf_uncram(): initialize from rock at [eve_d]. */ void - u3_serf_unpack(u3_serf* sef_u, c3_d eve_d); + u3_serf_uncram(u3_serf* sef_u, c3_d eve_d); /* u3_serf_writ(): apply writ [wit], producing plea [*pel] on c3y. */ diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index d86f21cd4..de8379d3b 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -398,8 +398,9 @@ u3_writ_peek = 1, u3_writ_play = 2, u3_writ_save = 3, - u3_writ_pack = 4, - u3_writ_exit = 5 + u3_writ_cram = 4, + u3_writ_pack = 5, + u3_writ_exit = 6 } u3_writ_type; /* u3_writ: ipc message from king to serf @@ -433,7 +434,7 @@ void (*work_done_f)(void*, u3_ovum*, u3_fact*, u3_gift*); void (*work_bail_f)(void*, u3_ovum*, u3_noun lud); void (*save_f)(void*); - void (*pack_f)(void*); + void (*cram_f)(void*); void (*bail_f)(void*); void (*exit_f)(void*); } u3_lord_cb; @@ -942,10 +943,10 @@ c3_o u3_lord_save(u3_lord* god_u); - /* u3_lord_pack(): save portable state. + /* u3_lord_cram(): save portable state. */ c3_o - u3_lord_pack(u3_lord* god_u); + u3_lord_cram(u3_lord* god_u); /* u3_lord_work(): attempt work. */ @@ -1215,10 +1216,10 @@ c3_o u3_pier_save(u3_pier* pir_u); - /* u3_pier_pack(): save a portable snapshot. + /* u3_pier_cram(): save a portable snapshot. */ c3_o - u3_pier_pack(u3_pier* pir_u); + u3_pier_cram(u3_pier* pir_u); /* u3_pier_info(): print status info. */ diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index ac1be4b8a..73d9e41af 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -25,9 +25,10 @@ :: +$ writ $% $: %live - $% [%exit cod=@] + $% [%cram eve=@] + [%exit cod=@] [%save eve=@] - [%pack eve=@] + [%pack ~] == == [%peek mil=@ now=@da lyc=gang pat=path] [%play eve=@ lit=(list ?((pair @da ovum) *))] @@ -108,6 +109,7 @@ _lord_writ_free(u3_writ* wit_u) } break; case u3_writ_save: + case u3_writ_cram: case u3_writ_pack: case u3_writ_exit: { } break; @@ -196,6 +198,7 @@ _lord_writ_str(u3_writ_type typ_e) case u3_writ_peek: return "peek"; case u3_writ_play: return "play"; case u3_writ_save: return "save"; + case u3_writ_cram: return "cram"; case u3_writ_pack: return "pack"; case u3_writ_exit: return "exit"; } @@ -258,8 +261,14 @@ _lord_plea_live(u3_lord* god_u, u3_noun dat) god_u->cb_u.save_f(god_u->cb_u.ptr_v); } break; + case u3_writ_cram: { + god_u->cb_u.cram_f(god_u->cb_u.ptr_v); + } break; + case u3_writ_pack: { - god_u->cb_u.pack_f(god_u->cb_u.ptr_v); + // XX wire into cb + // + u3l_log("pier: pack complete\n"); } break; } @@ -738,8 +747,12 @@ _lord_writ_jam(u3_lord* god_u, u3_writ* wit_u) msg = u3nt(c3__live, c3__save, u3i_chubs(1, &god_u->eve_d)); } break; + case u3_writ_cram: { + msg = u3nt(c3__live, c3__cram, u3i_chubs(1, &god_u->eve_d)); + } break; + case u3_writ_pack: { - msg = u3nt(c3__live, c3__pack, u3i_chubs(1, &god_u->eve_d)); + msg = u3nt(c3__live, c3__pack, u3_nul); } break; case u3_writ_exit: { @@ -938,17 +951,17 @@ u3_lord_save(u3_lord* god_u) } } -/* u3_lord_pack(): save portable state. +/* u3_lord_cram(): save portable state. */ c3_o -u3_lord_pack(u3_lord* god_u) +u3_lord_cram(u3_lord* god_u) { if ( god_u->dep_w ) { return c3n; } else { u3_writ* wit_u = _lord_writ_new(god_u); - wit_u->typ_e = u3_writ_pack; + wit_u->typ_e = u3_writ_cram; _lord_writ_plan(god_u, wit_u); return c3y; } diff --git a/pkg/urbit/vere/pier.c b/pkg/urbit/vere/pier.c index fb2c220a9..9c66b5315 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -597,8 +597,8 @@ _pier_play(u3_play* pay_u) // XX temporary hack // - u3l_log("pier: replay barrier reached, packing\r\n"); - u3_pier_pack(pir_u); + u3l_log("pier: replay barrier reached, cramming\r\n"); + u3_pier_cram(pir_u); } else if ( pay_u->eve_d == log_u->dun_d ) { _pier_work_init(pir_u); @@ -868,21 +868,21 @@ _pier_on_lord_save(void* ptr_v) // _pier_next(pir_u); } -/* _pier_on_lord_pack(): worker state-export complete (portable snapshot). +/* _pier_on_lord_cram(): worker state-export complete (portable snapshot). */ static void -_pier_on_lord_pack(void* ptr_v) +_pier_on_lord_cram(void* ptr_v) { u3_pier* pir_u = ptr_v; #ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): lord: pack\r\n", pir_u->god_u->eve_d); + fprintf(stderr, "pier: (%" PRIu64 "): lord: cram\r\n", pir_u->god_u->eve_d); #endif // XX temporary hack // if ( u3_psat_play == pir_u->sat_e ) { - u3l_log("pier: pack complete, shutting down\r\n"); + u3l_log("pier: cram complete, shutting down\r\n"); u3_pier_bail(pir_u); exit(0); } @@ -1189,7 +1189,7 @@ _pier_init(c3_w wag_w, c3_c* pax_c) .work_done_f = _pier_on_lord_work_done, .work_bail_f = _pier_on_lord_work_bail, .save_f = _pier_on_lord_save, - .pack_f = _pier_on_lord_pack, + .cram_f = _pier_on_lord_cram, .bail_f = _pier_on_lord_bail, .exit_f = _pier_on_lord_exit }; @@ -1469,33 +1469,33 @@ u3_pier_save(u3_pier* pir_u) } static void -_pier_pack_cb(void* ptr_v, c3_d eve_d) +_pier_cram_cb(void* ptr_v, c3_d eve_d) { u3_pier* pir_u = ptr_v; #ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): snap: send at %" PRIu64 "\r\n", pir_u->god_u->eve_d, eve_d); + fprintf(stderr, "pier: (%" PRIu64 "): cram: send at %" PRIu64 "\r\n", pir_u->god_u->eve_d, eve_d); #endif - u3_lord_pack(pir_u->god_u); + u3_lord_cram(pir_u->god_u); } -/* u3_pier_pack(): save a portable snapshot. +/* u3_pier_cram(): save a portable snapshot. */ c3_o -u3_pier_pack(u3_pier* pir_u) +u3_pier_cram(u3_pier* pir_u) { #ifdef VERBOSE_PIER - fprintf(stderr, "pier: (%" PRIu64 "): snap: plan\r\n", pir_u->god_u->eve_d); + fprintf(stderr, "pier: (%" PRIu64 "): cram: plan\r\n", pir_u->god_u->eve_d); #endif if ( u3_psat_play == pir_u->sat_e ) { - u3_lord_pack(pir_u->god_u); + u3_lord_cram(pir_u->god_u); return c3y; } if ( u3_psat_work == pir_u->sat_e ) { - _pier_wall_plan(pir_u, 0, pir_u, _pier_pack_cb); + _pier_wall_plan(pir_u, 0, pir_u, _pier_cram_cb); return c3y; } diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index e5d47c96d..c7895a8cd 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -175,7 +175,7 @@ main(c3_i argc, c3_c* argv[]) u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); if ( eve_d ) { - u3_serf_unpack(&u3V, eve_d); + u3_serf_uncram(&u3V, eve_d); } } diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index e18bae794..315f7e05f 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -31,9 +31,10 @@ :: +$ writ $% $: %live - $% [%exit cod=@] + $% [%cram eve=@] + [%exit cod=@] [%save eve=@] - [%pack eve=@] + [%pack ~] == == [%peek mil=@ now=@da lyc=gang pat=path] [%play eve=@ lit=(list ?((pair @da ovum) *))] @@ -274,10 +275,10 @@ _serf_static_grab(void) fflush(stderr); } -/* _serf_pack(): deduplicate and compact memory +/* _serf_cram(): deduplicate and compact memory. ORPHANED */ static void -_serf_pack(u3_serf* sef_u) +_serf_cram(u3_serf* sef_u) { _serf_static_grab(); @@ -288,7 +289,7 @@ _serf_pack(u3_serf* sef_u) return; } - u3_serf_unpack(sef_u, sef_u->dun_d); + u3_serf_uncram(sef_u, sef_u->dun_d); u3l_log("serf (%" PRIu64 "): compacted loom\r\n", sef_u->dun_d); @@ -313,7 +314,7 @@ u3_serf_post(u3_serf* sef_u) } if ( c3y == sef_u->pac_o ) { - _serf_pack(sef_u); + u3a_compact(); sef_u->pac_o = c3n; } } @@ -907,7 +908,6 @@ c3_o u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) { u3_noun tag, dat; - c3_o ret_o; // refcounts around snapshots require special handling // @@ -938,9 +938,9 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) return c3y; } - // NB: the %pack $writ only saves the rock, it doesn't load it + // NB: the %cram $writ only saves the rock, it doesn't load it // - case c3__pack: { + case c3__cram: { c3_d eve_d; if ( c3n == u3r_safe_chub(dat, &eve_d) ) { @@ -951,7 +951,7 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) u3z(com); if( eve_d != sef_u->dun_d ) { - fprintf(stderr, "serf (%" PRIu64 "): pack failed: %" PRIu64 "\r\n", + fprintf(stderr, "serf (%" PRIu64 "): cram failed: %" PRIu64 "\r\n", sef_u->dun_d, eve_d); return c3n; @@ -970,6 +970,19 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) return c3y; } + case c3__pack: { + if ( u3_nul != dat ) { + u3z(com); + return c3n; + } + else { + u3z(com); + u3a_compact(); + *ret = u3nc(c3__live, u3_nul); + return c3y; + } + } + case c3__save: { c3_d eve_d; @@ -1095,10 +1108,10 @@ _serf_ripe(u3_serf* sef_u) return u3nc(u3i_chubs(1, &sef_u->dun_d), sef_u->mug_l); } -/* u3_serf_unpack(): initialize from rock at [eve_d]. +/* u3_serf_uncram(): initialize from rock at [eve_d]. */ void -u3_serf_unpack(u3_serf* sef_u, c3_d eve_d) +u3_serf_uncram(u3_serf* sef_u, c3_d eve_d) { c3_o roc_o; c3_c nam_c[8193]; From 7d243771c0a1cc5afbbe73c0b162418670735815 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 21 Jul 2020 14:23:21 -0700 Subject: [PATCH 244/257] serf: restores autopack in response to memory pressure --- pkg/urbit/worker/serf.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 315f7e05f..55f12da8c 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -393,10 +393,12 @@ _serf_sure_feck(u3_serf* sef_u, c3_w pre_w, u3_noun vir) if ( (pre_w > low_w) && !(pos_w > low_w) ) { // XX set flag(s) in u3V so we don't repeat endlessly? // + pac_o = c3y; rec_o = c3y; pri = 1; } else if ( (pre_w > hig_w) && !(pos_w > hig_w) ) { + pac_o = c3y; rec_o = c3y; pri = 0; } From a580f964166cd41bd618529a5982b8d84c2ac4e6 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Tue, 21 Jul 2020 16:53:45 -0700 Subject: [PATCH 245/257] serf: adds subcommands to urbit-worker --- pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs | 2 +- pkg/urbit/include/vere/serf.h | 5 + pkg/urbit/vere/lord.c | 17 +- pkg/urbit/worker/main.c | 239 ++++++++++++++++--- pkg/urbit/worker/serf.c | 14 +- 5 files changed, 223 insertions(+), 54 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs index 418284b58..3b0d5b140 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -305,7 +305,7 @@ start (Config exePax pierPath flags onSlog onStdr onDead) = do config = show (compileFlags flags) rock = "0" -- XX support loading from rock cache = "50000" -- XX support memo-cache size - args = [pierPath, diskKey, config, cache, rock] + args = ["serf", pierPath, diskKey, config, cache, rock] pSpec = (proc exePax args) { std_in = CreatePipe , std_out = CreatePipe , std_err = CreatePipe diff --git a/pkg/urbit/include/vere/serf.h b/pkg/urbit/include/vere/serf.h index b931a761a..12647dbb6 100644 --- a/pkg/urbit/include/vere/serf.h +++ b/pkg/urbit/include/vere/serf.h @@ -58,3 +58,8 @@ */ void u3_serf_post(u3_serf* sef_u); + + /* u3_serf_grab(): garbage collect. + */ + void + u3_serf_grab(void); diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c index 73d9e41af..fef5584c5 100644 --- a/pkg/urbit/vere/lord.c +++ b/pkg/urbit/vere/lord.c @@ -1066,7 +1066,7 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) // spawn new process and connect to it // { - c3_c* arg_c[7]; + c3_c* arg_c[8]; c3_c key_c[256]; c3_c wag_c[11]; c3_c hap_c[11]; @@ -1083,21 +1083,22 @@ u3_lord_init(c3_c* pax_c, c3_w wag_w, c3_d key_d[4], u3_lord_cb cb_u) sprintf(hap_c, "%u", u3_Host.ops_u.hap_w); arg_c[0] = god_u->bin_c; // executable - arg_c[1] = god_u->pax_c; // path to checkpoint directory - arg_c[2] = key_c; // disk key - arg_c[3] = wag_c; // runtime config - arg_c[4] = hap_c; // hash table size + arg_c[1] = "serf"; // protocol + arg_c[2] = god_u->pax_c; // path to checkpoint directory + arg_c[3] = key_c; // disk key + arg_c[4] = wag_c; // runtime config + arg_c[5] = hap_c; // hash table size if ( u3_Host.ops_u.roc_c ) { // XX validate // - arg_c[5] = u3_Host.ops_u.roc_c; + arg_c[6] = u3_Host.ops_u.roc_c; } else { - arg_c[5] = "0"; + arg_c[6] = "0"; } - arg_c[6] = 0; + arg_c[7] = 0; uv_pipe_init(u3L, &god_u->inn_u.pyp_u, 0); uv_timer_init(u3L, &god_u->out_u.tim_u); diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index c7895a8cd..60558aff1 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -26,51 +26,51 @@ static u3_serf u3V; // one serf per process static u3_moat inn_u; // input stream static u3_mojo out_u; // output stream -/* _newt_fail(): failure stub. +/* _cw_serf_fail(): failure stub. */ static void -_newt_fail(void* vod_p, const c3_c* wut_c) +_cw_serf_fail(void* vod_p, const c3_c* wut_c) { fprintf(stderr, "serf: fail: %s\r\n", wut_c); exit(1); } -/* _newt_send(): send plea back to daemon. +/* _cw_serf_send(): send plea back to daemon. */ static void -_newt_send(u3_noun pel) +_cw_serf_send(u3_noun pel) { u3_newt_write(&out_u, u3ke_jam(pel)); } -/* _newt_send_slog(): send hint output (hod is [priority tank]). +/* _cw_serf_send_slog(): send hint output (hod is [priority tank]). */ static void -_newt_send_slog(u3_noun hod) +_cw_serf_send_slog(u3_noun hod) { - _newt_send(u3nc(c3__slog, hod)); + _cw_serf_send(u3nc(c3__slog, hod)); } -/* _newt_send_stdr(): send stderr output +/* _cw_serf_send_stdr(): send stderr output */ static void -_newt_send_stdr(c3_c* str_c) +_cw_serf_send_stdr(c3_c* str_c) { - _newt_send_slog(u3nc(0, u3i_string(str_c))); + _cw_serf_send_slog(u3nc(0, u3i_string(str_c))); } -/* _newt_writ(): +/* _cw_serf_writ(): */ static void -_newt_writ(void* vod_p, u3_noun mat) +_cw_serf_writ(void* vod_p, u3_noun mat) { u3_noun ret; if ( c3n == u3_serf_writ(&u3V, u3ke_cue(mat), &ret) ) { - _newt_fail(0, "bad jar"); + _cw_serf_fail(0, "bad jar"); } else { - _newt_send(ret); + _cw_serf_send(ret); // all references must now be counted, and all roots recorded // @@ -78,10 +78,10 @@ _newt_writ(void* vod_p, u3_noun mat) } } -/* main(): main() when run as urbit-worker +/* _cw_serf_stdio(): fix up std io handles */ -c3_i -main(c3_i argc, c3_c* argv[]) +static void +_cw_serf_stdio(c3_i* inn_i, c3_i* out_i) { // the serf is spawned with [FD 0] = events and [FD 1] = effects // we dup [FD 0 & 1] so we don't accidently use them for something else @@ -89,22 +89,34 @@ main(c3_i argc, c3_c* argv[]) // we replace [FD 1] (stdout) with a dup of [FD 2] (stderr) // c3_i nul_i = open("/dev/null", O_RDWR, 0); - c3_i inn_i = dup(0); - c3_i out_i = dup(1); + + *inn_i = dup(0); + *out_i = dup(1); + dup2(nul_i, 0); dup2(2, 1); - close(nul_i); - c3_assert( 6 == argc ); + close(nul_i); +} + +/* _cw_serf_commence(); initialize and run serf +*/ +static void +_cw_serf_commence(c3_i argc, c3_c* argv[]) +{ + c3_i inn_i, out_i; + _cw_serf_stdio(&inn_i, &out_i); + + c3_assert( 7 == argc ); uv_loop_t* lup_u = uv_default_loop(); - c3_c* dir_c = argv[1]; - c3_c* key_c = argv[2]; - c3_c* wag_c = argv[3]; - c3_c* hap_c = argv[4]; + c3_c* dir_c = argv[2]; + c3_c* key_c = argv[3]; + c3_c* wag_c = argv[4]; + c3_c* hap_c = argv[5]; c3_d eve_d = 0; - if ( 1 != sscanf(argv[5], "%" PRIu64 "", &eve_d) ) { + if ( 1 != sscanf(argv[6], "%" PRIu64 "", &eve_d) ) { fprintf(stderr, "serf: rock: invalid number '%s'\r\n", argv[4]); } @@ -160,13 +172,13 @@ main(c3_i argc, c3_c* argv[]) // set up writing // out_u.ptr_v = &u3V; - out_u.bal_f = _newt_fail; + out_u.bal_f = _cw_serf_fail; // set up reading // inn_u.ptr_v = &u3V; - inn_u.pok_f = _newt_writ; - inn_u.bal_f = _newt_fail; + inn_u.pok_f = _cw_serf_writ; + inn_u.bal_f = _cw_serf_fail; // setup loom // @@ -184,20 +196,14 @@ main(c3_i argc, c3_c* argv[]) // XX must be after u3m_boot due to u3l_log // { - u3C.stderr_log_f = _newt_send_stdr; - u3C.slog_f = _newt_send_slog; - } - - if (u3_Host.ops_u.hap_w == 1337) { - u3a_compact(); - u3e_save(); - return 0; + u3C.stderr_log_f = _cw_serf_send_stdr; + u3C.slog_f = _cw_serf_send_slog; } // start serf // { - _newt_send(u3_serf_init(&u3V)); + _cw_serf_send(u3_serf_init(&u3V)); } // start reading @@ -207,6 +213,163 @@ main(c3_i argc, c3_c* argv[]) // enter loop // uv_run(lup_u, UV_RUN_DEFAULT); +} + +/* _cw_info(); print pier info +*/ +static void +_cw_info(c3_i argc, c3_c* argv[]) +{ + c3_assert( 3 <= argc ); + + c3_c* dir_c = argv[2]; + c3_d eve_d = u3m_boot(dir_c); + + fprintf(stderr, "urbit-worker: %s at event %" PRIu64 "\r\n", dir_c, eve_d); +} + +/* _cw_grab(); gc pier. +*/ +static void +_cw_grab(c3_i argc, c3_c* argv[]) +{ + c3_assert( 3 <= argc ); + + c3_c* dir_c = argv[2]; + u3m_boot(dir_c); + u3_serf_grab(); +} + +/* _cw_cram(); jam persistent state (rock), and exit. +*/ +static void +_cw_cram(c3_i argc, c3_c* argv[]) +{ + c3_assert( 3 <= argc ); + + c3_c* dir_c = argv[2]; + c3_d eve_d = u3m_boot(dir_c); + + fprintf(stderr, "urbit-worker: cram: preparing\r\n"); + + if ( c3n == u3m_rock_stay(dir_c, eve_d) ) { + fprintf(stderr, "urbit-worker: cram: unable to jam state\r\n"); + exit(1); + } + + fprintf(stderr, "urbit-worker: cram: rock saved at event %" PRIu64 "\r\n", eve_d); +} + +/* _cw_queu(); cue rock, save, and exit. +*/ +static void +_cw_queu(c3_i argc, c3_c* argv[]) +{ + c3_assert( 4 <= argc ); + + c3_c* dir_c = argv[2]; + c3_c* eve_c = argv[3]; + c3_d eve_d; + + if ( 1 != sscanf(eve_c, "%" PRIu64 "", &eve_d) ) { + fprintf(stderr, "urbit-worker: queu: invalid number '%s'\r\n", eve_c); + exit(1); + } + else { + fprintf(stderr, "urbit-worker: queu: preparing\r\n"); + + memset(&u3V, 0, sizeof(u3V)); + u3V.dir_c = strdup(dir_c); + u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); + u3_serf_uncram(&u3V, eve_d); + u3e_save(); + + fprintf(stderr, "urbit-worker: queu: rock loaded at event %" PRIu64 "\r\n", eve_d); + } +} + +/* _cw_pack(); compact memory, save, and exit. +*/ +static void +_cw_pack(c3_i argc, c3_c* argv[]) +{ + c3_assert( 3 <= argc ); + + c3_c* dir_c = argv[2]; + + u3m_boot(dir_c); + u3a_compact(); + u3e_save(); +} + +/* _cw_usage(): print urbit-worker usage. +*/ +static void +_cw_usage(c3_i argc, c3_c* argv[]) +{ + fprintf(stderr, + "\rurbit-worker usage:\n" + " print pier info:\n" + " %s info \n\n" + " gc persistent state:\n" + " %s grab \n\n" + " compact persistent state:\n" + " %s pack \n\n" + " jam persistent state:\n" + " %s cram \n\n" + " cue persistent state:\n" + " %s queu \n\n" + " run as a 'serf':\n" + " %s serf \n", + argv[0], argv[0], argv[0], argv[0], argv[0], argv[0]); +} + +/* main(): main() when run as urbit-worker +*/ +c3_i +main(c3_i argc, c3_c* argv[]) +{ + // urbit-worker commands and positional arguments, by analogy + // + // $@ ~ ;; usage + // $% [%cram dir=@t] + // [%queu dir=@t eve=@ud] + // [%pack dir=@t] + // [%serf dir=@t key=@t wag=@t hap=@ud eve=@ud] + // == + // + // NB: don't print to anything other than stderr; + // other streams may have special requirements (in the case of "serf") + // + if ( 2 > argc ) { + _cw_usage(argc, argv); + exit(1); + } + else { + if ( 0 == strcmp("serf", argv[1]) ) { + _cw_serf_commence(argc, argv); + } + else if ( 0 == strcmp("info", argv[1]) ) { + _cw_info(argc, argv); + } + else if ( 0 == strcmp("grab", argv[1]) ) { + _cw_grab(argc, argv); + } + else if ( 0 == strcmp("cram", argv[1]) ) { + _cw_cram(argc, argv); + } + else if ( 0 == strcmp("queu", argv[1]) ) { + _cw_queu(argc, argv); + } + else if ( 0 == strcmp("pack", argv[1]) ) { + _cw_pack(argc, argv); + } + else { + fprintf(stderr, "unknown command '%s'\r\n", argv[1]); + _cw_usage(argc, argv); + exit(1); + } + } return 0; } diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 55f12da8c..8dd1ddb80 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -260,10 +260,10 @@ _serf_grab(u3_serf* sef_u) } } -/* _serf_static_grab(): garbage collect, checking for profiling. RETAIN. +/* u3_serf_grab(): garbage collect. */ -static void -_serf_static_grab(void) +void +u3_serf_grab(void) { c3_assert( u3R == &(u3H->rod_u) ); @@ -280,7 +280,7 @@ _serf_static_grab(void) static void _serf_cram(u3_serf* sef_u) { - _serf_static_grab(); + u3_serf_grab(); u3l_log("serf (%" PRIu64 "): compacting loom\r\n", sef_u->dun_d); @@ -293,7 +293,7 @@ _serf_cram(u3_serf* sef_u) u3l_log("serf (%" PRIu64 "): compacted loom\r\n", sef_u->dun_d); - _serf_static_grab(); + u3_serf_grab(); } /* u3_serf_post(): update serf state post-writ. @@ -966,7 +966,7 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) return c3n; } - _serf_static_grab(); + u3_serf_grab(); *ret = u3nc(c3__live, u3_nul); return c3y; @@ -1197,7 +1197,7 @@ u3_serf_init(u3_serf* sef_u) // if ( !(pen_w > (1 << 28)) ) { // fprintf(stderr, "\r\n"); // u3a_print_memory(stderr, "serf: contiguous free space", pen_w); - // _serf_static_grab(); + // u3_serf_grab(); // } // } From 565be3cad6aacd1767f1aea05849749519c02951 Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Tue, 21 Jul 2020 21:15:06 -0700 Subject: [PATCH 246/257] king: drop ames packets when >1k are unprocessed --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 30 ++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 471791bbd..f47740cc1 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -17,6 +17,14 @@ import Urbit.Vere.Ames.DNS (galaxyPort, resolvServ) import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ) +-- Constants ------------------------------------------------------------------- + +-- | How many unprocessed ames packets to allow in the queue before we stop +-- dropping incoming packets. +queueBound :: Word +queueBound = 1000 + + -- Types ----------------------------------------------------------------------- data AmesDrv = AmesDrv @@ -106,13 +114,31 @@ ames' -> (Text -> RIO e ()) -> RIO e ([Ev], RAcquire e (DriverApi NewtEf)) ames' who isFake stderr = do + -- Unfortunately, we cannot use TBQueue because the only behavior + -- provided for when full is to block the writer, and we want to + -- instead drop the incoming packet on the floor. The implementation + -- below uses materially the same data structures as TBQueue, however. ventQ :: TQueue EvErr <- newTQueueIO + avail :: TVar Word <- newTVarIO queueBound + let + enqueuePacket p = do + vail <- readTVar avail + if vail > 0 + then do + modifyTVar avail (subtract 1) + writeTQueue ventQ p + else pure () -- TODO debounced logging + dequeuePacket = do + pM <- tryReadTQueue ventQ + when (isJust pM) $ modifyTVar avail (+ 1) + pure pM + env <- ask - let (bornEvs, startDriver) = ames env who isFake (writeTQueue ventQ) stderr + let (bornEvs, startDriver) = ames env who isFake enqueuePacket stderr let runDriver = do diOnEffect <- startDriver - let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + let diEventSource = fmap RRWork <$> dequeuePacket pure (DriverApi {..}) pure (bornEvs, runDriver) From 3349ea511ff6c009bb62b4491f730254885cdbfb Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Tue, 21 Jul 2020 21:22:08 -0700 Subject: [PATCH 247/257] king: fix goshdarn typo --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index f47740cc1..57142bbed 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -19,7 +19,7 @@ import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ) -- Constants ------------------------------------------------------------------- --- | How many unprocessed ames packets to allow in the queue before we stop +-- | How many unprocessed ames packets to allow in the queue before we start -- dropping incoming packets. queueBound :: Word queueBound = 1000 From bbf0c512010380e2c8d8a5569bb80b181d164d2d Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 22 Jul 2020 21:52:42 -0700 Subject: [PATCH 248/257] u3: refactors u3m_reclaim() into noun modules, works on any road --- pkg/urbit/include/noun/allocate.h | 5 ++ pkg/urbit/include/noun/jets.h | 20 ++++---- pkg/urbit/include/noun/nock.h | 5 ++ pkg/urbit/include/noun/vortex.h | 5 ++ pkg/urbit/noun/allocate.c | 23 ++++++--- pkg/urbit/noun/jets.c | 82 ++++++++++++++++++------------- pkg/urbit/noun/manage.c | 42 ++-------------- pkg/urbit/noun/nock.c | 20 ++++++-- pkg/urbit/noun/vortex.c | 15 ++++++ 9 files changed, 127 insertions(+), 90 deletions(-) diff --git a/pkg/urbit/include/noun/allocate.h b/pkg/urbit/include/noun/allocate.h index 989891fba..1b1036799 100644 --- a/pkg/urbit/include/noun/allocate.h +++ b/pkg/urbit/include/noun/allocate.h @@ -465,6 +465,11 @@ c3_w u3a_mark_road(FILE* fil_u); + /* u3a_reclaim(): clear ad-hoc persistent caches to reclaim memory. + */ + void + u3a_reclaim(void); + /* u3a_rewrite_ptr(): mark a pointer as already having been rewritten */ c3_o diff --git a/pkg/urbit/include/noun/jets.h b/pkg/urbit/include/noun/jets.h index 3381facab..bc9b1e3b9 100644 --- a/pkg/urbit/include/noun/jets.h +++ b/pkg/urbit/include/noun/jets.h @@ -287,17 +287,17 @@ c3_w u3j_mark(FILE* fil_u); - /* u3j_rewrite_compact(): rewrite jet state for compaction. - */ - void - u3j_rewrite_compact(); - - /* u3j_free_hank(): free an entry from the hank cache. - */ - void - u3j_free_hank(u3_noun kev); - /* u3j_free(): free jet state. */ void u3j_free(void); + + /* u3j_reclaim(): clear ad-hoc persistent caches to reclaim memory. + */ + void + u3j_reclaim(void); + + /* u3j_rewrite_compact(): rewrite jet state for compaction. + */ + void + u3j_rewrite_compact(); diff --git a/pkg/urbit/include/noun/nock.h b/pkg/urbit/include/noun/nock.h index 3de1f1977..1e7c6430e 100644 --- a/pkg/urbit/include/noun/nock.h +++ b/pkg/urbit/include/noun/nock.h @@ -117,6 +117,11 @@ c3_w u3n_mark(FILE* fil_u); + /* u3n_reclaim(): clear ad-hoc persistent caches to reclaim memory. + */ + void + u3n_reclaim(void); + /* u3n_rewrite_compact(): rewrite bytecode cache for compaction. */ void diff --git a/pkg/urbit/include/noun/vortex.h b/pkg/urbit/include/noun/vortex.h index 4da1a135f..7dcab4e7e 100644 --- a/pkg/urbit/include/noun/vortex.h +++ b/pkg/urbit/include/noun/vortex.h @@ -104,6 +104,11 @@ c3_w u3v_mark(FILE* fil_u); + /* u3v_reclaim(): clear ad-hoc persistent caches to reclaim memory. + */ + void + u3v_reclaim(void); + /* u3v_rewrite_compact(): rewrite arvo kernel for compaction. */ void diff --git a/pkg/urbit/noun/allocate.c b/pkg/urbit/noun/allocate.c index d5aff71f3..5712c208a 100644 --- a/pkg/urbit/noun/allocate.c +++ b/pkg/urbit/noun/allocate.c @@ -374,10 +374,10 @@ u3a_reflux(void) } } -/* u3a_reclaim(): reclaim from memoization cache. +/* _ca_reclaim_half(): reclaim from memoization cache. */ -void -u3a_reclaim(void) +static void +_ca_reclaim_half(void) { // XX u3l_log avoid here, as it can // cause problems when handling errors @@ -435,7 +435,7 @@ _ca_willoc(c3_w len_w, c3_w ald_w, c3_w alp_w) // memory nearly empty; reclaim; should not be needed // - // if ( (u3a_open(u3R) + u3R->all.fre_w) < 65536 ) { u3a_reclaim(); } + // if ( (u3a_open(u3R) + u3R->all.fre_w) < 65536 ) { _ca_reclaim_half(); } box_u = _ca_box_make_hat(siz_w, ald_w, alp_w, 1); /* Flush a bunch of cell cache, then try again. @@ -447,7 +447,7 @@ _ca_willoc(c3_w len_w, c3_w ald_w, c3_w alp_w) return _ca_willoc(len_w, ald_w, alp_w); } else { - u3a_reclaim(); + _ca_reclaim_half(); return _ca_willoc(len_w, ald_w, alp_w); } } @@ -534,7 +534,7 @@ _ca_walloc(c3_w len_w, c3_w ald_w, c3_w alp_w) if ( 0 != ptr_v ) { break; } - u3a_reclaim(); + _ca_reclaim_half(); } return ptr_v; } @@ -1951,6 +1951,17 @@ u3a_mark_road(FILE* fil_u) return u3a_maid(fil_u, "total road stuff", tot_w); } +/* u3a_reclaim(): clear ad-hoc persistent caches to reclaim memory. +*/ +void +u3a_reclaim(void) +{ + // clear the memoization cache + // + u3h_free(u3R->cax.har_p); + u3R->cax.har_p = u3h_new(); +} + /* u3a_rewrite_compact(): rewrite pointers in ad-hoc persistent road structures. */ void diff --git a/pkg/urbit/noun/jets.c b/pkg/urbit/noun/jets.c index ad1d6bbd7..8a8682f61 100644 --- a/pkg/urbit/noun/jets.c +++ b/pkg/urbit/noun/jets.c @@ -2339,16 +2339,61 @@ u3j_mark(FILE* fil_u) return u3a_maid(fil_u, "total jet stuff", tot_w); } +/* _cj_free_hank(): free an entry from the hank cache. +*/ +static void +_cj_free_hank(u3_noun kev) +{ + _cj_hank* han_u = u3to(_cj_hank, u3t(kev)); + if ( u3_none != han_u->hax ) { + u3z(han_u->hax); + u3j_site_lose(&(han_u->sit_u)); + } + u3a_wfree(han_u); +} + +/* u3j_free(): free jet state. +*/ +void +u3j_free(void) +{ + u3h_walk(u3R->jed.han_p, _cj_free_hank); + u3h_free(u3R->jed.war_p); + u3h_free(u3R->jed.cod_p); + u3h_free(u3R->jed.han_p); + u3h_free(u3R->jed.bas_p); + if ( u3R == &(u3H->rod_u) ) { + u3h_free(u3R->jed.hot_p); + } +} + +/* u3j_reclaim(): clear ad-hoc persistent caches to reclaim memory. +*/ +void +u3j_reclaim(void) +{ + // re-establish the warm jet state + // + // XX might this reduce fragmentation? + // + // if ( &(u3H->rod_u) == u3R ) { + // u3j_ream(); + // } + + // clear the jet hank cache + // + u3h_walk(u3R->jed.han_p, _cj_free_hank); + u3h_free(u3R->jed.han_p); + u3R->jed.han_p = u3h_new(); +} + /* u3j_rewrite_compact(): rewrite jet state for compaction. * - * NB: u3R->jed.han_p *must* be cleared (currently via u3m_reclaim) + * NB: u3R->jed.han_p *must* be cleared (currently via u3j_reclaim above) * since it contains hanks which are not nouns but have loom pointers. * Alternately, rewrite the entries with u3h_walk, using u3j_mark as a * template for how to walk. There's an untested attempt at this in git * history at e8a307a. - * - * bas_p is also cleared in u3m_reclaim, but I think it would be - * rewritten just fine. */ void u3j_rewrite_compact() @@ -2368,32 +2413,3 @@ u3j_rewrite_compact() u3R->jed.han_p = u3a_rewritten(u3R->jed.han_p); u3R->jed.bas_p = u3a_rewritten(u3R->jed.bas_p); } - -/* u3j_free_hank(): free an entry from the hank cache. -*/ -void -u3j_free_hank(u3_noun kev) -{ - _cj_hank* han_u = u3to(_cj_hank, u3t(kev)); - if ( u3_none != han_u->hax ) { - u3z(han_u->hax); - u3j_site_lose(&(han_u->sit_u)); - } - u3a_wfree(han_u); -} - -/* u3j_free(): free jet state. -*/ -void -u3j_free(void) -{ - u3h_walk(u3R->jed.han_p, u3j_free_hank); - u3h_free(u3R->jed.war_p); - u3h_free(u3R->jed.cod_p); - u3h_free(u3R->jed.han_p); - u3h_free(u3R->jed.bas_p); - if ( u3R == &(u3H->rod_u) ) { - u3h_free(u3R->jed.hot_p); - } -} - diff --git a/pkg/urbit/noun/manage.c b/pkg/urbit/noun/manage.c index ec6cc2a70..5054e7960 100644 --- a/pkg/urbit/noun/manage.c +++ b/pkg/urbit/noun/manage.c @@ -1849,42 +1849,8 @@ u3m_wipe(void) void u3m_reclaim(void) { - c3_assert( &(u3H->rod_u) == u3R ); - - // clear the u3v_wish cache - // - // NB: this will leak if not on the home road - // - u3z(u3A->yot); - u3A->yot = u3_nul; - - // clear the memoization cache - // - u3h_free(u3R->cax.har_p); - u3R->cax.har_p = u3h_new(); - - // clear the jet battery hash cache - // - u3h_free(u3R->jed.bas_p); - u3R->jed.bas_p = u3h_new(); - - // re-establish the warm jet state - // - // XX might this reduce fragmentation? - // - // u3j_ream(); - - // clear the jet hank cache - // - u3h_walk(u3R->jed.han_p, u3j_free_hank); - u3h_free(u3R->jed.han_p); - u3R->jed.han_p = u3h_new(); - - // clear the bytecode cache - // - // We can't just u3h_free() -- the value is a post to a u3n_prog. - // Note that this requires that the hank cache also be freed. - // - u3n_free(); - u3R->byc.har_p = u3h_new(); + u3v_reclaim(); + u3j_reclaim(); + u3n_reclaim(); + u3a_reclaim(); } diff --git a/pkg/urbit/noun/nock.c b/pkg/urbit/noun/nock.c index 19a7f1f37..88d3d148d 100644 --- a/pkg/urbit/noun/nock.c +++ b/pkg/urbit/noun/nock.c @@ -2597,11 +2597,25 @@ u3n_mark(FILE* fil_u) return u3a_maid(fil_u, "total nock stuff", bam_w + har_w); } +/* u3n_reclaim(): clear ad-hoc persistent caches to reclaim memory. +*/ +void +u3n_reclaim(void) +{ + // clear the bytecode cache + // + // We can't just u3h_free() -- the value is a post to a u3n_prog. + // Note that the hank cache *must* also be freed (in u3j_reclaim()) + // + u3n_free(); + u3R->byc.har_p = u3h_new(); +} + /* u3n_rewrite_compact(): rewrite the bytecode cache for compaction. * - * NB: u3R->byc.har_p *must* be cleared (currently via u3m_reclaim, - * which calls u3n_free) since it contains things that look like nouns - * but aren't. Specifically, it contains "cells" where the tail is a + * NB: u3R->byc.har_p *must* be cleared (currently via u3n_reclaim above), + * since it contains things that look like nouns but aren't. + * Specifically, it contains "cells" where the tail is a * pointer to a u3a_malloc'ed block that contains loom pointers. * * You should be able to walk this with u3h_walk and rewrite the diff --git a/pkg/urbit/noun/vortex.c b/pkg/urbit/noun/vortex.c index 65db02bae..75351185d 100644 --- a/pkg/urbit/noun/vortex.c +++ b/pkg/urbit/noun/vortex.c @@ -327,6 +327,21 @@ u3v_mark(FILE* fil_u) return u3a_maid(fil_u, "total arvo stuff", tot_w); } +/* u3v_reclaim(): clear ad-hoc persistent caches to reclaim memory. +*/ +void +u3v_reclaim(void) +{ + // clear the u3v_wish cache + // + // NB: this would leak if not on the home road + // + if ( &(u3H->rod_u) == u3R ) { + u3z(u3A->yot); + u3A->yot = u3_nul; + } +} + /* u3v_rewrite_compact(): rewrite arvo kernel for compaction. */ void From d8db01a57b21223fdbc560c02c7049f592afb084 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 22 Jul 2020 22:20:03 -0700 Subject: [PATCH 249/257] u3: moves u3a_compact to u3m_pack, refactors internals --- pkg/urbit/include/noun/allocate.h | 20 +- pkg/urbit/include/noun/manage.h | 5 + pkg/urbit/noun/allocate.c | 313 ++++++++++++++++++------------ pkg/urbit/noun/manage.c | 40 ++++ pkg/urbit/worker/main.c | 7 +- pkg/urbit/worker/serf.c | 4 +- 6 files changed, 262 insertions(+), 127 deletions(-) diff --git a/pkg/urbit/include/noun/allocate.h b/pkg/urbit/include/noun/allocate.h index 1b1036799..ee95cc31e 100644 --- a/pkg/urbit/include/noun/allocate.h +++ b/pkg/urbit/include/noun/allocate.h @@ -470,6 +470,11 @@ void u3a_reclaim(void); + /* u3a_rewrite_compact(): rewrite pointers in ad-hoc persistent road structures. + */ + void + u3a_rewrite_compact(void); + /* u3a_rewrite_ptr(): mark a pointer as already having been rewritten */ c3_o @@ -490,11 +495,6 @@ u3_noun u3a_rewritten_noun(u3_noun som); - /* u3a_compact(): compact (north) road. - */ - void - u3a_compact(); - /* u3a_count_noun(): count size of noun. */ c3_w @@ -523,6 +523,16 @@ c3_w u3a_sweep(void); + /* u3a_pack_seek(): sweep the heap, modifying boxes to record new addresses. + */ + void + u3a_pack_seek(u3a_road* rod_u); + + /* u3a_pack_move(): sweep the heap, moving boxes to new addresses. + */ + void + u3a_pack_move(u3a_road* rod_u); + /* u3a_sane(): check allocator sanity. */ void diff --git a/pkg/urbit/include/noun/manage.h b/pkg/urbit/include/noun/manage.h index 3f8203b7c..a05ce7871 100644 --- a/pkg/urbit/include/noun/manage.h +++ b/pkg/urbit/include/noun/manage.h @@ -141,6 +141,11 @@ void u3m_reclaim(void); + /* u3m_pack: compact (defragment) memory. + */ + c3_w + u3m_pack(void); + /* u3m_rock_stay(): jam state into [dir_c] at [evt_d] */ c3_o diff --git a/pkg/urbit/noun/allocate.c b/pkg/urbit/noun/allocate.c index 5712c208a..48aeb4771 100644 --- a/pkg/urbit/noun/allocate.c +++ b/pkg/urbit/noun/allocate.c @@ -1965,7 +1965,7 @@ u3a_reclaim(void) /* u3a_rewrite_compact(): rewrite pointers in ad-hoc persistent road structures. */ void -u3a_rewrite_compact() +u3a_rewrite_compact(void) { u3a_rewrite_noun(u3R->ski.gul); u3a_rewrite_noun(u3R->bug.tax); @@ -2236,144 +2236,219 @@ u3a_sweep(void) return neg_w; } - -/* u3a_compact(): compact road. +/* u3a_pack_seek(): sweep the heap, modifying boxes to record new addresses. */ void -u3a_compact(void) +u3a_pack_seek(u3a_road* rod_u) { - // sleep(10); // in case you need to attach a debugger - - /* Note if u3m_reclaim changes to not reclaim something, or if other - * things are added to the loom, they will need to be added to the - * tracing step - */ - u3m_reclaim(); - - assert(c3y == u3a_is_north(u3R)); - u3_post box_p = _(u3a_is_north(u3R)) ? u3R->rut_p : u3R->hat_p; - u3_post end_p = _(u3a_is_north(u3R)) ? u3R->hat_p : u3R->rut_p; - - fprintf(stderr, "compact: sweep 1 beginning\r\n"); - - /* Sweep through arena, recording new address - * - * Don't trace to preserve memory locality - */ - { - u3_post new_p = c3_wiseof(u3a_box) + 1; - c3_w* box_w = u3a_into(box_p); - c3_w* end_w = u3a_into(end_p); + // the heap in [rod_u] is swept from "front" to "back". + // new locations are calculated for each in-use allocation box + // (simply the "deepest" linearly-available location), + // and stored in the box itself + // + // box_w: front of the heap + // end_w: back of the heap + // new_p: initial new location (data of first box) + // + c3_w* box_w = u3a_into(rod_u->rut_p); + c3_w* end_w = u3a_into(rod_u->hat_p); + u3_post new_p = (rod_u->rut_p + c3_wiseof(u3a_box)); + u3a_box* box_u; + c3_w siz_w; + if ( c3y == u3a_is_north(rod_u) ) { + // north roads are swept low to high + // + // new locations are recorded in the trailing size word + // while ( box_w < end_w ) { - u3a_box* box_u = (void *)box_w; + box_u = (void *)box_w; + siz_w = box_u->siz_w; - /* If not free, rewrite trailing size word to be new pointer. - * - * Another option would be to use the refcount and just - * regenerate it by tracing. - */ - if ( box_u->use_w > 0 ) { - //fprintf(stderr, "compact: found size %d at box_u %p, setting to new_p %x\r\n", box_u->siz_w, box_u, new_p); - box_w[box_u->siz_w - 1] = new_p; - new_p += box_u->siz_w; - //fprintf(stderr, "compact: adding to new_p %x\r\n", new_p); - } - - box_w += box_u->siz_w; - } - } - - fprintf(stderr, "compact: sweep 1 complete\r\n"); - - /* Trace through arena, rewriting pointers - * - * Don't sweep because it's ad-hoc polymorphic - */ - { - u3v_rewrite_compact(); - u3j_rewrite_compact(); - u3n_rewrite_compact(); - u3a_rewrite_compact(); - } - - fprintf(stderr, "compact: trace complete\r\n"); - - c3_w* new_w = (void*)u3a_botox(u3a_into(c3_wiseof(u3a_box) + 1)); - - /* Sweep through arena, moving nouns - * - * Don't trace because you need to move in order - */ - { - c3_w* box_w = u3a_into(box_p); - c3_w* end_w = u3a_into(end_p); - - while ( box_w < end_w ) { - u3a_box* old_u = (void *)box_w; - c3_w siz_w = old_u->siz_w; // store because we're about to overwrite - - /* Unmark if marked - */ - old_u->use_w &= 0x7fffffff; - - //fprintf(stderr, "compact: 364 == %d\r\n", *((c3_w*)0x200000364)); - //fprintf(stderr, "compact: found size %d at old_u %p\r\n", old_u->siz_w, old_u); - - - /* If not free, move to new home - */ - if ( old_u->use_w > 0 ) { - //fprintf(stderr, "compact: writing to %p from %p\r\n", u3a_botox(u3a_into(box_w[siz_w - 1])), box_w); - assert(new_w == (c3_w*)u3a_botox(u3a_into(box_w[siz_w - 1]))); - new_w = (c3_w*)u3a_botox(u3a_into(box_w[siz_w - 1])); - c3_w i_w; - if ( new_w > box_w ) { - fprintf(stderr, "compact: whoa new_w %p, i_w %d\r\n", new_w, i_w); - c3_assert(0); - } - for ( i_w = 0; i_w < siz_w - 1; i_w++ ) { - new_w[i_w] = box_w[i_w]; - } - new_w[siz_w - 1] = siz_w; - new_w += siz_w; + if ( box_u->use_w ) { + box_w[siz_w - 1] = new_p; + new_p += siz_w; } box_w += siz_w; } } + // XX untested! + // + else { + // south roads are swept high to low + // + // new locations are recorded in the leading size word + // + // since we traverse backward, [siz_w] holds the size of the next box, + // and we must initially offset to point to the head of the first box + // + siz_w = box_w[-1]; + box_w -= siz_w; + new_p -= siz_w; - fprintf(stderr, "compact: sweep 2 complete\r\n"); + while ( end_w < box_w ) { + box_u = (void *)box_w; + siz_w = box_w[-1]; - /* Set new end of heap. - */ + if ( box_u->use_w ) { + box_u->siz_w = new_p; + new_p -= siz_w; + } + + box_w -= siz_w; + } + } +} +static u3_post +_ca_pack_move_north(c3_w* box_w, c3_w* end_w, u3_post new_p) +{ + u3a_box* old_u; + c3_w siz_w; + + // relocate allocation boxes + // + // new locations have been recorded in the trailing size word, + // and are recalculated and asserted to ensure sanity + // + while ( box_w < end_w ) { + old_u = (void *)box_w; + siz_w = old_u->siz_w; + + old_u->use_w &= 0x7fffffff; + + if ( old_u->use_w ) { + c3_w* new_w = (void*)u3a_botox(u3a_into(new_p)); + + c3_assert( box_w[siz_w - 1] == new_p ); + + // note: includes leading size + // + if ( new_w < box_w ) { + c3_w i_w; + + for ( i_w = 0; i_w < siz_w - 1; i_w++ ) { + new_w[i_w] = box_w[i_w]; + } + } + else { + c3_assert( new_w == box_w ); + } + + // restore trailing size + // + new_w[siz_w - 1] = siz_w; + + new_p += siz_w; + } + + box_w += siz_w; + } + + return new_p; +} + +// XX untested! +// +static u3_post +_ca_pack_move_south(c3_w* box_w, c3_w* end_w, u3_post new_p) +{ + u3a_box* old_u; + c3_w siz_w; + c3_o yuz_o; + + // offset initial addresses (point to the head of the first box) + // + siz_w = box_w[-1]; + box_w -= siz_w; + new_p -= siz_w; + + // relocate allocation boxes + // + // new locations have been recorded in the leading size word, + // and are recalculated and asserted to ensure sanity + // + while ( 1 ) { + old_u = (void *)box_w; + + old_u->use_w &= 0x7fffffff; + + if ( old_u->use_w ) { + c3_w* new_w = (void*)u3a_botox(u3a_into(new_p)); + + c3_assert( old_u->siz_w == new_p ); + + // note: includes trailing size + // + if ( new_w > box_w ) { + c3_w i_w; + + for ( i_w = 1; i_w < siz_w; i_w++ ) { + new_w[i_w] = box_w[i_w]; + } + } + else { + c3_assert( new_w == box_w ); + } + + // restore leading size + // + new_w[0] = siz_w; + + yuz_o = c3y; + } + else { + yuz_o = c3n; + } + + // move backwards only if there is more work to be done + // + if ( box_w > end_w ) { + siz_w = box_w[-1]; + box_w -= siz_w; + + if ( c3y == yuz_o ) { + new_p -= siz_w; + } + } + else { + c3_assert( end_w == box_w ); + break; + } + } + + return new_p; +} + +/* u3a_pack_move(): sweep the heap, moving boxes to new addresses. +*/ +void +u3a_pack_move(u3a_road* rod_u) +{ + // box_w: front of the heap + // end_w: back of the heap + // new_p: initial new location (data of first box) + // las_p: newly calculated last location + // + c3_w* box_w = u3a_into(rod_u->rut_p); + c3_w* end_w = u3a_into(rod_u->hat_p); + u3_post new_p = (rod_u->rut_p + c3_wiseof(u3a_box)); + u3_post las_p = ( c3y == u3a_is_north(rod_u) ) + ? _ca_pack_move_north(box_w, end_w, new_p) + : _ca_pack_move_south(box_w, end_w, new_p); + + rod_u->hat_p = (las_p - c3_wiseof(u3a_box)); + + // clear free lists and cell allocator + // { - u3R->hat_p = u3a_outa(new_w); - c3_w i_w; for ( i_w = 0; i_w < u3a_fbox_no; i_w++ ) { u3R->all.fre_p[i_w] = 0; } - u3R->all.cel_p = 0; u3R->all.fre_w = 0; - - u3n_ream(); - - fprintf(stderr, "compact: running |mass to verify correct compaction\r\n"); - u3m_mark(stderr); - fprintf(stderr, "compact: marked\r\n"); - u3a_sweep(); - fprintf(stderr, "compact: swept\r\n"); - c3_w lid_w = u3a_idle(u3R); - if ( 0 == lid_w ) { - fprintf(stderr, "free lists: B/0\r\n"); - } - else { - u3a_print_memory(stderr, "free lists", u3a_idle(u3R)); - } - - fprintf(stderr, "compact: done\r\n"); + u3R->all.cel_p = 0; } } diff --git a/pkg/urbit/noun/manage.c b/pkg/urbit/noun/manage.c index 5054e7960..0711dbf9f 100644 --- a/pkg/urbit/noun/manage.c +++ b/pkg/urbit/noun/manage.c @@ -1854,3 +1854,43 @@ u3m_reclaim(void) u3n_reclaim(); u3a_reclaim(); } + +/* _cm_pack_rewrite(): trace through arena, rewriting pointers. +*/ +static void +_cm_pack_rewrite(void) +{ + // NB: these implementations must be kept in sync with u3m_reclaim(); + // anything not reclaimed must be rewritable + // + u3v_rewrite_compact(); + u3j_rewrite_compact(); + u3n_rewrite_compact(); + u3a_rewrite_compact(); +} + +/* u3m_pack: compact (defragment) memory. +*/ +c3_w +u3m_pack(void) +{ + c3_w pre_w = u3a_open(u3R); + + // reclaim first, to free space, and discard anything we can't/don't rewrite + // + u3m_reclaim(); + + // sweep the heap, finding and saving new locations + // + u3a_pack_seek(u3R); + + // trace roots, rewriting inner pointers + // + _cm_pack_rewrite(); + + // sweep the heap, relocating objects to their new locations + // + u3a_pack_move(u3R); + + return (u3a_open(u3R) - pre_w); +} diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index 60558aff1..95c04915b 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -298,7 +298,12 @@ _cw_pack(c3_i argc, c3_c* argv[]) c3_c* dir_c = argv[2]; u3m_boot(dir_c); - u3a_compact(); + + { + c3_w len_w = u3m_pack(); + u3a_print_memory(stderr, "urbit-worker: pack: gained", len_w); + } + u3e_save(); } diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 8dd1ddb80..142f2cbdf 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -314,7 +314,7 @@ u3_serf_post(u3_serf* sef_u) } if ( c3y == sef_u->pac_o ) { - u3a_compact(); + u3m_pack(); sef_u->pac_o = c3n; } } @@ -979,7 +979,7 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) } else { u3z(com); - u3a_compact(); + u3m_pack(); *ret = u3nc(c3__live, u3_nul); return c3y; } From eb2350c785629414a7eac19f7b9803022f891c6a Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Wed, 22 Jul 2020 22:43:28 -0700 Subject: [PATCH 250/257] serf: tweaks |pack and |mass printfs --- pkg/urbit/worker/main.c | 6 +----- pkg/urbit/worker/serf.c | 9 ++++++--- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index 95c04915b..7bc494e26 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -298,11 +298,7 @@ _cw_pack(c3_i argc, c3_c* argv[]) c3_c* dir_c = argv[2]; u3m_boot(dir_c); - - { - c3_w len_w = u3m_pack(); - u3a_print_memory(stderr, "urbit-worker: pack: gained", len_w); - } + u3a_print_memory(stderr, "urbit-worker: pack: gained", u3m_pack()); u3e_save(); } diff --git a/pkg/urbit/worker/serf.c b/pkg/urbit/worker/serf.c index 142f2cbdf..7d5b5922a 100644 --- a/pkg/urbit/worker/serf.c +++ b/pkg/urbit/worker/serf.c @@ -257,6 +257,8 @@ _serf_grab(u3_serf* sef_u) u3z(sef_u->sac); sef_u->sac = u3_nul; + + u3l_log("\n"); } } @@ -309,12 +311,13 @@ u3_serf_post(u3_serf* sef_u) // XX this runs on replay too, |mass s/b elsewhere // if ( c3y == sef_u->mut_o ) { - sef_u->mut_o = c3n; _serf_grab(sef_u); + sef_u->mut_o = c3n; } if ( c3y == sef_u->pac_o ) { - u3m_pack(); + u3a_print_memory(stderr, "serf: pack: gained", u3m_pack()); + u3l_log("\n"); sef_u->pac_o = c3n; } } @@ -979,7 +982,7 @@ u3_serf_live(u3_serf* sef_u, u3_noun com, u3_noun* ret) } else { u3z(com); - u3m_pack(); + u3a_print_memory(stderr, "serf: pack: gained", u3m_pack()); *ret = u3nc(c3__live, u3_nul); return c3y; } From 4c9cbb5d1907b9acebb31bed212efe02d45339b4 Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Wed, 22 Jul 2020 22:48:35 -0700 Subject: [PATCH 251/257] king: ames bounded q, now with logging and fifo --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 43 ++++++++++++++++++------ 1 file changed, 33 insertions(+), 10 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 57142bbed..6ef3986b4 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -6,8 +6,9 @@ module Urbit.Vere.Ames (ames, ames') where import Urbit.Prelude -import Network.Socket hiding (recvFrom, sendTo) -import Urbit.Arvo hiding (Fake) +import Control.Concurrent.STM.TVar (stateTVar) +import Network.Socket hiding (recvFrom, sendTo) +import Urbit.Arvo hiding (Fake) import Urbit.King.Config import Urbit.Vere.Pier.Types @@ -24,16 +25,26 @@ import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ) queueBound :: Word queueBound = 1000 +-- | How often, measured in number of packets dropped, we should announce packet +-- loss. +packetsDroppedPerComplaint :: Word +packetsDroppedPerComplaint = 1000 + -- Types ----------------------------------------------------------------------- data AmesDrv = AmesDrv { aTurfs :: TVar (Maybe [Turf]) + , aDropped :: TVar Word , aUdpServ :: UdpServ , aResolvr :: ResolvServ , aRecvTid :: Async () } +data PacketOutcome + = Intake + | Ouster + -- Utils ----------------------------------------------------------------------- @@ -127,7 +138,11 @@ ames' who isFake stderr = do then do modifyTVar avail (subtract 1) writeTQueue ventQ p - else pure () -- TODO debounced logging + pure Intake + else do + _ <- readTQueue ventQ + writeTQueue ventQ p + pure Ouster dequeuePacket = do pM <- tryReadTQueue ventQ when (isJust pM) $ modifyTVar avail (+ 1) @@ -161,7 +176,7 @@ ames => e -> Ship -> Bool - -> (EvErr -> STM ()) + -> (EvErr -> STM PacketOutcome) -> (Text -> RIO e ()) -> ([Ev], RAcquire e (NewtEf -> IO ())) ames env who isFake enqueueEv stderr = (initialEvents, runAmes) @@ -177,20 +192,28 @@ ames env who isFake enqueueEv stderr = (initialEvents, runAmes) drv <- mkRAcquire start stop pure (handleEffect drv mode) - start :: RIO e AmesDrv + start :: HasLogFunc e => RIO e AmesDrv start = do aTurfs <- newTVarIO Nothing + aDropped <- newTVarIO 0 aUdpServ <- udpServ isFake who - aRecvTid <- queuePacketsThread aUdpServ + aRecvTid <- queuePacketsThread aDropped aUdpServ aResolvr <- resolvServ aTurfs (usSend aUdpServ) stderr pure (AmesDrv { .. }) hearFailed _ = pure () - queuePacketsThread :: UdpServ -> RIO e (Async ()) - queuePacketsThread UdpServ {..} = async $ forever $ atomically $ do - (p, a, b) <- usRecv - enqueueEv (EvErr (hearEv p a b) hearFailed) + queuePacketsThread :: HasLogFunc e => TVar Word -> UdpServ -> RIO e (Async ()) + queuePacketsThread dropCtr UdpServ {..} = async $ forever $ do + outcome <- atomically $ do + (p, a, b) <- usRecv + enqueueEv (EvErr (hearEv p a b) hearFailed) + case outcome of + Intake -> pure () + Ouster -> do + d <- atomically $ stateTVar dropCtr (\d -> (d, d + 1)) + when (d `rem` packetsDroppedPerComplaint == 0) $ + logWarn "ames: queue full; dropping inbound packets" stop :: AmesDrv -> RIO e () stop AmesDrv {..} = io $ do From 8e14fb80869cafbcebab9f038677aada18d1da25 Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Wed, 22 Jul 2020 22:50:22 -0700 Subject: [PATCH 252/257] king: fix comment about ames q behavior --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 6ef3986b4..19387e813 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -126,8 +126,7 @@ ames' -> RIO e ([Ev], RAcquire e (DriverApi NewtEf)) ames' who isFake stderr = do -- Unfortunately, we cannot use TBQueue because the only behavior - -- provided for when full is to block the writer, and we want to - -- instead drop the incoming packet on the floor. The implementation + -- provided for when full is to block the writer. The implementation -- below uses materially the same data structures as TBQueue, however. ventQ :: TQueue EvErr <- newTQueueIO avail :: TVar Word <- newTVarIO queueBound From 7eddb89b7077d874682cb0956d5688ee69d75bec Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Wed, 22 Jul 2020 22:52:46 -0700 Subject: [PATCH 253/257] king: it was too clever of me to use stateTVar; compiler can't help --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 19387e813..fe1c6781e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -6,7 +6,6 @@ module Urbit.Vere.Ames (ames, ames') where import Urbit.Prelude -import Control.Concurrent.STM.TVar (stateTVar) import Network.Socket hiding (recvFrom, sendTo) import Urbit.Arvo hiding (Fake) import Urbit.King.Config @@ -210,7 +209,10 @@ ames env who isFake enqueueEv stderr = (initialEvents, runAmes) case outcome of Intake -> pure () Ouster -> do - d <- atomically $ stateTVar dropCtr (\d -> (d, d + 1)) + d <- atomically $ do + d <- readTVar dropCtr + writeTVar dropCtr (d + 1) + pure d when (d `rem` packetsDroppedPerComplaint == 0) $ logWarn "ames: queue full; dropping inbound packets" From 72cadc2b0a3add57d55b61f4c25ec2a3fe9ee435 Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 23 Jul 2020 00:01:04 -0700 Subject: [PATCH 254/257] u3: note that u3a_rewrit* doesn't yet support south roads --- pkg/urbit/noun/manage.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/pkg/urbit/noun/manage.c b/pkg/urbit/noun/manage.c index 0711dbf9f..c83d00605 100644 --- a/pkg/urbit/noun/manage.c +++ b/pkg/urbit/noun/manage.c @@ -1860,6 +1860,10 @@ u3m_reclaim(void) static void _cm_pack_rewrite(void) { + // XX fix u3a_rewrit* to support south roads + // + c3_assert( &(u3H->rod_u) == u3R ); + // NB: these implementations must be kept in sync with u3m_reclaim(); // anything not reclaimed must be rewritable // From 942e60670e2b84e5127879f189c8e571e5b8361c Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Thu, 23 Jul 2020 13:17:02 -0700 Subject: [PATCH 255/257] king: fix ames tests --- pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs | 2 +- pkg/hs/urbit-king/test/AmesTests.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index fe1c6781e..146389810 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -2,7 +2,7 @@ Ames IO Driver -} -module Urbit.Vere.Ames (ames, ames') where +module Urbit.Vere.Ames (ames, ames', PacketOutcome(..)) where import Urbit.Prelude diff --git a/pkg/hs/urbit-king/test/AmesTests.hs b/pkg/hs/urbit-king/test/AmesTests.hs index 3d9dce19d..6be3e5c8c 100644 --- a/pkg/hs/urbit-king/test/AmesTests.hs +++ b/pkg/hs/urbit-king/test/AmesTests.hs @@ -80,8 +80,8 @@ runGala runGala point = do env <- ask que <- newTQueueIO - let (_, runAmes) = - ames env (fromIntegral point) True (writeTQueue que) noStderr + let enqueue = \p -> writeTQueue que p $> Intake + let (_, runAmes) = ames env (fromIntegral point) True enqueue noStderr cb <- runAmes io (cb turfEf) pure (que, cb) From f87aa03d0b8a41a6531c4d2d1dec2248d5b0f5cc Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 23 Jul 2020 16:44:17 -0700 Subject: [PATCH 256/257] pill: updates all --- bin/brass.pill | 4 ++-- bin/ivory.pill | 4 ++-- bin/solid.pill | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/bin/brass.pill b/bin/brass.pill index cc8c83ed8..8e713c7d5 100644 --- a/bin/brass.pill +++ b/bin/brass.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:f738f60e9e028081864f317106f623d2f21a5fe5c2f6fdd83576e22d21a8c6a6 -size 14862847 +oid sha256:35d8930b9b35364605196d99766ec713154af9105ce7b9fabfaa50e8ca29a5fd +size 4448128 diff --git a/bin/ivory.pill b/bin/ivory.pill index 829304a93..29eeabbc5 100644 --- a/bin/ivory.pill +++ b/bin/ivory.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:9fbfbe75a6685df444621ebd27677716fd0abf7113020f3274c3b5c209e3616e -size 1304972 +oid sha256:e5c82dea80aa7c5593f43fa4294db7974211abceedd907663da73889857642e7 +size 1309381 diff --git a/bin/solid.pill b/bin/solid.pill index cb7466564..0ca93db1f 100644 --- a/bin/solid.pill +++ b/bin/solid.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:c9e3d43c56341c79dc3cbddbeddb0d6d86575d4a2871aeec2a9d80bf25b71c2d -size 16573103 +oid sha256:ecf3f8593815742e409008421f318b664124e672b1eecd131e4a1e49864a1c2a +size 6175676 From c96705e755f424e90887c656c452ada28797806b Mon Sep 17 00:00:00 2001 From: Joe Bryan Date: Thu, 23 Jul 2020 16:52:23 -0700 Subject: [PATCH 257/257] vere: bumps urbit version to v0.10.8 --- pkg/hs/urbit-king/package.yaml | 2 +- pkg/urbit/configure | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml index e786261e5..d1e8b6a77 100644 --- a/pkg/hs/urbit-king/package.yaml +++ b/pkg/hs/urbit-king/package.yaml @@ -1,5 +1,5 @@ name: urbit-king -version: 0.10.4 +version: 0.10.8 license: MIT license-file: LICENSE diff --git a/pkg/urbit/configure b/pkg/urbit/configure index f0f8f1e0d..6157fb544 100755 --- a/pkg/urbit/configure +++ b/pkg/urbit/configure @@ -2,7 +2,7 @@ set -e -URBIT_VERSION="0.10.7" +URBIT_VERSION="0.10.8" deps=" \ curl gmp sigsegv argon2 ed25519 ent h2o scrypt uv murmur3 secp256k1 \