diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2016-01-01 15:09:42 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-01-01 15:09:42 -0400 |
| commit | b106df45110320f24bbcd972f10f47192efbadd8 (patch) | |
| tree | b62f5f51e3b1d6394b91c19144c2d5e17db5a28d /Database | |
| parent | 797afd300cde42488a1c64201289165c48a9208e (diff) | |
scan for unlocked files on init/upgrade of v6 repo
Diffstat (limited to 'Database')
| -rw-r--r-- | Database/Keys.hs | 34 |
1 files changed, 31 insertions, 3 deletions
diff --git a/Database/Keys.hs b/Database/Keys.hs index f5a28c704..30e6ff921 100644 --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -1,14 +1,14 @@ {- Sqlite database of information about Keys - - - Copyright 2015 Joey Hess <id@joeyh.name> - -: + - Copyright 2015-2016 Joey Hess <id@joeyh.name> + - - Licensed under the GNU GPL version 3 or higher. -} {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} module Database.Keys ( DbHandle, @@ -16,6 +16,7 @@ module Database.Keys ( getAssociatedFiles, getAssociatedKey, removeAssociatedFile, + scanAssociatedFiles, storeInodeCaches, addInodeCaches, getInodeCaches, @@ -35,6 +36,12 @@ import Annex.Perms import Annex.LockFile import Utility.InodeCache import Annex.InodeSentinal +import qualified Git.Types +import qualified Git.LsTree +import Git.Ref +import Git.FilePath +import Annex.CatFile +import Messages import Database.Persist.TH import Database.Esqueleto hiding (Key) @@ -203,6 +210,27 @@ removeAssociatedFile' :: SKey -> FilePath -> Writer removeAssociatedFile' sk f = queueDb $ delete $ from $ \r -> do where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f) + +{- Find all unlocked associated files. This is expensive, and so normally + - the associated files are updated incrementally when changes are noticed. -} +scanAssociatedFiles :: Annex () +scanAssociatedFiles = runWriter $ \h -> do + showSideAction "scanning for unlocked files" + dropallassociated h + l <- inRepo $ Git.LsTree.lsTree headRef + forM_ l $ \i -> + when (isregfile i) $ + maybe noop (add h i) + =<< catKey (Git.Types.Ref $ Git.LsTree.sha i) + where + dropallassociated = queueDb $ + delete $ from $ \(_r :: SqlExpr (Entity Associated)) -> + return () + isregfile i = Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.FileBlob + add h i k = flip queueDb h $ + void $ insertUnique $ Associated + (toSKey k) + (getTopFilePath $ Git.LsTree.file i) {- Stats the files, and stores their InodeCaches. -} storeInodeCaches :: Key -> [FilePath] -> Annex () |