Merge branch 'master' into git-remote-annex
This commit is contained in:
commit
ff5193c6ad
137 changed files with 2031 additions and 325 deletions
|
@ -111,7 +111,7 @@ checkHiddenService = bracket setup cleanup go
|
|||
-- we just want to know if the tor circuit works.
|
||||
liftIO (tryNonAsync $ connectPeer g addr) >>= \case
|
||||
Left e -> do
|
||||
warning $ UnquotedString $ "Unable to connect to hidden service. It may not yet have propigated to the Tor network. (" ++ show e ++ ") Will retry.."
|
||||
warning $ UnquotedString $ "Unable to connect to hidden service. It may not yet have propagated to the Tor network. (" ++ show e ++ ") Will retry.."
|
||||
liftIO $ threadDelaySeconds (Seconds 2)
|
||||
check (n-1) addrs
|
||||
Right conn -> do
|
||||
|
|
|
@ -189,7 +189,7 @@ seek o = withOtherTmp $ \tmpdir -> do
|
|||
liftIO $ removeWhenExistsWith removeLink tmpindex
|
||||
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||
cmessage <- Annex.Branch.commitMessage
|
||||
c <- inRepo $ Git.commitTree cmode cmessage [] t
|
||||
c <- inRepo $ Git.commitTree cmode [cmessage] [] t
|
||||
liftIO $ putStrLn (fromRef c)
|
||||
where
|
||||
ww = WarnUnmatchLsFiles "filter-branch"
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2012-2021 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -70,7 +70,7 @@ data ImportOptions
|
|||
, importToSubDir :: Maybe FilePath
|
||||
, importContent :: Bool
|
||||
, checkGitIgnoreOption :: CheckGitIgnore
|
||||
, messageOption :: Maybe String
|
||||
, messageOption :: [String]
|
||||
}
|
||||
|
||||
optParser :: CmdParamsDesc -> Parser ImportOptions
|
||||
|
@ -82,7 +82,7 @@ optParser desc = do
|
|||
)
|
||||
dupmode <- fromMaybe Default <$> optional duplicateModeParser
|
||||
ic <- Command.Add.checkGitIgnoreSwitch
|
||||
message <- optional (strOption
|
||||
message <- many (strOption
|
||||
( long "message" <> short 'm' <> metavar "MSG"
|
||||
<> help "commit message"
|
||||
))
|
||||
|
@ -322,8 +322,8 @@ verifyExisting key destfile (yes, no) = do
|
|||
verifyEnoughCopiesToDrop [] key Nothing needcopies mincopies [] preverified tocheck
|
||||
(const yes) no
|
||||
|
||||
seekRemote :: Remote -> Branch -> Maybe TopFilePath -> Bool -> CheckGitIgnore -> Maybe String -> CommandSeek
|
||||
seekRemote remote branch msubdir importcontent ci mimportmessage = do
|
||||
seekRemote :: Remote -> Branch -> Maybe TopFilePath -> Bool -> CheckGitIgnore -> [String] -> CommandSeek
|
||||
seekRemote remote branch msubdir importcontent ci importmessages = do
|
||||
importtreeconfig <- case msubdir of
|
||||
Nothing -> return ImportTree
|
||||
Just subdir ->
|
||||
|
@ -336,7 +336,7 @@ seekRemote remote branch msubdir importcontent ci mimportmessage = do
|
|||
|
||||
trackingcommit <- fromtrackingbranch Git.Ref.sha
|
||||
cmode <- annexCommitMode <$> Annex.getGitConfig
|
||||
let importcommitconfig = ImportCommitConfig trackingcommit cmode importmessage
|
||||
let importcommitconfig = ImportCommitConfig trackingcommit cmode importmessages'
|
||||
let commitimport = commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig
|
||||
|
||||
importabletvar <- liftIO $ newTVarIO Nothing
|
||||
|
@ -353,9 +353,9 @@ seekRemote remote branch msubdir importcontent ci mimportmessage = do
|
|||
includeCommandAction $
|
||||
commitimport imported
|
||||
where
|
||||
importmessage = fromMaybe
|
||||
("import from " ++ Remote.name remote)
|
||||
mimportmessage
|
||||
importmessages'
|
||||
| null importmessages = ["import from " ++ Remote.name remote]
|
||||
| otherwise = importmessages
|
||||
|
||||
tb = mkRemoteTrackingBranch remote branch
|
||||
|
||||
|
|
|
@ -573,7 +573,7 @@ playlistFields u i = map (uncurry extractField)
|
|||
, ("itemtitle", [youtube_title i])
|
||||
, ("feedauthor", [youtube_playlist_uploader i])
|
||||
, ("itemauthor", [youtube_playlist_uploader i])
|
||||
-- itemsummary omitted, no equivilant in yt-dlp data
|
||||
-- itemsummary omitted, no equivalent in yt-dlp data
|
||||
, ("itemdescription", [youtube_description i])
|
||||
, ("itemrights", [youtube_license i])
|
||||
, ("itemid", [youtube_url i])
|
||||
|
|
|
@ -169,7 +169,7 @@ startAll o outputter = do
|
|||
- same key. The method is to compare each value with the value
|
||||
- after it in the list, which is the old version of the value.
|
||||
-
|
||||
- This ncessarily buffers the whole list, so does not stream.
|
||||
- This necessarily buffers the whole list, so does not stream.
|
||||
- But, the number of location log changes for a single key tends to be
|
||||
- fairly small.
|
||||
-
|
||||
|
@ -377,7 +377,7 @@ sizeHistoryInfo mu o = do
|
|||
-- time across all git-annex repositories.
|
||||
--
|
||||
-- This combines the new location log with what has been
|
||||
-- accumulated so far, which is equivilant to merging together
|
||||
-- accumulated so far, which is equivalent to merging together
|
||||
-- all git-annex branches at that point in time.
|
||||
update k sizemap locmap (oldlog, oldlocs) newlog =
|
||||
( updatesize (updatesize sizemap sz (S.toList addedlocs))
|
||||
|
@ -490,7 +490,7 @@ sizeHistoryInfo mu o = do
|
|||
|
||||
posminus a b = max 0 (a - b)
|
||||
|
||||
-- A verison of sizemap where uuids that are currently dead
|
||||
-- A version of sizemap where uuids that are currently dead
|
||||
-- have 0 size.
|
||||
sizemap' = M.mapWithKey zerodead sizemap
|
||||
zerodead u v = case M.lookup u (simpleMap trustlog) of
|
||||
|
|
|
@ -200,7 +200,7 @@ update oldkey newkey =
|
|||
firstM (\f -> (== Just newkey) <$> isAnnexLink f) $
|
||||
map (\f -> simplifyPath (fromTopFilePath f g)) fs
|
||||
|
||||
-- Always verify the content agains the newkey, even if
|
||||
-- Always verify the content against the newkey, even if
|
||||
-- annex.verify is unset. This is done to prent bad migration
|
||||
-- information maliciously injected into the git-annex branch
|
||||
-- from populating files with the wrong content.
|
||||
|
|
|
@ -40,7 +40,7 @@ start (_, key) = do
|
|||
)
|
||||
where
|
||||
{- No need to do any rollback; when sendAnnex fails, a nonzero
|
||||
- exit will be propigated, and the remote will know the transfer
|
||||
- exit will be propagated, and the remote will know the transfer
|
||||
- failed. -}
|
||||
rollback = noop
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>
|
||||
- Copyright 2011-2023 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2011-2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -105,7 +105,7 @@ data SyncOptions = SyncOptions
|
|||
, notOnlyAnnexOption :: Bool
|
||||
, commitOption :: Bool
|
||||
, noCommitOption :: Bool
|
||||
, messageOption :: Maybe String
|
||||
, messageOption :: [String]
|
||||
, pullOption :: Bool
|
||||
, pushOption :: Bool
|
||||
, contentOption :: Maybe Bool
|
||||
|
@ -125,7 +125,7 @@ instance Default SyncOptions where
|
|||
, notOnlyAnnexOption = False
|
||||
, commitOption = False
|
||||
, noCommitOption = False
|
||||
, messageOption = Nothing
|
||||
, messageOption = []
|
||||
, pullOption = False
|
||||
, pushOption = False
|
||||
, contentOption = Just False
|
||||
|
@ -169,8 +169,8 @@ optParser mode desc = SyncOptions
|
|||
( long "no-commit"
|
||||
<> help "avoid git commit"
|
||||
))
|
||||
<*> unlessmode [SyncMode, AssistMode] Nothing
|
||||
(optional (strOption
|
||||
<*> unlessmode [SyncMode, AssistMode] []
|
||||
(many (strOption
|
||||
( long "message" <> short 'm' <> metavar "MSG"
|
||||
<> help "commit message"
|
||||
)))
|
||||
|
@ -267,7 +267,7 @@ seek' o = startConcurrency transferStages $ do
|
|||
|
||||
remotes <- syncRemotes (syncWith o)
|
||||
warnSyncContentTransition o remotes
|
||||
-- Remotes that are git repositories, not (necesarily) special remotes.
|
||||
-- Remotes that are git repositories, not (necessarily) special remotes.
|
||||
let gitremotes = filter (Remote.gitSyncableRemoteType . Remote.remotetype) remotes
|
||||
-- Remotes that contain annex object content.
|
||||
contentremotes <- filter (\r -> Remote.uuid r /= NoUUID)
|
||||
|
@ -402,17 +402,18 @@ syncRemotes' ps available =
|
|||
|
||||
commit :: SyncOptions -> CommandStart
|
||||
commit o = stopUnless shouldcommit $ starting "commit" ai si $ do
|
||||
commitmessage <- maybe commitMsg return (messageOption o)
|
||||
Annex.Branch.commit =<< Annex.Branch.commitMessage
|
||||
mopts <- concatMap (\msg -> [Param "-m", Param msg])
|
||||
<$> if null (messageOption o)
|
||||
then (:[]) <$> commitMsg
|
||||
else pure (messageOption o)
|
||||
next $ do
|
||||
showOutput
|
||||
let cmode = Git.Branch.ManualCommit
|
||||
cquiet <- Git.Branch.CommitQuiet <$> commandProgressDisabled
|
||||
void $ inRepo $ Git.Branch.commitCommand cmode cquiet
|
||||
[ Param "-a"
|
||||
, Param "-m"
|
||||
, Param commitmessage
|
||||
]
|
||||
void $ inRepo $ Git.Branch.commitCommand
|
||||
cmode cquiet
|
||||
([ Param "-a" ] ++ mopts)
|
||||
return True
|
||||
where
|
||||
shouldcommit = notOnlyAnnex o <&&>
|
||||
|
@ -426,7 +427,8 @@ commitMsg :: Annex String
|
|||
commitMsg = do
|
||||
u <- getUUID
|
||||
m <- uuidDescMap
|
||||
return $ "git-annex in " ++ maybe "unknown" fromUUIDDesc (M.lookup u m)
|
||||
return $ "git-annex in "
|
||||
++ maybe "unknown" fromUUIDDesc (M.lookup u m)
|
||||
|
||||
mergeLocal :: [Git.Merge.MergeConfig] -> SyncOptions -> CurrBranch -> CommandStart
|
||||
mergeLocal mergeconfig o currbranch = stopUnless (notOnlyAnnex o) $
|
||||
|
@ -578,7 +580,7 @@ importRemote importcontent o remote currbranch
|
|||
let (branch, subdir) = splitRemoteAnnexTrackingBranchSubdir b
|
||||
if canImportKeys remote importcontent
|
||||
then do
|
||||
Command.Import.seekRemote remote branch subdir importcontent (CheckGitIgnore True) Nothing
|
||||
Command.Import.seekRemote remote branch subdir importcontent (CheckGitIgnore True) []
|
||||
-- Importing generates a branch
|
||||
-- that is not initially connected
|
||||
-- to the current branch, so allow
|
||||
|
@ -976,7 +978,7 @@ seekExportContent :: Maybe SyncOptions -> [Remote] -> CurrBranch -> Annex Bool
|
|||
seekExportContent o rs (mcurrbranch, madj)
|
||||
| null rs = return False
|
||||
| otherwise = do
|
||||
-- Propigate commits from the adjusted branch, so that
|
||||
-- Propagate commits from the adjusted branch, so that
|
||||
-- when the remoteAnnexTrackingBranch is set to the parent
|
||||
-- branch, it will be up-to-date.
|
||||
case (mcurrbranch, madj) of
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue