mirror of
https://github.com/urbit/shrub.git
synced 2024-11-24 13:06:09 +03:00
Merge branch 'release/next-vere' into na-release/runes
* release/next-vere: build: update gcloud to use non-deprecated action vere: manage memory properly in _fore_import build: update GoogleCloudPlatform/github-actions/setup-gcloud to 0.2.0 king: try undoing warnings in eventlog-lmdb king: diswarn tests king: more warnery king: fix warnings; more consistent warn policy vere: add -i and -o options for import and export herb/lens: add utilites for import/export vere: refactors pier initialization to fix -X king: fix test (daaad) king: fix warnings in Tree (thanks dad) king: this is a holdup!
This commit is contained in:
Joe Bryan
commit
1c83ad35e9
2
.github/workflows/build.yml
vendored
2
.github/workflows/build.yml
vendored
@ -100,7 +100,7 @@ jobs:
|
||||
name: mars
|
||||
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
|
||||
|
||||
- uses: GoogleCloudPlatform/github-actions/setup-gcloud@0.1.2
|
||||
- uses: google-github-actions/setup-gcloud@v0.2.0
|
||||
with:
|
||||
version: '290.0.1'
|
||||
service_account_key: ${{ secrets.GCS_SERVICE_ACCOUNT_KEY }}
|
||||
|
||||
@ -1145,6 +1145,8 @@
|
||||
$listen-api !!
|
||||
$export !!
|
||||
$import !!
|
||||
$export-all !!
|
||||
$import-all !!
|
||||
$as
|
||||
:* %as mar.source.com
|
||||
$(num +(num), source.com next.source.com)
|
||||
|
||||
@ -14,6 +14,28 @@
|
||||
job=(unit [eyre-id=@ta com=command:lens])
|
||||
==
|
||||
==
|
||||
::
|
||||
++ export-app
|
||||
|= [app=@tas our=@p now=@da]
|
||||
.^(@ %gx /(scot %p our)/[app]/(scot %da now)/export/noun)
|
||||
++ export-all
|
||||
|= [our=@p now=@da]
|
||||
^- (list [@tas @])
|
||||
%+ turn
|
||||
^- (list @tas)
|
||||
:~ %group-store
|
||||
%metadata-store
|
||||
%metadata-hook
|
||||
%contact-store
|
||||
%contact-hook
|
||||
%invite-store
|
||||
%chat-store
|
||||
%chat-hook
|
||||
%publish
|
||||
%graph-store
|
||||
==
|
||||
|= app=@tas
|
||||
[app (export-app app our now)]
|
||||
--
|
||||
::
|
||||
=| =state
|
||||
@ -43,12 +65,15 @@
|
||||
=/ com=command:lens
|
||||
(json:grab:lens-mark jon)
|
||||
::
|
||||
?: ?=(%export -.source.com)
|
||||
~& [%export app.source.com]
|
||||
?+ -.source.com
|
||||
:_ this(job.state (some [eyre-id com]))
|
||||
[%pass /sole %agent [our.bowl %dojo] %watch /sole/[eyre-id]]~
|
||||
::
|
||||
%export
|
||||
:_ this(job.state (some [eyre-id com]))
|
||||
[%pass /export %agent [our.bowl app.source.com] %watch /export]~
|
||||
::
|
||||
?: ?=(%import -.source.com)
|
||||
%import
|
||||
?~ enc=(de:base64 base64-jam.source.com)
|
||||
!!
|
||||
::
|
||||
@ -57,8 +82,28 @@
|
||||
:_ this(job.state (some [eyre-id com]))
|
||||
[%pass /import %agent [our.bowl app.source.com] %poke %import !>(c)]~
|
||||
::
|
||||
:_ this(job.state (some [eyre-id com]))
|
||||
[%pass /sole %agent [our.bowl %dojo] %watch /sole/[eyre-id]]~
|
||||
%export-all
|
||||
=/ output (crip "{<our.bowl>}-export/atom")
|
||||
=/ jon
|
||||
=/ =atom (jam (export-all our.bowl now.bowl))
|
||||
=/ =octs [(met 3 atom) atom]
|
||||
=/ enc (en:base64 octs)
|
||||
(pairs:enjs:format file+s+output data+s+enc ~)
|
||||
:_ this
|
||||
%+ give-simple-payload:app eyre-id
|
||||
(json-response:gen jon)
|
||||
::
|
||||
%import-all
|
||||
=/ enc (de:base64 base64-jam.source.com)
|
||||
?~ enc !!
|
||||
=/ by-app ;;((list [@tas @]) (cue q.u.enc))
|
||||
:_ this
|
||||
%+ weld (give-simple-payload:app eyre-id not-found:gen)
|
||||
%+ turn by-app
|
||||
|= [app=@tas data=@]
|
||||
^- card:agent:gall
|
||||
[%pass /import-all %agent [our.bowl app] %poke %import !>(data)]
|
||||
==
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
@ -68,7 +113,13 @@
|
||||
(on-watch:def path)
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
?+ path (on-peek:def path)
|
||||
[%x %export-all ~]
|
||||
``noun+!>((jam (export-all our.bowl now.bowl)))
|
||||
==
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card:agent:gall _this)
|
||||
|
||||
@ -42,6 +42,8 @@
|
||||
listen-api+(su ;~(plug sym ;~(pfix col sym)))
|
||||
export+so
|
||||
import+(ot app+so base64-jam+so ~)
|
||||
export-all+none
|
||||
import-all+(ot base64-jam+so ~)
|
||||
as+(ot mark+(su sym) next+source ~)
|
||||
hoon+(ot code+so next+source ~)
|
||||
==
|
||||
|
||||
@ -17,6 +17,8 @@
|
||||
{$listen-api api/term event/term}
|
||||
{$export app/@t}
|
||||
{$import app/@t base64-jam/@t}
|
||||
{$export-all ~}
|
||||
{$import-all base64-jam/@t}
|
||||
==
|
||||
++ sink
|
||||
$% {$stdout ~}
|
||||
|
||||
@ -145,6 +145,34 @@ class importFileAction(argparse.Action):
|
||||
|
||||
res.source = {"import": {"app": new_value, "base64-jam": base_data}}
|
||||
|
||||
class importAllAction(argparse.Action):
|
||||
"""Handles the import-all statement.
|
||||
|
||||
The --import-all statement reads in a jammed noun file from the path passed
|
||||
in and stuffs it the base64 encoded version which gets passed into your
|
||||
Urbit.
|
||||
|
||||
"""
|
||||
def __call__(self, parser, res, new_value, option_string):
|
||||
logging.debug('%r %r' % (new_value, option_string))
|
||||
logging.debug('source %s' % res.source)
|
||||
logging.debug('level %s' % res.level)
|
||||
|
||||
# We check to see if there's a "{new_value}" file in the current
|
||||
# working directory. If there isn't, we error
|
||||
data = ""
|
||||
filename = new_value
|
||||
with open(filename, 'rb') as f:
|
||||
data = f.read()
|
||||
|
||||
if data == "":
|
||||
raise ValueError('Failed to read jamfile')
|
||||
|
||||
base_data = base64.b64encode(data)
|
||||
|
||||
res.source = {"import-all": {"base64-jam": base_data}}
|
||||
|
||||
|
||||
class transformerAction(argparse.Action):
|
||||
"""Handle transformer flag.
|
||||
|
||||
@ -350,6 +378,13 @@ parser.add_argument('-i', '--import',
|
||||
metavar='app-name',
|
||||
help='imports the application state',
|
||||
action=importFileAction)
|
||||
parser.add_argument('-E', '--export-all', const={'export-all': None},
|
||||
help='exports data from all landscape apps',
|
||||
action='store_const', dest='source')
|
||||
parser.add_argument('-I', '--import-all',
|
||||
metavar='jam-file',
|
||||
help='imports data for all landscape apps',
|
||||
action=importAllAction)
|
||||
parser.add_argument('-m', '--mark', which='as',
|
||||
metavar='mark',
|
||||
help='transform a source to another mark',
|
||||
@ -398,10 +433,8 @@ sinks.add_argument('-p', '--app', which='app',
|
||||
metavar='app',
|
||||
action=sinkAction)
|
||||
|
||||
|
||||
args = parser.parse_args(args)
|
||||
|
||||
|
||||
if args.source is None:
|
||||
args.source = {"data": ''.join(sys.stdin)}
|
||||
|
||||
|
||||
@ -45,7 +45,8 @@ loob = \case
|
||||
|
||||
textToAtom :: Text -> Atom
|
||||
textToAtom t = case N.textToUtf8Atom t of
|
||||
N.A a -> a
|
||||
N.A a -> a
|
||||
N.C _ _ -> error "textToAtom: nani!?"
|
||||
|
||||
showA :: Atom -> String
|
||||
showA a = show (N.A a)
|
||||
|
||||
@ -38,7 +38,7 @@ hone = go
|
||||
Atom a -> H.HAtom a
|
||||
Tag tx -> H.HAtom (textToAtom tx)
|
||||
Cord tx -> H.HAtom (textToAtom tx)
|
||||
Tape tx -> undefined
|
||||
Tape tx -> error "hone: tapes not implemented"
|
||||
Incr c -> H.DotLus (go c)
|
||||
IncrIrr c -> H.DotLus (go c)
|
||||
AppIrr c d -> H.CenHep (go c) (go d)
|
||||
|
||||
@ -5,11 +5,8 @@ import ClassyPrelude
|
||||
import Bound
|
||||
import Control.Monad.Writer hiding (fix)
|
||||
import Data.Deriving (deriveEq1, deriveOrd1, deriveRead1, deriveShow1)
|
||||
import qualified Data.Function as F
|
||||
import Data.List (elemIndex)
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Void
|
||||
|
||||
import Dashboard (pattern FastAtom)
|
||||
import Nock
|
||||
|
||||
@ -11,12 +11,7 @@ import Control.Monad.State.Lazy
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Void (Void)
|
||||
import Prelude (head)
|
||||
import Text.Format.Para (formatParas)
|
||||
|
||||
import qualified Data.MultiMap as MM
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as LT
|
||||
import qualified Data.Text.Lazy.IO as LT
|
||||
import qualified Prelude
|
||||
|
||||
|
||||
@ -325,6 +320,7 @@ cst = irregular <|> rune <|> literal
|
||||
|
||||
-- Entry Point -----------------------------------------------------------------
|
||||
|
||||
hoonFile :: StateT Mode (Parsec Void Text) CST
|
||||
hoonFile = do
|
||||
option () whitespace
|
||||
h <- cst
|
||||
|
||||
@ -64,6 +64,7 @@ library:
|
||||
- -fwarn-incomplete-patterns
|
||||
- -fwarn-unused-binds
|
||||
- -fwarn-unused-imports
|
||||
- -Wwarn
|
||||
- -O2
|
||||
|
||||
executables:
|
||||
|
||||
@ -18,9 +18,7 @@ import qualified Control.Exception as E
|
||||
import qualified Control.Monad.Catch as C ()
|
||||
import qualified Data.Acquire.Internal as Act
|
||||
|
||||
import Control.Applicative (Applicative(..))
|
||||
import Control.Monad (ap, liftM)
|
||||
import Control.Monad.IO.Unlift (MonadIO(..), MonadUnliftIO, withRunInIO)
|
||||
import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)
|
||||
import Control.Monad.Reader
|
||||
import Data.Typeable (Typeable)
|
||||
|
||||
|
||||
@ -6,9 +6,11 @@ license-file: LICENSE
|
||||
library:
|
||||
source-dirs: lib
|
||||
ghc-options:
|
||||
- -fwarn-incomplete-patterns
|
||||
- -fwarn-unused-binds
|
||||
- -fwarn-unused-imports
|
||||
- -Wall
|
||||
- -Werror
|
||||
- -Wno-type-defaults
|
||||
- -Wno-unused-matches
|
||||
- -Wno-name-shadowing
|
||||
- -O2
|
||||
|
||||
dependencies:
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
import Prelude
|
||||
|
||||
@ -4,10 +4,12 @@ license: MIT
|
||||
license-file: LICENSE
|
||||
|
||||
ghc-options:
|
||||
- -fwarn-incomplete-patterns
|
||||
- -fwarn-unused-binds
|
||||
- -fwarn-unused-imports
|
||||
- -Wall
|
||||
- -Werror
|
||||
- -Wno-type-defaults
|
||||
- -Wno-unused-matches
|
||||
- -Wno-name-shadowing
|
||||
- -Wno-unbanged-strict-patterns
|
||||
- -O2
|
||||
|
||||
library:
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-# OPTIONS_GHC -Wno-deprecations #-}
|
||||
{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-}
|
||||
|
||||
|
||||
module Main (main) where
|
||||
|
||||
@ -4,6 +4,9 @@
|
||||
-- combination with 'deriveNoun' which generates an unreachable pattern.
|
||||
{-# OPTIONS_GHC -Wno-overlapping-patterns #-}
|
||||
|
||||
-- Hack. See comment above instance ToNoun H.StdMethod
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
{-|
|
||||
Types used in both Events and Effects.
|
||||
-}
|
||||
@ -15,7 +18,7 @@ module Urbit.Arvo.Common
|
||||
, HttpServerConf(..), PEM(..), Key, Cert
|
||||
, HttpEvent(..), Method, Header(..), ResponseHeader(..)
|
||||
, ReOrg(..), reorgThroughNoun
|
||||
, AmesDest(..), Ipv4(..), Ipv6(..), Patp(..), Galaxy, AmesAddress(..)
|
||||
, AmesDest, Ipv4(..), Ipv6(..), Patp(..), Galaxy, AmesAddress(..)
|
||||
) where
|
||||
|
||||
import Urbit.Prelude hiding (Term)
|
||||
|
||||
@ -10,7 +10,7 @@ module Urbit.Vere.Ames (ames, ames', PacketOutcome(..)) where
|
||||
|
||||
import Urbit.Prelude
|
||||
|
||||
import Network.Socket hiding (recvFrom, sendTo)
|
||||
import Network.Socket
|
||||
import Urbit.Arvo hiding (Fake)
|
||||
import Urbit.King.Config
|
||||
import Urbit.King.Scry
|
||||
|
||||
@ -61,7 +61,7 @@ where
|
||||
|
||||
import Urbit.Prelude
|
||||
|
||||
import Network.Socket hiding (recvFrom, sendTo)
|
||||
import Network.Socket
|
||||
import Urbit.Arvo hiding (Fake)
|
||||
|
||||
import qualified Data.Map.Strict as M
|
||||
|
||||
@ -53,9 +53,7 @@ instance Serialize Packet where
|
||||
lookAhead $ do
|
||||
len <- remaining
|
||||
body <- getBytes len
|
||||
-- XX mug (marked "TODO") is implemented as "slowMug" in U.N.Tree. Ominous
|
||||
-- Also, toNoun will copy the bytes into an atom. We probably want a mugBS
|
||||
let chk = fromIntegral (mug $ toNoun $ MkBytes body) .&. (2 ^ 20 - 1)
|
||||
let chk = fromIntegral (mugBS body) .&. (2 ^ 20 - 1)
|
||||
when (checksum /= chk) $
|
||||
fail ("checksum mismatch: expected " <> show checksum
|
||||
<> "; got " <> show chk)
|
||||
@ -84,8 +82,7 @@ instance Serialize Packet where
|
||||
let (sndR, putSndr) = putShipGetRank pktSndr
|
||||
let (rcvR, putRcvr) = putShipGetRank pktRcvr
|
||||
let body = runPut (putSndr <> putRcvr <> putByteString load)
|
||||
-- XX again maybe mug can be made better here
|
||||
let chek = fromIntegral (mug $ toNoun $ MkBytes body) .&. (2 ^ 20 - 1)
|
||||
let chek = fromIntegral (mugBS body) .&. (2 ^ 20 - 1)
|
||||
let encr = pktEncrypted
|
||||
let vers = fromIntegral pktVersion .&. 0b111
|
||||
let head = vers
|
||||
|
||||
@ -35,7 +35,7 @@ where
|
||||
import Urbit.Prelude
|
||||
import Urbit.Vere.Ports
|
||||
|
||||
import Network.Socket hiding (recvFrom, sendTo)
|
||||
import Network.Socket
|
||||
|
||||
import Control.Monad.STM (retry)
|
||||
import Network.Socket.ByteString (recvFrom, sendTo)
|
||||
|
||||
@ -8,6 +8,8 @@
|
||||
|
||||
module Urbit.Vere.Behn (behn, DriverApi(..), behn') where
|
||||
|
||||
import Data.Time.Clock.System (SystemTime)
|
||||
|
||||
import Urbit.Arvo hiding (Behn)
|
||||
import Urbit.Prelude
|
||||
import Urbit.Vere.Pier.Types
|
||||
@ -39,6 +41,7 @@ bornEv king = EvBlip $ BlipEvBehn $ BehnEvBorn (king, ()) ()
|
||||
wakeEv :: Ev
|
||||
wakeEv = EvBlip $ BlipEvBehn $ BehnEvWake () ()
|
||||
|
||||
sysTime :: Wen -> SystemTime
|
||||
sysTime = view Time.systemTime
|
||||
|
||||
wakeErr :: WorkError -> IO ()
|
||||
|
||||
@ -8,7 +8,7 @@ module Urbit.Vere.Clay
|
||||
)
|
||||
where
|
||||
|
||||
import Urbit.Arvo hiding (Term)
|
||||
import Urbit.Arvo
|
||||
import Urbit.King.App
|
||||
import Urbit.Prelude
|
||||
import Urbit.Vere.Pier.Types
|
||||
@ -32,6 +32,7 @@ deskToPath :: Desk -> FilePath
|
||||
deskToPath (Desk (Cord t)) = unpack t
|
||||
|
||||
-- | The hard coded mime type of every file.
|
||||
textPlain :: Path
|
||||
textPlain = Path [(MkKnot "text"), (MkKnot "plain")]
|
||||
|
||||
-- | Filter for dotfiles, tempfiles and backup files.
|
||||
|
||||
@ -17,7 +17,7 @@ module Urbit.Vere.Dawn ( dawnVent
|
||||
|
||||
import Urbit.Arvo.Common
|
||||
import Urbit.Arvo.Event hiding (Address)
|
||||
import Urbit.Prelude hiding (Call, rights, to, (.=))
|
||||
import Urbit.Prelude hiding (rights, to, (.=))
|
||||
|
||||
import Data.Bits (xor)
|
||||
import Data.List (nub)
|
||||
|
||||
@ -10,7 +10,7 @@ where
|
||||
|
||||
import Urbit.Prelude hiding (Builder)
|
||||
|
||||
import Urbit.Arvo hiding (ServerId, reqUrl, secure)
|
||||
import Urbit.Arvo hiding (ServerId, reqUrl)
|
||||
import Urbit.King.App (HasKingId(..), HasMultiEyreApi(..), HasPierEnv(..))
|
||||
import Urbit.King.Config
|
||||
import Urbit.Vere.Eyre.Multi
|
||||
|
||||
@ -16,7 +16,7 @@ where
|
||||
|
||||
import Urbit.Prelude hiding (Builder)
|
||||
|
||||
import Urbit.Arvo hiding (ServerId, reqUrl, secure)
|
||||
import Urbit.Arvo hiding (ServerId, reqUrl)
|
||||
import Urbit.Vere.Eyre.Serv
|
||||
import Urbit.Vere.Eyre.Wai
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@ import Foreign.Storable
|
||||
import RIO.FilePath
|
||||
import System.Posix.IO
|
||||
import System.Posix.Terminal
|
||||
import Urbit.Arvo hiding (Term)
|
||||
import Urbit.Arvo
|
||||
import Urbit.King.App
|
||||
import Urbit.Noun.Time
|
||||
import Urbit.Prelude hiding (getCurrentTime)
|
||||
@ -71,8 +71,10 @@ data Private = Private
|
||||
|
||||
-- Utils -----------------------------------------------------------------------
|
||||
|
||||
blewEvent :: Word -> Word -> Ev
|
||||
blewEvent w h = EvBlip $ BlipEvTerm $ TermEvBlew (UD 1, ()) w h
|
||||
|
||||
initialHail :: Ev
|
||||
initialHail = EvBlip $ BlipEvTerm $ TermEvHail (UD 1, ()) ()
|
||||
|
||||
-- Version one of this is punting on the ops_u.dem flag: whether we're running
|
||||
@ -162,6 +164,7 @@ leftBracket, rightBracket :: Text
|
||||
leftBracket = "«"
|
||||
rightBracket = "»"
|
||||
|
||||
_spin_cool_us, _spin_warm_us, _spin_rate_us, _spin_idle_us :: Integral i => i
|
||||
_spin_cool_us = 500000
|
||||
_spin_warm_us = 50000
|
||||
_spin_rate_us = 250000
|
||||
|
||||
@ -9,10 +9,12 @@ data-files:
|
||||
library:
|
||||
source-dirs: lib
|
||||
ghc-options:
|
||||
- -fwarn-incomplete-patterns
|
||||
- -fwarn-unused-binds
|
||||
- -fwarn-unused-imports
|
||||
- -Wall
|
||||
- -Werror
|
||||
- -Wno-type-defaults
|
||||
- -Wno-unused-matches
|
||||
- -Wno-name-shadowing
|
||||
- -Wno-unused-do-bind
|
||||
- -O2
|
||||
|
||||
tests:
|
||||
|
||||
@ -70,7 +70,7 @@ treeRTMug inp = do
|
||||
non <- cueBSExn byt
|
||||
tee <- fromNounExn non
|
||||
mug <- evaluate $ mug $ toNoun $ treeTestsIdentity tee
|
||||
pure $ Text.Lazy.Encoding.encodeUtf8 $ tlshow (mug :: Natural)
|
||||
pure $ Text.Lazy.Encoding.encodeUtf8 $ tlshow mug
|
||||
|
||||
goldenPill
|
||||
:: TestName
|
||||
|
||||
@ -14,11 +14,13 @@ module Urbit.Noun.Core
|
||||
, pattern Cell, pattern Atom
|
||||
, pattern C, pattern A
|
||||
, textToUtf8Atom, utf8AtomToText
|
||||
, mug
|
||||
) where
|
||||
|
||||
import ClassyPrelude hiding (hash)
|
||||
|
||||
import Urbit.Atom
|
||||
import Urbit.Noun.Mug
|
||||
|
||||
import Data.Bits (xor)
|
||||
import Data.Function ((&))
|
||||
@ -34,14 +36,20 @@ import qualified Data.Char as C
|
||||
-- Types -----------------------------------------------------------------------
|
||||
|
||||
data Noun
|
||||
= NCell Int Word !Noun !Noun
|
||||
| NAtom Int !Atom
|
||||
= NCell ~Mug Word Noun Noun
|
||||
| NAtom ~Mug Atom
|
||||
|
||||
pattern Cell :: Noun -> Noun -> Noun
|
||||
pattern Atom :: Atom -> Noun
|
||||
|
||||
pattern Cell x y <- NCell _ _ x y where Cell = mkCell
|
||||
pattern Atom a <- NAtom _ a where Atom = mkAtom
|
||||
|
||||
{-# COMPLETE Cell, Atom #-}
|
||||
|
||||
pattern C :: Noun -> Noun -> Noun
|
||||
pattern A :: Atom -> Noun
|
||||
|
||||
pattern C x y <- NCell _ _ x y where C = mkCell
|
||||
pattern A a <- NAtom _ a where A = mkAtom
|
||||
|
||||
@ -51,10 +59,9 @@ pattern A a <- NAtom _ a where A = mkAtom
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
instance Hashable Noun where
|
||||
hash = \case NCell h _ _ _ -> h
|
||||
NAtom h _ -> h
|
||||
hash = fromIntegral . mug
|
||||
{-# INLINE hash #-}
|
||||
hashWithSalt = defaultHashWithSalt
|
||||
hashWithSalt salt x = salt `combine` hash x
|
||||
{-# INLINE hashWithSalt #-}
|
||||
|
||||
textToUtf8Atom :: Text -> Noun
|
||||
@ -140,6 +147,10 @@ genAtom = do
|
||||
False -> genNatural
|
||||
True -> (`mod` 16) <$> genNatural
|
||||
|
||||
-- From http://hackage.haskell.org/package/hashable-1.2.7.0/docs/src/Data-Hashable-Class.html
|
||||
combine :: Int -> Int -> Int
|
||||
combine h1 h2 = (h1 * 16777619) `xor` h2
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
{-# INLINE nounSize #-}
|
||||
@ -148,24 +159,18 @@ nounSize = \case
|
||||
NCell _ s _ _ -> s
|
||||
NAtom _ _ -> 1
|
||||
|
||||
{-# INLINE mug #-}
|
||||
mug :: Noun -> Mug
|
||||
mug = \case NCell h _ _ _ -> h
|
||||
NAtom h _ -> h
|
||||
|
||||
{-# INLINE mkAtom #-}
|
||||
mkAtom :: Atom -> Noun
|
||||
mkAtom a = NAtom (hash a) a
|
||||
mkAtom a = NAtom (mugAtom a) a
|
||||
|
||||
{-# INLINE mkCell #-}
|
||||
mkCell :: Noun -> Noun -> Noun
|
||||
mkCell h t = NCell has siz h t
|
||||
where
|
||||
siz = nounSize h + nounSize t
|
||||
has = hash h `combine` hash t
|
||||
|
||||
|
||||
-- Stolen from Hashable Library ------------------------------------------------
|
||||
|
||||
{-# INLINE combine #-}
|
||||
combine :: Int -> Int -> Int
|
||||
combine h1 h2 = (h1 * 16777619) `xor` h2
|
||||
|
||||
{-# INLINE defaultHashWithSalt #-}
|
||||
defaultHashWithSalt :: Hashable a => Int -> a -> Int
|
||||
defaultHashWithSalt salt x = salt `combine` hash x
|
||||
has = mugBoth (mug h) (mug t)
|
||||
|
||||
32
pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs
Normal file
32
pkg/hs/urbit-noun-core/lib/Urbit/Noun/Mug.hs
Normal file
@ -0,0 +1,32 @@
|
||||
{-# OPTIONS_GHC -O2 #-}
|
||||
|
||||
module Urbit.Noun.Mug where
|
||||
|
||||
import ClassyPrelude
|
||||
|
||||
import Data.Bits
|
||||
import Urbit.Atom
|
||||
|
||||
import Data.Hash.Murmur (murmur3)
|
||||
|
||||
type Mug = Word32
|
||||
|
||||
{-# INLINE mugBS #-}
|
||||
mugBS :: ByteString -> Word32
|
||||
mugBS = go 0xcafebabe
|
||||
where
|
||||
go seed buf =
|
||||
let haz = murmur3 seed buf
|
||||
ham = shiftR haz 31 `xor` (haz .&. 0x7fff_ffff)
|
||||
in if ham == 0
|
||||
then go (seed + 1) buf
|
||||
else ham
|
||||
|
||||
-- XX is there a way to do this without copy?
|
||||
{-# INLINE mugAtom #-}
|
||||
mugAtom :: Atom -> Word32
|
||||
mugAtom = mugBS . atomBytes
|
||||
|
||||
{-# INLINE mugBoth #-}
|
||||
mugBoth :: Word32 -> Word32 -> Word32
|
||||
mugBoth m n = mugAtom $ fromIntegral $ m `xor` 0x7fff_ffff `xor` n
|
||||
@ -6,10 +6,11 @@ license-file: LICENSE
|
||||
library:
|
||||
source-dirs: lib
|
||||
ghc-options:
|
||||
- -fwarn-incomplete-patterns
|
||||
- -fwarn-unused-binds
|
||||
- -fwarn-unused-imports
|
||||
- -Wall
|
||||
- -Werror
|
||||
- -Wno-type-defaults
|
||||
- -Wno-unused-matches
|
||||
- -Wno-name-shadowing
|
||||
- -O2
|
||||
|
||||
dependencies:
|
||||
@ -24,6 +25,7 @@ dependencies:
|
||||
- vector
|
||||
- integer-gmp
|
||||
- template-haskell
|
||||
- murmur3
|
||||
|
||||
default-extensions:
|
||||
- ApplicativeDo
|
||||
|
||||
@ -11,6 +11,7 @@ module Urbit.Noun
|
||||
, module Urbit.Noun.Core
|
||||
, module Urbit.Noun.Cue
|
||||
, module Urbit.Noun.Jam
|
||||
, module Urbit.Noun.Mug
|
||||
, module Urbit.Noun.Tank
|
||||
, module Urbit.Noun.TH
|
||||
, module Urbit.Noun.Tree
|
||||
@ -29,6 +30,7 @@ import Urbit.Noun.Convert
|
||||
import Urbit.Noun.Core
|
||||
import Urbit.Noun.Cue
|
||||
import Urbit.Noun.Jam
|
||||
import Urbit.Noun.Mug
|
||||
import Urbit.Noun.Tank
|
||||
import Urbit.Noun.TH
|
||||
import Urbit.Noun.Tree
|
||||
|
||||
@ -10,7 +10,7 @@ module Urbit.Noun.Conversions
|
||||
, BigTape(..), BigCord(..)
|
||||
, Wain(..), Wall, Each(..)
|
||||
, UD(..), UV(..), UW(..), cordToUW
|
||||
, Mug(..), Path(..), EvilPath(..), Ship(..)
|
||||
, Path(..), EvilPath(..), Ship(..)
|
||||
, Lenient(..), pathToFilePath, filePathToPath
|
||||
, showUD, tshowUD
|
||||
, textAsTa
|
||||
@ -639,11 +639,6 @@ filePathToPath fp = Path path
|
||||
('.':xs) -> xs
|
||||
x -> x
|
||||
|
||||
-- Mug -------------------------------------------------------------------------
|
||||
|
||||
newtype Mug = Mug Word32
|
||||
deriving newtype (Eq, Ord, Show, Num, ToNoun, FromNoun)
|
||||
|
||||
|
||||
-- Bool ------------------------------------------------------------------------
|
||||
|
||||
|
||||
@ -7,22 +7,16 @@
|
||||
module Urbit.Noun.Tree
|
||||
( HoonSet, setToHoonSet, setFromHoonSet
|
||||
, HoonMap, mapToHoonMap, mapFromHoonMap
|
||||
, mug
|
||||
) where
|
||||
|
||||
import ClassyPrelude
|
||||
import Control.Lens hiding (non)
|
||||
|
||||
import Urbit.Atom
|
||||
import Urbit.Noun.Conversions ()
|
||||
import Urbit.Noun.Convert
|
||||
import Urbit.Noun.Core
|
||||
import Urbit.Noun.TH
|
||||
|
||||
import Data.Bits (shiftR, xor)
|
||||
import Data.Hash.Murmur (murmur3)
|
||||
import GHC.Natural (Natural)
|
||||
|
||||
|
||||
-- Types -----------------------------------------------------------------------
|
||||
|
||||
@ -41,6 +35,7 @@ data HoonTreeNode a = NTN
|
||||
data HoonTree a = E | Node (HoonTreeNode a)
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
pattern N :: NounVal a -> HoonTree a -> HoonTree a -> HoonTree a
|
||||
pattern N n l r = Node (NTN n l r)
|
||||
|
||||
newtype HoonSet a = HoonSet { unHoonSet :: HoonTree a }
|
||||
@ -78,67 +73,6 @@ instance FromNoun a => FromNoun (HoonTree a) where
|
||||
deriveNoun ''HoonTreeNode
|
||||
|
||||
|
||||
-- Mug -------------------------------------------------------------------------
|
||||
|
||||
type Nat = Natural
|
||||
|
||||
slowMug :: Noun -> Nat
|
||||
slowMug = trim 0xcafe_babe . \case
|
||||
A a -> a
|
||||
C h t -> mix (slowMug h) $ mix 0x7fff_ffff (slowMug t)
|
||||
where
|
||||
trim :: Nat -> Nat -> Nat
|
||||
trim syd key =
|
||||
if 0/=ham then ham else trim (succ syd) key
|
||||
where
|
||||
haz = muk syd (met 3 key) key
|
||||
ham = mix (rsh 0 31 haz) (end 0 31 haz)
|
||||
|
||||
mix :: Nat -> Nat -> Nat
|
||||
mix = xor
|
||||
|
||||
-- Murmur3
|
||||
muk :: Nat -> Nat -> Nat -> Nat
|
||||
muk seed len =
|
||||
fromIntegral . murmur3 (word32 seed) . resize . atomBytes
|
||||
where
|
||||
resize :: ByteString -> ByteString
|
||||
resize buf =
|
||||
case compare (length buf) (int len) of
|
||||
EQ -> buf
|
||||
LT -> error "bad-muk"
|
||||
GT -> error "bad-muk"
|
||||
-- LT -> buf <> replicate (len - length buf) 0
|
||||
-- GT -> take len buf
|
||||
|
||||
int :: Integral i => i -> Int
|
||||
int = fromIntegral
|
||||
|
||||
word32 :: Integral i => i -> Word32
|
||||
word32 = fromIntegral
|
||||
|
||||
bex :: Nat -> Nat
|
||||
bex = (2^)
|
||||
|
||||
end :: Nat -> Nat -> Nat -> Nat
|
||||
end blockSize blocks n =
|
||||
n `mod` (bex (bex blockSize * blocks))
|
||||
|
||||
rsh :: Nat -> Nat -> Nat -> Nat
|
||||
rsh blockSize blocks n =
|
||||
shiftR n $ fromIntegral $ (bex blockSize * blocks)
|
||||
|
||||
met :: Nat -> Nat -> Nat
|
||||
met bloq = go 0
|
||||
where
|
||||
go c 0 = c
|
||||
go c n = go (succ c) (rsh bloq 1 n)
|
||||
|
||||
-- XX TODO
|
||||
mug :: Noun -> Nat
|
||||
mug = slowMug
|
||||
|
||||
|
||||
-- Order -----------------------------------------------------------------------
|
||||
|
||||
{-
|
||||
@ -147,8 +81,8 @@ mug = slowMug
|
||||
mor :: Noun -> Noun -> Bool
|
||||
mor a b = if c == d then dor a b else c < d
|
||||
where
|
||||
c = mug $ A $ mug a
|
||||
d = mug $ A $ mug b
|
||||
c = mug $ A $ fromIntegral $ mug a
|
||||
d = mug $ A $ fromIntegral $ mug b
|
||||
|
||||
{-
|
||||
Orders in ascending tree depth.
|
||||
|
||||
@ -6,10 +6,12 @@ license-file: LICENSE
|
||||
library:
|
||||
source-dirs: lib
|
||||
ghc-options:
|
||||
- -fwarn-incomplete-patterns
|
||||
- -fwarn-unused-binds
|
||||
- -fwarn-unused-imports
|
||||
- -Wall
|
||||
- -Werror
|
||||
- -Wno-type-defaults
|
||||
- -Wno-unused-matches
|
||||
- -Wno-name-shadowing
|
||||
- -Wno-orphans
|
||||
- -O2
|
||||
|
||||
dependencies:
|
||||
|
||||
@ -3,7 +3,6 @@ module Main where
|
||||
import Prelude
|
||||
|
||||
import Urbit.TermSize (liveTermSize)
|
||||
import System.IO (getLine)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
||||
@ -9,9 +9,12 @@ dependencies:
|
||||
- unix
|
||||
|
||||
ghc-options:
|
||||
- -fwarn-incomplete-patterns
|
||||
- -fwarn-unused-binds
|
||||
- -fwarn-unused-imports
|
||||
- -Wall
|
||||
- -Werror
|
||||
- -Wno-type-defaults
|
||||
- -Wno-unused-matches
|
||||
- -Wno-name-shadowing
|
||||
- -Wno-unused-do-bind
|
||||
- -O2
|
||||
|
||||
library:
|
||||
|
||||
@ -74,6 +74,7 @@ _main_getopt(c3_i argc, c3_c** argv)
|
||||
u3_Host.ops_u.abo = c3n;
|
||||
u3_Host.ops_u.dem = c3n;
|
||||
u3_Host.ops_u.dry = c3n;
|
||||
u3_Host.ops_u.exp = c3n;
|
||||
u3_Host.ops_u.gab = c3n;
|
||||
u3_Host.ops_u.git = c3n;
|
||||
|
||||
@ -96,7 +97,7 @@ _main_getopt(c3_i argc, c3_c** argv)
|
||||
u3_Host.ops_u.kno_w = DefaultKernel;
|
||||
|
||||
while ( -1 != (ch_i=getopt(argc, argv,
|
||||
"X:Y:G:J:B:K:A:H:I:C:w:u:e:F:k:n:p:r:LljacdgqstvxPDRS")) )
|
||||
"X:Y:G:J:B:K:A:H:I:C:w:u:e:F:k:n:p:r:i:LljacdgoqstvxPDRS")) )
|
||||
{
|
||||
switch ( ch_i ) {
|
||||
case 'X': {
|
||||
@ -187,6 +188,10 @@ _main_getopt(c3_i argc, c3_c** argv)
|
||||
u3_Host.ops_u.roc_c = strdup(optarg);
|
||||
break;
|
||||
}
|
||||
case 'i': {
|
||||
u3_Host.ops_u.imp_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; }
|
||||
@ -194,6 +199,7 @@ _main_getopt(c3_i argc, c3_c** argv)
|
||||
case 'c': { u3_Host.ops_u.nuu = c3y; break; }
|
||||
case 'd': { u3_Host.ops_u.dem = c3y; break; }
|
||||
case 'g': { u3_Host.ops_u.gab = c3y; break; }
|
||||
case 'o': { u3_Host.ops_u.exp = c3y; break; }
|
||||
case 'P': { u3_Host.ops_u.pro = c3y; break; }
|
||||
case 'D': { u3_Host.ops_u.dry = c3y; break; }
|
||||
case 'q': { u3_Host.ops_u.qui = c3y; break; }
|
||||
@ -398,10 +404,12 @@ u3_ve_usage(c3_i argc, c3_c** argv)
|
||||
"-e url Ethereum gateway\n",
|
||||
"-F ship Fake keys; also disables networking\n",
|
||||
"-g Set GC flag\n",
|
||||
"-i jam_file import pier state\n",
|
||||
"-j Create json trace file in .urb/put/trace\n",
|
||||
"-K stage Start at Hoon kernel version stage\n",
|
||||
"-k keys Private key file\n",
|
||||
"-L local networking only\n",
|
||||
"-o export pier state\n",
|
||||
"-P Profiling\n",
|
||||
"-p ames_port Set the ames port to bind to\n",
|
||||
"-q Quiet\n",
|
||||
@ -415,7 +423,7 @@ u3_ve_usage(c3_i argc, c3_c** argv)
|
||||
"-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"
|
||||
"-Y file Optional name of jamfile (for -X and -o)\n"
|
||||
"\n",
|
||||
"Development Usage:\n",
|
||||
" To create a development ship, use a fakezod:\n",
|
||||
|
||||
@ -265,6 +265,8 @@
|
||||
c3_o gab; // -g, test garbage collection
|
||||
c3_c* dns_c; // -H, ames bootstrap domain
|
||||
c3_c* jin_c; // -I, inject raw event
|
||||
c3_c* imp_c; // -i, import pier state
|
||||
c3_o exp; // -o, export pier state
|
||||
c3_w hap_w; // -C, cap memo cache
|
||||
c3_c* lit_c; // -J, ivory (fastboot) kernel
|
||||
c3_o tra; // -j, json trace
|
||||
|
||||
@ -22,6 +22,17 @@ _fore_inject_bail(u3_ovum* egg_u, u3_noun lud)
|
||||
u3_ovum_free(egg_u);
|
||||
}
|
||||
|
||||
/* _fore_import_bail(): handle failure on arbitrary injection.
|
||||
*/
|
||||
static void
|
||||
_fore_import_bail(u3_ovum* egg_u, u3_noun lud)
|
||||
{
|
||||
u3_auto_bail_slog(egg_u, lud);
|
||||
u3l_log("pier: import failed\n");
|
||||
|
||||
u3_ovum_free(egg_u);
|
||||
}
|
||||
|
||||
/* _fore_inject(): inject an arbitrary ovum from a jammed file at [pax_c].
|
||||
*/
|
||||
static void
|
||||
@ -69,6 +80,37 @@ _fore_inject(u3_auto* car_u, c3_c* pax_c)
|
||||
u3z(ovo);
|
||||
}
|
||||
|
||||
/* _fore_import(): form an ovum from jammed archive at [pax_c] and inject it.
|
||||
*/
|
||||
static void
|
||||
_fore_import(u3_auto* car_u, c3_c* pax_c)
|
||||
{
|
||||
// With apologies
|
||||
u3_noun arc = u3ke_cue(u3m_file(pax_c));
|
||||
u3_noun b64 = u3do("crip", u3do("en-base64:mimes:html", arc));
|
||||
c3_c * b64_c = u3r_string(b64);
|
||||
|
||||
c3_w siz_w = strlen(b64_c) + 120;
|
||||
c3_c * bod_c = (c3_c *) c3_malloc(siz_w);
|
||||
snprintf(bod_c, siz_w,
|
||||
"{\"source\": {\"import-all\": {\"base64-jam\": \"%s\"}}, \
|
||||
\"sink\": {\"stdout\": null}}", b64_c);
|
||||
|
||||
u3_noun dat = u3nt(u3_nul, u3i_word(strlen(bod_c)), u3i_string(bod_c));
|
||||
u3_noun req = u3nt(c3n,
|
||||
u3nc(u3i_string("ipv4"), u3i_word(0x7f000001)),
|
||||
u3nq(u3i_string("POST"), u3i_string("/"), u3_nul, dat));
|
||||
u3_noun wir = u3nc(u3i_string("http-server"), u3_nul);
|
||||
u3_noun cad = u3nc(u3i_string("request-local"), req);
|
||||
u3_auto_peer(
|
||||
u3_auto_plan(car_u, u3_ovum_init(0, c3__e, wir, cad)),
|
||||
0, 0, _fore_import_bail);
|
||||
|
||||
u3z(b64);
|
||||
c3_free(b64_c);
|
||||
c3_free(bod_c);
|
||||
}
|
||||
|
||||
/* _fore_io_talk():
|
||||
*/
|
||||
static void
|
||||
@ -106,6 +148,10 @@ _fore_io_talk(u3_auto* car_u)
|
||||
if ( u3_Host.ops_u.jin_c ) {
|
||||
_fore_inject(car_u, u3_Host.ops_u.jin_c);
|
||||
}
|
||||
|
||||
if ( u3_Host.ops_u.imp_c ) {
|
||||
_fore_import(car_u, u3_Host.ops_u.imp_c);
|
||||
}
|
||||
}
|
||||
|
||||
/* _fore_io_kick(): handle no effects.
|
||||
|
||||
@ -477,6 +477,51 @@ u3_pier_peek_last(u3_pier* pir_u,
|
||||
_pier_peek_plan(pir_u, pic_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\n");
|
||||
u3_pier_exit(pir_u);
|
||||
|
||||
u3z(nun);
|
||||
}
|
||||
|
||||
/* _pier_work_init(): begin processing new events
|
||||
*/
|
||||
static void
|
||||
@ -529,11 +574,6 @@ _pier_work_init(u3_pier* pir_u)
|
||||
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 = {
|
||||
@ -545,6 +585,51 @@ _pier_work_init(u3_pier* pir_u)
|
||||
// };
|
||||
// u3_lord_work_init(pir_u->god_u, cb_u);
|
||||
|
||||
// XX this is messy, revise
|
||||
//
|
||||
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_pier_peek_last(pir_u, u3_nul, u3k(car), u3k(dek), u3k(pax),
|
||||
pir_u, _pier_on_scry_done);
|
||||
}
|
||||
u3z(pex);
|
||||
}
|
||||
else if ( _(u3_Host.ops_u.exp) ) {
|
||||
u3_noun pex = u3do("stab", u3i_string("/gx/lens/export-all/noun"));
|
||||
u3_noun car;
|
||||
u3_noun dek;
|
||||
u3_noun pax;
|
||||
u3r_trel(pex, &car, &dek, &pax);
|
||||
if (!u3_Host.ops_u.puk_c) {
|
||||
u3_Host.ops_u.puk_c = strdup("/archive");
|
||||
}
|
||||
// run the requested scry, jam to disk, then exit
|
||||
//
|
||||
u3l_log("pier: scry\n");
|
||||
u3_pier_peek_last(pir_u, u3_nul, u3k(car), u3k(dek), u3k(pax),
|
||||
pir_u, _pier_on_scry_done);
|
||||
u3z(pex);
|
||||
|
||||
}
|
||||
else {
|
||||
// initialize i/o drivers
|
||||
//
|
||||
wok_u->car_u = u3_auto_init(pir_u);
|
||||
u3_auto_talk(wok_u->car_u);
|
||||
}
|
||||
|
||||
_pier_work(wok_u);
|
||||
}
|
||||
|
||||
@ -1068,51 +1153,6 @@ _pier_on_lord_bail(void* ptr_v)
|
||||
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
|
||||
@ -1143,26 +1183,7 @@ _pier_on_lord_live(void* ptr_v)
|
||||
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_pier_peek_last(pir_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 ) {
|
||||
if ( god_u->eve_d < log_u->dun_d ) {
|
||||
c3_d eve_d;
|
||||
|
||||
// XX revisit
|
||||
|
||||
Loading…
Reference in New Issue
Block a user