diff --git a/Annex/Branch.hs b/Annex/Branch.hs --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -1,6 +1,6 @@ {- management of the git-annex branch - - - Copyright 2011-2017 Joey Hess + - Copyright 2011-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -19,6 +19,7 @@ getHistorical, change, maybeChange, + commitMessage, commit, forceCommit, getBranch, @@ -51,7 +52,7 @@ import Git.LsTree (lsTreeParams) import qualified Git.HashObject import Annex.HashObject -import Git.Types +import Git.Types (Ref(..), fromRef, RefDate, TreeItemType(..)) import Git.FilePath import Annex.CatFile import Annex.Perms @@ -177,9 +178,9 @@ go branchref dirty tomerge jl = withIndex $ do let (refs, branches) = unzip tomerge cleanjournal <- if dirty then stageJournal jl else return noop - let merge_desc = if null tomerge - then "update" - else "merging " ++ + merge_desc <- if null tomerge + then commitMessage + else return $ "merging " ++ unwords (map Git.Ref.describe branches) ++ " into " ++ fromRef name localtransitions <- parseTransitionsStrictly "local" @@ -222,10 +223,15 @@ getLocal file = go =<< getJournalFileStale file where go (Just journalcontent) = return journalcontent - go Nothing = getRaw file + go Nothing = getRef fullname file -getRaw :: FilePath -> Annex String -getRaw = getRef fullname +{- Gets the content of a file as staged in the branch's index. -} +getStaged :: FilePath -> Annex String +getStaged = getRef indexref + where + -- This makes git cat-file be run with ":file", + -- so it looks at the index. + indexref = Ref "" getHistorical :: RefDate -> FilePath -> Annex String getHistorical date file = @@ -259,6 +265,11 @@ set :: JournalLocked -> FilePath -> String -> Annex () set = setJournalFile +{- Commit message used when making a commit of whatever data has changed + - to the git-annex brach. -} +commitMessage :: Annex String +commitMessage = fromMaybe "update" . annexCommitMessage <$> Annex.getGitConfig + {- Stages the journal, and commits staged changes to the branch. -} commit :: String -> Annex () commit = whenM journalDirty . forceCommit @@ -527,6 +538,10 @@ -- update the git-annex branch, while it usually holds changes -- for the head branch. Flush any such changes. Annex.Queue.flush + -- Stop any running git cat-files, to ensure that the + -- getStaged calls below use the current index, and not some older + -- one. + catFileStop withIndex $ do prepareModifyIndex jl run $ mapMaybe getTransitionCalculator tlist @@ -551,15 +566,15 @@ - to hold changes to every file in the branch at once.) - - When a file in the branch is changed by transition code, - - that value is remembered and fed into the code for subsequent + - its new content is remembered and fed into the code for subsequent - transitions. -} run [] = noop run changers = do - trustmap <- calcTrustMap <$> getRaw trustLog + trustmap <- calcTrustMap <$> getStaged trustLog fs <- branchFiles forM_ fs $ \f -> do - content <- getRaw f + content <- getStaged f apply changers f content trustmap apply [] _ _ _ = return () apply (changer:rest) file content trustmap = diff --git a/Annex/Content.hs b/Annex/Content.hs --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -975,7 +975,7 @@ Annex.Queue.flush unless nocommit $ whenM (annexAlwaysCommit <$> Annex.getGitConfig) $ - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage {- Downloads content from any of a list of urls. -} downloadUrl :: Key -> MeterUpdate -> [Url.URLString] -> FilePath -> Annex Bool diff --git a/Annex/MakeRepo.hs b/Annex/MakeRepo.hs --- a/Annex/MakeRepo.hs +++ b/Annex/MakeRepo.hs @@ -82,7 +82,7 @@ maybe noop (defaultStandardGroup u) mgroup {- Ensure branch gets committed right away so it is - available for merging immediately. -} - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage {- Checks if a git repo exists at a location. -} probeRepoExists :: FilePath -> IO Bool diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -279,4 +279,4 @@ lessActiveFirst :: M.Map Remote Integer -> Remote -> Remote -> Ordering lessActiveFirst active a b | Remote.cost a == Remote.cost b = comparing (`M.lookup` active) a b - | otherwise = compare a b + | otherwise = comparing Remote.cost a b diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -124,7 +124,7 @@ pushToRemotes' :: UTCTime -> [Remote] -> Assistant [Remote] pushToRemotes' now remotes = do (g, branch, u) <- liftAnnex $ do - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage (,,) <$> gitRepo <*> join Command.Sync.getCurrBranch diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -92,7 +92,7 @@ filter (\r -> not (inset s r || Remote.readonly r)) (syncDataRemotes st) where - locs = S.fromList <$> Remote.keyLocations k + locs = S.fromList . map Remote.uuid <$> Remote.keyPossibilities k inset s r = S.member (Remote.uuid r) s gentransfer r = Transfer { transferDirection = direction diff --git a/Assistant/WebApp/Configurators/Fsck.hs b/Assistant/WebApp/Configurators/Fsck.hs --- a/Assistant/WebApp/Configurators/Fsck.hs +++ b/Assistant/WebApp/Configurators/Fsck.hs @@ -138,7 +138,7 @@ changeSchedule :: Handler () -> Handler Html changeSchedule a = do a - liftAnnex $ Annex.Branch.commit "update" + liftAnnex $ Annex.Branch.commit =<< Annex.Branch.commitMessage redirect ConfigFsckR getRemoveActivityR :: UUID -> ScheduledActivity -> Handler Html diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,21 @@ +git-annex (6.20180807) upstream; urgency=medium + + * S3: Support credential-less download from remotes configured + with public=yes exporttree=yes. + * Fix reversion in display of http 404 errors. + * Added remote.name.annex-speculate-present config that can be used to + make cache remotes. + * Added --accessedwithin matching option. + * Added annex.commitmessage config that can specify a commit message + for the git-annex branch instead of the usual "update". + * Fix wrong sorting of remotes when using -J, it was sorting by uuid, + rather than cost. + * addurl: Include filename in --json-progress output. + * Fix git-annex branch data loss that could occur after + git-annex forget --drop-dead. + + -- Joey Hess Tue, 07 Aug 2018 16:22:05 -0400 + git-annex (6.20180719) upstream; urgency=medium * Support working trees set up by git-worktree. diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -38,6 +38,7 @@ import CmdLine.GlobalSetter import qualified Backend import qualified Types.Backend as Backend +import Utility.HumanTime -- Global options that are accepted by all git-annex sub-commands, -- although not always used. @@ -275,6 +276,12 @@ <> help "match files the repository wants to drop" <> hidden ) + , globalSetter Limit.addAccessedWithin $ option (str >>= parseDuration) + ( long "accessedwithin" + <> metavar paramTime + <> help "match files accessed within a time interval" + <> hidden + ) ] -- Options to match files which may not yet be annexed. @@ -371,7 +378,7 @@ timeLimitOption :: [GlobalOption] timeLimitOption = - [ globalSetter Limit.addTimeLimit $ strOption + [ globalSetter Limit.addTimeLimit $ option (str >>= parseDuration) ( long "time-limit" <> short 'T' <> metavar paramTime <> help "stop after the specified amount of time" <> hidden diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -126,7 +126,7 @@ where go _ (Left e) = void $ commandAction $ do - showStart' "addurl" (Just u) + showStartAddUrl u o warning (show e) next $ next $ return False go deffile (Right (UrlContents sz mf)) = do @@ -148,7 +148,7 @@ startRemote r o file uri sz = do pathmax <- liftIO $ fileNameLengthLimit "." let file' = joinPath $ map (truncateFilePath pathmax) $ splitDirectories file - showStart' "addurl" (Just uri) + showStartAddUrl uri o showNote $ "from " ++ Remote.name r showDestinationFile file' next $ performRemote r o uri file' sz @@ -192,7 +192,7 @@ bad = fromMaybe (giveup $ "bad url " ++ urlstring) $ Url.parseURIRelaxed $ urlstring go url = do - showStart' "addurl" (Just urlstring) + showStartAddUrl urlstring o pathmax <- liftIO $ fileNameLengthLimit "." urlinfo <- if relaxedOption (downloadOptions o) then pure Url.assumeUrlExists @@ -310,6 +310,16 @@ else do warning $ dest ++ " already exists; not overwriting" return Nothing + +{- The destination file is not known at start time unless the user provided + - a filename. It's not displayed then for output consistency, + - but is added to the json when available. -} +showStartAddUrl :: URLString -> AddUrlOptions -> Annex () +showStartAddUrl url o = do + showStart' "addurl" (Just url) + case fileOption (downloadOptions o) of + Nothing -> noop + Just file -> maybeShowJSON $ JSONChunk [("file", file)] showDestinationFile :: FilePath -> Annex () showDestinationFile file = do diff --git a/Command/Commit.hs b/Command/Commit.hs --- a/Command/Commit.hs +++ b/Command/Commit.hs @@ -21,7 +21,7 @@ start :: CommandStart start = next $ next $ do - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage _ <- runhook <=< inRepo $ Git.hookPath "annex-content" return True where diff --git a/Command/Merge.hs b/Command/Merge.hs --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -27,7 +27,7 @@ next $ do Annex.Branch.update -- commit explicitly, in case no remote branches were merged - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage next $ return True mergeSynced :: CommandStart diff --git a/Command/Sync.hs b/Command/Sync.hs --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -301,7 +301,7 @@ commit o = stopUnless shouldcommit $ next $ next $ do commitmessage <- maybe commitMsg return (messageOption o) showStart' "commit" Nothing - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage ifM isDirect ( do void stageDirect @@ -544,7 +544,7 @@ commitAnnex :: CommandStart commitAnnex = do - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage stop mergeAnnex :: CommandStart @@ -616,7 +616,7 @@ -} syncFile :: Either (Maybe (Bloom Key)) (Key -> Annex ()) -> [Remote] -> AssociatedFile -> Key -> Annex Bool syncFile ebloom rs af k = onlyActionOn' k $ do - locs <- Remote.keyLocations k + locs <- map Remote.uuid <$> Remote.keyPossibilities k let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs got <- anyM id =<< handleget have diff --git a/Limit.hs b/Limit.hs --- a/Limit.hs +++ b/Limit.hs @@ -298,20 +298,31 @@ . S.filter matching . metaDataValues f <$> getCurrentMetaData k -addTimeLimit :: String -> Annex () -addTimeLimit s = do - let seconds = maybe (giveup "bad time-limit") durationToPOSIXTime $ - parseDuration s +addTimeLimit :: Duration -> Annex () +addTimeLimit duration = do start <- liftIO getPOSIXTime - let cutoff = start + seconds + let cutoff = start + durationToPOSIXTime duration addLimit $ Right $ const $ const $ do now <- liftIO getPOSIXTime if now > cutoff then do - warning $ "Time limit (" ++ s ++ ") reached!" + warning $ "Time limit (" ++ fromDuration duration ++ ") reached!" shutdown True liftIO $ exitWith $ ExitFailure 101 else return True + +addAccessedWithin :: Duration -> Annex () +addAccessedWithin duration = do + now <- liftIO getPOSIXTime + addLimit $ Right $ const $ checkKey $ check now + where + check now k = inAnnexCheck k $ \f -> + liftIO $ catchDefaultIO False $ do + s <- getFileStatus f + let accessed = realToFrac (accessTime s) + let delta = now - accessed + return $ delta <= secs + secs = fromIntegral (durationSeconds duration) lookupFileKey :: FileInfo -> Annex (Maybe Key) lookupFileKey = lookupFile . currFile diff --git a/Logs/Web.hs b/Logs/Web.hs --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -78,7 +78,7 @@ - any journaled changes are reflected in it, since we're going - to query its index directly. -} Annex.Branch.update - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage Annex.Branch.withIndex $ do top <- fromRepo Git.repoPath (l, cleanup) <- inRepo $ Git.LsFiles.stagedDetails [top] diff --git a/Remote.hs b/Remote.hs --- a/Remote.hs +++ b/Remote.hs @@ -1,6 +1,6 @@ {- git-annex remotes - - - Copyright 2011 Joey Hess + - Copyright 2011-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -278,13 +278,21 @@ {- Cost ordered lists of remotes that the location log indicates - may have a key. + - + - Also includes remotes with remoteAnnexSpeculatePresent set. -} keyPossibilities :: Key -> Annex [Remote] keyPossibilities key = do u <- getUUID -- uuids of all remotes that are recorded to have the key locations <- filter (/= u) <$> keyLocations key - fst <$> remoteLocations locations [] + speclocations <- map uuid + . filter (remoteAnnexSpeculatePresent . gitconfig) + <$> remoteList + -- there are unlikely to be many speclocations, so building a Set + -- is not worth the expense + let locations' = speclocations ++ filter (`notElem` speclocations) locations + fst <$> remoteLocations locations' [] {- Given a list of locations of a key, and a list of all - trusted repositories, generates a cost-ordered list of diff --git a/Remote/Git.hs b/Remote/Git.hs --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -728,7 +728,7 @@ cleanup | not $ Git.repoIsUrl repo = onLocalFast repo r $ doQuietSideAction $ - Annex.Branch.commit "update" + Annex.Branch.commit =<< Annex.Branch.commitMessage | otherwise = void $ do Just (shellcmd, shellparams) <- Ssh.git_annex_shell NoConsumeStdin diff --git a/Remote/S3.hs b/Remote/S3.hs --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -46,7 +46,7 @@ import Annex.UUID import Logs.Web import Utility.Metered -import qualified Utility.Url as Url +import qualified Annex.Url as Url import Utility.DataUnits import Utility.FileSystemEncoding import Annex.Content @@ -54,6 +54,7 @@ import Utility.Url (checkBoth, UrlOptions(..)) type BucketName = String +type BucketObject = String remote :: RemoteType remote = RemoteType @@ -91,15 +92,15 @@ , lockContent = Nothing , checkPresent = checkPresentDummy , checkPresentCheap = False - , exportActions = withS3Handle c gc u $ \h -> + , exportActions = withS3HandleMaybe c gc u $ \mh -> return $ ExportActions - { storeExport = storeExportS3 info h - , retrieveExport = retrieveExportS3 info h - , removeExport = removeExportS3 info h - , checkPresentExport = checkPresentExportS3 info h + { storeExport = storeExportS3 u info mh + , retrieveExport = retrieveExportS3 u info mh + , removeExport = removeExportS3 u info mh + , checkPresentExport = checkPresentExportS3 u info mh -- S3 does not have directories. , removeExportDirectory = Nothing - , renameExport = renameExportS3 info h + , renameExport = renameExportS3 u info mh } , whereisKey = Just (getWebUrls info c) , remoteFsck = Nothing @@ -188,7 +189,7 @@ storeHelper info h f (T.pack $ bucketObject info k) p -- Store public URL to item in Internet Archive. when (isIA info && not (isChunkKey k)) $ - setUrlPresent webUUID k (iaPublicKeyUrl info k) + setUrlPresent webUUID k (iaPublicUrl info (bucketObject info k)) return True storeHelper :: S3Info -> S3Handle -> FilePath -> S3.Object -> MeterUpdate -> Annex () @@ -254,10 +255,10 @@ retrieveHelper info h (T.pack $ bucketObject info k) f p retrieve r info Nothing = case getpublicurl info of Nothing -> \_ _ _ -> do - warnMissingCredPairFor "S3" (AWS.creds $ uuid r) + needS3Creds (uuid r) return False Just geturl -> fileRetriever $ \f k p -> - unlessM (downloadUrl k p [geturl k] f) $ + unlessM (downloadUrl k p [geturl $ bucketObject info k] f) $ giveup "failed to download content" retrieveHelper :: S3Info -> S3Handle -> S3.Object -> FilePath -> MeterUpdate -> Annex () @@ -281,11 +282,12 @@ checkKey :: Remote -> S3Info -> Maybe S3Handle -> CheckPresent checkKey r info Nothing k = case getpublicurl info of Nothing -> do - warnMissingCredPairFor "S3" (AWS.creds $ uuid r) + needS3Creds (uuid r) giveup "No S3 credentials configured" Just geturl -> do showChecking r - withUrlOptions $ liftIO . checkBoth (geturl k) (keySize k) + withUrlOptions $ liftIO . + checkBoth (geturl $ bucketObject info k) (keySize k) checkKey r info (Just h) k = do showChecking r checkKeyHelper info h (T.pack $ bucketObject info k) @@ -316,38 +318,58 @@ | otherwise = Nothing #endif -storeExportS3 :: S3Info -> S3Handle -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool -storeExportS3 info h f _k loc p = +storeExportS3 :: UUID -> S3Info -> Maybe S3Handle -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool +storeExportS3 _u info (Just h) f _k loc p = catchNonAsync go (\e -> warning (show e) >> return False) where go = do storeHelper info h f (T.pack $ bucketExportLocation info loc) p return True +storeExportS3 u _ Nothing _ _ _ _ = do + needS3Creds u + return False -retrieveExportS3 :: S3Info -> S3Handle -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool -retrieveExportS3 info h _k loc f p = +retrieveExportS3 :: UUID -> S3Info -> Maybe S3Handle -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool +retrieveExportS3 u info mh _k loc f p = catchNonAsync go (\e -> warning (show e) >> return False) where - go = do - retrieveHelper info h (T.pack $ bucketExportLocation info loc) f p - return True + go = case mh of + Just h -> do + retrieveHelper info h (T.pack exporturl) f p + return True + Nothing -> case getpublicurl info of + Nothing -> do + needS3Creds u + return False + Just geturl -> Url.withUrlOptions $ + liftIO . Url.download p (geturl exporturl) f + exporturl = bucketExportLocation info loc -removeExportS3 :: S3Info -> S3Handle -> Key -> ExportLocation -> Annex Bool -removeExportS3 info h _k loc = +removeExportS3 :: UUID -> S3Info -> Maybe S3Handle -> Key -> ExportLocation -> Annex Bool +removeExportS3 _u info (Just h) _k loc = catchNonAsync go (\e -> warning (show e) >> return False) where go = do res <- tryNonAsync $ sendS3Handle h $ S3.DeleteObject (T.pack $ bucketExportLocation info loc) (bucket info) return $ either (const False) (const True) res +removeExportS3 u _ Nothing _ _ = do + needS3Creds u + return False -checkPresentExportS3 :: S3Info -> S3Handle -> Key -> ExportLocation -> Annex Bool -checkPresentExportS3 info h _k loc = +checkPresentExportS3 :: UUID -> S3Info -> Maybe S3Handle -> Key -> ExportLocation -> Annex Bool +checkPresentExportS3 _u info (Just h) _k loc = checkKeyHelper info h (T.pack $ bucketExportLocation info loc) +checkPresentExportS3 u info Nothing k loc = case getpublicurl info of + Nothing -> do + needS3Creds u + giveup "No S3 credentials configured" + Just geturl -> withUrlOptions $ liftIO . + checkBoth (geturl $ bucketExportLocation info loc) (keySize k) -- S3 has no move primitive; copy and delete. -renameExportS3 :: S3Info -> S3Handle -> Key -> ExportLocation -> ExportLocation -> Annex Bool -renameExportS3 info h _k src dest = catchNonAsync go (\_ -> return False) +renameExportS3 :: UUID -> S3Info -> Maybe S3Handle -> Key -> ExportLocation -> ExportLocation -> Annex Bool +renameExportS3 _u info (Just h) _k src dest = catchNonAsync go (\_ -> return False) where go = do let co = S3.copyObject (bucket info) dstobject @@ -359,6 +381,9 @@ return True srcobject = T.pack $ bucketExportLocation info src dstobject = T.pack $ bucketExportLocation info dest +renameExportS3 u _ Nothing _ _ _ = do + needS3Creds u + return False {- Generate the bucket if it does not already exist, including creating the - UUID file within the bucket. @@ -477,7 +502,7 @@ withS3Handle c gc u a = withS3HandleMaybe c gc u $ \mh -> case mh of Just h -> a h Nothing -> do - warnMissingCredPairFor "S3" (AWS.creds u) + needS3Creds u giveup "No S3 credentials configured" withS3HandleMaybe :: RemoteConfig -> RemoteGitConfig -> UUID -> (Maybe S3Handle -> Annex a) -> Annex a @@ -496,6 +521,9 @@ where s3cfg = s3Configuration c +needS3Creds :: UUID -> Annex () +needS3Creds u = warnMissingCredPairFor "S3" (AWS.creds u) + s3Configuration :: RemoteConfig -> S3.S3Configuration AWS.NormalQuery s3Configuration c = cfg { S3.s3Port = port @@ -525,13 +553,13 @@ data S3Info = S3Info { bucket :: S3.Bucket , storageClass :: S3.StorageClass - , bucketObject :: Key -> String - , bucketExportLocation :: ExportLocation -> String + , bucketObject :: Key -> BucketObject + , bucketExportLocation :: ExportLocation -> BucketObject , metaHeaders :: [(T.Text, T.Text)] , partSize :: Maybe Integer , isIA :: Bool , public :: Bool - , getpublicurl :: Maybe (Key -> URLString) + , getpublicurl :: Maybe (BucketObject -> URLString) } extractS3Info :: RemoteConfig -> Annex S3Info @@ -552,13 +580,13 @@ Just "yes" -> True _ -> False , getpublicurl = case M.lookup "publicurl" c of - Just u -> Just $ genericPublicKeyUrl info u + Just u -> Just $ \p -> genericPublicUrl p u Nothing -> case M.lookup "host" c of Just h | h == AWS.s3DefaultHost -> - Just $ awsPublicKeyUrl info + Just (awsPublicUrl info) | isIAHost h -> - Just $ iaPublicKeyUrl info + Just (iaPublicUrl info) _ -> Nothing } return info @@ -601,14 +629,14 @@ getFilePrefix :: RemoteConfig -> String getFilePrefix = M.findWithDefault "" "fileprefix" -getBucketObject :: RemoteConfig -> Key -> FilePath +getBucketObject :: RemoteConfig -> Key -> BucketObject getBucketObject c = munge . key2file where munge s = case M.lookup "mungekeys" c of Just "ia" -> iaMunge $ getFilePrefix c ++ s _ -> getFilePrefix c ++ s -getBucketExportLocation :: RemoteConfig -> ExportLocation -> FilePath +getBucketExportLocation :: RemoteConfig -> ExportLocation -> BucketObject getBucketExportLocation c loc = getFilePrefix c ++ fromExportLocation loc {- Internet Archive documentation limits filenames to a subset of ascii. @@ -636,16 +664,16 @@ iaItemUrl :: BucketName -> URLString iaItemUrl b = "http://archive.org/details/" ++ b -iaPublicKeyUrl :: S3Info -> Key -> URLString -iaPublicKeyUrl info = genericPublicKeyUrl info $ +iaPublicUrl :: S3Info -> BucketObject -> URLString +iaPublicUrl info p = genericPublicUrl p $ "http://archive.org/download/" ++ T.unpack (bucket info) ++ "/" -awsPublicKeyUrl :: S3Info -> Key -> URLString -awsPublicKeyUrl info = genericPublicKeyUrl info $ +awsPublicUrl :: S3Info -> BucketObject -> URLString +awsPublicUrl info p = genericPublicUrl p $ "https://" ++ T.unpack (bucket info) ++ ".s3.amazonaws.com/" -genericPublicKeyUrl :: S3Info -> URLString -> Key -> URLString -genericPublicKeyUrl info baseurl k = baseurl ++ bucketObject info k +genericPublicUrl :: BucketObject -> URLString -> URLString +genericPublicUrl p baseurl = baseurl ++ p genCredentials :: CredPair -> IO AWS.Credentials genCredentials (keyid, secret) = AWS.Credentials @@ -690,6 +718,6 @@ getWebUrls info c k | exportTree c = return [] | otherwise = case (public info, getpublicurl info) of - (True, Just geturl) -> return [geturl k] + (True, Just geturl) -> return [geturl $ bucketObject info k] _ -> return [] diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -62,6 +62,7 @@ , annexBloomAccuracy :: Maybe Int , annexSshCaching :: Maybe Bool , annexAlwaysCommit :: Bool + , annexCommitMessage :: Maybe String , annexMergeAnnexBranches :: Bool , annexDelayAdd :: Maybe Int , annexHttpHeaders :: [String] @@ -123,6 +124,7 @@ , annexBloomAccuracy = getmayberead (annex "bloomaccuracy") , annexSshCaching = getmaybebool (annex "sshcaching") , annexAlwaysCommit = getbool (annex "alwayscommit") True + , annexCommitMessage = getmaybe (annex "commitmessage") , annexMergeAnnexBranches = getbool (annex "merge-annex-branches") True , annexDelayAdd = getmayberead (annex "delayadd") , annexHttpHeaders = getlist (annex "http-headers") @@ -226,6 +228,7 @@ , remoteAnnexStartCommand :: Maybe String , remoteAnnexStopCommand :: Maybe String , remoteAnnexAvailability :: Maybe Availability + , remoteAnnexSpeculatePresent :: Bool , remoteAnnexBare :: Maybe Bool , remoteAnnexRetry :: Maybe Integer , remoteAnnexRetryDelay :: Maybe Seconds @@ -281,6 +284,7 @@ , remoteAnnexStartCommand = notempty $ getmaybe "start-command" , remoteAnnexStopCommand = notempty $ getmaybe "stop-command" , remoteAnnexAvailability = getmayberead "availability" + , remoteAnnexSpeculatePresent = getbool "speculate-present" False , remoteAnnexBare = getmaybebool "bare" , remoteAnnexRetry = getmayberead "retry" , remoteAnnexRetryDelay = Seconds diff --git a/Types/Remote.hs b/Types/Remote.hs --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -146,8 +146,13 @@ instance Eq (RemoteA a) where x == y = uuid x == uuid y +-- Order by cost since that is the important order of remotes +-- when deciding which to use. But since remotes often have the same cost +-- and Ord must be total, do a secondary ordering by uuid. instance Ord (RemoteA a) where - compare = comparing uuid + compare a b + | cost a == cost b = comparing uuid a b + | otherwise = comparing cost a b instance ToUUID (RemoteA a) where toUUID = uuid diff --git a/Utility/Android.hs b/Utility/Android.hs --- a/Utility/Android.hs +++ b/Utility/Android.hs @@ -9,7 +9,9 @@ module Utility.Android where +#ifdef linux_HOST_OS import Common +#endif -- Detect when the Linux build is running on Android, eg in termux. -- diff --git a/Utility/Url.hs b/Utility/Url.hs --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -362,8 +362,8 @@ showhttpexception he = do #if MIN_VERSION_http_client(0,5,0) let msg = case he of - HttpExceptionRequest _ (StatusCodeException _ msgb) -> - B8.toString msgb + HttpExceptionRequest _ (StatusCodeException r _) -> + B8.toString $ statusMessage $ responseStatus r HttpExceptionRequest _ (InternalException ie) -> case fromException ie of Nothing -> show ie diff --git a/doc/git-annex-matching-options.mdwn b/doc/git-annex-matching-options.mdwn --- a/doc/git-annex-matching-options.mdwn +++ b/doc/git-annex-matching-options.mdwn @@ -145,6 +145,20 @@ Note that this will not match anything when using --all or --unused. +* `--accessedwithin=interval` + + Matches files that were accessed recently, within the specified time + interval. + + The interval can be in the form "5m" or "1h" or "2d" or "1y", or a + combination such as "1h5m". + + So for example, `--accessedwithin=1d` matches files that have been + accessed within the past day. + + If the OS or filesystem does not support access times, this will not + match any files. + * `--not` Inverts the next matching option. For example, to only act on diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -974,6 +974,17 @@ since it could garbage collect objects that are staged in git-annex's index but not yet committed. +* `annex.commitmessage` + + When git-annex updates the git-annex branch, it usually makes up + its own commit message ("update"), since users rarely look at or + care about changes to that branch. If you do care, you can + specify this setting by running commands with + `-c annex.commitmessage=whatever` + + This works well in combination with annex.alwayscommit=false, + to gather up a set of changes and commit them with a message you specify. + * `annex.merge-annex-branches` By default, git-annex branches that have been pulled from remotes @@ -1282,6 +1293,13 @@ Can be used to tell git-annex whether a remote is LocallyAvailable or GloballyAvailable. Normally, git-annex determines this automatically. + +* `remote..annex-speculate-present` + + Make git-annex speculate that this remote may contain the content of any + file, even though its normal location tracking does not indicate that it + does. This will cause git-annex to try to get all file contents from the + remote. Can be useful in setting up a caching remote. * `remote..annex-bare` diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 6.20180719 +Version: 6.20180807 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess