From 8e7165331c4dc6bcb52f9233f887d8bc5ab40742 Mon Sep 17 00:00:00 2001
From: voidlizard <dzuikov@gmail.com>
Date: Fri, 6 Jun 2025 06:43:40 +0300
Subject: [PATCH] hbs2 fsck re-implemented

---
 Makefile                                      |  2 +-
 bf6/hbs2                                      | 23 +++++++++++++++++++
 hbs2-peer/app/PeerMain.hs                     |  7 +-----
 .../Data/Config/Suckless/Script/Internal.hs   | 10 +-------
 4 files changed, 26 insertions(+), 16 deletions(-)

diff --git a/Makefile b/Makefile
index 4b62863d..33015d51 100644
--- a/Makefile
+++ b/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 \
 
diff --git a/bf6/hbs2 b/bf6/hbs2
index b3820726..32eda25c 100755
--- a/bf6/hbs2
+++ b/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) )
 )
 
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index 8b51537f..2e5479b0 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -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
                              ]
 
diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs
index b1f94c8d..7c292e60 100644
--- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs
+++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs
@@ -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