summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
Diffstat (limited to 'Remote')
-rw-r--r--Remote/BitTorrent.hs14
-rw-r--r--Remote/Bup.hs10
-rw-r--r--Remote/Ddar.hs4
-rw-r--r--Remote/Directory.hs8
-rw-r--r--Remote/External.hs31
-rw-r--r--Remote/GCrypt.hs14
-rw-r--r--Remote/Git.hs22
-rw-r--r--Remote/Glacier.hs14
-rw-r--r--Remote/Helper/Chunked.hs2
-rw-r--r--Remote/Helper/Encryptable.hs6
-rw-r--r--Remote/Helper/Http.hs2
-rw-r--r--Remote/Helper/Messages.hs2
-rw-r--r--Remote/Helper/Ssh.hs2
-rw-r--r--Remote/Hook.hs8
-rw-r--r--Remote/Rsync.hs8
-rw-r--r--Remote/S3.hs14
-rw-r--r--Remote/Tahoe.hs8
-rw-r--r--Remote/Web.hs2
-rw-r--r--Remote/WebDAV.hs8
19 files changed, 89 insertions, 90 deletions
diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index a0ccf99df..899c57e3e 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -111,7 +111,7 @@ dropKey k = do
- implemented, it tells us nothing about the later state of the torrent.
-}
checkKey :: Key -> Annex Bool
-checkKey = error "cannot reliably check torrent status"
+checkKey = giveup "cannot reliably check torrent status"
getBitTorrentUrls :: Key -> Annex [URLString]
getBitTorrentUrls key = filter supported <$> getUrls key
@@ -138,7 +138,7 @@ checkTorrentUrl u = do
registerTorrentCleanup u
ifM (downloadTorrentFile u)
( torrentContents u
- , error "could not download torrent file"
+ , giveup "could not download torrent file"
)
{- To specify which file inside a multi-url torrent, the file number is
@@ -268,13 +268,13 @@ downloadTorrentContent k u dest filenum p = do
fs <- liftIO $ map fst <$> torrentFileSizes torrent
if length fs >= filenum
then return (fs !! (filenum - 1))
- else error "Number of files in torrent seems to have changed."
+ else giveup "Number of files in torrent seems to have changed."
checkDependencies :: Annex ()
checkDependencies = do
missing <- liftIO $ filterM (not <$$> inPath) deps
unless (null missing) $
- error $ "need to install additional software in order to download from bittorrent: " ++ unwords missing
+ giveup $ "need to install additional software in order to download from bittorrent: " ++ unwords missing
where
deps =
[ "aria2c"
@@ -343,7 +343,7 @@ torrentFileSizes torrent = do
let mkfile = joinPath . map (scrub . decodeBS)
b <- B.readFile torrent
return $ case readTorrent b of
- Left e -> error $ "failed to parse torrent: " ++ e
+ Left e -> giveup $ "failed to parse torrent: " ++ e
Right t -> case tInfo t of
SingleFile { tLength = l, tName = f } ->
[ (mkfile [f], l) ]
@@ -366,7 +366,7 @@ torrentFileSizes torrent = do
_ -> parsefailed (show v)
where
getfield = btshowmetainfo torrent
- parsefailed s = error $ "failed to parse btshowmetainfo output for torrent file: " ++ show s
+ parsefailed s = giveup $ "failed to parse btshowmetainfo output for torrent file: " ++ show s
-- btshowmetainfo outputs a list of "filename (size)"
splitsize d l = (scrub (d </> fn), sz)
@@ -379,7 +379,7 @@ torrentFileSizes torrent = do
#endif
-- a malicious torrent file might try to do directory traversal
scrub f = if isAbsolute f || any (== "..") (splitPath f)
- then error "found unsafe filename in torrent!"
+ then giveup "found unsafe filename in torrent!"
else f
torrentContents :: URLString -> Annex UrlContents
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 22510859c..332e8d5dc 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -84,7 +84,7 @@ gen r u c gc = do
(simplyPrepare $ checkKey r bupr')
this
where
- buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
+ buprepo = fromMaybe (giveup "missing buprepo") $ remoteAnnexBupRepo gc
specialcfg = (specialRemoteCfg c)
-- chunking would not improve bup
{ chunkConfig = NoChunks
@@ -95,14 +95,14 @@ bupSetup mu _ c gc = do
u <- maybe (liftIO genUUID) return mu
-- verify configuration is sane
- let buprepo = fromMaybe (error "Specify buprepo=") $
+ let buprepo = fromMaybe (giveup "Specify buprepo=") $
M.lookup "buprepo" c
(c', _encsetup) <- encryptionSetup c gc
-- bup init will create the repository.
-- (If the repository already exists, bup init again appears safe.)
showAction "bup init"
- unlessM (bup "init" buprepo []) $ error "bup init failed"
+ unlessM (bup "init" buprepo []) $ giveup "bup init failed"
storeBupUUID u buprepo
@@ -197,7 +197,7 @@ storeBupUUID u buprepo = do
showAction "storing uuid"
unlessM (onBupRemote r boolSystem "git"
[Param "config", Param "annex.uuid", Param v]) $
- error "ssh failed"
+ giveup "ssh failed"
else liftIO $ do
r' <- Git.Config.read r
let olduuid = Git.Config.get "annex.uuid" "" r'
@@ -251,7 +251,7 @@ bup2GitRemote r
| bupLocal r =
if "/" `isPrefixOf` r
then Git.Construct.fromAbsPath r
- else error "please specify an absolute path"
+ else giveup "please specify an absolute path"
| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
where
bits = split ":" r
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index fded8d420..dcb16f5dd 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -76,7 +76,7 @@ gen r u c gc = do
, claimUrl = Nothing
, checkUrl = Nothing
}
- ddarrepo = maybe (error "missing ddarrepo") (DdarRepo gc) (remoteAnnexDdarRepo gc)
+ ddarrepo = maybe (giveup "missing ddarrepo") (DdarRepo gc) (remoteAnnexDdarRepo gc)
specialcfg = (specialRemoteCfg c)
-- chunking would not improve ddar
{ chunkConfig = NoChunks
@@ -87,7 +87,7 @@ ddarSetup mu _ c gc = do
u <- maybe (liftIO genUUID) return mu
-- verify configuration is sane
- let ddarrepo = fromMaybe (error "Specify ddarrepo=") $
+ let ddarrepo = fromMaybe (giveup "Specify ddarrepo=") $
M.lookup "ddarrepo" c
(c', _encsetup) <- encryptionSetup c gc
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 3b26947b6..248e5d49f 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -75,17 +75,17 @@ gen r u c gc = do
, checkUrl = Nothing
}
where
- dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
+ dir = fromMaybe (giveup "missing directory") $ remoteAnnexDirectory gc
directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
directorySetup mu _ c gc = do
u <- maybe (liftIO genUUID) return mu
-- verify configuration is sane
- let dir = fromMaybe (error "Specify directory=") $
+ let dir = fromMaybe (giveup "Specify directory=") $
M.lookup "directory" c
absdir <- liftIO $ absPath dir
liftIO $ unlessM (doesDirectoryExist absdir) $
- error $ "Directory does not exist: " ++ absdir
+ giveup $ "Directory does not exist: " ++ absdir
(c', _encsetup) <- encryptionSetup c gc
-- The directory is stored in git config, not in this remote's
@@ -216,6 +216,6 @@ checkKey d _ k = liftIO $
( return True
, ifM (doesDirectoryExist d)
( return False
- , error $ "directory " ++ d ++ " is not accessible"
+ , giveup $ "directory " ++ d ++ " is not accessible"
)
)
diff --git a/Remote/External.hs b/Remote/External.hs
index 65b05fe62..0b0e1dc18 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -107,12 +107,12 @@ gen r u c gc
(simplyPrepare toremove)
(simplyPrepare tocheckkey)
rmt
- externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc)
+ externaltype = fromMaybe (giveup "missing externaltype") (remoteAnnexExternalType gc)
externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
externalSetup mu _ c gc = do
u <- maybe (liftIO genUUID) return mu
- let externaltype = fromMaybe (error "Specify externaltype=") $
+ let externaltype = fromMaybe (giveup "Specify externaltype=") $
M.lookup "externaltype" c
(c', _encsetup) <- encryptionSetup c gc
@@ -124,7 +124,7 @@ externalSetup mu _ c gc = do
external <- newExternal externaltype u c' gc
handleRequest external INITREMOTE Nothing $ \resp -> case resp of
INITREMOTE_SUCCESS -> Just noop
- INITREMOTE_FAILURE errmsg -> Just $ error errmsg
+ INITREMOTE_FAILURE errmsg -> Just $ giveup errmsg
_ -> Nothing
withExternalState external $
liftIO . atomically . readTVar . externalConfig
@@ -151,8 +151,7 @@ retrieve external = fileRetriever $ \d k p ->
TRANSFER_SUCCESS Download k'
| k == k' -> Just $ return ()
TRANSFER_FAILURE Download k' errmsg
- | k == k' -> Just $ do
- error errmsg
+ | k == k' -> Just $ giveup errmsg
_ -> Nothing
remove :: External -> Remover
@@ -168,7 +167,7 @@ remove external k = safely $
_ -> Nothing
checkKey :: External -> CheckPresent
-checkKey external k = either error id <$> go
+checkKey external k = either giveup id <$> go
where
go = handleRequest external (CHECKPRESENT k) Nothing $ \resp ->
case resp of
@@ -284,7 +283,7 @@ handleRequest' st external req mp responsehandler
handleRemoteRequest (VERSION _) =
sendMessage st external (ERROR "too late to send VERSION")
- handleAsyncMessage (ERROR err) = error $ "external special remote error: " ++ err
+ handleAsyncMessage (ERROR err) = giveup $ "external special remote error: " ++ err
send = sendMessage st external
@@ -332,7 +331,7 @@ receiveMessage st external handleresponse handlerequest handleasync =
Nothing -> case parseMessage s :: Maybe AsyncMessage of
Just msg -> maybe (protocolError True s) id (handleasync msg)
Nothing -> protocolError False s
- protocolError parsed s = error $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\" " ++
+ protocolError parsed s = giveup $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\" " ++
if parsed then "(command not allowed at this time)" else "(unable to parse command)"
protocolDebug :: External -> ExternalState -> Bool -> String -> IO ()
@@ -413,14 +412,14 @@ startExternal external = do
environ <- propGitEnv g
return $ p { env = Just environ }
- runerr _ = error ("Cannot run " ++ basecmd ++ " -- Make sure it's in your PATH and is executable.")
+ runerr _ = giveup ("Cannot run " ++ basecmd ++ " -- Make sure it's in your PATH and is executable.")
checkearlytermination Nothing = noop
checkearlytermination (Just exitcode) = ifM (inPath basecmd)
- ( error $ unwords [ "failed to run", basecmd, "(" ++ show exitcode ++ ")" ]
+ ( giveup $ unwords [ "failed to run", basecmd, "(" ++ show exitcode ++ ")" ]
, do
path <- intercalate ":" <$> getSearchPath
- error $ basecmd ++ " is not installed in PATH (" ++ path ++ ")"
+ giveup $ basecmd ++ " is not installed in PATH (" ++ path ++ ")"
)
stopExternal :: External -> Annex ()
@@ -452,7 +451,7 @@ checkPrepared st external = do
v <- liftIO $ atomically $ readTVar $ externalPrepared st
case v of
Prepared -> noop
- FailedPrepare errmsg -> error errmsg
+ FailedPrepare errmsg -> giveup errmsg
Unprepared ->
handleRequest' st external PREPARE Nothing $ \resp ->
case resp of
@@ -460,7 +459,7 @@ checkPrepared st external = do
setprepared Prepared
PREPARE_FAILURE errmsg -> Just $ do
setprepared $ FailedPrepare errmsg
- error errmsg
+ giveup errmsg
_ -> Nothing
where
setprepared status = liftIO $ atomically $ void $
@@ -520,8 +519,8 @@ checkurl external url =
CHECKURL_MULTI ((_, sz, f):[]) ->
Just $ return $ UrlContents sz $ Just $ mkSafeFilePath f
CHECKURL_MULTI l -> Just $ return $ UrlMulti $ map mkmulti l
- CHECKURL_FAILURE errmsg -> Just $ error errmsg
- UNSUPPORTED_REQUEST -> error "CHECKURL not implemented by external special remote"
+ CHECKURL_FAILURE errmsg -> Just $ giveup errmsg
+ UNSUPPORTED_REQUEST -> giveup "CHECKURL not implemented by external special remote"
_ -> Nothing
where
mkmulti (u, s, f) = (u, s, mkSafeFilePath f)
@@ -530,7 +529,7 @@ retrieveUrl :: Retriever
retrieveUrl = fileRetriever $ \f k p -> do
us <- getWebUrls k
unlessM (downloadUrl k p us f) $
- error "failed to download content"
+ giveup "failed to download content"
checkKeyUrl :: Git.Repo -> CheckPresent
checkKeyUrl r k = do
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index a0c8ecaf7..78ab6ed79 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -164,16 +164,16 @@ rsyncTransport r gc
othertransport = return ([], loc, AccessDirect)
noCrypto :: Annex a
-noCrypto = error "cannot use gcrypt remote without encryption enabled"
+noCrypto = giveup "cannot use gcrypt remote without encryption enabled"
unsupportedUrl :: a
-unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported"
+unsupportedUrl = giveup "using non-ssh remote repo url with gcrypt is not supported"
gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
gCryptSetup mu _ c gc = go $ M.lookup "gitrepo" c
where
remotename = fromJust (M.lookup "name" c)
- go Nothing = error "Specify gitrepo="
+ go Nothing = giveup "Specify gitrepo="
go (Just gitrepo) = do
(c', _encsetup) <- encryptionSetup c gc
inRepo $ Git.Command.run
@@ -200,7 +200,7 @@ gCryptSetup mu _ c gc = go $ M.lookup "gitrepo" c
]
g <- inRepo Git.Config.reRead
case Git.GCrypt.remoteRepoId g (Just remotename) of
- Nothing -> error "unable to determine gcrypt-id of remote"
+ Nothing -> giveup "unable to determine gcrypt-id of remote"
Just gcryptid -> do
let u = genUUIDInNameSpace gCryptNameSpace gcryptid
if Just u == mu || isNothing mu
@@ -208,7 +208,7 @@ gCryptSetup mu _ c gc = go $ M.lookup "gitrepo" c
method <- setupRepo gcryptid =<< inRepo (Git.Construct.fromRemoteLocation gitrepo)
gitConfigSpecialRemote u c' "gcrypt" (fromAccessMethod method)
return (c', u)
- else error $ "uuid mismatch; expected " ++ show mu ++ " but remote gitrepo has " ++ show u ++ " (" ++ show gcryptid ++ ")"
+ else giveup $ "uuid mismatch; expected " ++ show mu ++ " but remote gitrepo has " ++ show u ++ " (" ++ show gcryptid ++ ")"
{- Sets up the gcrypt repository. The repository is either a local
- repo, or it is accessed via rsync directly, or it is accessed over ssh
@@ -258,7 +258,7 @@ setupRepo gcryptid r
, Param rsyncurl
]
unless ok $
- error "Failed to connect to remote to set it up."
+ giveup "Failed to connect to remote to set it up."
return AccessDirect
{- Ask git-annex-shell to configure the repository as a gcrypt
@@ -337,7 +337,7 @@ retrieve r rsyncopts
| Git.repoIsSsh (repo r) = if accessShell r
then fileRetriever $ \f k p ->
unlessM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download k f Nothing) $
- error "rsync failed"
+ giveup "rsync failed"
else fileRetriever $ Remote.Rsync.retrieve rsyncopts
| otherwise = unsupportedUrl
where
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 34bdd83a1..3304e2069 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -95,20 +95,20 @@ list autoinit = do
-}
gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
gitSetup Nothing _ c _ = do
- let location = fromMaybe (error "Specify location=url") $
+ let location = fromMaybe (giveup "Specify location=url") $
Url.parseURIRelaxed =<< M.lookup "location" c
g <- Annex.gitRepo
u <- case filter (\r -> Git.location r == Git.Url location) (Git.remotes g) of
[r] -> getRepoUUID r
- [] -> error "could not find existing git remote with specified location"
- _ -> error "found multiple git remotes with specified location"
+ [] -> giveup "could not find existing git remote with specified location"
+ _ -> giveup "found multiple git remotes with specified location"
return (c, u)
gitSetup (Just u) _ c _ = do
inRepo $ Git.Command.run
[ Param "remote"
, Param "add"
- , Param $ fromMaybe (error "no name") (M.lookup "name" c)
- , Param $ fromMaybe (error "no location") (M.lookup "location" c)
+ , Param $ fromMaybe (giveup "no name") (M.lookup "name" c)
+ , Param $ fromMaybe (giveup "no location") (M.lookup "location" c)
]
return (c, u)
@@ -202,7 +202,7 @@ tryGitConfigRead :: Bool -> Git.Repo -> Annex Git.Repo
tryGitConfigRead autoinit r
| haveconfig r = return r -- already read
| Git.repoIsSsh r = store $ do
- v <- Ssh.onRemote r (pipedconfig, return (Left $ error "configlist failed")) "configlist" [] configlistfields
+ v <- Ssh.onRemote r (pipedconfig, return (Left $ giveup "configlist failed")) "configlist" [] configlistfields
case v of
Right r'
| haveconfig r' -> return r'
@@ -321,7 +321,7 @@ inAnnex rmt key
showChecking r
ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))
( return True
- , error "not found"
+ , giveup "not found"
)
checkremote = Ssh.inAnnex r key
checklocal = guardUsable r (cantCheck r) $
@@ -357,7 +357,7 @@ dropKey r key
logStatus key InfoMissing
Annex.Content.saveState True
return True
- | Git.repoIsHttp (repo r) = error "dropping from http remote not supported"
+ | Git.repoIsHttp (repo r) = giveup "dropping from http remote not supported"
| otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key
lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r
@@ -414,7 +414,7 @@ lockKey r key callback
failedlock
| otherwise = failedlock
where
- failedlock = error "can't lock content"
+ failedlock = giveup "can't lock content"
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
@@ -444,7 +444,7 @@ copyFromRemote' r key file dest meterupdate
| Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \p -> do
Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p))
=<< Ssh.rsyncParamsRemote False r Download key dest file
- | otherwise = error "copying from non-ssh, non-http remote not supported"
+ | otherwise = giveup "copying from non-ssh, non-http remote not supported"
where
{- Feed local rsync's progress info back to the remote,
- by forking a feeder thread that runs
@@ -547,7 +547,7 @@ copyToRemote' r key file meterupdate
unlocked <- isDirect <||> versionSupportsUnlockedPointers
Ssh.rsyncHelper (Just meterupdate)
=<< Ssh.rsyncParamsRemote unlocked r Upload key object file
- | otherwise = error "copying to non-ssh repo not supported"
+ | otherwise = giveup "copying to non-ssh repo not supported"
where
copylocal Nothing = return False
copylocal (Just (object, checksuccess)) = do
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index eae2dab68..77a907b97 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -146,7 +146,7 @@ retrieve r k sink = go =<< glacierEnv c gc u
, Param $ getVault $ config r
, Param $ archive r k
]
- go Nothing = error "cannot retrieve from glacier"
+ go Nothing = giveup "cannot retrieve from glacier"
go (Just e) = do
let cmd = (proc "glacier" (toCommand params))
{ env = Just e
@@ -182,7 +182,7 @@ checkKey r k = do
showChecking r
go =<< glacierEnv (config r) (gitconfig r) (uuid r)
where
- go Nothing = error "cannot check glacier"
+ go Nothing = giveup "cannot check glacier"
go (Just e) = do
{- glacier checkpresent outputs the archive name to stdout if
- it's present. -}
@@ -190,7 +190,7 @@ checkKey r k = do
let probablypresent = key2file k `elem` lines s
if probablypresent
then ifM (Annex.getFlag "trustglacier")
- ( return True, error untrusted )
+ ( return True, giveup untrusted )
else return False
params = glacierParams (config r)
@@ -222,7 +222,7 @@ glacierParams :: RemoteConfig -> [CommandParam] -> [CommandParam]
glacierParams c params = datacenter:params
where
datacenter = Param $ "--region=" ++
- fromMaybe (error "Missing datacenter configuration")
+ fromMaybe (giveup "Missing datacenter configuration")
(M.lookup "datacenter" c)
glacierEnv :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex (Maybe [(String, String)])
@@ -239,7 +239,7 @@ glacierEnv c gc u = do
(uk, pk) = credPairEnvironment creds
getVault :: RemoteConfig -> Vault
-getVault = fromMaybe (error "Missing vault configuration")
+getVault = fromMaybe (giveup "Missing vault configuration")
. M.lookup "vault"
archive :: Remote -> Key -> Archive
@@ -249,7 +249,7 @@ archive r k = fileprefix ++ key2file k
genVault :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex ()
genVault c gc u = unlessM (runGlacier c gc u params) $
- error "Failed creating glacier vault."
+ giveup "Failed creating glacier vault."
where
params =
[ Param "vault"
@@ -312,7 +312,7 @@ jobList r keys = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
checkSaneGlacierCommand :: IO ()
checkSaneGlacierCommand =
whenM ((Nothing /=) <$> catchMaybeIO shouldfail) $
- error wrongcmd
+ giveup wrongcmd
where
test = proc "glacier" ["--compatibility-test-git-annex"]
shouldfail = withQuietOutput createProcessSuccess test
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index e3cf0d27b..103dcf4ca 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -59,7 +59,7 @@ getChunkConfig m =
Just size
| size == 0 -> NoChunks
| size > 0 -> c (fromInteger size)
- _ -> error $ "bad configuration " ++ f ++ "=" ++ v
+ _ -> giveup $ "bad configuration " ++ f ++ "=" ++ v
-- An infinite stream of chunk keys, starting from chunk 1.
newtype ChunkKeyStream = ChunkKeyStream [Key]
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 05c3e38a5..45ceae068 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -66,14 +66,14 @@ encryptionSetup c gc = do
encsetup $ genEncryptedCipher cmd (c, gc) key Hybrid
Just "pubkey" -> encsetup $ genEncryptedCipher cmd (c, gc) key PubKey
Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key
- _ -> error $ "Specify " ++ intercalate " or "
+ _ -> giveup $ "Specify " ++ intercalate " or "
(map ("encryption=" ++)
["none","shared","hybrid","pubkey", "sharedpubkey"])
++ "."
- key = fromMaybe (error "Specifiy keyid=...") $ M.lookup "keyid" c
+ key = fromMaybe (giveup "Specifiy keyid=...") $ M.lookup "keyid" c
newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++
maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c)
- cannotchange = error "Cannot set encryption type of existing remotes."
+ cannotchange = giveup "Cannot set encryption type of existing remotes."
-- Update an existing cipher if possible.
updateCipher cmd v = case v of
SharedCipher _ | maybe True (== "shared") encryption -> return (c', EncryptionIsSetup)
diff --git a/Remote/Helper/Http.hs b/Remote/Helper/Http.hs
index f01dfd922..ebe0f2598 100644
--- a/Remote/Helper/Http.hs
+++ b/Remote/Helper/Http.hs
@@ -70,7 +70,7 @@ handlePopper numchunks chunksize meterupdate h sink = do
-- meter as it goes.
httpBodyRetriever :: FilePath -> MeterUpdate -> Response BodyReader -> IO ()
httpBodyRetriever dest meterupdate resp
- | responseStatus resp /= ok200 = error $ show $ responseStatus resp
+ | responseStatus resp /= ok200 = giveup $ show $ responseStatus resp
| otherwise = bracket (openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)
where
reader = responseBody resp
diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs
index 484ea1955..014825776 100644
--- a/Remote/Helper/Messages.hs
+++ b/Remote/Helper/Messages.hs
@@ -29,7 +29,7 @@ showChecking :: Describable a => a -> Annex ()
showChecking v = showAction $ "checking " ++ describe v
cantCheck :: Describable a => a -> e
-cantCheck v = error $ "unable to check " ++ describe v
+cantCheck v = giveup $ "unable to check " ++ describe v
showLocking :: Describable a => a -> Annex ()
showLocking v = showAction $ "locking " ++ describe v
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 4ec772296..dff16b656 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -29,7 +29,7 @@ import Config
toRepo :: Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
toRepo r gc sshcmd = do
let opts = map Param $ remoteAnnexSshOptions gc
- let host = fromMaybe (error "bad ssh url") $ Git.Url.hostuser r
+ let host = fromMaybe (giveup "bad ssh url") $ Git.Url.hostuser r
params <- sshOptions (host, Git.Url.port r) gc opts
return $ params ++ Param host : sshcmd
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 7d8f7f096..6abffe117 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -68,12 +68,12 @@ gen r u c gc = do
, checkUrl = Nothing
}
where
- hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
+ hooktype = fromMaybe (giveup "missing hooktype") $ remoteAnnexHookType gc
hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
hookSetup mu _ c gc = do
u <- maybe (liftIO genUUID) return mu
- let hooktype = fromMaybe (error "Specify hooktype=") $
+ let hooktype = fromMaybe (giveup "Specify hooktype=") $
M.lookup "hooktype" c
(c', _encsetup) <- encryptionSetup c gc
gitConfigSpecialRemote u c' "hooktype" hooktype
@@ -129,7 +129,7 @@ store h = fileStorer $ \k src _p ->
retrieve :: HookName -> Retriever
retrieve h = fileRetriever $ \d k _p ->
unlessM (runHook h "retrieve" k (Just d) $ return True) $
- error "failed to retrieve content"
+ giveup "failed to retrieve content"
retrieveCheap :: HookName -> Key -> AssociatedFile -> FilePath -> Annex Bool
retrieveCheap _ _ _ _ = return False
@@ -145,7 +145,7 @@ checkKey r h k = do
where
action = "checkpresent"
findkey s = key2file k `elem` lines s
- check Nothing = error $ action ++ " hook misconfigured"
+ check Nothing = giveup $ action ++ " hook misconfigured"
check (Just hook) = do
environ <- hookEnv action k Nothing
findkey <$> readProcessEnv "sh" ["-c", hook] environ
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 4695ac7a9..22ef0b2cf 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -53,7 +53,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remot
gen r u c gc = do
cst <- remoteCost gc expensiveRemoteCost
(transport, url) <- rsyncTransport gc $
- fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
+ fromMaybe (giveup "missing rsyncurl") $ remoteAnnexRsyncUrl gc
let o = genRsyncOpts c gc transport url
let islocal = rsyncUrlIsPath $ rsyncUrl o
return $ Just $ specialRemote' specialcfg c
@@ -127,7 +127,7 @@ rsyncTransport gc url
(map Param $ loginopt ++ sshopts')
"rsh":rshopts -> return $ map Param $ "rsh" :
loginopt ++ rshopts
- rsh -> error $ "Unknown Rsync transport: "
+ rsh -> giveup $ "Unknown Rsync transport: "
++ unwords rsh
| otherwise = return ([], url)
where
@@ -141,7 +141,7 @@ rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig ->
rsyncSetup mu _ c gc = do
u <- maybe (liftIO genUUID) return mu
-- verify configuration is sane
- let url = fromMaybe (error "Specify rsyncurl=") $
+ let url = fromMaybe (giveup "Specify rsyncurl=") $
M.lookup "rsyncurl" c
(c', _encsetup) <- encryptionSetup c gc
@@ -188,7 +188,7 @@ store o k src meterupdate = withRsyncScratchDir $ \tmp -> do
retrieve :: RsyncOpts -> FilePath -> Key -> MeterUpdate -> Annex ()
retrieve o f k p =
unlessM (rsyncRetrieve o k f (Just p)) $
- error "rsync failed"
+ giveup "rsync failed"
retrieveCheap :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex Bool
retrieveCheap o k _af f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False )
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 97265e148..c6f23333f 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -136,7 +136,7 @@ s3Setup' new u mcreds c gc
-- Ensure user enters a valid bucket name, since
-- this determines the name of the archive.org item.
let validbucket = replace " " "-" $
- fromMaybe (error "specify bucket=") $
+ fromMaybe (giveup "specify bucket=") $
getBucketName c'
let archiveconfig =
-- IA acdepts x-amz-* as an alias for x-archive-*
@@ -252,7 +252,7 @@ retrieve r info Nothing = case getpublicurl info of
return False
Just geturl -> fileRetriever $ \f k p ->
unlessM (downloadUrl k p [geturl k] f) $
- error "failed to download content"
+ giveup "failed to download content"
retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
retrieveCheap _ _ _ = return False
@@ -301,7 +301,7 @@ checkKey r info (Just h) k = do
checkKey r info Nothing k = case getpublicurl info of
Nothing -> do
warnMissingCredPairFor "S3" (AWS.creds $ uuid r)
- error "No S3 credentials configured"
+ giveup "No S3 credentials configured"
Just geturl -> do
showChecking r
withUrlOptions $ checkBoth (geturl k) (keySize k)
@@ -415,7 +415,7 @@ withS3Handle c gc u a = withS3HandleMaybe c gc u $ \mh -> case mh of
Just h -> a h
Nothing -> do
warnMissingCredPairFor "S3" (AWS.creds u)
- error "No S3 credentials configured"
+ giveup "No S3 credentials configured"
withS3HandleMaybe :: RemoteConfig -> RemoteGitConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a
withS3HandleMaybe c gc u a = do
@@ -437,7 +437,7 @@ s3Configuration c = cfg
{ S3.s3Port = port
, S3.s3RequestStyle = case M.lookup "requeststyle" c of
Just "path" -> S3.PathStyle
- Just s -> error $ "bad S3 requeststyle value: " ++ s
+ Just s -> giveup $ "bad S3 requeststyle value: " ++ s
Nothing -> S3.s3RequestStyle cfg
}
where
@@ -455,7 +455,7 @@ s3Configuration c = cfg
port = let s = fromJust $ M.lookup "port" c in
case reads s of
[(p, _)] -> p
- _ -> error $ "bad S3 port value: " ++ s
+ _ -> giveup $ "bad S3 port value: " ++ s
cfg = S3.s3 proto endpoint False
tryS3 :: Annex a -> Annex (Either S3.S3Error a)
@@ -475,7 +475,7 @@ data S3Info = S3Info
extractS3Info :: RemoteConfig -> Annex S3Info
extractS3Info c = do
b <- maybe
- (error "S3 bucket not configured")
+ (giveup "S3 bucket not configured")
(return . T.pack)
(getBucketName c)
let info = S3Info
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index 05b120d46..c29cfb438 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -109,7 +109,7 @@ tahoeSetup mu _ c _ = do
where
scsk = "shared-convergence-secret"
furlk = "introducer-furl"
- missingfurl = error "Set TAHOE_FURL to the introducer furl to use."
+ missingfurl = giveup "Set TAHOE_FURL to the introducer furl to use."
store :: UUID -> TahoeHandle -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
store u hdl k _f _p = sendAnnex k noop $ \src ->
@@ -137,7 +137,7 @@ checkKey u hdl k = go =<< getCapability u k
[ Param "--raw"
, Param cap
]
- either error return v
+ either giveup return v
defaultTahoeConfigDir :: UUID -> IO TahoeConfigDir
defaultTahoeConfigDir u = do
@@ -147,7 +147,7 @@ defaultTahoeConfigDir u = do
tahoeConfigure :: TahoeConfigDir -> IntroducerFurl -> Maybe SharedConvergenceSecret -> IO SharedConvergenceSecret
tahoeConfigure configdir furl mscs = do
unlessM (createClient configdir furl) $
- error "tahoe create-client failed"
+ giveup "tahoe create-client failed"
maybe noop (writeSharedConvergenceSecret configdir) mscs
startTahoeDaemon configdir
getSharedConvergenceSecret configdir
@@ -173,7 +173,7 @@ getSharedConvergenceSecret configdir = go (60 :: Int)
where
f = convergenceFile configdir
go n
- | n == 0 = error $ "tahoe did not write " ++ f ++ " after 1 minute. Perhaps the daemon failed to start?"
+ | n == 0 = giveup $ "tahoe did not write " ++ f ++ " after 1 minute. Perhaps the daemon failed to start?"
| otherwise = do
v <- catchMaybeIO (readFile f)
case v of
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 033057dd8..be2f265e0 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -100,7 +100,7 @@ checkKey key = do
us <- getWebUrls key
if null us
then return False
- else either error return =<< checkKey' key us
+ else either giveup return =<< checkKey' key us
checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
checkKey' key us = firsthit us (Right False) $ \u -> do
let (u', downloader) = getDownloader u
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 3de8b357e..19dbaa8af 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -85,7 +85,7 @@ webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -
webdavSetup mu mcreds c gc = do
u <- maybe (liftIO genUUID) return mu
url <- case M.lookup "url" c of
- Nothing -> error "Specify url="
+ Nothing -> giveup "Specify url="
Just url -> return url
(c', encsetup) <- encryptionSetup c gc
creds <- maybe (getCreds c' gc u) (return . Just) mcreds
@@ -122,7 +122,7 @@ retrieveCheap :: Key -> AssociatedFile -> FilePath -> Annex Bool
retrieveCheap _ _ _ = return False
retrieve :: ChunkConfig -> Maybe DavHandle -> Retriever
-retrieve _ Nothing = error "unable to connect"
+retrieve _ Nothing = giveup "unable to connect"
retrieve (LegacyChunks _) (Just dav) = retrieveLegacyChunked dav
retrieve _ (Just dav) = fileRetriever $ \d k p -> liftIO $
goDAV dav $
@@ -147,7 +147,7 @@ remove (Just dav) k = liftIO $ do
_ -> return False
checkKey :: Remote -> ChunkConfig -> Maybe DavHandle -> CheckPresent
-checkKey r _ Nothing _ = error $ name r ++ " not configured"
+checkKey r _ Nothing _ = giveup $ name r ++ " not configured"
checkKey r chunkconfig (Just dav) k = do
showChecking r
case chunkconfig of
@@ -155,7 +155,7 @@ checkKey r chunkconfig (Just dav) k = do
_ -> do
v <- liftIO $ goDAV dav $
existsDAV (keyLocation k)
- either error return v
+ either giveup return v
configUrl :: Remote -> Maybe URLString
configUrl r = fixup <$> M.lookup "url" (config r)
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 09:56:49 +0000