diff options
author | Joey Hess <joey@kitenet.net> | 2011-07-05 20:24:10 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-07-05 20:24:10 -0400 |
commit | c98b5cf36e785cdf2c971eaf9b0329db06b68ef8 (patch) | |
tree | 9f7e69b1a57bccdb0ef446035d6579fdd3938fe1 /Utility | |
parent | 6040d8aed17de582f5d5c179040e29c599315e31 (diff) |
rename
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/Base64.hs | 18 | ||||
-rw-r--r-- | Utility/CopyFile.hs | 29 | ||||
-rw-r--r-- | Utility/RsyncFile.hs | 48 |
3 files changed, 95 insertions, 0 deletions
diff --git a/Utility/Base64.hs b/Utility/Base64.hs new file mode 100644 index 000000000..dd739fd4f --- /dev/null +++ b/Utility/Base64.hs @@ -0,0 +1,18 @@ +{- Simple Base64 access + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Base64 (toB64, fromB64) where + +import Codec.Binary.Base64 +import Data.Bits.Utils + +toB64 :: String -> String +toB64 = encode . s2w8 + +fromB64 :: String -> String +fromB64 s = maybe bad w82s $ decode s + where bad = error "bad base64 encoded data" diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs new file mode 100644 index 000000000..5ee4a91df --- /dev/null +++ b/Utility/CopyFile.hs @@ -0,0 +1,29 @@ +{- git-annex file copying + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.CopyFile (copyFile) where + +import System.Directory (doesFileExist, removeFile) + +import Utility +import qualified SysConfig + +{- The cp command is used, because I hate reinventing the wheel, + - and because this allows easy access to features like cp --reflink. -} +copyFile :: FilePath -> FilePath -> IO Bool +copyFile src dest = do + whenM (doesFileExist dest) $ + removeFile dest + boolSystem "cp" [params, File src, File dest] + where + params = if SysConfig.cp_reflink_auto + then Params "--reflink=auto" + else if SysConfig.cp_a + then Params "-a" + else if SysConfig.cp_p + then Params "-p" + else Params "" diff --git a/Utility/RsyncFile.hs b/Utility/RsyncFile.hs new file mode 100644 index 000000000..c68909d2d --- /dev/null +++ b/Utility/RsyncFile.hs @@ -0,0 +1,48 @@ +{- git-annex file copying with rsync + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.RsyncFile where + +import Data.String.Utils + +import Utility + +{- Generates parameters to make rsync use a specified command as its remote + - shell. -} +rsyncShell :: [CommandParam] -> [CommandParam] +rsyncShell command = [Param "-e", Param $ unwords $ map escape (toCommand command)] + where + {- rsync requires some weird, non-shell like quoting in + - here. A doubled single quote inside the single quoted + - string is a single quote. -} + escape s = "'" ++ (join "''" $ split "'" s) ++ "'" + +{- Runs rsync in server mode to send a file, and exits. -} +rsyncServerSend :: FilePath -> IO () +rsyncServerSend file = rsyncExec $ + rsyncServerParams ++ [Param "--sender", File file] + +{- Runs rsync in server mode to receive a file. -} +rsyncServerReceive :: FilePath -> IO Bool +rsyncServerReceive file = rsync $ rsyncServerParams ++ [File file] + +rsyncServerParams :: [CommandParam] +rsyncServerParams = + [ Param "--server" + -- preserve permissions + , Param "-p" + -- allow resuming of transfers of big files + , Param "--inplace" + -- other options rsync normally uses in server mode + , Params "-e.Lsf ." + ] + +rsync :: [CommandParam] -> IO Bool +rsync = boolSystem "rsync" + +rsyncExec :: [CommandParam] -> IO () +rsyncExec params = executeFile "rsync" True (toCommand params) Nothing |