fsck distribution key
This commit is contained in:
parent
b429ea0cea
commit
e563c7e6f4
3 changed files with 34 additions and 7 deletions
|
@ -12,9 +12,14 @@ import Assistant.Restart
|
|||
import qualified Annex
|
||||
import Assistant.Alert
|
||||
import Assistant.DaemonStatus
|
||||
import Utility.Url
|
||||
import Utility.Env
|
||||
import Types.Distribution
|
||||
import Logs.Transfer
|
||||
import Logs.Web
|
||||
import Annex.Content
|
||||
import qualified Backend
|
||||
import qualified Types.Backend
|
||||
import qualified Types.Key
|
||||
|
||||
{- Upgrade without interaction in the webapp. -}
|
||||
unattendedUpgrade :: Assistant ()
|
||||
|
@ -40,3 +45,29 @@ checkSuccessfulUpgrade = isJust <$> getEnv upgradedEnv
|
|||
|
||||
upgradedEnv :: String
|
||||
upgradedEnv = "GIT_ANNEX_UPGRADED"
|
||||
|
||||
{- Fsck the key to verify the download. -}
|
||||
distributionDownloadComplete :: GitAnnexDistribution -> Transfer -> Assistant ()
|
||||
distributionDownloadComplete d t
|
||||
| transferDirection t == Download = do
|
||||
maybe noop upgradeToDistribution
|
||||
=<< liftAnnex (withObjectLoc k fsckit (getM fsckit))
|
||||
liftAnnex $ setUrlMissing k (distributionUrl d)
|
||||
| otherwise = noop
|
||||
where
|
||||
k = distributionKey d
|
||||
fsckit f = case Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of
|
||||
Nothing -> return $ Just f
|
||||
Just b -> case Types.Backend.fsckKey b of
|
||||
Nothing -> return $ Just f
|
||||
Just a -> ifM (a k f)
|
||||
( return $ Just f
|
||||
, do
|
||||
-- unlikely to resume a bad
|
||||
-- download from web
|
||||
liftIO $ nukeFile f
|
||||
return Nothing
|
||||
)
|
||||
|
||||
upgradeToDistribution :: FilePath -> Assistant ()
|
||||
upgradeToDistribution f = error "TODO"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue