commit 82cb7d852e77800c94cc577e793a11ef1e8f9d49
parent 3fbf842d50566931c2c340fc8e01d37eb7f251da
Author: mtmn <miro@haravara.org>
Date: Mon, 4 May 2026 23:14:39 +0200
backup: add mobius, rename estri
Diffstat:
| M | backup/backup.hs | | | 92 | +++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------- |
1 file changed, 62 insertions(+), 30 deletions(-)
diff --git a/backup/backup.hs b/backup/backup.hs
@@ -28,7 +28,8 @@ data Config = Config
{ cfgHome :: FilePath
, cfgGitDirs :: Map String FilePath
, cfgGitAnnexDirs :: Map String FilePath
- , cfgS3Dirs :: Map String FilePath
+ , cfgPlakarDirs :: Map String FilePath
+ , cfgMobiusDirs :: Map String FilePath
}
mkConfig :: FilePath -> Config
@@ -44,20 +45,22 @@ mkConfig h =
, ("releases", h <> "/src/haravara.org/releases")
, ("bandcamp", h <> "/misc/music/backlog/_todo")
]
- , cfgGitAnnexDirs =
- Map.fromList
- [ ("notes", h <> "/misc/notes")
- , ("books", h <> "/misc/books")
- , ("docs", h <> "/misc/docs")
- , ("www", h <> "/misc/www")
- ]
- , cfgS3Dirs =
+ , cfgGitAnnexDirs = Map.empty
+ , cfgPlakarDirs =
Map.fromList
[ ("src", h <> "/src")
, ("misc", h <> "/misc")
, ("local", h <> "/.local")
, ("config", h <> "/.config")
]
+ , cfgMobiusDirs =
+ Map.fromList
+ [ ("www", h <> "/misc/www")
+ , ("notes", h <> "/misc/notes")
+ , ("books", h <> "/misc/books")
+ , ("docs", h <> "/misc/docs")
+ , ("mobius", h <> "/misc/mobius")
+ ]
}
-- Logging
@@ -98,6 +101,11 @@ runLoud cmd args = do
(_, _, _, ph) <- createProcess p
waitForProcess ph
+runSilent :: String -> [String] -> IO ExitCode
+runSilent cmd args = do
+ (ec, _, _) <- readProcessWithExitCode cmd args ""
+ return ec
+
requireCmd :: String -> BackupM ()
requireCmd cmd =
liftIO (findExecutable cmd) >>= maybe (throwError $ cmd <> " not found") (const $ return ())
@@ -142,15 +150,18 @@ syncRepos dir push annex = do
unless (ok pushEc) $ throwError $ "Failed to push changes from " <> dir
liftIO $ logMsg $ "Successfully pushed changes from " <> dir
-s3Sync :: Config -> String -> BackupM ()
-s3Sync cfg name = case Map.lookup name (cfgS3Dirs cfg) of
- Nothing -> throwError $ "Unknown S3 target: " <> name
+plakarSync :: Config -> String -> BackupM ()
+plakarSync cfg name = case Map.lookup name (cfgPlakarDirs cfg) of
+ Nothing -> throwError $ "Unknown plakar target: " <> name
Just dir -> do
+ liftIO $ logMsg $ "Syncing plakar/" <> name <> " from " <> dir
ec <-
liftIO $
- runLoud
- "plakar_estri"
- [ "backup"
+ runSilent
+ "plakar"
+ [ "at"
+ , "@estri"
+ , "backup"
, "--ignore"
, "**/.local/share/containers*"
, "--ignore"
@@ -159,7 +170,28 @@ s3Sync cfg name = case Map.lookup name (cfgS3Dirs cfg) of
, "**/mnt*"
, dir
]
- unless (ok ec) $ throwError $ "plakar_estri failed for " <> name
+ unless (ok ec) $ throwError $ "plakar failed for " <> name
+ liftIO $ logMsg $ "Done plakar/" <> name
+
+mobiusSync :: Config -> String -> BackupM ()
+mobiusSync cfg name = case Map.lookup name (cfgMobiusDirs cfg) of
+ Nothing -> throwError $ "Unknown mobius target: " <> name
+ Just dir -> do
+ liftIO $ logMsg $ "Syncing mobius/" <> name <> " from " <> dir
+ ec <-
+ liftIO $
+ runSilent
+ "aws"
+ [ "s3"
+ , "sync"
+ , "--exclude"
+ , "*/.git/*"
+ , "--no-follow-symlinks"
+ , dir
+ , "s3://mobius/" <> name
+ ]
+ unless (ok ec) $ throwError $ "aws s3 sync failed for " <> name
+ liftIO $ logMsg $ "Done mobius/" <> name
backup :: Config -> String -> Bool -> BackupM ()
backup cfg btype push = case btype of
@@ -183,19 +215,16 @@ backup cfg btype push = case btype of
mapM_ (\k -> putStrLn $ " " <> k) . sort . Map.keys $ cfgGitDirs cfg
putStrLn "git-annex"
mapM_ (\k -> putStrLn $ " " <> k) . sort . Map.keys $ cfgGitAnnexDirs cfg
- putStrLn "estri"
- mapM_ (\k -> putStrLn $ " " <> k) . sort . Map.keys $ cfgS3Dirs cfg
- "histdb" -> do
- requireCmd "histdb-sync"
- liftIO $ logMsg "Running histdb-sync"
- ec <- liftIO $ runLoud "histdb-sync" []
- unless (ok ec) $ throwError "histdb-sync failed"
+ putStrLn "plakar"
+ mapM_ (\k -> putStrLn $ " " <> k) . sort . Map.keys $ cfgPlakarDirs cfg
+ putStrLn "mobius"
+ mapM_ (\k -> putStrLn $ " " <> k) . sort . Map.keys $ cfgMobiusDirs cfg
"local" -> do
requireCmd "plakar"
liftIO $ logMsg "Running plakar"
ec <-
liftIO $
- runLoud
+ runSilent
"plakar"
[ "at"
, "@hoo"
@@ -209,16 +238,19 @@ backup cfg btype push = case btype of
, cfgHome cfg
]
unless (ok ec) $ throwError "plakar local backup failed"
+ liftIO $ logMsg "Done plakar local"
t
- | t `elem` ["estri", "s3"] ->
- forM_ (Map.keys (cfgS3Dirs cfg)) $ s3Sync cfg
+ | t == "plakar" ->
+ forM_ (Map.keys (cfgPlakarDirs cfg)) $ plakarSync cfg
+ | t == "mobius" ->
+ forM_ (Map.keys (cfgMobiusDirs cfg)) $ mobiusSync cfg
_ -> case ( Map.lookup btype (cfgGitDirs cfg)
, Map.lookup btype (cfgGitAnnexDirs cfg)
- , Map.lookup btype (cfgS3Dirs cfg)
+ , Map.lookup btype (cfgPlakarDirs cfg)
) of
(Just dir, _, _) -> syncRepos dir push False
(_, Just dir, _) -> syncRepos dir push True
- (_, _, Just _) -> s3Sync cfg btype
+ (_, _, Just _) -> plakarSync cfg btype
_ -> throwError $ "Unknown backup type '" <> btype <> "'"
showUsage :: IO ()
@@ -231,11 +263,11 @@ showUsage = do
, "Backup types:"
, " push - Backup and push everything"
, " ls - List available backup types"
- , " histdb - Sync using histdb-sync"
, " git - Sync all git repos"
, " annex - Sync all git-annex repos"
, " local - Sync using plakar"
- , " estri - Sync to S3"
+ , " plakar - Sync using plakar"
+ , " mobius - Sync to mobius bucket"
, " <name> - Backup specific item"
, ""
, "Options:"
