From 513e2deef8ad7a3fc0fe13ced0433127fafa3cf2 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Wed, 12 Feb 2025 13:51:59 +0300 Subject: [PATCH] simple-test --- hbs2-tests/integrational/wtf.ss | 155 ++++++++++++++++++ .../lib/Data/Config/Suckless/Almost/RPC.hs | 13 ++ .../Data/Config/Suckless/Script/Internal.hs | 26 +++ 3 files changed, 194 insertions(+) create mode 100644 hbs2-tests/integrational/wtf.ss diff --git a/hbs2-tests/integrational/wtf.ss b/hbs2-tests/integrational/wtf.ss new file mode 100644 index 00000000..4919bc88 --- /dev/null +++ b/hbs2-tests/integrational/wtf.ss @@ -0,0 +1,155 @@ + +(define local-net macvlan-wtf) +(define remote-net macvlan1) +(define local-phy enp2s0) + +(define local-ip :192.168.1.171/24) +(define remote-ip :192.168.1.172/24) +(define remote-gw :192.168.1.1) + +(define local-temp-dir (sys:temp:dir)) +(define local-conf (join :/ local-temp-dir .config)) +(define local-share (join :/ local-temp-dir .share)) +(define local-local (join :/ local-temp-dir .local)) +(define local-keyman (join :/ local-temp-dir .hbs2-keyman/keys)) +(define local-temp (join :/ local-temp-dir .tmp)) +(define resolv.conf (join :/ local-temp-dir :resolv.conf)) +(define workdir (pwd)) +(define locale-dir /run/current-system/sw/lib/locale/locale-archive) + +(define HOME (env :HOME)) + +(define profile-bin (join :/ /home/dmz/.nix-profile/bin)) + +(define local-dirs + `[ ,local-temp-dir + ,local-conf + ,local-share + ,local-local + ,local-keyman + ,local-temp + ]) + +(define remote-path + (begin + (local path0 + `[ /usr/bin:/sbin + /usr/sbin + /nix/store + /opt/bin + /run/current-system/sw/bin + ,(sym HOME /.nix-profile/bin) + /opt/bin + ,(join :/ workdir bin) + ]) + (join :: path0))) + +(define tmux.conf + (begin + (local tenv (join space set-environment -g PATH (str remote-path))) + (local cfg (join chr:lf tenv chr:lf) ) + cfg) +) + +(define env-file (sym (join :/ local-temp .env))) + +(define vm-shell + (begin + (local vminit + `[ [call:proc ip link set ,remote-net up] + [call:proc ip addr add ,remote-ip dev ,remote-net] + [call:proc ip route add default via ,remote-gw] + ; [str:append:file /etc/resolv.conf (concat nameserver space ,remote-gw chr:lf)] + [run:proc:attached echo ,HOME] + [println "PATH: " (env PATH)] + [cp /tmp/.tmux.conf (join :/ (env HOME) .tmux.conf)] + ; [run:proc:attached bash --noprofile --norc] + [run:proc:attached tmux new-session -d -s mysession sh] + [run:proc:attached tmux split-window -v -t mysession:0 sh] + [run:proc:attached tmux send-keys -t mysession:0.0 hbs2-keyman space update Enter] + [run:proc:attached tmux send-keys -t mysession:0.0 hbs2-peer space run Enter] + [sleep 0.5] + [run:proc:attached tmux send-keys -t mysession:0.1 "hbs2-peer log debug on" Enter] + + [run:proc:attached tmux send-keys -t mysession:0.1 "hbs2-peer ping 192.168.1.43:7354" Enter] + [sleep 0.5] + + [run:proc:attached tmux send-keys -t mysession:0.1 "git clone hbs23://EvP3kskPVuKuKVMUc3LnfdW7GcFYjz6f5fFU1EGzrdgk && tmux kill-session -t mysession" Enter] + [run:proc:attached tmux attach-session -t mysession ] + + ; [run:proc:attached tmux attach-session -t mysession] + ; [run:proc:attached tmux kill-session -t mysession] + ]) + vminit + ) +) + +(define (vm-shell-write) + (begin + (touch env-file) + (str:save env-file (sym (join chr:lf vm-shell))) + (str:save resolv.conf (sym :nameserver space remote-gw)) + (str:save (join :/ local-temp .tmux.conf) tmux.conf) + ) +) + +(define (nspawn-args) + (begin '[] + (local ndir (join := --directory :/)) + (local iface (join := --network-macvlan (concat local-net :: remote-net))) + (local (param k v) (join := k v)) + (local (nbind a b) (join := --bind (join :: a b))) + (local (nbind-ro a b) (join := --bind-ro (join :: a b))) + (local local-locale-dir /run/current-system/sw/lib/locale/locale-archive) + (local remote-locale-dir /usr/lib/locale/locale-archive) + (local dist-dir (join :/ workdir dist-newstyle)) + (local remote-keyman /root/.hbs2-keyman/keys) + (local setenv --setenv) + (local nargs0 + `[ ,ndir + --ephemeral + ,(nbind local-keyman remote-keyman) + ,(nbind local-temp /tmp) + ,(nbind /var/tmp /var/tmp) + ,(nbind /run/current-system/sw/bin /run/current-system/sw/bin) + ,(nbind resolv.conf /etc/resolv.conf) + ,(nbind /nix/store /nix/store) + ,(nbind-ro profile-bin profile-bin) + ,(nbind locale-dir remote-locale-dir ) + ,(nbind dist-dir dist-dir) + ,(nbind ./bin /opt/bin) + ,iface + ,setenv ,(param LOCAL_ARCHIVE remote-locale-dir) + ,setenv ,(param LC_ALL C.utf8) + ,setenv ,(param PATH remote-path) + ,setenv ,(param PS1 (concat (join space "(nspawn) "))) + /opt/bin/hbs2-cli --run /tmp/.env + ]) + (map sym nargs0) + ) +) + + +(println "preparing dirs") +(rm local-dirs) +(mkdir local-dirs) +(touch env-file) +(call:proc :chmod :1777 env-file) + +;;FIXME: interface hardcode + +(vm-shell-write) +(run:proc:quiet sudo `[ip link delete ,local-net]) +(sleep 0.3) +(run:proc:attached sudo `[ip link add ,local-net link ,local-phy type macvlan mode bridge]) +(sleep 0.3) +(run:proc:attached sudo `[ip link set ,local-net up]) +(run:proc:attached sudo `[ip addr add ,local-ip dev ,local-net]) +(sleep 0.3) + +(run:proc:attached sudo (cons systemd-nspawn [nspawn-args])) + +(run:proc:attached sudo `[rm -rf ,local-temp-dir]) +(run:proc:attached sudo `[ip link delete ,local-net]) + + diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Almost/RPC.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Almost/RPC.hs index 9dd7dbf8..38da5443 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Almost/RPC.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Almost/RPC.hs @@ -86,6 +86,19 @@ runProcAttached cmd args = do runProcess processConfig + +runProcQuiet :: forall m . MonadIO m + => FilePath + -> [String] + -> m ExitCode +runProcQuiet cmd args = do + let config = setStdout createPipe $ setStderr createPipe $ setStdout createPipe $ proc cmd args + -- let processConfig = setStdout closed + -- $ setStderr closed + -- $ proc cmd args + + runProcess config + pipeProcText :: forall m . MonadIO m => FilePath -> [String] 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 39ea04e6..1bed704e 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs @@ -70,6 +70,7 @@ import System.Exit qualified as Exit import Text.InterpolatedString.Perl6 (qc) import Lens.Micro.Platform import UnliftIO +import UnliftIO.Concurrent import Control.Monad.Trans.Cont -- TODO: move-to-suckless-conf @@ -1426,6 +1427,12 @@ internalEntries = do _ -> throwIO (BadFormException @c nil) + entry $ bindMatch "str:append:file" $ nil_ \case + (StringLike fn : StringLikeList what) -> do + liftIO (forM_ what (appendFile fn)) + + e -> throwIO (BadFormException @c (mkList e)) + entry $ bindValue "space" $ mkStr " " let doParseTop w l s = @@ -1591,6 +1598,10 @@ internalEntries = do [w] -> pure (mkBool (isTrue w)) _ -> throwIO (BadFormException @c nil) + entry $ bindMatch "setenv" $ nil_ \case + [ StringLike k, StringLike v] -> liftIO $ setEnv k v + _ -> throwIO (BadFormException @c nil) + brief "get system environment" $ args [] $ args [ arg "string" "string" ] @@ -1730,6 +1741,11 @@ internalEntries = do _ -> throwIO (BadFormException @c nil) + entry $ bindMatch "sleep" $ nil_ $ \case + [ LitIntVal n ] -> lift $ threadDelay ( fromIntegral n * 1000000 ) + [ LitScientificVal n ] -> lift $ threadDelay ( round $ realToFrac n * 1000000 ) + e -> throwIO (BadFormException @c (mkList e)) + brief "call external process as pipe" $ entry $ bindMatch "run:proc:attached" $ \syn -> do (cmd, args) <- case syn of @@ -1740,6 +1756,16 @@ internalEntries = do Exit.ExitSuccess -> pure $ mkInt 0 Exit.ExitFailure n -> pure $ mkInt n + brief "call external process as pipe" + $ entry $ bindMatch "run:proc:quiet" $ \syn -> do + (cmd, args) <- case syn of + [ StringLike name, ListVal (StringLikeList params) ] -> pure (name, params) + StringLikeList (name:params) -> pure (name, params) + e -> throwIO (BadFormException @c (mkList e)) + runProcQuiet cmd args >>= \case + Exit.ExitSuccess -> pure $ mkInt 0 + Exit.ExitFailure n -> pure $ mkInt n + entry $ bindMatch "fallback" $ \case [ e, expr ] -> do try @_ @SomeException (eval expr) >>= \case