diff options
Diffstat (limited to 'Remote/Bup.hs')
| -rw-r--r-- | Remote/Bup.hs | 20 |
1 files changed, 11 insertions, 9 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 5a44397f0..4ea455226 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -8,7 +8,8 @@ module Remote.Bup (remote) where import qualified Data.ByteString.Lazy.Char8 as L -import IO +import System.IO +import System.IO.Error import Control.Exception.Extensible (IOException) import qualified Data.Map as M import Control.Monad (when) @@ -16,6 +17,7 @@ import Control.Monad.State (liftIO) import System.Process import System.Exit import System.FilePath +import Data.Maybe import Data.List.Utils import System.Cmd.Utils @@ -68,7 +70,7 @@ gen r u c = do bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig bupSetup u c = do -- verify configuration is sane - let buprepo = maybe (error "Specify buprepo=") id $ + let buprepo = fromMaybe (error "Specify buprepo=") $ M.lookup "buprepo" c c' <- encryptionSetup c @@ -87,7 +89,7 @@ bupSetup u c = do bupParams :: String -> BupRepo -> [CommandParam] -> [CommandParam] bupParams command buprepo params = - (Param command) : [Param "-r", Param buprepo] ++ params + Param command : [Param "-r", Param buprepo] ++ params bup :: String -> BupRepo -> [CommandParam] -> Annex Bool bup command buprepo params = do @@ -123,8 +125,8 @@ storeEncrypted r buprepo (cipher, enck) k = do g <- Annex.gitRepo let src = gitAnnexLocation g k params <- bupSplitParams r buprepo enck (Param "-") - liftIO $ catchBool $ do - withEncryptedHandle cipher (L.readFile src) $ \h -> do + liftIO $ catchBool $ + withEncryptedHandle cipher (L.readFile src) $ \h -> pipeBup params (Just h) Nothing retrieve :: BupRepo -> Key -> FilePath -> Annex Bool @@ -184,7 +186,7 @@ onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [ onBupRemote r a command params = do let dir = shellEscape (Git.workTree r) sshparams <- sshToRepo r [Param $ - "cd " ++ dir ++ " && " ++ (unwords $ command : toCommand params)] + "cd " ++ dir ++ " && " ++ unwords (command : toCommand params)] liftIO $ a "ssh" sshparams {- Allow for bup repositories on removable media by checking @@ -215,20 +217,20 @@ bup2GitRemote "" = do Git.repoFromAbsPath $ h </> ".bup" bup2GitRemote r | bupLocal r = - if r !! 0 == '/' + if head r == '/' then Git.repoFromAbsPath r else error "please specify an absolute path" | otherwise = Git.repoFromUrl $ "ssh://" ++ host ++ slash dir where bits = split ":" r - host = bits !! 0 + host = head bits dir = join ":" $ drop 1 bits -- "host:~user/dir" is not supported specially by bup; -- "host:dir" is relative to the home directory; -- "host:" goes in ~/.bup slash d | d == "" = "/~/.bup" - | d !! 0 == '/' = d + | head d == '/' = d | otherwise = "/~/" ++ d bupLocal :: BupRepo -> Bool |