wire git repair into webapp
This commit is contained in:
parent
1ab2ad86c7
commit
0036139b33
5 changed files with 87 additions and 22 deletions
|
@ -10,7 +10,17 @@
|
|||
module Assistant.WebApp.Repair where
|
||||
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.WebApp.Utility
|
||||
import Assistant.WebApp.RepoList
|
||||
import Remote (prettyUUID)
|
||||
import Command.Repair (repairAnnexBranch)
|
||||
import Git.Repair (runRepairOf)
|
||||
import Logs.FsckResults
|
||||
import Annex.UUID
|
||||
import Utility.Batch
|
||||
import Config.Files
|
||||
|
||||
import Control.Concurrent.Async
|
||||
|
||||
getRepairRepositoryR :: UUID -> Handler Html
|
||||
getRepairRepositoryR = postRepairRepositoryR
|
||||
|
@ -20,7 +30,51 @@ postRepairRepositoryR u = page "Repair repository" Nothing $ do
|
|||
$(widgetFile "control/repairrepository")
|
||||
|
||||
getRepairRepositoryRunR :: UUID -> Handler Html
|
||||
getRepairRepositoryRunR = postRepairRepositoryR
|
||||
getRepairRepositoryRunR = postRepairRepositoryRunR
|
||||
postRepairRepositoryRunR :: UUID -> Handler Html
|
||||
postRepairRepositoryRunR u = page "Repair repository" Nothing $ do
|
||||
$(widgetFile "control/repairrepository/run")
|
||||
postRepairRepositoryRunR u = do
|
||||
-- Stop the watcher from running while running repairs.
|
||||
changeSyncable Nothing False
|
||||
|
||||
fsckthread <- liftAssistant $ runRepair u
|
||||
|
||||
-- Start the watcher running again. This also triggers it to do a
|
||||
-- startup scan, which is especially important if the git repo
|
||||
-- repair removed files from the index file. Those files will be
|
||||
-- seen as new, and re-added to the repository.
|
||||
changeSyncable Nothing True
|
||||
|
||||
liftAnnex $ writeFsckResults u Nothing
|
||||
|
||||
page "Repair repository" Nothing $ do
|
||||
let repolist = repoListDisplay $
|
||||
mainRepoSelector { nudgeAddMore = True }
|
||||
$(widgetFile "control/repairrepository/done")
|
||||
|
||||
runRepair :: UUID -> Assistant ()
|
||||
runRepair u = do
|
||||
fsckresults <- liftAnnex (readFsckResults u)
|
||||
myu <- liftAnnex getUUID
|
||||
if u == myu
|
||||
then localrepair fsckresults
|
||||
else remoterepair fsckresults
|
||||
where
|
||||
localrepair fsckresults = do
|
||||
-- This intentionally runs the repair inside the Annex
|
||||
-- monad, which is not stricktly necessary, but keeps
|
||||
-- other threads that might be trying to use the Annex
|
||||
-- from running until it completes.
|
||||
needfsck <- liftAnnex $ do
|
||||
(ok, stillmissing, modifiedbranches) <- inRepo $
|
||||
runRepairOf fsckresults True
|
||||
repairAnnexBranch stillmissing modifiedbranches
|
||||
return (not ok)
|
||||
when needfsck $
|
||||
backgroundfsck [ Param "--fast" ]
|
||||
|
||||
remoterepair fsckresults = do
|
||||
error "TODO: remote repair"
|
||||
|
||||
backgroundfsck params = liftIO $ void $ async $ do
|
||||
program <- readProgramFile
|
||||
batchCommand program (Param "fsck" : params)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue