rename

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"

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 ""

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