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:
Joey Hess 2015-05-12 13:23:22 -04:00
commit e27b97d364
378 changed files with 4978 additions and 1158 deletions

View file

@ -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

View file

@ -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

View file

@ -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"
)

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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] $

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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
View 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

View file

@ -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

View file

@ -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