use a remote server

This commit is contained in:
Michele Guerini Rocco 2019-08-08 22:25:57 +02:00
parent 3e04fe10bf
commit 9a80c28b24
Signed by: rnhmjoj
GPG Key ID: BFBAF4C975F76450

View File

@ -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