check rawSystem exit codes

This commit is contained in:
Joey Hess 2010-10-14 13:17:43 -04:00
parent 8df3e2aa02
commit 7c975eab07
2 changed files with 10 additions and 8 deletions

View file

@ -6,6 +6,7 @@ module Backend.File (backend) where
import Control.Monad.State import Control.Monad.State
import System.IO import System.IO
import System.Cmd import System.Cmd
import System.Exit
import Control.Exception import Control.Exception
import BackendTypes import BackendTypes
import LocationLog import LocationLog
@ -68,10 +69,11 @@ copyFromRemote r key file = do
if (Git.repoIsLocal r) if (Git.repoIsLocal r)
then getlocal then getlocal
else getremote else getremote
return ()
where where
getlocal = do getlocal = do
rawSystem "cp" ["-a", location, file] res <-rawSystem "cp" ["-a", location, file]
putStrLn "cp done" if (res == ExitSuccess)
then return ()
else error "cp failed"
getremote = error "get via network not yet implemented!" getremote = error "get via network not yet implemented!"
location = annexLocation r backend key location = annexLocation r backend key

View file

@ -5,7 +5,7 @@ module Backend.Url (backend) where
import Control.Monad.State import Control.Monad.State
import System.Cmd import System.Cmd
import IO import System.Exit
import BackendTypes import BackendTypes
backend = Backend { backend = Backend {
@ -29,7 +29,7 @@ dummyRemove url = return False
downloadUrl :: Key -> FilePath -> Annex Bool downloadUrl :: Key -> FilePath -> Annex Bool
downloadUrl url file = do downloadUrl url file = do
liftIO $ putStrLn $ "download: " ++ (show url) liftIO $ putStrLn $ "download: " ++ (show url)
result <- liftIO $ try $ rawSystem "curl" ["-#", "-o", file, (show url)] result <- liftIO $ rawSystem "curl" ["-#", "-o", file, (show url)]
case (result) of if (result == ExitSuccess)
Left _ -> return False then return True
Right _ -> return True else return False