Merge branch 'master' into concurrentprogress
Conflicts: Command/Fsck.hs Messages.hs Remote/Directory.hs Remote/Git.hs Remote/Helper/Special.hs Types/Remote.hs debian/changelog git-annex.cabal
This commit is contained in:
commit
e27b97d364
378 changed files with 4978 additions and 1158 deletions
|
@ -116,7 +116,10 @@ start file = ifAnnexed file addpresent add
|
|||
- Lockdown can fail if a file gets deleted, and Nothing will be returned.
|
||||
-}
|
||||
lockDown :: FilePath -> Annex (Maybe KeySource)
|
||||
lockDown = either (\e -> showErr e >> return Nothing) (return . Just) <=< lockDown'
|
||||
lockDown = either
|
||||
(\e -> warning (show e) >> return Nothing)
|
||||
(return . Just)
|
||||
<=< lockDown'
|
||||
|
||||
lockDown' :: FilePath -> Annex (Either IOException KeySource)
|
||||
lockDown' file = ifM crippledFileSystem
|
||||
|
|
|
@ -178,7 +178,7 @@ startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring
|
|||
pathmax <- liftIO $ fileNameLengthLimit "."
|
||||
let file = flip fromMaybe optfile $
|
||||
truncateFilePath pathmax $ sanitizeFilePath $
|
||||
Quvi.pageTitle page ++ "." ++ Quvi.linkSuffix link
|
||||
Quvi.pageTitle page ++ "." ++ fromMaybe "m" (Quvi.linkSuffix link)
|
||||
showStart "addurl" file
|
||||
next $ performQuvi relaxed urlstring (Quvi.linkUrl link) file
|
||||
#else
|
||||
|
|
|
@ -20,7 +20,7 @@ import Assistant.Install
|
|||
import System.Environment
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [noRepo checkAutoStart $ dontCheck repoExists $ withOptions options $
|
||||
cmd = [noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $
|
||||
notBareRepo $ command "assistant" paramNothing seek SectionCommon
|
||||
"automatically sync changes"]
|
||||
|
||||
|
@ -30,11 +30,15 @@ options =
|
|||
, Command.Watch.stopOption
|
||||
, autoStartOption
|
||||
, startDelayOption
|
||||
, autoStopOption
|
||||
]
|
||||
|
||||
autoStartOption :: Option
|
||||
autoStartOption = flagOption [] "autostart" "start in known repositories"
|
||||
|
||||
autoStopOption :: Option
|
||||
autoStopOption = flagOption [] "autostop" "stop in known repositories"
|
||||
|
||||
startDelayOption :: Option
|
||||
startDelayOption = fieldOption [] "startdelay" paramNumber "delay before running startup scan"
|
||||
|
||||
|
@ -43,25 +47,31 @@ seek ps = do
|
|||
stopdaemon <- getOptionFlag Command.Watch.stopOption
|
||||
foreground <- getOptionFlag Command.Watch.foregroundOption
|
||||
autostart <- getOptionFlag autoStartOption
|
||||
autostop <- getOptionFlag autoStopOption
|
||||
startdelay <- getOptionField startDelayOption (pure . maybe Nothing parseDuration)
|
||||
withNothing (start foreground stopdaemon autostart startdelay) ps
|
||||
withNothing (start foreground stopdaemon autostart autostop startdelay) ps
|
||||
|
||||
start :: Bool -> Bool -> Bool -> Maybe Duration -> CommandStart
|
||||
start foreground stopdaemon autostart startdelay
|
||||
start :: Bool -> Bool -> Bool -> Bool -> Maybe Duration -> CommandStart
|
||||
start foreground stopdaemon autostart autostop startdelay
|
||||
| autostart = do
|
||||
liftIO $ autoStart startdelay
|
||||
stop
|
||||
| autostop = do
|
||||
liftIO autoStop
|
||||
stop
|
||||
| otherwise = do
|
||||
liftIO ensureInstalled
|
||||
ensureInitialized
|
||||
Command.Watch.start True foreground stopdaemon startdelay
|
||||
|
||||
{- Run outside a git repository. Check to see if any parameter is
|
||||
- --autostart and enter autostart mode. -}
|
||||
checkAutoStart :: CmdParams -> IO ()
|
||||
checkAutoStart _ = ifM (elem "--autostart" <$> getArgs)
|
||||
{- Run outside a git repository; support autostart and autostop mode. -}
|
||||
checkNoRepoOpts :: CmdParams -> IO ()
|
||||
checkNoRepoOpts _ = ifM (elem "--autostart" <$> getArgs)
|
||||
( autoStart Nothing
|
||||
, error "Not in a git repository."
|
||||
, ifM (elem "--autostop" <$> getArgs)
|
||||
( autoStop
|
||||
, error "Not in a git repository."
|
||||
)
|
||||
)
|
||||
|
||||
autoStart :: Maybe Duration -> IO ()
|
||||
|
@ -89,3 +99,15 @@ autoStart startdelay = do
|
|||
[ Param "assistant"
|
||||
, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) startdelay)
|
||||
]
|
||||
|
||||
autoStop :: IO ()
|
||||
autoStop = do
|
||||
dirs <- liftIO readAutoStartFile
|
||||
program <- programPath
|
||||
forM_ dirs $ \d -> do
|
||||
putStrLn $ "git-annex autostop in " ++ d
|
||||
setCurrentDirectory d
|
||||
ifM (boolSystem program [Param "assistant", Param "--stop"])
|
||||
( putStrLn "ok"
|
||||
, putStrLn "failed"
|
||||
)
|
||||
|
|
|
@ -9,19 +9,20 @@ module Command.ContentLocation where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import CmdLine.Batch
|
||||
import Annex.Content
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [noCommit $ noMessages $
|
||||
cmd = [withOptions [batchOption] $ noCommit $ noMessages $
|
||||
command "contentlocation" (paramRepeating paramKey) seek
|
||||
SectionPlumbing "looks up content for a key"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek = withKeys start
|
||||
seek = batchable withKeys start
|
||||
|
||||
start :: Key -> CommandStart
|
||||
start k = do
|
||||
liftIO . maybe exitFailure putStrLn
|
||||
start :: Batchable Key
|
||||
start batchmode k = do
|
||||
maybe (batchBadInput batchmode) (liftIO . putStrLn)
|
||||
=<< inAnnex' (pure True) Nothing check k
|
||||
stop
|
||||
where
|
||||
|
|
|
@ -12,7 +12,7 @@ import Command
|
|||
import qualified Command.Move
|
||||
import qualified Remote
|
||||
import Annex.Wanted
|
||||
import Config.NumCopies
|
||||
import Annex.NumCopies
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [withOptions copyOptions $ command "copy" paramPaths seek
|
||||
|
|
|
@ -15,7 +15,7 @@ import Annex.UUID
|
|||
import Logs.Location
|
||||
import Logs.Trust
|
||||
import Logs.PreferredContent
|
||||
import Config.NumCopies
|
||||
import Annex.NumCopies
|
||||
import Annex.Content
|
||||
import Annex.Wanted
|
||||
import Annex.Notification
|
||||
|
@ -27,7 +27,7 @@ cmd = [withOptions (dropOptions) $ command "drop" paramPaths seek
|
|||
SectionCommon "indicate content of files not currently wanted"]
|
||||
|
||||
dropOptions :: [Option]
|
||||
dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption]
|
||||
dropOptions = dropFromOption : annexedMatchingOptions ++ [autoOption] ++ keyOptions
|
||||
|
||||
dropFromOption :: Option
|
||||
dropFromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
|
||||
|
@ -36,23 +36,32 @@ seek :: CommandSeek
|
|||
seek ps = do
|
||||
from <- getOptionField dropFromOption Remote.byNameWithUUID
|
||||
auto <- getOptionFlag autoOption
|
||||
withFilesInGit (whenAnnexed $ start auto from) ps
|
||||
withKeyOptions auto
|
||||
(startKeys auto from)
|
||||
(withFilesInGit $ whenAnnexed $ start auto from)
|
||||
ps
|
||||
|
||||
start :: Bool -> Maybe Remote -> FilePath -> Key -> CommandStart
|
||||
start auto from file key = checkDropAuto auto from file key $ \numcopies ->
|
||||
start auto from file key = start' auto from key (Just file)
|
||||
|
||||
start' :: Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
|
||||
start' auto from key afile = checkDropAuto auto from afile key $ \numcopies ->
|
||||
stopUnless want $
|
||||
case from of
|
||||
Nothing -> startLocal (Just file) numcopies key Nothing
|
||||
Nothing -> startLocal afile numcopies key Nothing
|
||||
Just remote -> do
|
||||
u <- getUUID
|
||||
if Remote.uuid remote == u
|
||||
then startLocal (Just file) numcopies key Nothing
|
||||
else startRemote (Just file) numcopies key remote
|
||||
then startLocal afile numcopies key Nothing
|
||||
else startRemote afile numcopies key remote
|
||||
where
|
||||
want
|
||||
| auto = wantDrop False (Remote.uuid <$> from) (Just key) (Just file)
|
||||
| auto = wantDrop False (Remote.uuid <$> from) (Just key) afile
|
||||
| otherwise = return True
|
||||
|
||||
startKeys :: Bool -> Maybe Remote -> Key -> CommandStart
|
||||
startKeys auto from key = start' auto from key Nothing
|
||||
|
||||
startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
|
||||
startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
|
||||
showStart' "drop" key afile
|
||||
|
@ -72,7 +81,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ \content
|
|||
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
|
||||
let trusteduuids' = case knownpresentremote of
|
||||
Nothing -> trusteduuids
|
||||
Just r -> nub (Remote.uuid r:trusteduuids)
|
||||
Just r -> Remote.uuid r:trusteduuids
|
||||
untrusteduuids <- trustGet UnTrusted
|
||||
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
|
||||
u <- getUUID
|
||||
|
@ -91,17 +100,9 @@ performRemote key afile numcopies remote = do
|
|||
-- Filter the remote it's being dropped from out of the lists of
|
||||
-- places assumed to have the key, and places to check.
|
||||
-- When the local repo has the key, that's one additional copy,
|
||||
-- as long asthe local repo is not untrusted.
|
||||
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
|
||||
present <- inAnnex key
|
||||
u <- getUUID
|
||||
trusteduuids' <- if present
|
||||
then ifM ((<= SemiTrusted) <$> lookupTrust u)
|
||||
( pure (u:trusteduuids)
|
||||
, pure trusteduuids
|
||||
)
|
||||
else pure trusteduuids
|
||||
let have = filter (/= uuid) trusteduuids'
|
||||
-- as long as the local repo is not untrusted.
|
||||
(remotes, trusteduuids) <- knownCopies key
|
||||
let have = filter (/= uuid) trusteduuids
|
||||
untrusteduuids <- trustGet UnTrusted
|
||||
let tocheck = filter (/= remote) $
|
||||
Remote.remotesWithoutUUID remotes (have++untrusteduuids)
|
||||
|
@ -131,45 +132,20 @@ cleanupRemote key remote ok = do
|
|||
- --force overrides and always allows dropping.
|
||||
-}
|
||||
canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
|
||||
canDrop dropfrom key afile numcopies have check skip = ifM (Annex.getState Annex.force)
|
||||
( return True
|
||||
, checkRequiredContent dropfrom key afile
|
||||
<&&>
|
||||
findCopies key numcopies skip have check
|
||||
)
|
||||
|
||||
findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
|
||||
findCopies key need skip = helper [] []
|
||||
canDrop dropfrom key afile numcopies have check skip =
|
||||
ifM (Annex.getState Annex.force)
|
||||
( return True
|
||||
, ifM (checkRequiredContent dropfrom key afile
|
||||
<&&> verifyEnoughCopies nolocmsg key numcopies skip have check
|
||||
)
|
||||
( return True
|
||||
, do
|
||||
hint
|
||||
return False
|
||||
)
|
||||
)
|
||||
where
|
||||
helper bad missing have []
|
||||
| NumCopies (length have) >= need = return True
|
||||
| otherwise = notEnoughCopies key need have (skip++missing) bad
|
||||
helper bad missing have (r:rs)
|
||||
| NumCopies (length have) >= need = return True
|
||||
| otherwise = do
|
||||
let u = Remote.uuid r
|
||||
let duplicate = u `elem` have
|
||||
haskey <- Remote.hasKey r key
|
||||
case (duplicate, haskey) of
|
||||
(False, Right True) -> helper bad missing (u:have) rs
|
||||
(False, Left _) -> helper (r:bad) missing have rs
|
||||
(False, Right False) -> helper bad (u:missing) have rs
|
||||
_ -> helper bad missing have rs
|
||||
|
||||
notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
|
||||
notEnoughCopies key need have skip bad = do
|
||||
unsafe
|
||||
showLongNote $
|
||||
"Could only verify the existence of " ++
|
||||
show (length have) ++ " out of " ++ show (fromNumCopies need) ++
|
||||
" necessary copies"
|
||||
Remote.showTriedRemotes bad
|
||||
Remote.showLocations True key (have++skip)
|
||||
"Rather than dropping this file, try using: git annex move"
|
||||
hint
|
||||
return False
|
||||
where
|
||||
unsafe = showNote "unsafe"
|
||||
nolocmsg = "Rather than dropping this file, try using: git annex move"
|
||||
hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"
|
||||
|
||||
checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool
|
||||
|
@ -187,8 +163,8 @@ requiredContent = do
|
|||
|
||||
{- In auto mode, only runs the action if there are enough
|
||||
- copies on other semitrusted repositories. -}
|
||||
checkDropAuto :: Bool -> Maybe Remote -> FilePath -> Key -> (NumCopies -> CommandStart) -> CommandStart
|
||||
checkDropAuto auto mremote file key a = go =<< getFileNumCopies file
|
||||
checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> CommandStart) -> CommandStart
|
||||
checkDropAuto auto mremote afile key a = go =<< maybe getNumCopies getFileNumCopies afile
|
||||
where
|
||||
go numcopies
|
||||
| auto = do
|
||||
|
|
|
@ -14,7 +14,7 @@ import qualified Command.Drop
|
|||
import qualified Remote
|
||||
import qualified Git
|
||||
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
|
||||
import Config.NumCopies
|
||||
import Annex.NumCopies
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [withOptions [Command.Drop.dropFromOption] $
|
||||
|
|
|
@ -9,21 +9,22 @@ module Command.ExamineKey where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import CmdLine.Batch
|
||||
import qualified Utility.Format
|
||||
import Command.Find (formatOption, getFormat, showFormatted, keyVars)
|
||||
import Types.Key
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption] $
|
||||
cmd = [noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $
|
||||
command "examinekey" (paramRepeating paramKey) seek
|
||||
SectionPlumbing "prints information from a key"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek ps = do
|
||||
format <- getFormat
|
||||
withKeys (start format) ps
|
||||
batchable withKeys (start format) ps
|
||||
|
||||
start :: Maybe Utility.Format.Format -> Key -> CommandStart
|
||||
start format key = do
|
||||
start :: Maybe Utility.Format.Format -> Batchable Key
|
||||
start format _ key = do
|
||||
showFormatted format (key2file key) (keyVars key)
|
||||
stop
|
||||
|
|
|
@ -24,21 +24,21 @@ import Annex.Link
|
|||
import Logs.Location
|
||||
import Logs.Trust
|
||||
import Logs.Activity
|
||||
import Config.NumCopies
|
||||
import Logs.TimeStamp
|
||||
import Annex.NumCopies
|
||||
import Annex.UUID
|
||||
import Utility.DataUnits
|
||||
import Config
|
||||
import Types.Key
|
||||
import Types.CleanupActions
|
||||
import Utility.HumanTime
|
||||
import Utility.CopyFile
|
||||
import Git.FilePath
|
||||
import Utility.PID
|
||||
import qualified Database.Fsck as FsckDb
|
||||
|
||||
import Data.Time.Clock.POSIX
|
||||
import Data.Time
|
||||
import System.Posix.Types (EpochTime)
|
||||
import System.Locale
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [withOptions fsckOptions $ command "fsck" paramPaths seek
|
||||
|
@ -75,7 +75,7 @@ seek ps = do
|
|||
(withFilesInGit $ whenAnnexed $ start from i)
|
||||
ps
|
||||
withFsckDb i FsckDb.closeDb
|
||||
recordActivity Fsck u
|
||||
void $ tryIO $ recordActivity Fsck u
|
||||
|
||||
start :: Maybe Remote -> Incremental -> FilePath -> Key -> CommandStart
|
||||
start from inc file key = do
|
||||
|
@ -111,14 +111,15 @@ performRemote key file backend numcopies remote =
|
|||
dispatch (Left err) = do
|
||||
showNote err
|
||||
return False
|
||||
dispatch (Right True) = withtmp $ \tmpfile ->
|
||||
ifM (getfile tmpfile)
|
||||
( go True (Just tmpfile)
|
||||
, do
|
||||
dispatch (Right True) = withtmp $ \tmpfile -> do
|
||||
r <- getfile tmpfile
|
||||
case r of
|
||||
Nothing -> go True Nothing
|
||||
Just True -> go True (Just tmpfile)
|
||||
Just False -> do
|
||||
warning "failed to download file from remote"
|
||||
void $ go True Nothing
|
||||
return False
|
||||
)
|
||||
dispatch (Right False) = go False Nothing
|
||||
go present localcopy = check
|
||||
[ verifyLocationLogRemote key file remote present
|
||||
|
@ -134,14 +135,17 @@ performRemote key file backend numcopies remote =
|
|||
let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
|
||||
cleanup
|
||||
cleanup `after` a tmp
|
||||
getfile tmp =
|
||||
ifM (Remote.retrieveKeyFileCheap remote key (Just file) tmp)
|
||||
( return True
|
||||
getfile tmp = ifM (checkDiskSpace (Just tmp) key 0)
|
||||
( ifM (Remote.retrieveKeyFileCheap remote key (Just file) tmp)
|
||||
( return (Just True)
|
||||
, ifM (Annex.getState Annex.fast)
|
||||
( return False
|
||||
, Remote.retrieveKeyFile remote key (Just file) tmp dummymeter
|
||||
( return Nothing
|
||||
, Just <$>
|
||||
Remote.retrieveKeyFile remote key Nothing tmp dummymeter
|
||||
)
|
||||
)
|
||||
, return (Just False)
|
||||
)
|
||||
dummymeter _ = noop
|
||||
|
||||
startKey :: Incremental -> Key -> NumCopies -> CommandStart
|
||||
|
@ -273,7 +277,7 @@ checkKeySize key = ifM isDirect
|
|||
checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool
|
||||
checkKeySizeRemote _ _ Nothing = return True
|
||||
checkKeySizeRemote key remote (Just file) =
|
||||
checkKeySizeOr (badContentRemote remote) key file
|
||||
checkKeySizeOr (badContentRemote remote file) key file
|
||||
|
||||
checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> Annex Bool
|
||||
checkKeySizeOr bad key file = case Types.Key.keySize key of
|
||||
|
@ -318,7 +322,7 @@ checkBackend backend key mfile = go =<< isDirect
|
|||
checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
|
||||
checkBackendRemote backend key remote = maybe (return True) go
|
||||
where
|
||||
go = checkBackendOr (badContentRemote remote) backend key
|
||||
go file = checkBackendOr (badContentRemote remote file) backend key file
|
||||
|
||||
checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool
|
||||
checkBackendOr bad backend key file =
|
||||
|
@ -380,13 +384,36 @@ badContentDirect file key = do
|
|||
logStatus key InfoMissing
|
||||
return "left in place for you to examine"
|
||||
|
||||
badContentRemote :: Remote -> Key -> Annex String
|
||||
badContentRemote remote key = do
|
||||
ok <- Remote.removeKey remote key
|
||||
when ok $
|
||||
{- Bad content is dropped from the remote. We have downloaded a copy
|
||||
- from the remote to a temp file already (in some cases, it's just a
|
||||
- symlink to a file in the remote). To avoid any further data loss,
|
||||
- that temp file is moved to the bad content directory unless
|
||||
- the local annex has a copy of the content. -}
|
||||
badContentRemote :: Remote -> FilePath -> Key -> Annex String
|
||||
badContentRemote remote localcopy key = do
|
||||
bad <- fromRepo gitAnnexBadDir
|
||||
let destbad = bad </> key2file key
|
||||
movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
|
||||
( return False
|
||||
, do
|
||||
createAnnexDirectory (parentDir destbad)
|
||||
liftIO $ catchDefaultIO False $
|
||||
ifM (isSymbolicLink <$> getSymbolicLinkStatus localcopy)
|
||||
( copyFileExternal CopyTimeStamps localcopy destbad
|
||||
, do
|
||||
moveFile localcopy destbad
|
||||
return True
|
||||
)
|
||||
)
|
||||
|
||||
dropped <- Remote.removeKey remote key
|
||||
when dropped $
|
||||
Remote.logStatus remote key InfoMissing
|
||||
return $ (if ok then "dropped from " else "failed to drop from ")
|
||||
++ Remote.name remote
|
||||
return $ case (movedbad, dropped) of
|
||||
(True, True) -> "moved from " ++ Remote.name remote ++
|
||||
" to " ++ destbad
|
||||
(False, True) -> "dropped from " ++ Remote.name remote
|
||||
(_, False) -> "failed to drop from" ++ Remote.name remote
|
||||
|
||||
runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart
|
||||
runFsck inc file key a = ifM (needFsck inc key)
|
||||
|
@ -448,14 +475,11 @@ getStartTime u = do
|
|||
liftIO $ catchDefaultIO Nothing $ do
|
||||
timestamp <- modificationTime <$> getFileStatus f
|
||||
let fromstatus = Just (realToFrac timestamp)
|
||||
fromfile <- readishTime <$> readFile f
|
||||
fromfile <- parsePOSIXTime <$> readFile f
|
||||
return $ if matchingtimestamp fromfile fromstatus
|
||||
then Just timestamp
|
||||
else Nothing
|
||||
where
|
||||
readishTime :: String -> Maybe POSIXTime
|
||||
readishTime s = utcTimeToPOSIXSeconds <$>
|
||||
parseTime defaultTimeLocale "%s%Qs" s
|
||||
matchingtimestamp fromfile fromstatus =
|
||||
#ifndef mingw32_HOST_OS
|
||||
fromfile == fromstatus
|
||||
|
|
|
@ -12,7 +12,7 @@ import Command
|
|||
import qualified Remote
|
||||
import Annex.Content
|
||||
import Annex.Transfer
|
||||
import Config.NumCopies
|
||||
import Annex.NumCopies
|
||||
import Annex.Wanted
|
||||
import qualified Command.Move
|
||||
|
||||
|
|
|
@ -8,13 +8,9 @@
|
|||
module Command.GroupWanted where
|
||||
|
||||
import Common.Annex
|
||||
import qualified Annex
|
||||
import Command
|
||||
import Logs.PreferredContent
|
||||
import Types.Messages
|
||||
import Types.Group
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Command.Wanted (performGet, performSet)
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [command "groupwanted" (paramPair paramGroup (paramOptional paramExpression)) seek
|
||||
|
@ -24,22 +20,8 @@ seek :: CommandSeek
|
|||
seek = withWords start
|
||||
|
||||
start :: [String] -> CommandStart
|
||||
start (g:[]) = next $ performGet g
|
||||
start (g:[]) = next $ performGet groupPreferredContentMapRaw g
|
||||
start (g:expr:[]) = do
|
||||
showStart "groupwanted" g
|
||||
next $ performSet g expr
|
||||
next $ performSet groupPreferredContentSet expr g
|
||||
start _ = error "Specify a group."
|
||||
|
||||
performGet :: Group -> CommandPerform
|
||||
performGet g = do
|
||||
Annex.setOutput QuietOutput
|
||||
m <- groupPreferredContentMapRaw
|
||||
liftIO $ putStrLn $ fromMaybe "" $ M.lookup g m
|
||||
next $ return True
|
||||
|
||||
performSet :: Group -> String -> CommandPerform
|
||||
performSet g expr = case checkPreferredContentExpression expr of
|
||||
Just e -> error $ "Parse error: " ++ e
|
||||
Nothing -> do
|
||||
groupPreferredContentSet g expr
|
||||
next $ return True
|
||||
|
|
|
@ -9,6 +9,7 @@ module Command.Import where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import qualified Git
|
||||
import qualified Annex
|
||||
import qualified Command.Add
|
||||
import Utility.CopyFile
|
||||
|
@ -16,6 +17,10 @@ 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
|
||||
|
@ -58,6 +63,10 @@ getDuplicateMode = go . catMaybes <$> mapM getflag [minBound..maxBound]
|
|||
seek :: CommandSeek
|
||||
seek ps = do
|
||||
mode <- getDuplicateMode
|
||||
repopath <- liftIO . absPath =<< fromRepo Git.repoPath
|
||||
inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath ps
|
||||
unless (null inrepops) $ do
|
||||
error $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
|
||||
withPathContents (start mode) ps
|
||||
|
||||
start :: DuplicateMode -> (FilePath, FilePath) -> CommandStart
|
||||
|
@ -75,23 +84,41 @@ start mode (srcfile, destfile) =
|
|||
where
|
||||
deletedup k = do
|
||||
showNote $ "duplicate of " ++ key2file k
|
||||
liftIO $ removeFile srcfile
|
||||
next $ return True
|
||||
ifM (verifiedExisting k destfile)
|
||||
( do
|
||||
liftIO $ removeFile srcfile
|
||||
next $ return True
|
||||
, do
|
||||
warning "Could not verify that the content is still present in the annex; not removing from the import location."
|
||||
stop
|
||||
)
|
||||
importfile = do
|
||||
handleexisting =<< liftIO (catchMaybeIO $ getSymbolicLinkStatus destfile)
|
||||
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
|
||||
handleexisting Nothing = noop
|
||||
handleexisting (Just s)
|
||||
| isDirectory s = notoverwriting "(is a directory)"
|
||||
| otherwise = ifM (Annex.getState Annex.force)
|
||||
( liftIO $ nukeFile destfile
|
||||
, notoverwriting "(use --force to override, or a duplication option such as --deduplicate to clean up)"
|
||||
)
|
||||
notoverwriting why = error $ "not overwriting existing " ++ destfile ++ " " ++ why
|
||||
notoverwriting why = do
|
||||
warning $ "not overwriting existing " ++ destfile ++ " " ++ why
|
||||
stop
|
||||
checkdup dupa notdupa = do
|
||||
backend <- chooseBackend destfile
|
||||
let ks = KeySource srcfile srcfile Nothing
|
||||
|
@ -107,3 +134,14 @@ start mode (srcfile, destfile) =
|
|||
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
|
||||
|
|
|
@ -16,7 +16,9 @@ import qualified Data.Set as S
|
|||
import qualified Data.Map as M
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Format
|
||||
#if ! MIN_VERSION_time(1,5,0)
|
||||
import System.Locale
|
||||
#endif
|
||||
|
||||
import Common.Annex
|
||||
import qualified Annex
|
||||
|
@ -196,7 +198,7 @@ performDownload opts cache todownload = case location todownload of
|
|||
Just link -> do
|
||||
let videourl = Quvi.linkUrl link
|
||||
checkknown videourl $
|
||||
rundownload videourl ("." ++ Quvi.linkSuffix link) $ \f ->
|
||||
rundownload videourl ("." ++ fromMaybe "m" (Quvi.linkSuffix link)) $ \f ->
|
||||
maybeToList <$> addUrlFileQuvi (relaxedOpt opts) quviurl videourl f
|
||||
#else
|
||||
return False
|
||||
|
|
|
@ -30,7 +30,7 @@ import Types.Key
|
|||
import Logs.UUID
|
||||
import Logs.Trust
|
||||
import Logs.Location
|
||||
import Config.NumCopies
|
||||
import Annex.NumCopies
|
||||
import Remote
|
||||
import Config
|
||||
import Utility.Percentage
|
||||
|
|
|
@ -5,15 +5,19 @@
|
|||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Command.Log where
|
||||
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import Data.Char
|
||||
import Data.Time.Clock.POSIX
|
||||
import Data.Time
|
||||
#if ! MIN_VERSION_time(1,5,0)
|
||||
import System.Locale
|
||||
import Data.Char
|
||||
#endif
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
|
@ -172,7 +176,11 @@ parseRaw l = go $ words l
|
|||
|
||||
parseTimeStamp :: String -> POSIXTime
|
||||
parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (error "bad timestamp") .
|
||||
#if MIN_VERSION_time(1,5,0)
|
||||
parseTimeM True defaultTimeLocale "%s"
|
||||
#else
|
||||
parseTime defaultTimeLocale "%s"
|
||||
#endif
|
||||
|
||||
showTimeStamp :: TimeZone -> POSIXTime -> String
|
||||
showTimeStamp zone = show . utcToLocalTime zone . posixSecondsToUTCTime
|
||||
|
|
|
@ -9,18 +9,20 @@ module Command.LookupKey where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import CmdLine.Batch
|
||||
import Annex.CatFile
|
||||
import Types.Key
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [notBareRepo $ noCommit $ noMessages $
|
||||
cmd = [withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $
|
||||
command "lookupkey" (paramRepeating paramFile) seek
|
||||
SectionPlumbing "looks up key used for file"]
|
||||
|
||||
seek :: CommandSeek
|
||||
seek = withStrings start
|
||||
seek = batchable withStrings start
|
||||
|
||||
start :: String -> CommandStart
|
||||
start file = do
|
||||
liftIO . maybe exitFailure (putStrLn . key2file) =<< catKeyFile file
|
||||
start :: Batchable String
|
||||
start batchmode file = do
|
||||
maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file)
|
||||
=<< catKeyFile file
|
||||
stop
|
||||
|
|
|
@ -14,7 +14,7 @@ import qualified Command.Drop
|
|||
import qualified Command.Get
|
||||
import qualified Remote
|
||||
import Annex.Content
|
||||
import Config.NumCopies
|
||||
import Annex.NumCopies
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [withOptions mirrorOptions $ command "mirror" paramPaths seek
|
||||
|
|
|
@ -10,7 +10,7 @@ module Command.NumCopies where
|
|||
import Common.Annex
|
||||
import qualified Annex
|
||||
import Command
|
||||
import Config.NumCopies
|
||||
import Annex.NumCopies
|
||||
import Types.Messages
|
||||
|
||||
cmd :: [Command]
|
||||
|
|
17
Command/Required.hs
Normal file
17
Command/Required.hs
Normal file
|
@ -0,0 +1,17 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2015 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Command.Required where
|
||||
|
||||
import Command
|
||||
import Logs.PreferredContent
|
||||
import qualified Command.Wanted
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = Command.Wanted.cmd' "required" "get or set required content expression"
|
||||
requiredContentMapRaw
|
||||
requiredContentSet
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2013 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
@ -13,39 +13,47 @@ import Command
|
|||
import qualified Remote
|
||||
import Logs.PreferredContent
|
||||
import Types.Messages
|
||||
import Types.StandardGroups
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
cmd :: [Command]
|
||||
cmd = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek
|
||||
SectionSetup "get or set preferred content expression"]
|
||||
cmd = cmd' "wanted" "get or set preferred content expression"
|
||||
preferredContentMapRaw
|
||||
preferredContentSet
|
||||
|
||||
seek :: CommandSeek
|
||||
seek = withWords start
|
||||
|
||||
start :: [String] -> CommandStart
|
||||
start = parse
|
||||
cmd'
|
||||
:: String
|
||||
-> String
|
||||
-> Annex (M.Map UUID PreferredContentExpression)
|
||||
-> (UUID -> PreferredContentExpression -> Annex ())
|
||||
-> [Command]
|
||||
cmd' name desc getter setter = [command name pdesc seek SectionSetup desc]
|
||||
where
|
||||
parse (name:[]) = go name performGet
|
||||
parse (name:expr:[]) = go name $ \uuid -> do
|
||||
showStart "wanted" name
|
||||
performSet expr uuid
|
||||
parse _ = error "Specify a repository."
|
||||
pdesc = paramPair paramRemote (paramOptional paramExpression)
|
||||
|
||||
go name a = do
|
||||
u <- Remote.nameToUUID name
|
||||
seek = withWords start
|
||||
|
||||
start (rname:[]) = go rname (performGet getter)
|
||||
start (rname:expr:[]) = go rname $ \uuid -> do
|
||||
showStart name rname
|
||||
performSet setter expr uuid
|
||||
start _ = error "Specify a repository."
|
||||
|
||||
go rname a = do
|
||||
u <- Remote.nameToUUID rname
|
||||
next $ a u
|
||||
|
||||
performGet :: UUID -> CommandPerform
|
||||
performGet uuid = do
|
||||
performGet :: Ord a => Annex (M.Map a PreferredContentExpression) -> a -> CommandPerform
|
||||
performGet getter a = do
|
||||
Annex.setOutput QuietOutput
|
||||
m <- preferredContentMapRaw
|
||||
liftIO $ putStrLn $ fromMaybe "" $ M.lookup uuid m
|
||||
m <- getter
|
||||
liftIO $ putStrLn $ fromMaybe "" $ M.lookup a m
|
||||
next $ return True
|
||||
|
||||
performSet :: String -> UUID -> CommandPerform
|
||||
performSet expr uuid = case checkPreferredContentExpression expr of
|
||||
performSet :: Ord a => (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform
|
||||
performSet setter expr a = case checkPreferredContentExpression expr of
|
||||
Just e -> error $ "Parse error: " ++ e
|
||||
Nothing -> do
|
||||
preferredContentSet uuid expr
|
||||
setter a expr
|
||||
next $ return True
|
||||
|
|
|
@ -143,10 +143,10 @@ firstRun :: Maybe HostName -> IO ()
|
|||
firstRun listenhost = do
|
||||
checkEnvironmentIO
|
||||
{- Without a repository, we cannot have an Annex monad, so cannot
|
||||
- get a ThreadState. Using undefined is only safe because the
|
||||
- get a ThreadState. This is only safe because the
|
||||
- webapp checks its noAnnex field before accessing the
|
||||
- threadstate. -}
|
||||
let st = undefined
|
||||
let st = error "annex state not available"
|
||||
{- Get a DaemonStatus without running in the Annex monad. -}
|
||||
dstatus <- atomically . newTMVar =<< newDaemonStatus
|
||||
d <- newAssistantData st dstatus
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue