use a remote server
This commit is contained in:
parent
3e04fe10bf
commit
9a80c28b24
@ -1,7 +1,7 @@
|
|||||||
#!/usr/bin/env nix-script
|
#!/usr/bin/env nix-script
|
||||||
#!>haskell
|
#!>haskell
|
||||||
#! shell | bup git
|
#! shell | bup git
|
||||||
#! env | BUP_DIR
|
#! env | BUP_DIR BUP_SRV
|
||||||
#! haskell | shell-conduit filepath
|
#! haskell | shell-conduit filepath
|
||||||
|
|
||||||
import Data.List (intersperse)
|
import Data.List (intersperse)
|
||||||
@ -9,6 +9,7 @@ import Data.Conduit.Shell
|
|||||||
import Data.Conduit.Shell.Segments (strings)
|
import Data.Conduit.Shell.Segments (strings)
|
||||||
import Data.Conduit.Shell.Variadic (variadicProcess)
|
import Data.Conduit.Shell.Variadic (variadicProcess)
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
import System.Environment (lookupEnv)
|
||||||
|
|
||||||
|
|
||||||
-- | regexs for excluded files
|
-- | regexs for excluded files
|
||||||
@ -21,25 +22,28 @@ excluded = intersperse "--exclude-rx"
|
|||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = run $ mapM_ backup =<< strings (bup "ls")
|
main = do
|
||||||
|
var <- lookupEnv "BUP_SRV"
|
||||||
|
case var of
|
||||||
|
Nothing -> run (echo "set the BUP_SRV variable to hostname:path")
|
||||||
|
Just server -> run $
|
||||||
|
mapM_ (backup server) =<< strings (bup "ls" "-r" server)
|
||||||
|
|
||||||
|
|
||||||
-- | Finds the path of a backup
|
findPath :: String -> String -> Segment FilePath
|
||||||
findPath :: String -> Segment FilePath
|
findPath server path = do
|
||||||
findPath path = do
|
files <- strings (bup "ls" "-A" "-r" server path)
|
||||||
files <- strings (bup "ls" "-A" path)
|
if length files /= 1
|
||||||
if length files == 1
|
then return ("/" </> final path)
|
||||||
then findPath (path </> head files)
|
else findPath server (path </> head files)
|
||||||
else return $ "/" </> final path
|
|
||||||
where final = concat . drop 2 . splitPath
|
where final = concat . drop 2 . splitPath
|
||||||
|
|
||||||
|
|
||||||
-- | Runs the backup
|
backup :: String -> String -> Segment ()
|
||||||
backup :: String -> Segment ()
|
backup server name = do
|
||||||
backup name = do
|
path <- findPath server (name </> "latest")
|
||||||
path <- findPath (name </> "latest")
|
|
||||||
proc "bup" ("index" : path : "--exclude-rx" : excluded)
|
proc "bup" ("index" : path : "--exclude-rx" : excluded)
|
||||||
bup "save" "-n" name path
|
bup "save" "-r" server "-n" name path
|
||||||
|
|
||||||
|
|
||||||
-- | Fix for missing execs on NixOS
|
-- | Fix for missing execs on NixOS
|
||||||
|
Loading…
Reference in New Issue
Block a user