git style filename quoting controlled by core.quotePath
This is by no means complete, but escaping filenames in actionItemDesc does cover most commands. Note that for ActionItemBranchFilePath, the value is branch:file, and I choose to only quote the file part (if necessary). I considered quoting the whole thing. But, branch names cannot contain control characters, and while they can contain unicode, git coes not quote unicode when displaying branch names. So, it would be surprising for git-annex to quote unicode in a branch name. The find command is the most obvious command that still needs to be dealt with. There are probably other places that filenames also get displayed, eg embedded in error messages. Some other commands use ActionItemOther with a filename, I think that ActionItemOther should either be pre-sanitized, or should explicitly not be used for filenames, so that needs more work. When --json is used, unicode does not get escaped, but control characters were already escaped in json. (Key escaping may turn out to be needed, but I'm ignoring that for now.) Sponsored-by: unqueued on Patreon
This commit is contained in:
parent
81bc57322f
commit
d689a5b338
11 changed files with 78 additions and 45 deletions
|
@ -15,6 +15,7 @@ import Logs.Transfer
|
||||||
import Utility.DirWatcher
|
import Utility.DirWatcher
|
||||||
import Utility.DirWatcher.Types
|
import Utility.DirWatcher.Types
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
import qualified Annex
|
||||||
import Annex.Perms
|
import Annex.Perms
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
@ -62,7 +63,8 @@ onAdd file = case parseTransferFile file of
|
||||||
where
|
where
|
||||||
go _ Nothing = noop -- transfer already finished
|
go _ Nothing = noop -- transfer already finished
|
||||||
go t (Just info) = do
|
go t (Just info) = do
|
||||||
debug [ "transfer starting:", describeTransfer t info ]
|
qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
|
||||||
|
debug [ "transfer starting:", describeTransfer qp t info ]
|
||||||
r <- liftAnnex $ Remote.remoteFromUUID $ transferUUID t
|
r <- liftAnnex $ Remote.remoteFromUUID $ transferUUID t
|
||||||
updateTransferInfo t info { transferRemote = r }
|
updateTransferInfo t info { transferRemote = r }
|
||||||
|
|
||||||
|
|
|
@ -31,6 +31,7 @@ import Logs.Transfer
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
import qualified Types.Remote as Remote
|
import qualified Types.Remote as Remote
|
||||||
|
import qualified Annex
|
||||||
import Annex.Wanted
|
import Annex.Wanted
|
||||||
import Utility.TList
|
import Utility.TList
|
||||||
|
|
||||||
|
@ -139,7 +140,8 @@ enqueue reason schedule t info
|
||||||
| otherwise = go snocTList
|
| otherwise = go snocTList
|
||||||
where
|
where
|
||||||
go modlist = whenM (add modlist) $ do
|
go modlist = whenM (add modlist) $ do
|
||||||
debug [ "queued", describeTransfer t info, ": " ++ reason ]
|
qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
|
||||||
|
debug [ "queued", describeTransfer qp t info, ": " ++ reason ]
|
||||||
notifyTransfer
|
notifyTransfer
|
||||||
add modlist = do
|
add modlist = do
|
||||||
q <- getAssistant transferQueue
|
q <- getAssistant transferQueue
|
||||||
|
|
|
@ -123,14 +123,16 @@ genTransfer t info = case transferRemote info of
|
||||||
return Nothing
|
return Nothing
|
||||||
, ifM (liftAnnex $ shouldTransfer t info)
|
, ifM (liftAnnex $ shouldTransfer t info)
|
||||||
( do
|
( do
|
||||||
debug [ "Transferring:" , describeTransfer t info ]
|
qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
|
||||||
|
debug [ "Transferring:" , describeTransfer qp t info ]
|
||||||
notifyTransfer
|
notifyTransfer
|
||||||
let sd = remoteAnnexStallDetection
|
let sd = remoteAnnexStallDetection
|
||||||
(Remote.gitconfig remote)
|
(Remote.gitconfig remote)
|
||||||
return $ Just (t, info, go remote sd)
|
return $ Just (t, info, go remote sd)
|
||||||
, do
|
, do
|
||||||
|
qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
|
||||||
debug [ "Skipping unnecessary transfer:",
|
debug [ "Skipping unnecessary transfer:",
|
||||||
describeTransfer t info ]
|
describeTransfer qp t info ]
|
||||||
void $ removeTransfer t
|
void $ removeTransfer t
|
||||||
finishedTransfer t (Just info)
|
finishedTransfer t (Just info)
|
||||||
return Nothing
|
return Nothing
|
||||||
|
@ -241,9 +243,11 @@ finishedTransfer t (Just info)
|
||||||
Later (transferKey t) (associatedFile info) Upload
|
Later (transferKey t) (associatedFile info) Upload
|
||||||
| otherwise = dodrops True
|
| otherwise = dodrops True
|
||||||
where
|
where
|
||||||
dodrops fromhere = handleDrops
|
dodrops fromhere = do
|
||||||
("drop wanted after " ++ describeTransfer t info)
|
qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
|
||||||
fromhere (transferKey t) (associatedFile info) []
|
handleDrops
|
||||||
|
("drop wanted after " ++ describeTransfer qp t info)
|
||||||
|
fromhere (transferKey t) (associatedFile info) []
|
||||||
finishedTransfer _ _ = noop
|
finishedTransfer _ _ = noop
|
||||||
|
|
||||||
{- Pause a running transfer. -}
|
{- Pause a running transfer. -}
|
||||||
|
|
|
@ -1,3 +1,12 @@
|
||||||
|
git-annex (10.20230408) UNRELEASED; urgency=medium
|
||||||
|
|
||||||
|
* Many commands now display filenames that contain unusual characters the
|
||||||
|
same way that git does, to avoid exposing control characters to the terminal.
|
||||||
|
* Support core.quotePath, which can be set to false to display utf8
|
||||||
|
characters as-is in filenames.
|
||||||
|
|
||||||
|
-- Joey Hess <id@joeyh.name> Sat, 08 Apr 2023 13:57:18 -0400
|
||||||
|
|
||||||
git-annex (10.20230407) upstream; urgency=medium
|
git-annex (10.20230407) upstream; urgency=medium
|
||||||
|
|
||||||
* Fix laziness bug introduced in last release that breaks use
|
* Fix laziness bug introduced in last release that breaks use
|
||||||
|
|
|
@ -167,7 +167,8 @@ performRemote key afile backend numcopies remote =
|
||||||
Nothing -> go True Nothing
|
Nothing -> go True Nothing
|
||||||
Just (Right verification) -> go True (Just (tmpfile, verification))
|
Just (Right verification) -> go True (Just (tmpfile, verification))
|
||||||
Just (Left _) -> do
|
Just (Left _) -> do
|
||||||
warning (decodeBS (actionItemDesc ai) ++ ": failed to download file from remote")
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
|
warning (decodeBS (actionItemDesc qp ai) ++ ": failed to download file from remote")
|
||||||
void $ go True Nothing
|
void $ go True Nothing
|
||||||
return False
|
return False
|
||||||
dispatch (Right False) = go False Nothing
|
dispatch (Right False) = go False Nothing
|
||||||
|
@ -350,9 +351,10 @@ verifyLocationLog' key ai present u updatestatus = do
|
||||||
return True
|
return True
|
||||||
(False, True) -> do
|
(False, True) -> do
|
||||||
fix InfoMissing
|
fix InfoMissing
|
||||||
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
warning $
|
warning $
|
||||||
"** Based on the location log, " ++
|
"** Based on the location log, " ++
|
||||||
decodeBS (actionItemDesc ai) ++
|
decodeBS (actionItemDesc qp ai) ++
|
||||||
"\n** was expected to be present, " ++
|
"\n** was expected to be present, " ++
|
||||||
"but its content is missing."
|
"but its content is missing."
|
||||||
return False
|
return False
|
||||||
|
@ -389,10 +391,11 @@ verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = case afile of
|
||||||
if null missinglocs
|
if null missinglocs
|
||||||
then return True
|
then return True
|
||||||
else do
|
else do
|
||||||
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs
|
missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs
|
||||||
warning $
|
warning $
|
||||||
"** Required content " ++
|
"** Required content " ++
|
||||||
decodeBS (actionItemDesc ai) ++
|
decodeBS (actionItemDesc qp ai) ++
|
||||||
" is missing from these repositories:\n" ++
|
" is missing from these repositories:\n" ++
|
||||||
missingrequired
|
missingrequired
|
||||||
return False
|
return False
|
||||||
|
@ -465,8 +468,9 @@ checkKeySizeOr bad key file ai = case fromKey keySize key of
|
||||||
return same
|
return same
|
||||||
badsize a b = do
|
badsize a b = do
|
||||||
msg <- bad key
|
msg <- bad key
|
||||||
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
warning $ concat
|
warning $ concat
|
||||||
[ decodeBS (actionItemDesc ai)
|
[ decodeBS (actionItemDesc qp ai)
|
||||||
, ": Bad file size ("
|
, ": Bad file size ("
|
||||||
, compareSizes storageUnits True a b
|
, compareSizes storageUnits True a b
|
||||||
, "); "
|
, "); "
|
||||||
|
@ -483,8 +487,9 @@ checkKeyUpgrade :: Backend -> Key -> ActionItem -> AssociatedFile -> Annex Bool
|
||||||
checkKeyUpgrade backend key ai (AssociatedFile (Just file)) =
|
checkKeyUpgrade backend key ai (AssociatedFile (Just file)) =
|
||||||
case Types.Backend.canUpgradeKey backend of
|
case Types.Backend.canUpgradeKey backend of
|
||||||
Just a | a key -> do
|
Just a | a key -> do
|
||||||
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
warning $ concat
|
warning $ concat
|
||||||
[ decodeBS (actionItemDesc ai)
|
[ decodeBS (actionItemDesc qp ai)
|
||||||
, ": Can be upgraded to an improved key format. "
|
, ": Can be upgraded to an improved key format. "
|
||||||
, "You can do so by running: git annex migrate --backend="
|
, "You can do so by running: git annex migrate --backend="
|
||||||
, decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " "
|
, decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " "
|
||||||
|
@ -534,8 +539,9 @@ checkBackendOr bad backend key file ai =
|
||||||
ok <- verifier key file
|
ok <- verifier key file
|
||||||
unless ok $ do
|
unless ok $ do
|
||||||
msg <- bad key
|
msg <- bad key
|
||||||
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
warning $ concat
|
warning $ concat
|
||||||
[ decodeBS (actionItemDesc ai)
|
[ decodeBS (actionItemDesc qp ai)
|
||||||
, ": Bad file content; "
|
, ": Bad file content; "
|
||||||
, msg
|
, msg
|
||||||
]
|
]
|
||||||
|
@ -562,8 +568,9 @@ checkInodeCache key content mic ai = case mic of
|
||||||
withTSDelta (liftIO . genInodeCache content) >>= \case
|
withTSDelta (liftIO . genInodeCache content) >>= \case
|
||||||
Nothing -> noop
|
Nothing -> noop
|
||||||
Just ic' -> whenM (compareInodeCaches ic ic') $ do
|
Just ic' -> whenM (compareInodeCaches ic ic') $ do
|
||||||
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
warning $ concat
|
warning $ concat
|
||||||
[ decodeBS (actionItemDesc ai)
|
[ decodeBS (actionItemDesc qp ai)
|
||||||
, ": Stale or missing inode cache; updating."
|
, ": Stale or missing inode cache; updating."
|
||||||
]
|
]
|
||||||
Database.Keys.addInodeCaches key [ic]
|
Database.Keys.addInodeCaches key [ic]
|
||||||
|
|
|
@ -455,15 +455,16 @@ transfer_list = stat desc $ nojson $ lift $ do
|
||||||
uuidmap <- Remote.remoteMap id
|
uuidmap <- Remote.remoteMap id
|
||||||
ts <- getTransfers
|
ts <- getTransfers
|
||||||
maybeShowJSON $ JSONChunk [(desc, V.fromList $ map (uncurry jsonify) ts)]
|
maybeShowJSON $ JSONChunk [(desc, V.fromList $ map (uncurry jsonify) ts)]
|
||||||
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
return $ if null ts
|
return $ if null ts
|
||||||
then "none"
|
then "none"
|
||||||
else multiLine $
|
else multiLine $
|
||||||
map (uncurry $ line uuidmap) $ sort ts
|
map (uncurry $ line qp uuidmap) $ sort ts
|
||||||
where
|
where
|
||||||
desc = "transfers in progress"
|
desc = "transfers in progress"
|
||||||
line uuidmap t i = unwords
|
line qp uuidmap t i = unwords
|
||||||
[ fromRawFilePath (formatDirection (transferDirection t)) ++ "ing"
|
[ fromRawFilePath (formatDirection (transferDirection t)) ++ "ing"
|
||||||
, fromRawFilePath $ actionItemDesc $ mkActionItem
|
, fromRawFilePath $ actionItemDesc qp $ mkActionItem
|
||||||
(transferKey t, associatedFile i)
|
(transferKey t, associatedFile i)
|
||||||
, if transferDirection t == Upload then "to" else "from"
|
, if transferDirection t == Upload then "to" else "from"
|
||||||
, maybe (fromUUID $ transferUUID t) Remote.name $
|
, maybe (fromUUID $ transferUUID t) Remote.name $
|
||||||
|
|
|
@ -30,6 +30,7 @@ module Git.FilePath (
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
import Git
|
import Git
|
||||||
|
import qualified Git.Filename as Filename
|
||||||
|
|
||||||
import qualified System.FilePath.ByteString as P
|
import qualified System.FilePath.ByteString as P
|
||||||
import qualified System.FilePath.Posix.ByteString
|
import qualified System.FilePath.Posix.ByteString
|
||||||
|
@ -48,9 +49,9 @@ data BranchFilePath = BranchFilePath Ref TopFilePath
|
||||||
deriving (Show, Eq, Ord)
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
{- Git uses the branch:file form to refer to a BranchFilePath -}
|
{- Git uses the branch:file form to refer to a BranchFilePath -}
|
||||||
descBranchFilePath :: BranchFilePath -> S.ByteString
|
descBranchFilePath :: Filename.QuotePath -> BranchFilePath -> S.ByteString
|
||||||
descBranchFilePath (BranchFilePath b f) =
|
descBranchFilePath qp (BranchFilePath b f) =
|
||||||
fromRef' b <> ":" <> getTopFilePath f
|
fromRef' b <> ":" <> Filename.encode qp (getTopFilePath f)
|
||||||
|
|
||||||
{- Path to a TopFilePath, within the provided git repo. -}
|
{- Path to a TopFilePath, within the provided git repo. -}
|
||||||
fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath
|
fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath
|
||||||
|
|
|
@ -14,6 +14,7 @@ import Types.Transfer
|
||||||
import Types.ActionItem
|
import Types.ActionItem
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
import qualified Git
|
import qualified Git
|
||||||
|
import qualified Git.Filename
|
||||||
import Utility.Metered
|
import Utility.Metered
|
||||||
import Utility.Percentage
|
import Utility.Percentage
|
||||||
import Utility.PID
|
import Utility.PID
|
||||||
|
@ -31,11 +32,11 @@ import Control.Concurrent.STM
|
||||||
import qualified Data.ByteString.Char8 as B8
|
import qualified Data.ByteString.Char8 as B8
|
||||||
import qualified System.FilePath.ByteString as P
|
import qualified System.FilePath.ByteString as P
|
||||||
|
|
||||||
describeTransfer :: Transfer -> TransferInfo -> String
|
describeTransfer :: Git.Filename.QuotePath -> Transfer -> TransferInfo -> String
|
||||||
describeTransfer t info = unwords
|
describeTransfer qp t info = unwords
|
||||||
[ show $ transferDirection t
|
[ show $ transferDirection t
|
||||||
, show $ transferUUID t
|
, show $ transferUUID t
|
||||||
, decodeBS $ actionItemDesc $ ActionItemAssociatedFile
|
, decodeBS $ actionItemDesc qp $ ActionItemAssociatedFile
|
||||||
(associatedFile info)
|
(associatedFile info)
|
||||||
(transferKey t)
|
(transferKey t)
|
||||||
, show $ bytesComplete info
|
, show $ bytesComplete info
|
||||||
|
|
25
Messages.hs
25
Messages.hs
|
@ -1,6 +1,6 @@
|
||||||
{- git-annex output messages
|
{- git-annex output messages
|
||||||
-
|
-
|
||||||
- Copyright 2010-2021 Joey Hess <id@joeyh.name>
|
- Copyright 2010-2023 Joey Hess <id@joeyh.name>
|
||||||
-
|
-
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -62,7 +62,6 @@ import Types.Messages
|
||||||
import Types.ActionItem
|
import Types.ActionItem
|
||||||
import Types.Concurrency
|
import Types.Concurrency
|
||||||
import Types.Command (StartMessage(..), SeekInput)
|
import Types.Command (StartMessage(..), SeekInput)
|
||||||
import Types.Transfer (transferKey)
|
|
||||||
import Messages.Internal
|
import Messages.Internal
|
||||||
import Messages.Concurrent
|
import Messages.Concurrent
|
||||||
import Annex.Debug
|
import Annex.Debug
|
||||||
|
@ -76,11 +75,13 @@ showStart command file si = outputMessage json $
|
||||||
where
|
where
|
||||||
json = JSON.start command (Just file) Nothing si
|
json = JSON.start command (Just file) Nothing si
|
||||||
|
|
||||||
showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex ()
|
showStartActionItem :: String -> ActionItem -> SeekInput -> Annex ()
|
||||||
showStartKey command key ai si = outputMessage json $
|
showStartActionItem command ai si = do
|
||||||
encodeBS command <> " " <> actionItemDesc ai <> " "
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||||
|
outputMessage json $
|
||||||
|
encodeBS command <> " " <> actionItemDesc qp ai <> " "
|
||||||
where
|
where
|
||||||
json = JSON.start command (actionItemFile ai) (Just key) si
|
json = JSON.start command (actionItemFile ai) (actionItemKey ai) si
|
||||||
|
|
||||||
showStartOther :: String -> Maybe String -> SeekInput -> Annex ()
|
showStartOther :: String -> Maybe String -> SeekInput -> Annex ()
|
||||||
showStartOther command mdesc si = outputMessage json $ encodeBS $
|
showStartOther command mdesc si = outputMessage json $ encodeBS $
|
||||||
|
@ -90,11 +91,11 @@ showStartOther command mdesc si = outputMessage json $ encodeBS $
|
||||||
|
|
||||||
showStartMessage :: StartMessage -> Annex ()
|
showStartMessage :: StartMessage -> Annex ()
|
||||||
showStartMessage (StartMessage command ai si) = case ai of
|
showStartMessage (StartMessage command ai si) = case ai of
|
||||||
ActionItemAssociatedFile _ k -> showStartKey command k ai si
|
ActionItemAssociatedFile _ _ -> showStartActionItem command ai si
|
||||||
ActionItemKey k -> showStartKey command k ai si
|
ActionItemKey _ -> showStartActionItem command ai si
|
||||||
ActionItemBranchFilePath _ k -> showStartKey command k ai si
|
ActionItemBranchFilePath _ _ -> showStartActionItem command ai si
|
||||||
ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai si
|
ActionItemFailedTransfer _ _ -> showStartActionItem command ai si
|
||||||
ActionItemTreeFile file -> showStart command file si
|
ActionItemTreeFile _ -> showStartActionItem command ai si
|
||||||
ActionItemOther msg -> showStartOther command msg si
|
ActionItemOther msg -> showStartOther command msg si
|
||||||
OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
|
OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si)
|
||||||
showStartMessage (StartUsualMessages command ai si) = do
|
showStartMessage (StartUsualMessages command ai si) = do
|
||||||
|
@ -235,7 +236,7 @@ showFullJSON v = withMessageState $ bufferJSON (JSON.complete v)
|
||||||
{- Performs an action that outputs nonstandard/customized output, and
|
{- Performs an action that outputs nonstandard/customized output, and
|
||||||
- in JSON mode wraps its output in JSON.start and JSON.end, so it's
|
- in JSON mode wraps its output in JSON.start and JSON.end, so it's
|
||||||
- a complete JSON document.
|
- a complete JSON document.
|
||||||
- This is only needed when showStart and showEndOk is not used.
|
- This is only needed when showStart* and showEndOk is not used.
|
||||||
-}
|
-}
|
||||||
showCustom :: String -> SeekInput -> Annex Bool -> Annex ()
|
showCustom :: String -> SeekInput -> Annex Bool -> Annex ()
|
||||||
showCustom command si a = do
|
showCustom command si a = do
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- items that a command can act on
|
{- items that a command can act on
|
||||||
-
|
-
|
||||||
- Copyright 2016-2019 Joey Hess <id@joeyh.name>
|
- Copyright 2016-2023 Joey Hess <id@joeyh.name>
|
||||||
-
|
-
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -12,6 +12,7 @@ module Types.ActionItem where
|
||||||
import Key
|
import Key
|
||||||
import Types.Transfer
|
import Types.Transfer
|
||||||
import Git.FilePath
|
import Git.FilePath
|
||||||
|
import qualified Git.Filename
|
||||||
import Utility.FileSystemEncoding
|
import Utility.FileSystemEncoding
|
||||||
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
@ -56,17 +57,18 @@ instance MkActionItem (BranchFilePath, Key) where
|
||||||
instance MkActionItem (Transfer, TransferInfo) where
|
instance MkActionItem (Transfer, TransferInfo) where
|
||||||
mkActionItem = uncurry ActionItemFailedTransfer
|
mkActionItem = uncurry ActionItemFailedTransfer
|
||||||
|
|
||||||
actionItemDesc :: ActionItem -> S.ByteString
|
actionItemDesc :: Git.Filename.QuotePath -> ActionItem -> S.ByteString
|
||||||
actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f)) _) = f
|
actionItemDesc qp (ActionItemAssociatedFile (AssociatedFile (Just f)) _) =
|
||||||
actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing) k) =
|
Git.Filename.encode qp f
|
||||||
|
actionItemDesc _ (ActionItemAssociatedFile (AssociatedFile Nothing) k) =
|
||||||
serializeKey' k
|
serializeKey' k
|
||||||
actionItemDesc (ActionItemKey k) = serializeKey' k
|
actionItemDesc _ (ActionItemKey k) = serializeKey' k
|
||||||
actionItemDesc (ActionItemBranchFilePath bfp _) = descBranchFilePath bfp
|
actionItemDesc qp (ActionItemBranchFilePath bfp _) = descBranchFilePath qp bfp
|
||||||
actionItemDesc (ActionItemFailedTransfer t i) = actionItemDesc $
|
actionItemDesc qp (ActionItemFailedTransfer t i) = actionItemDesc qp $
|
||||||
ActionItemAssociatedFile (associatedFile i) (transferKey t)
|
ActionItemAssociatedFile (associatedFile i) (transferKey t)
|
||||||
actionItemDesc (ActionItemTreeFile f) = f
|
actionItemDesc qp (ActionItemTreeFile f) = Git.Filename.encode qp f
|
||||||
actionItemDesc (ActionItemOther s) = encodeBS (fromMaybe "" s)
|
actionItemDesc _ (ActionItemOther s) = encodeBS (fromMaybe "" s)
|
||||||
actionItemDesc (OnlyActionOn _ ai) = actionItemDesc ai
|
actionItemDesc qp (OnlyActionOn _ ai) = actionItemDesc qp ai
|
||||||
|
|
||||||
actionItemKey :: ActionItem -> Maybe Key
|
actionItemKey :: ActionItem -> Maybe Key
|
||||||
actionItemKey (ActionItemAssociatedFile _ k) = Just k
|
actionItemKey (ActionItemAssociatedFile _ k) = Just k
|
||||||
|
|
|
@ -32,6 +32,7 @@ import Git.Types
|
||||||
import Git.ConfigTypes
|
import Git.ConfigTypes
|
||||||
import Git.Remote (isRemoteKey, remoteKeyToRemoteName)
|
import Git.Remote (isRemoteKey, remoteKeyToRemoteName)
|
||||||
import Git.Branch (CommitMode(..))
|
import Git.Branch (CommitMode(..))
|
||||||
|
import Git.Filename (QuotePath(..))
|
||||||
import Utility.DataUnits
|
import Utility.DataUnits
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
import Types.UUID
|
import Types.UUID
|
||||||
|
@ -140,6 +141,7 @@ data GitConfig = GitConfig
|
||||||
, annexSupportUnlocked :: Bool
|
, annexSupportUnlocked :: Bool
|
||||||
, coreSymlinks :: Bool
|
, coreSymlinks :: Bool
|
||||||
, coreSharedRepository :: SharedRepository
|
, coreSharedRepository :: SharedRepository
|
||||||
|
, coreQuotePath :: QuotePath
|
||||||
, receiveDenyCurrentBranch :: DenyCurrentBranch
|
, receiveDenyCurrentBranch :: DenyCurrentBranch
|
||||||
, gcryptId :: Maybe String
|
, gcryptId :: Maybe String
|
||||||
, gpgCmd :: GpgCmd
|
, gpgCmd :: GpgCmd
|
||||||
|
@ -250,6 +252,7 @@ extractGitConfig configsource r = GitConfig
|
||||||
, annexSupportUnlocked = getbool (annexConfig "supportunlocked") True
|
, annexSupportUnlocked = getbool (annexConfig "supportunlocked") True
|
||||||
, coreSymlinks = getbool "core.symlinks" True
|
, coreSymlinks = getbool "core.symlinks" True
|
||||||
, coreSharedRepository = getSharedRepository r
|
, coreSharedRepository = getSharedRepository r
|
||||||
|
, coreQuotePath = QuotePath (getbool "core.quotepath" True)
|
||||||
, receiveDenyCurrentBranch = getDenyCurrentBranch r
|
, receiveDenyCurrentBranch = getDenyCurrentBranch r
|
||||||
, gcryptId = getmaybe "core.gcrypt-id"
|
, gcryptId = getmaybe "core.gcrypt-id"
|
||||||
, gpgCmd = mkGpgCmd (getmaybe "gpg.program")
|
, gpgCmd = mkGpgCmd (getmaybe "gpg.program")
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue