commit ac9d608a2ce57e13fd4e43ee82f4b59f144c718b
parent 58e44f1e772628c10b2528a110e96c44597266df
Author: mtmn <miro@haravara.org>
Date: Sat, 9 May 2026 22:18:06 +0200
backup: remove annex, shadow backups guard
Diffstat:
4 files changed, 139 insertions(+), 154 deletions(-)
diff --git a/README.md b/README.md
@@ -5,7 +5,7 @@ Various tools I have been using throughout the years.
| tool | description |
|---|---|
| [aaltomuoto](aaltomuoto/) | frequency-colored audio waveform generator |
-| [backup](backup/) | backup orchestrator — git, plakar, S3 |
+| [backup](backup/) | terminal backup orchestrator |
| [bandeno](bandeno/) | Bandcamp JSON Feed proxy |
| [diffamer](diffamer/) | line-file syncer with rsync and coloured diff |
| [diggah](diggah/) | find files modified within a time range, locally or over SSH |
diff --git a/backup/README.md b/backup/README.md
@@ -11,25 +11,23 @@ cabal build
## Usage
```sh
-backup <type> [--push]
+backup [-t <target>] [--push] [--quiet] [--list]
```
-### Types
+### Targets
-| Type | Description |
-|------|-------------|
-| `push` | Commit and push all git repos |
+| Target | Description |
+|--------|-------------|
| `git` | Commit all git repos (push with `--push`) |
-| `annex` | Sync all git-annex repos |
-| `local` | Snapshot `$HOME` to the local plakar store |
-| `plakar` | Snapshot all configured directories to the remote plakar store |
-| `mobius` | Sync all configured directories to S3 |
-| `ls` | List all configured backup targets |
-| `<name>` | Run backup for a specific named target |
+| `plakar` | Snapshot to both plakar repos (`s3` and `hoo`) |
+| `mobius` | Sync all mobius targets to S3 |
+| `<backend>:<name>[:<sub>]` | Run a single target, e.g. `git:nix`, `plakar:s3`, `plakar:hoo`, `plakar:s3:src`, `mobius:www` |
### Options
| Flag | Description |
|------|-------------|
-| `--push` | Push after committing (for git targets) |
+| `-p`, `--push` | Push after committing (for git targets) |
+| `-q`, `--quiet` | Suppress command output (default: stream output) |
+| `-l`, `--list` | List all configured backup targets and exit |
| `-h`, `--help` | Show help |
diff --git a/backup/backup.cabal b/backup/backup.cabal
@@ -1,4 +1,4 @@
-cabal-version: 3.16
+cabal-version: 3.0
name: backup
version: 0.1.0
build-type: Simple
diff --git a/backup/backup.hs b/backup/backup.hs
@@ -6,12 +6,12 @@ import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)
+import System.Environment (getArgs, withArgs)
import Turtle hiding (sort)
data Config = Config
{ cfgHome :: Text
, cfgGitDirs :: Map Text Text
- , cfgGitAnnexDirs :: Map Text Text
, cfgPlakarDirs :: Map Text Text
, cfgMobiusDirs :: Map Text Text
}
@@ -29,7 +29,6 @@ mkConfig h =
, ("releases", h <> "/src/haravara.org/releases")
, ("bandcamp", h <> "/misc/music/backlog/_todo")
]
- , cfgGitAnnexDirs = Map.empty
, cfgPlakarDirs =
Map.fromList
[ ("src", h <> "/src")
@@ -50,7 +49,9 @@ mkConfig h =
-- Logging
ts :: IO Text
-ts = T.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%z" <$> getCurrentTime
+ts =
+ T.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%z"
+ <$> getCurrentTime
logMsg :: Text -> IO ()
logMsg msg = ts >>= \t -> echo (unsafeTextToLine $ "[" <> t <> "]: " <> msg)
@@ -63,169 +64,155 @@ fatal msg = do
-- Process helpers
+run :: Bool -> Text -> [Text] -> IO ExitCode
+run verbose cmd args
+ | verbose = proc cmd args stdin
+ | otherwise = fst <$> procStrict cmd args empty
+
gitPrefix :: Text -> [Text]
gitPrefix dir = ["--git-dir=" <> dir <> "/.git", "--work-tree=" <> dir]
-gitSilent :: Text -> [Text] -> IO ExitCode
-gitSilent dir args = fst <$> procStrict "git" (gitPrefix dir <> args) empty
+git :: Bool -> Text -> [Text] -> IO ExitCode
+git verbose dir args = run verbose "git" (gitPrefix dir <> args)
gitCapture :: Text -> [Text] -> IO (ExitCode, Text)
gitCapture dir args = procStrict "git" (gitPrefix dir <> args) empty
-gitLoud :: Text -> [Text] -> IO ExitCode
-gitLoud dir args = proc "git" (gitPrefix dir <> args) stdin
-
-runSilent :: Text -> [Text] -> IO ExitCode
-runSilent cmd args = fst <$> procStrict cmd args empty
-
-requireCmd :: Text -> IO ()
-requireCmd cmd =
- which (T.unpack cmd) >>= maybe (fatal $ cmd <> " not found") (const $ return ())
-
ok :: ExitCode -> Bool
ok = (== ExitSuccess)
+expect :: Text -> ExitCode -> IO ()
+expect msg ec = unless (ok ec) $ fatal msg
+
-- Core logic
-syncRepos :: Text -> Bool -> Bool -> IO ()
-syncRepos dir push annex = do
- stageEc <- gitSilent dir $ if annex then ["annex", "add", "."] else ["add", "-A"]
- unless (ok stageEc) $ fatal $ "Failed to stage changes in " <> dir
+syncRepos :: Text -> Bool -> IO ()
+syncRepos dir push = do
+ git False dir ["add", "-A"]
+ >>= expect ("Failed to stage changes in " <> dir)
- diffEc <- gitSilent dir ["diff", "--cached", "--quiet"]
+ diffEc <- git False dir ["diff", "--cached", "--quiet"]
if ok diffEc
then logMsg $ "Nothing to commit in " <> dir
else do
- (_, changed) <- gitCapture dir ["diff", "--cached", "--name-only"]
- commitEc <- gitLoud dir ["commit", "-m", T.unwords . T.lines $ changed]
- unless (ok commitEc) $ fatal $ "Failed to commit changes in " <> dir
+ (changedEc, changed) <-
+ gitCapture dir ["diff", "--cached", "--name-only"]
+ expect ("Failed to list staged changes in " <> dir) changedEc
+ git True dir ["commit", "-m", T.unwords . T.lines $ changed]
+ >>= expect ("Failed to commit changes in " <> dir)
logMsg $ "Committed changes in " <> dir
- when push $
- if annex
- then do
- logMsg $ "Syncing annex in " <> dir
- syncEc <- gitLoud dir ["annex", "sync", "--content"]
- unless (ok syncEc) $ fatal $ "Failed to sync annex in " <> dir
- logMsg $ "Successfully synced annex in " <> dir
- else do
- logMsg $ "Pushing changes from " <> dir
- pushEc <- gitLoud dir ["push"]
- unless (ok pushEc) $ fatal $ "Failed to push changes from " <> dir
- logMsg $ "Successfully pushed changes from " <> dir
-
-plakarSync :: Config -> Text -> IO ()
-plakarSync cfg name = case Map.lookup name (cfgPlakarDirs cfg) of
- Nothing -> fatal $ "Unknown plakar target: " <> name
- Just dir -> do
- logMsg $ "Syncing plakar/" <> name <> " from " <> dir
- ec <-
- runSilent
- "plakar"
- [ "at"
- , "@estri"
- , "backup"
- , "--ignore"
- , "**/.local/share/containers*"
- , "--ignore"
- , "**/Steam*"
- , "--ignore"
- , "**/mnt*"
- , "--ignore"
- , "**/.git*"
- , dir
- ]
- unless (ok ec) $ fatal $ "plakar failed for " <> name
- logMsg $ "Done plakar/" <> name
-
-mobiusSync :: Config -> Text -> IO ()
-mobiusSync cfg name = case Map.lookup name (cfgMobiusDirs cfg) of
- Nothing -> fatal $ "Unknown mobius target: " <> name
- Just dir -> do
- logMsg $ "Syncing mobius/" <> name <> " from " <> dir
- ec <-
- runSilent
- "aws"
- [ "s3"
- , "sync"
- , "--exclude"
- , "*/.git/*"
- , "--no-follow-symlinks"
- , dir
- , "s3://mobius/" <> name
- ]
- unless (ok ec) $ fatal $ "aws s3 sync failed for " <> name
- logMsg $ "Done mobius/" <> name
-
-backup :: Config -> Text -> Bool -> IO ()
-backup cfg btype push = case btype of
- "push" -> do
+ when push $ do
+ logMsg $ "Pushing changes from " <> dir
+ git True dir ["push"] >>= expect ("Failed to push changes from " <> dir)
+ logMsg $ "Done pushing " <> dir
+
+runPlakar :: Bool -> Text -> [Text] -> Text -> IO ExitCode
+runPlakar verbose repo ignores dir =
+ run verbose "plakar" $
+ ["at", repo, "backup"]
+ <> concatMap (\p -> ["--ignore", p]) ignores
+ <> [dir]
+
+s3Ignores :: [Text]
+s3Ignores = ["**/.local/share/containers*", "**/Steam*", "**/mnt*", "**/.git*"]
+
+hooIgnores :: [Text]
+hooIgnores = ["**/.cache*", "**/Steam*", "**/mnt*", "**/.git*"]
+
+plakarS3 :: Bool -> Text -> Text -> IO ()
+plakarS3 verbose name dir = do
+ logMsg $ "Syncing plakar/s3/" <> name <> " from " <> dir
+ runPlakar verbose "@estri" s3Ignores dir
+ >>= expect ("plakar @s3 failed for " <> name)
+ logMsg $ "Done plakar/s3/" <> name
+
+plakarHoo :: Bool -> Text -> IO ()
+plakarHoo verbose dir = do
+ logMsg $ "Syncing plakar/hoo from " <> dir
+ runPlakar verbose "@hoo" hooIgnores dir
+ >>= expect "plakar @hoo failed"
+ logMsg "Done plakar/hoo"
+
+mobiusFilters :: Text -> [Text]
+mobiusFilters "www" =
+ ["--exclude", "*", "--include", "*.html", "--include", "*.md"]
+mobiusFilters _ = ["--exclude", "*/.git/*"]
+
+mobiusSync :: Bool -> Text -> Text -> IO ()
+mobiusSync verbose name dir = do
+ logMsg $ "Syncing mobius/" <> name <> " from " <> dir
+ let args =
+ ["s3", "sync"]
+ <> mobiusFilters name
+ <> ["--no-follow-symlinks", dir, "s3://mobius/" <> name]
+ run verbose "aws" args
+ >>= expect ("aws s3 sync failed for " <> name)
+ logMsg $ "Done mobius/" <> name
+
+listTargets :: Config -> IO ()
+listTargets cfg = do
+ let listKeys indent =
+ mapM_ (echo . unsafeTextToLine . (indent <>)) . sort . Map.keys
+ echo "git"
+ listKeys " " (cfgGitDirs cfg)
+ echo "plakar"
+ echo " hoo"
+ echo " s3"
+ listKeys " " (cfgPlakarDirs cfg)
+ echo "mobius"
+ listKeys " " (cfgMobiusDirs cfg)
+
+backup :: Config -> Text -> Bool -> Bool -> IO ()
+backup cfg target push verbose = case T.splitOn ":" target of
+ ["git"] ->
forM_ (Map.toList (cfgGitDirs cfg)) $ \(name, dir) ->
- logMsg name >> syncRepos dir True False
- forM_ (Map.toList (cfgGitAnnexDirs cfg)) $ \(name, dir) ->
- logMsg (name <> " (annex)") >> syncRepos dir True True
- "git" ->
- forM_ (Map.toList (cfgGitDirs cfg)) $ \(name, dir) ->
- logMsg name >> syncRepos dir push False
- "annex" ->
- forM_ (Map.toList (cfgGitAnnexDirs cfg)) $ \(name, dir) ->
- logMsg (name <> " (annex)") >> syncRepos dir push True
- "ls" -> do
- echo "git"
- mapM_ (echo . unsafeTextToLine . (" " <>)) . sort . Map.keys $ cfgGitDirs cfg
- echo "git-annex"
- mapM_ (echo . unsafeTextToLine . (" " <>)) . sort . Map.keys $ cfgGitAnnexDirs cfg
- echo "plakar"
- mapM_ (echo . unsafeTextToLine . (" " <>)) . sort . Map.keys $ cfgPlakarDirs cfg
- echo "mobius"
- mapM_ (echo . unsafeTextToLine . (" " <>)) . sort . Map.keys $ cfgMobiusDirs cfg
- "local" -> do
- requireCmd "plakar"
- logMsg "Running plakar"
- ec <-
- runSilent
- "plakar"
- [ "at"
- , "@hoo"
- , "backup"
- , "--ignore"
- , "**/.cache*"
- , "--ignore"
- , "**/Steam*"
- , "--ignore"
- , "**/mnt*"
- , "--ignore"
- , "**/.git*"
- , cfgHome cfg
- ]
- unless (ok ec) $ fatal "plakar local backup failed"
- logMsg "Done plakar local"
- "plakar" ->
- forM_ (Map.keys (cfgPlakarDirs cfg)) $ plakarSync cfg
- "mobius" ->
- forM_ (Map.keys (cfgMobiusDirs cfg)) $ mobiusSync cfg
- _ -> case ( Map.lookup btype (cfgGitDirs cfg)
- , Map.lookup btype (cfgGitAnnexDirs cfg)
- , Map.lookup btype (cfgPlakarDirs cfg)
- ) of
- (Just dir, _, _) -> syncRepos dir push False
- (_, Just dir, _) -> syncRepos dir push True
- (_, _, Just _) -> plakarSync cfg btype
- _ -> fatal $ "Unknown backup type '" <> btype <> "'"
+ logMsg name >> syncRepos dir push
+ ["plakar"] -> do
+ forM_ (Map.toList (cfgPlakarDirs cfg)) $ uncurry (plakarS3 verbose)
+ plakarHoo verbose (cfgHome cfg)
+ ["mobius"] ->
+ forM_ (Map.toList (cfgMobiusDirs cfg)) $ uncurry (mobiusSync verbose)
+ ["git", name] -> case Map.lookup name (cfgGitDirs cfg) of
+ Just dir -> syncRepos dir push
+ Nothing -> fatal $ "Unknown git target: " <> name
+ ["plakar", "s3"] ->
+ forM_ (Map.toList (cfgPlakarDirs cfg)) $ uncurry (plakarS3 verbose)
+ ["plakar", "hoo"] -> plakarHoo verbose (cfgHome cfg)
+ ["plakar", "s3", name] -> case Map.lookup name (cfgPlakarDirs cfg) of
+ Just dir -> plakarS3 verbose name dir
+ Nothing -> fatal $ "Unknown plakar/s3 dir: " <> name
+ ["mobius", name] -> case Map.lookup name (cfgMobiusDirs cfg) of
+ Just dir -> mobiusSync verbose name dir
+ Nothing -> fatal $ "Unknown mobius target: " <> name
+ _ -> fatal $ "Unknown target: " <> target
data Args = Args
- { argBackupType :: Text
+ { argTarget :: Maybe Text
, argPush :: Bool
+ , argQuiet :: Bool
+ , argList :: Bool
}
argsParser :: Parser Args
argsParser =
- Args
- <$> argText "backup_type" "Type of backup (push, ls, git, annex, local, plakar, mobius, <name>)"
- <*> switch "push" 'p' "Push changes after commit (for Git items)"
+ let targetHelp = "git, plakar, mobius, <backend>:<name>[:<sub>]"
+ in Args
+ <$> optional (optText "target" 't' targetHelp)
+ <*> switch "push" 'p' "Push changes after commit"
+ <*> switch "quiet" 'q' "Suppress command output"
+ <*> switch "list" 'l' "List all configured backup targets"
main :: IO ()
main = do
- Args btype pushFlag <- options "Backup manager" argsParser
- h <- need "HOME" >>= maybe (die "HOME not set") return
- backup (mkConfig h) btype pushFlag
+ rawArgs <- getArgs
+ let effArgs = if null rawArgs then ["--help"] else rawArgs
+ Args mtarget pushFlag quietFlag listFlag <-
+ withArgs effArgs $ options "" argsParser
+ h <- need "HOME" >>= maybe (fatal "HOME not set") pure
+ let cfg = mkConfig h
+ if listFlag
+ then listTargets cfg
+ else case mtarget of
+ Just target -> backup cfg target pushFlag (not quietFlag)
+ Nothing -> fatal "no target given (use --list to list targets)"
