diff --git a/.travis.yml b/.travis.yml index 0a575fc1c5..e9f7b659fc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,13 @@ +stages: + - compile + # Don't run the combine stage in pull requests, because deploy is disabled there. + - name: combine + if: type != pull_request + jobs: include: - - os: linux + - stage: compile + os: linux language: nix nix: 2.3.6 before_install: @@ -15,7 +22,8 @@ jobs: - make release - sh/ci-tests - - os: linux + - stage: compile + os: linux language: generic env: STACK_YAML=pkg/hs/stack.yaml cache: @@ -32,7 +40,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 @@ -50,6 +59,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/bin/brass.pill b/bin/brass.pill index cc8c83ed8b..8e713c7d5d 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 829304a932..29eeabbc5d 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 dbed55b1e0..0ca93db1fa 100644 --- a/bin/solid.pill +++ b/bin/solid.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:59786d78805460632c4de60275b994260d255be7b721ccf47140d7647a46e66c -size 6244195 +oid sha256:ecf3f8593815742e409008421f318b664124e672b1eecd131e4a1e49864a1c2a +size 6175676 diff --git a/nix/cachix/local.nix b/nix/cachix/local.nix index a1dac3150e..753a00a0cd 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/cachix/tests.nix b/nix/cachix/tests.nix new file mode 100644 index 0000000000..2248a5cea2 --- /dev/null +++ b/nix/cachix/tests.nix @@ -0,0 +1,7 @@ +let + ops = import ../ops/default.nix {}; +in + { + results = ops.test; + fakebus = ops.bus; + } diff --git a/nix/crossdeps.nix b/nix/crossdeps.nix index df2829fd9e..e942b842b6 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 cd945bceb0..6f7357b4f6 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 curl gmp scrypt libsigsegv openssl zlib lmdb ]; osx = with pkgs; @@ -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 b14746f1ad..8f44e75015 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 c726b58c5d..0000000000 --- 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 69d11152e5..0000000000 --- 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 506a5df63c..0000000000 --- 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/nixcrpkgs/pkgs.nix b/nix/nixcrpkgs/pkgs.nix index b083876700..2fb612a27c 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/nix/ops/boot-ship.nix b/nix/ops/boot-ship.nix index 2fb2ba2e79..b54a7a90ae 100644 --- a/nix/ops/boot-ship.nix +++ b/nix/ops/boot-ship.nix @@ -10,10 +10,10 @@ let tlon = import ../pkgs { inherit pkgs; }; arvo = tlon.arvo; urbit = tlon.urbit; - herb = tlon.herb; + herb = tlon.herb; in import ./fakeship { - inherit pkgs arvo pill ship herb urbit; + inherit pkgs arvo pill ship urbit herb; } diff --git a/nix/ops/default.nix b/nix/ops/default.nix index 64f8c67a74..d048d783ed 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 94736ad0f6..19ef10b87e 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/solid/builder.sh b/nix/ops/solid/builder.sh index 579266feda..f5b39a057f 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 diff --git a/nix/pkgs/default.nix b/nix/pkgs/default.nix index 8356f6eb8f..ba1129dd31 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 8a11072e2b..19befa1ef3 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 @@ -23,10 +23,10 @@ let deps = with pkgs; - [ curl gmp sigseg ncurses openssl zlib lmdb ]; + [ curl gmp sigseg 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 b42bbc8cf7..9d486f3dfd 100644 --- a/nix/pkgs/urbit/release.nix +++ b/nix/pkgs/urbit/release.nix @@ -12,11 +12,11 @@ let crossdeps = with env; - [ curl libgmp libsigsegv ncurses openssl zlib lmdb ]; + [ curl libgmp libsigsegv openssl zlib lmdb ]; 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 @@ -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 76b35040a0..4bff817e42 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/pkgs/urbit/shell.nix b/nix/pkgs/urbit/shell.nix index e603ba7284..dee99d9620 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/nix/release.nix b/nix/release.nix index f71589ea9a..2ccd1098bc 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/arvo/gen/solid.hoon b/pkg/arvo/gen/solid.hoon index 762f211e2b..7a26757ef6 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] :: diff --git a/pkg/hs/.gitignore b/pkg/hs/.gitignore new file mode 100644 index 0000000000..609770f0c7 --- /dev/null +++ b/pkg/hs/.gitignore @@ -0,0 +1 @@ +stack.yaml.lock diff --git a/pkg/hs/proto/package.yaml b/pkg/hs/proto/package.yaml index 046177079e..4427b11615 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/racquire/.gitignore b/pkg/hs/racquire/.gitignore new file mode 100644 index 0000000000..65e7ea8181 --- /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 0000000000..bf9294e05c --- /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 0000000000..36b562d11c --- /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 c18632ee35..74bad3fe51 100644 --- a/pkg/hs/stack.yaml +++ b/pkg/hs/stack.yaml @@ -3,10 +3,15 @@ resolver: lts-14.21 packages: - lmdb-static - proto + - racquire - terminal-progress-bar - urbit-atom - urbit-azimuth + - urbit-eventlog-lmdb - urbit-king + - urbit-termsize + - urbit-noun + - urbit-noun-core extra-deps: - flat-0.3.4@sha256:002a0e0ae656ea8cc02a772d0bcb6ea7dbd7f2e79070959cc748ad1e7138eb38 diff --git a/pkg/hs/urbit-eventlog-lmdb/.gitignore b/pkg/hs/urbit-eventlog-lmdb/.gitignore new file mode 100644 index 0000000000..65e7ea8181 --- /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 0000000000..bf9294e05c --- /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 82% rename from pkg/hs/urbit-king/lib/Urbit/Vere/Log.hs rename to pkg/hs/urbit-eventlog-lmdb/lib/Urbit/EventLog/LMDB.hs index 62dc7fe1d8..ed53db19c3 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 @@ -34,29 +58,29 @@ type Dbi = MDB_dbi type Cur = MDB_cursor data EventLog = EventLog - { env :: Env - , _metaTbl :: Dbi - , eventsTbl :: Dbi - , effectsTbl :: Dbi - , identity :: LogIdentity - , numEvents :: IORef EventId - } + { env :: Env + , _metaTbl :: Dbi + , eventsTbl :: Dbi + , effectsTbl :: Dbi + , identity :: LogIdentity + , numEvents :: TVar Word64 + } -nextEv :: EventLog -> RIO e EventId -nextEv = fmap succ . readIORef . numEvents +nextEv :: EventLog -> STM Word64 +nextEv = fmap (+1) . lastEv -lastEv :: EventLog -> RIO e EventId -lastEv = readIORef . numEvents +lastEv :: EventLog -> STM Word64 +lastEv = readTVar . numEvents data EventLogExn - = NoLogIdentity - | MissingEvent EventId - | BadNounInLogIdentity ByteString DecodeErr ByteString - | BadKeyInEventLog - | BadWriteLogIdentity LogIdentity - | BadWriteEvent EventId - | BadWriteEffect EventId - deriving Show + = NoLogIdentity + | MissingEvent Word64 + | BadNounInLogIdentity ByteString DecodeErr ByteString + | BadKeyInEventLog + | BadWriteLogIdentity LogIdentity + | BadWriteEvent Word64 + | BadWriteEffect Word64 + deriving Show -- Instances ------------------------------------------------------------------- @@ -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 @@ -82,7 +112,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 +128,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 +257,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 -> @@ -240,21 +270,20 @@ 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 -> Word64 -> 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 ----------------------------------------------------------------- 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,23 +291,21 @@ 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 - -> 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 + => 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 @@ -294,12 +321,12 @@ 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) - 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 0000000000..9e53f1a116 --- /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 new file mode 100644 index 0000000000..f1a292b859 --- /dev/null +++ b/pkg/hs/urbit-king/TODO.md @@ -0,0 +1,119 @@ +# New IPC Protocol + +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. +- [x] Handle `peek` and `pack` in `swimming` flow. +- [x] Documentation for `Urbit.Vere.Serf.IPC`. +- [x] Unstub slog/stder/dead callbacks on serf config. +- [x] Remove GoodParse hack in newRunCompute. +- [x] Bring back tank printing. +- [x] Handle serf stderr message correctly. +- [x] Bring back `logEvent`. +- [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. + +Bugs: + +- [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. +- [x] `king new` should reject pier directories that already exist. +- [x] In non-daemon-mode, ^D doesn't bring down Urbit properly. +- [x] Spinner updated multiple times with the same event, and this causes + logging of events to contain duplicates. + +King-Haskell specific features: + +- [x] Re-implement `collectFX` flow in Serf/Pier. +- [x] Hook up `collectFX` to CLI. +- [ ] Get `collect-all-fx` flow working again. + +Performance: + +- [x] Batching during replay. +- [x] Batching during normal operation. + +Optimization: + +- [x] IO Driver Event Prioritization + +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. +- [x] Logging for new IPC flow. +- [x] Logging for boot sequence. +- [x] Take snapshots on clean shutdown. + +# Misc Bugs + +- [ ] `king run --collect-fx` flag does nothing. Remove or implement. +- [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 + 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? + + +# 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 + +- [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]`. + 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`?) + +# Polish + +- [x] Goot logging output in non-verbose mode. +- [x] Command-Line flag to re-enable verbose output. + + +# Cleanup + +- [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. +- [x] Spin off `racquire` into it's own package. +- [x] Spin off `urbit-noun-core` and `urbit-noun` packages. +- [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` diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs index 49a8ce914e..1b0b4ad4b3 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/Effect.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs index e5c9be1595..606539907a 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) @@ -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 @@ -203,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 23e4aca164..39df141e13 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 @@ -350,6 +357,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 ----------------------------------------------------------- {- @@ -374,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/API.hs b/pkg/hs/urbit-king/lib/Urbit/King/API.hs index 0851309951..adba475509 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 @@ -12,7 +19,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 +50,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 +72,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 +93,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 edef869b59..bd8b6b1a53 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/App.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/App.hs @@ -2,139 +2,192 @@ Code for setting up the RIO environment. -} module Urbit.King.App - ( App - , runApp - , runAppLogFile - , runAppNoLog - , runPierApp - , HasConfigDir(..) - , HasStderrLogFunc(..) - ) where + ( KingEnv + , runKingEnvStderr + , runKingEnvLogFile + , runKingEnvNoLog + , kingEnvKillSignal + , killKingActionL + , onKillKingSigL + , PierEnv + , runPierEnv + , killPierActionL + , onKillPierSigL + , HasStderrLogFunc(..) + , HasKingId(..) + , HasProcId(..) + , HasKingEnv(..) + , HasPierEnv(..) + , module Urbit.King.Config + ) +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) +import Urbit.King.App.Class (HasStderrLogFunc(..)) --------------------------------------------------------------------------------- -class HasConfigDir a where - configDirL ∷ Lens' a FilePath +-- KingEnv --------------------------------------------------------------------- -class HasStderrLogFunc a where - stderrLogFuncL :: Lens' a LogFunc +class HasKingId a where + kingIdL :: Lens' a Word16 --------------------------------------------------------------------------------- +class HasProcId a where + procIdL :: Lens' a Int32 -data App = App - { _appLogFunc :: !LogFunc - , _appStderrLogFunc :: !LogFunc - } +class (HasLogFunc a, HasStderrLogFunc a, HasKingId a, HasProcId a) + => HasKingEnv a + where + kingEnvL :: Lens' a KingEnv -makeLenses ''App +data KingEnv = KingEnv + { _kingEnvLogFunc :: !LogFunc + , _kingEnvStderrLogFunc :: !LogFunc + , _kingEnvKingId :: !Word16 + , _kingEnvProcId :: !Int32 + , _kingEnvKillSignal :: !(TMVar ()) + } -instance HasLogFunc App where - logFuncL = appLogFunc +makeLenses ''KingEnv -instance HasStderrLogFunc App where - stderrLogFuncL = appStderrLogFunc +instance HasKingEnv KingEnv where + kingEnvL = id -runApp :: RIO App a -> IO a -runApp inner = do - logOptions <- logOptionsHandle stderr True - <&> setLogUseTime True - <&> setLogUseLoc False +instance HasLogFunc KingEnv where + logFuncL = kingEnvLogFunc - withLogFunc logOptions $ \logFunc -> - runRIO (App logFunc logFunc) inner +instance HasStderrLogFunc KingEnv where + stderrLogFuncL = kingEnvStderrLogFunc -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 HasProcId KingEnv where + procIdL = kingEnvProcId - withLogFunc stderrLogOptions $ \stderrLogFunc -> - withLogFunc logOptions $ \logFunc -> - runRIO (App logFunc stderrLogFunc) inner +instance HasKingId KingEnv where + kingIdL = kingEnvKingId + + +-- Running KingEnvs ------------------------------------------------------------ + +runKingEnvStderr :: Bool -> RIO KingEnv a -> IO a +runKingEnvStderr verb inner = do + logOptions <- + logOptionsHandle stderr verb <&> setLogUseTime True <&> setLogUseLoc False + + withLogFunc logOptions $ \logFunc -> runKingEnv logFunc logFunc inner + +runKingEnvLogFile :: Bool -> RIO KingEnv a -> IO a +runKingEnvLogFile verb inner = withLogFileHandle $ \h -> do + logOptions <- + logOptionsHandle h verb <&> setLogUseTime True <&> setLogUseLoc False + stderrLogOptions <- + logOptionsHandle stderr verb <&> 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 + kil <- newEmptyTMVarIO + runRIO (KingEnv logFunc stderr kid pid kil) 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 +-- KingEnv Utils --------------------------------------------------------------- -instance HasStderrLogFunc PierApp where - stderrLogFuncL = pierAppStderrLogFunc +onKillKingSigL :: HasKingEnv e => Getter e (STM ()) +onKillKingSigL = kingEnvL . kingEnvKillSignal . to readTMVar -instance HasLogFunc PierApp where - logFuncL = pierAppLogFunc +killKingActionL :: HasKingEnv e => Getter e (STM ()) +killKingActionL = + kingEnvL . kingEnvKillSignal . to (\kil -> void (tryPutTMVar kil ())) -instance HasPierConfig PierApp where - pierConfigL = pierAppPierConfig -instance HasNetworkConfig PierApp where - networkConfigL = pierAppNetworkConfig +-- PierEnv --------------------------------------------------------------------- -instance HasConfigDir PierApp where - configDirL = pierAppPierConfig . pcPierPath +class (HasKingEnv a, HasPierConfig a, HasNetworkConfig a) => HasPierEnv a where + pierEnvL :: Lens' a PierEnv -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 +data PierEnv = PierEnv + { _pierEnvKingEnv :: !KingEnv + , _pierEnvPierConfig :: !PierConfig + , _pierEnvNetworkConfig :: !NetworkConfig + , _pierEnvKillSignal :: !(TMVar ()) + } - withLogFunc logOptions $ \logFunc -> - go $ PierApp { _pierAppLogFunc = logFunc - , _pierAppStderrLogFunc = logFunc - , _pierAppPierConfig = pierConfig - , _pierAppNetworkConfig = networkConfig - } +makeLenses ''PierEnv - 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 +instance HasKingEnv PierEnv where + kingEnvL = pierEnvKingEnv + +instance HasPierEnv PierEnv where + pierEnvL = id + +instance HasKingId PierEnv where + kingIdL = kingEnvL . kingEnvKingId + +instance HasStderrLogFunc PierEnv where + stderrLogFuncL = kingEnvL . stderrLogFuncL + +instance HasLogFunc PierEnv where + logFuncL = kingEnvL . logFuncL + +instance HasPierPath PierEnv where + pierPathL = pierEnvPierConfig . pierPathL + +instance HasDryRun PierEnv where + dryRunL = pierEnvPierConfig . dryRunL + +instance HasPierConfig PierEnv where + pierConfigL = pierEnvPierConfig + +instance HasNetworkConfig PierEnv where + networkConfigL = pierEnvNetworkConfig + +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 -> 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/App/Class.hs b/pkg/hs/urbit-king/lib/Urbit/King/App/Class.hs new file mode 100644 index 0000000000..c4a4ec08b2 --- /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 78f3a7a856..b5edbcd2f9 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 @@ -23,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 @@ -31,6 +40,7 @@ data Opts = Opts , oHttpPort :: Maybe Word16 , oHttpsPort :: Maybe Word16 , oLoopbackPort :: Maybe Word16 + , oSerfExe :: Maybe Text } deriving (Show) @@ -93,7 +103,7 @@ data Bug data Cmd = CmdNew New Opts - | CmdRun Run Opts Bool + | CmdRun KingOpts [(Run, Opts, Bool)] | CmdBug Bug | CmdCon FilePath deriving (Show) @@ -221,6 +231,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 @@ -245,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 + $ strOption + $ 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" @@ -307,15 +340,33 @@ 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) + +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 = do - rPierPath <- pierPath - o <- opts - daemon <- switch $ short 'd' - <> long "daemon" - <> help "Daemon mode" - <> hidden - pure (CmdRun (Run{..}) o daemon) +runShip = CmdRun <$> kingOpts <*> some runOneShip valPill :: Parser Bug valPill = do diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs index 9292eb7ba3..7cb9ceb2c9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs @@ -1,29 +1,40 @@ {-| - Pier Configuration + Pier Configuration -} 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. + 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 + , _pcSerfExe :: Text + , _pcSerfFlags :: [Serf.Flag] + } 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 ------------------------------------------------------------------------------- @@ -36,6 +47,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/EventBrowser.hs b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs index 389728dccc..49914aa360 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs @@ -10,14 +10,15 @@ 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(..)) -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 + -------------------------------------------------------------------------------- @@ -39,7 +40,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 f8e40e0993..2fb280d2da 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 @@ -62,18 +82,18 @@ 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 +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 (runApp, runAppLogFile, runAppNoLog, runPierApp) -import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) 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 @@ -82,18 +102,14 @@ 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 --------------------------------------------------------------------------------- - -zod :: Ship -zod = 0 -------------------------------------------------------------------------------- @@ -103,28 +119,33 @@ removeFileIfExists pax = do when exists $ do removeFile pax --------------------------------------------------------------------------------- -toSerfFlags :: CLI.Opts -> Serf.Flags +-- 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 { .. } @@ -143,157 +164,187 @@ 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 - ) - => Bool -> Pill -> Bool -> Serf.Flags -> Ship - -> LegacyBootEvent - -> RIO e () -tryBootFromPill oExit pill lite flags ship boot = do - mStart <- newEmptyMVar - runOrExitImmediately bootedPier oExit mStart - where - bootedPier = do - view pierPathL >>= lockFile - rio $ logTrace "Starting boot" - sls <- Pier.booted pill lite flags ship boot - rio $ logTrace "Completed boot" - pure sls +logStderr :: HasStderrLogFunc e => RIO LogFunc a -> RIO e a +logStderr action = do + logFunc <- view stderrLogFuncL + runRIO logFunc action -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 +logSlogs :: HasStderrLogFunc e => RIO e (TVar (Text -> IO ())) +logSlogs = logStderr $ do + env <- ask + newTVarIO (runRIO env . logOther "serf" . display . T.strip) - -- Why is this here? Do I need to force a snapshot to happen? - io $ threadDelay 500000 +tryBootFromPill + :: Bool + -> Pill + -> Bool + -> Ship + -> LegacyBootEvent + -> MultiEyreApi + -> RIO PierEnv () +tryBootFromPill oExit pill lite ship boot multi = do + mStart <- newEmptyMVar + vSlog <- logSlogs + runOrExitImmediately vSlog (bootedPier vSlog) oExit mStart multi + where + bootedPier vSlog = do + view pierPathL >>= lockFile + rio $ logDebug "Starting boot" + sls <- Pier.booted vSlog pill lite ship boot + rio $ logDebug "Completed boot" + pure sls - ss <- shutdown serf 0 - logTrace $ displayShow ss - logTrace "Shutdown!" +runOrExitImmediately + :: TVar (Text -> IO ()) + -> RAcquire PierEnv (Serf, Log.EventLog) + -> Bool + -> MVar () + -> MultiEyreApi + -> RIO PierEnv () +runOrExitImmediately vSlog getPier oExit mStart multi = do + rwith getPier (if oExit then shutdownImmediately else runPier) + where + shutdownImmediately :: (Serf, Log.EventLog) -> RIO PierEnv () + shutdownImmediately (serf, log) = do + logDebug "Sending shutdown signal" + Serf.stop serf + logDebug "Shutdown!" - runPier sls = do - runRAcquire $ Pier.pier sls mStart + runPier :: (Serf, Log.EventLog) -> RIO PierEnv () + runPier serfLog = do + runRAcquire (Pier.pier serfLog vSlog 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 - when fullReplay wipeSnapshot - runOrExitImmediately resumeShip exitImmediately mStart - 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) +tryPlayShip + :: Bool + -> Bool + -> Maybe Word64 + -> MVar () + -> MultiEyreApi + -> RIO PierEnv () +tryPlayShip exitImmediately fullReplay playFrom mStart multi = do + when fullReplay wipeSnapshot + vSlog <- logSlogs + runOrExitImmediately vSlog (resumeShip vSlog) exitImmediately mStart multi + where + wipeSnapshot = do + shipPath <- view pierPathL + logDebug "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 = do - view pierPathL >>= lockFile - rio $ logTrace "RESUMING SHIP" - sls <- Pier.resumed playFrom flags - rio $ logTrace "SHIP RESUMED" - pure sls + resumeShip :: TVar (Text -> IO ()) -> RAcquire PierEnv (Serf, Log.EventLog) + resumeShip vSlog = do + view pierPathL >>= lockFile + rio $ logDebug "RESUMING SHIP" + sls <- Pier.resumed vSlog playFrom + rio $ logDebug "SHIP RESUMED" + pure sls runRAcquire :: (MonadUnliftIO (m e), MonadIO (m e), MonadReader e (m e)) => RAcquire e a -> m e a 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 } + logDebug (displayShow ident) - last <- Log.lastEv log <&> \lastReal -> min last lastReal + last <- atomically $ 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 $ logDebug "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 -------------------------------------------------------------------------------- +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 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 $ \() -> - logTrace "Done collecting effects!" + logDebug $ display $ pack @Text top + vSlog <- logSlogs + rwith (collectedFX vSlog) $ \() -> + logDebug "Done collecting effects!" where tmpDir :: FilePath tmpDir = top ".tmpdir" - collectedFX :: RAcquire e () - collectedFX = do + collectedFX :: TVar (Text -> IO ()) -> RAcquire KingEnv () + collectedFX vSlog = do lockFile top log <- Log.existing (top <> "/.urb/log") - serf <- Serf.run (Serf.Config tmpDir serfFlags) + serf <- Pier.runSerf vSlog tmpDir serfFlags rio $ Serf.collectFX serf log - serfFlags :: Serf.Flags + serfFlags :: [Serf.Flag] serfFlags = [Serf.Hashless, Serf.DryRun] +-} + -------------------------------------------------------------------------------- -replayPartEvs :: ∀e. (HasStderrLogFunc e, HasLogFunc e) - => FilePath -> Word64 -> RIO e () +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 e () + fetchSnapshot :: RIO KingEnv () fetchSnapshot = do snap <- Pier.getSnapshot top last case snap of @@ -305,20 +356,28 @@ 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") - 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 + Left bail -> error (show bail) + Right 0 -> io (Serf.snapshot serf) + Right num -> pure () io $ threadDelay 500000 -- Copied from runOrExitImmediately pure () - serfFlags :: Serf.Flags + serfFlags :: [Serf.Flag] serfFlags = [Serf.Hashless] + -------------------------------------------------------------------------------- {-| @@ -326,84 +385,98 @@ replayPartEvs top last = do -} testPill :: HasLogFunc e => FilePath -> Bool -> Bool -> RIO e () testPill pax showPil showSeq = do - putStrLn "Reading pill file." + logDebug "Reading pill file." pillBytes <- readFile pax - putStrLn "Cueing pill file." + logDebug "Cueing pill file." pillNoun <- io $ cueBS pillBytes & either throwIO pure - putStrLn "Parsing pill file." + logDebug "Parsing pill file." pill <- fromNounErr pillNoun & either (throwIO . uncurry ParseErr) pure - putStrLn "Using pill to generate boot sequence." - bootSeq <- generateBootSeq zod pill False (Fake $ Ship 0) + logDebug "Using pill to generate boot sequence." + bootSeq <- genBootSeq (Ship 0) pill False (Fake (Ship 0)) - putStrLn "Validate jam/cue and toNoun/fromNoun on pill value" + logDebug "Validate jam/cue and toNoun/fromNoun on pill value" reJam <- validateNounVal pill - putStrLn "Checking if round-trip matches input file:" + logDebug "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." + logDebug " Our jam does not match the file...\n" + logDebug " This is surprising, but it is probably okay." when showPil $ do - putStrLn "\n\n== Pill ==\n" + logDebug "\n\n== Pill ==\n" io $ pPrint pill when showSeq $ do - putStrLn "\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 - putStrLn " jam" + logDebug " jam" inpByt <- evaluate $ jamBS $ toNoun inpVal - putStrLn " cue" + logDebug " cue" outNon <- cueBS inpByt & either throwIO pure - putStrLn " fromNoun" + logDebug " fromNoun" outVal <- fromNounErr outNon & either (throwIO . uncurry ParseErr) pure - putStrLn " toNoun" + logDebug " toNoun" outNon <- evaluate (toNoun outVal) - putStrLn " jam" + logDebug " jam" outByt <- evaluate $ jamBS outNon - putStrLn "Checking if: x == cue (jam x)" + logDebug "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))" + logDebug "Checking if: jam x == jam (cue (jam x))" unless (inpByt == outByt) $ error "Value fails test: jam x == jam (cue (jam x))" pure outByt + -------------------------------------------------------------------------------- -pillFrom :: CLI.PillSource -> RIO e Pill +pillFrom :: CLI.PillSource -> RIO KingEnv Pill +pillFrom = \case + CLI.PillSourceFile pillPath -> do + logDebug $ 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 + 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 + 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 KingEnv () +newShip CLI.New{..} opts = do + {- + TODO XXX HACK -newShip :: forall e. HasLogFunc e => CLI.New -> CLI.Opts -> RIO e () -newShip 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 @@ -413,14 +486,14 @@ newShip 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?" @@ -433,10 +506,10 @@ newShip CLI.New{..} opts pill <- pillFrom nPillSource - bootFromSeed pill seed + bootFromSeed multi pill seed where - shipFrom :: Text -> RIO e 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 @@ -446,7 +519,7 @@ newShip CLI.New{..} opts Just x -> x Nothing -> "./" <> unpack name - nameFromShip :: Ship -> RIO e Text + nameFromShip :: Ship -> RIO KingEnv Text nameFromShip s = name where nameWithSig = Ob.renderPatp $ Ob.patp $ fromIntegral s @@ -454,8 +527,8 @@ newShip 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 KingEnv () + bootFromSeed multi pill seed = do ethReturn <- dawnVent seed case ethReturn of @@ -463,43 +536,51 @@ newShip CLI.New{..} opts Right dawn -> do let ship = sShip $ dSeed dawn name <- nameFromShip ship - runTryBootFromPill pill name ship (Dawn dawn) - - flags = toSerfFlags opts + runTryBootFromPill multi pill name ship (Dawn dawn) -- 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 + vKill <- view kingEnvKillSignal let pierConfig = toPierConfig (pierPath name) opts let networkConfig = toNetworkConfig opts - io $ runPierApp pierConfig networkConfig True $ - tryBootFromPill True pill nLite flags ship bootEvent + runPierEnv pierConfig networkConfig vKill $ + 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 +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 -> IO () -runShip (CLI.Run pierPath) opts daemon = do - tid <- myThreadId - let onTermExit = throwTo tid UserInterrupt - mStart <- newEmptyMVar +runShip + :: CLI.Run -> CLI.Opts -> Bool -> MultiEyreApi -> RIO PierEnv () +runShip (CLI.Run pierPath) opts daemon multi = do + 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 (runAppNoLog $ connTerm pierPath) onTermExit - finally (runPier mStart) (cancel connectionThread) + finally (connTerm pierPath) $ do + view killPierActionL >>= atomically + + -- Run the pier until it finishes, and then kill the terminal. + finally (runPier mStart) $ do + cancel connectionThread where - runPier mStart = - runPierApp pierConfig networkConfig daemon $ - tryPlayShip - (CLI.oExit opts) - (CLI.oFullReplay opts) - (CLI.oDryFrom opts) - (toSerfFlags opts) - mStart - pierConfig = toPierConfig pierPath opts - networkConfig = toNetworkConfig opts + runPier :: MVar () -> RIO PierEnv () + runPier mStart = do + tryPlayShip + (CLI.oExit opts) + (CLI.oFullReplay opts) + (CLI.oDryFrom opts) + mStart + multi startBrowser :: HasLogFunc e => FilePath -> RIO e () @@ -540,33 +621,200 @@ checkComet = do main :: IO () main = do + args <- CLI.parseArgs + + hSetBuffering stdout NoBuffering + setupSignalHandlers + + 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 + 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 + runKingEnv args = + let verb = verboseLogging args + in if willRunTerminal args + then runKingEnvLogFile verb + else runKingEnvStderr verb + + setupSignalHandlers = do mainTid <- myThreadId + let onKillSig = throwTo mainTid UserInterrupt + for_ [Sys.sigTERM, Sys.sigINT] $ \sig -> do + Sys.installHandler sig (Sys.Catch onKillSig) Nothing - hSetBuffering stdout NoBuffering + verboseLogging :: CLI.Cmd -> Bool + verboseLogging = \case + CLI.CmdRun ko ships -> any CLI.oVerbose (ships <&> \(_, o, _) -> o) + _ -> False - let onTermSig = throwTo mainTid UserInterrupt + willRunTerminal :: CLI.Cmd -> Bool + willRunTerminal = \case + CLI.CmdCon _ -> True + CLI.CmdRun ko [(_,_,daemon)] -> not daemon + CLI.CmdRun ko _ -> False + _ -> False - Sys.installHandler Sys.sigTERM (Sys.Catch onTermSig) Nothing - CLI.parseArgs >>= \case - CLI.CmdRun r o d -> runShip r o d - 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 +{- + 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 + :: CLI.Run -> CLI.Opts -> MultiEyreApi -> RIO KingEnv () +runShipRestarting r o multi = do + let pier = pack (CLI.rPierPath r) + loop = runShipRestarting r o multi + + onKill <- view onKillKingSigL + vKillPier <- newEmptyTMVarIO + + tid <- asyncBound $ runShipEnv r o vKillPier $ runShip r o True multi + + let onShipExit = Left <$> waitCatchSTM tid + onKillRequ = Right <$> onKill + + atomically (onShipExit <|> onKillRequ) >>= \case + Left exit -> do + case exit of + Left err -> logError $ display (tshow err <> ": " <> pier) + Right () -> + logError $ display ("Ship exited on it's own. Why? " <> pier) + threadDelay 250_000 + loop + Right () -> do + logTrace $ display (pier <> " shutdown requested") + race_ (wait tid) $ do + threadDelay 5_000_000 + logDebug $ 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 + :: 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 <$> onKill + + 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 + let meConf = MultiEyreConf + { mecHttpPort = fromIntegral <$> koSharedHttpPort + , mecHttpsPort = fromIntegral <$> koSharedHttpsPort + , mecLocalhostOnly = False -- TODO Localhost-only needs to be + -- a king-wide option. + } + + + {- + 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 <- multiEyre meConf + + go multi ships + where + go :: MultiEyreApi -> [(CLI.Run, CLI.Opts, Bool)] -> RIO KingEnv () + go me = \case + [] -> pure () + [rod] -> runSingleShip rod me + ships -> runMultipleShips (ships <&> \(r, o, _) -> (r, o)) me + + +-- TODO Duplicated logic. +runSingleShip :: (CLI.Run, CLI.Opts, Bool) -> MultiEyreApi -> RIO KingEnv () +runSingleShip (r, o, d) multi = do + shipThread <- async (runShipNoRestart r o d multi) + + {- + Wait for the ship to go down. + + 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. + -} + onException (void $ waitCatch shipThread) $ do + logTrace "KING IS GOING DOWN" + atomically =<< view killKingActionL + waitCatch shipThread + pure () + + +runMultipleShips :: [(CLI.Run, CLI.Opts)] -> MultiEyreApi -> RIO KingEnv () +runMultipleShips ships multi = do + shipThreads <- for ships $ \(r, o) -> do + async (runShipRestarting 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 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 + themselves back up. + -} + let spin = forever (threadDelay maxBound) + finally spin $ do + logTrace "KING IS GOING DOWN" + view killKingActionL >>= atomically + for_ shipThreads waitCatch -------------------------------------------------------------------------------- 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/Ames.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs index 9d8d098465..1463898109 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs @@ -1,87 +1,162 @@ {-| - Ames IO Driver -- UDP + Ames IO Driver -} -module Urbit.Vere.Ames (ames) where +module Urbit.Vere.Ames (ames, ames', PacketOutcome(..)) 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.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) + + +-- Constants ------------------------------------------------------------------- + +-- | How many unprocessed ames packets to allow in the queue before we start +-- dropping incoming packets. +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]) - , aGalaxies :: IORef (M.Map Galaxy (Async (), TQueue ByteString)) - , aSocket :: TVar (Maybe Socket) - , aListener :: Async () - , aSendingQueue :: TQueue (SockAddr, ByteString) - , aSendingThread :: Async () + { aTurfs :: TVar (Maybe [Turf]) + , aDropped :: TVar Word + , aUdpServ :: UdpServ + , aResolvr :: ResolvServ + , aRecvTid :: Async () } -data NetworkMode = Fake | Localhost | Real | NoNetwork - deriving (Eq, Ord, Show) +data PacketOutcome + = Intake + | Ouster -- 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 +listenPort m _ = 0 -- I don't care, just give me any port. 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) -okayFakeAddr :: AmesDest -> Bool -okayFakeAddr = \case - EachYes _ -> True - EachNo (Jammed (AAIpv4 (Ipv4 a) _)) -> a == localhost - EachNo (Jammed (AAVoid v)) -> absurd v +modeAddress :: NetworkMode -> Maybe HostAddress +modeAddress = \case + Fake -> Just localhost + Localhost -> Just localhost + Real -> Just inaddrAny + NoNetwork -> Nothing -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 +okFakeAddr :: AmesDest -> Bool +okFakeAddr = \case + EachYes _ -> True + EachNo (Jammed (AAIpv4 (Ipv4 a) _)) -> a == localhost + EachNo (Jammed (AAVoid v )) -> absurd v + +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 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) - -_turfText :: Turf -> Text -_turfText = intercalate "." . reverse . fmap unCord . unTurf - -renderGalaxy :: Galaxy -> Text -renderGalaxy = Ob.renderPatp . Ob.patp . fromIntegral . unPatp + EvBlip $ BlipEvAmes $ AmesEvHear () dest (MkBytes bs) + where + dest = EachNo $ Jammed $ AAIpv4 (Ipv4 a) (fromIntegral p) -------------------------------------------------------------------------------- +netMode :: HasNetworkConfig e => Bool -> RIO e NetworkMode +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 :: HasNetworkConfig e => Bool -> Ship -> 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 + +_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 + -- Unfortunately, we cannot use TBQueue because the only behavior + -- 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 + let + enqueuePacket p = do + vail <- readTVar avail + if vail > 0 + then do + modifyTVar avail (subtract 1) + writeTQueue ventQ p + pure Intake + else do + _ <- readTQueue ventQ + writeTQueue ventQ p + pure Ouster + dequeuePacket = do + pM <- tryReadTQueue ventQ + when (isJust pM) $ modifyTVar avail (+ 1) + pure pM + + env <- ask + let (bornEvs, startDriver) = ames env who isFake enqueuePacket stderr + + let runDriver = do + diOnEffect <- startDriver + let diEventSource = fmap RRWork <$> dequeuePacket + pure (DriverApi {..}) + + pure (bornEvs, runDriver) + + {-| inst -- Process instance number. who -- Which ship are we? @@ -93,229 +168,81 @@ renderGalaxy = Ob.renderPatp . Ob.patp . fromIntegral . unPatp 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, HasKingId e) + => e + -> Ship + -> Bool + -> (EvErr -> STM PacketOutcome) + -> (Text -> RIO e ()) + -> ([Ev], RAcquire e (NewtEf -> IO ())) +ames env who isFake enqueueEv stderr = (initialEvents, runAmes) + where + king = fromIntegral (env ^. kingIdL) - runAmes :: RAcquire e (EffCb e NewtEf) - runAmes = do - drv <- mkRAcquire start stop - pure (handleEffect drv) + initialEvents :: [Ev] + initialEvents = [bornEv king] - 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{..} + runAmes :: RAcquire e (NewtEf -> IO ()) + runAmes = do + mode <- rio (netMode isFake) + drv <- mkRAcquire start stop + pure (handleEffect drv mode) - 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 + start :: HasLogFunc e => RIO e AmesDrv + start = do + aTurfs <- newTVarIO Nothing + aDropped <- newTVarIO 0 + aUdpServ <- udpServ isFake who + aRecvTid <- queuePacketsThread aDropped aUdpServ + aResolvr <- resolvServ aTurfs (usSend aUdpServ) stderr + pure (AmesDrv { .. }) - stop :: AmesDrv -> RIO e () - stop AmesDrv{..} = do - readIORef aGalaxies >>= mapM_ (cancel . fst) + hearFailed _ = pure () - cancel aSendingThread - cancel aListener - socket <- atomically $ readTVar aSocket - io $ maybeM (pure ()) (close') (pure socket) + 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 $ do + d <- readTVar dropCtr + writeTVar dropCtr (d + 1) + pure d + when (d `rem` packetsDroppedPerComplaint == 0) $ + logWarn "ames: queue full; dropping inbound packets" - 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 + stop :: AmesDrv -> RIO e () + stop AmesDrv {..} = io $ do + usKill aUdpServ + rsKill aResolvr + cancel aRecvTid - 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 + handleEffect :: AmesDrv -> NetworkMode -> NewtEf -> IO () + handleEffect drv@AmesDrv {..} mode = runRIO env . \case + NewtEfTurf (_id, ()) turfs -> do + atomically $ writeTVar aTurfs (Just turfs) - logTrace $ displayShow ("(ames) Binding to port ", ourPort) - let addr = SockAddrInet ourPort bindAddr - () <- io $ bind s addr + NewtEfSend (_id, ()) dest (MkBytes bs) -> do + atomically (readTVar aTurfs) >>= \case + Nothing -> pure () + Just turfs -> sendPacket drv mode dest bs - atomically $ writeTVar socketVar (Just s) + sendPacket :: AmesDrv -> NetworkMode -> AmesDest -> ByteString -> RIO e () + sendPacket AmesDrv {..} mode dest byt = do + let to adr = io (usSend aUdpServ adr byt) - 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 () + 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) - waitPacket socketVar - - - handleEffect :: AmesDrv -> NewtEf -> RIO e () - handleEffect drv@AmesDrv{..} = \case - NewtEfTurf (_id, ()) turfs -> do - 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 - - -- 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 - -> TQueue (SockAddr, ByteString) - -> RIO e () - galaxyResolver galaxy turfVar incoming outgoing = - loop Nothing Time.unixEpoch - where - loop :: Maybe SockAddr -> Time.Wen -> RIO e () - loop lastGalaxyIP lastLookupTime = do - packet <- atomically $ readTQueue incoming - - 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 - - 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) - - queueSendToGalaxy :: SockAddr -> ByteString -> RIO e () - queueSendToGalaxy inet packet = do - atomically $ writeTQueue outgoing (inet, packet) + 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 0000000000..f16f6a55a8 --- /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.Noun.Time as Time +import qualified Urbit.Ob as Ob + + +-- 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) 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 0000000000..47a9b24fbf --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs @@ -0,0 +1,243 @@ +{- | + 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 + logDebug (display ("AMES: UDP: Opening socket on port " <> tshow por)) + io (doBind por hos) >>= \case + Right sk -> do + logDebug (display ("AMES: UDP: Opened socket on port " <> tshow por)) + pure sk + Left err -> do + logDebug (display ("AMES: UDP: " <> tshow err)) + logDebug ("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 + 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 + logDebug $ displayShow ("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 + logDebug $ displayShow ("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 + logDebug $ displayShow ("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 + logDebug $ displayShow ("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 $ displayShow $ ("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) + logWarn "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 + logDebug "AMES: UDP: Received packet." + enqueueRecvPacket p a b + + let shutdown = do + logDebug "AMES: UDP: Shutting down. (killing threads)" + cancel tOpen + cancel tSend + cancel tRecv + logDebug "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 + } diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs index 5336534b0e..72ae5218f1 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs @@ -2,21 +2,33 @@ 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.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 ------------------------------------------------------------------ +behn' :: HasPierEnv e => RIO e ([Ev], RAcquire e (DriverApi BehnEf)) +behn' = do + env <- ask + 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, ()) () @@ -25,16 +37,22 @@ wakeEv = EvBlip $ BlipEvBehn $ BehnEvWake () () sysTime = view Time.systemTime -behn :: KingId -> QueueEv -> ([Ev], Acquire (EffCb e BehnEf)) -behn king enqueueEv = - (initialEvents, runBehn) - where - initialEvents = [bornEv king] +wakeErr :: WorkError -> IO () +wakeErr _ = pure () - runBehn :: Acquire (EffCb e BehnEf) +behn + :: HasKingId e + => e + -> (EvErr -> STM ()) + -> Acquire (BehnEf -> IO ()) +behn env enqueueEv = runBehn + where + king = fromIntegral (env ^. kingIdL) + + 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 @@ -45,4 +63,4 @@ behn king 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 811586409d..6b8272266c 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs @@ -2,10 +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.Config +import Urbit.King.App import Urbit.Prelude import Urbit.Vere.Pier.Types @@ -112,26 +116,52 @@ buildActionListFromDifferences fp snapshot = do -------------------------------------------------------------------------------- -clay :: forall e. (HasPierConfig e, HasLogFunc e) - => KingId -> QueueEv -> ([Ev], RAcquire e (EffCb e SyncEf)) -clay king enqueueEv = +_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 ()) + -> ([Ev], RAcquire e (SyncEf -> IO ())) +clay env plan = (initialEvents, runSync) where - 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. - ] + king = fromIntegral (env ^. kingIdL) - runSync :: RAcquire e (EffCb e SyncEf) + 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 = [boatEv] + + 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 @@ -151,8 +181,15 @@ clay king 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 new file mode 100644 index 0000000000..2aeb33f630 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs @@ -0,0 +1,364 @@ +{-| + Eyre: Http Server Driver +-} + +module Urbit.Vere.Eyre + ( eyre + , eyre' + ) +where + +import Urbit.Prelude hiding (Builder) + +import Urbit.Arvo hiding (ServerId, reqUrl, secure) +import Urbit.King.App (HasKingId(..), HasPierEnv(..)) +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.Wai +import Urbit.Vere.Pier.Types + +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.PEM (pemParseBS, pemWriteBS) +import RIO.Prelude (decodeUtf8Lenient) +import System.Random (randomIO) +import Urbit.Vere.Http (convertHeaders, unconvertHeaders) + +import qualified Network.HTTP.Types as H + + +-- Types ----------------------------------------------------------------------- + +type HasShipEnv e = (HasLogFunc e, HasNetworkConfig e, HasPierConfig e) + +type ReqId = UD + +newtype Drv = Drv (MVar (Maybe Serv)) + +data SockOpts = SockOpts + { soLocalhost :: Bool + , soWhich :: ServPort + } + +data PortsToTry = PortsToTry + { pttSec :: SockOpts + , pttIns :: SockOpts + , pttLop :: SockOpts + } + +data Serv = Serv + { sServId :: ServId + , sConfig :: HttpServerConf + , sLop :: ServApi + , sIns :: ServApi + , sSec :: Maybe ServApi + , sPorts :: Ports + , sPortsFile :: FilePath + , sLiveReqs :: TVar LiveReqs + } + + +-- Utilities for Constructing Events ------------------------------------------- + +servEv :: HttpServerEv -> Ev +servEv = EvBlip . BlipEvHttpServer + +bornEv :: KingId -> Ev +bornEv king = servEv $ HttpServerEvBorn (king, ()) () + +liveEv :: ServId -> Ports -> Ev +liveEv sId Ports {..} = servEv $ HttpServerEvLive (sId, ()) pHttp pHttps + +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 + Loopback -> servEv $ HttpServerEvRequestLocal (sId, reqId, 1, ()) + $ HttpServerReq False addr req + _ -> servEv $ HttpServerEvRequest (sId, reqId, 1, ()) + $ HttpServerReq (which == Secure) addr req + + +-- Based on Pier+Config, which ports should each server run? ------------------- + +httpServerPorts :: HasShipEnv e => Bool -> RIO e PortsToTry +httpServerPorts fak = do + ins <- view (networkConfigL . ncHttpPort . to (fmap fromIntegral)) + sec <- view (networkConfigL . ncHttpsPort . to (fmap fromIntegral)) + lop <- view (networkConfigL . ncLocalPort . to (fmap fromIntegral)) + localMode <- view (networkConfigL . ncNetMode . to (== NMLocalhost)) + + let local = localMode || fak + + let pttSec = case (sec, fak) of + (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 (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 (SPChoices $ singleton p) + (Nothing, _) -> SockOpts local SPAnyPort + + pure (PortsToTry { .. }) + + +-- Convert Between Urbit and WAI types. ---------------------------------------- + +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] + 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 + + fByt :: File -> ByteString + fByt = unOcts . unFile + +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 + + 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 + logDebug $ 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 + -> (EvErr -> STM ()) + -> RIO e Serv +startServ multi who isFake conf plan = do + logDebug (displayShow ("EYRE", "startServ")) + + let vLive = meaLive multi + + srvId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32) + + let mTls = hscSecure conf >>= parseTlsConfig + + mCre <- mTls & \case + Nothing -> pure Nothing + Just tc -> configCreds tc & \case + Right rs -> pure (Just (tc, rs)) + Left err -> do + logError "Couldn't Load TLS Credentials." + pure Nothing + + ptt <- httpServerPorts isFake + + {- + 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 + + noHttp <- view (networkConfigL . ncNoHttp) + noHttps <- view (networkConfigL . ncNoHttps) + + let reqEvFailed _ = pure () + + let onReq :: WhichServer -> Ship -> Word64 -> ReqInfo -> STM () + onReq which _ship reqId reqInfo = + plan $ EvErr (requestEvent srvId which reqId reqInfo) reqEvFailed + + let onKilReq :: Ship -> Word64 -> STM () + onKilReq _ship = plan . cancelEv srvId . fromIntegral + + logDebug (displayShow ("EYRE", "joinMultiEyre", who, mTls, mCre)) + + atomically (joinMultiEyre multi who mCre onReq onKilReq) + + logDebug $ displayShow ("EYRE", "Starting loopback server") + lop <- serv vLive $ ServConf + { scHost = soHost (pttLop ptt) + , scPort = soWhich (pttLop ptt) + , scRedi = Nothing + , scFake = False + , scType = STHttp who $ ReqApi + { rcReq = onReq Loopback + , rcKil = onKilReq + } + } + + logDebug $ displayShow ("EYRE", "Starting insecure server") + ins <- serv vLive $ ServConf + { scHost = soHost (pttIns ptt) + , scPort = soWhich (pttIns ptt) + , scRedi = secRedi + , scFake = noHttp + , scType = STHttp who $ ReqApi + { rcReq = onReq Insecure + , rcKil = onKilReq + } + } + + mSec <- for mTls $ \tls -> do + logDebug "Starting secure server" + serv vLive $ ServConf + { scHost = soHost (pttSec ptt) + , scPort = soWhich (pttSec ptt) + , scRedi = Nothing + , scFake = noHttps + , scType = STHttps who tls $ ReqApi + { rcReq = onReq Secure + , rcKil = onKilReq + } + } + + pierPath <- view pierPathL + + 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 ("EYRE", "All Servers Started.", srvId, por, fil) + + pure (Serv srvId conf lop ins mSec por fil vLive) + + +-- Eyre Driver ----------------------------------------------------------------- + +_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 + . (HasPierEnv e) + => e + -> MultiEyreApi + -> Ship + -> (EvErr -> STM ()) + -> Bool + -> ([Ev], RAcquire e (HttpServerEf -> IO ())) +eyre env multi who plan isFake = (initialEvents, runHttpServer) + where + king = fromIntegral (env ^. kingIdL) + + initialEvents :: [Ev] + initialEvents = [bornEv king] + + runHttpServer :: RAcquire e (HttpServerEf -> IO ()) + runHttpServer = handleEf <$> mkRAcquire + (Drv <$> newMVar Nothing) + (\(Drv v) -> stopService v kill >>= fromEither) + + 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) + + 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 + + liveFailed _ = pure () + + handleEf :: Drv -> HttpServerEf -> IO () + handleEf drv = runRIO env . \case + HSESetConfig (i, ()) conf -> do + logDebug (displayShow ("EYRE", "%set-config")) + Serv {..} <- restart drv conf + logDebug (displayShow ("EYRE", "%set-config", "Sending %live")) + atomically $ plan (EvErr (liveEv sServId sPorts) liveFailed) + logDebug "Write ports file" + io (writePortsFile sPortsFile sPorts) + HSEResponse (i, req, _seq, ()) ev -> do + logDebug (displayShow ("EYRE", "%response")) + execRespActs drv who (fromIntegral req) ev 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 0000000000..706afb8f3d --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs @@ -0,0 +1,131 @@ +{-| + 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 + } + deriving (Show) + +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 (TlsConfig, Credential)) + , meaKill :: STM () + } + + +-- Multi-Tenet HTTP ------------------------------------------------------------ + +joinMultiEyre + :: MultiEyreApi + -> Ship + -> Maybe (TlsConfig, 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 $ \creds -> do + modifyTVar' (meaTlsC api) (insertMap who creds) + +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 + logDebug (displayShow ("EYRE", "MULTI", conf)) + + vLive <- io emptyLiveReqs >>= newTVarIO + 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 -> do + logDebug (displayShow ("EYRE", "MULTI", "HTTP", por)) + serv vLive $ ServConf + { scHost = host + , scPort = SPChoices $ singleton $ fromIntegral por + , scRedi = Nothing -- TODO + , scFake = False + , scType = STMultiHttp $ ReqApi + { rcReq = onReq Insecure + , rcKil = onKil + } + } + + mSec <- for mecHttpsPort $ \por -> do + logDebug (displayShow ("EYRE", "MULTI", "HTTPS", por)) + serv vLive $ ServConf + { scHost = host + , scPort = SPChoices $ singleton $ fromIntegral por + , scRedi = Nothing + , scFake = False + , scType = STMultiHttps (MTC 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 0000000000..20e073122b --- /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 new file mode 100644 index 0000000000..e007d6331a --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Serv.hs @@ -0,0 +1,356 @@ +{-| + 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 + ( ServApi(..) + , TlsConfig(..) + , MultiTlsConfig(..) + , ReqApi(..) + , ServType(..) + , ServPort(..) + , ServHost(..) + , ServConf(..) + , configCreds + , serv + , fakeServ + ) +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 Control.Monad.STM as STM +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 ServApi = ServApi + { saKil :: STM () + , saPor :: STM W.Port + } + +data TlsConfig = TlsConfig + { tcPrKey :: ByteString + , tcCerti :: ByteString + , tcChain :: [ByteString] + } + deriving (Show) + +newtype MultiTlsConfig = MTC (TVar (Map Ship (TlsConfig, 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 + , scHost :: ServHost + , scPort :: ServPort + , scRedi :: Maybe W.Port + , scFake :: Bool + } + deriving (Show) + + +-- 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 + logDbg 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 + => String + -> NonEmpty W.Port + -> RIO e (Either IOError (W.Port, Net.Socket)) +tryOpenChoices hos = go + where + go (p :| ps) = do + logDebug (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 + let ctx = ["EYRE", "SERV", "tryOpenAny"] + 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)) + +logDbg :: (HasLogFunc e, Show a) => [Text] -> a -> RIO e () +logDbg ctx msg = logDebug (prefix <> suffix) + where + prefix = display (concat $ fmap (<> ": ") ctx) + suffix = displayShow msg + +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 + let ctx = ["EYRE", "SERV", "forceOpenSocket"] + logDbg ctx (hos, por) + (p, s) <- retry $ case por of + SPAnyPort -> tryOpenAny bind + SPChoices ps -> tryOpenChoices bind ps + logDbg ctx ("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 + :: HasLogFunc e => e -> MultiTlsConfig -> Maybe String -> IO Credentials +onSniHdr env (MTC mtls) mHos = do + tabl <- atomically (readTVar mtls) + runRIO env $ logDbg ctx (tabl, mHos) + ship <- hostShip (encodeUtf8 . pack <$> mHos) + runRIO env $ logDbg ctx ship + tcfg <- lookup ship tabl & maybe (notRunning ship) (pure . snd) + runRIO env $ logDbg ctx tcfg + pure (Credentials [tcfg]) + where + notRunning ship = error ("Ship not running: ~" <> show ship) + ctx = ["EYRE", "HTTPS", "SNI"] + +startServer + :: HasLogFunc e + => ServType + -> ServHost + -> W.Port + -> Net.Socket + -> Maybe W.Port + -> TVar E.LiveReqs + -> RIO e () +startServer typ hos por sok red vLive = do + envir <- ask + + 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 who = E.app envir who vLive + reqShip = hostShip . W.requestHeaderHost + + case typ of + STHttp who api -> do + let app = runAppl who (rcReq api who) (rcKil api who) + io (W.runSettingsSocket opts sok app) + + STHttps who TlsConfig {..} api -> do + let tls = W.tlsSettingsChainMemory tcCerti tcChain tcPrKey + 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 + who <- reqShip req + runAppl who (rcReq api who) (rcKil api who) req resp + io (W.runSettingsSocket opts sok app) + + STMultiHttps mtls api -> do + TlsConfig {..} <- atomically (getFirstTlsConfig mtls) + + let sni = def { onServerNameIndication = onSniHdr envir mtls } + + let tlsSing = (W.tlsSettingsChainMemory tcCerti tcChain tcPrKey) + let tlsMany = tlsSing { W.tlsServerHooks = sni } + + let ctx = ["EYRE", "HTTPS", "REQ"] + + let + app = \req resp -> do + runRIO envir $ logDbg ctx "Got request" + who <- reqShip req + runRIO envir $ logDbg ctx ("Parsed HOST", who) + runAppl who (rcReq api who) (rcKil api who) req resp + + io (W.runTLSSocket tlsMany opts sok app) + + +-------------------------------------------------------------------------------- + +configCreds :: TlsConfig -> Either Text Credential +configCreds TlsConfig {..} = + credentialLoadX509ChainFromMemory tcCerti tcChain tcPrKey & \case + Left str -> Left (pack str) + Right rs -> Right rs + +fakeServ :: HasLogFunc e => ServConf -> RIO e ServApi +fakeServ conf = do + let por = fakePort (scPort conf) + logDebug (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 + +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 + logDebug (displayShow ("EYRE", "SERV", "Running Real Server")) + kil <- newEmptyTMVarIO + por <- newEmptyTMVarIO + + tid <- async (runServ por) + _ <- async (atomically (takeTMVar kil) >> cancel tid) + + pure $ ServApi + { saKil = void (tryPutTMVar kil ()) + , saPor = readTMVar por + } + where + runServ vPort = do + logDebug (displayShow ("EYRE", "SERV", "runServ")) + 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 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 0000000000..ce3bc01a93 --- /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 new file mode 100644 index 0000000000..3815e1ca95 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Wai.hs @@ -0,0 +1,229 @@ +{-| + 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.Eyre.Wai + ( 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 System.Random (newStdGen, randoms) +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 ----------------------------------------------------------------------- + +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 + { reqIdSuply :: [Word64] + , activeReqs :: Map Word64 (Ship, 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 :: 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 = + (lookup reqId . activeReqs <$> readTVar vLiv) >>= \case + Nothing -> pure False + Just (own, tv) -> do + if (who == own) + then raAct tv act + else pure False + +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 + tmv <- newTQueue + kil <- newEmptyTMVar + nex <- allocateReqId var + + LiveReqs sup tbl <- readTVar var + + let waitAct = (<|>) (readTMVar kil $> RADone) (readTQueue tmv) + respApi = RespApi + { raKil = putTMVar kil () + , raAct = \act -> tryReadTMVar kil >>= \case + Nothing -> writeTQueue tmv act $> True + Just () -> pure False + } + + + writeTVar var (LiveReqs sup (insertMap nex (who, respApi) tbl)) + + 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." + +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 "" = pure () + 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 :: Ship -> TVar LiveReqs -> RAcquire e (Word64, STM RespAct) +liveReq who vLiv = mkRAcquire ins del + where + ins = atomically (newLiveReq who vLiv) + del = atomically . rmLiveReq vLiv . fst + +app + :: HasLogFunc e + => e + -> Ship + -> TVar LiveReqs + -> (Word64 -> ReqInfo -> STM ()) + -> (Word64 -> STM ()) + -> W.Application +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) + + 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) 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 23526467eb..011ce86acd 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.King.App + +import Urbit.Arvo (BlipEv(..), Ev(..), HttpClientEf(..), HttpClientEv(..), + HttpClientReq(..), HttpEvent(..), KingId, ResponseHeader(..)) + 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,14 +57,54 @@ bornEv king = -------------------------------------------------------------------------------- -client :: forall e. HasLogFunc e - => KingId -> QueueEv -> ([Ev], RAcquire e (EffCb e HttpClientEf)) -client kingId enqueueEv = (initialEvents, runHttpClient) +_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 ()) + -> ([Ev], RAcquire e (HttpClientEf -> IO ())) +client env plan = (initialEvents, runHttpClient) where + kingId = view (kingIdL . to fromIntegral) env + initialEvents :: [Ev] initialEvents = [bornEv kingId] - runHttpClient :: RAcquire e (EffCb e HttpClientEf) + runHttpClient :: RAcquire e (HttpClientEf -> IO ()) runHttpClient = handleEffect <$> mkRAcquire start stop start :: RIO e (HttpClientDrv) @@ -75,10 +118,10 @@ client kingId enqueueEv = (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 @@ -124,8 +167,14 @@ client kingId 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/Http/Server.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs deleted file mode 100644 index 0da819e150..0000000000 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs +++ /dev/null @@ -1,635 +0,0 @@ -{-| - 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"; --} - -module Urbit.Vere.Http.Server 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.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 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 - - --- Internal Types -------------------------------------------------------------- - -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 - , pHttp :: Port - , pLoop :: Port - } - deriving (Eq, Ord, Show) - -newtype Drv = Drv { unDrv :: 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 - } - - --- 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 ----------------- - -{-| - 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) - - --- 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 () -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 - - --- 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 - deriving (Eq) - -servEv :: HttpServerEv -> Ev -servEv = EvBlip . BlipEvHttpServer - -bornEv :: KingId -> Ev -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, ()) () - -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 - - --- 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 - deriving (Eq, Ord, Show, Exception) - -data WhichPort - = WPSpecific W.Port - | WPChoices [W.Port] - -data SockOpts = SockOpts - { soLocalhost :: Bool - , soWhich :: WhichPort - } - -data PortsToTry = PortsToTry - { pttSec :: SockOpts - , pttIns :: SockOpts - , 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)) - sec <- view (networkConfigL . ncHttpsPort . to (fmap fromIntegral)) - lop <- view (networkConfigL . ncLocalPort . to (fmap fromIntegral)) - localMode <- view (networkConfigL . ncNetMode . to (== NMLocalhost)) - - 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])) - - 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]) - - let pttLop = case (lop, fak) of - (Just p , _) -> SockOpts local (WPSpecific p) - (Nothing, _) -> SockOpts local (WPChoices [12321 .. 12326]) - - 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) - -startServ :: (HasPierConfig e, HasLogFunc e, HasNetworkConfig e) - => Bool -> HttpServerConf -> (Ev -> STM ()) - -> RIO e Serv -startServ isFake conf plan = do - logDebug "startServ" - - let tls = do (PEM key, PEM certs) <- hscSecure conf - (cert, chain) <- parseCerts (wainBytes certs) - pure $ W.tlsSettingsChainMemory cert chain $ wainBytes key - - sId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32) - liv <- newTVarIO emptyLiveReqs - - ptt <- httpServerPorts isFake - - (httpPortInt, httpSock) <- openPort (pttIns ptt) - (httpsPortInt, httpsSock) <- openPort (pttSec ptt) - (loopPortInt, loopSock) <- openPort (pttLop ptt) - - let httpPort = Port (fromIntegral httpPortInt) - httpsPort = Port (fromIntegral httpsPortInt) - loopPort = Port (fromIntegral loopPortInt) - - 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) - - env <- ask - - logDebug "Starting loopback server" - loopTid <- async $ io - $ W.runSettingsSocket loopOpts loopSock - $ app env sId liv plan Loopback - - logDebug "Starting HTTP server" - httpTid <- async $ io - $ W.runSettingsSocket httpOpts httpSock - $ app 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 - - pierPath <- view pierPathL - let por = Ports (tls <&> const httpsPort) httpPort loopPort - fil = pierPath <> "/.http.ports" - - logDebug $ displayShow (sId, por, fil) - - logDebug "Finished started HTTP Servers" - - pure $ Serv sId conf - loopTid httpTid httpsTid - httpSock httpsSock loopSock - por fil liv - -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 - -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)) -serv king plan isFake = - (initialEvents, runHttpServer) - where - initialEvents :: [Ev] - initialEvents = [bornEv king] - - runHttpServer :: RAcquire e (EffCb e HttpServerEf) - runHttpServer = handleEf <$> mkRAcquire (Drv <$> newMVar Nothing) kill - - 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 - - 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 diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/NounServ.hs index f82950da69..f23f82aa33 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 06b2baeabd..78b6d9e5da 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -1,413 +1,553 @@ {-| - 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 event log, and the IO drivers. -} module Urbit.Vere.Pier - ( booted, resumed, getSnapshot, pier, runPersist, runCompute, generateBootSeq - ) where + ( booted + , runSerf + , resumed + , getSnapshot + , pier + , runPersist + , runCompute + , genBootSeq + ) +where import Urbit.Prelude -import RIO.Directory -import System.Random -import Urbit.Arvo -import Urbit.King.Config -import Urbit.Vere.Pier.Types import Control.Monad.Trans.Maybe +import RIO.Directory +import Urbit.Arvo +import Urbit.King.App +import Urbit.Vere.Pier.Types -import Data.Text (append) +import Control.Monad.STM (retry) import System.Posix.Files (ownerModes, setFileMode) -import Urbit.King.App (HasConfigDir(..), HasStderrLogFunc(..)) -import Urbit.Vere.Ames (ames) -import Urbit.Vere.Behn (behn) -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.EventLog.LMDB (EventLog) +import Urbit.King.API (TermConn) +import Urbit.Noun.Time (Wen) +import Urbit.TermSize (TermSize(..)) +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 -import qualified Urbit.Time as Time -import qualified Urbit.Vere.Log as Log +import qualified Urbit.Noun.Time as Time +import qualified Urbit.Vere.Ames as Ames +import qualified Urbit.Vere.Behn as Behn +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 import qualified Urbit.Vere.Term.Demux as Term -import qualified Urbit.Vere.Term.Render as Term --------------------------------------------------------------------------------- +-- Initialize pier directory. -------------------------------------------------- -_ioDrivers = [] :: [IODriver] +data PierDirectoryAlreadyExists = PierDirectoryAlreadyExists + deriving (Show, Exception) 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 + -- 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 + createDirectoryIfMissing True pax + io $ setFileMode pax ownerModes -- Load pill into boot sequence. ----------------------------------------------- -genEntropy :: RIO e Word512 -genEntropy = fromIntegral . bytesAtom <$> io (Ent.getEntropy 64) +genEntropy :: MonadIO m => m Entropy +genEntropy = Entropy . 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 +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 + 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 ------------------------------------ +-- Write to the log. ----------------------------------------------------------- +-- | Write a batch of jobs to 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 <- atomically (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) + + +-- Acquire a running serf. ----------------------------------------------------- + +printTank :: (Text -> IO ()) -> Atom -> Tank -> IO () +printTank f _priority = f . unlines . fmap unTape . wash (WashCfg 0 80) . tankTree + where + tankTree (Tank t) = t + +runSerf + :: HasPierEnv e + => TVar (Text -> IO ()) + -> FilePath + -> RAcquire e Serf +runSerf vSlog pax = do + env <- ask + Serf.withSerf (config env) + where + slog txt = atomically (readTVar vSlog) >>= (\f -> f txt) + config env = Serf.Config + { scSerf = env ^. pierConfigL . pcSerfExe . to unpack + , scPier = pax + , scFlag = env ^. pierConfigL . pcSerfFlags + , scSlog = \(pri, tank) -> printTank slog pri tank + , scStdr = \txt -> slog (txt <> "\r\n") + , scDead = pure () -- TODO: What can be done? + } -- 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 +booted + :: TVar (Text -> IO ()) + -> Pill + -> Bool + -> Ship + -> LegacyBootEvent + -> RAcquire PierEnv (Serf, EventLog) +booted vSlog pill lite ship boot = do + rio $ bootNewShip pill lite ship boot + resumed vSlog Nothing - 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 nockJob nocks <> fmap ovumJob ovums + where + nockJob nok eId = RunNok $ LifeCyc eId 0 nok + ovumJob ov eId = DoWork $ Work eId 0 (wen eId) ov + +bootNewShip + :: HasPierEnv e + => Pill + -> Bool + -> Ship + -> LegacyBootEvent + -> RIO e () +bootNewShip pill lite ship bootEv = do + seq@(BootSeq ident x y) <- genBootSeq ship pill lite bootEv + logDebug "BootSeq Computed" pierPath <- view pierPathL - liftRIO (setupPierDirectory pierPath) + rio (setupPierDirectory pierPath) + logDebug "Directory setup." - rio $ logTrace "Directory Setup" + let logPath = (pierPath ".urb/log") - log <- Log.new (pierPath <> "/.urb/log") ident + rwith (Log.new logPath ident) $ \log -> do + logDebug "Event log onitialized." + jobs <- (\now -> bootSeqJobs now seq) <$> io Time.now + writeJobs log (fromList jobs) - 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) + logDebug "Finsihed populating event log with boot sequence" -- 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 + :: TVar (Text -> IO ()) + -> Maybe Word64 + -> RAcquire PierEnv (Serf, EventLog) +resumed vSlog replayUntil = 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 $ 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 - serf <- Serf.run (Serf.Config tap flags) + rio $ do + logDebug "Replaying events" + Serf.execReplay serf log replayUntil >>= \case + Left err -> error (show err) + Right 0 -> do + logDebug "No work during replay so no snapshot" + pure () + Right _ -> do + logDebug "Taking snapshot" + io (Serf.snapshot serf) + logDebug "SNAPSHOT TAKEN" - serfSt <- rio $ Serf.replay serf log event + pure (serf, log) - rio $ Serf.snapshot serf serfSt - - pure (serf, log, serfSt) - -getSnapshot :: forall e. FilePath -> Word64 -> RIO e (Maybe FilePath) +-- | Get a fake pier directory for partial snapshots. +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) + + +-- Utils for Spawning Worker Threads ------------------------------------------- + +acquireWorker :: HasLogFunc e => Text -> RIO e () -> RAcquire e (Async ()) +acquireWorker nam act = mkRAcquire (async act) kill + where + kill tid = do + 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 + logDebug ("Killing worker thread: " <> display nam) + cancel tid - listReplays :: RIO e [Word64] - listReplays = do - createDirectoryIfMissing True replayDir - snapshotNums <- mapMaybe readMay <$> listDirectory replayDir - pure $ sort (filter (<= fromIntegral last) snapshotNums) -- Run Pier -------------------------------------------------------------------- -acquireWorker :: RIO e () -> RAcquire e (Async ()) -acquireWorker act = mkRAcquire (async act) cancel +pier + :: (Serf, EventLog) + -> TVar (Text -> IO ()) + -> MVar () + -> MultiEyreApi + -> RAcquire PierEnv () +pier (serf, log) vSlog startedSig multi = do + let logId = Log.identity log :: LogIdentity + let ship = who logId :: Ship -pier :: ∀e. (HasConfigDir e, HasLogFunc e, HasNetworkConfig e, HasPierConfig e) - => (Serf e, EventLog, SerfState) - -> MVar () - -> RAcquire e () -pier (serf, log, ss) mStart = do - computeQ <- newTQueueIO - persistQ <- newTQueueIO - executeQ <- newTQueueIO - saveM <- newEmptyTMVarIO - shutdownM <- newEmptyTMVarIO + -- TODO Instead of using a TMVar, pull directly from the IO driver + -- event sources. + computeQ :: TMVar RunReq <- newEmptyTMVarIO - kapi ← King.kingAPI + persistQ :: TQueue (Fact, FX) <- newTQueueIO + executeQ :: TQueue FX <- newTQueueIO + saveSig :: TMVar () <- newEmptyTMVarIO + kingApi :: King.King <- King.kingAPI - termApiQ <- atomically $ do - q <- newTQueue - writeTVar (King.kTermConn kapi) (Just $ writeTQueue q) - pure q + termApiQ :: TQueue TermConn <- atomically $ do + q <- newTQueue + writeTVar (King.kTermConn kingApi) (Just $ writeTQueue q) + pure q - let shutdownEvent = putTMVar shutdownM () + (demux :: Term.Demux, muxed :: Term.Client) <- atomically $ do + res <- Term.mkDemux + pure (res, Term.useDemux res) - inst <- io (KingId . UV . fromIntegral <$> randomIO @Word16) + void $ acquireWorker "TERMSERV Listener" $ forever $ do + logDebug "TERMSERV Waiting for external terminal." + atomically $ do + ext <- Term.connClient <$> readTQueue termApiQ + Term.addDemux ext demux + logDebug "TERMSERV External terminal connected." - -- (sz, local) <- Term.localClient + -- Slogs go to both stderr and to the terminal. + env <- ask + atomically $ writeTVar vSlog $ \txt -> runRIO env $ do + atomically $ Term.trace muxed txt + logOther "serf" (display $ T.strip txt) - -- (waitExternalTerm, termServPort) <- Term.termServer + -- 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 compute = putTMVar computeQ + let execute = writeTQueue executeQ + let persist = writeTQueue persistQ + let sigint = Serf.sendSIGINT serf - (demux, muxed) <- atomically $ do - res <- Term.mkDemux - -- Term.addDemux local res - pure (res, Term.useDemux res) + (bootEvents, startDrivers) <- do + env <- ask + let err = atomically . Term.trace muxed . (<> "\r\n") + let siz = TermSize { tsWide = 80, tsTall = 24 } + let fak = isFake logId + drivers env multi ship fak compute (siz, muxed) err sigint - -- rio $ logInfo $ display $ - -- "TERMSERV Terminal Server running on port: " <> tshow termServPort + scrySig <- newEmptyTMVarIO + onKill <- view onKillPierSigL - 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." + let computeConfig = ComputeConfig { ccOnWork = takeTMVar computeQ + , ccOnKill = onKill + , ccOnSave = takeTMVar saveSig + , ccOnScry = takeTMVar scrySig + , ccPutResult = persist + , ccShowSpinner = Term.spin muxed + , ccHideSpinner = Term.stopSpin muxed + , ccLastEvInLog = Log.lastEv log + } - swapMVar (sStderr serf) (atomically . Term.trace muxed) + tSerf <- acquireWorker "Serf" (runCompute serf computeConfig) - let logId = Log.identity log - let ship = who logId + -- Run all born events and retry them until they succeed. + wackEv <- EvBlip . BlipEvArvo . ArvoEvWack () <$> genEntropy + rio $ for_ (wackEv : bootEvents) $ \ev -> do + okaySig <- newEmptyMVar - -- 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 (bootEvents, startDrivers) = - drivers inst ship (isFake logId) - (writeTQueue computeQ) - shutdownEvent - (Term.TSize{tsWide=80, tsTall=24}, muxed) - showErr + let inject n = atomically $ compute $ RRWork $ EvErr ev $ cb n - io $ atomically $ for_ bootEvents (writeTQueue computeQ) + -- 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) - tExe <- startDrivers >>= router (readTQueue executeQ) - tDisk <- runPersist log persistQ (writeTQueue executeQ) - tCpu <- runCompute serf ss - (readTQueue computeQ) - (takeTMVar saveM) - (takeTMVar shutdownM) - (Term.spin muxed) - (Term.stopSpin muxed) - (writeTQueue persistQ) + -- logTrace ("[BOOT EVENT]: " <> display (summarizeEvent ev)) + io (inject 0) - tSaveSignal <- saveSignalThread saveM + let slog :: Text -> IO () + slog txt = do + fn <- atomically (readTVar vSlog) + fn txt - putMVar mStart () + drivz <- startDrivers + tExec <- acquireWorker "Effects" (router slog (readTQueue executeQ) drivz) + tDisk <- acquireWorkerBound "Persist" (runPersist log persistQ execute) - -- Wait for something to die. + let snapshotEverySecs = 120 - let ded = asum [ death "effect thread" tExe - , death "persist thread" tDisk - , death "compute thread" tCpu - ] + void $ acquireWorker "Save" $ forever $ do + threadDelay (snapshotEverySecs * 1_000_000) + void $ atomically $ tryPutTMVar saveSig () - atomically ded >>= \case - Left (txt, exn) -> logError $ displayShow ("Somthing died", txt, exn) - Right tag -> logError $ displayShow ("something simply exited", tag) + -- TODO bullshit scry tester + 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) - atomically $ (Term.spin muxed) (Just "shutdown") + putMVar startedSig () + -- Wait for something to die. + + let ded = asum + [ death "effects thread" tExec + , death "persist thread" tDisk + , death "compute thread" tSerf + ] + + atomically ded >>= \case + 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") 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 () -- 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 - } +data Drivers = Drivers + { dBehn :: BehnEf -> IO () + , dIris :: HttpClientEf -> IO () + , dEyre :: HttpServerEf -> IO () + , dNewt :: NewtEf -> IO () + , dSync :: SyncEf -> IO () + , dTerm :: TermEf -> IO () + } -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 = - (initialEvents, runDrivers) - where - (behnBorn, runBehn) = behn inst plan - (amesBorn, runAmes) = ames inst who isFake plan stderr - (httpBorn, runHttp) = serv inst plan isFake - (clayBorn, runClay) = clay inst plan - (irisBorn, runIris) = client inst plan - (termBorn, runTerm) = Term.term termSys shutdownSTM inst 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{..}) +drivers + :: HasPierEnv e + => e + -> MultiEyreApi + -> Ship + -> Bool + -> (RunReq -> STM ()) + -> (TermSize, Term.Client) + -> (Text -> RIO e ()) + -> IO () + -> RAcquire e ([Ev], RAcquire e Drivers) +drivers env multi who isFake plan termSys stderr serfSIGINT = do + (behnBorn, runBehn) <- rio Behn.behn' + (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' + (irisBorn, runIris) <- rio Iris.client' + + 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 -> 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 :: 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 Thread -------------------------------------------------------------- - -data ComputeRequest - = CREvent Ev - | CRSave () - | CRShutdown () - deriving (Eq, Show) +-- Compute (Serf) 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 = 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 - 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 = do + logTrace $ " -> " <> display (summarizeEffect 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 -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 ComputeConfig = ComputeConfig + { ccOnWork :: STM RunReq + , ccOnKill :: STM () + , ccOnSave :: STM () + , ccOnScry :: STM (Wen, Gang, Path, Maybe (Term, Noun) -> IO ()) + , ccPutResult :: (Fact, FX) -> STM () + , ccShowSpinner :: Maybe Text -> STM () + , ccHideSpinner :: STM () + , ccLastEvInLog :: STM EventId + } - 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 . HasKingEnv e => Serf.Serf -> ComputeConfig -> RIO e () +runCompute serf ComputeConfig {..} = do + logDebug "runCompute" + + let onRR = asum [ ccOnKill <&> Serf.RRKill + , ccOnSave <&> Serf.RRSave + , ccOnWork + , ccOnScry <&> \(w,g,p,k) -> Serf.RRScry w g p k + ] + + vEvProcessing :: TMVar Ev <- newEmptyTMVarIO + + void $ async $ forever (atomically (takeTMVar vEvProcessing) >>= logEvent) + + let onSpin :: Maybe Ev -> STM () + onSpin = \case + Nothing -> ccHideSpinner + Just ev -> do + ccShowSpinner (getSpinnerNameForEvent ev) + putTMVar vEvProcessing ev + + let maxBatchSize = 10 + + io (Serf.run serf maxBatchSize ccLastEvInLog onRR ccPutResult onSpin) --- Persist Thread -------------------------------------------------------------- +-- Event-Log Persistence Thread ------------------------------------------------ data PersistExn = BadEventId EventId EventId deriving Show @@ -418,43 +558,36 @@ 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 + . HasPierEnv e + => EventLog + -> TQueue (Fact, FX) + -> (FX -> STM ()) + -> 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 - 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) + where + validateFactsAndGetBytes :: [Fact] -> RIO e (Vector ByteString) + validateFactsAndGetBytes facts = do + expect <- atomically (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/Pier/Types.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs index eaa8df10de..6dbffa34c9 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs @@ -3,12 +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.Arvo -import Urbit.Time +import Urbit.Noun.Time +import Urbit.Vere.Serf.Types + +import Urbit.EventLog.LMDB (LogIdentity(..)) -- Avoid touching Nock values. ------------------------------------------------- @@ -29,25 +44,16 @@ instance Show Nock where -------------------------------------------------------------------------------- -type EventId = Word64 - data Pill = Pill - { pBootFormulas :: [Nock] - , pKernelOvums :: [Ev] - , pUserspaceOvums :: [Ev] - } - deriving (Eq, Show) - -data LogIdentity = LogIdentity - { who :: Ship - , isFake :: Bool - , lifecycleLen :: Word - } deriving (Eq, Ord, Show) + { pBootFormulas :: [Nock] + , pKernelOvums :: [Ev] + , pUserspaceOvums :: [Ev] + } + deriving (Eq, Show) data BootSeq = BootSeq LogIdentity [Nock] [Ev] deriving (Eq, Show) -deriveNoun ''LogIdentity deriveNoun ''Pill @@ -60,40 +66,25 @@ 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 ----------------------------------------------------------- -data Order - = OBoot Word -- lifecycle length - | OExit Word8 - | OSave EventId - | OWork Job - deriving (Eq, Show) - -deriveToNoun ''Order - -type QueueEv = Ev -> STM () - -type EffCb e a = a -> RIO e () - -type Perform = Ef -> IO () - -data IODriver = IODriver - { bornEvent :: IO Ev - , startDriver :: (Ev -> STM ()) -> IO (Async (), Perform) - } +data DriverApi ef = DriverApi + { diEventSource :: STM (Maybe RunReq) + , diOnEffect :: ef -> IO () + } -- Instances ------------------------------------------------------------------- @@ -102,17 +93,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 ac9b1f0355..e03512883e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf.hs @@ -1,547 +1,162 @@ {-| - Serf Interface - - TODO: `recvLen` is not big-endian safe. + High-Level Serf Interface -} -module Urbit.Vere.Serf ( Serf, sStderr, SerfState(..), doJob - , run, shutdown, kill - , replay, bootFromSeq, snapshot - , collectFX - , Config(..), Flags, Flag(..) - ) where +module Urbit.Vere.Serf + ( withSerf + , execReplay + , collectFX + , module X + ) +where import Urbit.Prelude import Data.Conduit -import System.Process -import System.ProgressBar -import Urbit.Arvo import Urbit.Vere.Pier.Types +import Urbit.Vere.Serf.IPC -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(..)) +import Control.Monad.Trans.Resource (runResourceT) +import Urbit.Arvo (FX) +import Urbit.King.App.Class (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 -import qualified Urbit.Vere.Log as Log +import qualified System.ProgressBar as PB +import qualified Urbit.EventLog.LMDB 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 +import qualified Urbit.Vere.Serf.IPC as X (Config (..), EvErr (..), Flag (..), + RunReq (..), Serf, WorkError (..), + run, sendSIGINT, snapshot, start, + stop) -------------------------------------------------------------------------------- -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 +parseLogRow :: MonadIO m => ByteString -> m (Mug, Noun) +parseLogRow = cueBSExn >=> fromNounExn -shutdown :: HasLogFunc e => Serf e -> Word8 -> RIO e () -shutdown serf code = sendOrder serf (OExit code) +withSerf :: HasLogFunc e => Config -> RAcquire e Serf +withSerf config = mkRAcquire startup kill + where + startup = do + (serf, st) <- io $ start config + logDebug (displayShow ("serf state", st)) + pure serf + kill serf = do + void $ rio $ stop serf -{-| - TODO Find a cleaner way to handle `PStdr` Pleas. --} -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) +execReplay + :: forall e + . (HasLogFunc e, HasStderrLogFunc e) + => Serf + -> Log.EventLog + -> Maybe Word64 + -> 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 (Either PlayBail Word) + doBoot = do + logDebug "Beginning boot sequence" - 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 + 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) + .| CC.mapM (fmap snd . parseLogRow) + .| CC.sinkList - ss@SerfState{..} <- recvPlea serf >>= \case - PPlay e m -> pure $ SerfState e m - x -> throwIO (InvalidInitialPlea x) + let numEvs = fromIntegral (length evs) - logTrace $ display ("Handshake result: " <> tshow ss) + when (numEvs /= bootSeqLen) $ do + throwIO (MissingBootEventsInEventLog numEvs bootSeqLen) - when (ssNextEv == 1) $ do - let ev = OBoot (lifecycleLen ident) - logTrace $ display ("No snapshot. Sending boot event: " <> tshow ev) - sendOrder serf ev + logDebug $ display ("Sending " <> tshow numEvs <> " boot events to serf") - logTrace "Finished handshake" + io (boot serf evs) >>= \case + Just err -> do + logDebug "Error on replay, exiting" + pure (Left err) + Nothing -> do + logDebug "Finished boot events, moving on to more events from log." + doReplay <&> \case + Left err -> Left err + Right num -> Right (num + numEvs) - 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 (Either PlayBail Word) + doReplay = do logTrace "Beginning event log replay" + lastEventInSnap <- io (serfLastEventBlocking 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 + logLastEv :: Word64 <- atomically $ fromIntegral <$> Log.lastEv log 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 + throwIO (SnapshotAheadOfLog logLastEv lastEventInSnap) + + incProgress <- logStderr (trackProgress (fromIntegral numEvs)) + logTrace $ display $ "Replaying up to event #" <> tshow replayUpTo logTrace $ display $ "Will replay " <> tshow numEvs <> " in total." - runConduit $ Log.streamEvents log serfNextEv - .| CC.take (fromIntegral numEvs) - .| toJobs (Log.identity log) serfNextEv - .| replayJobs serf (fromIntegral replayUpTo) ss + env <- ask -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) + res <- runResourceT + $ runConduit + $ Log.streamEvents log (lastEventInSnap + 1) + .| CC.take (fromIntegral numEvs) + .| CC.mapM (fmap snd . parseLogRow) + .| replay 5 incProgress serf - 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) + res & \case + Nothing -> pure (Right $ fromIntegral numEvs) + Just er -> pure (Left er) + +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 Effects for Parsing ------------------------------------------------- +-- Collect FX ------------------------------------------------------------------ -collectFX :: HasLogFunc e => Serf e -> Log.EventLog -> RIO e () +collectFX :: HasLogFunc e => Serf -> Log.EventLog -> RIO e () collectFX serf log = do - ss <- handshake serf (Log.identity log) + lastEv <- io (serfLastEventBlocking serf) + runResourceT + $ runConduit + $ Log.streamEvents log (lastEv + 1) + .| CC.mapM (parseLogRow >=> fromNounExn . snd) + .| swim serf + .| persistFX 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) +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 new file mode 100644 index 0000000000..3b0d5b1406 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs @@ -0,0 +1,704 @@ +{-| + 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 `run` 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 + $% [%cram eve=@] + [%exit cod=@] + [%save eve=@] + [%pack ~] + == == + [%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=%1 hon=@ nok=@] eve=@ mug=@] + [%slog pri=@ ?(cord tank)] + $: %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 @da ovum) fec=(list ovum)] + [%bail lud=(list goof)] + == == + == + ``` +-} + +module Urbit.Vere.Serf.IPC + ( Serf + , start + , stop + , serfLastEventBlocking + , snapshot + , compact + , scry + , boot + , replay + , run + , swim + , sendSIGINT + , module Urbit.Vere.Serf.Types + ) +where + +import Urbit.Prelude hiding ((<|)) + +import Data.Bits +import Data.Conduit +import System.Process +import Urbit.Vere.Serf.Types + +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 (sigINT, sigKILL, signalProcess) +import Urbit.Arvo (Ev, FX) +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.Noun.Time as Time + + +-- 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 + | LSave EventId + | LCram EventId + | LPack () + deriving (Show) + +data Play + = PDone Mug + | 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 + | WBail [Goof] + deriving (Show) + +data Writ + = WLive Live + | WPeek Atom Wen Gang Path + | WPlay EventId [Noun] + | WWork Atom Wen Ev + deriving (Show) + +data Plea + = PLive () + | PRipe SerfInfo + | PSlog Slog + | PPeek Scry + | PPlay Play + | PWork Work + deriving (Show) + +deriveNoun ''Live +deriveNoun ''Play +deriveNoun ''Scry +deriveNoun ''Work +deriveNoun ''Writ +deriveNoun ''Plea + + +-- Access Current Serf State --------------------------------------------------- + +serfLastEventBlocking :: Serf -> IO EventId +serfLastEventBlocking Serf{serfLock} = readMVar serfLock >>= \case + Nothing -> throwIO SerfNotRunning + Just ss -> pure (ssLast ss) + + +-- Low Level IPC Functions ----------------------------------------------------- + +fromRightExn :: (Exception e, MonadIO m) => Either a b -> (a -> e) -> m b +fromRightExn (Left m) exn = throwIO (exn m) +fromRightExn (Right x) _ = pure x + +-- TODO Support Big Endian +sendLen :: Serf -> Int -> IO () +sendLen s i = do + w <- evaluate (fromIntegral i :: Word64) + 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 + 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 = 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 @Word64 . castPtr) + _ -> throwIO SerfConnectionClosed + +recvResp :: Serf -> IO ByteString +recvResp serf = do + len <- recvLen serf + recvBytes serf len + + +-- Send Writ / Recv Plea ------------------------------------------------------- + +sendWrit :: Serf -> Writ -> IO () +sendWrit s = sendBytes s . jamBS . toNoun + +recvPlea :: Serf -> IO Plea +recvPlea w = do + 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 +recvPleaHandlingSlog serf = loop + where + loop = recvPlea serf >>= \case + PSlog info -> serfSlog serf info >> loop + other -> pure other + + +-- Higher-Level IPC Functions -------------------------------------------------- + +recvRipe :: Serf -> IO SerfInfo +recvRipe serf = recvPleaHandlingSlog serf >>= \case + PRipe ripe -> pure ripe + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %play") + +recvPlay :: Serf -> IO Play +recvPlay serf = recvPleaHandlingSlog serf >>= \case + PPlay play -> pure play + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %play") + +recvLive :: Serf -> IO () +recvLive serf = recvPleaHandlingSlog serf >>= \case + PLive () -> pure () + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %live") + +recvWork :: Serf -> IO Work +recvWork serf = do + recvPleaHandlingSlog serf >>= \case + PWork work -> pure work + plea -> throwIO (UnexpectedPlea (toNoun plea) "expecting %work") + +recvPeek :: Serf -> IO (Maybe (Term, Noun)) +recvPeek serf = do + recvPleaHandlingSlog serf >>= \case + 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 ----------------------- + +sendSnapshotRequest :: Serf -> EventId -> IO () +sendSnapshotRequest serf eve = do + sendWrit serf (WLive $ LSave eve) + recvLive serf + +sendCompactionRequest :: Serf -> IO () +sendCompactionRequest serf = do + sendWrit serf (WLive $ LPack ()) + recvLive serf + +sendScryRequest :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun)) +sendScryRequest serf w g p = do + sendWrit serf (WPeek 0 w g p) + recvPeek serf + +sendShutdownRequest :: Serf -> Atom -> IO () +sendShutdownRequest serf exitCode = do + sendWrit serf (WLive $ LExit exitCode) + pure () + + +-- Starting the Serf ----------------------------------------------------------- + +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 + void $ async (readStdErr e onStdr onDead) + vLock <- newEmptyMVar + let serf = Serf i o p onSlog vLock + info <- recvRipe serf + putMVar vLock (Just $ siStat info) + pure (serf, info) + where + diskKey = "" + config = show (compileFlags flags) + rock = "0" -- XX support loading from rock + cache = "50000" -- XX support memo-cache size + args = ["serf", pierPath, diskKey, config, cache, rock] + pSpec = (proc exePax args) { std_in = CreatePipe + , std_out = CreatePipe + , std_err = CreatePipe + } + + +-- Taking the SerfState Lock --------------------------------------------------- + +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 + 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)) + + +-- 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. +-} +stop :: HasLogFunc e => Serf -> RIO e () +stop serf = do + race_ niceKill (wait2sec >> forceKill) + where + 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 (forcefullyKillSerf serf) + logTrace "Serf process killed with SIGTERM." + +{-| + 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) + + +-- 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 + 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 + the serf can determine the length of the boot sequence. +-} +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) + +{-| + 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 + . (MonadResource m, MonadUnliftIO m, MonadIO m) + => Int + -> (Int -> IO ()) + -> Serf + -> ConduitT Noun Void m (Maybe PlayBail) +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 + awaitBatch batchSize >>= \case + [] -> pure (Nothing, SerfState lastEve lastMug) + evs -> do + let nexEve = lastEve + 1 + let newEve = lastEve + fromIntegral (length evs) + io $ sendWrit serf (WPlay nexEve evs) + io (recvPlay serf) >>= \case + PBail bail -> pure (Just bail, SerfState lastEve lastMug) + 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. +-} +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) + + +-- 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, MonadResource m) + => Serf + -> ConduitT (Wen, Ev) (EventId, FX) m () +swim serf = do + withSerfLock 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 0 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 ----------------------------------------------------------- + +{-| + TODO Don't take snapshot until event log has processed current event. +-} +run + :: Serf + -> Int + -> STM EventId + -> STM RunReq + -> ((Fact, FX) -> STM ()) + -> (Maybe Ev -> STM ()) + -> IO () +run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop + where + topLoop :: IO () + topLoop = atomically onInput >>= \case + RRWork workErr -> doWork workErr + RRSave () -> doSave + RRKill () -> doKill + RRPack () -> doPack + RRScry w g p k -> doScry w g p k + + doPack :: IO () + doPack = compact serf >> topLoop + + waitForLog :: IO () + waitForLog = do + serfLast <- serfLastEventBlocking serf + atomically $ do + logLast <- getLastEvInLog + when (logLast < serfLast) retry + + 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 + + doWork :: EvErr -> IO () + doWork firstWorkErr = do + que <- newTBMQueueIO 1 + () <- atomically (writeTBMQueue que firstWorkErr) + tWork <- async (processWork serf maxBatchSize que onWorkResp spin) + flip onException (cancel tWork) $ do + nexSt <- workLoop que + wait tWork + nexSt + + workLoop :: TBMQueue EvErr -> IO (IO ()) + workLoop que = atomically onInput >>= \case + 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) + RRWork workErr -> atomically (writeTBMQueue que workErr) >> workLoop que + + 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) + atomically $ sendOn (Fact eid hash wen noun, fx) + WBail goofs -> do + io $ err (RunBail goofs) + +{-| + 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 >= maxSize + then retry + else readTBMQueue queue + +{-| + 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 ()) + -> (Maybe Ev -> STM ()) + -> IO () +processWork serf maxSize q onResp spin = do + vDoneFlag <- newTVarIO False + vInFlightQueue <- newTVarIO empty + recvThread <- async (recvLoop serf vDoneFlag vInFlightQueue spin) + 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 + atomically (pullFromQueueBounded maxSize vInFlight q) >>= \case + Nothing -> do + atomically (writeTVar vDone True) + Just evErr@(EvErr ev _) -> do + now <- Time.now + let cb = onResp now evErr + atomically $ modifyTVar' vInFlight (:|> (ev, cb)) + sendWrit serf (WWork 0 now ev) + loop vInFlight vDone + +{-| + 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 ())) + -> (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 (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 (Ev, Work -> IO ())) + takeCallback = do + ((,) <$> readTVar vDone <*> readTVar vWork) >>= \case + (False, Empty ) -> retry + (True , Empty ) -> pure Nothing + (_ , (e, x) :<| xs) -> writeTVar vWork xs $> Just (e, x) + (_ , _ ) -> error "impossible" 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 0000000000..1544a56fe6 --- /dev/null +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs @@ -0,0 +1,121 @@ +module Urbit.Vere.Serf.Types where + +import Urbit.Prelude + +import Urbit.Arvo (Ev, FX) +import Urbit.Noun.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 -- 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 + 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 + | PeekBail Goof + | 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 diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs index dc85580b33..06082c142d 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 @@ -18,19 +19,21 @@ import RIO.FilePath import System.Posix.IO import System.Posix.Terminal import Urbit.Arvo hiding (Term) -import Urbit.King.Config +import Urbit.King.App +import Urbit.Noun.Time import Urbit.Prelude hiding (getCurrentTime) -import Urbit.Time import Urbit.Vere.Pier.Types 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 System.Console.ANSI as ANSI +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 @@ -74,20 +77,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) @@ -138,7 +127,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 @@ -153,20 +142,46 @@ 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. -} 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 - 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 @@ -187,12 +202,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 @@ -226,17 +241,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. @@ -246,9 +250,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 @@ -266,6 +268,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 @@ -274,7 +278,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 @@ -291,7 +298,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 @@ -306,16 +313,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 @@ -356,8 +363,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 @@ -489,28 +496,55 @@ localClient doneSignal = fst <$> mkRAcquire start stop -- logDebug $ displayShow ("terminalBelt", b) atomically $ writeTQueue rq b + -------------------------------------------------------------------------------- +{-| + Terminal Driver + + 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 + => (TermSize, Client) + -> IO () + -> RIO e ([Ev], RAcquire e (DriverApi TermEf)) +term' (tsize, client) serfSIGINT = do + let TermSize 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) serfSIGINT + + let diEventSource = fmap RRWork <$> tryReadTQueue ventQ + + pure (DriverApi {..}) + {-| Terminal Driver -} -term :: forall e. (HasPierConfig e, HasLogFunc e) - => (T.TSize, Client) - -> (STM ()) - -> KingId - -> QueueEv - -> ([Ev], RAcquire e (EffCb e TermEf)) -term (tsize, Client{..}) shutdownSTM king enqueueEv = - (initialEvents, runTerm) +term :: forall e. (HasPierEnv e) + => e + -> (TermSize, Client) + -> (EvErr -> STM ()) + -> IO () + -> RAcquire e (TermEf -> IO ()) +term env (tsize, Client{..}) plan serfSIGINT = runTerm where - T.TSize wi hi = tsize - - initialEvents = [(initialBlew wi hi), initialHail] - - 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 @@ -521,14 +555,17 @@ term (tsize, Client{..}) shutdownSTM king enqueueEv = atomically take >>= \case Nothing -> pure () Just b -> do - let blip = EvBlip $ BlipEvTerm $ TermEvBelt (UD 1, ()) $ b - atomically $ enqueueEv $ blip + when (b == Ctl (Cord "c")) $ do + io serfSIGINT + let beltEv = EvBlip $ BlipEvTerm $ TermEvBelt (UD 1, ()) $ b + let beltFailed _ = pure () + atomically $ plan (EvErr beltEv beltFailed) handleEffect :: TermEf -> RIO e () 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] 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 9b805e7b5b..a7751a005f 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 e4da0a37b9..d1e8b6a774 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 @@ -72,6 +72,7 @@ dependencies: - primitive - process - QuickCheck + - racquire - random - regex-tdfa - regex-tdfa-text @@ -88,10 +89,10 @@ dependencies: - tasty-th - template-haskell - terminal-progress-bar - - terminal-size - text - these - time + - tls - transformers - unix - unliftio @@ -99,7 +100,11 @@ dependencies: - unordered-containers - urbit-atom - urbit-azimuth + - urbit-eventlog-lmdb - urbit-hob + - urbit-noun + - urbit-noun-core + - urbit-termsize - utf8-string - vector - wai diff --git a/pkg/hs/urbit-king/test/AmesTests.hs b/pkg/hs/urbit-king/test/AmesTests.hs index a68bb9a0b7..6be3e5c8c9 100644 --- a/pkg/hs/urbit-king/test/AmesTests.hs +++ b/pkg/hs/urbit-king/test/AmesTests.hs @@ -8,22 +8,27 @@ 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.Time import Urbit.Vere.Ames -import Urbit.Vere.Log import Urbit.Vere.Pier.Types 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 +import qualified Urbit.EventLog.LMDB 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,67 +54,81 @@ 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 - let (_, runAmes) = - ames pid (fromIntegral point) True (writeTQueue q) noStderr - cb ← runAmes - rio $ cb turfEf - pure (q, cb) +runGala + :: forall e + . HasAmes e + => Word8 + -> RAcquire e (TQueue EvErr, NewtEf -> IO ()) +runGala point = do + env <- ask + que <- newTQueueIO + let enqueue = \p -> writeTQueue que p $> Intake + let (_, runAmes) = ames env (fromIntegral point) True enqueue noStderr + cb <- runAmes + io (cb turfEf) + pure (que, cb) 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 + 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 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/ArvoTests.hs b/pkg/hs/urbit-king/test/ArvoTests.hs index 7dac215a33..b2396b4296 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.Time -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 11b48ce489..d8b18cb943 100644 --- a/pkg/hs/urbit-king/test/BehnTests.hs +++ b/pkg/hs/urbit-king/test/BehnTests.hs @@ -9,37 +9,36 @@ 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.Time import Urbit.Vere.Behn -import Urbit.Vere.Log import Urbit.Vere.Pier.Types 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 (runKingEnvNoLog, HasKingId(..)) -import qualified Urbit.Time as Time -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log +import qualified Urbit.Noun.Time as Time -------------------------------------------------------------------------------- -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 . runKingEnvNoLog . 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 - cb (BehnEfDoze (king, ()) (Just (2^20))) + rwith (liftAcquire $ behn envr (writeTQueue q)) $ \cb -> do + io $ cb (BehnEfDoze (king, ()) (Just (2^20))) t <- atomically $ readTQueue q pure True diff --git a/pkg/hs/urbit-king/test/DeriveNounTests.hs b/pkg/hs/urbit-king/test/DeriveNounTests.hs index 1cb43abf50..d883d29fa4 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 3e65092882..d4317069ea 100644 --- a/pkg/hs/urbit-king/test/LogTests.hs +++ b/pkg/hs/urbit-king/test/LogTests.hs @@ -7,16 +7,16 @@ 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 Urbit.King.App (App, runApp) +import Urbit.King.App (KingEnv, runKingEnvNoLog) -import qualified Urbit.Vere.Log as Log +import qualified Urbit.EventLog.LMDB as Log -- Utils ----------------------------------------------------------------------- @@ -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,13 @@ withDb dir (Db dId dEvs dFx) act = do -------------------------------------------------------------------------------- +runApp :: RIO KingEnv a -> IO a +runApp = runKingEnvNoLog + 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 +80,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 +92,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 +109,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 +126,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 diff --git a/pkg/hs/urbit-noun-core/.gitignore b/pkg/hs/urbit-noun-core/.gitignore new file mode 100644 index 0000000000..65e7ea8181 --- /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 0000000000..bf9294e05c --- /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 0000000000..f9fee33741 --- /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 0000000000..65e7ea8181 --- /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 0000000000..bf9294e05c --- /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 99% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Conversions.hs index 77fe234d75..6a8b5fddfe 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs +++ b/pkg/hs/urbit-noun/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/Noun/Tank.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs similarity index 93% rename from pkg/hs/urbit-king/lib/Urbit/Noun/Tank.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Tank.hs index 90a315ab6f..bfba684c7d 100644 --- a/pkg/hs/urbit-king/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 diff --git a/pkg/hs/urbit-king/lib/Urbit/Time.hs b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs similarity index 64% rename from pkg/hs/urbit-king/lib/Urbit/Time.hs rename to pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs index ba9cbfb55f..55122fcb34 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Time.hs +++ b/pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs @@ -2,16 +2,21 @@ TODO This is slow. -} -module Urbit.Time where +module Urbit.Noun.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/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 0000000000..d94be31f67 --- /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 diff --git a/pkg/hs/urbit-termsize/.gitignore b/pkg/hs/urbit-termsize/.gitignore new file mode 100644 index 0000000000..e5904eabeb --- /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 0000000000..bf9294e05c --- /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 0000000000..798ece23fa --- /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 0000000000..33f2d78cf6 --- /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 0000000000..83efc8c17a --- /dev/null +++ b/pkg/hs/urbit-termsize/package.yaml @@ -0,0 +1,25 @@ +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: + urbit-test-termsize-updates: + main: Main.hs + source-dirs: app + dependencies: + - urbit-termsize diff --git a/pkg/urbit/Makefile b/pkg/urbit/Makefile index 850f56e8f2..972310caac 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/configure b/pkg/urbit/configure index 8ae0f453cf..6157fb544b 100755 --- a/pkg/urbit/configure +++ b/pkg/urbit/configure @@ -2,11 +2,11 @@ set -e -URBIT_VERSION="0.10.7" +URBIT_VERSION="0.10.8" -deps=" \ - curl gmp sigsegv argon2 ed25519 ent h2o scrypt sni uv murmur3 secp256k1 \ - softfloat3 ncurses 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 pthread \ " headers=" \ diff --git a/pkg/urbit/daemon/main.c b/pkg/urbit/daemon/main.c index 657d1c2ac5..95d097b31f 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 @@ -20,6 +18,7 @@ #include #include #include +#include #define U3_GLOBAL #define C3_GLOBAL @@ -97,9 +96,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:C:w:u:e:F:k:p:LljacdgqstvxPDRS")) ) + "X:Y:G:J:B:K:A:H:I:C: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; @@ -162,6 +169,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; @@ -172,6 +183,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; } @@ -398,7 +413,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", @@ -449,7 +466,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, @@ -474,19 +490,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(); -} - -/* _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 - // - if ( 0 != u3K.len_w ) { - u3_pier_db_shutdown(u3_pier_stub()); - } + u3_king_bail(); } /* @@ -584,7 +588,7 @@ _fork_into_background_process() static void _stop_on_boot_completed_cb() { - u3_pier_exit(u3_pier_stub()); + u3_king_exit(); } c3_i @@ -603,12 +607,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(); } @@ -651,10 +649,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); @@ -768,7 +762,7 @@ main(c3_i argc, exit(1); } - u3_daemon_commence(); + u3_king_commence(); // uninitialize curl // diff --git a/pkg/urbit/include/c/defs.h b/pkg/urbit/include/c/defs.h index 636ee861bb..8eee3998cd 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. */ diff --git a/pkg/urbit/include/c/motes.h b/pkg/urbit/include/c/motes.h index e980e99aea..8f9f040136 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') @@ -365,6 +366,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') @@ -928,6 +930,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 +1065,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 +1210,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/include/noun/aliases.h b/pkg/urbit/include/noun/aliases.h index c8d0e852f8..5e98714d48 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/allocate.h b/pkg/urbit/include/noun/allocate.h index 934b70328b..ee95cc31e1 100644 --- a/pkg/urbit/include/noun/allocate.h +++ b/pkg/urbit/include/noun/allocate.h @@ -465,6 +465,36 @@ c3_w u3a_mark_road(FILE* fil_u); + /* u3a_reclaim(): clear ad-hoc persistent caches to reclaim memory. + */ + 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 + 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_count_noun(): count size of noun. */ c3_w @@ -493,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/hashtable.h b/pkg/urbit/include/noun/hashtable.h index a6457ad951..bf9f50e176 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/imprison.h b/pkg/urbit/include/noun/imprison.h index 363feb42e2..714bf15c6c 100644 --- a/pkg/urbit/include/noun/imprison.h +++ b/pkg/urbit/include/noun/imprison.h @@ -1,60 +1,67 @@ -/* 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_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` @@ -63,13 +70,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 +77,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/include/noun/jets.h b/pkg/urbit/include/noun/jets.h index aa3934284a..bc9b1e3b9a 100644 --- a/pkg/urbit/include/noun/jets.h +++ b/pkg/urbit/include/noun/jets.h @@ -287,12 +287,17 @@ c3_w u3j_mark(FILE* fil_u); - /* 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/manage.h b/pkg/urbit/include/noun/manage.h index 7da08e6292..a05ce78714 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. */ @@ -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/include/noun/nock.h b/pkg/urbit/include/noun/nock.h index 243932fa1b..1e7c6430ea 100644 --- a/pkg/urbit/include/noun/nock.h +++ b/pkg/urbit/include/noun/nock.h @@ -117,6 +117,16 @@ 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 + u3n_rewrite_compact(); + /* u3n_free(): free bytecode cache. */ void diff --git a/pkg/urbit/include/noun/retrieve.h b/pkg/urbit/include/noun/retrieve.h index dffb3759fc..eed2bcc916 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/include/noun/vortex.h b/pkg/urbit/include/noun/vortex.h index ba0593f9e0..7dcab4e7ee 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 @@ -98,3 +103,13 @@ */ 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 + u3v_rewrite_compact(); diff --git a/pkg/urbit/include/vere/db/lmdb.h b/pkg/urbit/include/vere/db/lmdb.h new file mode 100644 index 0000000000..53453419d7 --- /dev/null +++ b/pkg/urbit/include/vere/db/lmdb.h @@ -0,0 +1,56 @@ +/* include/vere/db/lmdb-impl.h +*/ + +#include + + /* lmdb api wrapper + */ + + /* u3_lmdb_init(): open lmdb at [pax_c], mmap up to [siz_i]. + */ + MDB_env* + u3_lmdb_init(const c3_c* pax_c, size_t siz_i); + + /* u3_lmdb_exit(): close lmdb. + */ + void + u3_lmdb_exit(MDB_env* env_u); + + /* u3_lmdb_gulf(): read first and last event numbers. + */ + c3_o + u3_lmdb_gulf(MDB_env* env_u, c3_d* low_d, c3_d* hig_d); + + /* u3_lmdb_read(): read [len_d] events starting at [eve_d]. + */ + c3_o + u3_lmdb_read(MDB_env* env_u, + void* ptr_v, + c3_d eve_d, + c3_d len_d, + c3_o (*read_f)(void*, c3_d, size_t , void*)); + + /* u3_lmdb_save(): save [len_d] events starting at [eve_d]. + */ + c3_o + u3_lmdb_save(MDB_env* env_u, + c3_d eve_d, + c3_d len_d, + void** byt_p, + size_t* siz_i); + + /* u3_lmdb_read_meta(): read by string from the META db. + */ + void + u3_lmdb_read_meta(MDB_env* env_u, + void* ptr_v, + const c3_c* key_c, + void (*read_f)(void*, size_t, void*)); + + /* u3_lmdb_save_meta(): save by string into the META db. + */ + c3_o + 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/include/vere/serf.h b/pkg/urbit/include/vere/serf.h new file mode 100644 index 0000000000..12647dbb6a --- /dev/null +++ b/pkg/urbit/include/vere/serf.h @@ -0,0 +1,65 @@ +/* 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 cache + 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_uncram(): initialize from rock at [eve_d]. + */ + void + u3_serf_uncram(u3_serf* sef_u, c3_d eve_d); + + /* 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_peek(): read namespace. + */ + u3_noun + u3_serf_peek(u3_serf* sef_u, c3_w mil_w, u3_noun sam); + + /* u3_serf_play(): apply event list, producing status. + */ + u3_noun + u3_serf_play(u3_serf* sef_u, c3_d eve_d, u3_noun lit); + + /* u3_serf_work(): apply event, producing effects. + */ + u3_noun + u3_serf_work(u3_serf* sef_u, c3_w mil_w, u3_noun job); + + /* u3_serf_post(): update serf state post-writ. + */ + void + u3_serf_post(u3_serf* sef_u); + + /* u3_serf_grab(): garbage collect. + */ + void + u3_serf_grab(void); diff --git a/pkg/urbit/include/vere/vere.h b/pkg/urbit/include/vere/vere.h index 41a539b803..de8379d3ba 100644 --- a/pkg/urbit/include/vere/vere.h +++ b/pkg/urbit/include/vere/vere.h @@ -1,10 +1,7 @@ -/* include/v/vere.h -** -** This file is in the public domain. +/* include/vere/vere.h */ -#include "h2o.h" -#include +#include /** Quasi-tunable parameters. **/ @@ -13,8 +10,6 @@ # define FirstKernel 164 # define DefaultKernel 164 -#define RECK - /** Data types. **/ @@ -36,219 +31,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_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 { - 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_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_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 { @@ -256,26 +38,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 *); - - /* 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; + typedef void (*u3_moor_bail)(void*, const c3_c* err_c); /* u3_meat: blob message block. */ @@ -285,35 +54,61 @@ 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 { uv_pipe_t pyp_u; // input stream - u3_bail bal_f; // error response function - void* vod_p; // callback pointer - u3_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_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 } u3_moat; /* u3_mojo: outbound message stream. */ typedef struct _u3_mojo { - uv_pipe_t pyp_u; // output stream - u3_bail bal_f; // error response function + 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_bail bal_f; - void* vod_p; - u3_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. @@ -331,22 +126,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 { @@ -399,51 +178,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 { @@ -452,30 +186,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; - - /* 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 { @@ -533,6 +243,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. @@ -566,10 +277,12 @@ 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 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 @@ -577,6 +290,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. @@ -588,138 +303,334 @@ 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_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 - 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 /** New pier system. **/ - /* u3_writ: inbound event. + /* 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 { + 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 + u3_noun cad; // card + 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 + } u3_ovum; + + /* u3_fact: completed event + */ + typedef struct _u3_fact { + c3_d eve_d; // event number + c3_l bug_l; // kernel mug before XX remove + c3_l mug_l; // kernel mug after + u3_noun job; // (pair date ovum) + struct _u3_fact* nex_u; // next in queue + } u3_fact; + + /* u3_gift: effects + */ + 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_info: ordered, contiguous slice of facts + */ + typedef struct _u3_info { + u3_fact* ent_u; // queue entry (highest) + u3_fact* ext_u; // queue exit (lowest) + } u3_info; + + /* u3_peek_cb: namespace read response callback. + */ + typedef void (*u3_peek_cb)(void*, u3_noun); + + /* u3_peek: namespace read request + */ + typedef struct _u3_peek { + void* ptr_v; // context + u3_peek_cb fun_f; // callback + u3_noun now; // XX + u3_noun gan; // leakset + u3_noun ful; // /care/beam + } u3_peek; + + /* 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_cram = 4, + u3_writ_pack = 5, + u3_writ_exit = 6 + } u3_writ_type; + + /* u3_writ: ipc message from king to serf */ 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 + struct timeval tim_u; // time enqueued + u3_atom mat; // serialized + struct _u3_writ* nex_u; // next in queue + u3_writ_type typ_e; // type-tagged + union { // + 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 + }; } u3_writ; - /* u3_controller: working process controller. + /* u3_lord_cb: u3_lord callbacks */ - typedef struct _u3_controller { + typedef struct _u3_lord_cb { + void* ptr_v; + 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 (*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 (*cram_f)(void*); + void (*bail_f)(void*); + void (*exit_f)(void*); + } 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 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; // 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 + } 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_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 { + 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); + 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 + void* mdb_u; // lmdb environment. + c3_d sen_d; // commit requested + c3_d dun_d; // committed + u3_disk_cb cb_u; // callbacks + 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; - /* u3_boot: startup controller. - */ - typedef struct _u3_boot { - u3_noun pil; // pill - u3_noun ven; // boot event - struct _u3_pier* pir_u; // pier backpointer - } u3_boot; - /* u3_psat: pier state. */ 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_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 { + u3_noun bot; // boot formulas + u3_noun mod; // module ova + u3_noun use; // userpace ova + } u3_boot; + + /* u3_play: replay control. + */ + typedef struct _u3_play { + c3_d eve_d; // target + c3_d req_d; // last read requested + c3_d sen_d; // 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*); + 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; + + /* u3_auto: abstract i/o driver + */ + typedef struct _u3_auto { + 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; + struct _u3_pier* pir_u; + } u3_auto; + + /* u3_wall: pier barrier + */ + typedef struct _u3_wall { + void* ptr_v; + 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 { 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_disk* log_u; // event log - u3_controller* god_u; // computer - u3_ames* sam_u; // packet interface - u3_behn* teh_u; // behn timer - u3_unix* unx_u; // sync and clay + u3_lord* god_u; // computer + 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 - 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 + struct _u3_pier* nex_u; // next in list } u3_pier; /* 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 + u3_pier* pir_u; // pier list + uv_timer_t tim_u; // gc timer + } u3_king; + + /* u3_pier_spin(): (re-)activate idle handler + */ + void + u3_pier_spin(u3_pier* pir_u); # 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. **/ @@ -793,6 +704,290 @@ c3_d u3_time_gap_ms(u3_noun now, u3_noun wen); + /** 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* + 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); + + /* u3_ovum_init: initialize an unlinked potential event + */ + u3_ovum* + u3_ovum_init(c3_w mil_w, + 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); + + /* 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. + */ + 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 + 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); + + /* 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(): 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 + u3_auto_peer(u3_ovum* egg_u, + void* ptr_v, + u3_ovum_peer news_f, + u3_ovum_bail bail_f); + + /* 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_info(): print status info. + */ + void + u3_disk_info(u3_disk* log_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(): 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 + u3_disk_plan(u3_disk* log_u, u3_fact* tac_u); + + /* 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_info(): print status info. + */ + void + u3_lord_info(u3_lord* god_u); + + /* u3_lord_exit(): shutdown gracefully. + */ + void + 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. + */ + c3_o + u3_lord_save(u3_lord* god_u); + + /* u3_lord_cram(): save portable state. + */ + c3_o + u3_lord_cram(u3_lord* god_u); + + /* 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_info fon_u); + + /* u3_lord_peek(): read namespace. + */ + void + u3_lord_peek(u3_lord* god_u, + u3_noun gan, + u3_noun ful, + void* ptr_v, + 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* ptr_v, + 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* ptr_v, + u3_peek_cb fun_f); + /** Filesystem (new api). **/ /* u3_walk_load(): load file or bail. @@ -810,11 +1005,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 @@ -825,35 +1015,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. @@ -861,19 +1022,12 @@ 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. */ 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. */ @@ -885,16 +1039,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 @@ -905,31 +1049,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. */ @@ -946,47 +1069,24 @@ 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. **/ - /* 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 @@ -1017,204 +1117,90 @@ /** 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. **/ /* 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. **/ - /* 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. **/ - /** 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_auto* + u3_cttp_io_init(u3_pier* pir_u); - /* u3_cttp_io_exit(): terminate cttp I/O. + /** fore, first events + **/ + /* u3_hind_io_init(): initialize fore */ - void - u3_cttp_io_exit(void); + u3_auto* + 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. **/ - /* 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 - 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. */ 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. + /* 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); + /* 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 + 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. - */ - 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 @@ -1223,31 +1209,26 @@ /* u3_pier_bail(): immediately shutdown.. */ void - u3_pier_bail(void); + u3_pier_bail(u3_pier* pir_u); - /* u3_pier_work(): send event; real pier pointer. + /* u3_pier_save(): request checkpoint. + */ + c3_o + u3_pier_save(u3_pier* pir_u); + + /* u3_pier_cram(): save a portable snapshot. + */ + c3_o + u3_pier_cram(u3_pier* pir_u); + + /* u3_pier_info(): print status info. */ void - u3_pier_work(u3_pier* pir_u, u3_noun pax, u3_noun fav); - - /* u3_pier_snap(): request checkpoint. - */ - void - u3_pier_snap(u3_pier* pir_u); - - /* u3_pier_stub(): get the One Pier for unreconstructed code. - */ - 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_info(u3_pier* pir_u); /* 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 @@ -1256,7 +1237,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. @@ -1269,6 +1250,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 @@ -1289,95 +1280,41 @@ 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_stub(): get the One Pier for unreconstructed code. */ - void - u3_daemon_bail(void); + u3_pier* + u3_king_stub(void); - /* u3_daemon_grab(): gc the daemon + /* u3_king_info(): print status info. */ void - u3_daemon_grab(void* vod_p); + u3_king_info(void); + + /* u3_king_done(): all piers closed + */ + void + u3_king_done(void); + + /* u3_king_exit(): shutdown gracefully + */ + void + u3_king_exit(void); + + /* u3_king_bail(): immediately shutdown. + */ + void + u3_king_bail(void); + + /* u3_king_grab(): gc the daemon + */ + void + u3_king_grab(void* ptr_v); 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(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)); - - /* 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/noun/allocate.c b/pkg/urbit/noun/allocate.c index ea44ef1684..48aeb47716 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; } @@ -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,39 @@ 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 +u3a_rewrite_compact(void) +{ + 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 +2236,255 @@ u3a_sweep(void) return neg_w; } +/* u3a_pack_seek(): sweep the heap, modifying boxes to record new addresses. +*/ +void +u3a_pack_seek(u3a_road* rod_u) +{ + // 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 ) { + box_u = (void *)box_w; + siz_w = box_u->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; + + while ( end_w < box_w ) { + box_u = (void *)box_w; + siz_w = box_w[-1]; + + 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 + // + { + c3_w i_w; + for ( i_w = 0; i_w < u3a_fbox_no; i_w++ ) { + u3R->all.fre_p[i_w] = 0; + } + + u3R->all.fre_w = 0; + u3R->all.cel_p = 0; + } +} + +/* 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 86162741d0..b010fd13e0 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/hashtable.c b/pkg/urbit/noun/hashtable.c index 3eb7152beb..1838c8945d 100644 --- a/pkg/urbit/noun/hashtable.c +++ b/pkg/urbit/noun/hashtable.c @@ -942,6 +942,85 @@ u3h_mark(u3p(u3h_root) har_p) return tot_w; } +/* _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_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/imprison.c b/pkg/urbit/noun/imprison.c index be9decee5a..6eb533c436 100644 --- a/pkg/urbit/noun/imprison.c +++ b/pkg/urbit/noun/imprison.c @@ -1,90 +1,25 @@ -/* 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) -{ - c3_w *b_w = c3_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); - c3_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. - */ + u3_noun pro; + u3t_on(mal_o); + + // 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; @@ -103,18 +38,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; @@ -123,8 +58,8 @@ u3i_bytes(c3_w a_w, } } - /* Fill the bytes. - */ + // Fill the bytes. + // { c3_w i_w; @@ -132,13 +67,137 @@ 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_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) +{ + u3_noun pro; + u3t_on(mal_o); + + // 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]; + } + } + + pro = u3a_to_pug(u3a_outa(nov_w)); + } + + u3t_off(mal_o); + return pro; +} + +/* u3i_chubs(): Copy [a] chubs from [b] into an atom. +*/ +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] ) { + 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; + } + } + + 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. */ u3_noun u3i_mp(mpz_t a_mp) @@ -152,9 +211,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) @@ -176,67 +233,41 @@ 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) { + u3_noun pro; u3t_on(mal_o); #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; nov_u->mug_w = 0; nov_u->hed = a; 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 } + + u3t_off(mal_o); + return pro; } -/* 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) @@ -244,9 +275,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) @@ -254,6 +283,57 @@ 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(): list from `u3_none`-terminated varargs. +*/ +u3_noun +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) { @@ -398,48 +478,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. @@ -476,7 +514,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; @@ -503,8 +541,8 @@ u3i_molt(u3_noun som, ...) struct _molt_pair* pms_m; u3_noun pro; - /* Count. - */ + // Count. + // len_w = 0; { va_start(ap, som); @@ -521,8 +559,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; @@ -534,10 +572,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; } - diff --git a/pkg/urbit/noun/jets.c b/pkg/urbit/noun/jets.c index 2ae4aea40c..8a8682f614 100644 --- a/pkg/urbit/noun/jets.c +++ b/pkg/urbit/noun/jets.c @@ -2339,10 +2339,10 @@ u3j_mark(FILE* fil_u) return u3a_maid(fil_u, "total jet stuff", tot_w); } -/* u3j_free_hank(): free an entry from the hank cache. +/* _cj_free_hank(): free an entry from the hank cache. */ -void -u3j_free_hank(u3_noun kev) +static void +_cj_free_hank(u3_noun kev) { _cj_hank* han_u = u3to(_cj_hank, u3t(kev)); if ( u3_none != han_u->hax ) { @@ -2357,7 +2357,7 @@ u3j_free_hank(u3_noun kev) void u3j_free(void) { - u3h_walk(u3R->jed.han_p, u3j_free_hank); + 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); @@ -2367,3 +2367,49 @@ u3j_free(void) } } +/* 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 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. +*/ +void +u3j_rewrite_compact() +{ + 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); +} diff --git a/pkg/urbit/noun/manage.c b/pkg/urbit/noun/manage.c index f5127be741..c83d006055 100644 --- a/pkg/urbit/noun/manage.c +++ b/pkg/urbit/noun/manage.c @@ -69,10 +69,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; @@ -324,10 +324,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 // @@ -348,15 +348,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(); @@ -371,14 +375,18 @@ _cm_signal_done() signal(SIGTERM, SIG_IGN); signal(SIGVTALRM, SIG_IGN); +#ifndef NO_OVERFLOW stackoverflow_deinstall_handler(); +#endif { struct itimerval itm_u; 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 @@ -789,6 +797,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, @@ -804,6 +822,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; @@ -913,17 +934,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 @@ -1196,13 +1217,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; @@ -1828,42 +1849,52 @@ u3m_wipe(void) void u3m_reclaim(void) { + u3v_reclaim(); + u3j_reclaim(); + u3n_reclaim(); + u3a_reclaim(); +} + +/* _cm_pack_rewrite(): trace through arena, rewriting pointers. +*/ +static void +_cm_pack_rewrite(void) +{ + // XX fix u3a_rewrit* to support south roads + // c3_assert( &(u3H->rod_u) == u3R ); - // clear the u3v_wish cache + // NB: these implementations must be kept in sync with u3m_reclaim(); + // anything not reclaimed must be rewritable // - // 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_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/noun/nock.c b/pkg/urbit/noun/nock.c index e2bfc0f7d3..88d3d148d6 100644 --- a/pkg/urbit/noun/nock.c +++ b/pkg/urbit/noun/nock.c @@ -2597,6 +2597,41 @@ 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 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 + * 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_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/retrieve.c b/pkg/urbit/noun/retrieve.c index f7f32e19d5..63589ab1e1 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); } @@ -1202,6 +1204,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 @@ -1342,7 +1389,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); } @@ -1360,14 +1407,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); } @@ -1377,8 +1440,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]`. @@ -1486,7 +1548,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 @@ -1504,7 +1566,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; } diff --git a/pkg/urbit/noun/trace.c b/pkg/urbit/noun/trace.c index 1350adc0e4..f8fe81320c 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(); diff --git a/pkg/urbit/noun/vortex.c b/pkg/urbit/noun/vortex.c index 8bb1bae0e7..75351185db 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); @@ -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. @@ -365,3 +326,39 @@ 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_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 +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/tests/mug_tests.c b/pkg/urbit/tests/mug_tests.c index 760f20d06e..ff7736bc06 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"); } diff --git a/pkg/urbit/tests/newt_tests.c b/pkg/urbit/tests/newt_tests.c index 41f20eb401..639cc80e51 100644 --- a/pkg/urbit/tests/newt_tests.c +++ b/pkg/urbit/tests/newt_tests.c @@ -10,20 +10,43 @@ _setup(void) u3m_pave(c3y, c3n); } -static c3_w pok_w; -static c3_w bal_w; - -static void -_moat_poke_cb(void* vod_p, u3_atom a) +/* _newt_encode(): synchronous serialization into a single buffer, for test purposes +*/ +static c3_y* +_newt_encode(u3_atom mat, c3_w* len_w) { - pok_w++; - u3z(a); + 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_bail_cb(void* vod_p, const c3_c* err_c) +static c3_w +_moat_length(u3_moat* mot_u) { - bal_w++; + u3_meat* met_u = mot_u->ext_u; + c3_w len_w = 0; + + while ( met_u ) { + met_u = met_u->nex_u; + len_w++; + } + + return len_w; } /* _test_newt_smol(): various scenarios with small messages @@ -39,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 = 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 ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt smol fail (a)\n"); exit(1); } @@ -60,10 +80,9 @@ _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 = 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); @@ -71,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); } @@ -81,24 +100,24 @@ _test_newt_smol(void) // { c3_y* end_y; - pok_w = 0; - bal_w = 0; - buf_y = u3_newt_encode(u3k(a), &len_w); + mot_u.ent_u = mot_u.ext_u = 0; + + buf_y = _newt_encode(u3k(a), &len_w); end_y = c3_malloc(1); end_y[0] = buf_y[len_w - 1]; 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); } @@ -110,10 +129,9 @@ _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 = 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; @@ -130,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); } @@ -159,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 = 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 ) { + if ( 1 != _moat_length(&mot_u) ) { fprintf(stderr, "newt vast fail (a)\n"); exit(1); } @@ -180,10 +195,9 @@ _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 = 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); @@ -191,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); } @@ -200,10 +214,9 @@ _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 = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); { c3_y* cop_y = c3_malloc(len_w); @@ -216,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); } @@ -228,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); } @@ -240,10 +253,9 @@ _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 = 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; @@ -260,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); } @@ -278,10 +290,9 @@ _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 = u3_newt_encode(u3k(a), &len_w); + buf_y = _newt_encode(u3k(a), &len_w); dub_w = 2 * len_w; @@ -301,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); } @@ -313,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/auto.c b/pkg/urbit/vere/auto.c new file mode 100644 index 0000000000..cca6fae144 --- /dev/null +++ b/pkg/urbit/vere/auto.c @@ -0,0 +1,434 @@ +/* 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" + +/* 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; + + 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 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; + + 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); + + 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 +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; +} + +/* 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; + c3_w len_w = 1; + + while ( u3_nul != dul ) { + u3l_log("%s: bail %u\r\n", car_c, len_w++); + u3_pier_punt_goof(car_c, u3k(u3h(dul))); + + dul = u3t(dul); + } + + u3_pier_punt_ovum(car_c, u3k(egg_u->wir), u3k(u3h(egg_u->cad))); + + 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) +{ + // optional + // + if ( egg_u->cb_u.bail_f ) { + c3_l cod_l = u3a_lush(egg_u->car_u->nam_m); + egg_u->cb_u.bail_f(egg_u, lud); + u3a_lop(cod_l); + } + else { + u3_auto_bail_slog(egg_u, lud); + u3_ovum_free(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) +{ + _auto_news(egg_u, u3_ovum_done); + u3_ovum_free(egg_u); +} + +/* u3_auto_work(): notify driver of [egg_u] commencement. +*/ +void +u3_auto_work(u3_ovum* egg_u) +{ + _auto_news(egg_u, u3_ovum_work); +} + +/* u3_auto_drop(): dequeue and dispose an ovum. +*/ +void +u3_auto_drop(u3_auto* car_u, u3_ovum* egg_u) +{ + { + c3_assert( egg_u->car_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; + } + + // 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 + // + if ( egg_u->car_u && ( car_u != egg_u->car_u ) ) { + _auto_news(egg_u, u3_ovum_drop); + } + + u3_ovum_free(egg_u); +} + +/* u3_auto_next(): select an ovum, dequeue and construct. +*/ +u3_ovum* +u3_auto_next(u3_auto* car_u, u3_noun* ovo) +{ + while ( car_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 ); + + 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; + + u3_auto_work(egg_u); + + // XX cons [tar] route onto wire + // + // *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; + } + } + + return 0; +} + +/* _auto_kick_lost(): print details of unroutable effect. RETAIN +*/ +static void +_auto_kick_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); +} + +/* _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_kick(u3_auto* car_u, u3_noun act) +{ + u3_auto* rac_u = car_u; + u3_noun fec, pax, wir, cad; + + while ( u3_nul != act ) { + fec = u3h(act); + u3x_cell(fec, &pax, &cad); + u3_assent(u3r_p(pax, u3_blip, &wir)); + + while ( c3n == _auto_kick(car_u, u3k(wir), u3k(cad)) ) { + if ( car_u->nex_u ) { + car_u = car_u->nex_u; + continue; + } + else { + _auto_kick_lost(wir, cad); + break; + } + } + + car_u = rac_u; + 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; + + { + 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); + u3a_lop(cod_l); + + car_u = nex_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 (info_f is optional) + // + c3_assert( car_u->io.talk_f ); + c3_assert( car_u->io.kick_f ); + c3_assert( car_u->io.exit_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 deleted file mode 100644 index 96b9a0b9d0..0000000000 --- a/pkg/urbit/vere/behn.c +++ /dev/null @@ -1,107 +0,0 @@ -/* vere/behn.c -** -*/ -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "all.h" -#include "vere/vere.h" - -/* u3_behn(): initialize time timer. -*/ -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); -} - -/* _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; - teh_u->alm = c3n; - - // 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. - // - { - 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 - // - { - u3_pier_work - (pir_u, - u3nt(u3_blip, c3__behn, u3_nul), - u3nc(c3__wake, u3_nul)); - } -} - -/* u3_behn_ef_doze(): set or cancel timer -*/ -void -u3_behn_ef_doze(u3_pier *pir_u, u3_noun wen) -{ - u3_behn* teh_u = pir_u->teh_u; - - if ( c3y == teh_u->alm ) { - uv_timer_stop(&teh_u->tim_u); - teh_u->alm = c3n; - } - - if ( (u3_nul != wen) && - (c3y == u3du(wen)) && - (c3y == u3ud(u3t(wen))) ) - { - struct timeval tim_tv; - gettimeofday(&tim_tv, 0); - - 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; - uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); - } - - u3z(wen); -} - -/* u3_behn_ef_bake(): notify %behn that we're live -*/ -void -u3_behn_ef_bake(u3_pier *pir_u) -{ - u3_noun pax = u3nq(u3_blip, c3__behn, u3k(u3A->sen), u3_nul); - - u3_pier_work(pir_u, pax, u3nc(c3__born, u3_nul)); -} diff --git a/pkg/urbit/vere/db/lmdb.c b/pkg/urbit/vere/db/lmdb.c new file mode 100644 index 0000000000..ef77ba01f3 --- /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 +// + +/* u3_lmdb_init(): open lmdb at [pax_c], mmap up to [siz_i]. +*/ +MDB_env* +u3_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; +} + +/* u3_lmdb_exit(): close lmdb. +*/ +void +u3_lmdb_exit(MDB_env* env_u) +{ + mdb_env_close(env_u); +} + +/* u3_lmdb_gulf(): read first and last event numbers. +*/ +c3_o +u3_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; + } + } +} + +/* u3_lmdb_read(): read [len_d] events starting at [eve_d]. +*/ +c3_o +u3_lmdb_read(MDB_env* env_u, + void* ptr_v, + 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(ptr_v, 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; + } + } +} + +/* u3_lmdb_save(): save [len_d] events starting at [eve_d]. +*/ +c3_o +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 + 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; +} + +/* u3_lmdb_read_meta(): read by string from the META db. +*/ +void +u3_lmdb_read_meta(MDB_env* env_u, + void* ptr_v, + 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(ptr_v, 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(ptr_v, 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(ptr_v, 0, 0); + } + else { + read_f(ptr_v, val_u.mv_size, val_u.mv_data); + + // read-only transactions are aborted when complete + // + mdb_txn_abort(txn_u); + } + } +} + +/* u3_lmdb_save_meta(): save by string into the META db. +*/ +c3_o +u3_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 new file mode 100644 index 0000000000..feea9697f1 --- /dev/null +++ b/pkg/urbit/vere/disk.c @@ -0,0 +1,786 @@ +/* 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" +#include + +struct _cd_read { + uv_timer_t tim_u; + 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; +}; + +struct _cd_save { + c3_o ret_o; // result + 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; +}; + +#undef VERBOSE_DISK + +static void +_disk_commit(u3_disk* log_u); + +/* _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.ptr_v, 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.ptr_v, 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; + u3_fact_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) +{ + struct _cd_save* req_u = ted_u->data; + + 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. +*/ +static void +_disk_commit_cb(uv_work_t* ted_u) +{ + struct _cd_save* req_u = ted_u->data; + 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? + 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, u3_fact* tac_u) +{ + c3_assert( (1ULL + log_u->sen_d) == tac_u->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(): enqueue boot sequence, without autocommit. +*/ +void +u3_disk_boot_plan(u3_disk* log_u, u3_noun 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 ); + + 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; + } + +#ifdef VERBOSE_DISK + fprintf(stderr, "disk: (%" PRIu64 "): db boot plan\r\n", tac_u->eve_d); +#endif +} + +/* 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); +} + +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) +{ + 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.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* ptr_v, c3_d eve_d, size_t val_i, void* val_p) +{ + u3_read* red_u = ptr_v; + u3_disk* log_u = red_u->log_u; + 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, &bug_l)) ) // XX + { + // failure here triggers cleanup in _disk_read_start_cb() + // + u3z(dat); + return c3n; + } + + // 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); + } + + 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) +{ + u3_read* red_u = tim_u->data; + u3_disk* log_u = red_u->log_u; + + // read events synchronously + // + if ( c3n == u3_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.ptr_v, red_u->eve_d); + _disk_read_close(red_u); + } + // finish the read asynchronously + // + 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]. +*/ +void +u3_disk_read(u3_disk* log_u, c3_d eve_d, c3_d len_d) +{ + 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 + // + 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]. +*/ +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 = u3_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 [ptr_v] if present. +*/ +static void +_disk_meta_read_cb(void* ptr_v, size_t val_i, void* val_p) +{ + u3_weak* mat = ptr_v; + + 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; + + 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); + + 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) +{ + // 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); + } + 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_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* +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->ted_o = c3n; + log_u->cb_u = cb_u; + log_u->red_u = 0; + log_u->put_u.ent_u = log_u->put_u.ext_u = 0; + + // 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; + } + + // Arbitrarily choosing 1TB as a "large enough" mapsize + // + // per the LMDB docs: + // "[..] on 64-bit there is no penalty for making this huge (say 1TB)." + // + { + const size_t siz_i = 1099511627776; + + 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); + return 0; + } + } + + c3_free(log_c); + } + + // get the latest event number from the db + // + { + log_u->dun_d = 0; + c3_d fir_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; + } + + log_u->sen_d = log_u->dun_d; + } + + log_u->liv_o = c3y; + + return log_u; +} diff --git a/pkg/urbit/vere/foil.c b/pkg/urbit/vere/foil.c index 4bd4a401ac..9c78cd2969 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 @@ -123,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/http.c b/pkg/urbit/vere/http.c deleted file mode 100644 index 5ca88a7e60..0000000000 --- a/pkg/urbit/vere/http.c +++ /dev/null @@ -1,3123 +0,0 @@ -/* vere/http.c -** -*/ -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "all.h" -#include "vere/vere.h" - -typedef struct _u3_h2o_serv { - h2o_globalconf_t fig_u; // h2o global config - h2o_context_t ctx_u; // h2o ctx - h2o_accept_ctx_t cep_u; // h2o accept ctx - h2o_hostconf_t* hos_u; // h2o host config - 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); - -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 -_http_close_cb(uv_handle_t* han_u) -{ - c3_free(han_u); -} - -/* _http_vec_to_meth(): convert h2o_iovec_t to meth -*/ -static u3_weak -_http_vec_to_meth(h2o_iovec_t vec_u) -{ - return ( 0 == strncmp(vec_u.base, "GET", vec_u.len) ) ? u3i_string("GET") : - ( 0 == strncmp(vec_u.base, "PUT", vec_u.len) ) ? u3i_string("PUT") : - ( 0 == strncmp(vec_u.base, "POST", vec_u.len) ) ? u3i_string("POST") : - ( 0 == strncmp(vec_u.base, "HEAD", vec_u.len) ) ? u3i_string("HEAD") : - ( 0 == strncmp(vec_u.base, "CONNECT", vec_u.len) ) ? u3i_string("CONNECT") : - ( 0 == strncmp(vec_u.base, "DELETE", vec_u.len) ) ? u3i_string("DELETE") : - ( 0 == strncmp(vec_u.base, "OPTIONS", vec_u.len) ) ? u3i_string("OPTIONS") : - ( 0 == strncmp(vec_u.base, "TRACE", vec_u.len) ) ? u3i_string("TRACE") : - // TODO ?? - // ( 0 == strncmp(vec_u.base, "PATCH", vec_u.len) ) ? c3__patc : - u3_none; -} - -/* _http_vec_to_atom(): convert h2o_iovec_t to atom (cord) -*/ -static u3_noun -_http_vec_to_atom(h2o_iovec_t vec_u) -{ - return u3i_bytes(vec_u.len, (const c3_y*)vec_u.base); -} - -/* _http_vec_to_octs(): convert h2o_iovec_t to (unit octs) -*/ -static u3_noun -_http_vec_to_octs(h2o_iovec_t vec_u) -{ - if ( 0 == vec_u.len ) { - return u3_nul; - } - - // XX correct size_t -> atom? - return u3nt(u3_nul, u3i_chubs(1, (const c3_d*)&vec_u.len), - _http_vec_to_atom(vec_u)); -} - -/* _cttp_bods_free(): free body structure. -*/ -static void -_cttp_bods_free(u3_hbod* bod_u) -{ - while ( bod_u ) { - u3_hbod* nex_u = bod_u->nex_u; - - c3_free(bod_u); - bod_u = nex_u; - } -} - -/* _cttp_bod_from_octs(): translate octet-stream noun into body. -*/ -static u3_hbod* -_cttp_bod_from_octs(u3_noun oct) -{ - c3_w len_w; - - if ( !_(u3a_is_cat(u3h(oct))) ) { // 2GB max - u3m_bail(c3__fail); return 0; - } - len_w = u3h(oct); - - { - u3_hbod* bod_u = c3_malloc(1 + len_w + sizeof(*bod_u)); - bod_u->hun_y[len_w] = 0; - bod_u->len_w = len_w; - u3r_bytes(0, len_w, bod_u->hun_y, u3t(oct)); - - bod_u->nex_u = 0; - - u3z(oct); - return bod_u; - } -} - -/* _cttp_bods_to_vec(): translate body buffers to array of h2o_iovec_t -*/ -static h2o_iovec_t* -_cttp_bods_to_vec(u3_hbod* bod_u, c3_w* tot_w) -{ - h2o_iovec_t* vec_u; - c3_w len_w; - - { - u3_hbod* bid_u = bod_u; - len_w = 0; - - while( bid_u ) { - len_w++; - bid_u = bid_u->nex_u; - } - } - - vec_u = c3_malloc(sizeof(h2o_iovec_t) * len_w); - len_w = 0; - - while( bod_u ) { - vec_u[len_w] = h2o_iovec_init(bod_u->hun_y, bod_u->len_w); - len_w++; - bod_u = bod_u->nex_u; - } - - *tot_w = len_w; - - return vec_u; -} - -/* _http_heds_to_noun(): convert h2o_header_t to (list (pair @t @t)) -*/ -static u3_noun -_http_heds_to_noun(h2o_header_t* hed_u, c3_d hed_d) -{ - u3_noun hed = u3_nul; - c3_d dex_d = hed_d; - - h2o_header_t deh_u; - - while ( 0 < dex_d ) { - deh_u = hed_u[--dex_d]; - hed = u3nc(u3nc(_http_vec_to_atom(*deh_u.name), - _http_vec_to_atom(deh_u.value)), hed); - } - - return hed; -} - -/* _http_heds_free(): free header linked list -*/ -static void -_http_heds_free(u3_hhed* hed_u) -{ - while ( hed_u ) { - u3_hhed* nex_u = hed_u->nex_u; - - c3_free(hed_u->nam_c); - c3_free(hed_u->val_c); - c3_free(hed_u); - hed_u = nex_u; - } -} - -/* _http_hed_new(): create u3_hhed from nam/val cords -*/ -static u3_hhed* -_http_hed_new(u3_atom nam, u3_atom val) -{ - c3_w nam_w = u3r_met(3, nam); - c3_w val_w = u3r_met(3, val); - u3_hhed* hed_u = c3_malloc(sizeof(*hed_u)); - - hed_u->nam_c = c3_malloc(1 + nam_w); - hed_u->val_c = c3_malloc(1 + val_w); - hed_u->nam_c[nam_w] = 0; - hed_u->val_c[val_w] = 0; - hed_u->nex_u = 0; - hed_u->nam_w = nam_w; - hed_u->val_w = val_w; - - u3r_bytes(0, nam_w, (c3_y*)hed_u->nam_c, nam); - u3r_bytes(0, val_w, (c3_y*)hed_u->val_c, val); - - return hed_u; -} - -/* _http_heds_from_noun(): convert (list (pair @t @t)) to u3_hhed -*/ -static u3_hhed* -_http_heds_from_noun(u3_noun hed) -{ - u3_noun deh = hed; - u3_noun i_hed; - - u3_hhed* hed_u = 0; - - while ( u3_nul != hed ) { - i_hed = u3h(hed); - u3_hhed* nex_u = _http_hed_new(u3h(i_hed), u3t(i_hed)); - nex_u->nex_u = hed_u; - - hed_u = nex_u; - hed = u3t(hed); - } - - u3z(deh); - return hed_u; -} - -/* _http_req_find(): find http request in connection by sequence. -*/ -static u3_hreq* -_http_req_find(u3_hcon* hon_u, c3_w seq_l) -{ - u3_hreq* req_u = hon_u->req_u; - - // XX glories of linear search - // - while ( req_u ) { - if ( seq_l == req_u->seq_l ) { - return req_u; - } - req_u = req_u->nex_u; - } - return 0; -} - -/* _http_req_link(): link http request to connection -*/ -static void -_http_req_link(u3_hcon* hon_u, u3_hreq* req_u) -{ - req_u->hon_u = hon_u; - req_u->seq_l = hon_u->seq_l++; - req_u->nex_u = hon_u->req_u; - - if ( 0 != req_u->nex_u ) { - req_u->nex_u->pre_u = req_u; - } - hon_u->req_u = req_u; -} - -/* _http_req_unlink(): remove http request from connection -*/ -static void -_http_req_unlink(u3_hreq* req_u) -{ - if ( 0 != req_u->pre_u ) { - req_u->pre_u->nex_u = req_u->nex_u; - - if ( 0 != req_u->nex_u ) { - req_u->nex_u->pre_u = req_u->pre_u; - } - } - else { - req_u->hon_u->req_u = req_u->nex_u; - - if ( 0 != req_u->nex_u ) { - req_u->nex_u->pre_u = 0; - } - } -} - -/* _http_req_to_duct(): translate srv/con/req to duct -*/ -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), - u3_nul)); -} - -/* _http_req_kill(): kill http request in %eyre. -*/ -static void -_http_req_kill(u3_hreq* req_u) -{ - u3_noun pox = _http_req_to_duct(req_u); - - u3_pier_plan(pox, u3nc(u3i_string("cancel-request"), - u3_nul)); -} - -typedef struct _u3_hgen { - h2o_generator_t neg_u; // response callbacks - c3_o red; // ready to send - c3_o dun; // done sending - u3_hbod* bod_u; // pending body - u3_hbod* nud_u; // pending free - u3_hhed* hed_u; // pending free - u3_hreq* req_u; // originating request -} u3_hgen; - -/* _http_req_done(): request finished, deallocation callback -*/ -static void -_http_req_done(void* ptr_v) -{ - u3_hreq* req_u = (u3_hreq*)ptr_v; - - // client canceled request before response - // - if ( u3_rsat_plan == req_u->sat_e ) { - _http_req_kill(req_u); - } - - if ( 0 != req_u->tim_u ) { - uv_close((uv_handle_t*)req_u->tim_u, _http_close_cb); - req_u->tim_u = 0; - } - - _http_req_unlink(req_u); -} - -/* _http_req_timer_cb(): request timeout callback -*/ -static void -_http_req_timer_cb(uv_timer_t* tim_u) -{ - u3_hreq* req_u = tim_u->data; - - if ( u3_rsat_plan == req_u->sat_e ) { - _http_req_kill(req_u); - req_u->sat_e = u3_rsat_ripe; - - c3_c* msg_c = "gateway timeout"; - h2o_send_error_generic(req_u->rec_u, 504, msg_c, msg_c, 0); - } -} - -/* _http_req_new(): receive http request. -*/ -static u3_hreq* -_http_req_new(u3_hcon* hon_u, h2o_req_t* rec_u) -{ - u3_hreq* req_u = h2o_mem_alloc_shared(&rec_u->pool, sizeof(*req_u), - _http_req_done); - req_u->rec_u = rec_u; - req_u->sat_e = u3_rsat_init; - req_u->tim_u = 0; - req_u->gen_u = 0; - req_u->pre_u = 0; - - _http_req_link(hon_u, req_u); - - return req_u; -} - -/* _http_req_dispatch(): dispatch http request to %eyre -*/ -static void -_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); - - 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)); - - } - 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)); - } -} - -/* _http_hgen_dispose(): dispose response generator and buffers -*/ -static void -_http_hgen_dispose(void* ptr_v) -{ - u3_hgen* gen_u = (u3_hgen*)ptr_v; - _http_heds_free(gen_u->hed_u); - gen_u->hed_u = 0; - _cttp_bods_free(gen_u->nud_u); - gen_u->nud_u = 0; - _cttp_bods_free(gen_u->bod_u); - gen_u->bod_u = 0; -} - -static void -_http_hgen_send(u3_hgen* gen_u) -{ - c3_assert( c3y == gen_u->red ); - - u3_hreq* req_u = gen_u->req_u; - h2o_req_t* rec_u = req_u->rec_u; - - c3_w len_w; - h2o_iovec_t* vec_u = _cttp_bods_to_vec(gen_u->bod_u, &len_w); - - // not ready again until _proceed - // - gen_u->red = c3n; - - // stash [bod_u] to free later - // - _cttp_bods_free(gen_u->nud_u); - gen_u->nud_u = gen_u->bod_u; - gen_u->bod_u = 0; - - if ( c3n == gen_u->dun ) { - h2o_send(rec_u, vec_u, len_w, H2O_SEND_STATE_IN_PROGRESS); - uv_timer_start(req_u->tim_u, _http_req_timer_cb, 45 * 1000, 0); - } - else { - // close connection if shutdown pending - // - u3_h2o_serv* h2o_u = req_u->hon_u->htp_u->h2o_u; - - if ( 0 != h2o_u->ctx_u.shutdown_requested ) { - rec_u->http1_is_persistent = 0; - } - - h2o_send(rec_u, vec_u, len_w, H2O_SEND_STATE_FINAL); - } - - c3_free(vec_u); -} - -/* _http_hgen_stop(): h2o is closing an in-progress response. -*/ -static void -_http_hgen_stop(h2o_generator_t* neg_u, h2o_req_t* rec_u) -{ - u3_hgen* gen_u = (u3_hgen*)neg_u; - - // response not complete, enqueue cancel - // - if ( c3n == gen_u->dun ) { - _http_req_kill(gen_u->req_u); - } -} - -/* _http_hgen_proceed(): h2o is ready for more response data. -*/ -static void -_http_hgen_proceed(h2o_generator_t* neg_u, h2o_req_t* rec_u) -{ - u3_hgen* gen_u = (u3_hgen*)neg_u; - u3_hreq* req_u = gen_u->req_u; - - // sanity check - c3_assert( rec_u == req_u->rec_u ); - - gen_u->red = c3y; - - if ( 0 != gen_u->bod_u || c3y == gen_u->dun ) { - _http_hgen_send(gen_u); - } -} - -/* _http_start_respond(): write a [%http-response %start ...] to h2o_req_t->res -*/ -static void -_http_start_respond(u3_hreq* req_u, - u3_noun status, - u3_noun headers, - u3_noun data, - u3_noun complete) -{ - // u3l_log("start\n"); - - if ( u3_rsat_plan != req_u->sat_e ) { - //u3l_log("duplicate response\n"); - return; - } - - req_u->sat_e = u3_rsat_ripe; - - uv_timer_stop(req_u->tim_u); - - h2o_req_t* rec_u = req_u->rec_u; - - rec_u->res.status = status; - rec_u->res.reason = (status < 200) ? "weird" : - (status < 300) ? "ok" : - (status < 400) ? "moved" : - (status < 500) ? "missing" : - "hosed"; - - u3_hhed* hed_u = _http_heds_from_noun(u3k(headers)); - u3_hhed* deh_u = hed_u; - - c3_i has_len_i = 0; - - while ( 0 != hed_u ) { - if ( 0 == strncmp(hed_u->nam_c, "content-length", 14) ) { - has_len_i = 1; - } - else { - h2o_add_header_by_str(&rec_u->pool, &rec_u->res.headers, - hed_u->nam_c, hed_u->nam_w, 0, 0, - hed_u->val_c, hed_u->val_w); - } - - hed_u = hed_u->nex_u; - } - - u3_hgen* gen_u = h2o_mem_alloc_shared(&rec_u->pool, sizeof(*gen_u), - _http_hgen_dispose); - gen_u->neg_u = (h2o_generator_t){ _http_hgen_proceed, _http_hgen_stop }; - gen_u->red = c3y; - gen_u->dun = complete; - gen_u->bod_u = ( u3_nul == data ) ? - 0 : _cttp_bod_from_octs(u3k(u3t(data))); - gen_u->nud_u = 0; - gen_u->hed_u = deh_u; - gen_u->req_u = req_u; - - // 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; - } - - req_u->gen_u = gen_u; - - h2o_start_response(rec_u, &gen_u->neg_u); - - _http_hgen_send(gen_u); - - u3z(status); u3z(headers); u3z(data); u3z(complete); -} - -/* _http_continue_respond(): write a [%http-response %continue ...] to - * h2o_req_t->res -*/ -static void -_http_continue_respond(u3_hreq* req_u, - /* u3_noun status, */ - /* u3_noun headers, */ - u3_noun data, - u3_noun complete) -{ - // u3l_log("continue\n"); - - // XX add sequence numbers for %continue effects? - // Arvo does not (currently) guarantee effect idempotence!! - - // response has not yet been started - if ( u3_rsat_ripe != req_u->sat_e ) { - // u3l_log("duplicate response\n"); - return; - } - - u3_hgen* gen_u = req_u->gen_u; - - uv_timer_stop(req_u->tim_u); - - // XX proposed sequence number safety check - // if ( sequence <= gen_u->sequence ) { - // return; - // } - // - // c3_assert( sequence == ++gen_u->sequence ); - - gen_u->dun = complete; - - if ( u3_nul != data ) { - u3_hbod* bod_u = _cttp_bod_from_octs(u3k(u3t(data))); - - if ( 0 == gen_u->bod_u ) { - gen_u->bod_u = bod_u; - } - else { - u3_hbod* pre_u = gen_u->bod_u; - - while ( 0 != pre_u->nex_u ) { - pre_u = pre_u->nex_u; - } - - pre_u->nex_u = bod_u; - } - } - - if ( c3y == gen_u->red ) { - _http_hgen_send(gen_u); - } - - u3z(data); u3z(complete); -} - -/* _http_rec_to_httq(): convert h2o_req_t to httq -*/ -static u3_weak -_http_rec_to_httq(h2o_req_t* rec_u) -{ - u3_noun med = _http_vec_to_meth(rec_u->method); - - if ( u3_none == med ) { - return u3_none; - } - - u3_noun url = _http_vec_to_atom(rec_u->path); - u3_noun hed = _http_heds_to_noun(rec_u->headers.entries, - rec_u->headers.size); - - // restore host header - hed = u3nc(u3nc(u3i_string("host"), - _http_vec_to_atom(rec_u->authority)), - hed); - - u3_noun bod = _http_vec_to_octs(rec_u->entity); - - return u3nq(med, url, hed, bod); -} - -typedef struct _h2o_uv_sock { // see private st_h2o_uv_socket_t - h2o_socket_t sok_u; // socket - uv_stream_t* han_u; // client stream handler (u3_hcon) -} h2o_uv_sock; - -/* _http_rec_accept(); handle incoming http request from h2o. -*/ -static c3_i -_http_rec_accept(h2o_handler_t* han_u, h2o_req_t* rec_u) -{ - u3_weak req = _http_rec_to_httq(rec_u); - - if ( u3_none == req ) { - if ( (u3C.wag_w & u3o_verbose) ) { - u3l_log("strange %.*s request\n", (int)rec_u->method.len, - rec_u->method.base); - } - c3_c* msg_c = "bad request"; - h2o_send_error_generic(rec_u, 400, msg_c, msg_c, 0); - } - else { - h2o_uv_sock* suv_u = (h2o_uv_sock*)rec_u->conn-> - callbacks->get_socket(rec_u->conn); - u3_hcon* hon_u = (u3_hcon*)suv_u->han_u; - - // sanity check - c3_assert( hon_u->sok_u == &suv_u->sok_u ); - - u3_hreq* req_u = _http_req_new(hon_u, rec_u); - - req_u->tim_u = c3_malloc(sizeof(*req_u->tim_u)); - req_u->tim_u->data = req_u; - uv_timer_init(u3L, req_u->tim_u); - uv_timer_start(req_u->tim_u, _http_req_timer_cb, 600 * 1000, 0); - - _http_req_dispatch(req_u, req); - } - - return 0; -} - -/* _http_conn_find(): find http connection in server by sequence. -*/ -static u3_hcon* -_http_conn_find(u3_http *htp_u, c3_w coq_l) -{ - u3_hcon* hon_u = htp_u->hon_u; - - // XX glories of linear search - // - while ( hon_u ) { - if ( coq_l == hon_u->coq_l ) { - return hon_u; - } - hon_u = hon_u->nex_u; - } - return 0; -} - -/* _http_conn_link(): link http request to connection -*/ -static void -_http_conn_link(u3_http* htp_u, u3_hcon* hon_u) -{ - hon_u->htp_u = htp_u; - hon_u->coq_l = htp_u->coq_l++; - hon_u->nex_u = htp_u->hon_u; - - if ( 0 != hon_u->nex_u ) { - hon_u->nex_u->pre_u = hon_u; - } - htp_u->hon_u = hon_u; -} - -/* _http_conn_unlink(): remove http request from connection -*/ -static void -_http_conn_unlink(u3_hcon* hon_u) -{ - if ( 0 != hon_u->pre_u ) { - hon_u->pre_u->nex_u = hon_u->nex_u; - - if ( 0 != hon_u->nex_u ) { - hon_u->nex_u->pre_u = hon_u->pre_u; - } - } - else { - hon_u->htp_u->hon_u = hon_u->nex_u; - - if ( 0 != hon_u->nex_u ) { - hon_u->nex_u->pre_u = 0; - } - } -} - -/* _http_conn_free(): free http connection on close. -*/ -static void -_http_conn_free(uv_handle_t* han_t) -{ - u3_hcon* hon_u = (u3_hcon*)han_t; - u3_http* htp_u = hon_u->htp_u; - u3_h2o_serv* h2o_u = htp_u->h2o_u; - - c3_assert( 0 == hon_u->req_u ); - -#if 0 - { - c3_w len_w = 0; - - u3_hcon* noh_u = htp_u->hon_u; - - while ( 0 != noh_u ) { - len_w++; - noh_u = noh_u->nex_u; - } - - u3l_log("http conn free %d of %u server %d\n", hon_u->coq_l, len_w, htp_u->sev_l); - } -#endif - - _http_conn_unlink(hon_u); - -#if 0 - { - c3_w len_w = 0; - - u3_hcon* noh_u = htp_u->hon_u; - - while ( 0 != noh_u ) { - len_w++; - noh_u = noh_u->nex_u; - } - - u3l_log("http conn free %u remaining\n", len_w); - } -#endif - - if ( (0 == htp_u->hon_u) && (0 != h2o_u->ctx_u.shutdown_requested) ) { -#if 0 - u3l_log("http conn free %d free server %d\n", hon_u->coq_l, htp_u->sev_l); -#endif - _http_serv_free(htp_u); - } - - c3_free(hon_u); -} - -/* _http_conn_new(): create and accept http connection. -*/ -static u3_hcon* -_http_conn_new(u3_http* htp_u) -{ - u3_hcon* hon_u = c3_malloc(sizeof(*hon_u)); - hon_u->seq_l = 1; - hon_u->ipf_w = 0; - hon_u->req_u = 0; - hon_u->sok_u = 0; - hon_u->con_u = 0; - hon_u->pre_u = 0; - - _http_conn_link(htp_u, hon_u); - -#if 0 - u3l_log("http conn neww %d server %d\n", hon_u->coq_l, htp_u->sev_l); -#endif - - return hon_u; -} - -/* _http_serv_find(): find http server by sequence. -*/ -static u3_http* -_http_serv_find(c3_l sev_l) -{ - u3_http* htp_u = u3_Host.htp_u; - - // XX glories of linear search - // - while ( htp_u ) { - if ( sev_l == htp_u->sev_l ) { - return htp_u; - } - htp_u = htp_u->nex_u; - } - return 0; -} - -/* _http_serv_link(): link http server to global state. -*/ -static void -_http_serv_link(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; - } - else { - htp_u->sev_l = u3A->sev_l; - } - - htp_u->nex_u = u3_Host.htp_u; - u3_Host.htp_u = htp_u; -} - -/* _http_serv_unlink(): remove http server from global state. -*/ -static void -_http_serv_unlink(u3_http* htp_u) -{ - // XX link elsewhere initially, relink on start? -#if 0 - u3l_log("http serv unlink %d\n", htp_u->sev_l); -#endif - - if ( u3_Host.htp_u == htp_u ) { - u3_Host.htp_u = htp_u->nex_u; - } - else { - u3_http* pre_u = u3_Host.htp_u; - - // XX glories of linear search - // - while ( pre_u ) { - if ( pre_u->nex_u == htp_u ) { - pre_u->nex_u = htp_u->nex_u; - } - else pre_u = pre_u->nex_u; - } - } -} - -/* _http_h2o_context_dispose(): h2o_context_dispose, inlined and cleaned up. -*/ -static void -_http_h2o_context_dispose(h2o_context_t* ctx) -{ - h2o_globalconf_t *config = ctx->globalconf; - size_t i, j; - - for (i = 0; config->hosts[i] != NULL; ++i) { - h2o_hostconf_t *hostconf = config->hosts[i]; - for (j = 0; j != hostconf->paths.size; ++j) { - h2o_pathconf_t *pathconf = hostconf->paths.entries + j; - h2o_context_dispose_pathconf_context(ctx, pathconf); - } - h2o_context_dispose_pathconf_context(ctx, &hostconf->fallback_path); - } - - c3_free(ctx->_pathconfs_inited.entries); - c3_free(ctx->_module_configs); - - h2o_timeout_dispose(ctx->loop, &ctx->zero_timeout); - h2o_timeout_dispose(ctx->loop, &ctx->hundred_ms_timeout); - h2o_timeout_dispose(ctx->loop, &ctx->handshake_timeout); - h2o_timeout_dispose(ctx->loop, &ctx->http1.req_timeout); - h2o_timeout_dispose(ctx->loop, &ctx->http2.idle_timeout); - - // NOTE: linked in http2/connection, never unlinked - h2o_timeout_unlink(&ctx->http2._graceful_shutdown_timeout); - - h2o_timeout_dispose(ctx->loop, &ctx->http2.graceful_shutdown_timeout); - h2o_timeout_dispose(ctx->loop, &ctx->proxy.io_timeout); - h2o_timeout_dispose(ctx->loop, &ctx->one_sec_timeout); - - h2o_filecache_destroy(ctx->filecache); - ctx->filecache = NULL; - - /* clear storage */ - for (i = 0; i != ctx->storage.size; ++i) { - h2o_context_storage_item_t *item = ctx->storage.entries + i; - if (item->dispose != NULL) { - item->dispose(item->data); - } - } - - c3_free(ctx->storage.entries); - - h2o_multithread_unregister_receiver(ctx->queue, &ctx->receivers.hostinfo_getaddr); - h2o_multithread_destroy_queue(ctx->queue); - - if (ctx->_timestamp_cache.value != NULL) { - h2o_mem_release_shared(ctx->_timestamp_cache.value); - } - - // NOTE: explicit uv_run removed -} - -/* _http_serv_really_free(): free http server. -*/ -static void -_http_serv_really_free(u3_http* htp_u) -{ - c3_assert( 0 == htp_u->hon_u ); - - if ( 0 != htp_u->h2o_u ) { - u3_h2o_serv* h2o_u = htp_u->h2o_u; - - if ( 0 != h2o_u->cep_u.ssl_ctx ) { - SSL_CTX_free(h2o_u->cep_u.ssl_ctx); - } - - h2o_config_dispose(&h2o_u->fig_u); - - // XX h2o_cleanup_thread if not restarting? - - c3_free(htp_u->h2o_u); - htp_u->h2o_u = 0; - } - - _http_serv_unlink(htp_u); - c3_free(htp_u); -} - -/* http_serv_free_cb(): timer callback for freeing http server. -*/ -static void -http_serv_free_cb(uv_timer_t* tim_u) -{ - u3_http* htp_u = tim_u->data; - -#if 0 - u3l_log("http serv free cb %d\n", htp_u->sev_l); -#endif - - _http_serv_really_free(htp_u); - - uv_close((uv_handle_t*)tim_u, _http_close_cb); -} - -/* _http_serv_free(): begin to free http server. -*/ -static void -_http_serv_free(u3_http* htp_u) -{ -#if 0 - u3l_log("http serv free %d\n", htp_u->sev_l); -#endif - - c3_assert( 0 == htp_u->hon_u ); - - if ( 0 == htp_u->h2o_u ) { - _http_serv_really_free(htp_u); - } - else { - u3_h2o_serv* h2o_u = htp_u->h2o_u; - - _http_h2o_context_dispose(&h2o_u->ctx_u); - - // NOTE: free deferred to allow timers to be closed - // this is a heavy-handed workaround for the lack of - // close callbacks in h2o_timer_t - // it's unpredictable how many event-loop turns will - // be required to finish closing the underlying uv_timer_t - // and we can't free until that's done (or we have UB) - // testing reveals 5s to be a long enough deferral - uv_timer_t* tim_u = c3_malloc(sizeof(*tim_u)); - - tim_u->data = htp_u; - - uv_timer_init(u3L, tim_u); - uv_timer_start(tim_u, http_serv_free_cb, 5000, 0); - } -} - -/* _http_serv_close_cb(): http server uv_close callback. -*/ -static void -_http_serv_close_cb(uv_handle_t* han_u) -{ - u3_http* htp_u = (u3_http*)han_u; - htp_u->liv = c3n; - - // otherwise freed by the last linked connection - if ( 0 == htp_u->hon_u ) { - _http_serv_free(htp_u); - } - - // restart if all linked servers have been shutdown - { - htp_u = u3_Host.htp_u; - c3_o res = c3y; - - while ( 0 != htp_u ) { - if ( c3y == htp_u->liv ) { - res = c3n; - } - htp_u = htp_u->nex_u; - } - - if ( (c3y == res) && (0 != u3_Host.fig_u.for_u) ) { - _http_serv_start_all(); - } - } -} - -/* _http_serv_close(): close http server gracefully. -*/ -static void -_http_serv_close(u3_http* htp_u) -{ - u3_h2o_serv* h2o_u = htp_u->h2o_u; - h2o_context_request_shutdown(&h2o_u->ctx_u); - -#if 0 - u3l_log("http serv close %d %p\n", htp_u->sev_l, &htp_u->wax_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. -*/ -static u3_http* -_http_serv_new(c3_s por_s, c3_o sec, c3_o lop) -{ - u3_http* htp_u = c3_malloc(sizeof(*htp_u)); - - htp_u->coq_l = 1; - htp_u->por_s = por_s; - htp_u->sec = sec; - 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); - - return htp_u; -} - -/* _http_serv_accept(): accept new http connection. -*/ -static void -_http_serv_accept(u3_http* htp_u) -{ - u3_hcon* hon_u = _http_conn_new(htp_u); - - uv_tcp_init(u3L, &hon_u->wax_u); - - c3_i sas_i; - - if ( 0 != (sas_i = uv_accept((uv_stream_t*)&htp_u->wax_u, - (uv_stream_t*)&hon_u->wax_u)) ) { - if ( (u3C.wag_w & u3o_verbose) ) { - u3l_log("http: accept: %s\n", uv_strerror(sas_i)); - } - - uv_close((uv_handle_t*)&hon_u->wax_u, _http_conn_free); - return; - } - - hon_u->sok_u = h2o_uv_socket_create((uv_stream_t*)&hon_u->wax_u, - _http_conn_free); - - h2o_accept(&((u3_h2o_serv*)htp_u->h2o_u)->cep_u, hon_u->sok_u); - - // capture h2o connection (XX fragile) - hon_u->con_u = (h2o_conn_t*)hon_u->sok_u->data; - - struct sockaddr_in adr_u; - h2o_socket_getpeername(hon_u->sok_u, (struct sockaddr*)&adr_u); - hon_u->ipf_w = ( adr_u.sin_family != AF_INET ) ? - 0 : ntohl(adr_u.sin_addr.s_addr); -} - -/* _http_serv_listen_cb(): uv_connection_cb for uv_listen -*/ -static void -_http_serv_listen_cb(uv_stream_t* str_u, c3_i sas_i) -{ - u3_http* htp_u = (u3_http*)str_u; - - if ( 0 != sas_i ) { - u3l_log("http: listen_cb: %s\n", uv_strerror(sas_i)); - } - else { - _http_serv_accept(htp_u); - } -} - -/* _http_serv_init_h2o(): initialize h2o ctx and handlers for server. -*/ -static u3_h2o_serv* -_http_serv_init_h2o(SSL_CTX* tls_u, c3_o log, c3_o red) -{ - u3_h2o_serv* h2o_u = c3_calloc(sizeof(*h2o_u)); - - h2o_config_init(&h2o_u->fig_u); - h2o_u->fig_u.server_name = h2o_iovec_init( - H2O_STRLIT("urbit/vere-" URBIT_VERSION)); - - // XX default pending vhost/custom-domain design - // XX revisit the effect of specifying the port - h2o_u->hos_u = h2o_config_register_host(&h2o_u->fig_u, - h2o_iovec_init(H2O_STRLIT("default")), - 65535); - - h2o_u->cep_u.ctx = (h2o_context_t*)&h2o_u->ctx_u; - h2o_u->cep_u.hosts = h2o_u->fig_u.hosts; - h2o_u->cep_u.ssl_ctx = tls_u; - - h2o_u->han_u = h2o_create_handler(&h2o_u->hos_u->fallback_path, - sizeof(*h2o_u->han_u)); - if ( c3y == red ) { - // XX h2o_redirect_register - h2o_u->han_u->on_req = _http_rec_accept; - } - else { - h2o_u->han_u->on_req = _http_rec_accept; - } - - if ( c3y == log ) { - // XX move this to post serv_start and put the port in the name -#if 0 - c3_c* pax_c = u3_Host.dir_c; - u3_noun now = u3dc("scot", c3__da, u3k(u3A->now)); - c3_c* now_c = u3r_string(now); - c3_c* nam_c = ".access.log"; - c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(now_c) + strlen(nam_c); - - c3_c* paf_c = c3_malloc(len_w); - snprintf(paf_c, len_w, "%s/%s%s", pax_c, now_c, nam_c); - - h2o_access_log_filehandle_t* fil_u = - h2o_access_log_open_handle(paf_c, 0, H2O_LOGCONF_ESCAPE_APACHE); - - h2o_access_log_register(&h2o_u->hos_u->fallback_path, fil_u); - - c3_free(paf_c); - c3_free(now_c); - u3z(now); -#endif - } - - // XX h2o_compress_register - - h2o_context_init(&h2o_u->ctx_u, u3L, &h2o_u->fig_u); - - return h2o_u; -} - -/* _http_serv_start(): start http server. -*/ -static void -_http_serv_start(u3_http* htp_u) -{ - struct sockaddr_in adr_u; - memset(&adr_u, 0, sizeof(adr_u)); - - adr_u.sin_family = AF_INET; - adr_u.sin_addr.s_addr = ( c3y == htp_u->lop ) ? - htonl(INADDR_LOOPBACK) : - INADDR_ANY; - - uv_tcp_init(u3L, &htp_u->wax_u); - - /* Try ascending ports. - */ - while ( 1 ) { - c3_i sas_i; - - adr_u.sin_port = htons(htp_u->por_s); - - if ( 0 != (sas_i = uv_tcp_bind(&htp_u->wax_u, - (const struct sockaddr*)&adr_u, 0)) || - 0 != (sas_i = uv_listen((uv_stream_t*)&htp_u->wax_u, - TCP_BACKLOG, _http_serv_listen_cb)) ) { - if ( (UV_EADDRINUSE == sas_i) || (UV_EACCES == sas_i) ) { - if ( (c3y == htp_u->sec) && (443 == htp_u->por_s) ) { - htp_u->por_s = 8443; - } - else if ( (c3n == htp_u->sec) && (80 == htp_u->por_s) ) { - htp_u->por_s = 8080; - } - else { - htp_u->por_s++; - } - - continue; - } - - 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", - (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); - } - - break; - } -} - -//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_c* buf_c = c3_malloc(1 + len_w); - - _cttp_mcut_path(buf_c, 0, (c3_c)10, wan); - buf_c[len_w] = 0; - - return uv_buf_init(buf_c, len_w); -} - -/* _http_init_tls: initialize OpenSSL context -*/ -static SSL_CTX* -_http_init_tls(uv_buf_t key_u, uv_buf_t cer_u) -{ - // XX require 1.1.0 and use TLS_server_method() - SSL_CTX* tls_u = SSL_CTX_new(SSLv23_server_method()); - // XX use SSL_CTX_set_max_proto_version() and SSL_CTX_set_min_proto_version() - SSL_CTX_set_options(tls_u, SSL_OP_NO_SSLv2 | - SSL_OP_NO_SSLv3 | - // SSL_OP_NO_TLSv1 | // XX test - SSL_OP_NO_COMPRESSION); - - SSL_CTX_set_default_verify_paths(tls_u); - SSL_CTX_set_session_cache_mode(tls_u, SSL_SESS_CACHE_OFF); - SSL_CTX_set_cipher_list(tls_u, - "ECDH+AESGCM:DH+AESGCM:ECDH+AES256:DH+AES256:" - "ECDH+AES128:DH+AES:ECDH+3DES:DH+3DES:RSA+AESGCM:" - "RSA+AES:RSA+3DES:!aNULL:!MD5:!DSS"); - - // enable ALPN for HTTP 2 support -#if 0 //H2O_USE_ALPN - { - SSL_CTX_set_ecdh_auto(tls_u, 1); - h2o_ssl_register_alpn_protocols(tls_u, h2o_http2_alpn_protocols); - } -#endif - - { - BIO* bio_u = BIO_new_mem_buf(key_u.base, key_u.len); - EVP_PKEY* pky_u = PEM_read_bio_PrivateKey(bio_u, 0, 0, 0); - c3_i sas_i = SSL_CTX_use_PrivateKey(tls_u, pky_u); - - EVP_PKEY_free(pky_u); - BIO_free(bio_u); - - if( 0 == sas_i ) { - u3l_log("http: load private key failed:\n"); - ERR_print_errors_fp(u3_term_io_hija()); - u3_term_io_loja(1); - - SSL_CTX_free(tls_u); - - return 0; - } - } - - { - BIO* bio_u = BIO_new_mem_buf(cer_u.base, cer_u.len); - X509* xer_u = PEM_read_bio_X509_AUX(bio_u, 0, 0, 0); - c3_i sas_i = SSL_CTX_use_certificate(tls_u, xer_u); - - X509_free(xer_u); - - if( 0 == sas_i ) { - u3l_log("http: load certificate failed:\n"); - ERR_print_errors_fp(u3_term_io_hija()); - u3_term_io_loja(1); - - BIO_free(bio_u); - SSL_CTX_free(tls_u); - - return 0; - } - - // get any additional CA certs, ignoring errors - while ( 0 != (xer_u = PEM_read_bio_X509(bio_u, 0, 0, 0)) ) { - // XX require 1.0.2 or newer and use SSL_CTX_add0_chain_cert - SSL_CTX_add_extra_chain_cert(tls_u, xer_u); - } - - BIO_free(bio_u); - } - - return tls_u; -} - -/* _http_write_ports_file(): update .http.ports -*/ -static void -_http_write_ports_file(c3_c *pax_c) -{ - c3_c* nam_c = ".http.ports"; - c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(nam_c); - - c3_c* paf_c = c3_malloc(len_w); - snprintf(paf_c, len_w, "%s/%s", pax_c, nam_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; - - 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", - (c3y == htp_u->lop) ? "loopback" : "public"); - } - - htp_u = htp_u->nex_u; - } - - c3_sync(por_i); - close(por_i); -} - -/* _http_release_ports_file(): remove .http.ports -*/ -static void -_http_release_ports_file(c3_c *pax_c) -{ - c3_c* nam_c = ".http.ports"; - c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(nam_c); - - c3_c* paf_c = c3_malloc(len_w); - snprintf(paf_c, len_w, "%s/%s", pax_c, nam_c); - - unlink(paf_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) -{ - 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 ( bug_w ) { - u3l_log("http: server not found: %x\r\n", sev_l); - } - return 0; - } - else if ( !(hon_u = _http_conn_find(htp_u, coq_l)) ) { - if ( bug_w ) { - u3l_log("http: connection not found: %x/%d\r\n", sev_l, coq_l); - } - return 0; - } - else if ( !(req_u = _http_req_find(hon_u, seq_l)) ) { - if ( bug_w ) { - u3l_log("http: request not found: %x/%d/%d\r\n", - sev_l, coq_l, seq_l); - } - return 0; - } - - 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) -{ - u3_http* htp_u; - c3_s por_s; - - u3_noun sec = u3_nul; - u3_noun non = u3_none; - - u3_form* for_u = u3_Host.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; - - // 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); - - // 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 ) { - 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); - - 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); - } - } - - // HTTP server. - { - por_s = ( c3y == for_u->pro ) ? 8080 : 80; - 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; - } - - // Loopback server. - { - 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); - } - - // send listening ports to %eyre - { - c3_assert( u3_none != non ); - - u3_noun pax = u3nq(u3_blip, - u3i_string("http-server"), - u3k(u3A->sen), - u3_nul); - u3_pier_plan(pax, u3nt(c3__live, non, sec)); - } - - _http_write_ports_file(u3_Host.dir_c); - _http_form_free(); -} - -/* _http_serv_restart(): gracefully shutdown, then start servers. -*/ -static void -_http_serv_restart(void) -{ - u3_http* htp_u = u3_Host.htp_u; - - if ( 0 == htp_u ) { - _http_serv_start_all(); - } - else { - u3l_log("http: restarting servers to apply configuration\n"); - - while ( 0 != htp_u ) { - if ( c3y == htp_u->liv ) { - _http_serv_close(htp_u); - } - htp_u = htp_u->nex_u; - } - - _http_release_ports_file(u3_Host.dir_c); - } -} - -/* _http_form_free(): free and unlink saved config. -*/ -static void -_http_form_free(void) -{ - u3_form* for_u = u3_Host.fig_u.for_u; - - if ( 0 == for_u ) { - return; - } - - if ( 0 != for_u->key_u.base ) { - c3_free(for_u->key_u.base); - } - - if ( 0 != for_u->cer_u.base ) { - c3_free(for_u->cer_u.base); - } - - c3_free(for_u); - u3_Host.fig_u.for_u = 0; -} - -/* u3_http_ef_form(): apply configuration, restart servers. -*/ -void -u3_http_ef_form(u3_noun fig) -{ - u3_noun sec, pro, log, red; - - if ( (c3n == u3r_qual(fig, &sec, &pro, &log, &red) ) || - // confirm sec is a valid (unit ^) - !( u3_nul == sec || ( c3y == u3du(sec) && - c3y == u3du(u3t(sec)) && - u3_nul == u3h(sec) ) ) || - // confirm valid flags ("loobeans") - !( c3y == pro || c3n == pro ) || - !( c3y == log || c3n == log ) || - !( c3y == red || c3n == red ) ) { - u3l_log("http: form: invalid card\n"); - u3z(fig); - return; - } - - u3_form* for_u = c3_malloc(sizeof(*for_u)); - for_u->pro = (c3_o)pro; - for_u->log = (c3_o)log; - for_u->red = (c3_o)red; - - if ( u3_nul != sec ) { - u3_noun key = u3h(u3t(sec)); - u3_noun cer = u3t(u3t(sec)); - - for_u->key_u = _http_wain_to_buf(u3k(key)); - for_u->cer_u = _http_wain_to_buf(u3k(cer)); - } - else { - for_u->key_u = uv_buf_init(0, 0); - for_u->cer_u = uv_buf_init(0, 0); - } - - u3z(fig); - _http_form_free(); - - u3_Host.fig_u.for_u = for_u; - - _http_serv_restart(); - - // 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(); - } -} - -/* u3_http_io_init(): initialize http I/O. -*/ -void -u3_http_io_init(void) -{ -} - -/* u3_http_io_talk(): start http I/O. -*/ -void -u3_http_io_talk(void) -{ -} - -/* u3_http_io_exit(): shut down http. -*/ -void -u3_http_io_exit(void) -{ - // dispose of configuration to avoid restarts - // - _http_form_free(); - - // 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 close u3_Host.fig_u.cli_u and con_u - - _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); -} diff --git a/pkg/urbit/vere/ames.c b/pkg/urbit/vere/io/ames.c similarity index 52% rename from pkg/urbit/vere/ames.c rename to pkg/urbit/vere/io/ames.c index 371ac95daa..a4bad01277 100644 --- a/pkg/urbit/vere/ames.c +++ b/pkg/urbit/vere/io/ames.c @@ -9,13 +9,42 @@ #include #include #include -#include -#include -#include #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_s por_s; // public IPv4 port + c3_c* dns_c; // domain XX multiple/fallback + 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 + } u3_ames; + /* _ames_alloc(): libuv buffer allocator. */ static void @@ -48,11 +77,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 +89,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 +133,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 +160,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 +237,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,32 +303,21 @@ _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 ) { + if ( c3n == sam_u->car_u.liv_o ) { u3l_log("ames: not yet live, dropping outbound\r\n"); u3z(lan); u3z(pac); return; } 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); @@ -351,6 +358,83 @@ u3_ames_ef_send(u3_pier* pir_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) +{ + 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 ) { + 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); + } + } + + u3_ovum_free(egg_u); +} + /* _ames_recv_cb(): receive callback. */ static void @@ -360,52 +444,57 @@ _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 wir = u3nc(c3__ames, u3_nul); + u3_noun cad; + { 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 + cad = u3nt(c3__hear, u3nc(c3n, lan), msg); } - c3_free(buf_u->base); + + u3_auto_peer( + u3_auto_plan(&sam_u->car_u, + u3_ovum_init(0, c3__a, wir, cad)), + 0, 0, _ames_hear_bail); + + _ames_cap_queue(sam_u); } + + 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 ) { @@ -417,11 +506,6 @@ _ames_io_start(u3_pier* pir_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); - } - // Bind and stuff. { struct sockaddr_in add_u; @@ -445,7 +529,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_bail(u3_king_stub()); } uv_udp_getsockname(&sam_u->wax_u, (struct sockaddr *)&add_u, &add_i); @@ -455,127 +541,209 @@ _ames_io_start(u3_pier* pir_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); - sam_u->liv = c3y; + sam_u->car_u.liv_o = c3y; u3z(rac); u3z(who); } -/* _cttp_mcut_char(): measure/cut character. +/* _ames_ef_turf(): initialize ames I/O on domain(s). */ -static c3_w -_cttp_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c) +static void +_ames_ef_turf(u3_ames* sam_u, u3_noun tuf) { - 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; -} - -/* 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* sam_u = pir_u->sam_u; - 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)); + 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 ? + // + 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); + // XX is this ever necessary? + // + if ( c3n == sam_u->car_u.liv_o ) { + _ames_io_start(sam_u); } } +/* _ames_io_talk(): start receiving ames traffic. +*/ +static void +_ames_io_talk(u3_auto* car_u) +{ + u3_ames* sam_u = (u3_ames*)car_u; + _ames_io_start(sam_u); + + // send born event + // + { + u3_noun wir = u3nt(c3__newt, u3k(u3A->sen), u3_nul); + u3_noun cad = u3nc(c3__born, u3_nul); + + u3_auto_plan(car_u, u3_ovum_init(0, c3__a, wir, cad)); + } +} + +/* _ames_kick_newt(): apply packet network outputs. +*/ +static c3_o +_ames_kick_newt(u3_ames* sam_u, u3_noun tag, u3_noun dat) +{ + 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; +} + +/* _ames_io_kick(): apply effects +*/ +static c3_o +_ames_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) +{ + u3_ames* sam_u = (u3_ames*)car_u; + + u3_noun tag, dat, i_wir; + c3_o ret_o; + + if ( (c3n == u3r_cell(wir, &i_wir, 0)) + || (c3n == u3r_cell(cad, &tag, &dat)) ) + { + ret_o = c3n; + } + else { + switch ( i_wir ) { + default: { + ret_o = c3n; + } break; + + // XX should also be c3__ames + // + case c3__newt: { + ret_o = _ames_kick_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_kick_newt(sam_u, u3k(tag), u3k(dat)); + } + } break; + } + } + + u3z(wir); u3z(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; + 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); + u3l_log(" crashed: %" PRIu64 "\n", sam_u->fal_d); +} + /* u3_ames_io_init(): initialize ames I/O. */ -void +u3_auto* u3_ames_io_init(u3_pier* pir_u) { - u3_ames* sam_u = pir_u->sam_u; - sam_u->liv = c3n; -} + 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; + sam_u->dop_d = 0; -/* u3_ames_io_talk(): start receiving ames traffic. -*/ -void -u3_ames_io_talk(u3_pier* pir_u) -{ - _ames_io_start(pir_u); -} + c3_assert( !uv_udp_init(u3L, &sam_u->wax_u) ); + sam_u->wax_u.data = sam_u; -/* u3_ames_io_exit(): terminate ames I/O. -*/ -void -u3_ames_io_exit(u3_pier* pir_u) -{ - u3_ames* sam_u = pir_u->sam_u; - - if ( c3y == sam_u->liv ) { - uv_close(&sam_u->had_u, 0); + // Disable networking for fake ships + // + if ( c3y == sam_u->fak_o ) { + u3_Host.ops_u.net = c3n; } + + + 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.info_f = _ames_io_info; + car_u->io.kick_f = _ames_io_kick; + car_u->io.exit_f = _ames_io_exit; + + return car_u; } diff --git a/pkg/urbit/vere/io/behn.c b/pkg/urbit/vere/io/behn.c new file mode 100644 index 0000000000..7e13c05b3a --- /dev/null +++ b/pkg/urbit/vere/io/behn.c @@ -0,0 +1,245 @@ +/* vere/behn.c +** +*/ +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* u3_behn: just a timer for ever +*/ + typedef struct _u3_behn { + u3_auto car_u; // driver + uv_timer_t tim_u; // behn timer + 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 +_behn_wake_bail(u3_ovum* egg_u, u3_noun lud) +{ + u3_auto* car_u = egg_u->car_u; + + if ( (2 > egg_u->try_w) + && (c3n == _behn_bail_dire(lud)) ) + { + u3z(lud); + u3_auto_redo(car_u, egg_u); + } + else { + u3_auto_bail_slog(egg_u, lud); + u3_ovum_free(egg_u); + + 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. +*/ +static void +_behn_time_cb(uv_timer_t* tim_u) +{ + u3_behn* teh_u = tim_u->data; + teh_u->alm_o = c3n; + + // 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. + // + { + 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); + } + + // send timer event + // + { + u3_noun wir = u3nc(c3__behn, u3_nul); + u3_noun cad = u3nc(c3__wake, u3_nul); + + u3_auto_peer( + u3_auto_plan(&teh_u->car_u, u3_ovum_init(0, c3__b, wir, cad)), + 0, 0, _behn_wake_bail); + } +} + +/* u3_behn_ef_doze(): set or cancel timer +*/ +static void +_behn_ef_doze(u3_behn* teh_u, u3_noun wen) +{ + if ( c3n == teh_u->car_u.liv_o ) { + teh_u->car_u.liv_o = c3y; + } + + if ( c3y == teh_u->alm_o ) { + uv_timer_stop(&teh_u->tim_u); + teh_u->alm_o = c3n; + } + + if ( (u3_nul != wen) && + (c3y == u3du(wen)) && + (c3y == u3ud(u3t(wen))) ) + { + struct timeval tim_tv; + gettimeofday(&tim_tv, 0); + + 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; + uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); + } + + 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; + } +} + +/* _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; + + if ( (2 > egg_u->try_w) + && (c3n == _behn_bail_dire(lud)) ) + { + u3z(lud); + u3_auto_redo(car_u, egg_u); + } + else { + u3_auto_bail_slog(egg_u, lud); + u3_ovum_free(egg_u); + + 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 +*/ +static void +_behn_io_talk(u3_auto* car_u) +{ + // XX remove u3A->sen + // + u3_noun wir = u3nt(c3__behn, u3k(u3A->sen), u3_nul); + u3_noun cad = u3nc(c3__born, u3_nul); + + u3_auto_peer( + u3_auto_plan(car_u, u3_ovum_init(0, c3__b, wir, cad)), + 0, + _behn_born_news, + _behn_born_bail); +} + +/* _behn_io_kick(): apply effects. +*/ +static c3_o +_behn_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) +{ + u3_behn* teh_u = (u3_behn*)car_u; + + u3_noun tag, dat, i_wir; + c3_o ret_o; + + if ( (c3n == u3r_cell(wir, &i_wir, 0)) + || (c3n == u3r_cell(cad, &tag, &dat)) + || (c3__behn != i_wir) ) + { + ret_o = c3n; + } + else { + ret_o = c3y; + _behn_ef_doze(teh_u, u3k(dat)); + } + + u3z(wir); u3z(cad); + 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); +} + +/* 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_o = 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; + + 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; + + return car_u; +} diff --git a/pkg/urbit/vere/cttp.c b/pkg/urbit/vere/io/cttp.c similarity index 73% rename from pkg/urbit/vere/cttp.c rename to pkg/urbit/vere/io/cttp.c index e5f25b16b3..5c6e3eae0c 100644 --- a/pkg/urbit/vere/cttp.c +++ b/pkg/urbit/vere/io/cttp.c @@ -14,6 +14,60 @@ #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 + 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 + 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) @@ -286,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 @@ -350,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; @@ -369,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, '&'); } { @@ -382,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; } @@ -402,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 ) { @@ -441,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; @@ -466,9 +464,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 // @@ -484,14 +482,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 @@ -499,6 +499,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; @@ -507,7 +509,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; @@ -531,6 +533,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); @@ -545,7 +548,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)); @@ -597,7 +600,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); @@ -627,6 +630,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. @@ -708,19 +712,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); + // 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_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, u3_ovum_init(0, c3__i, wir, cad)); } /* _cttp_creq_fail(): dispatch error response @@ -734,7 +735,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); } @@ -745,7 +746,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))); @@ -844,17 +845,13 @@ _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 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); @@ -935,7 +932,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()); @@ -956,86 +953,122 @@ _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) { - u3_noun pax = u3nq(u3_blip, u3i_string("http-client"), u3k(u3A->sen), u3_nul); - u3_pier_plan(pax, u3nc(c3__born, u3_nul)); + // XX remove u3A->sen + // + 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, u3_ovum_init(0, c3__i, wir, cad)); } -/* u3_cttp_io_init(): initialize http client I/O. +/* _cttp_io_kick(): apply effects */ -void -u3_cttp_io_init() +static c3_o +_cttp_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) { - // 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 tag, dat, i_wir; + 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_cell(wir, &i_wir, 0)) + || (c3n == u3r_cell(cad, &tag, &dat)) + || (c3n == u3r_sing_c("http-client", i_wir)) ) + { + 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(wir); u3z(cad); + return ret_o; } -/* u3_cttp_io_exit(): shut down cttp. +/* _cttp_io_exit_cb(): free cttp. */ -void -u3_cttp_io_exit(void) +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 +_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 // { - 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); @@ -1043,8 +1076,47 @@ 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); +} + +/* 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; + + // 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); + 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 set in done_cb for %born + // + 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; + // XX retry up to N? + // + // car_u->ev.bail_f = ...; + + return car_u; } diff --git a/pkg/urbit/vere/io/fore.c b/pkg/urbit/vere/io/fore.c new file mode 100644 index 0000000000..96f6dd53b7 --- /dev/null +++ b/pkg/urbit/vere/io/fore.c @@ -0,0 +1,144 @@ +/* vere/root.c +** +*/ +#include +#include +#include +#include +#include +#include + +#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"); + + u3_ovum_free(egg_u); +} + +/* _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, u3_ovum_init(0, u3k(tar), u3k(wir), u3k(cad))), + 0, 0, _fore_inject_bail); + } + + u3z(ovo); +} + +/* _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, u3_ovum_init(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, u3_ovum_init(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. +*/ +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) +{ + c3_free(car_u); +} + +/* 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; + // 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; + // car_u->ev.bail_f = ...; + + return car_u; +} diff --git a/pkg/urbit/vere/io/hind.c b/pkg/urbit/vere/io/hind.c new file mode 100644 index 0000000000..be83a9f66e --- /dev/null +++ b/pkg/urbit/vere/io/hind.c @@ -0,0 +1,84 @@ +/* vere/root.c +** +*/ +#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, u3_ovum_init(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) +{ + c3_free(car_u); +} + +/* 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 = 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; + // car_u->ev.bail_f = ...; + + return car_u; +} diff --git a/pkg/urbit/vere/io/http.c b/pkg/urbit/vere/io/http.c new file mode 100644 index 0000000000..bcd356221e --- /dev/null +++ b/pkg/urbit/vere/io/http.c @@ -0,0 +1,1883 @@ +/* vere/http.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +typedef struct _u3_h2o_serv { + h2o_globalconf_t fig_u; // h2o global config + h2o_context_t ctx_u; // h2o ctx + h2o_accept_ctx_t cep_u; // h2o accept ctx + h2o_hostconf_t* hos_u; // h2o host config + 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(u3_httd* htd_u); +static void _http_form_free(u3_httd* htd_u); + +static const c3_i TCP_BACKLOG = 16; + +/* _http_close_cb(): uv_close_cb that just free's handle +*/ +static void +_http_close_cb(uv_handle_t* han_u) +{ + c3_free(han_u); +} + +/* _http_vec_to_meth(): convert h2o_iovec_t to meth +*/ +static u3_weak +_http_vec_to_meth(h2o_iovec_t vec_u) +{ + return ( 0 == strncmp(vec_u.base, "GET", vec_u.len) ) ? u3i_string("GET") : + ( 0 == strncmp(vec_u.base, "PUT", vec_u.len) ) ? u3i_string("PUT") : + ( 0 == strncmp(vec_u.base, "POST", vec_u.len) ) ? u3i_string("POST") : + ( 0 == strncmp(vec_u.base, "HEAD", vec_u.len) ) ? u3i_string("HEAD") : + ( 0 == strncmp(vec_u.base, "CONNECT", vec_u.len) ) ? u3i_string("CONNECT") : + ( 0 == strncmp(vec_u.base, "DELETE", vec_u.len) ) ? u3i_string("DELETE") : + ( 0 == strncmp(vec_u.base, "OPTIONS", vec_u.len) ) ? u3i_string("OPTIONS") : + ( 0 == strncmp(vec_u.base, "TRACE", vec_u.len) ) ? u3i_string("TRACE") : + // TODO ?? + // ( 0 == strncmp(vec_u.base, "PATCH", vec_u.len) ) ? c3__patc : + u3_none; +} + +/* _http_vec_to_atom(): convert h2o_iovec_t to atom (cord) +*/ +static u3_noun +_http_vec_to_atom(h2o_iovec_t vec_u) +{ + return u3i_bytes(vec_u.len, (const c3_y*)vec_u.base); +} + +/* _http_vec_to_octs(): convert h2o_iovec_t to (unit octs) +*/ +static u3_noun +_http_vec_to_octs(h2o_iovec_t vec_u) +{ + if ( 0 == vec_u.len ) { + return u3_nul; + } + + // XX correct size_t -> atom? + return u3nt(u3_nul, u3i_chubs(1, (const c3_d*)&vec_u.len), + _http_vec_to_atom(vec_u)); +} + +/* _cttp_bods_free(): free body structure. +*/ +static void +_cttp_bods_free(u3_hbod* bod_u) +{ + while ( bod_u ) { + u3_hbod* nex_u = bod_u->nex_u; + + c3_free(bod_u); + bod_u = nex_u; + } +} + +/* _cttp_bod_from_octs(): translate octet-stream noun into body. +*/ +static u3_hbod* +_cttp_bod_from_octs(u3_noun oct) +{ + c3_w len_w; + + if ( !_(u3a_is_cat(u3h(oct))) ) { // 2GB max + u3m_bail(c3__fail); return 0; + } + len_w = u3h(oct); + + { + u3_hbod* bod_u = c3_malloc(1 + len_w + sizeof(*bod_u)); + bod_u->hun_y[len_w] = 0; + bod_u->len_w = len_w; + u3r_bytes(0, len_w, bod_u->hun_y, u3t(oct)); + + bod_u->nex_u = 0; + + u3z(oct); + return bod_u; + } +} + +/* _cttp_bods_to_vec(): translate body buffers to array of h2o_iovec_t +*/ +static h2o_iovec_t* +_cttp_bods_to_vec(u3_hbod* bod_u, c3_w* tot_w) +{ + h2o_iovec_t* vec_u; + c3_w len_w; + + { + u3_hbod* bid_u = bod_u; + len_w = 0; + + while( bid_u ) { + len_w++; + bid_u = bid_u->nex_u; + } + } + + vec_u = c3_malloc(sizeof(h2o_iovec_t) * len_w); + len_w = 0; + + while( bod_u ) { + vec_u[len_w] = h2o_iovec_init(bod_u->hun_y, bod_u->len_w); + len_w++; + bod_u = bod_u->nex_u; + } + + *tot_w = len_w; + + return vec_u; +} + +/* _http_heds_to_noun(): convert h2o_header_t to (list (pair @t @t)) +*/ +static u3_noun +_http_heds_to_noun(h2o_header_t* hed_u, c3_d hed_d) +{ + u3_noun hed = u3_nul; + c3_d dex_d = hed_d; + + h2o_header_t deh_u; + + while ( 0 < dex_d ) { + deh_u = hed_u[--dex_d]; + hed = u3nc(u3nc(_http_vec_to_atom(*deh_u.name), + _http_vec_to_atom(deh_u.value)), hed); + } + + return hed; +} + +/* _http_heds_free(): free header linked list +*/ +static void +_http_heds_free(u3_hhed* hed_u) +{ + while ( hed_u ) { + u3_hhed* nex_u = hed_u->nex_u; + + c3_free(hed_u->nam_c); + c3_free(hed_u->val_c); + c3_free(hed_u); + hed_u = nex_u; + } +} + +/* _http_hed_new(): create u3_hhed from nam/val cords +*/ +static u3_hhed* +_http_hed_new(u3_atom nam, u3_atom val) +{ + c3_w nam_w = u3r_met(3, nam); + c3_w val_w = u3r_met(3, val); + u3_hhed* hed_u = c3_malloc(sizeof(*hed_u)); + + hed_u->nam_c = c3_malloc(1 + nam_w); + hed_u->val_c = c3_malloc(1 + val_w); + hed_u->nam_c[nam_w] = 0; + hed_u->val_c[val_w] = 0; + hed_u->nex_u = 0; + hed_u->nam_w = nam_w; + hed_u->val_w = val_w; + + u3r_bytes(0, nam_w, (c3_y*)hed_u->nam_c, nam); + u3r_bytes(0, val_w, (c3_y*)hed_u->val_c, val); + + return hed_u; +} + +/* _http_heds_from_noun(): convert (list (pair @t @t)) to u3_hhed +*/ +static u3_hhed* +_http_heds_from_noun(u3_noun hed) +{ + u3_noun deh = hed; + u3_noun i_hed; + + u3_hhed* hed_u = 0; + + while ( u3_nul != hed ) { + i_hed = u3h(hed); + u3_hhed* nex_u = _http_hed_new(u3h(i_hed), u3t(i_hed)); + nex_u->nex_u = hed_u; + + hed_u = nex_u; + hed = u3t(hed); + } + + u3z(deh); + return hed_u; +} + +/* _http_req_find(): find http request in connection by sequence. +*/ +static u3_hreq* +_http_req_find(u3_hcon* hon_u, c3_w seq_l) +{ + u3_hreq* req_u = hon_u->req_u; + + // XX glories of linear search + // + while ( req_u ) { + if ( seq_l == req_u->seq_l ) { + return req_u; + } + req_u = req_u->nex_u; + } + return 0; +} + +/* _http_req_link(): link http request to connection +*/ +static void +_http_req_link(u3_hcon* hon_u, u3_hreq* req_u) +{ + req_u->hon_u = hon_u; + req_u->seq_l = hon_u->seq_l++; + req_u->nex_u = hon_u->req_u; + + if ( 0 != req_u->nex_u ) { + req_u->nex_u->pre_u = req_u; + } + hon_u->req_u = req_u; +} + +/* _http_req_unlink(): remove http request from connection +*/ +static void +_http_req_unlink(u3_hreq* req_u) +{ + if ( 0 != req_u->pre_u ) { + req_u->pre_u->nex_u = req_u->nex_u; + + if ( 0 != req_u->nex_u ) { + req_u->nex_u->pre_u = req_u->pre_u; + } + } + else { + req_u->hon_u->req_u = req_u->nex_u; + + if ( 0 != req_u->nex_u ) { + req_u->nex_u->pre_u = 0; + } + } +} + +/* _http_req_to_duct(): translate srv/con/req to duct +*/ +static u3_noun +_http_req_to_duct(u3_hreq* req_u) +{ + 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)); +} + +/* _http_req_kill(): kill http request in %eyre. +*/ +static void +_http_req_kill(u3_hreq* req_u) +{ + u3_httd* htd_u = req_u->hon_u->htp_u->htd_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, u3_ovum_init(0, c3__e, wir, cad)); +} + +typedef struct _u3_hgen { + h2o_generator_t neg_u; // response callbacks + c3_o red; // ready to send + c3_o dun; // done sending + u3_hbod* bod_u; // pending body + u3_hbod* nud_u; // pending free + u3_hhed* hed_u; // pending free + u3_hreq* req_u; // originating request +} u3_hgen; + +/* _http_req_done(): request finished, deallocation callback +*/ +static void +_http_req_done(void* ptr_v) +{ + u3_hreq* req_u = (u3_hreq*)ptr_v; + + // client canceled request before response + // + if ( u3_rsat_plan == req_u->sat_e ) { + _http_req_kill(req_u); + } + + if ( 0 != req_u->tim_u ) { + uv_close((uv_handle_t*)req_u->tim_u, _http_close_cb); + req_u->tim_u = 0; + } + + _http_req_unlink(req_u); +} + +/* _http_req_timer_cb(): request timeout callback +*/ +static void +_http_req_timer_cb(uv_timer_t* tim_u) +{ + u3_hreq* req_u = tim_u->data; + + if ( u3_rsat_plan == req_u->sat_e ) { + _http_req_kill(req_u); + req_u->sat_e = u3_rsat_ripe; + + c3_c* msg_c = "gateway timeout"; + h2o_send_error_generic(req_u->rec_u, 504, msg_c, msg_c, 0); + } +} + +/* _http_req_new(): receive http request. +*/ +static u3_hreq* +_http_req_new(u3_hcon* hon_u, h2o_req_t* rec_u) +{ + u3_hreq* req_u = h2o_mem_alloc_shared(&rec_u->pool, sizeof(*req_u), + _http_req_done); + req_u->rec_u = rec_u; + req_u->sat_e = u3_rsat_init; + req_u->tim_u = 0; + req_u->gen_u = 0; + req_u->pre_u = 0; + + _http_req_link(hon_u, req_u); + + return req_u; +} + +/* _http_req_dispatch(): dispatch http request to %eyre +*/ +static void +_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_http* htp_u = req_u->hon_u->htp_u; + u3_httd* htd_u = htp_u->htd_u; + 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)); + // XX loopback automatically secure too? + // + u3_noun dat = u3nt(htp_u->sec, adr, req); + + 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, u3_ovum_init(0, c3__e, wir, cad)); + } +} + +/* _http_hgen_dispose(): dispose response generator and buffers +*/ +static void +_http_hgen_dispose(void* ptr_v) +{ + u3_hgen* gen_u = (u3_hgen*)ptr_v; + _http_heds_free(gen_u->hed_u); + gen_u->hed_u = 0; + _cttp_bods_free(gen_u->nud_u); + gen_u->nud_u = 0; + _cttp_bods_free(gen_u->bod_u); + gen_u->bod_u = 0; +} + +static void +_http_hgen_send(u3_hgen* gen_u) +{ + c3_assert( c3y == gen_u->red ); + + u3_hreq* req_u = gen_u->req_u; + h2o_req_t* rec_u = req_u->rec_u; + + c3_w len_w; + h2o_iovec_t* vec_u = _cttp_bods_to_vec(gen_u->bod_u, &len_w); + + // not ready again until _proceed + // + gen_u->red = c3n; + + // stash [bod_u] to free later + // + _cttp_bods_free(gen_u->nud_u); + gen_u->nud_u = gen_u->bod_u; + gen_u->bod_u = 0; + + if ( c3n == gen_u->dun ) { + h2o_send(rec_u, vec_u, len_w, H2O_SEND_STATE_IN_PROGRESS); + uv_timer_start(req_u->tim_u, _http_req_timer_cb, 45 * 1000, 0); + } + else { + // close connection if shutdown pending + // + u3_h2o_serv* h2o_u = req_u->hon_u->htp_u->h2o_u; + + if ( 0 != h2o_u->ctx_u.shutdown_requested ) { + rec_u->http1_is_persistent = 0; + } + + h2o_send(rec_u, vec_u, len_w, H2O_SEND_STATE_FINAL); + } + + c3_free(vec_u); +} + +/* _http_hgen_stop(): h2o is closing an in-progress response. +*/ +static void +_http_hgen_stop(h2o_generator_t* neg_u, h2o_req_t* rec_u) +{ + u3_hgen* gen_u = (u3_hgen*)neg_u; + + // response not complete, enqueue cancel + // + if ( c3n == gen_u->dun ) { + _http_req_kill(gen_u->req_u); + } +} + +/* _http_hgen_proceed(): h2o is ready for more response data. +*/ +static void +_http_hgen_proceed(h2o_generator_t* neg_u, h2o_req_t* rec_u) +{ + u3_hgen* gen_u = (u3_hgen*)neg_u; + u3_hreq* req_u = gen_u->req_u; + + // sanity check + c3_assert( rec_u == req_u->rec_u ); + + gen_u->red = c3y; + + if ( 0 != gen_u->bod_u || c3y == gen_u->dun ) { + _http_hgen_send(gen_u); + } +} + +/* _http_start_respond(): write a [%http-response %start ...] to h2o_req_t->res +*/ +static void +_http_start_respond(u3_hreq* req_u, + u3_noun status, + u3_noun headers, + u3_noun data, + u3_noun complete) +{ + // u3l_log("start\n"); + + if ( u3_rsat_plan != req_u->sat_e ) { + //u3l_log("duplicate response\n"); + return; + } + + req_u->sat_e = u3_rsat_ripe; + + uv_timer_stop(req_u->tim_u); + + h2o_req_t* rec_u = req_u->rec_u; + + rec_u->res.status = status; + rec_u->res.reason = (status < 200) ? "weird" : + (status < 300) ? "ok" : + (status < 400) ? "moved" : + (status < 500) ? "missing" : + "hosed"; + + u3_hhed* hed_u = _http_heds_from_noun(u3k(headers)); + u3_hhed* deh_u = hed_u; + + c3_i has_len_i = 0; + + while ( 0 != hed_u ) { + if ( 0 == strncmp(hed_u->nam_c, "content-length", 14) ) { + has_len_i = 1; + } + else { + h2o_add_header_by_str(&rec_u->pool, &rec_u->res.headers, + hed_u->nam_c, hed_u->nam_w, 0, 0, + hed_u->val_c, hed_u->val_w); + } + + hed_u = hed_u->nex_u; + } + + u3_hgen* gen_u = h2o_mem_alloc_shared(&rec_u->pool, sizeof(*gen_u), + _http_hgen_dispose); + gen_u->neg_u = (h2o_generator_t){ _http_hgen_proceed, _http_hgen_stop }; + gen_u->red = c3y; + gen_u->dun = complete; + gen_u->bod_u = ( u3_nul == data ) ? + 0 : _cttp_bod_from_octs(u3k(u3t(data))); + gen_u->nud_u = 0; + gen_u->hed_u = deh_u; + gen_u->req_u = req_u; + + // 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; + } + + req_u->gen_u = gen_u; + + h2o_start_response(rec_u, &gen_u->neg_u); + + _http_hgen_send(gen_u); + + u3z(status); u3z(headers); u3z(data); u3z(complete); +} + +/* _http_continue_respond(): write a [%http-response %continue ...] to + * h2o_req_t->res +*/ +static void +_http_continue_respond(u3_hreq* req_u, + /* u3_noun status, */ + /* u3_noun headers, */ + u3_noun data, + u3_noun complete) +{ + // u3l_log("continue\n"); + + // XX add sequence numbers for %continue effects? + // Arvo does not (currently) guarantee effect idempotence!! + + // response has not yet been started + if ( u3_rsat_ripe != req_u->sat_e ) { + // u3l_log("duplicate response\n"); + return; + } + + u3_hgen* gen_u = req_u->gen_u; + + uv_timer_stop(req_u->tim_u); + + // XX proposed sequence number safety check + // if ( sequence <= gen_u->sequence ) { + // return; + // } + // + // c3_assert( sequence == ++gen_u->sequence ); + + gen_u->dun = complete; + + if ( u3_nul != data ) { + u3_hbod* bod_u = _cttp_bod_from_octs(u3k(u3t(data))); + + if ( 0 == gen_u->bod_u ) { + gen_u->bod_u = bod_u; + } + else { + u3_hbod* pre_u = gen_u->bod_u; + + while ( 0 != pre_u->nex_u ) { + pre_u = pre_u->nex_u; + } + + pre_u->nex_u = bod_u; + } + } + + if ( c3y == gen_u->red ) { + _http_hgen_send(gen_u); + } + + u3z(data); u3z(complete); +} + +/* _http_rec_to_httq(): convert h2o_req_t to httq +*/ +static u3_weak +_http_rec_to_httq(h2o_req_t* rec_u) +{ + u3_noun med = _http_vec_to_meth(rec_u->method); + + if ( u3_none == med ) { + return u3_none; + } + + u3_noun url = _http_vec_to_atom(rec_u->path); + u3_noun hed = _http_heds_to_noun(rec_u->headers.entries, + rec_u->headers.size); + + // restore host header + hed = u3nc(u3nc(u3i_string("host"), + _http_vec_to_atom(rec_u->authority)), + hed); + + u3_noun bod = _http_vec_to_octs(rec_u->entity); + + return u3nq(med, url, hed, bod); +} + +typedef struct _h2o_uv_sock { // see private st_h2o_uv_socket_t + h2o_socket_t sok_u; // socket + uv_stream_t* han_u; // client stream handler (u3_hcon) +} h2o_uv_sock; + +/* _http_rec_accept(); handle incoming http request from h2o. +*/ +static c3_i +_http_rec_accept(h2o_handler_t* han_u, h2o_req_t* rec_u) +{ + u3_weak req = _http_rec_to_httq(rec_u); + + if ( u3_none == req ) { + if ( (u3C.wag_w & u3o_verbose) ) { + u3l_log("strange %.*s request\n", (int)rec_u->method.len, + rec_u->method.base); + } + c3_c* msg_c = "bad request"; + h2o_send_error_generic(rec_u, 400, msg_c, msg_c, 0); + } + else { + h2o_uv_sock* suv_u = (h2o_uv_sock*)rec_u->conn-> + callbacks->get_socket(rec_u->conn); + u3_hcon* hon_u = (u3_hcon*)suv_u->han_u; + + // sanity check + c3_assert( hon_u->sok_u == &suv_u->sok_u ); + + u3_hreq* req_u = _http_req_new(hon_u, rec_u); + + req_u->tim_u = c3_malloc(sizeof(*req_u->tim_u)); + req_u->tim_u->data = req_u; + uv_timer_init(u3L, req_u->tim_u); + uv_timer_start(req_u->tim_u, _http_req_timer_cb, 600 * 1000, 0); + + _http_req_dispatch(req_u, req); + } + + return 0; +} + +/* _http_conn_find(): find http connection in server by sequence. +*/ +static u3_hcon* +_http_conn_find(u3_http *htp_u, c3_w coq_l) +{ + u3_hcon* hon_u = htp_u->hon_u; + + // XX glories of linear search + // + while ( hon_u ) { + if ( coq_l == hon_u->coq_l ) { + return hon_u; + } + hon_u = hon_u->nex_u; + } + return 0; +} + +/* _http_conn_link(): link http request to connection +*/ +static void +_http_conn_link(u3_http* htp_u, u3_hcon* hon_u) +{ + hon_u->htp_u = htp_u; + hon_u->coq_l = htp_u->coq_l++; + hon_u->nex_u = htp_u->hon_u; + + if ( 0 != hon_u->nex_u ) { + hon_u->nex_u->pre_u = hon_u; + } + htp_u->hon_u = hon_u; +} + +/* _http_conn_unlink(): remove http request from connection +*/ +static void +_http_conn_unlink(u3_hcon* hon_u) +{ + if ( 0 != hon_u->pre_u ) { + hon_u->pre_u->nex_u = hon_u->nex_u; + + if ( 0 != hon_u->nex_u ) { + hon_u->nex_u->pre_u = hon_u->pre_u; + } + } + else { + hon_u->htp_u->hon_u = hon_u->nex_u; + + if ( 0 != hon_u->nex_u ) { + hon_u->nex_u->pre_u = 0; + } + } +} + +/* _http_conn_free(): free http connection on close. +*/ +static void +_http_conn_free(uv_handle_t* han_t) +{ + u3_hcon* hon_u = (u3_hcon*)han_t; + u3_http* htp_u = hon_u->htp_u; + u3_h2o_serv* h2o_u = htp_u->h2o_u; + + c3_assert( 0 == hon_u->req_u ); + +#if 0 + { + c3_w len_w = 0; + + u3_hcon* noh_u = htp_u->hon_u; + + while ( 0 != noh_u ) { + len_w++; + noh_u = noh_u->nex_u; + } + + u3l_log("http conn free %d of %u server %d\n", hon_u->coq_l, len_w, htp_u->sev_l); + } +#endif + + _http_conn_unlink(hon_u); + +#if 0 + { + c3_w len_w = 0; + + u3_hcon* noh_u = htp_u->hon_u; + + while ( 0 != noh_u ) { + len_w++; + noh_u = noh_u->nex_u; + } + + u3l_log("http conn free %u remaining\n", len_w); + } +#endif + + if ( (0 == htp_u->hon_u) && (0 != h2o_u->ctx_u.shutdown_requested) ) { +#if 0 + u3l_log("http conn free %d free server %d\n", hon_u->coq_l, htp_u->sev_l); +#endif + _http_serv_free(htp_u); + } + + c3_free(hon_u); +} + +/* _http_conn_new(): create and accept http connection. +*/ +static u3_hcon* +_http_conn_new(u3_http* htp_u) +{ + u3_hcon* hon_u = c3_malloc(sizeof(*hon_u)); + hon_u->seq_l = 1; + hon_u->ipf_w = 0; + hon_u->req_u = 0; + hon_u->sok_u = 0; + hon_u->con_u = 0; + hon_u->pre_u = 0; + + _http_conn_link(htp_u, hon_u); + +#if 0 + u3l_log("http conn neww %d server %d\n", hon_u->coq_l, htp_u->sev_l); +#endif + + return hon_u; +} + +/* _http_serv_find(): find http server by sequence. +*/ +static u3_http* +_http_serv_find(u3_httd* htd_u, c3_l sev_l) +{ + u3_http* htp_u = htd_u->htp_u; + + // XX glories of linear search + // + while ( htp_u ) { + if ( sev_l == htp_u->sev_l ) { + return htp_u; + } + htp_u = htp_u->nex_u; + } + return 0; +} + +/* _http_serv_link(): link http server to global state. +*/ +static void +_http_serv_link(u3_httd* htd_u, u3_http* htp_u) +{ + // XX link elsewhere initially, relink on start? + + 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 = 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. +*/ +static void +_http_serv_unlink(u3_http* htp_u) +{ + // XX link elsewhere initially, relink on start? +#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 ( pre_u == htp_u ) { + pre_u = htp_u->nex_u; + } + else { + // XX glories of linear search + // + while ( pre_u ) { + if ( pre_u->nex_u == htp_u ) { + pre_u->nex_u = htp_u->nex_u; + } + else pre_u = pre_u->nex_u; + } + } +} + +/* _http_h2o_context_dispose(): h2o_context_dispose, inlined and cleaned up. +*/ +static void +_http_h2o_context_dispose(h2o_context_t* ctx) +{ + h2o_globalconf_t *config = ctx->globalconf; + size_t i, j; + + for (i = 0; config->hosts[i] != NULL; ++i) { + h2o_hostconf_t *hostconf = config->hosts[i]; + for (j = 0; j != hostconf->paths.size; ++j) { + h2o_pathconf_t *pathconf = hostconf->paths.entries + j; + h2o_context_dispose_pathconf_context(ctx, pathconf); + } + h2o_context_dispose_pathconf_context(ctx, &hostconf->fallback_path); + } + + c3_free(ctx->_pathconfs_inited.entries); + c3_free(ctx->_module_configs); + + h2o_timeout_dispose(ctx->loop, &ctx->zero_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->hundred_ms_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->handshake_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->http1.req_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->http2.idle_timeout); + + // NOTE: linked in http2/connection, never unlinked + h2o_timeout_unlink(&ctx->http2._graceful_shutdown_timeout); + + h2o_timeout_dispose(ctx->loop, &ctx->http2.graceful_shutdown_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->proxy.io_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->one_sec_timeout); + + h2o_filecache_destroy(ctx->filecache); + ctx->filecache = NULL; + + /* clear storage */ + for (i = 0; i != ctx->storage.size; ++i) { + h2o_context_storage_item_t *item = ctx->storage.entries + i; + if (item->dispose != NULL) { + item->dispose(item->data); + } + } + + c3_free(ctx->storage.entries); + + h2o_multithread_unregister_receiver(ctx->queue, &ctx->receivers.hostinfo_getaddr); + h2o_multithread_destroy_queue(ctx->queue); + + if (ctx->_timestamp_cache.value != NULL) { + h2o_mem_release_shared(ctx->_timestamp_cache.value); + } + + // NOTE: explicit uv_run removed +} + +/* _http_serv_really_free(): free http server. +*/ +static void +_http_serv_really_free(u3_http* htp_u) +{ + c3_assert( 0 == htp_u->hon_u ); + + if ( 0 != htp_u->h2o_u ) { + u3_h2o_serv* h2o_u = htp_u->h2o_u; + + if ( 0 != h2o_u->cep_u.ssl_ctx ) { + SSL_CTX_free(h2o_u->cep_u.ssl_ctx); + } + + h2o_config_dispose(&h2o_u->fig_u); + + // XX h2o_cleanup_thread if not restarting? + + c3_free(htp_u->h2o_u); + htp_u->h2o_u = 0; + } + + _http_serv_unlink(htp_u); + c3_free(htp_u); +} + +/* http_serv_free_cb(): timer callback for freeing http server. +*/ +static void +http_serv_free_cb(uv_timer_t* tim_u) +{ + u3_http* htp_u = tim_u->data; + +#if 0 + u3l_log("http serv free cb %d\n", htp_u->sev_l); +#endif + + _http_serv_really_free(htp_u); + + uv_close((uv_handle_t*)tim_u, _http_close_cb); +} + +/* _http_serv_free(): begin to free http server. +*/ +static void +_http_serv_free(u3_http* htp_u) +{ +#if 0 + u3l_log("http serv free %d\n", htp_u->sev_l); +#endif + + c3_assert( 0 == htp_u->hon_u ); + + if ( 0 == htp_u->h2o_u ) { + _http_serv_really_free(htp_u); + } + else { + u3_h2o_serv* h2o_u = htp_u->h2o_u; + + _http_h2o_context_dispose(&h2o_u->ctx_u); + + // NOTE: free deferred to allow timers to be closed + // this is a heavy-handed workaround for the lack of + // close callbacks in h2o_timer_t + // it's unpredictable how many event-loop turns will + // be required to finish closing the underlying uv_timer_t + // and we can't free until that's done (or we have UB) + // testing reveals 5s to be a long enough deferral + uv_timer_t* tim_u = c3_malloc(sizeof(*tim_u)); + + tim_u->data = htp_u; + + uv_timer_init(u3L, tim_u); + uv_timer_start(tim_u, http_serv_free_cb, 5000, 0); + } +} + +/* _http_serv_close_cb(): http server uv_close callback. +*/ +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 + if ( 0 == htp_u->hon_u ) { + _http_serv_free(htp_u); + } + + // restart if all linked servers have been shutdown + { + htp_u = htd_u->htp_u; + c3_o res = c3y; + + while ( 0 != htp_u ) { + if ( c3y == htp_u->liv ) { + res = c3n; + } + htp_u = htp_u->nex_u; + } + + if ( (c3y == res) && (0 != htd_u->fig_u.for_u) ) { + _http_serv_start_all(htd_u); + } + } +} + +/* _http_serv_close(): close http server gracefully. +*/ +static void +_http_serv_close(u3_http* htp_u) +{ + u3_h2o_serv* h2o_u = htp_u->h2o_u; + h2o_context_request_shutdown(&h2o_u->ctx_u); + +#if 0 + u3l_log("http serv close %d %p\n", htp_u->sev_l, &htp_u->wax_u); +#endif + + uv_close((uv_handle_t*)&htp_u->wax_u, _http_serv_close_cb); +} + +/* _http_serv_new(): create new http server. +*/ +static u3_http* +_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)); + + htp_u->coq_l = 1; + htp_u->por_s = por_s; + htp_u->sec = sec; + htp_u->lop = lop; + htp_u->liv = c3y; + htp_u->h2o_u = 0; + htp_u->hon_u = 0; + htp_u->nex_u = 0; + + _http_serv_link(htd_u, htp_u); + + return htp_u; +} + +/* _http_serv_accept(): accept new http connection. +*/ +static void +_http_serv_accept(u3_http* htp_u) +{ + u3_hcon* hon_u = _http_conn_new(htp_u); + + uv_tcp_init(u3L, &hon_u->wax_u); + + c3_i sas_i; + + if ( 0 != (sas_i = uv_accept((uv_stream_t*)&htp_u->wax_u, + (uv_stream_t*)&hon_u->wax_u)) ) { + if ( (u3C.wag_w & u3o_verbose) ) { + u3l_log("http: accept: %s\n", uv_strerror(sas_i)); + } + + uv_close((uv_handle_t*)&hon_u->wax_u, _http_conn_free); + return; + } + + hon_u->sok_u = h2o_uv_socket_create((uv_stream_t*)&hon_u->wax_u, + _http_conn_free); + + h2o_accept(&((u3_h2o_serv*)htp_u->h2o_u)->cep_u, hon_u->sok_u); + + // capture h2o connection (XX fragile) + hon_u->con_u = (h2o_conn_t*)hon_u->sok_u->data; + + struct sockaddr_in adr_u; + h2o_socket_getpeername(hon_u->sok_u, (struct sockaddr*)&adr_u); + hon_u->ipf_w = ( adr_u.sin_family != AF_INET ) ? + 0 : ntohl(adr_u.sin_addr.s_addr); +} + +/* _http_serv_listen_cb(): uv_connection_cb for uv_listen +*/ +static void +_http_serv_listen_cb(uv_stream_t* str_u, c3_i sas_i) +{ + u3_http* htp_u = (u3_http*)str_u; + + if ( 0 != sas_i ) { + u3l_log("http: listen_cb: %s\n", uv_strerror(sas_i)); + } + else { + _http_serv_accept(htp_u); + } +} + +/* _http_serv_init_h2o(): initialize h2o ctx and handlers for server. +*/ +static u3_h2o_serv* +_http_serv_init_h2o(SSL_CTX* tls_u, c3_o log, c3_o red) +{ + u3_h2o_serv* h2o_u = c3_calloc(sizeof(*h2o_u)); + + h2o_config_init(&h2o_u->fig_u); + h2o_u->fig_u.server_name = h2o_iovec_init( + H2O_STRLIT("urbit/vere-" URBIT_VERSION)); + + // XX default pending vhost/custom-domain design + // XX revisit the effect of specifying the port + h2o_u->hos_u = h2o_config_register_host(&h2o_u->fig_u, + h2o_iovec_init(H2O_STRLIT("default")), + 65535); + + h2o_u->cep_u.ctx = (h2o_context_t*)&h2o_u->ctx_u; + h2o_u->cep_u.hosts = h2o_u->fig_u.hosts; + h2o_u->cep_u.ssl_ctx = tls_u; + + h2o_u->han_u = h2o_create_handler(&h2o_u->hos_u->fallback_path, + sizeof(*h2o_u->han_u)); + if ( c3y == red ) { + // XX h2o_redirect_register + h2o_u->han_u->on_req = _http_rec_accept; + } + else { + h2o_u->han_u->on_req = _http_rec_accept; + } + + if ( c3y == log ) { + // XX move this to post serv_start and put the port in the name +#if 0 + c3_c* pax_c = u3_Host.dir_c; + u3_noun now = u3dc("scot", c3__da, u3k(u3A->now)); + c3_c* now_c = u3r_string(now); + c3_c* nam_c = ".access.log"; + c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(now_c) + strlen(nam_c); + + c3_c* paf_c = c3_malloc(len_w); + snprintf(paf_c, len_w, "%s/%s%s", pax_c, now_c, nam_c); + + h2o_access_log_filehandle_t* fil_u = + h2o_access_log_open_handle(paf_c, 0, H2O_LOGCONF_ESCAPE_APACHE); + + h2o_access_log_register(&h2o_u->hos_u->fallback_path, fil_u); + + c3_free(paf_c); + c3_free(now_c); + u3z(now); +#endif + } + + // XX h2o_compress_register + + h2o_context_init(&h2o_u->ctx_u, u3L, &h2o_u->fig_u); + + return h2o_u; +} + +/* _http_serv_start(): start http server. +*/ +static void +_http_serv_start(u3_http* htp_u) +{ + struct sockaddr_in adr_u; + memset(&adr_u, 0, sizeof(adr_u)); + + adr_u.sin_family = AF_INET; + adr_u.sin_addr.s_addr = ( c3y == htp_u->lop ) ? + htonl(INADDR_LOOPBACK) : + INADDR_ANY; + + uv_tcp_init(u3L, &htp_u->wax_u); + + /* Try ascending ports. + */ + while ( 1 ) { + c3_i sas_i; + + adr_u.sin_port = htons(htp_u->por_s); + + if ( 0 != (sas_i = uv_tcp_bind(&htp_u->wax_u, + (const struct sockaddr*)&adr_u, 0)) || + 0 != (sas_i = uv_listen((uv_stream_t*)&htp_u->wax_u, + TCP_BACKLOG, _http_serv_listen_cb)) ) { + if ( (UV_EADDRINUSE == sas_i) || (UV_EACCES == sas_i) ) { + if ( (c3y == htp_u->sec) && (443 == htp_u->por_s) ) { + htp_u->por_s = 8443; + } + else if ( (c3n == htp_u->sec) && (80 == htp_u->por_s) ) { + htp_u->por_s = 8080; + } + else { + htp_u->por_s++; + } + + continue; + } + + u3l_log("http: listen: %s\n", uv_strerror(sas_i)); + + _http_serv_free(htp_u); + return; + } + + 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); + + break; + } +} + +static uv_buf_t +_http_wain_to_buf(u3_noun wan) +{ + c3_w len_w = u3_mcut_path(0, 0, (c3_c)10, u3k(wan)); + c3_c* buf_c = c3_malloc(1 + len_w); + + u3_mcut_path(buf_c, 0, (c3_c)10, wan); + buf_c[len_w] = 0; + + return uv_buf_init(buf_c, len_w); +} + +/* _http_init_tls: initialize OpenSSL context +*/ +static SSL_CTX* +_http_init_tls(uv_buf_t key_u, uv_buf_t cer_u) +{ + // XX require 1.1.0 and use TLS_server_method() + SSL_CTX* tls_u = SSL_CTX_new(SSLv23_server_method()); + // XX use SSL_CTX_set_max_proto_version() and SSL_CTX_set_min_proto_version() + SSL_CTX_set_options(tls_u, SSL_OP_NO_SSLv2 | + SSL_OP_NO_SSLv3 | + // SSL_OP_NO_TLSv1 | // XX test + SSL_OP_NO_COMPRESSION); + + SSL_CTX_set_default_verify_paths(tls_u); + SSL_CTX_set_session_cache_mode(tls_u, SSL_SESS_CACHE_OFF); + SSL_CTX_set_cipher_list(tls_u, + "ECDH+AESGCM:DH+AESGCM:ECDH+AES256:DH+AES256:" + "ECDH+AES128:DH+AES:ECDH+3DES:DH+3DES:RSA+AESGCM:" + "RSA+AES:RSA+3DES:!aNULL:!MD5:!DSS"); + + // enable ALPN for HTTP 2 support +#if 0 //H2O_USE_ALPN + { + SSL_CTX_set_ecdh_auto(tls_u, 1); + h2o_ssl_register_alpn_protocols(tls_u, h2o_http2_alpn_protocols); + } +#endif + + { + BIO* bio_u = BIO_new_mem_buf(key_u.base, key_u.len); + EVP_PKEY* pky_u = PEM_read_bio_PrivateKey(bio_u, 0, 0, 0); + c3_i sas_i = SSL_CTX_use_PrivateKey(tls_u, pky_u); + + EVP_PKEY_free(pky_u); + BIO_free(bio_u); + + if( 0 == sas_i ) { + u3l_log("http: load private key failed:\n"); + ERR_print_errors_fp(u3_term_io_hija()); + u3_term_io_loja(1); + + SSL_CTX_free(tls_u); + + return 0; + } + } + + { + BIO* bio_u = BIO_new_mem_buf(cer_u.base, cer_u.len); + X509* xer_u = PEM_read_bio_X509_AUX(bio_u, 0, 0, 0); + c3_i sas_i = SSL_CTX_use_certificate(tls_u, xer_u); + + X509_free(xer_u); + + if( 0 == sas_i ) { + u3l_log("http: load certificate failed:\n"); + ERR_print_errors_fp(u3_term_io_hija()); + u3_term_io_loja(1); + + BIO_free(bio_u); + SSL_CTX_free(tls_u); + + return 0; + } + + // get any additional CA certs, ignoring errors + while ( 0 != (xer_u = PEM_read_bio_X509(bio_u, 0, 0, 0)) ) { + // XX require 1.0.2 or newer and use SSL_CTX_add0_chain_cert + SSL_CTX_add_extra_chain_cert(tls_u, xer_u); + } + + BIO_free(bio_u); + } + + return tls_u; +} + +/* _http_write_ports_file(): update .http.ports +*/ +static void +_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); + + c3_c* paf_c = c3_malloc(len_w); + snprintf(paf_c, len_w, "%s/%s", pax_c, nam_c); + + c3_i por_i = open(paf_c, O_WRONLY | O_CREAT | O_TRUNC, 0666); + c3_free(paf_c); + + u3_http* htp_u = htd_u->htp_u; + + while ( 0 != htp_u ) { + if ( 0 < htp_u->por_s ) { + dprintf(por_i, "%u %s %s\n", htp_u->por_s, + (c3y == htp_u->sec) ? "secure" : "insecure", + (c3y == htp_u->lop) ? "loopback" : "public"); + } + + htp_u = htp_u->nex_u; + } + + c3_sync(por_i); + close(por_i); +} + +/* _http_release_ports_file(): remove .http.ports +*/ +static void +_http_release_ports_file(c3_c *pax_c) +{ + c3_c* nam_c = ".http.ports"; + c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(nam_c); + + c3_c* paf_c = c3_malloc(len_w); + snprintf(paf_c, len_w, "%s/%s", pax_c, nam_c); + + unlink(paf_c); + c3_free(paf_c); +} + +static u3_hreq* +_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(htd_u, sev_l)) ) { + if ( bug_w ) { + u3l_log("http: server not found: %x\r\n", sev_l); + } + return 0; + } + else if ( !(hon_u = _http_conn_find(htp_u, coq_l)) ) { + if ( bug_w ) { + u3l_log("http: connection not found: %x/%d\r\n", sev_l, coq_l); + } + return 0; + } + else if ( !(req_u = _http_req_find(hon_u, seq_l)) ) { + if ( bug_w ) { + u3l_log("http: request not found: %x/%d/%d\r\n", + sev_l, coq_l, seq_l); + } + return 0; + } + + return req_u; +} + +/* _http_serv_start_all(): initialize and start servers based on saved config. +*/ +static void +_http_serv_start_all(u3_httd* htd_u) +{ + u3_http* htp_u; + c3_s por_s; + + u3_noun sec = u3_nul; + u3_noun non = u3_none; + + 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 + htd_u->tls_u = 0; + + // HTTPS server. + if ( (0 != for_u->key_u.base) && (0 != for_u->cer_u.base) ) { + 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 != htd_u->tls_u ) { + por_s = ( c3y == for_u->pro ) ? 8443 : 443; + 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); + } + } + + // HTTP server. + { + por_s = ( c3y == for_u->pro ) ? 8080 : 80; + 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); + non = htp_u->por_s; + } + + // Loopback server. + { + por_s = 12321; + 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); + } + + // send listening ports to %eyre + { + c3_assert( u3_none != non ); + + // XX remove [sen] + // + 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, u3_ovum_init(0, c3__e, wir, cad)); + } + + _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(u3_httd* htd_u) +{ + u3_http* htp_u = htd_u->htp_u; + + if ( 0 == htp_u ) { + _http_serv_start_all(htd_u); + } + else { + u3l_log("http: restarting servers to apply configuration\n"); + + while ( 0 != htp_u ) { + if ( c3y == htp_u->liv ) { + _http_serv_close(htp_u); + } + htp_u = htp_u->nex_u; + } + + _http_release_ports_file(u3_Host.dir_c); + } +} + +/* _http_form_free(): free and unlink saved config. +*/ +static void +_http_form_free(u3_httd* htd_u) +{ + u3_form* for_u = htd_u->fig_u.for_u; + + if ( 0 == for_u ) { + return; + } + + if ( 0 != for_u->key_u.base ) { + c3_free(for_u->key_u.base); + } + + if ( 0 != for_u->cer_u.base ) { + c3_free(for_u->cer_u.base); + } + + c3_free(for_u); + htd_u->fig_u.for_u = 0; +} + +/* u3_http_ef_form(): apply configuration, restart servers. +*/ +void +u3_http_ef_form(u3_httd* htd_u, u3_noun fig) +{ + u3_noun sec, pro, log, red; + + if ( (c3n == u3r_qual(fig, &sec, &pro, &log, &red) ) || + // confirm sec is a valid (unit ^) + !( u3_nul == sec || ( c3y == u3du(sec) && + c3y == u3du(u3t(sec)) && + u3_nul == u3h(sec) ) ) || + // confirm valid flags ("loobeans") + !( c3y == pro || c3n == pro ) || + !( c3y == log || c3n == log ) || + !( c3y == red || c3n == red ) ) { + u3l_log("http: form: invalid card\n"); + u3z(fig); + return; + } + + u3_form* for_u = c3_malloc(sizeof(*for_u)); + for_u->pro = (c3_o)pro; + for_u->log = (c3_o)log; + for_u->red = (c3_o)red; + + if ( u3_nul != sec ) { + u3_noun key = u3h(u3t(sec)); + u3_noun cer = u3t(u3t(sec)); + + for_u->key_u = _http_wain_to_buf(u3k(key)); + for_u->cer_u = _http_wain_to_buf(u3k(cer)); + } + else { + for_u->key_u = uv_buf_init(0, 0); + for_u->cer_u = uv_buf_init(0, 0); + } + + u3z(fig); + _http_form_free(htd_u); + + htd_u->fig_u.for_u = for_u; + + _http_serv_restart(htd_u); + + htd_u->car_u.liv_o = c3y; +} + +/* _http_io_talk(): start http I/O. +*/ +static void +_http_io_talk(u3_auto* car_u) +{ + // XX remove u3A->sen + // + 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, u3_ovum_init(0, c3__e, wir, cad)); + + // XX set liv_o on done/swap? + // +} + +/* _http_ef_http_server(): dispatch an %http-server effect from %light. +*/ +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); +} + +/* _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; + } + } +} + +/* _http_io_kick(): apply effects. +*/ +static c3_o +_http_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) +{ + u3_httd* htd_u = (u3_httd*)car_u; + + u3_noun tag, dat, i_wir, t_wir; + + if ( (c3n == u3r_cell(wir, &i_wir, &t_wir)) + || (c3n == u3r_cell(cad, &tag, &dat)) + || (c3n == u3r_sing_c("http-server", i_wir)) ) + { + u3z(wir); u3z(cad); + return c3n; + } + + // XX this needs to be rewritten, it defers (c3n) in cases it should not + // + { + 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; + + + if ( (c3n == u3r_cell(pud, &p_pud, &t_pud)) || + (c3n == _reck_lily(c3__uv, u3k(p_pud), &sev_l)) ) + { + u3z(wir); u3z(cad); + 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(wir); u3z(cad); + 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(wir); u3z(cad); + return c3n; + } + } + } + + _http_ef_http_server(htd_u, sev_l, coq_l, seq_l, u3k(tag), u3k(dat)); + u3z(wir); u3z(cad); + 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(htd_u); + + // close all servers + // + // 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_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.kick_f = _http_io_kick; + car_u->io.exit_f = _http_io_exit; + // 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/io/term.c similarity index 74% rename from pkg/urbit/vere/term.c rename to pkg/urbit/vere/io/term.c index 906fbd3c2a..3eb24050cd 100644 --- a/pkg/urbit/vere/term.c +++ b/pkg/urbit/vere/io/term.c @@ -8,9 +8,7 @@ #include #include #include -#include #include -#include #include "all.h" #include "vere/vere.h" @@ -21,14 +19,45 @@ 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 ) { + 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) + && ( (errno == EINTR) + || (errno == EAGAIN) + || (errno == EWOULDBLOCK) )); + + // assert on true errors + // + // NB: can't call u3l_log here or we would re-enter _write() + // + if ( ret_i < 0 ) { + fprintf(stderr, "term: write failed %s\r\n", strerror(errno)); + c3_assert(0); + } + // continue partial writes + // + else { + len_i -= ret_i; + buf_v += ret_i; + } } } @@ -58,7 +87,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 +120,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,15 +141,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. - // - { - if ( 0 != setupterm(0, 2, 0) ) { - c3_assert(!"init-setupterm"); - } } // Load terminfo strings. @@ -129,39 +148,32 @@ u3_term_io_init() { 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; @@ -227,6 +239,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 +264,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,29 +278,21 @@ 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); - } - 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 ) { @@ -283,10 +304,10 @@ u3_term_io_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. @@ -301,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); @@ -581,15 +602,43 @@ _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 wir, u3_noun cad) +{ + u3_ovum* egg_u = u3_auto_plan(car_u, u3_ovum_init(0, c3__d, wir, cad)); + + // term events have no spinner label + // + u3z(egg_u->pin_u.lab); + egg_u->pin_u.lab = 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) { - 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 wir = u3nt(c3__term, '1', u3_nul); + u3_noun cad = 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_ovum* egg_u = _term_ovum_plan(uty_u->car_u, wir, cad); + + // no spinner delay on %ret + // + if ( c3__ret == u3h(blb) ) { + egg_u->pin_u.del_o = c3n; + } + } } /* _term_io_suck_char(): process a single character. @@ -715,7 +764,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)); @@ -798,15 +850,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'; @@ -836,7 +888,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(); @@ -852,7 +904,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; @@ -905,7 +957,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; @@ -952,9 +1004,16 @@ 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); + // 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)); - u3_pier_plan(pax, u3nc(c3__blew, u3_term_get_blew(1))); + c3_assert( 1 == u3_Host.uty_u->tid_l ); + + _term_ovum_plan(u3_Host.uty_u->car_u, wir, cad); + } } /* u3_term_ef_ctlc(): send ^C on console. @@ -962,35 +1021,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 wir = u3nt(c3__term, '1', u3_nul); + u3_noun cad = 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); + _term_ovum_plan(uty_u->car_u, wir, cad); + } - 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. @@ -1079,32 +1122,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* @@ -1249,3 +1266,213 @@ 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 wir = u3nt(c3__term, '1', u3_nul); + u3_noun cad; + + // send terminal dimensions + // + { + 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 + // + // u3nq(c3__flow, c3__seat, c3__dojo, u3_nul) + + // refresh terminal state + // + { + cad = u3nc(c3__hail, u3_nul); + _term_ovum_plan(car_u, wir, cad); + } +} + +/* _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_kick(): apply effects. +*/ +static c3_o +_term_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) +{ + u3_noun tag, dat, i_wir, t_wir; + c3_o ret_o; + + 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 = t_wir; + 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_king_grab, 0, 0); + } break; + + // ignore pack (processed in worker) + // + case c3__pack: { + ret_o = c3y; + // XX would be + // + // u3_assure(u3_pier_pack(car_u->pir_u)); + } break; + } + } + } + + u3z(wir); u3z(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) +{ + u3_utty* uty_u = _term_main(); + + // 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 +*/ +u3_auto* +u3_term_io_init(u3_pier* pir_u) +{ + u3_auto* car_u = c3_calloc(sizeof(*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 = 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; + + return car_u; +} diff --git a/pkg/urbit/vere/unix.c b/pkg/urbit/vere/io/unix.c similarity index 76% rename from pkg/urbit/vere/unix.c rename to pkg/urbit/vere/io/unix.c index badd5289ee..debca0c833 100644 --- a/pkg/urbit/vere/unix.c +++ b/pkg/urbit/vere/io/unix.c @@ -7,15 +7,83 @@ #include #include #include -#include -#include #include #include #include #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 +99,6 @@ c3_w u3_readdir_r(DIR *dirp, struct dirent *entry, struct dirent **result) return(0); } - /* _unix_down(): descend path. */ static c3_c* @@ -41,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; @@ -54,7 +121,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 +142,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 +334,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 +350,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 +361,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 +380,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 +444,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 +453,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 +494,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 +519,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 +542,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 +559,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 +571,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 +595,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 +605,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 @@ -598,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); @@ -610,7 +678,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 +689,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 +706,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 +751,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 +767,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 +793,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 +812,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 +896,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 +916,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 +931,36 @@ _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)); + { + // 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_auto_plan(&unx_u->car_u, u3_ovum_init(0, c3__c, wir, cad)); + } } } @@ -1024,7 +1097,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 ); @@ -1038,11 +1111,11 @@ _unix_sync_file(u3_pier *pir_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); @@ -1062,7 +1135,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 +1143,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 +1161,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 +1186,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 +1210,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 +1219,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,39 +1238,43 @@ _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) { 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); } + + unx_u->car_u.liv_o = c3y; + u3z(hil); } @@ -1275,55 +1352,126 @@ 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) +{ + // XX review wire + // + u3_noun wir = u3nc(c3__boat, u3_nul); + u3_noun cad = u3nc(c3__boat, u3_nul); + + u3_auto_plan(car_u, u3_ovum_init(0, c3__c, wir, cad)); +} + +/* _unix_io_kick(): apply effects. +*/ +static c3_o +_unix_io_kick(u3_auto* car_u, u3_noun wir, u3_noun cad) +{ + u3_unix* unx_u = (u3_unix*)car_u; + + u3_noun tag, dat, i_wir; + c3_o ret_o; + + 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; + } + 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(wir); u3z(cad); + 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); +} + /* 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.kick_f = _unix_io_kick; + car_u->io.exit_f = _unix_io_exit; + // XX wat do + // + // car_u->ev.bail_f = ...l; -/* u3_unix_io_exit(): terminate unix I/O. -*/ -void -u3_unix_io_exit(u3_pier *pir_u) -{ - u3_unix_release(pir_u->pax_c); + return car_u; } diff --git a/pkg/urbit/vere/daemon.c b/pkg/urbit/vere/king.c similarity index 61% rename from pkg/urbit/vere/daemon.c rename to pkg/urbit/vere/king.c index 2792146cae..c0df14592a 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,145 +85,28 @@ 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 _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); -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 +/* _king_defy_fate(): invalid fate */ void -_daemon_defy_fate() +_king_defy_fate() { exit(1); } -/* _daemon_fate(): top-level fate parser +/* _king_doom(): doom 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) -{ - /* 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 -*/ -void -_daemon_doom(u3_noun doom) +_king_doom(u3_noun doom) { u3_noun load; void (*next)(u3_noun); @@ -262,19 +116,13 @@ _daemon_doom(u3_noun doom) switch ( u3h(doom) ) { case c3__boot: - next = _daemon_boot; - break; - case c3__exit: - next = _daemon_exit; + next = _king_boot; break; case c3__pier: - next = _daemon_pier; - break; - case c3__root: - next = _daemon_root; + next = _king_pier; break; default: - _daemon_defy_fate(); + _king_defy_fate(); } load = u3k(u3t(doom)); @@ -282,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); @@ -296,77 +144,76 @@ _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) { - 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) +/* _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; - 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 // u3C.slog_f = 0; } -/* _daemon_exit(): exit parser +/* _king_pier(): pier parser */ void -_daemon_exit(u3_noun exit) -{ -} - -/* _daemon_pier(): pier parser -*/ -void -_daemon_pier(u3_noun pier) +_king_pier(u3_noun pier) { if ( (c3n == u3du(pier)) || (c3n == u3ud(u3t(pier))) ) { @@ -374,72 +221,15 @@ _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); } -/* _daemon_root(): root parser -*/ -void -_daemon_root(u3_noun root) -{ -} - -/* _daemon_bail(): bail for command socket newt -*/ -void -_daemon_bail(u3_moor *vod_p, const c3_c *err_c) -{ - u3_moor *free_p; - u3l_log("_daemon_bail: %s\r\n", err_c); - - if ( vod_p == 0 ) { - free_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); - } -} - -/* _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->vod_p = 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 = mor_u->nex_u; - mor_u->nex_u = 0; - } - - uv_pipe_init(u3L, &mor_u->pyp_u, 0); - mor_u->pok_f = _daemon_fate; - mor_u->bal_f = (u3_bail)_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 +/* _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); @@ -451,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; @@ -470,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); @@ -581,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 ) { @@ -655,7 +445,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) @@ -720,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 // @@ -764,7 +554,22 @@ _daemon_sign_init(void) u3_Host.sig_u = sig_u; } - // handle SIGQUIT (turn it into SIGABRT) + // handle SIGINFO (if available) + // +#ifndef U3_OS_linux + { + 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; + } +#endif + + // handle SIGUSR1 (fallback for SIGINFO) // { u3_usig* sig_u; @@ -772,16 +577,16 @@ _daemon_sign_init(void) sig_u = c3_malloc(sizeof(u3_usig)); uv_signal_init(u3L, &sig_u->sil_u); - sig_u->num_i = SIGQUIT; + 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: { @@ -790,7 +595,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; } @@ -805,28 +610,34 @@ _daemon_sign_cb(uv_signal_t* sil_u, c3_i num_i) break; } - case SIGQUIT: { - abort(); + // fallthru if defined + // +#ifndef U3_OS_linux + case SIGINFO: +#endif + case SIGUSR1: { + u3_king_info(); + break; } } } -/* _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; @@ -835,67 +646,63 @@ _daemon_sign_hold(void) } } -/* _boothack_cb(): callback for the boothack self-connection -** (as if we were a client process) +/* _king_sign_close(): dispose daemon signal handlers */ -void -_boothack_cb(uv_connect_t* con_u, c3_i sas_i) +static void +_king_sign_close(void) { - u3_mojo *moj_u = con_u->data; + u3_usig* sig_u; - 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, 0); - - 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); + 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); } } - -/* _daemon_loop_init(): stuff that comes before the event loop +/* _boothack_cb(): setup pier via message as if from client. */ void -_daemon_loop_init() +_boothack_cb(uv_timer_t* tim_u) { - _daemon_sign_init(); - _daemon_sign_move(); + _king_doom(_boothack_doom()); +} - // boot hack: send pier %boot command via %doom cmd socket msg +/* _king_loop_init(): stuff that comes before the event loop +*/ +void +_king_loop_init() +{ + // initialize terminal/logging // - { - 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_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(); + + // start signal handlers + // + _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.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(); + // 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) // @@ -906,8 +713,8 @@ u3_daemon_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. { @@ -935,42 +742,132 @@ u3_daemon_commence() } } - // listen on command socket + // disable core dumps (due to lmdb size) // { - c3_c buf_c[256]; + struct rlimit rlm; - sprintf(buf_c, "/tmp/urbit-sock-%d", getpid()); - u3K.soc_c = strdup(buf_c); + 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); + } } - 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); - - _daemon_loop_init(); - + // run the loop + // + _king_loop_init(); uv_run(u3L, UV_RUN_DEFAULT); - - _daemon_loop_exit(); + _king_loop_exit(); } -/* u3_daemon_bail(): immediately shutdown. +/* 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; + } +} + +/* u3_king_info(): print status info. */ void -u3_daemon_bail(void) +u3_king_info(void) { - _daemon_loop_exit(); - u3_pier_bail(); + _king_forall(u3_pier_info); +} + +/* _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); + _king_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_bail(): immediately shutdown. +*/ +void +u3_king_bail(void) +{ + _king_forall_unlink(u3_pier_bail); + _king_loop_exit(); + u3_king_done(); 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; @@ -985,7 +882,7 @@ u3_daemon_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/lmdb.c b/pkg/urbit/vere/lmdb.c deleted file mode 100644 index bf1e3b83f4..0000000000 --- a/pkg/urbit/vere/lmdb.c +++ /dev/null @@ -1,675 +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) { - fprintf(stderr, "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) { - fprintf(stderr, "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) { - fprintf(stderr, "lmdb: 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) { - fprintf(stderr, "lmdb: 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) { - fprintf(stderr, "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 ) { - fprintf(stderr, "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; - fprintf(stderr, "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(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)) -{ - // Creates the read transaction. - MDB_txn* transaction_u; - c3_w ret_w = mdb_txn_begin(pir_u->log_u->db_u, - //environment, - (MDB_txn *) NULL, - MDB_RDONLY, /* flags */ - &transaction_u); - if (0 != ret_w) { - u3l_log("lmdb: 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: 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: 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: 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: 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 %" - 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 - 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"); - 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", - 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: 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: 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: 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: 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: 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: 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: 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: 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; -} diff --git a/pkg/urbit/vere/lord.c b/pkg/urbit/vere/lord.c new file mode 100644 index 0000000000..fef5584c5d --- /dev/null +++ b/pkg/urbit/vere/lord.c @@ -0,0 +1,1145 @@ +/* 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 + $% [%cram eve=@] + [%exit cod=@] + [%save eve=@] + [%pack ~] + == == + [%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=%1 hon=@ nok=@] eve=@ mug=@] + [%slog pri=@ ?(cord tank)] + $: %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 @da ovum) fec=(list ovum)] + [%bail lud=(list goof)] + == == + == +-- +*/ + +/* _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.ptr_v; + + 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_cram: + 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.ptr_v; + + u3_lord_halt(god_u); + bail_f(bail_v); +} + +/* _lord_writ_pop(): pop the writ stack. +*/ +static u3_writ* +_lord_writ_pop(u3_lord* god_u) +{ + u3_writ* 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; + } + + god_u->dep_w--; + + return wit_u; +} + +/* _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_cram: return "cram"; + 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, u3_writ_type typ_e) +{ + u3_writ* wit_u = _lord_writ_pop(god_u); + + 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)); + _lord_bail(god_u); + return 0; + } + + return wit_u; +} + +/* _lord_plea_foul(): +*/ +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); + } + + // XX can't unconditionally print + // + // u3m_p("plea", dat); + + _lord_bail(god_u); +} + +/* _lord_plea_live(): hear serf %live ack +*/ +static void +_lord_plea_live(u3_lord* god_u, u3_noun dat) +{ + u3_writ* wit_u = _lord_writ_pop(god_u); + + if( u3_nul != dat ) { + return _lord_plea_foul(god_u, c3__live, dat); + } + + switch ( wit_u->typ_e ) { + default: { + return _lord_plea_foul(god_u, c3__live, dat); + } break; + + case u3_writ_save: { + 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: { + // XX wire into cb + // + u3l_log("pier: pack complete\n"); + } 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"); + _lord_bail(god_u); + return; + } + + { + 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); + _lord_bail(god_u); + return; + } + + 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.ptr_v); + + 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.ptr_v, pri_w, u3k(tan)); + 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->ptr_v, 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 +_lord_plea_peek(u3_lord* god_u, u3_noun dat) +{ + u3_peek* pek_u; + { + u3_writ* wit_u = _lord_writ_need(god_u, u3_writ_peek); + pek_u = wit_u->pek_u; + c3_free(wit_u); + } + + if ( c3n == u3a_is_cell(dat) ) { + return _lord_plea_foul(god_u, c3__peek, 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 +*/ +static void +_lord_plea_play_bail(u3_lord* god_u, u3_info fon_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)) ) + { + 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.ptr_v, + 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_info fon_u, u3_noun dat) +{ + c3_l mug_l; + + if ( c3n == u3r_safe_word(dat, &mug_l) ) { + fprintf(stderr, "lord: invalid %%play\r\n"); + return _lord_plea_foul(god_u, c3__done, 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.ptr_v, fon_u, mug_l); + + u3z(dat); +} + +/* _lord_plea_play(): hear serf %play response +*/ +static void +_lord_plea_play(u3_lord* god_u, u3_noun dat) +{ + u3_info fon_u; + { + u3_writ* wit_u = _lord_writ_need(god_u, u3_writ_play); + fon_u = wit_u->fon_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__done: { + _lord_plea_play_done(god_u, fon_u, u3k(u3t(dat))); + } break; + + case c3__bail: { + _lord_plea_play_bail(god_u, fon_u, u3k(u3t(dat))); + } break; + } + + u3z(dat); +} + +/* _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; + + // complete spinner + // + c3_assert( c3y == god_u->pin_o ); + god_u->cb_u.spun_f(god_u->cb_u.ptr_v); + god_u->pin_o = c3n; + + // restart spinner if more work + // + while ( wit_u ) { + if ( u3_writ_work != wit_u->typ_e ) { + wit_u = wit_u->nex_u; + } + else { + u3_ovum* egg_u = wit_u->wok_u.egg_u; + + 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; + 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 = u3_fact_init(eve_d, mug_l, job); + tac_u->bug_l = god_u->mug_l; // XX + + 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); + + god_u->cb_u.work_done_f(god_u->cb_u.ptr_v, 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_ovum* egg_u, u3_noun lud) +{ + _lord_work_spin(god_u); + + god_u->cb_u.work_bail_f(god_u->cb_u.ptr_v, egg_u, lud); +} + +/* _lord_plea_work_swap(): hear serf %work %swap +*/ +static void +_lord_plea_work_swap(u3_lord* god_u, u3_ovum* egg_u, u3_noun dat) +{ + u3_noun eve, mug, job, act; + c3_d eve_d; + c3_l mug_l; + + 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)) ) + { + u3z(job); + u3_ovum_free(egg_u); + 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); + } +} + +/* _lord_plea_work_done(): hear serf %work %done +*/ +static void +_lord_plea_work_done(u3_lord* god_u, + u3_ovum* egg_u, + u3_noun job, + u3_noun dat) +{ + u3_noun eve, mug, act; + c3_d eve_d; + c3_l mug_l; + + if ( (c3n == u3r_trel(dat, &eve, &mug, &act)) + || (c3n == u3r_safe_chub(eve, &eve_d)) + || (c3n == u3r_safe_word(mug, &mug_l)) ) + { + u3z(job); + u3_ovum_free(egg_u); + 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); + } +} + +/* _lord_plea_work(): hear serf %work response +*/ +static void +_lord_plea_work(u3_lord* god_u, u3_noun dat) +{ + u3_ovum* egg_u; + u3_noun job; + + { + 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) ) { + u3z(job); + u3_ovum_free(egg_u); + return _lord_plea_foul(god_u, c3__work, dat); + } + + switch ( u3h(dat) ) { + default: { + u3z(job); + u3_ovum_free(egg_u); + return _lord_plea_foul(god_u, c3__work, dat); + } break; + + case c3__done: { + _lord_plea_work_done(god_u, egg_u, job, u3k(u3t(dat))); + } break; + + case c3__swap: { + u3z(job); + _lord_plea_work_swap(god_u, egg_u, u3k(u3t(dat))); + } break; + + case c3__bail: { + u3z(job); + _lord_plea_work_bail(god_u, egg_u, u3k(u3t(dat))); + } break; + } + + u3z(dat); +} + +/* _lord_on_plea(): handle plea from serf. +*/ +static void +_lord_on_plea(void* ptr_v, u3_noun mat) +{ + u3_lord* god_u = ptr_v; + u3_noun jar = u3ke_cue(mat); + u3_noun tag, dat; + + if ( c3n == u3r_cell(jar, &tag, &dat) ) { + u3m_p("jar", jar); + return _lord_plea_foul(god_u, 0, jar); + } + + switch ( tag ) { + default: { + return _lord_plea_foul(god_u, 0, jar); + } + + case c3__work: { + _lord_plea_work(god_u, u3k(dat)); + } 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); +} + +/* _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)); + gettimeofday(&wit_u->tim_u, 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_e ) { + default: c3_assert(0); + + case u3_writ_work: { + 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: { + 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: { + u3_fact* tac_u = wit_u->fon_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 u3_writ_save: { + 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, u3_nul); + } break; + + case u3_writ_exit: { + // requested exit code is always 0 + // + msg = u3nt(c3__live, c3__exit, 0); + } 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) +{ + // 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. +*/ +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_peek(): read namespace. +*/ +void +u3_lord_peek(u3_lord* god_u, + u3_noun gan, + u3_noun ful, + 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->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; + 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* 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->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; + + { + // XX cache + // + 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); + } + + // 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* 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->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; + + { + // XX cache + // + 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)); + + 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); +} + +/* u3_lord_play(): recompute batch. +*/ +void +u3_lord_play(u3_lord* god_u, u3_info fon_u) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_e = u3_writ_play; + wit_u->fon_u = fon_u; + + // XX wat do? + // + // 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_e = u3_writ_work; + wit_u->wok_u.egg_u = egg_u; + + { + 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.ptr_v, + egg_u->pin_u.lab, + egg_u->pin_u.del_o); + god_u->pin_o = c3y; + } + + _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_cram(): save portable state. +*/ +c3_o +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_cram; + _lord_writ_plan(god_u, wit_u); + return c3y; + } +} + +/* u3_lord_exit(): shutdown gracefully. +*/ +void +u3_lord_exit(u3_lord* god_u) +{ + u3_writ* wit_u = _lord_writ_new(god_u); + wit_u->typ_e = u3_writ_exit; + _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_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_newt_moat_info(&god_u->out_u); +} + +/* 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); + 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[8]; + c3_c key_c[256]; + c3_c wag_c[11]; + c3_c hap_c[11]; + c3_i err_i; + + sprintf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", + god_u->key_d[0], + god_u->key_d[1], + god_u->key_d[2], + god_u->key_d[3]); + + sprintf(wag_c, "%u", god_u->wag_w); + + sprintf(hap_c, "%u", u3_Host.ops_u.hap_w); + + arg_c[0] = god_u->bin_c; // executable + 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[6] = u3_Host.ops_u.roc_c; + } + else { + 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); + 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_serf_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.ptr_v = god_u; + 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_on_serf_bail; + + u3_newt_read(&god_u->out_u); + } + return god_u; +} diff --git a/pkg/urbit/vere/newt.c b/pkg/urbit/vere/newt.c index c60083a443..e7cfe2be50 100644 --- a/pkg/urbit/vere/newt.c +++ b/pkg/urbit/vere/newt.c @@ -24,350 +24,451 @@ #include #include #include -#include -#include -#include #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 ) { - u3l_log("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 +/* _newt_meat_poke(): deliver completed msg. */ static void -_newt_poke_mess(u3_moat* mot_u) +_newt_meat_poke(u3_moat* mot_u, u3_meat* met_u) { - c3_assert( 0 != mot_u->mes_u ); - c3_assert( mot_u->mes_u->has_d >= mot_u->mes_u->len_d ); + 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_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; +/* _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; - // we should have just cleared this - // - c3_assert(!mot_u->rag_y); - c3_assert(!mot_u->len_d); + while ( met_u ) { + u3_meat* nex_u = met_u->nex_u; + _newt_meat_poke(mot_u, met_u); + met_u = nex_u; + } - // collect queue blocks, cleaning them up; return any spare meat - // to the rag. - // - { - met_u = mot_u->mes_u->meq_u; + mot_u->ent_u = mot_u->ext_u = 0; +} - 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; +static void +_newt_meat_next_cb(uv_timer_t* tim_u); - 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; +/* _newt_meat_next(): deliver completed msgs, asynchronously. +*/ +static void +_newt_meat_next(u3_moat* mot_u) +{ + u3_meat* met_u = mot_u->ext_u; - 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; + if ( met_u ) { + mot_u->ext_u = met_u->nex_u; - // 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; + _newt_meat_poke(mot_u, met_u); } +} - // build and send the object - // - { - u3_noun mat = u3i_bytes((c3_w)len_d, buf_y); - mot_u->pok_f(mot_u->vod_p, mat); - } - - 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_next(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 + u3_mess* mes_u = &mot_u->mes_u; + + while ( len_d ) { + switch( mes_u->sat_e ) { + + // read up to 8 length bytes as needed + // + 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); + + 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; + } + } +} + +/* _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); + + 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; + } + // EAGAIN/EWOULDBLOCK // - if ( mot_u->rag_y ) { - // XX check SIZE_MAX? - // - c3_d nel_d = mot_u->len_d + len_w; - - 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); - - mot_u->len_d = nel_d; - c3_free(buf_y); + else if ( 0 == len_i ) { + c3_free(buf_u->base); + return c3n; } 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 - // - 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); - - // check for message completions - // - if ( mot_u->mes_u->has_d >= mot_u->mes_u->len_d ) { - _newt_poke_mess(mot_u); - } - } + u3_newt_decode(mot_u, (c3_y*)buf_u->base, (c3_d)len_i); + c3_free(buf_u->base); + return c3y; } } -/* _raft_alloc(): libuv-style allocator for raft. +/* _newt_read_sync_cb(): async read callback, sync msg delivery. */ static void -_newt_alloc(uv_handle_t* had_u, - size_t len_i, - uv_buf_t* buf_u) +_newt_read_sync_cb(uv_stream_t* str_u, + ssize_t len_i, + const uv_buf_t* buf_u) { - void* ptr_v = c3_malloc(len_i); + u3_moat* mot_u = (void *)str_u; - *buf_u = uv_buf_init(ptr_v, len_i); + if ( c3y == _newt_read(mot_u, len_i, buf_u) ) { + _newt_meat_next_sync(mot_u); + } } -/* _newt_read_cb(): stream input callback. +/* _newt_read_cb(): async read callback, async msg delivery. */ -void +static void _newt_read_cb(uv_stream_t* str_u, ssize_t len_i, const uv_buf_t* buf_u) { u3_moat* mot_u = (void *)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)); - } - // EAGAIN/EWOULDBLOCK - // - else if ( 0 == len_i ) { - c3_free(buf_u->base); - } - else { - u3_newt_decode(mot_u, (c3_y*)buf_u->base, (c3_w)len_i); + if ( c3y == _newt_read(mot_u, len_i, buf_u) ) { + _newt_meat_next(mot_u); } } -/* u3_newt_read(): start stream reading. +/* _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); +} + +static void +_newt_read_init(u3_moat* mot_u, uv_read_cb read_cb_f) +{ + // zero-initialize completed msg queue + // + mot_u->ent_u = mot_u->ext_u = 0; + + // store pointer for libuv handle callback + // + mot_u->pyp_u.data = mot_u; + mot_u->tim_u.data = mot_u; + + // await next msg header + // + _newt_mess_head(&mot_u->mes_u); + + { + c3_i sas_i; + + if ( 0 != (sas_i = uv_read_start((uv_stream_t*)&mot_u->pyp_u, + _newt_alloc, + 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)); + } + } +} + +/* _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 +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) { - c3_i err_i; + _newt_read_init(mot_u, _newt_read_cb); +} - mot_u->mes_u = 0; - mot_u->len_d = 0; - mot_u->rag_y = 0; +/* 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; - err_i = uv_read_start((uv_stream_t*) &mot_u->pyp_u, - _newt_alloc, - _newt_read_cb); + while ( met_u ) { + len_w++; + met_u = met_u->nex_u; + } - if ( err_i != 0 ) { - mot_u->bal_f(mot_u, uv_strerror(err_i)); + if ( len_w ) { + u3l_log(" newt: %u inbound ipc messages pending\n", len_w); } } -/* 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 ) { - u3l_log("newt: bad write %d\r\n", sas_i); - moj_u->bal_f(vod_p, 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)); + } } } -/* u3_newt_encode(): encode an atom to a length-prefixed byte buffer +/* _mojo_stop_cb(): finalize stop/close output stream.. */ -c3_y* -u3_newt_encode(u3_atom mat, c3_w* len_w) +static void +_mojo_stop_cb(uv_handle_t* han_u) { - c3_w met_w = u3r_met(3, mat); - c3_y* buf_y; + u3_mojo* moj_u = han_u->data; + moj_u->bal_f(moj_u->ptr_v, ""); +} - *len_w = 8 + met_w; - buf_y = c3_malloc(*len_w); +/* 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; - // 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; + if ( bal_f ) { + moj_u->bal_f = bal_f; + } - u3r_bytes(0, met_w, buf_y + 8, mat); - u3z(mat); - - return buf_y; + uv_close((uv_handle_t*)&moj_u->pyp_u, _mojo_stop_cb); } /* 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/vere/pier.c b/pkg/urbit/vere/pier.c index 0c5b114422..9c66b5315a 100644 --- a/pkg/urbit/vere/pier.c +++ b/pkg/urbit/vere/pier.c @@ -16,1433 +16,1346 @@ #include #include #include -#include -#include -#include #include "all.h" #include "vere/vere.h" -#undef VERBOSE_EVENTS +#define PIER_READ_BATCH 1000ULL +#define PIER_PLAY_BATCH 500ULL +#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); - -/* _pier_db_bail(): bail from disk i/o. +/* _pier_work_send(): send new events for processing */ static void -_pier_db_bail(void* vod_p, const c3_c* err_c) +_pier_work_send(u3_work* wok_u) { - u3l_log("disk error: %s\r\n", err_c); -} + u3_auto* car_u = wok_u->car_u; + u3_pier* pir_u = wok_u->pir_u; + u3_lord* god_u = pir_u->god_u; + c3_w len_w = 0; -/* u3_pier_db_shutdown(): close the log. -*/ -void -u3_pier_db_shutdown(u3_pier* pir_u) -{ - u3_lmdb_shutdown(pir_u->log_u->db_u); -} - -/* _pier_db_commit_complete(): commit complete. - */ -static void -_pier_db_commit_complete(c3_o success, - u3_pier* pir_u, - c3_d first_event_d, - c3_d event_count_d) -{ - u3_disk* log_u = pir_u->log_u; - - if (success == c3n) { - u3l_log("Failed to persist event. Exiting to prevent corruption."); - u3_pier_bail(); - } - -#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); - } -#endif - - /* advance commit counter - */ + // calculate work batch size { - 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; - } + u3_wall* wal_u = wok_u->wal_u; - _pier_loop_resume(pir_u); -} - -/* _pier_db_commit_request(): start commit. -*/ -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) -{ - 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); - } -#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 ( 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; - } - - return c3y; -} - -/* _pier_db_load_commit(): load len_d commits >= lav_d; enqueue for replay -*/ -static void -_pier_db_load_commits(u3_pier* pir_u, - c3_d lav_d, - c3_d len_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(); - } -} - -/* _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 - // - if ( c3n == _pier_db_init(log_u) ) { - return c3n; - } - - 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; - } - } - 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; - } -} - -/* _pier_writ_dispose(): dispose of writ. -*/ -static void -_pier_writ_dispose(u3_writ* wit_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_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 ); - - { - 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 - // - { - u3_disk* log_u = pir_u->log_u; - - // XX requires that writs be unlinked before effects are released + if ( !wal_u ) { + // XX work depth, or full lord send-stack depth? // - 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); - } - } -} - -/* _pier_work_spin_start(): activate spinner. -*/ -static void -_pier_work_spin_start(u3_writ* wit_u) -{ - u3_pier* pir_u = wit_u->pir_u; - c3_o now_o = c3n; - u3_noun say = u3_blip; - - if ( wit_u->evt_d <= pir_u->lif_d ) { - say = c3__nock; - } - else { - u3_noun why; - - // 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; - } - } - } - - u3_term_start_spinner(say, now_o); -} - -/* _pier_work_spin_stop(): deactivate spinner. -*/ -static void -_pier_work_spin_stop(u3_writ* wit_u) -{ - 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, " "); + if ( PIER_WORK_BATCH > god_u->dep_w ) { + len_w = PIER_WORK_BATCH - god_u->dep_w; } } else { - gettimeofday(&b4, 0); - b4_d = u3R->pro.nox_d; + 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; + } } - old = 1; } -#endif - u3_pier_tank(0, pri_w, tan); -} - -/* _pier_work_exit(): handle subprocess exit. -*/ -static void -_pier_work_exit(uv_process_t* req_u, - c3_ds sas_i, - c3_i sig_i) -{ - u3_controller* god_u = (void *) req_u; - u3_pier* pir_u = god_u->pir_u; - - fprintf(stderr, "\rpier: work exit: status %" PRId64 ", signal %d\r\n", - sas_i, sig_i); - uv_close((uv_handle_t*) req_u, 0); - - // XX dispose + // send batch // - pir_u->god_u = 0; + { + u3_ovum* egg_u; + u3_noun ovo; - u3_pier_bail(); + 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; + } + } } -/* _pier_work_poke(): handle subprocess result. transfer nouns. +/* _pier_gift_plan(): enqueue effects. */ static void -_pier_work_poke(void* vod_p, - u3_noun mat) +_pier_gift_plan(u3_work* wok_u, u3_gift* gif_u) { - u3_pier* pir_u = vod_p; - u3_noun jar = u3ke_cue(u3k(mat)); - u3_noun p_jar, q_jar, r_jar; + c3_assert( gif_u->eve_d > wok_u->fec_u.rel_d ); - if ( c3y != u3du(jar) ) { - goto error; - } - - 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; - } - else { - c3_d evt_d = u3r_chub(0, p_jar); - u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); - - 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; - } - - 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); +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): compute: complete\r\n", gif_u->eve_d); #endif - _pier_work_replace(wit_u, u3k(job)); - u3z(entry); - } - break; - } + gif_u->nex_u = 0; - 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); - - 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; - } - - 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); - - // Unlike slog, we always reprint interpreter errors during replay. - _pier_work_stdr(wit_u, q_jar); - } - break; - } - - 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 ( !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; } - - 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 { + wok_u->fec_u.ent_u->nex_u = gif_u; + wok_u->fec_u.ent_u = gif_u; } } -/* pier_work_create(): instantiate child process. +/* _pier_gift_next(): dequeue effect. */ -static u3_controller* -_pier_work_create(u3_pier* pir_u) +static u3_gift* +_pier_gift_next(u3_work* wok_u) { - u3_controller* god_u = c3_calloc(sizeof *god_u); + u3_pier* pir_u = wok_u->pir_u; + u3_disk* log_u = pir_u->log_u; + u3_gift* gif_u = wok_u->fec_u.ext_u; - pir_u->god_u = god_u; - god_u->pir_u = pir_u; - god_u->liv_o = c3n; + if ( !gif_u || (gif_u->eve_d > log_u->dun_d) ) { + return 0; + } + else { + wok_u->fec_u.ext_u = gif_u->nex_u; - /* spawn new process and connect to it - */ - { - c3_c* arg_c[6]; - 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_c hap_c[11]; - c3_i err_i; - - 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]); - - sprintf(wag_c, "%u", pir_u->wag_w); - sprintf(hap_c, "%u", u3_Host.ops_u.hap_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] = hap_c; // hash table size - 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); - - 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; + if ( !wok_u->fec_u.ext_u ) { + wok_u->fec_u.ent_u = 0; } + + 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; } - - /* 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; - - god_u->inn_u.bal_f = _pier_work_bail; - - u3_newt_read(&god_u->out_u); - } - return god_u; } -/* _pier_loop_time(): set time. +/* _pier_gift_kick(): apply effects. */ static void -_pier_loop_time(void) +_pier_gift_kick(u3_work* wok_u) +{ + u3_gift* gif_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(wok_u->car_u, gif_u->act); + u3_gift_free(gif_u); + } +} + +/* _pier_wall_plan(): enqueue a barrier. +*/ +static void +_pier_wall_plan(u3_pier* pir_u, c3_d eve_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->ptr_v = ptr_v; + 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; + } +} + +/* _pier_wall(): process a barrier if possible. +*/ +static void +_pier_wall(u3_work* wok_u) +{ + u3_lord* god_u = wok_u->pir_u->god_u; + u3_disk* log_u = wok_u->pir_u->log_u; + + if ( god_u->eve_d == log_u->dun_d ) { + u3_wall* wal_u; + + 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->ptr_v, god_u->eve_d); + c3_free(wal_u); + } + } +} + +/* _pier_work(): advance event processing. +*/ +static void +_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(wok_u->car_u); + + // all i/o drivers are fully initialized + // + if ( c3y == pir_u->liv_o ) { + // XX this is when "boot" is actually complete + // XX even better would be after neighboring with our sponsor + // + u3l_log("pier (%" PRIu64 "): live\r\n", pir_u->god_u->eve_d); + + // XX move callbacking to king + // + if ( u3_Host.bot_f ) { + u3_Host.bot_f(); + } + } + } + + _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* ptr_v, u3_atom pin, c3_o del_o) +{ + u3_pier* pir_u = ptr_v; + + 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* ptr_v) +{ + u3_pier* pir_u = ptr_v; + + 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* ptr_v, + u3_ovum* egg_u, + u3_fact* tac_u, + u3_gift* gif_u) +{ + u3_pier* pir_u = ptr_v; + + 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); + + u3_auto_done(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* ptr_v, u3_ovum* egg_u, u3_noun lud) +{ + u3_pier* pir_u = ptr_v; + +#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_loop_prepare(): run on every loop iteration before i/o polling. +/* _pier_work_fore_cb(): run on every loop iteration before i/o polling. */ static void -_pier_loop_prepare(uv_prepare_t* pep_u) +_pier_work_fore_cb(uv_prepare_t* pep_u) { - _pier_loop_time(); + u3_work* wok_u = pep_u->data; + _pier_work_time(wok_u->pir_u); } -/* _pier_loop_idle_cb(): run on every loop iteration after i/o polling. +/* _pier_work_afte_cb(): run on every loop iteration after i/o polling. */ static void -_pier_loop_idle_cb(uv_idle_t* idl_u) +_pier_work_afte_cb(uv_check_t* cek_u) { - u3_pier* pir_u = idl_u->data; - _pier_apply(pir_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); } -/* _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); + // 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_loop_init_pier(): initialize loop handlers. +/* _pier_work_init(): begin processing new events */ static void -_pier_loop_init(u3_pier* pir_u) +_pier_work_init(u3_pier* pir_u) { - c3_l cod_l; + u3_work* wok_u; - _pier_loop_time(); + 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(); - cod_l = u3a_lush(c3__ames); - u3_ames_io_init(pir_u); - u3a_lop(cod_l); + // XX plan kelvin event + // - 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 + // XX snapshot timer + // XX moveme // { - 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(); + 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 = { + // .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, + // .bail_f = _pier_on_lord_work_bail + // }; + // u3_lord_work_init(pir_u->god_u, cb_u); + + _pier_work(wok_u); } -/* _pier_loop_wake(): initialize listeners and send initial events. +/* _pier_play_plan(): enqueue events for replay. */ static void -_pier_loop_wake(u3_pier* pir_u) +_pier_play_plan(u3_play* pay_u, u3_info fon_u) { - c3_l cod_l; + u3_fact** ext_u; + c3_d old_d; - // 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); + 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 = &pay_u->ent_u->nex_u; + old_d = pay_u->ent_u->eve_d; } - cod_l = u3a_lush(c3__unix); - u3_unix_io_talk(pir_u); - u3_unix_ef_bake(pir_u); - u3a_lop(cod_l); +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: play plan %" PRIu64 "-%" PRIu64 " at %" PRIu64 "\r\n", + fon_u.ext_u->eve_d, + fon_u.ent_u->eve_d, + old_d); +#endif - cod_l = u3a_lush(c3__ames); - u3_ames_io_talk(pir_u); - u3_ames_ef_bake(pir_u); - u3a_lop(cod_l); + c3_assert( (1ULL + old_d) == fon_u.ext_u->eve_d ); - 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); - } + *ext_u = fon_u.ext_u; + pay_u->ent_u = fon_u.ent_u; } -/* _pier_loop_exit(): terminate I/O across the process. +/* _pier_play_send(): detach a batch of up to [len_w] events from queue. +*/ +static u3_info +_pier_play_next(u3_play* pay_u, c3_w len_w) +{ + 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_w-- && tac_u->nex_u ) { + tac_u = tac_u->nex_u; + } + + fon_u.ent_u = tac_u; + } + + // detatch batch from queue + // + if ( tac_u->nex_u ) { + pay_u->ext_u = tac_u->nex_u; + tac_u->nex_u = 0; + } + else { + pay_u->ent_u = pay_u->ext_u = 0; + } + + return fon_u; +} + +/* _pier_play_send(): send a batch of events to the worker for replay. */ static void -_pier_loop_exit(u3_pier* pir_u) +_pier_play_send(u3_play* pay_u) { - c3_l cod_l; + u3_pier* pir_u = pay_u->pir_u; + c3_w len_w; - 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 + // awaiting read // + if ( !pay_u->ext_u ) { + return; + } + + // XX fill the pipe how much? + // (god_u->dep_w > PIER_WORK_BATCH) ) + // + + // 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); + } + { - cod_l = u3a_lush(c3__http); - u3_http_io_exit(); - u3a_lop(cod_l); + u3_info fon_u = _pier_play_next(pay_u, len_w); - cod_l = u3a_lush(c3__cttp); - u3_cttp_io_exit(); - u3a_lop(cod_l); + // bump sent counter + // + pay_u->sen_d = fon_u.ent_u->eve_d; - cod_l = u3a_lush(c3__term); - u3_term_io_exit(); - u3a_lop(cod_l); +#ifdef VERBOSE_PIER + 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, fon_u); } } -/* _pier_boot_set_ship(): +/* _pier_play_read(): read events from disk for replay. */ static void -_pier_boot_set_ship(u3_pier* pir_u, u3_noun who, u3_noun fak) +_pier_play_read(u3_play* pay_u) { - c3_assert( c3y == u3ud(who) ); - c3_assert( (c3y == fak) || (c3n == fak) ); + u3_pier* pir_u = pay_u->pir_u; + c3_d las_d; - c3_o fak_o = fak; - c3_d who_d[2]; + if ( pay_u->ent_u ) { + las_d = pay_u->ent_u->eve_d; - 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]; + // cap the pir_u->pay_u queue depth + // + if ( (las_d - pay_u->ext_u->eve_d) >= PIER_PLAY_BATCH ) { + return; + } + } + else { + las_d = pay_u->sen_d; + } { - u3_noun how = u3dc("scot", 'p', u3k(who)); + c3_d nex_d = (1ULL + las_d); + c3_d len_d = c3_min(pay_u->eve_d - las_d, PIER_READ_BATCH); - c3_free(pir_u->who_c); - pir_u->who_c = u3r_string(how); - u3z(how); + if ( len_d + && (nex_d > pay_u->req_d) ) + { + u3_disk_read(pir_u->log_u, nex_d, len_d); + pay_u->req_d = nex_d; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: play read %" PRIu64 " at %" PRIu64 "\r\n", len_d, nex_d); +#endif + } } - - // 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 +/* _pier_play(): send a batch of events to the worker for log replay. */ -static u3_boot* -_pier_boot_create(u3_pier* pir_u, u3_noun pil, u3_noun ven) +static void +_pier_play(u3_play* pay_u) { - 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; + 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 ( god_u->eve_d == pay_u->eve_d ) { + // XX should be play_cb + // + u3l_log("---------------- playback complete ----------------\r\n"); + 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(pir_u); + // exit(0); + + // XX temporary hack + // + 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); + } + } + else { + c3_assert( god_u->eve_d < pay_u->eve_d ); + _pier_play_send(pay_u); + _pier_play_read(pay_u); + } +} + +/* _pier_on_lord_play_done(): log replay batch completion from worker. +*/ +static void +_pier_on_lord_play_done(void* ptr_v, u3_info fon_u, c3_l mug_l) +{ + u3_pier* pir_u = ptr_v; + u3_fact* tac_u = fon_u.ent_u; + u3_fact* nex_u; + + c3_assert( u3_psat_play == pir_u->sat_e ); + + u3l_log("pier: (%" PRIu64 "): play: done\r\n", tac_u->eve_d); + + // XX optional + // + 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(pir_u); + } + + // dispose successful + // + { + tac_u = fon_u.ext_u; + + while ( tac_u ) { + nex_u = tac_u->nex_u; + u3_fact_free(tac_u); + tac_u = nex_u; + } + } + + _pier_play(pir_u->pay_u); +} + +/* _pier_on_lord_play_bail(): log replay batch failure from worker. +*/ +static void +_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 = ptr_v; + + c3_assert( u3_psat_play == pir_u->sat_e ); + + { + u3_fact* tac_u = fon_u.ext_u; + u3_fact* nex_u; + c3_l las_l = 0; + + // dispose successful + // + while ( tac_u->eve_d < eve_d ) { + nex_u = tac_u->nex_u; + las_l = tac_u->mug_l; + u3_fact_free(tac_u); + tac_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(pir_u); + } + + // XX enable to retry + // +#if 0 + { + u3l_log("pier: (%" PRIu64 "): play: retry\r\n", eve_d); + + 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(pir_u); + exit(1); + } +#endif + } +} + +/* _pier_play_init(): begin boot/replay up to [eve_d]. +*/ +static void +_pier_play_init(u3_pier* pir_u, c3_d eve_d) +{ + u3_lord* god_u = pir_u->god_u; + u3_disk* log_u = pir_u->log_u; + u3_play* pay_u; + + c3_assert( (u3_psat_init == pir_u->sat_e) + || (u3_psat_boot == pir_u->sat_e) ); + + c3_assert( eve_d > god_u->eve_d ); + c3_assert( 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; + + 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 { + u3l_log("pier: replaying events %" PRIu64 "-%" PRIu64 "\r\n", + (c3_d)(1ULL + god_u->eve_d), + eve_d); + } + + 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* ptr_v, u3_info fon_u) +{ + u3_pier* pir_u = ptr_v; + + c3_assert( u3_psat_play == pir_u->sat_e ); + + _pier_play_plan(pir_u->pay_u, fon_u); + _pier_play(pir_u->pay_u); +} + +/* _pier_on_disk_read_bail(): event log read failure. +*/ +static void +_pier_on_disk_read_bail(void* ptr_v, c3_d eve_d) +{ + u3_pier* pir_u = ptr_v; + + 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); +} + +/* _pier_on_disk_write_done(): event log write success. +*/ +static void +_pier_on_disk_write_done(void* ptr_v, c3_d eve_d) +{ + u3_pier* pir_u = ptr_v; + u3_disk* log_u = pir_u->log_u; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): db commit: complete\r\n", eve_d); +#endif + + if ( u3_psat_boot == pir_u->sat_e ) { + // lord already live + // + 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_psat_work == pir_u->sat_e) + || (u3_psat_done == pir_u->sat_e) ); + + _pier_work(pir_u->wok_u); + } +} + +/* _pier_on_disk_write_bail(): event log write failure. +*/ +static void +_pier_on_disk_write_bail(void* ptr_v, c3_d eve_d) +{ + u3_pier* pir_u = ptr_v; + + if ( u3_psat_boot == pir_u->sat_e ) { + // XX nice message + // + } + + // XX + // + fprintf(stderr, "pier: disk write bail\r\n"); + u3_pier_bail(pir_u); +} + +/* _pier_on_lord_slog(): debug printf from worker. +*/ +static void +_pier_on_lord_slog(void* ptr_v, c3_w pri_w, u3_noun tan) +{ + u3_pier* pir_u = ptr_v; + + 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_on_lord_save(): worker (non-portable) snapshot complete. +*/ +static void +_pier_on_lord_save(void* ptr_v) +{ + u3_pier* pir_u = ptr_v; + +#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_cram(): worker state-export complete (portable snapshot). +*/ +static void +_pier_on_lord_cram(void* ptr_v) +{ + u3_pier* pir_u = ptr_v; + +#ifdef VERBOSE_PIER + 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: cram complete, shutting down\r\n"); + 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); + // } + // 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* ptr_v) +{ + u3_pier* pir_u = ptr_v; + + // 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(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* ptr_v) +{ + u3_pier* pir_u = ptr_v; + + // the lord has already gone + // + pir_u->god_u = 0; + + u3_pier_bail(pir_u); +} + +/* _pier_on_scry_done(): scry callback. +*/ +static void +_pier_on_scry_done(void* ptr_v, u3_noun nun) +{ + u3_pier* pir_u = ptr_v; + u3_weak res = u3r_at(7, nun); + + if (u3_none == res) { + u3l_log("pier: scry failed\n"); + } + else { + u3l_log("pier: scry succeeded\n"); + + c3_c* pac_c = u3_Host.ops_u.puk_c; + if (!pac_c) { + pac_c = u3_Host.ops_u.pek_c; + } + + 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'), + 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, pac_c+1); + + 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"); + u3_pier_exit(pir_u); + + u3z(nun); +} + +/* _pier_on_lord_live(): worker is ready. +*/ +static void +_pier_on_lord_live(void* ptr_v) +{ + u3_pier* pir_u = ptr_v; + 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 (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, u3_nul); + } 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 + // + 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); + } + } +} + +/* 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: 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* +_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_psat_init; + pir_u->liv_o = c3n; + + // XX remove + // + pir_u->por_s = u3_Host.ops_u.por_s; + pir_u->sav_u = c3_calloc(sizeof(u3_save)); + + // initialize persistence + // + { + // XX load/set secrets + // + u3_disk_cb cb_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, + .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; + } + } + + // initialize compute + // + { + // 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 = { + .ptr_v = 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, + .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, + .cram_f = _pier_on_lord_cram, + .bail_f = _pier_on_lord_bail, + .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; + } + } + + return pir_u; +} + +/* u3_pier_stay(): restart an existing pier. +*/ +u3_pier* +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_meta(pir_u->log_u, pir_u->who_d, + &pir_u->fak_o, &pir_u->lif_w) ) + { + fprintf(stderr, "pier: disk read meta fail\r\n"); + // XX dispose + // + u3_pier_bail(pir_u); + exit(1); + } + + u3z(pax); + + return pir_u; +} + +/* _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_dispose(): dispose of boot controller +/* _pier_boot_make(): construct boot sequence */ -static void -_pier_boot_dispose(u3_boot* bot_u) +static u3_boot +_pier_boot_make(u3_noun who, u3_noun ven, u3_noun pil) { - u3_pier* pir_u = bot_u->pir_u; + u3_boot bot_u = _pier_pill_parse(pil); // transfer - u3z(bot_u->pil); - u3z(bot_u->ven); - c3_free(bot_u); - pir_u->bot_u = 0; + // 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_vent(): create and enqueue boot sequence -** -** per cgy: -** this new boot sequence is almost, but not quite, -** the right thing. see new arvo. +/* _pier_boot_plan(): construct and commit boot sequence */ -static void -_pier_boot_vent(u3_boot* bot_u) +static c3_o +_pier_boot_plan(u3_pier* pir_u, u3_noun who, u3_noun ven, u3_noun pil) { - // 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_boot bot_u; { - u3_noun pil_p, pil_q, pil_r; - u3_noun pro; + 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); - 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); + bot_u = _pier_boot_make(who, ven, pil); + pir_u->lif_w = u3qb_lent(bot_u.bot); } - // prepend entropy to the module sequence - // + if ( c3n == u3_disk_save_meta(pir_u->log_u, pir_u->who_d, + pir_u->fak_o, pir_u->lif_w) ) { - 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); + // XX dispose bot_u + // + return c3n; } // insert boot sequence directly @@ -1450,483 +1363,324 @@ _pier_boot_vent(u3_boot* bot_u) // 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). + // All subsequent events will be (pair date 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; + u3_noun fol = bot_u.bot; while ( u3_nul != fol ) { - _pier_writ_insert(pir_u, 0, u3k(u3h(fol))); + u3_disk_boot_plan(pir_u->log_u, u3k(u3h(fol))); fol = u3t(fol); } } - // insert module events + // insert module and userspace events + // + // XX increment [now] deterministically? // { - u3_noun ova = mod; - // add to the boot barrier - // - pir_u->but_d += u3kb_lent(u3k(ova)); + struct timeval tim_tv; + u3_noun ova = bot_u.mod; + u3_noun now; while ( u3_nul != ova ) { - _pier_writ_insert_ovum(pir_u, 0, u3k(u3h(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); } } - // insert legacy boot event - // - { - // XX do something about this wire - // XX route directly to %jael? - // - c3_assert( c3y == u3du(bot_u->ven) ); + u3_disk_boot_save(pir_u->log_u); - 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); + u3z(bot_u.bot); + u3z(bot_u.mod); + u3z(bot_u.use); - _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); + return c3y; } -/* _pier_boot_complete(): start organic event flow on boot/reboot. +/* u3_pier_boot(): start a new pier. */ -static void -_pier_boot_complete(u3_pier* pir_u) +u3_pier* +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 { - if ( u3_psat_init != pir_u->sat_e ) { - u3_pier_snap(pir_u); - } + u3_pier* pir_u = _pier_init(wag_w, u3r_string(pax)); - 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 + if ( c3n == _pier_boot_plan(pir_u, who, ven, pil) ) { + fprintf(stderr, "pier: boot plan fail\r\n"); + // XX dispose // - _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_pier_bail(pir_u); + exit(1); } - 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; + u3z(pax); return pir_u; } -/* _pier_inject(): inject raw event at filename -*/ static void -_pier_inject(u3_pier* pir_u, c3_c* pax_c) +_pier_save_cb(void* ptr_v, c3_d eve_d) { - 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* 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); +#endif + + u3_lord_save(pir_u->god_u); } -/* u3_pier_interrupt(): interrupt running process. +/* u3_pier_save(): save a non-portable snapshot */ -void -u3_pier_interrupt(u3_pier* pir_u) +c3_o +u3_pier_save(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); +#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_loop_exit(pir_u); + if ( u3_psat_work == pir_u->sat_e ) { + _pier_wall_plan(pir_u, 0, pir_u, _pier_save_cb); + return c3y; + } - // XX uninstall pier from u3K.tab_u, dispose - - // XX no can do - // - uv_stop(u3L); + return c3n; } -/* u3_pier_exit(): trigger a gentle shutdown. +static void +_pier_cram_cb(void* ptr_v, c3_d eve_d) +{ + u3_pier* pir_u = ptr_v; + +#ifdef VERBOSE_PIER + fprintf(stderr, "pier: (%" PRIu64 "): cram: send at %" PRIu64 "\r\n", pir_u->god_u->eve_d, eve_d); +#endif + + u3_lord_cram(pir_u->god_u); +} + +/* u3_pier_cram(): save a portable snapshot. +*/ +c3_o +u3_pier_cram(u3_pier* pir_u) +{ +#ifdef VERBOSE_PIER + 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_cram(pir_u->god_u); + return c3y; + } + + if ( u3_psat_work == pir_u->sat_e ) { + _pier_wall_plan(pir_u, 0, pir_u, _pier_cram_cb); + return c3y; + } + + return c3n; +} + +static void +_pier_work_close_cb(uv_handle_t* idl_u) +{ + u3_work* wok_u = idl_u->data; + c3_free(wok_u); +} + +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; +} + +/* _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(); +} + +/* _pier_exit(): synchronous shutdown. +*/ +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; + } + + if ( pir_u->god_u ) { + u3_lord_exit(pir_u->god_u); + pir_u->god_u = 0; + } + else { + // otherwise called in _pier_on_lord_exit() + // + _pier_done(pir_u); + } +} + +/* _pier_work_exit(): commence graceful shutdown. +*/ +static void +_pier_work_exit_cb(void* ptr_v, c3_d eve_d) +{ + u3_pier* pir_u = ptr_v; + + _pier_work_close(pir_u->wok_u); + pir_u->wok_u = 0; + + _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 + // + { + 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. */ void u3_pier_exit(u3_pier* pir_u) +{ + switch ( pir_u->sat_e ) { + default: { + fprintf(stderr, "pier: unknown exit: %u\r\n", pir_u->sat_e); + c3_assert(0); + } + + case u3_psat_done: return; + + case u3_psat_work: return _pier_work_exit(pir_u); + + 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; + } break; + + case u3_psat_play: { + // XX dispose play q + // + c3_free(pir_u->pay_u); + pir_u->pay_u = 0; + } break; + } + + pir_u->sat_e = u3_psat_done; + _pier_exit(pir_u); +} + +/* u3_pier_bail(): immediately shutdown due to error. +*/ +void +u3_pier_bail(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 ( pir_u->god_u ) { + u3_lord_halt(pir_u->god_u); + pir_u->god_u = 0; } - // if we're gracefully shutting down, do so now + + // exig i/o drivers // - else if ( u3_psat_done == pir_u->sat_e ) { - _pier_exit_done(pir_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; } -} -/* 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) -{ -} - -/* 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_noun now; - struct timeval tim_tv; - - gettimeofday(&tim_tv, 0); - // XX use wit_u->now (currently unused) + // close db // - now = u3_time_in_tv(&tim_tv); + if ( pir_u->log_u ) { + u3_disk_exit(pir_u->log_u); + pir_u->log_u = 0; + } - u3_pier_discover(pir_u, 0, u3nt(now, 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); + _pier_done(pir_u); } /* c3_rand(): fill a 512-bit (16-word) buffer. @@ -1935,30 +1689,17 @@ 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(); + u3_king_bail(); } } -/* u3_pier_bail(): immediately shutdown. -*/ -void -u3_pier_bail(void) -{ - if ( 0 != u3K.len_w ) { - _pier_exit_done(u3_pier_stub()); - } - - fflush(stdout); - 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; @@ -1981,15 +1722,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); @@ -2035,7 +1776,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); } @@ -2045,7 +1786,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 ) { @@ -2074,6 +1815,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 @@ -2085,141 +1864,10 @@ 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]; - } -} - -/* _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/vere/reck.c b/pkg/urbit/vere/reck.c deleted file mode 100644 index 9f8d63dae7..0000000000 --- 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/save.c b/pkg/urbit/vere/save.c index 63ad738766..e2c042b243 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/time.c b/pkg/urbit/vere/time.c index 2a36cf8220..e67046ba22 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/walk.c b/pkg/urbit/vere/walk.c index 1456d9aa8d..892636a932 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" @@ -118,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)); diff --git a/pkg/urbit/vere/ward.c b/pkg/urbit/vere/ward.c new file mode 100644 index 0000000000..bb9b092129 --- /dev/null +++ b/pkg/urbit/vere/ward.c @@ -0,0 +1,225 @@ +/* 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_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* +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); +} + +/* u3_ovum_init: initialize an unlinked potential event +*/ +u3_ovum* +u3_ovum_init(c3_w mil_w, + u3_noun tar, + u3_noun wir, + u3_noun cad) +{ + 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; + 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); +} + +/* 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; +} diff --git a/pkg/urbit/worker/main.c b/pkg/urbit/worker/main.c index 064029a6c1..7bc494e269 100644 --- a/pkg/urbit/worker/main.c +++ b/pkg/urbit/worker/main.c @@ -1,6 +1,6 @@ /* worker/main.c ** -** the main loop of a worker process. +** the main loop of a serf process. */ #include #include @@ -17,1013 +17,116 @@ #include #include #include -#include -#include -#include #include "all.h" #include +#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; +static u3_serf u3V; // one serf per process +static u3_moat inn_u; // input stream +static u3_mojo out_u; // output stream -/* -:: 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. +/* _cw_serf_fail(): failure stub. */ static void -_worker_grab(u3_noun sac, u3_noun ovo, u3_noun vir) +_cw_serf_fail(void* vod_p, const c3_c* wut_c) { - 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); + fprintf(stderr, "serf: fail: %s\r\n", wut_c); exit(1); } -/* _worker_send(): send result back to daemon. +/* _cw_serf_send(): send plea back to daemon. */ static void -_worker_send(u3_noun job) +_cw_serf_send(u3_noun pel) { - u3_newt_write(&u3V.out_u, u3ke_jam(job), 0); + u3_newt_write(&out_u, u3ke_jam(pel)); } -/* _worker_send_replace(): send replacement job back to daemon. +/* _cw_serf_send_slog(): send hint output (hod is [priority tank]). */ static void -_worker_send_replace(c3_d evt_d, u3_noun job) +_cw_serf_send_slog(u3_noun hod) { - _worker_send(u3nt(c3__work, - u3i_chubs(1, &evt_d), - u3ke_jam(u3nc(u3V.mug_l, job)))); + _cw_serf_send(u3nc(c3__slog, hod)); } -/* _worker_send_complete(): report completion. +/* _cw_serf_send_stdr(): send stderr output */ static void -_worker_send_complete(u3_noun vir) +_cw_serf_send_stdr(c3_c* str_c) { - _worker_send(u3nq(c3__done, - u3i_chubs(1, &u3V.dun_d), - u3V.mug_l, - vir)); + _cw_serf_send_slog(u3nc(0, u3i_string(str_c))); } -/* _worker_send_stdr(): send stderr output +/* _cw_serf_writ(): */ static void -_worker_send_stdr(c3_c* str_c) +_cw_serf_writ(void* vod_p, u3_noun mat) { - _worker_send(u3nt(c3__stdr, u3i_chubs(1, &u3V.sen_d), u3i_string(str_c))); -} + u3_noun ret; -/* _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 rec_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)))); - } - - // reclaim memory on bail:meme? - // - rec_o = __(c3__meme == why); - - _worker_send_replace(evt_d, u3nc(now, rep)); - - u3z(ovo); u3z(why); u3z(tan); - - if ( c3y == rec_o ) { - u3m_reclaim(); - } -} - -/* _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? - // - 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 - // - 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); + if ( c3n == u3_serf_writ(&u3V, u3ke_cue(mat), &ret) ) { + _cw_serf_fail(0, "bad jar"); } else { - // prior to the evaluation of the entire lifecycle sequence, - // we simply use the mug of the formula as the kernel mug + _cw_serf_send(ret); + + // all references must now be counted, and all roots recorded // - u3V.mug_l = u3r_mug(job); + u3_serf_post(&u3V); } - - _worker_send(u3nq(c3__done, - u3i_chubs(1, &evt_d), - u3V.mug_l, - u3_nul)); } -/* _worker_poke_work(): apply event. +/* _cw_serf_stdio(): fix up std io handles */ static void -_worker_poke_work(c3_d evt_d, // event number - c3_l mug_l, // mug of state - u3_noun job) // full event +_cw_serf_stdio(c3_i* inn_i, c3_i* out_i) { - 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 + // 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); + + *inn_i = dup(0); + *out_i = dup(1); + dup2(nul_i, 0); dup2(2, 1); + 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; - c3_assert(5 == argc); + if ( 1 != sscanf(argv[6], "%" 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)); - /* load passkey - */ + // load passkey + // + // XX and then ... use passkey + // { sscanf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", &u3V.key_d[0], @@ -1032,27 +135,13 @@ main(c3_i argc, c3_c* argv[]) &u3V.key_d[3]); } - /* load runtime config - */ + // load runtime config + // { sscanf(wag_c, "%" SCNu32, &u3C.wag_w); sscanf(hap_c, "%" SCNu32, &u3_Host.ops_u.hap_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. // { @@ -1062,38 +151,226 @@ main(c3_i argc, c3_c* argv[]) sigaction(SIGPIPE, &sig_s, 0); } - /* configure pipe to daemon process - */ + // configure pipe to daemon process + // { c3_i err_i; - err_i = uv_pipe_init(lup_u, &u3V.inn_u.pyp_u, 0); + err_i = uv_timer_init(lup_u, &inn_u.tim_u); c3_assert(!err_i); - uv_pipe_open(&u3V.inn_u.pyp_u, inn_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, &u3V.out_u.pyp_u, 0); + err_i = uv_pipe_init(lup_u, &out_u.pyp_u, 0); c3_assert(!err_i); - uv_pipe_open(&u3V.out_u.pyp_u, out_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 - */ - u3V.out_u.bal_f = _worker_fail; + // set up writing + // + out_u.ptr_v = &u3V; + out_u.bal_f = _cw_serf_fail; - /* start reading - */ - u3V.inn_u.vod_p = &u3V; - u3V.inn_u.pok_f = _worker_poke; - u3V.inn_u.bal_f = _worker_fail; + // set up reading + // + inn_u.ptr_v = &u3V; + inn_u.pok_f = _cw_serf_writ; + inn_u.bal_f = _cw_serf_fail; - u3_newt_read(&u3V.inn_u); + // setup loom + // + { + u3V.dir_c = strdup(dir_c); + u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); - /* send start request - */ - u3_worker_boot(); + if ( eve_d ) { + u3_serf_uncram(&u3V, eve_d); + } + } - /* enter loop - */ + // set up logging + // + // XX must be after u3m_boot due to u3l_log + // + { + u3C.stderr_log_f = _cw_serf_send_stdr; + u3C.slog_f = _cw_serf_send_slog; + } + + // start serf + // + { + _cw_serf_send(u3_serf_init(&u3V)); + } + + // start reading + // + u3_newt_read_sync(&inn_u); + + // 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_print_memory(stderr, "urbit-worker: pack: gained", u3m_pack()); + + 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 new file mode 100644 index 0000000000..8ddc30e48e --- /dev/null +++ b/pkg/urbit/worker/serf.c @@ -0,0 +1,1220 @@ +/* worker/serf.c +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include +#include + +/* +|% +:: +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 + $% [%cram eve=@] + [%exit cod=@] + [%save eve=@] + [%pack ~] + == == + [%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=%1 hon=@ nok=@] eve=@ mug=@] + [%slog pri=@ ?(cord tank)] + $: %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 @da ovum) fec=(list ovum)] + [%bail lud=(list goof)] + == == + == +-- +*/ + +/* _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(u3_serf* sef_u) +{ + if ( u3_nul == sef_u->sac) { + if ( u3C.wag_w & (u3o_debug_ram | u3o_check_corrupt) ) { + u3m_grab(sef_u->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[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); + + 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, sef_u->sac)); + tot_w += u3m_mark(fil_u); + 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)); + u3a_print_memory(fil_u, "sweep", u3a_sweep()); + + fflush(fil_u); + +#ifdef U3_MEMORY_LOG + { + fclose(fil_u); + } +#endif + + u3z(sef_u->sac); + sef_u->sac = u3_nul; + + u3l_log("\n"); + } +} + +/* u3_serf_grab(): garbage collect. +*/ +void +u3_serf_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_cram(): deduplicate and compact memory. ORPHANED +*/ +static void +_serf_cram(u3_serf* sef_u) +{ + u3_serf_grab(); + + 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"); + return; + } + + u3_serf_uncram(sef_u, sef_u->dun_d); + + u3l_log("serf (%" PRIu64 "): compacted loom\r\n", sef_u->dun_d); + + u3_serf_grab(); +} + +/* u3_serf_post(): update serf state post-writ. +*/ +void +u3_serf_post(u3_serf* sef_u) +{ + if ( c3y == sef_u->rec_o ) { + u3m_reclaim(); + sef_u->rec_o = c3n; + } + + // XX this runs on replay too, |mass s/b elsewhere + // + if ( c3y == sef_u->mut_o ) { + _serf_grab(sef_u); + sef_u->mut_o = c3n; + } + + if ( c3y == sef_u->pac_o ) { + u3a_print_memory(stderr, "serf: pack: gained", u3m_pack()); + u3l_log("\n"); + sef_u->pac_o = c3n; + } +} + +/* _serf_sure_feck(): event succeeded, send effects. +*/ +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 + // + { + 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 + // + sef_u->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? + // + 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; + } + // 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 if ( 0 == (sef_u->dun_d % 1000ULL) ) { + rec_o = c3y; + } + + // 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); + } + } + + sef_u->rec_o = c3o(sef_u->rec_o, rec_o); + sef_u->pac_o = c3o(sef_u->pac_o, pac_o); + + return vir; +} + +/* _serf_sure_core(): event succeeded, save state. +*/ +static void +_serf_sure_core(u3_serf* sef_u, u3_noun cor) +{ + sef_u->dun_d = sef_u->sen_d; + + u3z(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; +} + +/* _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 +_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_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); + + wen = u3A->now; + u3A->now = u3k(now); + +#ifdef U3_EVENT_TIME_DEBUG + struct timeval b4; + c3_c* txt_c; + + gettimeofday(&b4, 0); + + { + 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(mil_w, u3v_poke, u3k(ovo)); + +#ifdef U3_EVENT_TIME_DEBUG + { + 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 + + 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_serf* sef_u, c3_w mil_w, u3_noun job) +{ + u3_noun gon; + c3_w pre_w = u3a_open(u3R); + + // event numbers must be continuous + // + c3_assert( sef_u->sen_d == sef_u->dun_d); + sef_u->sen_d++; + + gon = _serf_poke(sef_u, "work", mil_w, job); // retain + + // event accepted + // + if ( u3_blip == u3h(gon) ) { + 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), + sef_u->mug_l, + vir)); + } + // event rejected + // + else { + // stash $goof from first crash + // + u3_noun dud = u3k(gon); + + // XX reclaim on %meme first? + // + + job = _serf_make_crud(job, dud); + gon = _serf_poke(sef_u, "crud", mil_w, job); // retain + + // error notification accepted + // + if ( u3_blip == u3h(gon) ) { + 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), + sef_u->mug_l, + job, + vir)); + } + // error notification rejected + // + else { + sef_u->sen_d = sef_u->dun_d; + + // XX reclaim on %meme ? + // + + u3z(job); + return u3nq(c3__bail, gon, dud, u3_nul); + } + } +} + +/* u3_serf_work(): apply event, producing effects. +*/ +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[2056]; + 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, 2056, "work [%s %s]", wir_c, cad_c); + c3_free(cad_c); + c3_free(wir_c); + } + + 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, mil_w, job)); + + if ( tac_t ) { + u3t_event_trace(lab_c, 'E'); + } + + return pro; +} + +/* _serf_play_life(): +*/ +static u3_noun +_serf_play_life(u3_serf* sef_u, u3_noun eve) +{ + u3_noun gon; + + c3_assert( 0ULL == sef_u->sen_d ); + + { + u3_noun len = u3qb_lent(eve); + c3_assert( c3y == u3r_safe_chub(len, &sef_u->sen_d) ); + u3z(len); + } + + // ensure zero-initialized kernel + // + // 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(sef_u, u3k(u3t(gon))); + + u3z(gon); + return u3nc(c3__done, sef_u->mug_l); + } + // lifecycle sequence failed + // + else { + // send failure message and trace + // + sef_u->dun_d = sef_u->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); + } + + return gon; +} + +/* _serf_play_list(): +*/ +static u3_noun +_serf_play_list(u3_serf* sef_u, u3_noun eve) +{ + c3_w pre_w = u3a_open(u3R); + u3_noun vev = eve; + u3_noun job, gon; + + while ( u3_nul != eve ) { + job = u3h(eve); + + // bump sent event counter + // + sef_u->sen_d++; + + gon = _serf_play_poke(job); + + // event succeeded, save and continue + // + 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)); + + // process effects to set u3_serf_post flags + // + u3z(_serf_sure_feck(sef_u, pre_w, u3k(vir))); + + u3z(gon); + + // skip |mass on replay + // + u3z(sef_u->sac); + sef_u->sac = u3_nul; + + eve = u3t(eve); + } + // event succeeded, save and continue + // + else { + u3_noun dud = u3k(u3t(gon)); + + // reset sent event counter + // + sef_u->sen_d = sef_u->dun_d; + + u3z(gon); + + // XX reclaim on meme ? + // + + // send failure notification + // + u3z(vev); + return u3nc(c3__bail, u3nt(u3i_chubs(1, &sef_u->dun_d), + sef_u->mug_l, + dud)); + } + } + + u3z(vev); + return u3nc(c3__done, sef_u->mug_l); +} + +/* u3_serf_play(): apply event list, producing status. +*/ +u3_noun +u3_serf_play(u3_serf* sef_u, c3_d eve_d, u3_noun lit) +{ + c3_assert( eve_d == 1ULL + sef_u->sen_d ); + + // XX better condition for no kernel? + // + return u3nc(c3__play, ( 0ULL == sef_u->dun_d ) + ? _serf_play_life(sef_u, lit) + : _serf_play_list(sef_u, lit)); +} + +/* u3_serf_peek(): dereference namespace. +*/ +u3_noun +u3_serf_peek(u3_serf* sef_u, c3_w mil_w, u3_noun sam) +{ + u3_noun wen, pat, pro; + + // stash the previous date and set current + // + // XX incomplete interface, arvo should track the date + // + wen = u3A->now; + + { + u3_noun now, lyc; + u3x_trel(sam, &now, &lyc, &pat); + u3A->now = u3k(now); + } + + + { + 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 { + pro = u3nc(c3__bail, gon); + } + } + + // restore the previous date + // + // XX incomplete interface, arvo should track the date + // + u3z(u3A->now); + u3A->now = wen; + + u3z(sam); + return u3nc(c3__peek, pro); +} + +/* _serf_writ_live_exit(): exit on command. +*/ +static void +_serf_writ_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[2054]; + snprintf(man_c, 2053, "%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_writ_live_save(): save snapshot. +*/ +static void +_serf_writ_live_save(u3_serf* sef_u, c3_d eve_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(); +} + +/* 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; + + // 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; + } + + // NB: the %cram $writ only saves the rock, it doesn't load it + // + case c3__cram: { + 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 "): cram 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; + } + + u3_serf_grab(); + + *ret = u3nc(c3__live, u3_nul); + return c3y; + } + + case c3__pack: { + if ( u3_nul != dat ) { + u3z(com); + return c3n; + } + else { + u3z(com); + u3a_print_memory(stderr, "serf: pack: gained", u3m_pack()); + *ret = u3nc(c3__live, u3_nul); + return c3y; + } + } + + case c3__save: { + 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(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(sef_u->dir_c); + } + else if ( u3_Host.tra_u.con_w >= 100000 ) { + u3t_trace_close(); + u3t_trace_open(sef_u->dir_c); + } + } +} + +/* 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_noun tag, com; + c3_o ret_o; + + if ( c3n == u3r_cell(wit, &tag, &com) ) { + ret_o = c3n; + } + else { + _serf_step_trace(sef_u); + + switch ( tag ) { + default: { + ret_o = c3n; + } break; + + case c3__live: { + // since %live can take snapshots, it's refcount protocol is unique + // + u3k(com); + u3z(wit); + return u3_serf_live(sef_u, com, pel); + } break; + + case c3__peek: { + 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: { + 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__work: { + u3_noun tim, job; + 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; + } + } + + u3z(wit); + return ret_o; +} + +/* _serf_ripe(): produce initial serf state as [eve=@ mug=@] +*/ +static u3_noun +_serf_ripe(u3_serf* sef_u) +{ + // u3l_log("serf: ripe %" PRIu64 "\r\n", sef_u->dun_d); + + sef_u->mug_l = ( 0 == sef_u->dun_d ) + ? 0 + : u3r_mug(u3A->roc); + + return u3nc(u3i_chubs(1, &sef_u->dun_d), sef_u->mug_l); +} + +/* u3_serf_uncram(): initialize from rock at [eve_d]. +*/ +void +u3_serf_uncram(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 +u3_serf_init(u3_serf* sef_u) +{ + u3_noun rip; + + { + 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)); + } + + // 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); + + // if ( !(pen_w > (1 << 28)) ) { + // fprintf(stderr, "\r\n"); + // u3a_print_memory(stderr, "serf: contiguous free space", pen_w); + // u3_serf_grab(); + // } + // } + + sef_u->pac_o = c3n; + sef_u->rec_o = c3n; + sef_u->mut_o = c3n; + sef_u->sac = u3_nul; + + return rip; +} diff --git a/sh/cachix b/sh/cachix index a824ade417..15394f45fe 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,13 +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 \ - > .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 diff --git a/sh/combine-release-builds b/sh/combine-release-builds new file mode 100755 index 0000000000..844b542f09 --- /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/cross b/sh/cross index c2f7f12e93..28d1aa8772 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 diff --git a/sh/release b/sh/release index 10f6ed1b60..0207a9390d 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