summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-07-05 20:24:10 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-07-05 20:24:10 -0400
commitc98b5cf36e785cdf2c971eaf9b0329db06b68ef8 (patch)
tree9f7e69b1a57bccdb0ef446035d6579fdd3938fe1 /Utility
parent6040d8aed17de582f5d5c179040e29c599315e31 (diff)
rename
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Base64.hs18
-rw-r--r--Utility/CopyFile.hs29
-rw-r--r--Utility/RsyncFile.hs48
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