packages feed

pushme 1.0.0 → 1.0.1

raw patch · 3 files changed

+48/−37 lines, 3 files

Files

Main.hs view
@@ -21,7 +21,7 @@ import           Data.Function ( on ) import           Data.Function.Pointless ( (.:) ) import           Data.List-import qualified Data.Map as M ( fromList, (!) )+import qualified Data.Map as M ( Map, fromList, lookup ) import           Data.Maybe ( fromMaybe, isNothing, isJust, fromJust ) import           Data.Monoid ( Monoid(mconcat), (<>) ) import           Data.Stringable as S ( Stringable(fromString, toString) )@@ -36,7 +36,7 @@ import qualified Distribution.PackageDescription.TH as Pkg import           Filesystem ( isFile, getHomeDirectory ) import           GHC.Conc ( setNumCapabilities, getNumProcessors )-import           Prelude hiding (FilePath)+import           Prelude hiding (FilePath, catch) import           Shelly hiding (find) import           System.Console.CmdArgs import           System.Environment ( getArgs, withArgs )@@ -77,6 +77,7 @@ data PushmeOpts = PushmeOpts { jobs      :: Int                              , dryRun    :: Bool                              , noSync    :: Bool+                             , copyAll   :: Bool                              , loadRevs  :: Bool                              , stores    :: Bool                              , ssh       :: String@@ -96,6 +97,7 @@                       &= help "Don't take any actions"     , noSync    = def &= name "N"                       &= help "Don't even attempt a dry-run sync"+    , copyAll   = def &= help "For git-annex directories, copy all files"     , loadRevs  = def &= name "L"                       &= help "Load latest snapshot revs from disk"     , stores    = def &= help "Show all the stores know to pushme"@@ -212,6 +214,7 @@          PushmeOpts { jobs      = 1                     , dryRun    = True                     , noSync    = True+                    , copyAll   = False                     , loadRevs  = True                     , stores    = False                     , ssh       = ""@@ -428,7 +431,7 @@         patterns     = map regexToGlob                        . filter (`notElem` ["*", "*/", ".*", ".*/"])                        . map stringify . T.lines $ optsText-        patMatch f p = (toString f) =~ (toString p)+        patMatch f p = toString f =~ toString p         files'       =           foldl' (\acc x ->                      if any (patMatch x) patterns@@ -483,7 +486,7 @@                 if storeIsLocal here (info^.infoStore)                 then vrun "ls" ["-1", p']                 else remote vrun u h ["ls", "-1", p']-      if length listing == 0+      if null listing         then return Nothing         else return . Just . last $ listing @@ -658,9 +661,10 @@  createSyncCommands :: Binding -> Sh (Sh [Text], Sh [Text], Sh [Container]) createSyncCommands bnd = do-  src  <- liftIO $ sourcePath bnd-  dst  <- liftIO $ destinationPath bnd-  verb <- getOption verbose+  src   <- liftIO $ sourcePath bnd+  dst   <- liftIO $ destinationPath bnd+  verb  <- getOption verbose+  cpAll <- getOption copyAll    let thisCont    = bnd^.bindingThis.infoContainer       thatCont    = bnd^.bindingThat.infoContainer@@ -676,17 +680,17 @@     (LocalPath (Pathname l), LocalPath (Pathname r)) ->       if thisCont^.containerIsAnnex && thatCont^.containerIsAnnex       then-      return ( (if verb then id else silently) $-               do chdir l $ vrun_ "git-annex" $ ["-q" | not verb]-                    <> ["sync", bnd^.bindingThat.infoHostName]-                  -- chdir r $ vrun_ "git-annex" $ ["-q" | not verb]-                  --   <> ["sync", bnd^.bindingThis.infoHostName]-                  chdir l $ vrun_ "git-annex" $ ["-q" | not verb]-                    <> [ "--auto"-                       | not (bnd^.bindingThat.infoStore.storeIsPrimary) ]-                    <> [ "copy", "--to"-                       , bnd^.bindingThat.infoHostName ]-                  return []+      return ( (if verb then id else silently) $ chdir l $ do+                 vrun_ "git-annex" $ ["-q" | not verb] <> ["add", "."]+                 vrun_ "git-annex" $ ["-q" | not verb]+                       <> ["sync", bnd^.bindingThat.infoHostName]+                 vrun_ "git-annex" $ ["-q" | not verb]+                       <> [ "--auto"+                          | not ((bnd^.bindingThat.infoStore.storeIsPrimary) ||+                                 cpAll) ]+                       <> [ "copy", "--to"+                          , bnd^.bindingThat.infoHostName ]+                 return []              , return []              , updateContainers Nothing bnd )       else@@ -699,20 +703,19 @@       if thisCont^.containerIsAnnex && thatCont^.containerIsAnnex       then       return ( escaping False $ (if verb then id else silently) $-               do chdir l $ vrun_ "git-annex" $ ["-q" | not verb]-                    <> ["sync", bnd^.bindingThat.infoHostName]-                  chdir l $ vrun_ "git-annex" $ ["-q" | not verb]-                    <> [ "--auto"-                       | not (bnd^.bindingThat.infoStore.storeIsPrimary) ]-                    <> [ "copy", "--to"-                       , bnd^.bindingThat.infoHostName]-                  -- remote vrun_ u h-                  --   ["\"cd '" <> toTextIgnore r <> "'; git-annex "-                  --    <> (if verb then "" else "-q") <> " sync "-                  --    <> bnd^.bindingThis.infoHostName <> "\""]-                  noticeL $ format "{}: Git Annex synchronized"-                                   [(bnd^.bindingFileset.filesetName)]-                  return []+               chdir l $ do+                 vrun_ "git-annex" $ ["-q" | not verb] <> ["add", "."]+                 vrun_ "git-annex" $ ["-q" | not verb]+                       <> ["sync", bnd^.bindingThat.infoHostName]+                 vrun_ "git-annex" $ ["-q" | not verb]+                       <> [ "--auto"+                          | not ((bnd^.bindingThat.infoStore.storeIsPrimary)+                                || cpAll) ]+                       <> [ "copy", "--to"+                          , bnd^.bindingThat.infoHostName]+                 noticeL $ format "{}: Git Annex synchronized"+                                  [ bnd^.bindingFileset.filesetName ]+                 return []              , return []              , updateContainers Nothing bnd )       else@@ -889,8 +892,10 @@                                else (x `T.cons` xs, num + 1))                              ("", 0)                    . intToText-    field x stats = read (toString (stats M.! x)) :: Integer +    field :: Text -> M.Map Text Text -> Integer+    field x stats = fromMaybe 0 $ read . toString <$> M.lookup x stats+     doCopy f rsync False False os = f rsync os     doCopy f rsync False True os  = sudo f rsync os     doCopy f rsync True False os  = f rsync (remoteRsync rsync:os)@@ -934,11 +939,13 @@ remote f user host xs = do   sshCmd <- getOption ssh   p <- if null sshCmd-      then which "ssh"-      else return . Just . fromText . T.pack $ sshCmd+      then do sshPath <- which "ssh"+              return (toTextIgnore <$> sshPath)+      else return . Just . T.pack $ sshCmd   case p of     Nothing -> error "Could not find ssh!"-    Just r  -> f r (format "{}@{}" [user, host]:xs)+    Just r  -> let ys = T.words r <> [format "{}@{}" [user, host]] <> xs+               in f (fromText (head ys)) (tail ys)  asRoot :: (FilePath -> [Text] -> Sh a) -> FilePath -> [Text] -> Sh a asRoot f p xs =
README.md view
@@ -16,6 +16,7 @@       'SelfRe': '[Ff]oo'       'ZfsPool': null       'ZfsPath': null+      'IsPrimary': true     - 'Targets':       - - 'foo'         - - 'home'@@ -26,6 +27,7 @@       'SelfRe': '[Bb]ar'       'ZfsPool': null       'ZfsPath': null+      'IsPrimary': false  Then, `~/.pushme/filesets.yml`: @@ -44,6 +46,7 @@       'Recurse': false       'Fileset': 'home'       'PoolPath': null+      'IsAnnex': false       'LastRev': null       'LastSync': null       'Path': '~/'@@ -51,6 +54,7 @@       'Recurse': false       'Fileset': 'local'       'PoolPath': null+      'IsAnnex': false       'LastRev': null       'LastSync': null       'Path': '/usr/local/'
pushme.cabal view
@@ -1,6 +1,6 @@ Name: pushme -Version:  1.0.0+Version:  1.0.1 Synopsis: Script I use for synchronizing my data among machines  Description: Script I use for synchronizing my data among machines.