mirror of https://github.com/voidlizard/hbs2
hbs2 fsck re-implemented
This commit is contained in:
parent
fc7a5c5e9f
commit
8e7165331c
2
Makefile
2
Makefile
|
@ -19,7 +19,6 @@ BINS := \
|
|||
hbs2 \
|
||||
hbs2-peer \
|
||||
hbs2-keyman \
|
||||
hbs2-git-subscribe \
|
||||
git-remote-hbs2 \
|
||||
hbs2-cli \
|
||||
hbs2-sync \
|
||||
|
@ -27,6 +26,7 @@ BINS := \
|
|||
hbs2-git3 \
|
||||
git-remote-hbs23 \
|
||||
hbs2-ncq \
|
||||
hbs2-obsolete \
|
||||
tcq \
|
||||
test-ncq \
|
||||
|
||||
|
|
23
bf6/hbs2
23
bf6/hbs2
|
@ -170,6 +170,29 @@
|
|||
(iterate println (hbs2:tree:scan:deep hash) )
|
||||
)
|
||||
|
||||
( (list? [sym? fsck] [sym? -h])
|
||||
(begin
|
||||
(println "usage: hbs2 fsck <PATH>")
|
||||
(println "default for <PATH> is hbs2-peer storage path")
|
||||
)
|
||||
)
|
||||
|
||||
( (list? [sym? fsck] ...)
|
||||
(begin
|
||||
(local sto1 (if (eq? (type ...) :list) (car ...) '()))
|
||||
(if sto1
|
||||
(run:proc:attached tcq ncq:fsck (concat sto1 :/ :0))
|
||||
(begin
|
||||
(local answ (fallback #f '(call:proc hbs2-peer poke)))
|
||||
(unless answ (die "hbs2-peer seems down, but you may pass storage directory manually"))
|
||||
(local sto (lookup:uw storage: answ))
|
||||
(println (ansi :red _ "check") space sto)
|
||||
(run:proc:attached tcq ncq:fsck (concat sto :/ :0))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
( _ (--help) )
|
||||
)
|
||||
|
||||
|
|
|
@ -893,12 +893,6 @@ runPeer opts = respawnOnError opts $ flip runContT pure do
|
|||
|
||||
pl <- AnyPeerLocator <$> newBrainyPeerLocator @e (SomeBrains @e brains) mempty
|
||||
|
||||
-- FIXME: messaing-watchdog
|
||||
-- Раз уж мы не помирает в случае, если один
|
||||
-- из месседжингов отвалился --- то нужно
|
||||
-- сделать watchdog, который будет респавнить
|
||||
-- всё, если нет ни одного живого месседжинга
|
||||
|
||||
msgAlive <- liftIO $ newTVarIO 0
|
||||
|
||||
messWatchDog <- liftIO $ async do
|
||||
|
@ -1353,6 +1347,7 @@ runPeer opts = respawnOnError opts $ flip runContT pure do
|
|||
, "tcp:" <+> dquotes (pretty (fst . snd <$> tcpPoint))
|
||||
, "local-multicast:" <+> dquotes (pretty localMulticast)
|
||||
, "rpc:" <+> dquotes (pretty rpc)
|
||||
, "storage:" <+> dquotes (pretty ncqPath)
|
||||
, http
|
||||
]
|
||||
|
||||
|
|
|
@ -2110,17 +2110,9 @@ internalEntries = do
|
|||
[ e, expr ] -> do
|
||||
try @_ @SomeException (eval expr) >>= \case
|
||||
Right x -> pure x
|
||||
Left x -> pure e
|
||||
Left _ -> eval e
|
||||
other -> throwIO (BadFormException @c (mkList other))
|
||||
|
||||
entry $ bindMatch "fallback1" $ \case
|
||||
[ e, expr ] -> do
|
||||
try @_ @SomeException (eval expr) >>= \case
|
||||
Right x -> pure x
|
||||
Left x -> error (show x)
|
||||
other -> throwIO (BadFormException @c (mkList other))
|
||||
|
||||
|
||||
entry $ bindMatch "grep" \case
|
||||
[TextLike needle, what ] | matchOne needle what
|
||||
-> pure what
|
||||
|
|
Loading…
Reference in New Issue