diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +The MIT License (MIT) + +Copyright (c) 2015 Emin Karayel + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/main/hs/Main.hs b/src/main/hs/Main.hs new file mode 100644 --- /dev/null +++ b/src/main/hs/Main.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +import System.Environment +import System.Process +import System.IO +import System.IO.Error +import System.Console.GetOpt +import Paths_sync_mht (version) +import Data.List +import Data.Version (showVersion) + +import Sync.MerkleTree.CommTypes +import Sync.MerkleTree.Sync + +data SyncOptions + = SyncOptions + { so_source :: Maybe FilePath + , so_destination :: Maybe FilePath + , so_remote :: Maybe String + , so_ignore :: [FilePath] + , so_add :: Bool + , so_update :: Bool + , so_delete :: Bool + , so_help :: Bool + , so_nonOptions :: [String] + } + +defaultSyncOptions :: SyncOptions +defaultSyncOptions = + SyncOptions + { so_source = Nothing + , so_destination = Nothing + , so_remote = Nothing + , so_ignore = [] + , so_add = False + , so_update = False + , so_delete = False + , so_help = False + , so_nonOptions = [] + } + + +toClientServerOptions :: SyncOptions -> ClientServerOptions +toClientServerOptions so = + ClientServerOptions + { cs_add = so_add so + , cs_update = so_update so + , cs_delete = so_delete so + , cs_ignore = so_ignore so + } + +optDescriptions :: [OptDescr (SyncOptions -> SyncOptions)] +optDescriptions = + [ Option ['s'] ["source"] (ReqArg (\fp so -> so { so_source = Just fp }) "DIR") + "directory to copy files from (source) (this option is required)" + , Option ['d'] ["destination"] (ReqArg (\fp so -> so { so_destination = Just fp }) "DIR") + "directory to copy files to (destination) (this option is required)" + , Option ['r'] ["remote-shell"] (ReqArg (\s so -> so { so_remote = Just s }) "CMD") + "synchroize with a remote-site using a remote command execution tool (like ssh or docker)" + , Option ['i'] ["ignore"] (ReqArg (\fp so -> so { so_ignore = fp:(so_ignore so) }) "PATH") ( concat + [ "files or directories (relative to the source and destination directories) that are to " + , "be ignored during synchroization (this option can be given multiple times)" + ]) + , Option ['a'] ["add"] (NoArg (\so -> so { so_add = True })) ( concat + [ "copy files from the source directory if there is corresponding file inside " + , "the destination directory" + ]) + , Option ['u'] ["update"] (NoArg (\so -> so { so_update = True })) ( concat + [ "overwrite existing files inside the destination directory if their content does not " + , "match the respective files inside the source directory" + ]) + , Option [] ["delete"] (NoArg (\so -> so { so_delete = True })) ( concat + [ "delete files inside the destination directory if there is no corresponding file inside " + , "the source directory" + ]) + , Option ['h'] ["help"] (NoArg (\so -> so { so_help = True })) "shows usage information" + ] + +parseNonOption :: String -> (SyncOptions -> SyncOptions) +parseNonOption s so = so { so_nonOptions = s:(so_nonOptions so) } + +toSyncOptions :: [(SyncOptions -> SyncOptions)] -> SyncOptions +toSyncOptions = foldl (flip id) defaultSyncOptions + +putError :: String -> IO () +putError = hPutStrLn stderr + +printUsageInfo :: [String] -> IO () +printUsageInfo prefix = mapM_ putError (prefix ++ [usageInfo header optDescriptions] ++ [details]) + where + header = unlines + [ "sync-mht version " ++ showVersion version + , "" + , "Usage: sync-mht [OPTIONS..]" + ] + details = concat + [ "Note: If the --remote-shell option has been provided, exactly one of the directories " + , "must be prepended with 'remote:' - indicating a folder on the site, accessible with " + , "the provided remote shell command." + ] + +_HIDDENT_CLIENT_MODE_OPTION_ :: String +_HIDDENT_CLIENT_MODE_OPTION_ = "--hidden-client-mode-option" + +main :: IO () +main = flip catchIOError (putError . show) $ + do args <- getArgs + let parsedOpts = getOpt (ReturnInOrder parseNonOption) optDescriptions args + case () of + () | [_HIDDENT_CLIENT_MODE_OPTION_] == args -> child + | (options,[],[]) <- parsedOpts -> run $ toSyncOptions options + | (_,_,errs) <- parsedOpts -> printUsageInfo errs + +data Side + = Remote FilePath + | Local FilePath + +parseFilePath :: FilePath -> Side +parseFilePath fp + | Just rest <- stripPrefix "remote:" fp = Remote rest + | otherwise = Local fp + +run :: SyncOptions -> IO () +run so + | so_help so = + printUsageInfo [] + | not (null (so_nonOptions so)) = + printUsageInfo ["Could not understand the following options: " ++ show (so_nonOptions so)] + | Just source <- so_source so, Just destination <- so_destination so = + case (parseFilePath source, parseFilePath destination) of + (Remote _, Remote _) -> printUsageInfo [doubleRemote] + (Local source', Local destination') + | Just _ <- so_remote so -> printUsageInfo [missingRemote] + | otherwise -> local cs source' destination' + (Remote source', Local destination') + | Just remoteCmd <- so_remote so -> runParent cs remoteCmd source' destination' FromRemote + | otherwise -> printUsageInfo [missingRemoteCmd] + (Local source', Remote destination') + | Just remoteCmd <- so_remote so -> runParent cs remoteCmd source' destination' ToRemote + | otherwise -> printUsageInfo [missingRemoteCmd] + | otherwise = + do let missingOpts = + intercalate ", " $ map snd $ filter ((== Nothing) . ($ so) . fst) + [(so_source, "--source"),(so_destination, "--destination")] + printUsageInfo ["The follwing required options: " ++ missingOpts ++ " were missing."] + where + cs = toClientServerOptions so + doubleRemote = "Either the directory given in --source or --destination must be local." + missingRemote = concat + [ "The --remote-shell options requires that either the directory given at " + , "--source or --destination is at remote site. (Indicated by the prefix: 'remote:')" + ] + missingRemoteCmd = "The --remote-shell is required when the prefix 'remote:' is used." + +runParent :: ClientServerOptions -> String -> FilePath -> FilePath -> Direction -> IO () +runParent clientServerOpts remoteCmd source destination dir = + do let remoteCmd' = remoteCmd ++ " " ++ _HIDDENT_CLIENT_MODE_OPTION_ + handles <- createProcess ((shell remoteCmd') { std_in = CreatePipe, std_out = CreatePipe }) + case handles of + (Just hIn, Just hOut, Nothing, _ph) -> + do streams <- openStreams hOut hIn + parent streams source destination dir clientServerOpts + _ -> fail "createProcess did return the correct set of handles." + diff --git a/sync-mht.cabal b/sync-mht.cabal new file mode 100644 --- /dev/null +++ b/sync-mht.cabal @@ -0,0 +1,67 @@ +-- This .cabal file was generated by src/build/hs/CabalTemplate.hs +name: sync-mht +version: 0.2.0.0 +synopsis: + Fast incremental file transfer using Merke-Hash-Trees + +description: + A command line tool that can be used to incrementally synchronize a directory hierarchy with a + second one. It is using a Merkle-Hash-Tree to compare the folders, such that the synchronization + time and communication (round) complexity grows only logarithmically with the actual size of the + directories (assuming the actual difference of the directories is small). + + The communication happens through standard streams between parent and child processes, which can + easily be routed through remote command execution tools, e.g. + + sync-mht -s foo/ -d bar + + will synchronize the local folder bar/ with the local folder foo/, but + + sync-mht -s foo/ -d remote:/bar -r "ssh fred@example.org sync-mht" + + will synchronize the folder bar/ in the home directory of the user fred on the host machine + example.org with the local folder foo/. + + It is also possible to use it with docker, e.g. + + sync-mht -s foo/ -d remote:/bar -r "docker run -i --volumes-from bar ekarayel/sync-mht sync-mht" + + to synchronize the folder /bar (of the container named bar) with the local folder foo/. + +license: MIT +license-file: LICENSE +author: Emin Karayel +maintainer: Emin Karayel +package-url: https://github.com/ekarayel/sync-mht +category: Utility +build-type: Simple +cabal-version: >=1.10 +source-repository head + type: git + location: https://github.com/ekarayel/sync-mht +source-repository this + type: git + tag: 0.2.0.0 + location: https://github.com/ekarayel/sync-mht +executable sync-mht + main-is: Main.hs + ghc-options: -Wall + build-depends: + base >=4.7 && <4.8 + , unix >=2.7 && <2.8 + , directory >=1.2 && <1.3 + , filepath >=1.3 && <1.4 + , process >=1.2 && <1.3 + , cryptohash >=0.11 && <0.12 + , byteable >=0.1 && <0.2 + , array >=0.5 && <0.6 + , containers >=0.5 && <0.6 + , text >=1.2 && <1.3 + , bytestring >=0.10 && <0.11 + , base16-bytestring >=0.1 && <0.2 + , cereal >= 0.4 && < 0.5 + , io-streams >= 1.2 && <1.3 + , transformers >= 0.4 && < 0.5 + , mtl >= 2.2 && < 2.3 + hs-source-dirs: src/main/hs + default-language: Haskell2010