pushme 2.1.1 → 2.1.3
raw patch · 3 files changed
+165/−41 lines, 3 filesdep ~shellydep ~temporary
Dependency ranges changed: shelly, temporary
Files
- Main.hs +51/−34
- Pushme/Options.hs +108/−0
- pushme.cabal +6/−7
Main.hs view
@@ -57,6 +57,7 @@ , _rsyncName :: Maybe Text , _rsyncFilters :: [Text] , _rsyncReportMissing :: Bool+ , _rsyncNoLinks :: Bool , _rsyncSendOnly :: Bool , _rsyncReceiveOnly :: Bool , _rsyncReceiveFrom :: Maybe [Text]@@ -64,7 +65,7 @@ deriving (Show, Eq) defaultRsync :: FilePath -> Rsync-defaultRsync p = Rsync p Nothing [] False False False Nothing+defaultRsync p = Rsync p Nothing [] False False False False Nothing instance FromJSON FilePath where parseJSON = fmap fromText . parseJSON@@ -75,6 +76,7 @@ <*> v .:? "Host" <*> v .:? "Filters" .!= [] <*> v .:? "ReportMissing" .!= False+ <*> v .:? "NoLinks" .!= False <*> v .:? "SendOnly" .!= False <*> v .:? "ReceiveOnly" .!= False <*> v .:? "ReceiveFrom" .!= Nothing@@ -181,6 +183,12 @@ fs' & stores.traverse.rsyncScheme.rsyncFilters <>~ fromJSON' xs k fs' "ReportMissing" xs = fs' & stores.traverse.rsyncScheme.rsyncReportMissing &&~ fromJSON' xs+ k fs' "NoLinks" xs =+ fs' & stores.traverse.rsyncScheme.rsyncNoLinks &&~ fromJSON' xs+ k fs' "SendOnly" xs =+ fs' & stores.traverse.rsyncScheme.rsyncSendOnly &&~ fromJSON' xs+ k fs' "ReceiveOnly" xs =+ fs' & stores.traverse.rsyncScheme.rsyncReceiveOnly &&~ fromJSON' xs k fs' "ReceiveFrom" xs = fs' & stores.traverse.rsyncScheme.rsyncReceiveFrom <>~ fromJSON' xs k fs' _ _ = fs'@@ -266,12 +274,12 @@ setLogLevel $ if verbose opts then LevelDebug else LevelInfo setLogTimeFormat "%H:%M:%S" - hosts <- readHostsFile+ hosts <- readHostsFile opts processBindings opts hosts `finally` stopGlobalPool -readHostsFile :: IO (Map Text Host)-readHostsFile = do- hostsFile <- getHomePath (".pushme" </> "hosts")+readHostsFile :: Options -> IO (Map Text Host)+readHostsFile opts = do+ hostsFile <- expandPath (decodeString (configDir opts) </> "hosts") exists <- isFile hostsFile if exists then do@@ -292,13 +300,15 @@ filter (`notElem` [".", "..", ".DS_Store", ".localized"]) names forM_ properNames $ \name -> yield (topPath </> name) -readFilesets :: IO (Map Text Fileset)-readFilesets = do- confD <- getHomePath (".pushme" </> "conf.d")+readFilesets :: Options -> IO (Map Text Fileset)+readFilesets opts = do+ confD <- expandPath (decodeString (configDir opts) </> "conf.d") exists <- isDirectory confD unless exists $ errorL $ "Please define filesets, "- <> "using files named ~/.pushme/conf.d/<name>.yml"+ <> "using files named "+ <> T.pack (encodeString (decodeString (configDir opts)+ </> "conf.d" </> "<name>.yml")) fmap (M.fromList . map ((^.fsName) &&& id)) $ P.toListM@@ -315,7 +325,7 @@ processBindings :: Options -> Map Text Host -> IO () processBindings opts hosts = do- fsets <- readFilesets+ fsets <- readFilesets opts thisHost <- T.init <$> shelly (silently $ cmd "hostname") let dflt = defaultHost (pack (fromName opts)) here = case dflt of@@ -413,9 +423,9 @@ checkDirectory :: Binding -> FilePath -> Bool -> App Bool checkDirectory _ path False = test_d path checkDirectory (isLocal -> True) path True = test_d path-checkDirectory _bnd _path True = return True -- do- -- execute (env bnd) "test" ["-d", toTextIgnore path]- -- (== 0) <$> lastExitCode+checkDirectory bnd path True = do+ execute_ (env bnd) "test" ["-d", escape (toTextIgnore path)]+ (== 0) <$> lastExitCode getStorePath :: Binding -> Store -> Bool -> Maybe FilePath getStorePath bnd s wantTarget@@ -576,7 +586,8 @@ ] else do let rfs = (srcRsync^.rsyncFilters) <> (destRsync^.rsyncFilters)- go xs = doRsync (fs^.fsName) xs (toTextIgnore src) dest+ nol = (srcRsync^.rsyncNoLinks) || (destRsync^.rsyncNoLinks)+ go xs = doRsync (fs^.fsName) xs (toTextIgnore src) dest nol case rfs of [] -> go [] @@ -622,8 +633,8 @@ . T.replace "?" "." . T.replace "." "\\." -doRsync :: Text -> [Text] -> Text -> Text -> App ()-doRsync label options src dest = do+doRsync :: Text -> [Text] -> Text -> Text -> Bool -> App ()+doRsync label options src dest noLinks = do opts <- ask let den = (\x -> if x then 1000 else 1024) $ siUnits opts sshCmd = ssh opts@@ -657,6 +668,7 @@ then ["--rsh", pack sshCmd] else []) <> ["-n" | dryRun opts]+ <> ["--no-links" | noLinks] <> ["--checksum" | checksum opts] <> (if verbose opts then ["-P"] else ["--stats"]) <> [pack ("--rsync-path=sudo " ++ if not (null rsyncCmd)@@ -713,21 +725,21 @@ Normal -> (cmdName, args) Sudo -> ("sudo", toTextIgnore cmdName:args) SudoAsRoot -> sudoAsRoot cmdName args- (modifier, name'', args'')= case exeRemote of++ (modifier, name'', args'') = case exeRemote of Nothing -> (id, name', args')- Just h ->- remote opts h $ case exeCwd of- Nothing -> (id, name', args')- Just cwd ->- (escaping False, fromText $ T.concat $- [ "\"cd "- , escape (toTextIgnore cwd)- , "; "- , escape (toTextIgnore name')- , " "- ]- <> intersperse " " (map escape args')- <> ["\""], [])+ Just h -> remote opts h $ case exeCwd of+ Nothing -> (id, name', args')+ Just cwd ->+ (escaping False, fromText $ T.concat $+ [ "\"cd "+ , escape (toTextIgnore cwd)+ , "; "+ , escape (toTextIgnore name')+ , " "+ ]+ <> intersperse " " (map escape args')+ <> ["\""], []) runner p xs | exeDiscard = run_ p xs >> return "" | otherwise = run p xs@@ -738,9 +750,13 @@ if dryRun opts || noSync opts then return "" else do- n <- findCmd name''+ let (sshCmd:sshArgs) = words (encodeString name'')+ n <- findCmd (decodeString sshCmd) liftIO $ debug' $ format "{} {}"- [ toTextIgnore n, T.intercalate " " (map tshow args'') ]+ [ toTextIgnore n+ , T.intercalate " "+ (map tshow (map T.pack sshArgs ++ args''))+ ] runner' n args'' where findCmd n@@ -770,8 +786,9 @@ execute_ :: ExeEnv -> FilePath -> [Text] -> App () execute_ env' fp args = void $ execute env' { exeDiscard = True } fp args -getHomePath :: FilePath -> IO FilePath-getHomePath p = (</> p) <$> getHomeDirectory+expandPath :: FilePath -> IO FilePath+expandPath (encodeString -> '~':'/':p) = (</> decodeString p) <$> getHomeDirectory+expandPath p = return p asDirectory :: FilePath -> FilePath asDirectory (toTextIgnore -> fp) =
+ Pushme/Options.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Pushme.Options where++import Data.Data (Data)+import Data.Monoid+import Data.Typeable (Typeable)+import Options.Applicative hiding (Success, (&))++version :: String+version = "2.0.0.1"++copyright :: String+copyright = "2013-4"++pushmeSummary :: String+pushmeSummary =+ "pushme " ++ version ++ ", (C) " ++ copyright ++ " John Wiegley"++data Options = Options+ { jobs :: Int+ , dryRun :: Bool+ , noSync :: Bool+ , copyAll :: Bool+ , dump :: Bool+ , ssh :: String+ , rsyncOpt :: String+ , checksum :: Bool+ , fromName :: String+ , configDir :: String+ , filesets :: String+ , classes :: String+ , siUnits :: Bool+ , verbose :: Bool+ , quiet :: Bool+ , cliArgs :: [String]+ }+ deriving (Data, Typeable, Show, Eq)++pushmeOpts :: Parser Options+pushmeOpts = Options+ <$> option auto+ ( short 'j'+ <> long "jobs"+ <> value 1+ <> help "Run INT concurrent finds at once (default: 1)")+ <*> switch+ ( short 'n'+ <> long "dry-run"+ <> help "Don't take any actions")+ <*> switch+ ( short 'N'+ <> long "no-sync"+ <> help "Don't even attempt a dry-run sync")+ <*> switch+ ( long "copy-all"+ <> help "For git-annex directories, copy all files")+ <*> switch+ ( long "dump"+ <> help "Show all the stores that would be synced")+ <*> strOption+ ( long "ssh"+ <> value ""+ <> help "Use a specific ssh command")+ <*> strOption+ ( long "rsync"+ <> value ""+ <> help "Use a specific rsync command")+ <*> switch+ ( long "checksum"+ <> help "Pass --checksum flag to rsync")+ <*> strOption+ ( long "from"+ <> value ""+ <> help "Provide the name of the current host")+ <*> strOption+ ( long "config"+ <> value "~/.pushme"+ <> help "Directory containing configuration files (def: ~/.pushme)")+ <*> strOption+ ( short 'f'+ <> long "filesets"+ <> value ""+ <> help "Synchronize the given fileset(s) (comma-sep)")+ <*> strOption+ ( short 'c'+ <> long "classes"+ <> value ""+ <> help "Filesets classes to synchronize (comma-sep)")+ <*> switch+ ( long "si"+ <> help "Use 1000 instead of 1024 to divide")+ <*> switch+ ( short 'v'+ <> long "verbose"+ <> help "Report progress verbosely")+ <*> switch+ ( short 'q'+ <> long "quiet"+ <> help "Be a little quieter")+ <*> many (argument (eitherReader Right) (metavar "ARGS"))+ -- <*> many (argument Just (metavar "ARGS"))++optionsDefinition = info+ (helper <*> pushmeOpts)+ (fullDesc <> progDesc "" <> header pushmeSummary)++getOptions = execParser optionsDefinition
pushme.cabal view
@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.21.2.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 4dd172a5ea6fa754c4e33bf4e491f4cb405e6b9770e2bc094176b875b320957d+-- hash: abf40cc11ead58c2c28cd6cc91c5b6a82de8e5bdc28651c2f416b9da9fb8b397 name: pushme-version: 2.1.1+version: 2.1.3 synopsis: Tool to synchronize directories with rsync, zfs or git-annex description: Script I use for synchronizing data among machines. category: System@@ -17,7 +17,6 @@ license-file: LICENSE build-type: Simple cabal-version: >= 1.10- extra-source-files: README.md @@ -28,7 +27,7 @@ executable pushme main-is: Main.hs other-modules:- Paths_pushme+ Pushme.Options ghc-options: -threaded build-depends: aeson@@ -49,10 +48,10 @@ , pipes-text , regex-posix >=0.95 && <1.0 , safe >=0.3 && <0.4- , shelly >=1.6 && <1.8+ , shelly >=1.6 && <2.0 , system-fileio >=0.3 && <0.4 , system-filepath >=0.4 && <0.5- , temporary >=1.2 && <1.3+ , temporary >=1.2 && <2.0 , text >=1.2 && <1.3 , text-format >=0.3 && <0.4 , time >=1.4 && <2.0