diff options
Diffstat (limited to 'Command')
-rw-r--r-- | Command/AddUnused.hs | 34 | ||||
-rw-r--r-- | Command/AddUrl.hs | 9 | ||||
-rw-r--r-- | Command/DropUnused.hs | 48 | ||||
-rw-r--r-- | Command/Fsck.hs | 9 | ||||
-rw-r--r-- | Command/Import.hs | 39 | ||||
-rw-r--r-- | Command/Lock.hs | 6 | ||||
-rw-r--r-- | Command/Log.hs | 2 | ||||
-rw-r--r-- | Command/Map.hs | 8 | ||||
-rw-r--r-- | Command/Status.hs | 18 | ||||
-rw-r--r-- | Command/Sync.hs | 9 | ||||
-rw-r--r-- | Command/Unannex.hs | 6 | ||||
-rw-r--r-- | Command/Unlock.hs | 6 | ||||
-rw-r--r-- | Command/Unused.hs | 18 | ||||
-rw-r--r-- | Command/Whereis.hs | 12 |
14 files changed, 130 insertions, 94 deletions
diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs new file mode 100644 index 000000000..c498216dc --- /dev/null +++ b/Command/AddUnused.hs @@ -0,0 +1,34 @@ +{- git-annex command + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.AddUnused where + +import Common.Annex +import Logs.Unused +import Command +import qualified Command.Add + +def :: [Command] +def = [command "addunused" (paramRepeating paramNumRange) + seek "add back unused files"] + +seek :: [CommandSeek] +seek = [withUnusedMaps start] + +start :: UnusedMaps -> Int -> CommandStart +start = startUnused "addunused" perform (performOther "bad") (performOther "tmp") + +perform :: Key -> CommandPerform +perform key = next $ Command.Add.cleanup file key True + where + file = "unused." ++ show key + +{- The content is not in the annex, but in another directory, and + - it seems better to error out, rather than moving bad/tmp content into + - the annex. -} +performOther :: String -> Key -> CommandPerform +performOther other _ = error $ "cannot addunused " ++ otherĀ ++ "content" diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index c87399f5d..089606e85 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -20,6 +20,7 @@ import Annex.Content import Logs.Web import qualified Option import Types.Key +import Config def :: [Command] def = [withOptions [fileOption, pathdepthOption] $ @@ -53,8 +54,9 @@ perform url file = ifAnnexed file addurl geturl liftIO $ createDirectoryIfMissing True (parentDir file) ifM (Annex.getState Annex.fast) ( nodownload url file , download url file ) - addurl (key, _backend) = - ifM (liftIO $ Url.check url $ keySize key) + addurl (key, _backend) = do + headers <- getHttpHeaders + ifM (liftIO $ Url.check url headers $ keySize key) ( do setUrlPresent key url next $ return True @@ -81,7 +83,8 @@ download url file = do nodownload :: String -> FilePath -> CommandPerform nodownload url file = do - (exists, size) <- liftIO $ Url.exists url + headers <- getHttpHeaders + (exists, size) <- liftIO $ Url.exists url headers if exists then do let key = Backend.URL.fromUrl url size diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 0b2a60216..a94c2873d 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -1,14 +1,13 @@ {- git-annex command - - - Copyright 2010 Joey Hess <joey@kitenet.net> + - Copyright 2010,2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} module Command.DropUnused where -import qualified Data.Map as M - +import Logs.Unused import Common.Annex import Command import qualified Annex @@ -16,40 +15,17 @@ import qualified Command.Drop import qualified Remote import qualified Git import qualified Option -import Types.Key - -type UnusedMap = M.Map String Key def :: [Command] def = [withOptions [Command.Drop.fromOption] $ - command "dropunused" (paramRepeating paramNumber) + command "dropunused" (paramRepeating paramNumRange) seek "drop unused file content"] seek :: [CommandSeek] -seek = [withUnusedMaps] - -{- Read unused logs once, and pass the maps to each start action. -} -withUnusedMaps :: CommandSeek -withUnusedMaps params = do - unused <- readUnusedLog "" - unusedbad <- readUnusedLog "bad" - unusedtmp <- readUnusedLog "tmp" - return $ map (start (unused, unusedbad, unusedtmp)) params +seek = [withUnusedMaps start] -start :: (UnusedMap, UnusedMap, UnusedMap) -> FilePath -> CommandStart -start (unused, unusedbad, unusedtmp) s = search - [ (unused, perform) - , (unusedbad, performOther gitAnnexBadLocation) - , (unusedtmp, performOther gitAnnexTmpLocation) - ] - where - search [] = stop - search ((m, a):rest) = - case M.lookup s m of - Nothing -> search rest - Just key -> do - showStart "dropunused" s - next $ a key +start :: UnusedMaps -> Int -> CommandStart +start = startUnused "dropunused" perform (performOther gitAnnexBadLocation) (performOther gitAnnexTmpLocation) perform :: Key -> CommandPerform perform key = maybe droplocal dropremote =<< Remote.byName =<< from @@ -66,15 +42,3 @@ performOther filespec key = do f <- fromRepo $ filespec key liftIO $ whenM (doesFileExist f) $ removeFile f next $ return True - -readUnusedLog :: FilePath -> Annex UnusedMap -readUnusedLog prefix = do - f <- fromRepo $ gitAnnexUnusedLog prefix - e <- liftIO $ doesFileExist f - if e - then M.fromList . map parse . lines <$> liftIO (readFile f) - else return M.empty - where - parse line = (num, fromJust $ readKey rest) - where - (num, rest) = separate (== ' ') line diff --git a/Command/Fsck.hs b/Command/Fsck.hs index dac3bfac9..38b1bbbac 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -85,7 +85,7 @@ performRemote key file backend numcopies remote = t <- fromRepo gitAnnexTmpDir let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key liftIO $ createDirectoryIfMissing True t - let cleanup = liftIO $ catchIO (removeFile tmp) (const $ return ()) + let cleanup = liftIO $ catchIO (removeFile tmp) (const noop) cleanup cleanup `after` a tmp getfile tmp = @@ -166,10 +166,9 @@ verifyLocationLog key desc = do -- Since we're checking that a key's file is present, throw -- in a permission fixup here too. when present $ do - f <- inRepo $ gitAnnexLocation key - liftIO $ do - preventWrite f - preventWrite (parentDir f) + file <- inRepo $ gitAnnexLocation key + freezeContent file + freezeContentDir file u <- getUUID verifyLocationLog' key desc present u (logChange key u) diff --git a/Command/Import.hs b/Command/Import.hs new file mode 100644 index 000000000..e27a421f2 --- /dev/null +++ b/Command/Import.hs @@ -0,0 +1,39 @@ +{- git-annex command + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Import where + +import Common.Annex +import Command +import qualified Annex +import qualified Command.Add + +def :: [Command] +def = [command "import" paramPaths seek "move and add files from outside git working copy"] + +seek :: [CommandSeek] +seek = [withPathContents start] + +start :: (FilePath, FilePath) -> CommandStart +start (srcfile, destfile) = notBareRepo $ + ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile) + ( do + showStart "import" destfile + next $ perform srcfile destfile + , stop + ) + +perform :: FilePath -> FilePath -> CommandPerform +perform srcfile destfile = do + whenM (liftIO $ doesFileExist destfile) $ + unlessM (Annex.getState Annex.force) $ + error $ "not overwriting existing " ++ destfile ++ + " (use --force to override)" + + liftIO $ createDirectoryIfMissing True (parentDir destfile) + liftIO $ moveFile srcfile destfile + Command.Add.perform destfile diff --git a/Command/Lock.hs b/Command/Lock.hs index b8aedb252..ab97b14bc 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -24,9 +24,5 @@ start file = do perform :: FilePath -> CommandPerform perform file = do - liftIO $ removeFile file - -- Checkout from HEAD to get rid of any changes that might be - -- staged in the index, and get back to the previous symlink to - -- the content. - Annex.Queue.add "checkout" [Param "HEAD", Param "--"] [file] + Annex.Queue.add "checkout" [Param "--"] [file] next $ return True -- no cleanup needed diff --git a/Command/Log.hs b/Command/Log.hs index d78b60206..aa39aea9c 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -133,7 +133,7 @@ compareChanges format changes = concatMap diff $ zip changes (drop 1 changes) - *lot* for newish files. -} getLog :: Key -> [CommandParam] -> Annex [String] getLog key os = do - top <- fromRepo Git.workTree + top <- fromRepo Git.repoPath p <- liftIO $ relPathCwdToFile top let logfile = p </> Logs.Location.logFile key inRepo $ pipeNullSplit $ diff --git a/Command/Map.hs b/Command/Map.hs index bdb86f95a..86e9609a7 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -156,14 +156,14 @@ absRepo :: Git.Repo -> Git.Repo -> Annex Git.Repo absRepo reference r | Git.repoIsUrl reference = return $ Git.Construct.localToUrl reference r | Git.repoIsUrl r = return r - | otherwise = liftIO $ Git.Construct.fromAbsPath =<< absPath (Git.workTree r) + | otherwise = liftIO $ Git.Construct.fromAbsPath =<< absPath (Git.repoPath r) {- Checks if two repos are the same. -} same :: Git.Repo -> Git.Repo -> Bool same a b - | both Git.repoIsSsh = matching Git.Url.authority && matching Git.workTree + | both Git.repoIsSsh = matching Git.Url.authority && matching Git.repoPath | both Git.repoIsUrl && neither Git.repoIsSsh = matching show - | neither Git.repoIsSsh = matching Git.workTree + | neither Git.repoIsSsh = matching Git.repoPath | otherwise = False where @@ -210,7 +210,7 @@ tryScan r where sshcmd = cddir ++ " && " ++ "git config --null --list" - dir = Git.workTree r + dir = Git.repoPath r cddir | "/~" `isPrefixOf` dir = let (userhome, reldir) = span (/= '/') (drop 1 dir) diff --git a/Command/Status.hs b/Command/Status.hs index 1ee36d8b4..2540a92da 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -30,6 +30,7 @@ import Logs.UUID import Logs.Trust import Remote import Config +import Utility.Percentage -- a named computation that produces a statistic type Stat = StatState (Maybe (String, StatState String)) @@ -69,6 +70,7 @@ fast_stats = , remote_list SemiTrusted "semitrusted" , remote_list UnTrusted "untrusted" , remote_list DeadTrusted "dead" + , disk_size ] slow_stats :: [Stat] slow_stats = @@ -78,7 +80,6 @@ slow_stats = , local_annex_size , known_annex_keys , known_annex_size - , disk_size , bloom_info , backend_usage ] @@ -108,12 +109,11 @@ nojson :: StatState String -> String -> StatState String nojson a _ = a showStat :: Stat -> StatState () -showStat s = calc =<< s +showStat s = maybe noop calc =<< s where - calc (Just (desc, a)) = do + calc (desc, a) = do (lift . showHeader) desc lift . showRaw =<< a - calc Nothing = return () supported_backends :: Stat supported_backends = stat "supported backends" $ json unwords $ @@ -161,7 +161,7 @@ bloom_info = stat "bloom filter size" $ json id $ do let note = aside $ if localkeys >= capacity then "appears too small for this repository; adjust annex.bloomcapacity" - else "has room for " ++ show (capacity - localkeys) ++ " more local annex keys" + else showPercentage 1 (percentage capacity localkeys) ++ " full" -- Two bloom filters are used at the same time, so double the size -- of one. @@ -176,8 +176,12 @@ disk_size = stat "available local disk space" $ json id $ lift $ <$> getDiskReserve <*> inRepo (getDiskFree . gitAnnexDir) where - calcfree reserve (Just have) = - roughSize storageUnits False $ nonneg $ have - reserve + calcfree reserve (Just have) = unwords + [ roughSize storageUnits False $ nonneg $ have - reserve + , "(+" ++ roughSize storageUnits False reserve + , "reserved)" + ] + calcfree _ _ = "unknown" nonneg x | x >= 0 = x diff --git a/Command/Sync.hs b/Command/Sync.hs index b9ef0bc97..5fb49d30c 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -57,10 +57,17 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) wanted | null rs = good =<< concat . byspeed <$> available | otherwise = listed - listed = catMaybes <$> mapM (Remote.byName . Just) rs + listed = do + l <- catMaybes <$> mapM (Remote.byName . Just) rs + let s = filter special l + unless (null s) $ + error $ "cannot sync special remotes: " ++ + unwords (map Types.Remote.name s) + return l available = filter nonspecial <$> Remote.enabledRemoteList good = filterM $ Remote.Git.repoAvail . Types.Remote.repo nonspecial r = Types.Remote.remotetype r == Remote.Git.remote + special = not . nonspecial fastest = fromMaybe [] . headMaybe . byspeed byspeed = map snd . sort . M.toList . costmap costmap = M.fromListWith (++) . map costpair diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 1e7313711..bf931adfd 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -10,7 +10,6 @@ module Command.Unannex where import Common.Annex import Command import qualified Annex -import Utility.FileMode import Logs.Location import Annex.Content import qualified Git.Command @@ -51,9 +50,8 @@ cleanup file key = do ( do -- fast mode: hard link to content in annex src <- inRepo $ gitAnnexLocation key - liftIO $ do - createLink src file - allowWrite file + liftIO $ createLink src file + thawContent file , do fromAnnex key file logStatus key InfoMissing diff --git a/Command/Unlock.hs b/Command/Unlock.hs index afee10145..f3ffd31ba 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -11,7 +11,6 @@ import Common.Annex import Command import Annex.Content import Utility.CopyFile -import Utility.FileMode def :: [Command] def = @@ -34,8 +33,7 @@ start file (key, _) = do perform :: FilePath -> Key -> CommandPerform perform dest key = do unlessM (inAnnex key) $ error "content not present" - - checkDiskSpace key + unlessM (checkDiskSpace Nothing key 0) $ error "cannot unlock" src <- inRepo $ gitAnnexLocation key tmpdest <- fromRepo $ gitAnnexTmpLocation key @@ -47,6 +45,6 @@ perform dest key = do liftIO $ do removeFile dest moveFile tmpdest dest - allowWrite dest + thawContent dest next $ return True else error "copy failed!" diff --git a/Command/Unused.hs b/Command/Unused.hs index bc721635b..1224d0545 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -19,9 +19,9 @@ import Control.Monad.ST import Common.Annex import Command +import Logs.Unused import Annex.Content import Utility.FileMode -import Utility.TempFile import Logs.Location import Config import qualified Annex @@ -91,19 +91,13 @@ check file msg a c = do l <- a let unusedlist = number c l unless (null l) $ showLongNote $ msg unusedlist - writeUnusedFile file unusedlist + writeUnusedLog file unusedlist return $ c + length l number :: Int -> [a] -> [(Int, a)] number _ [] = [] number n (x:xs) = (n+1, x) : number (n+1) xs -writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex () -writeUnusedFile prefix l = do - logfile <- fromRepo $ gitAnnexUnusedLog prefix - liftIO $ viaTmp writeFile logfile $ - unlines $ map (\(n, k) -> show n ++ " " ++ show k) l - table :: [(Int, Key)] -> [String] table l = " NUMBER KEY" : map cols l where @@ -189,10 +183,10 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller -} bloomCapacity :: Annex Int bloomCapacity = fromMaybe 500000 . readish - <$> getConfig "annex.bloomcapacity" "" + <$> getConfig (annexConfig "bloomcapacity") "" bloomAccuracy :: Annex Int bloomAccuracy = fromMaybe 1000 . readish - <$> getConfig "annex.bloomaccuracy" "" + <$> getConfig (annexConfig "bloomaccuracy") "" bloomBitsHashes :: Annex (Int, Int) bloomBitsHashes = do capacity <- bloomCapacity @@ -237,7 +231,7 @@ withKeysReferenced' :: v -> (Key -> v -> Annex v) -> Annex v withKeysReferenced' initial a = go initial =<< files where files = do - top <- fromRepo Git.workTree + top <- fromRepo Git.repoPath inRepo $ LsFiles.inRepo [top] go v [] = return v go v (f:fs) = do @@ -268,7 +262,7 @@ withKeysReferencedInGitRef a ref = do showAction $ "checking " ++ Git.Ref.describe ref go =<< inRepo (LsTree.lsTree ref) where - go [] = return () + go [] = noop go (l:ls) | isSymLink (LsTree.mode l) = do content <- L.decodeUtf8 <$> catFile ref (LsTree.file l) diff --git a/Command/Whereis.hs b/Command/Whereis.hs index d4d268d93..eb6ea7c56 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -46,9 +46,9 @@ perform remotemap key = do untrustedheader = "The following untrusted locations may also have copies:\n" performRemote :: Key -> Remote -> Annex () -performRemote key remote = case whereisKey remote of - Nothing -> return () - Just a -> do - ls <- a key - unless (null ls) $ showLongNote $ - unlines $ map (\l -> name remote ++ ": " ++ l) ls +performRemote key remote = maybe noop go $ whereisKey remote + where + go a = do + ls <- a key + unless (null ls) $ showLongNote $ unlines $ + map (\l -> name remote ++ ": " ++ l) ls |