git-annex/Command/Import.hs

143 lines
4.4 KiB
Haskell
Raw Normal View History

{- git-annex command
-
- Copyright 2012-2013 Joey Hess <id@joeyh.name>
-
- 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
import Utility.CopyFile
import Backend
import Remote
import Types.KeySource
import Types.Key
import Annex.CheckIgnore
import Annex.NumCopies
import Types.TrustLevel
import Logs.Trust
cmd :: [Command]
cmd = [withOptions opts $ notBareRepo $ command "import" paramPaths seek
SectionCommon "move and add files from outside git working copy"]
opts :: [Option]
opts = duplicateModeOptions ++ fileMatchingOptions
data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates
deriving (Eq, Enum, Bounded)
associatedOption :: DuplicateMode -> Maybe Option
associatedOption Default = Nothing
associatedOption Duplicate = Just $
flagOption [] "duplicate" "do not delete source files"
associatedOption DeDuplicate = Just $
flagOption [] "deduplicate" "delete source files whose content was imported before"
associatedOption CleanDuplicates = Just $
flagOption [] "clean-duplicates" "delete duplicate source files (import nothing)"
associatedOption SkipDuplicates = Just $
flagOption [] "skip-duplicates" "import only new files"
duplicateModeOptions :: [Option]
duplicateModeOptions = mapMaybe associatedOption [minBound..maxBound]
getDuplicateMode :: Annex DuplicateMode
getDuplicateMode = go . catMaybes <$> mapM getflag [minBound..maxBound]
where
getflag m = case associatedOption m of
Nothing -> return Nothing
Just o -> ifM (Annex.getFlag (optionName o))
( return (Just m)
, return Nothing
)
go [] = Default
go [m] = m
go ms = error $ "cannot combine " ++
unwords (map (optionParam . fromJust . associatedOption) ms)
seek :: CommandSeek
seek ps = do
mode <- getDuplicateMode
withPathContents (start mode) ps
start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart
start mode (srcfile, destfile) =
ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile)
( do
ma <- pickaction
case ma of
Nothing -> stop
Just a -> do
showStart "import" destfile
next a
, stop
)
where
deletedup k = do
showNote $ "duplicate of " ++ key2file k
ifM (verifiedExisting k destfile)
( do
liftIO $ removeFile srcfile
next $ return True
, do
2015-04-30 18:10:28 +00:00
warning "Could not verify that the content is still present in the annex; not removing from the import location."
stop
)
importfile = do
ignored <- not <$> Annex.getState Annex.force <&&> checkIgnored destfile
if ignored
then do
warning $ "not importing " ++ destfile ++ " which is .gitignored (use --force to override)"
stop
else do
existing <- liftIO (catchMaybeIO $ getSymbolicLinkStatus destfile)
case existing of
Nothing -> importfilechecked
(Just s)
| isDirectory s -> notoverwriting "(is a directory)"
| otherwise -> ifM (Annex.getState Annex.force)
( do
liftIO $ nukeFile destfile
importfilechecked
, notoverwriting "(use --force to override, or a duplication option such as --deduplicate to clean up)"
)
importfilechecked = do
liftIO $ createDirectoryIfMissing True (parentDir destfile)
liftIO $ if mode == Duplicate || mode == SkipDuplicates
then void $ copyFileExternal CopyAllMetaData srcfile destfile
else moveFile srcfile destfile
Command.Add.perform destfile
notoverwriting why = do
warning $ "not overwriting existing " ++ destfile ++ " " ++ why
stop
checkdup dupa notdupa = do
backend <- chooseBackend destfile
let ks = KeySource srcfile srcfile Nothing
v <- genKey ks backend
case v of
Just (k, _) -> ifM (not . null <$> keyLocations k)
( return (maybe Nothing (\a -> Just (a k)) dupa)
, return notdupa
)
_ -> return notdupa
pickaction = case mode of
DeDuplicate -> checkdup (Just deletedup) (Just importfile)
CleanDuplicates -> checkdup (Just deletedup) Nothing
SkipDuplicates -> checkdup Nothing (Just importfile)
_ -> return (Just importfile)
verifiedExisting :: Key -> FilePath -> Annex Bool
verifiedExisting key destfile = do
-- Look up the numcopies setting for the file that it would be
-- imported to, if it were imported.
need <- getFileNumCopies destfile
(remotes, trusteduuids) <- knownCopies key
untrusteduuids <- trustGet UnTrusted
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
verifyEnoughCopies [] key need trusteduuids [] tocheck