git-annex 7.20190219 → 7.20190322

raw patch · 484 files changed

+2913/−1120 lines, 484 files

This diff is very large; some files are shown as “too large to diff”. Download the raw patch for the complete diff.

Files

Annex.hs +3/−2
Annex/Action.hs +1/−1
Annex/AutoMerge.hs +1/−1
Annex/BloomFilter.hs +1/−1
Annex/Branch.hs +10/−10
Annex/Branch/Transitions.hs +4/−4
Annex/BranchState.hs +1/−1
Annex/CatFile.hs +1/−1
Annex/ChangedRefs.hs +1/−1
Annex/CheckAttr.hs +1/−1
Annex/CheckIgnore.hs +1/−1
Annex/Concurrent.hs +1/−1
Annex/Content.hs +1/−1
Annex/Content/Direct.hs +1/−1
Annex/Content/LowLevel.hs +1/−1
Annex/Content/PointerFile.hs +1/−1
Annex/Difference.hs +1/−1
Annex/DirHashes.hs +1/−1
Annex/Direct.hs +1/−1
Annex/Drop.hs +1/−2
Annex/Environment.hs +1/−1
Annex/Export.hs +1/−6
Annex/FileMatcher.hs +1/−1
Annex/Fixup.hs +1/−1
Annex/GitOverlay.hs +1/−1
Annex/HashObject.hs +1/−1
Annex/Hook.hs +1/−1
Annex/Import.hs +339/−0
Annex/Ingest.hs +1/−1
Annex/Init.hs +1/−1
Annex/InodeSentinal.hs +1/−1
Annex/Journal.hs +1/−1
Annex/Link.hs +1/−1
Annex/Locations.hs +16/−1
Annex/LockFile.hs +11/−3
Annex/LockPool.hs +1/−1
Annex/LockPool/PosixOrPid.hs +1/−1
Annex/Magic.hs +1/−1
Annex/MakeRepo.hs +1/−1
Annex/MetaData.hs +1/−1
Annex/MetaData/StandardFields.hs +1/−1
Annex/Multicast.hs +1/−1
Annex/Notification.hs +1/−1
Annex/NumCopies.hs +1/−1
Annex/Path.hs +1/−1
Annex/Perms.hs +1/−1
Annex/Queue.hs +1/−1
Annex/RemoteTrackingBranch.hs +34/−0
Annex/ReplaceFile.hs +1/−1
Annex/SpecialRemote.hs +1/−1
Annex/Ssh.hs +1/−1
Annex/TaggedPush.hs +1/−1
Annex/Tmp.hs +1/−1
Annex/Transfer.hs +1/−1
Annex/UUID.hs +1/−1
Annex/UpdateInstead.hs +1/−1
Annex/Url.hs +1/−1
Annex/VariantFile.hs +1/−1
Annex/VectorClock.hs +1/−1
Annex/View.hs +1/−1
Annex/View/ViewedFile.hs +1/−1
Annex/Wanted.hs +1/−1
Annex/WorkTree.hs +2/−2
Annex/YoutubeDl.hs +1/−1
Assistant.hs +1/−1
Assistant/Alert.hs +1/−1
Assistant/Alert/Utility.hs +1/−1
Assistant/BranchChange.hs +1/−1
Assistant/Changes.hs +1/−1
Assistant/Commits.hs +1/−1
Assistant/Common.hs +1/−1
Assistant/CredPairCache.hs +1/−1
Assistant/DaemonStatus.hs +2/−2
Assistant/DeleteRemote.hs +1/−1
Assistant/Drop.hs +1/−1
Assistant/Fsck.hs +1/−1
Assistant/Gpg.hs +1/−1
Assistant/Install.hs +1/−1
Assistant/Install/AutoStart.hs +1/−1
Assistant/Install/Menu.hs +1/−1
Assistant/MakeRemote.hs +1/−1
Assistant/Monad.hs +1/−1
Assistant/NamedThread.hs +1/−1
Assistant/Pairing.hs +1/−1
Assistant/Pairing/MakeRemote.hs +1/−1
Assistant/Pairing/Network.hs +1/−1
Assistant/Pushes.hs +1/−1
Assistant/RemoteControl.hs +1/−1
Assistant/Repair.hs +1/−1
Assistant/RepoProblem.hs +1/−1
Assistant/Restart.hs +1/−1
Assistant/ScanRemotes.hs +1/−1
Assistant/Ssh.hs +1/−1
Assistant/Sync.hs +1/−1
Assistant/Threads/Committer.hs +1/−1
Assistant/Threads/ConfigMonitor.hs +1/−1
Assistant/Threads/Cronner.hs +1/−1
Assistant/Threads/DaemonStatus.hs +1/−1
Assistant/Threads/Exporter.hs +2/−2
Assistant/Threads/Glacier.hs +1/−1
Assistant/Threads/Merger.hs +1/−1
Assistant/Threads/MountWatcher.hs +1/−1
Assistant/Threads/NetWatcher.hs +1/−1
Assistant/Threads/PairListener.hs +1/−1
Assistant/Threads/ProblemFixer.hs +1/−1
Assistant/Threads/Pusher.hs +1/−1
Assistant/Threads/RemoteControl.hs +1/−1
Assistant/Threads/SanityChecker.hs +1/−1
Assistant/Threads/TransferPoller.hs +1/−1
Assistant/Threads/TransferScanner.hs +1/−1
Assistant/Threads/TransferWatcher.hs +1/−1
Assistant/Threads/Transferrer.hs +1/−1
Assistant/Threads/UpgradeWatcher.hs +1/−1
Assistant/Threads/Upgrader.hs +1/−1
Assistant/Threads/Watcher.hs +1/−1
Assistant/Threads/WebApp.hs +1/−1
Assistant/TransferQueue.hs +1/−1
Assistant/TransferSlots.hs +1/−1
Assistant/TransferrerPool.hs +1/−1
Assistant/Types/Alert.hs +1/−1
Assistant/Types/BranchChange.hs +1/−1
Assistant/Types/Changes.hs +1/−1
Assistant/Types/Commits.hs +1/−1
Assistant/Types/CredPairCache.hs +1/−1
Assistant/Types/DaemonStatus.hs +1/−1
Assistant/Types/NamedThread.hs +1/−1
Assistant/Types/Pushes.hs +1/−1
Assistant/Types/RemoteControl.hs +1/−1
Assistant/Types/RepoProblem.hs +1/−1
Assistant/Types/ScanRemotes.hs +1/−1
Assistant/Types/ThreadName.hs +1/−1
Assistant/Types/ThreadedMonad.hs +1/−1
Assistant/Types/TransferQueue.hs +1/−1
Assistant/Types/TransferSlots.hs +1/−1
Assistant/Types/TransferrerPool.hs +1/−1
Assistant/Types/UrlRenderer.hs +1/−1
Assistant/Unused.hs +1/−1
Assistant/Upgrade.hs +1/−1
Backend.hs +1/−1
Backend/Hash.hs +1/−1
Backend/URL.hs +1/−1
Backend/Utilities.hs +1/−1
Backend/WORM.hs +1/−1
Build/BundledPrograms.hs +2/−9
Build/DesktopFile.hs +3/−3
Build/Mans.hs +1/−1
BuildFlags.hs +1/−1
BuildInfo.hs +1/−1
CHANGELOG +44/−0
COPYRIGHT +3/−7
CmdLine.hs +1/−1
CmdLine/Action.hs +1/−1
CmdLine/Batch.hs +1/−1
CmdLine/GitAnnex.hs +1/−1
CmdLine/GitAnnex/Options.hs +1/−1
CmdLine/GitAnnexShell.hs +1/−1
CmdLine/GitAnnexShell/Checks.hs +1/−1
CmdLine/GitAnnexShell/Fields.hs +1/−1
CmdLine/GitRemoteTorAnnex.hs +1/−1
CmdLine/GlobalSetter.hs +1/−1
CmdLine/Option.hs +1/−1
CmdLine/Seek.hs +2/−2
CmdLine/Usage.hs +1/−1
Command.hs +1/−1
Command/Add.hs +1/−1
Command/AddUnused.hs +1/−1
Command/AddUrl.hs +8/−3
Command/Adjust.hs +1/−1
Command/Assistant.hs +1/−1
Command/Benchmark.hs +1/−1
Command/CalcKey.hs +1/−1
Command/CheckPresentKey.hs +1/−1
Command/Commit.hs +1/−1
Command/Config.hs +1/−1
Command/ConfigList.hs +1/−1
Command/ContentLocation.hs +1/−1
Command/Copy.hs +1/−1
Command/Dead.hs +1/−1
Command/Describe.hs +1/−1
Command/DiffDriver.hs +1/−1
Command/Direct.hs +1/−1
Command/Drop.hs +1/−1
Command/DropKey.hs +1/−1
Command/DropUnused.hs +1/−1
Command/EnableRemote.hs +1/−1
Command/EnableTor.hs +1/−1
Command/ExamineKey.hs +1/−1
Command/Expire.hs +1/−1
Command/Export.hs +87/−40
Command/Find.hs +1/−1
Command/FindRef.hs +1/−1
Command/Fix.hs +1/−1
Command/Forget.hs +1/−1
Command/FromKey.hs +1/−1
Command/Fsck.hs +39/−26
Command/FuzzTest.hs +1/−1
Command/GCryptSetup.hs +1/−1
Command/Get.hs +1/−1
Command/Group.hs +1/−1
Command/GroupWanted.hs +1/−1
Command/Help.hs +1/−1
Command/Import.hs +119/−19
Command/ImportFeed.hs +1/−1
Command/InAnnex.hs +1/−1
Command/Indirect.hs +1/−1
Command/Info.hs +2/−2
Command/Init.hs +1/−1
Command/InitRemote.hs +1/−1
Command/Inprogress.hs +1/−1
Command/List.hs +1/−1
Command/Lock.hs +1/−1
Command/LockContent.hs +1/−1
Command/Log.hs +1/−1
Command/LookupKey.hs +1/−1
Command/Map.hs +1/−1
Command/MatchExpression.hs +1/−1
Command/Merge.hs +1/−1
Command/MetaData.hs +1/−1
Command/Migrate.hs +2/−2
Command/Mirror.hs +1/−1
Command/Move.hs +1/−1
Command/Multicast.hs +1/−1
Command/NotifyChanges.hs +1/−1
Command/NumCopies.hs +1/−1
Command/P2P.hs +1/−1
Command/P2PStdIO.hs +1/−1
Command/PostReceive.hs +1/−1
Command/PreCommit.hs +1/−1
Command/Proxy.hs +1/−1
Command/ReKey.hs +1/−1
Command/ReadPresentKey.hs +1/−1
Command/RecvKey.hs +1/−1
Command/RegisterUrl.hs +1/−1
Command/Reinit.hs +1/−1
Command/Reinject.hs +1/−1
Command/RemoteDaemon.hs +1/−1
Command/Repair.hs +1/−1
Command/Required.hs +1/−1
Command/ResolveMerge.hs +1/−1
Command/RmUrl.hs +1/−1
Command/Schedule.hs +1/−1
Command/Semitrust.hs +1/−1
Command/SendKey.hs +1/−1
Command/SetKey.hs +1/−1
Command/SetPresentKey.hs +1/−1
Command/Smudge.hs +1/−1
Command/Status.hs +1/−1
Command/Sync.hs +67/−34
Command/Test.hs +1/−1
Command/TestRemote.hs +2/−2
Command/TransferInfo.hs +1/−1
Command/TransferKey.hs +1/−1
Command/TransferKeys.hs +1/−1
Command/Trust.hs +1/−1
Command/Unannex.hs +1/−1
Command/Undo.hs +1/−1
Command/Ungroup.hs +1/−1
Command/Uninit.hs +1/−1
Command/Unlock.hs +1/−1
Command/Untrust.hs +1/−1
Command/Unused.hs +1/−1
Command/Upgrade.hs +1/−1
Command/VAdd.hs +1/−1
Command/VCycle.hs +1/−1
Command/VFilter.hs +1/−1
Command/VPop.hs +1/−1
Command/Version.hs +1/−1
Command/Vicfg.hs +1/−1
Command/View.hs +1/−1
Command/Wanted.hs +1/−1
Command/Watch.hs +1/−1
Command/WebApp.hs +1/−1
Command/Whereis.hs +1/−1
Config.hs +7/−1
Config/Cost.hs +1/−1
Config/DynamicConfig.hs +1/−1
Config/Files.hs +2/−2
Config/GitConfig.hs +1/−1
Config/Smudge.hs +3/−3
Creds.hs +1/−1
Crypto.hs +1/−1
Database/ContentIdentifier.hs +154/−0
Database/Export.hs +133/−30
Database/Fsck.hs +1/−1
Database/Handle.hs +1/−1
Database/Init.hs +1/−1
Database/Keys.hs +1/−1
Database/Keys/Handle.hs +1/−1
Database/Keys/SQL.hs +1/−1
Database/Queue.hs +1/−1
Database/Types.hs +32/−2
Git.hs +1/−1
Git/AutoCorrect.hs +1/−1
Git/Branch.hs +1/−1
Git/BuildVersion.hs +1/−1
Git/CatFile.hs +1/−1
Git/CheckAttr.hs +1/−1
Git/CheckIgnore.hs +1/−1
Git/Command.hs +1/−1
Git/Command/Batch.hs +1/−1
Git/Config.hs +1/−1
Git/ConfigTypes.hs +1/−1
Git/Construct.hs +1/−1
Git/CurrentRepo.hs +1/−1
Git/DiffTree.hs +1/−1
Git/DiffTreeItem.hs +1/−1
Git/Env.hs +1/−1
Git/FileMode.hs +1/−1
Git/FilePath.hs +1/−1
Git/Filename.hs +1/−1
Git/Fsck.hs +1/−1
Git/GCrypt.hs +1/−1
Git/HashObject.hs +1/−1
Git/Hook.hs +1/−1
Git/Index.hs +1/−1
Git/LockFile.hs +1/−1
Git/LsFiles.hs +1/−1
Git/LsTree.hs +17/−12
Git/Merge.hs +13/−6
Git/Objects.hs +1/−1
Git/Queue.hs +1/−1
Git/Ref.hs +18/−9
Git/RefLog.hs +1/−1
Git/Remote.hs +1/−1
Git/Remote/Remove.hs +1/−1
Git/Repair.hs +2/−2
Git/Sha.hs +1/−1
Git/Ssh.hs +1/−1
Git/Status.hs +1/−1
Git/Tree.hs +75/−7
Git/Types.hs +1/−1
Git/UnionMerge.hs +1/−1
Git/UpdateIndex.hs +1/−1
Git/Url.hs +1/−1
Git/Version.hs +1/−1
Key.hs +1/−1
Limit.hs +1/−1
Limit/Wanted.hs +1/−1
Logs.hs +50/−40
Logs/Activity.hs +4/−4
Logs/Chunk.hs +1/−1
Logs/Chunk/Pure.hs +1/−1
Logs/Config.hs +1/−1
Logs/ContentIdentifier.hs +47/−0
Logs/ContentIdentifier/Pure.hs +75/−0
Logs/Difference.hs +3/−3
Logs/Difference/Pure.hs +2/−2
Logs/Export.hs +2/−2
Logs/FsckResults.hs +1/−1
Logs/Group.hs +4/−3
Logs/Location.hs +1/−1
Logs/MapLog.hs +5/−1
Logs/MetaData.hs +1/−1
Logs/MetaData/Pure.hs +1/−1
Logs/Multicast.hs +4/−4
Logs/NumCopies.hs +1/−1
Logs/PreferredContent.hs +2/−2
Logs/PreferredContent/Raw.hs +5/−5
Logs/Presence.hs +1/−1
Logs/Presence/Pure.hs +3/−4
Logs/Remote.hs +4/−4
Logs/RemoteState.hs +1/−1
Logs/Schedule.hs +4/−4
Logs/SingleValue.hs +1/−1
Logs/SingleValue/Pure.hs +1/−1
Logs/Transfer.hs +1/−1
Logs/Transitions.hs +1/−1
Logs/Trust.hs +1/−1
Logs/Trust/Basic.hs +3/−3
Logs/Trust/Pure.hs +2/−2
Logs/UUID.hs +3/−3
Logs/UUIDBased.hs +15/−15
Logs/Unused.hs +1/−1
Logs/View.hs +1/−1
Logs/Web.hs +1/−1
Messages.hs +1/−1
Messages/Concurrent.hs +1/−1
Messages/Internal.hs +1/−1
Messages/JSON.hs +1/−1
Messages/Progress.hs +1/−1
P2P/Address.hs +1/−1
P2P/Annex.hs +1/−1
P2P/Auth.hs +1/−1
P2P/IO.hs +1/−1
P2P/Protocol.hs +1/−1
Remote.hs +1/−1
Remote/Adb.hs +6/−4
Remote/BitTorrent.hs +4/−2
Remote/Bup.hs +4/−2
Remote/Ddar.hs +4/−2
Remote/Directory.hs +186/−16
Remote/Directory/LegacyChunked.hs +1/−1
Remote/External.hs +13/−9
Remote/GCrypt.hs +4/−2
Remote/Git.hs +3/−1
Remote/Glacier.hs +4/−2
Remote/Helper/AWS.hs +1/−1
Remote/Helper/Chunked.hs +1/−1
Remote/Helper/Chunked/Legacy.hs +1/−1
Remote/Helper/Encryptable.hs +1/−1
Remote/Helper/Export.hs too large to diff
Remote/Helper/ExportImport.hs too large to diff
Remote/Helper/Git.hs too large to diff
Remote/Helper/Hooks.hs too large to diff
Remote/Helper/Http.hs too large to diff
Remote/Helper/Messages.hs too large to diff
Remote/Helper/P2P.hs too large to diff
Remote/Helper/ReadOnly.hs too large to diff
Remote/Helper/Special.hs too large to diff
Remote/Hook.hs too large to diff
Remote/List.hs too large to diff
Remote/P2P.hs too large to diff
Remote/Rsync.hs too large to diff
Remote/Rsync/RsyncUrl.hs too large to diff
Remote/S3.hs too large to diff
Remote/Tahoe.hs too large to diff
Remote/Web.hs too large to diff
Remote/WebDAV.hs too large to diff
Remote/WebDAV/DavLocation.hs too large to diff
RemoteDaemon/Common.hs too large to diff
RemoteDaemon/Core.hs too large to diff
RemoteDaemon/Transport.hs too large to diff
RemoteDaemon/Transport/GCrypt.hs too large to diff
RemoteDaemon/Transport/Ssh.hs too large to diff
RemoteDaemon/Transport/Ssh/Types.hs too large to diff
RemoteDaemon/Transport/Tor.hs too large to diff
RemoteDaemon/Types.hs too large to diff
Test.hs too large to diff
Test/Framework.hs too large to diff
Types.hs too large to diff
Types/ActionItem.hs too large to diff
Types/Availability.hs too large to diff
Types/Backend.hs too large to diff
Types/Benchmark.hs too large to diff
Types/BranchState.hs too large to diff
Types/CleanupActions.hs too large to diff
Types/Command.hs too large to diff
Types/Concurrency.hs too large to diff
Types/Creds.hs too large to diff
Types/Crypto.hs too large to diff
Types/DeferredParse.hs too large to diff
Types/DesktopNotify.hs too large to diff
Types/Difference.hs too large to diff
Types/Distribution.hs too large to diff
Types/Export.hs too large to diff
Types/FileMatcher.hs too large to diff
Types/GitConfig.hs too large to diff
Types/Group.hs too large to diff
Types/Import.hs too large to diff
Types/Key.hs too large to diff
Types/KeySource.hs too large to diff
Types/LockCache.hs too large to diff
Types/Messages.hs too large to diff
Types/MetaData.hs too large to diff
Types/NumCopies.hs too large to diff
Types/RefSpec.hs too large to diff
Types/Remote.hs too large to diff
Types/ScheduledActivity.hs too large to diff
Types/StandardGroups.hs too large to diff
Types/StoreRetrieve.hs too large to diff
Types/Test.hs too large to diff
Types/Transfer.hs too large to diff
Types/TrustLevel.hs too large to diff
Types/UUID.hs too large to diff
Types/UrlContents.hs too large to diff
Types/View.hs too large to diff
Upgrade.hs too large to diff
Upgrade/V0.hs too large to diff
Upgrade/V1.hs too large to diff
Upgrade/V2.hs too large to diff
Upgrade/V3.hs too large to diff
Upgrade/V4.hs too large to diff
Upgrade/V5.hs too large to diff
Utility/QuickCheck.hs too large to diff
Utility/Tmp.hs too large to diff
Utility/Tor.hs too large to diff
Utility/Yesod.hs too large to diff
doc/git-annex-export.mdwn too large to diff
doc/git-annex-import.mdwn too large to diff
doc/git-annex-sync.mdwn too large to diff
doc/git-annex.mdwn too large to diff
git-annex.cabal too large to diff
git-annex.hs too large to diff
stack.yaml too large to diff

Annex.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports, BangPatterns #-}@@ -96,7 +96,8 @@ 		MonadMask, 		Fail.MonadFail, 		Functor,-		Applicative+		Applicative,+		Alternative 	)  -- internal state storage

Annex/Action.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/AutoMerge.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.AutoMerge

Annex/BloomFilter.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.BloomFilter where

Annex/Branch.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Branch (@@ -24,7 +24,7 @@ 	forceCommit, 	getBranch, 	files,-	graftTreeish,+	rememberTreeish, 	performTransitions, 	withIndex, ) where@@ -51,6 +51,7 @@ import qualified Git.UnionMerge import qualified Git.UpdateIndex import qualified Git.Tree+import qualified Git.LsTree import Git.LsTree (lsTreeParams) import qualified Git.HashObject import Annex.HashObject@@ -366,7 +367,7 @@  branchFiles' :: Git.Repo -> IO [FilePath] branchFiles' = Git.Command.pipeNullSplitZombie-	(lsTreeParams fullname [Param "--name-only"])+	(lsTreeParams Git.LsTree.LsTreeRecursive fullname [Param "--name-only"])  {- Populates the branch's index file with the current branch contents.  - @@ -645,16 +646,15 @@  - and then removes it. This ensures that the treeish won't get garbage  - collected, and will always be available as long as the git-annex branch  - is available. -}-graftTreeish :: Git.Ref -> TopFilePath -> Annex ()-graftTreeish treeish graftpoint = lockJournal $ \jl -> do+rememberTreeish :: Git.Ref -> TopFilePath -> Annex ()+rememberTreeish treeish graftpoint = lockJournal $ \jl -> do 	branchref <- getBranch 	updateIndex jl branchref-	Git.Tree.Tree t <- inRepo $ Git.Tree.getTree branchref-	t' <- inRepo $ Git.Tree.recordTree $ Git.Tree.Tree $-		Git.Tree.RecordedSubTree graftpoint treeish [] : t+	origtree <- fromMaybe (giveup "unable to determine git-annex branch tree") <$>+		inRepo (Git.Ref.tree branchref)+	addedt <- inRepo $ Git.Tree.graftTree treeish graftpoint origtree 	c <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit-		"graft" [branchref] t'-	origtree <- inRepo $ Git.Tree.recordTree (Git.Tree.Tree t)+		"graft" [branchref] addedt 	c' <- inRepo $ Git.Branch.commitTree Git.Branch.AutomaticCommit 		"graft cleanup" [c] origtree 	inRepo $ Git.Branch.update' fullname c'

Annex/Branch/Transitions.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Branch.Transitions (@@ -40,15 +40,15 @@  dropDead :: FilePath -> L.ByteString -> TrustMap -> FileTransition dropDead f content trustmap = case getLogVariety f of-	Just UUIDBasedLog+	Just OldUUIDBasedLog 		-- Don't remove the dead repo from the trust log, 		-- because git remotes may still exist, and they need 		-- to still know it's dead. 		| f == trustLog -> PreserveFile 		| otherwise -> ChangeFile $-			UUIDBased.buildLog byteString $+			UUIDBased.buildLogOld byteString $ 				dropDeadFromMapLog trustmap id $-					UUIDBased.parseLog A.takeByteString content+					UUIDBased.parseLogOld A.takeByteString content 	Just NewUUIDBasedLog -> ChangeFile $ 		UUIDBased.buildLogNew byteString $ 			dropDeadFromMapLog trustmap id $

Annex/BranchState.hs view

@@ -4,7 +4,7 @@  -  - Copyright 2011-2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.BranchState where

Annex/CatFile.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.CatFile (

Annex/ChangedRefs.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-216 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.ChangedRefs

Annex/CheckAttr.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.CheckAttr (

Annex/CheckIgnore.hs view

@@ -3,7 +3,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.CheckIgnore (

Annex/Concurrent.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Concurrent where

Annex/Content.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/Content/Direct.hs view

@@ -5,7 +5,7 @@  -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Content.Direct (

Annex/Content/LowLevel.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/Content/PointerFile.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/Difference.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Difference (

Annex/DirHashes.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.DirHashes (

Annex/Direct.hs view

@@ -5,7 +5,7 @@  -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Direct where

Annex/Drop.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Drop where@@ -16,7 +16,6 @@ import qualified Command.Drop import Command import Annex.Wanted-import Annex.Export import Config import Annex.Content.Direct import qualified Database.Keys

Annex/Environment.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012, 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Environment where

Annex/Export.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Export where@@ -13,11 +13,9 @@ import Types.Key import qualified Git import qualified Types.Remote as Remote-import Config import Messages import Utility.FileSystemEncoding -import qualified Data.Map as M import Control.Applicative import Data.Maybe import Prelude@@ -43,9 +41,6 @@ 		, keyChunkSize = Nothing 		, keyChunkNum = Nothing 		}--exportTree :: Remote.RemoteConfig -> Bool-exportTree c = fromMaybe False $ yesNo =<< M.lookup "exporttree" c  warnExportConflict :: Remote -> Annex () warnExportConflict r = toplevelWarning True $

Annex/FileMatcher.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/Fixup.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Fixup where

Annex/GitOverlay.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.GitOverlay where

Annex/HashObject.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.HashObject (

Annex/Hook.hs view

@@ -6,7 +6,7 @@  -  - Copyright 2013-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Hook where

+ Annex/Import.hs view

@@ -0,0 +1,339 @@+{- git-annex import from remotes+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Annex.Import (+	importTree,+	ImportTreeConfig(..),+	ImportCommitConfig(..),+	buildImportCommit,+	buildImportTrees,+	downloadImport+) where++import Annex.Common+import Types.Import+import qualified Types.Remote as Remote+import Git.Types+import Git.Tree+import Git.Sha+import Git.FilePath+import qualified Git.Ref+import qualified Git.Branch+import qualified Annex+import Annex.Link+import Annex.LockFile+import Annex.Content+import Annex.Export+import Command+import Backend+import Config+import Types.Key+import Types.KeySource+import Messages.Progress+import Utility.DataUnits+import Logs.Export+import Logs.Location+import qualified Database.Export as Export+import qualified Database.ContentIdentifier as CIDDb+import qualified Logs.ContentIdentifier as CIDLog++import Control.Concurrent.STM+import qualified Data.Map.Strict as M+import qualified Data.Set as S++{- Configures how to build an import tree. -}+data ImportTreeConfig+	= ImportTree+	-- ^ Import the tree as-is from the remote.+	| ImportSubTree TopFilePath Sha+	-- ^ Import a tree from the remote and graft it into a subdirectory+	-- of the existing tree whose Sha is provided, replacing anything+	-- that was there before.+	deriving (Show)++{- Configures how to build an import commit. -}+data ImportCommitConfig = ImportCommitConfig+	{ importCommitParent :: Maybe Sha+	-- ^ Commit to use as a parent of the import commit.+	, importCommitMode :: Git.Branch.CommitMode+	, importCommitMessage :: String+	}++{- Builds a commit for an import from a special remote. + -+ - When a remote provided a history of versions of files,+ - builds a corresponding tree of git commits.+ -+ - When there are no changes to commit (ie, the imported tree is the same+ - as the tree in the importCommitParent), returns Nothing.+ -+ - After importing from a remote, exporting the same thing back to the+ - remote should be a no-op. So, the export log and database are+ - updated to reflect the imported tree.+ -+ - This does not download any content from a remote. But since it needs the+ - Key of imported files to be known, its caller will have to first download+ - new files in order to generate keys for them.+ -}+buildImportCommit+	:: Remote+	-> ImportTreeConfig+	-> ImportCommitConfig+	-> ImportableContents Key+	-> Annex (Maybe Ref)+buildImportCommit remote importtreeconfig importcommitconfig importable =+	case importCommitParent importcommitconfig of+		Nothing -> go emptyTree Nothing+		Just basecommit -> inRepo (Git.Ref.tree basecommit) >>= \case+			Nothing -> go emptyTree Nothing+			Just origtree -> go origtree (Just basecommit)+  where+	basetree = case importtreeconfig of+		ImportTree -> emptyTree+		ImportSubTree _ sha -> sha+	subdir = case importtreeconfig of+		ImportTree -> Nothing+		ImportSubTree dir _ -> Just dir+	+	go origtree basecommit = do+		imported@(History finaltree _) <-+			buildImportTrees basetree subdir importable+		mkcommits origtree basecommit imported >>= \case+			Nothing -> return Nothing+			Just finalcommit -> do+				updatestate finaltree+				return (Just finalcommit)++	mkcommits origtree basecommit (History importedtree hs) = do+		parents <- catMaybes <$> mapM (mkcommits origtree basecommit) hs+		if importedtree == origtree && null parents+			then return Nothing -- no changes to commit+			else do+				let commitparents = if null parents+					then catMaybes [basecommit]+					else parents+				commit <- inRepo $ Git.Branch.commitTree+					(importCommitMode importcommitconfig)+					(importCommitMessage importcommitconfig)+					commitparents+					importedtree+				return (Just commit)+	+	updatestate committedtree = do+		importedtree <- case subdir of+			Nothing -> pure committedtree+			Just dir -> +				let subtreeref = Ref $+					fromRef committedtree ++ ":" ++ getTopFilePath dir+				in fromMaybe emptyTree+					<$> inRepo (Git.Ref.tree subtreeref)+		updateexportdb importedtree+		oldexport <- updateexportlog importedtree+		updatelocationlog oldexport importedtree++	updateexportdb importedtree = do+		db <- Export.openDb (Remote.uuid remote)+		Export.writeLockDbWhile db $ do+			prevtree <- liftIO $ fromMaybe emptyTree+				<$> Export.getExportTreeCurrent db+			when (importedtree /= prevtree) $ do+				Export.updateExportDb db prevtree importedtree+				liftIO $ Export.recordExportTreeCurrent db importedtree+		Export.closeDb db+	+	updateexportlog importedtree = do+		oldexport <- getExport (Remote.uuid remote)+		recordExport (Remote.uuid remote) $ ExportChange+			{ oldTreeish = exportedTreeishes oldexport+			, newTreeish = importedtree+			}+		return oldexport++	-- downloadImport takes care of updating the location log+	-- for the local repo when keys are downloaded, and also updates+	-- the location log for the remote for keys that are present in it.+	-- That leaves updating the location log for the remote for keys+	-- that have had the last copy of their content removed from it.+	--+	-- This must run after the export database has been updated+	-- and flushed to disk, so it can query it.+	updatelocationlog oldexport finaltree = do+		let stillpresent db k = liftIO $ not . null+			<$> Export.getExportedLocation db k+		let updater db oldkey _newkey _ = case oldkey of+			Just (AnnexKey k) -> unlessM (stillpresent db k) $+				logChange k (Remote.uuid remote) InfoMissing+			Just (GitKey _) -> noop+			Nothing -> noop+		db <- Export.openDb (Remote.uuid remote)+		forM_ (exportedTreeishes oldexport) $ \oldtree ->+			Export.runExportDiffUpdater updater db oldtree finaltree+		Export.closeDb db++data History t = History t [History t]+	deriving (Show)++{- Builds a history of git trees reflecting the ImportableContents.+ -+ - When a subdir is provided, imported tree is grafted into the basetree at+ - that location, replacing any object that was there.+ -}+buildImportTrees+	:: Ref+	-> Maybe TopFilePath+	-> ImportableContents Key+	-> Annex (History Sha)+buildImportTrees basetree msubdir importable = History+	<$> (go (importableContents importable) =<< Annex.gitRepo)+	<*> mapM (buildImportTrees basetree msubdir) (importableHistory importable)+  where+	go ls repo = withMkTreeHandle repo $ \hdl -> do+		importtree <- liftIO . recordTree' hdl +			. treeItemsToTree+			=<< mapM mktreeitem ls+		case msubdir of+			Nothing -> return importtree+			Just subdir -> liftIO $ +				graftTree' importtree subdir basetree repo hdl+	mktreeitem (loc, k) = do+		let lf = fromImportLocation loc+		let treepath = asTopFilePath lf+		let topf = asTopFilePath $+			maybe lf (\sd -> getTopFilePath sd </> lf) msubdir+		relf <- fromRepo $ fromTopFilePath topf+		symlink <- calcRepo $ gitAnnexLink relf k+		linksha <- hashSymlink symlink+		return $ TreeItem treepath (fromTreeItemType TreeSymlink) linksha++{- Downloads all new ContentIdentifiers as needed to generate Keys. + - Supports concurrency when enabled.+ -+ - If any download fails, the whole thing fails, but it will resume where+ - it left off.+ -}+downloadImport :: Remote -> ImportTreeConfig -> ImportableContents (ContentIdentifier, ByteSize) -> Annex (Maybe (ImportableContents Key))+downloadImport remote importtreeconfig importablecontents = do+	-- This map is used to remember content identifiers that+	-- were just downloaded, before they have necessarily been+	-- stored in the database. This way, if the same content+	-- identifier appears multiple times in the+	-- importablecontents (eg when it has a history), +	-- they will only be downloaded once.+	cidmap <- liftIO $ newTVarIO M.empty+	-- When concurrency is enabled, this set is needed to+	-- avoid two threads both downloading the same content identifier.+	downloading <- liftIO $ newTVarIO S.empty+	withExclusiveLock gitAnnexContentIdentifierLock $+		bracket CIDDb.openDb CIDDb.closeDb $ \db -> do+			CIDDb.needsUpdateFromLog db+				>>= maybe noop (CIDDb.updateFromLog db)+			go cidmap downloading importablecontents db+  where+	go cidmap downloading (ImportableContents l h) db = do+		jobs <- forM l $ \i ->+			startdownload cidmap downloading db i+		l' <- liftIO $ forM jobs $+			either pure (atomically . takeTMVar)+		if any isNothing l'+			then return Nothing+			else do+				h' <- mapM (\ic -> go cidmap downloading ic db) h+				if any isNothing h'+					then return Nothing+					else return $ Just $+						ImportableContents+							(catMaybes l')+							(catMaybes h')+	+	waitstart downloading cid = liftIO $ atomically $ do+		s <- readTVar downloading+		if S.member cid s+			then retry+			else writeTVar downloading $ S.insert cid s+	+	signaldone downloading cid = liftIO $ atomically $ do+		s <- readTVar downloading+		writeTVar downloading $ S.delete cid s+	+	startdownload cidmap downloading db i@(loc, (cid, _sz)) = getcidkey cidmap db cid >>= \case+		(k:_) -> return $ Left $ Just (loc, k)+		[] -> do+			job <- liftIO $ newEmptyTMVarIO+			let downloadaction = do+				showStart ("import " ++ Remote.name remote) (fromImportLocation loc)+				next $ tryNonAsync (download cidmap db i) >>= \case+					Left e -> next $ do+						warning (show e)+						liftIO $ atomically $+							putTMVar job Nothing+						return False+					Right r -> next $ do+						liftIO $ atomically $+							putTMVar job r+						return True+			commandAction $ bracket_+				(waitstart downloading cid)+				(signaldone downloading cid)+				downloadaction+			return (Right job)+	+	download cidmap db (loc, (cid, sz)) = do+		let rundownload tmpfile p = +			Remote.retrieveExportWithContentIdentifier ia loc cid tmpfile (mkkey loc tmpfile) p >>= \case+				Just k -> tryNonAsync (moveAnnex k tmpfile) >>= \case+					Right True -> do+						recordcidkey cidmap db cid k+						logStatus k InfoPresent+						logChange k (Remote.uuid remote) InfoPresent+						return $ Just (loc, k)+					_ -> return Nothing+				Nothing -> return Nothing+		checkDiskSpaceToGet tmpkey Nothing $+			withTmp tmpkey $ \tmpfile ->+				metered Nothing tmpkey (return Nothing) $+					const (rundownload tmpfile)+	  where+		ia = Remote.importActions remote+		tmpkey = importKey cid sz+	+	mkkey loc tmpfile = do+		f <- fromRepo $ fromTopFilePath $ locworktreefilename loc+		backend <- chooseBackend f+		let ks = KeySource+			{ keyFilename = f+			, contentLocation = tmpfile+			, inodeCache = Nothing+			}+		fmap fst <$> genKey ks backend++	locworktreefilename loc = asTopFilePath $ case importtreeconfig of+		ImportTree -> fromImportLocation loc+		ImportSubTree subdir _ ->+			getTopFilePath subdir </> fromImportLocation loc++	getcidkey cidmap db cid = liftIO $+		CIDDb.getContentIdentifierKeys db (Remote.uuid remote) cid >>= \case+			[] -> atomically $+				maybeToList . M.lookup cid <$> readTVar cidmap+			l -> return l++	recordcidkey cidmap db cid k = do+		liftIO $ atomically $ modifyTVar' cidmap $+			M.insert cid k+		liftIO $ CIDDb.recordContentIdentifier db (Remote.uuid remote) cid k+		CIDLog.recordContentIdentifier (Remote.uuid remote) cid k++{- Temporary key used for import of a ContentIdentifier while downloading+ - content, before generating its real key. -}+importKey :: ContentIdentifier -> Integer -> Key+importKey (ContentIdentifier cid) size = stubKey+	{ keyName = cid+	, keyVariety = OtherKey "CID"+	, keySize = Just size+	}

Annex/Ingest.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Ingest (

Annex/Init.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/InodeSentinal.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/Journal.hs view

@@ -6,7 +6,7 @@  -  - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Journal where

Annex/Link.hs view

@@ -9,7 +9,7 @@  -  - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP, BangPatterns #-}

Annex/Locations.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings #-}@@ -48,6 +48,9 @@ 	gitAnnexSmudgeLock, 	gitAnnexExportDbDir, 	gitAnnexExportLock,+	gitAnnexExportUpdateLock,+	gitAnnexContentIdentifierDbDir,+	gitAnnexContentIdentifierLock, 	gitAnnexScheduleState, 	gitAnnexTransferDir, 	gitAnnexCredsDir,@@ -347,6 +350,18 @@ {- Lock file for export state for a special remote. -} gitAnnexExportLock :: UUID -> Git.Repo -> FilePath gitAnnexExportLock u r = gitAnnexExportDbDir u r ++ ".lck"++{- Lock file for updating the export state for a special remote. -}+gitAnnexExportUpdateLock :: UUID -> Git.Repo -> FilePath+gitAnnexExportUpdateLock u r = gitAnnexExportDbDir u r ++ ".upl"++{- Directory containing database used to record remote content ids. -}+gitAnnexContentIdentifierDbDir :: Git.Repo -> FilePath+gitAnnexContentIdentifierDbDir r = gitAnnexDir r </> "cid"++{- Lock file for writing to the content id database. -}+gitAnnexContentIdentifierLock :: Git.Repo -> FilePath+gitAnnexContentIdentifierLock r = gitAnnexContentIdentifierDbDir r ++ ".lck"  {- .git/annex/schedulestate is used to store information about when  - scheduled jobs were last run. -}

Annex/LockFile.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}@@ -14,6 +14,7 @@ 	fromLockCache, 	withSharedLock, 	withExclusiveLock,+	takeExclusiveLock, 	tryExclusiveLock, ) where @@ -77,11 +78,18 @@ {- Runs an action with an exclusive lock held. If the lock is already  - held, blocks until it becomes free. -} withExclusiveLock :: (Git.Repo -> FilePath) -> Annex a -> Annex a-withExclusiveLock getlockfile a = debugLocks $ do+withExclusiveLock getlockfile a = bracket+	(takeExclusiveLock getlockfile)+	(liftIO . dropLock)+	(const a)++{- Takes an exclusive lock, blocking until it's free. -}+takeExclusiveLock :: (Git.Repo -> FilePath) -> Annex LockHandle+takeExclusiveLock getlockfile = debugLocks $ do 	lockfile <- fromRepo getlockfile 	createAnnexDirectory $ takeDirectory lockfile 	mode <- annexFileMode-	bracket (lock mode lockfile) (liftIO . dropLock) (const a)+	lock mode lockfile   where #ifndef mingw32_HOST_OS 	lock mode = noUmask mode . lockExclusive (Just mode)

Annex/LockPool.hs view

@@ -3,7 +3,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/LockPool/PosixOrPid.hs view

@@ -3,7 +3,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.LockPool.PosixOrPid (

Annex/Magic.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/MakeRepo.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.MakeRepo where

Annex/MetaData.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.MetaData (

Annex/MetaData/StandardFields.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings #-}

Annex/Multicast.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/Notification.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

Annex/NumCopies.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}

Annex/Path.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Path where

Annex/Perms.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Perms (

Annex/Queue.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011, 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

+ Annex/RemoteTrackingBranch.hs view

@@ -0,0 +1,34 @@+{- git-annex remote tracking branches+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Annex.RemoteTrackingBranch+	( RemoteTrackingBranch+	, mkRemoteTrackingBranch+	, fromRemoteTrackingBranch+	, setRemoteTrackingBranch+	) where++import Annex.Common+import Git.Types+import qualified Git.Ref+import qualified Git.Branch+import qualified Types.Remote as Remote++newtype RemoteTrackingBranch = RemoteTrackingBranch+	{ fromRemoteTrackingBranch :: Ref }+	deriving (Show, Eq)++{- Makes a remote tracking branch corresponding to a local branch. + - Note that the local branch does not need to exist yet. -}+mkRemoteTrackingBranch :: Remote -> Branch -> RemoteTrackingBranch+mkRemoteTrackingBranch remote ref = RemoteTrackingBranch $+	Git.Ref.underBase ("refs/remotes/" ++ Remote.name remote) ref++{- Set remote tracking branch to point to a commit. -}+setRemoteTrackingBranch :: RemoteTrackingBranch -> Sha -> Annex ()+setRemoteTrackingBranch tb commit = +	inRepo $ Git.Branch.update' (fromRemoteTrackingBranch tb) commit

Annex/ReplaceFile.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/SpecialRemote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.SpecialRemote where

Annex/Ssh.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/TaggedPush.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.TaggedPush where

Annex/Tmp.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Tmp where

Annex/Transfer.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP, BangPatterns #-}

Annex/UUID.hs view

@@ -8,7 +8,7 @@  -  - Copyright 2010-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.UUID (

Annex/UpdateInstead.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.UpdateInstead where

Annex/Url.hs view

@@ -3,7 +3,7 @@  -  - Copyright 2013-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Url (

Annex/VariantFile.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.VariantFile where

Annex/VectorClock.hs view

@@ -5,7 +5,7 @@  -  - Copyright 2017-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.VectorClock where

Annex/View.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.View where

Annex/View/ViewedFile.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Annex/Wanted.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Wanted where

Annex/WorkTree.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.WorkTree where@@ -83,7 +83,7 @@ 	showSideAction "scanning for unlocked files" 	Database.Keys.runWriter $ 		liftIO . Database.Keys.SQL.dropAllAssociatedFiles-	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.Ref.headRef+	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive Git.Ref.headRef 	forM_ l $ \i ->  		when (isregfile i) $ 			maybe noop (add i)

Annex/YoutubeDl.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.YoutubeDl (

Assistant.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Alert.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings, CPP, BangPatterns #-}

Assistant/Alert/Utility.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012, 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Alert.Utility where

Assistant/BranchChange.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.BranchChange where

Assistant/Changes.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Changes where

Assistant/Commits.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Commits where

Assistant/Common.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Common (module X) where

Assistant/CredPairCache.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

Assistant/DaemonStatus.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}@@ -19,8 +19,8 @@ import Utility.TimeStamp import qualified Remote import qualified Types.Remote as Remote+import Config import Config.DynamicConfig-import Annex.Export  import Control.Concurrent.STM import System.Posix.Types

Assistant/DeleteRemote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Drop.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Drop (

Assistant/Fsck.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Fsck where

Assistant/Gpg.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Gpg where

Assistant/Install.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Install/AutoStart.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/MakeRemote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012, 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.MakeRemote where

Assistant/Monad.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}

Assistant/NamedThread.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Pairing.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Pairing where

Assistant/Pairing/MakeRemote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Pairing.MakeRemote where

Assistant/Pairing/Network.hs view

@@ -6,7 +6,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Pairing.Network where

Assistant/Pushes.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Pushes where

Assistant/RemoteControl.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.RemoteControl (

Assistant/Repair.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/RepoProblem.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.RepoProblem where

Assistant/Restart.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/ScanRemotes.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.ScanRemotes where

Assistant/Ssh.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Ssh where

Assistant/Sync.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Sync where

Assistant/Threads/Committer.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Threads/ConfigMonitor.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.ConfigMonitor where

Assistant/Threads/Cronner.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE DeriveDataTypeable #-}

Assistant/Threads/DaemonStatus.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.DaemonStatus where

Assistant/Threads/Exporter.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.Exporter where@@ -64,7 +64,7 @@ 		forM rs $ \r -> do 			Annex.changeState $ \st -> st { Annex.errcounter = 0 } 			start <- liftIO getCurrentTime-			void $ Command.Sync.seekExportContent rs+			void $ Command.Sync.seekExportContent Nothing rs 				=<< getCurrentBranch 			-- Look at command error counter to see if the export 			-- didn't work.

Assistant/Threads/Glacier.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Threads/Merger.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.Merger where

Assistant/Threads/MountWatcher.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Threads/NetWatcher.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Threads/PairListener.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.PairListener where

Assistant/Threads/ProblemFixer.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.ProblemFixer (

Assistant/Threads/Pusher.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.Pusher where

Assistant/Threads/RemoteControl.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.RemoteControl where

Assistant/Threads/SanityChecker.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012, 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Threads/TransferPoller.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.TransferPoller where

Assistant/Threads/TransferScanner.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.TransferScanner where

Assistant/Threads/TransferWatcher.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.TransferWatcher where

Assistant/Threads/Transferrer.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Threads.Transferrer where

Assistant/Threads/UpgradeWatcher.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Threads/Upgrader.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Threads/Watcher.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE DeriveDataTypeable, CPP #-}

Assistant/Threads/WebApp.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}

Assistant/TransferQueue.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

Assistant/TransferSlots.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/TransferrerPool.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.TransferrerPool where

Assistant/Types/Alert.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.Alert where

Assistant/Types/BranchChange.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.BranchChange where

Assistant/Types/Changes.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

Assistant/Types/Commits.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.Commits where

Assistant/Types/CredPairCache.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.CredPairCache where

Assistant/Types/DaemonStatus.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.DaemonStatus where

Assistant/Types/NamedThread.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.NamedThread where

Assistant/Types/Pushes.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.Pushes where

Assistant/Types/RemoteControl.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.RemoteControl where

Assistant/Types/RepoProblem.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.RepoProblem where

Assistant/Types/ScanRemotes.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.ScanRemotes where

Assistant/Types/ThreadName.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.ThreadName where

Assistant/Types/ThreadedMonad.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.ThreadedMonad where

Assistant/Types/TransferQueue.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.TransferQueue where

Assistant/Types/TransferSlots.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE DeriveDataTypeable #-}

Assistant/Types/TransferrerPool.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Assistant.Types.TransferrerPool where

Assistant/Types/UrlRenderer.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Assistant/Unused.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings #-}

Assistant/Upgrade.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Backend.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Backend (

Backend/Hash.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Backend/URL.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Backend.URL (

Backend/Utilities.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Backend.Utilities where

Backend/WORM.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Backend.WORM (backends) where

Build/BundledPrograms.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}@@ -24,14 +24,7 @@  -} extraBundledPrograms :: [FilePath] extraBundledPrograms = catMaybes-	-- The system gpg is probably better, because it may better-	-- integrate with the system gpg-agent, etc.-	-- On Windows, gpg is bundled with git for windows.-#ifndef mingw32_HOST_OS-	[ BuildInfo.gpg-#else-	[-#endif+	[ Nothing #ifndef darwin_HOST_OS #ifndef mingw32_HOST_OS 	-- OS X has ssh installed by default.

Build/DesktopFile.hs view

@@ -3,7 +3,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}@@ -29,12 +29,12 @@  systemwideInstall :: IO Bool #ifndef mingw32_HOST_OS -systemwideInstall = isroot <||> destdirset+systemwideInstall = isroot <||> (not <$> userdirset)   where 	isroot = do 		uid <- fromIntegral <$> getRealUserID 		return $ uid == (0 :: Int)-	destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR")+	userdirset = isJust <$> catchMaybeIO (getEnv "USERDIR") #else systemwideInstall = return False #endif

Build/Mans.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# OPTIONS_GHC -fno-warn-tabs #-}

BuildFlags.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

BuildInfo.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

CHANGELOG view

@@ -1,3 +1,47 @@+git-annex (7.20190322) upstream; urgency=medium++  * New feature allows importing from special remotes, using+    git annex import branch:subdir --from remote+  * Directory special remote supports being configured with importree=yes,+    to allow git-annex import of files from the directory. This can be+    combined with exporttree=yes and git-annex export used to send changes+    back to the same directory.+  * Remote tracking branches are updated when importing and exporting to+    special remotes, in ways analagous to how git fetch and git push do.+  * export: Deprecated the --tracking option.+    Instead, users can configure remote.<name>.annex-tracking-branch+    themselves.+  * sync --content: When remote.<name>.annex-tracking-branch is configured,+    import from special remotes.+  * sync, assistant: --no-push and remote.<name>.annex-push prevent exporting+    trees to special remotes.+  * Fix storage of metadata values containing newlines.+    (Reversion introduced in version 7.20190122.)+  * Sped up git-annex export in repositories with lots of keys.+  * S3: Support enabling bucket versioning when built with aws-0.21.1.+  * stack.yaml: Build with aws-0.21.1+  * Fix cleanup of git-annex:export.log after git-annex forget --drop-dead.+  * Makefile: Added install-home target which installs git-annex into+    the HOME directory.+  * addurl --file: Fix a bug that made youtube-dl be used unneccessarily+    when adding an html url that does not contain any media.+  * Add -- before %f in the smudge/clean filter configuration,+    to support filenames starting with dashes.+    (To update the config of existing repositories, you can+    re-run git-annex init.)+  * fsck: Detect situations where annex.thin has caused data loss+    to the content of locked files.+  * Removed bundled gpg from the Linux standalone build and OSX dmg,+    because gpg now always wants to use gpg-agent, and shipping such a daemon+    in those is not a good idea.+  * import: Let --force overwrite symlinks, not only regular files.+  * Android: Fix typo of name of armv7l in installation script.+    Thanks, 4omecha.+  * S3: Added protocol= initremote setting, to allow https to be used+    on a non-standard port.++ -- Joey Hess <id@joeyh.name>  Fri, 22 Mar 2019 13:56:51 -0400+ git-annex (7.20190219) upstream; urgency=medium    * init: Fix bug when direct mode needs to be enabled on a crippled

@@ -3,21 +3,17 @@  Files: * Copyright: © 2010-2019 Joey Hess <id@joeyh.name>-License: GPL-3++License: AGPL-3+  Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/* Copyright: © 2012-2017 Joey Hess <id@joeyh.name>            © 2014 Sören Brunk License: AGPL-3+ -Files: Annex/AdjustedBranch.hs Annex/AdjustedBranch/Name.hs Annex/CurrentBranch.hs Annex/Version.hs Benchmark.hs Logs/File.hs Logs/Line.hs Logs/Smudge.hs Remote/Git.hs Remote/Helper/Ssh.hs Remote/Adb.hs Remote/External.hs Remote/Extermal/Types.hs Types/AdjustedBranch.hs Types/RepoVersion.hs Upgrade/V6.hs-Copyright: © 2011-2019 Joey Hess <id@joeyh.name>-License: AGPL-3+- Files: Remote/Ddar.hs Copyright: © 2011 Joey Hess <id@joeyh.name>            © 2014 Robie Basak <robie@justgohome.co.uk>-License: GPL-3++License: AGPL-3+  Files: Utility/ThreadScheduler.hs Copyright: 2011 Bas van Dijk & Roel van Dijk@@ -43,7 +39,7 @@ Files: Annex/DirHashes.hs Copyright: 2001 Ian Lynagh            2010-2015 Joey Hess <id@joeyh.name>-License: GPL-3++License: AGPL-3+  Files: doc/tips/automatically_adding_metadata/pre-commit-annex  Copyright: 2014 Joey Hess <id@joeyh.name>

CmdLine.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine (

CmdLine/Action.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

CmdLine/Batch.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine.Batch where

CmdLine/GitAnnex.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP, OverloadedStrings #-}

CmdLine/GitAnnex/Options.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-}

CmdLine/GitAnnexShell.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine.GitAnnexShell where

CmdLine/GitAnnexShell/Checks.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine.GitAnnexShell.Checks where

CmdLine/GitAnnexShell/Fields.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine.GitAnnexShell.Fields where

CmdLine/GitRemoteTorAnnex.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine.GitRemoteTorAnnex where

CmdLine/GlobalSetter.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.   -}    module CmdLine.GlobalSetter where

CmdLine/Option.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine.Option where

CmdLine/Seek.hs view

@@ -6,7 +6,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine.Seek where@@ -228,7 +228,7 @@ 	runbranchkeys bs = do 		keyaction <- mkkeyaction 		forM_ bs $ \b -> do-			(l, cleanup) <- inRepo $ LsTree.lsTree b+			(l, cleanup) <- inRepo $ LsTree.lsTree LsTree.LsTreeRecursive b 			forM_ l $ \i -> do 				let bfp = mkActionItem $ BranchFilePath b (LsTree.file i) 				maybe noop (\k -> keyaction (k, bfp))

CmdLine/Usage.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module CmdLine.Usage where

Command.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command (

Command/Add.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Add where

Command/AddUnused.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.AddUnused where

Command/AddUrl.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.AddUrl where@@ -218,7 +218,7 @@ performWeb o url file urlinfo = ifAnnexed file addurl geturl   where 	geturl = next $ isJust <$> addUrlFile (downloadOptions o) url urlinfo file-	addurl = addUrlChecked o url file webUUID $ \k -> +	addurl = addUrlChecked o url file webUUID $ \k -> 		ifM (pure (not (rawOption (downloadOptions o))) <&&> youtubeDlSupported url) 			( return (True, True, setDownloader url YoutubeDownloader) 			, return (Url.urlExists urlinfo, Url.urlSize urlinfo == keySize k, url)@@ -277,7 +277,6 @@ 		liftIO $ createDirectoryIfMissing True (parentDir file) 		finishDownloadWith tmp webUUID url file 	tryyoutubedl tmp-		| isJust (fileOption o) = dl file 		-- Ask youtube-dl what filename it will download 		-- first, and check if that is already an annexed file, 		-- to avoid unnecessary work in that case.@@ -285,6 +284,12 @@ 			Right dest -> ifAnnexed dest  				(alreadyannexed dest) 				(dl dest)+			Left _ -> normalfinish tmp+		-- Ask youtube-dl what filename it will download+		-- fist, so it's only used when the file contains embedded+		-- media.+		| isJust (fileOption o) = youtubeDlFileNameHtmlOnly url >>= \case+			Right _ -> dl file 			Left _ -> normalfinish tmp 	  where 		dl dest = withTmpWorkDir mediakey $ \workdir -> do

Command/Adjust.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Adjust where

Command/Assistant.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Assistant where

Command/Benchmark.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/CalcKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.CalcKey where

Command/CheckPresentKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.CheckPresentKey where

Command/Commit.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Commit where

Command/Config.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Config where

Command/ConfigList.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.ConfigList where

Command/ContentLocation.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.ContentLocation where

Command/Copy.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Copy where

Command/Dead.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011, 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Dead where

Command/Describe.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Describe where

Command/DiffDriver.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.DiffDriver where

Command/Direct.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Direct where

Command/Drop.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Drop where

Command/DropKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010,2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.DropKey where

Command/DropUnused.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010,2012,2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.DropUnused where

Command/EnableRemote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.EnableRemote where

Command/EnableTor.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/ExamineKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.ExamineKey where

Command/Expire.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Expire where

Command/Export.hs view

@@ -1,8 +1,8 @@ {- git-annex command  -- - Copyright 2017 Joey Hess <id@joeyh.name>+ - Copyright 2017-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE TupleSections, BangPatterns #-}@@ -24,7 +24,7 @@ import Annex.Content import Annex.Transfer import Annex.CatFile-import Annex.LockFile+import Annex.RemoteTrackingBranch import Logs.Location import Logs.Export import Database.Export@@ -43,6 +43,7 @@  data ExportOptions = ExportOptions 	{ exportTreeish :: Git.Ref+	-- ^ can be a tree, a branch, a commit, or a tag 	, exportRemote :: DeferredParse Remote 	, exportTracking :: Bool 	}@@ -58,7 +59,7 @@ 		) 	parsetracking = switch 		( long "tracking"-		<> help ("track changes to the " ++ paramTreeish)+		<> help ("track changes to the " ++ paramTreeish ++ " (deprecated)") 		)  -- To handle renames which swap files, the exported file is first renamed@@ -72,20 +73,43 @@ 	r <- getParsed (exportRemote o) 	unlessM (isExportSupported r) $ 		giveup "That remote does not support exports."+	+	-- handle deprecated option 	when (exportTracking o) $-		setConfig (remoteConfig r "export-tracking")+		setConfig (remoteConfig r "annex-tracking-branch") 			(fromRef $ exportTreeish o)-	new <- fromMaybe (giveup "unknown tree") <$>-		-- Dereference the tree pointed to by the branch, commit,-		-- or tag.+	+	tree <- fromMaybe (giveup "unknown tree") <$> 		inRepo (Git.Ref.tree (exportTreeish o))-	withExclusiveLock (gitAnnexExportLock (uuid r)) $ do-		db <- openDb (uuid r)-		changeExport r db new-		unlessM (Annex.getState Annex.fast) $-			void $ fillExport r db new-		closeDb db+	+	mtbcommitsha <- getExportCommit r (exportTreeish o) +	db <- openDb (uuid r)+	writeLockDbWhile db $ do+		changeExport r db tree+		unlessM (Annex.getState Annex.fast) $ do+			void $ fillExport r db tree mtbcommitsha+	closeDb db++-- | When the treeish is a branch like master or refs/heads/master+-- (but not refs/remotes/...), find the commit it points to+-- and the corresponding remote tracking branch.+--+-- The treeish may also be a subdir within a branch, like master:subdir,+-- that results in this returning the same thing it does for the master+-- branch.+getExportCommit :: Remote -> Git.Ref -> Annex (Maybe (RemoteTrackingBranch, Sha))+getExportCommit r treeish+	| '/' `notElem` fromRef baseref = do+		let tb = mkRemoteTrackingBranch r baseref+		commitsha <- inRepo $ Git.Ref.sha $ Git.Ref.underBase refsheads baseref+		return (fmap (tb, ) commitsha)+	| otherwise = return Nothing+  where+	baseref = Ref $ takeWhile (/= ':') $ fromRef $ +		Git.Ref.removeBase refsheads treeish+	refsheads = "refs/heads"+ -- | Changes what's exported to the remote. Does not upload any new -- files, but does delete and rename files already exported to the remote. changeExport :: Remote -> ExportHandle -> Git.Ref -> CommandSeek@@ -189,26 +213,42 @@ 		| sha == nullSha = return Nothing 		| otherwise = Just <$> exportKey sha --- | Upload all exported files that are not yet in the remote,--- Returns True when files were uploaded.-fillExport :: Remote -> ExportHandle -> Git.Ref -> Annex Bool-fillExport r db new = do-	(l, cleanup) <- inRepo $ Git.LsTree.lsTree new-	cvar <- liftIO $ newMVar False-	commandActions $ map (startExport r db cvar) l+newtype FileUploaded = FileUploaded { fromFileUploaded :: Bool }++newtype AllFilled = AllFilled { fromAllFilled :: Bool }++-- | Upload all exported files that are not yet in the remote.+--+-- Returns True when some files were uploaded (perhaps not all of them).+--+-- Once all exported files have reached the remote, updates the+-- remote tracking branch.+fillExport :: Remote -> ExportHandle -> Git.Ref -> Maybe (RemoteTrackingBranch, Sha) -> Annex Bool+fillExport r db newtree mtbcommitsha = do+	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive newtree+	cvar <- liftIO $ newMVar (FileUploaded False)+	allfilledvar <- liftIO $ newMVar (AllFilled True)+	commandActions $ map (startExport r db cvar allfilledvar) l 	void $ liftIO $ cleanup-	liftIO $ takeMVar cvar -startExport :: Remote -> ExportHandle -> MVar Bool -> Git.LsTree.TreeItem -> CommandStart-startExport r db cvar ti = do+	case mtbcommitsha of+		Nothing -> noop+		Just (tb, commitsha) ->+			whenM (liftIO $ fromAllFilled <$> takeMVar allfilledvar) $+				setRemoteTrackingBranch tb commitsha+	+	liftIO $ fromFileUploaded <$> takeMVar cvar++startExport :: Remote -> ExportHandle -> MVar FileUploaded -> MVar AllFilled -> Git.LsTree.TreeItem -> CommandStart+startExport r db cvar allfilledvar ti = do 	ek <- exportKey (Git.LsTree.sha ti) 	stopUnless (notrecordedpresent ek) $ do 		showStart ("export " ++ name r) f 		ifM (either (const False) id <$> tryNonAsync (checkPresentExport (exportActions r) (asKey ek) loc)) 			( next $ next $ cleanupExport r db ek loc False 			, do-				liftIO $ modifyMVar_ cvar (pure . const True)-				next $ performExport r db ek af (Git.LsTree.sha ti) loc+				liftIO $ modifyMVar_ cvar (pure . const (FileUploaded True))+				next $ performExport r db ek af (Git.LsTree.sha ti) loc allfilledvar 			)   where 	loc = mkExportLocation f@@ -220,10 +260,10 @@ 		-- will still list it, so also check location tracking. 		<*> (notElem (uuid r) <$> loggedLocations (asKey ek)) -performExport :: Remote -> ExportHandle -> ExportKey -> AssociatedFile -> Sha -> ExportLocation -> CommandPerform-performExport r db ek af contentsha loc = do+performExport :: Remote -> ExportHandle -> ExportKey -> AssociatedFile -> Sha -> ExportLocation -> MVar AllFilled -> CommandPerform+performExport r db ek af contentsha loc allfilledvar = do 	let storer = storeExport (exportActions r)-	sent <- case ek of+	sent <- tryNonAsync $ case ek of 		AnnexKey k -> ifM (inAnnex k) 			( notifyTransfer Upload af $ 				-- Using noRetry here because interrupted@@ -244,9 +284,15 @@ 				liftIO $ L.hPut h b 				liftIO $ hClose h 				storer tmp sha1k loc nullMeterUpdate-	if sent-		then next $ cleanupExport r db ek loc True-		else stop+	let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False))+	case sent of+		Right True -> next $ cleanupExport r db ek loc True+		Right False -> do+			failedsend+			stop+		Left err -> do+			failedsend+			throwM err  cleanupExport :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> Bool -> CommandCleanup cleanupExport r db ek loc sent = do@@ -339,15 +385,16 @@ 	f' = getTopFilePath f  performRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform-performRename r db ek src dest = do-	ifM (renameExport (exportActions r) (asKey ek) src dest)-		( next $ cleanupRename r db ek src dest-		-- In case the special remote does not support renaming,-		-- unexport the src instead.-		, do+performRename r db ek src dest =+	renameExport (exportActions r) (asKey ek) src dest >>= \case+		Just True -> next $ cleanupRename r db ek src dest+		Just False -> do 			warning "rename failed; deleting instead"-			performUnexport r db [ek] src-		)+			fallbackdelete+		-- Remote does not support renaming, so don't warn about it.+		Nothing -> fallbackdelete+  where+	fallbackdelete = performUnexport r db [ek] src  cleanupRename :: Remote -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandCleanup cleanupRename r db ek src dest = do

Command/Find.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Find where

Command/FindRef.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.FindRef where

Command/Fix.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/Forget.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Forget where

Command/FromKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

Command/Fsck.hs view

@@ -1,8 +1,8 @@ {- git-annex command  -- - Copyright 2010-2018 Joey Hess <id@joeyh.name>+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}@@ -227,7 +227,7 @@ verifyLocationLog key keystatus ai = do 	direct <- isDirect 	obj <- calcRepo $ gitAnnexLocation key-	present <- if not direct && isKeyUnlocked keystatus+	present <- if not direct && isKeyUnlockedThin keystatus 		then liftIO (doesFileExist obj) 		else inAnnex key 	u <- getUUID@@ -235,9 +235,10 @@ 	{- Since we're checking that a key's object file is present, throw 	 - in a permission fixup here too. -} 	when (present && not direct) $ do-		void $ tryIO $ if isKeyUnlocked keystatus-			then thawContent obj-			else freezeContent obj+		void $ tryIO $ case keystatus of+			KeyUnlockedThin -> thawContent obj+			KeyLockedThin -> thawContent obj+			_ -> freezeContent obj 		unlessM (isContentWritePermOk obj) $ 			warning $ "** Unable to set correct write mode for " ++ obj ++ " ; perhaps you don't own that file" 	whenM (liftIO $ doesDirectoryExist $ parentDir obj) $@@ -326,13 +327,11 @@ 		forM_ fs $ \f ->  			unlessM (liftIO $ doesFileExist f) $ 				void $ Direct.removeAssociatedFile key f-	goindirect = case keystatus of-		KeyUnlocked -> do-			f <- inRepo $ toTopFilePath file-			afs <- Database.Keys.getAssociatedFiles key-			unless (getTopFilePath f `elem` map getTopFilePath afs) $-				Database.Keys.addAssociatedFile key f-		_ -> return ()+	goindirect = when (isKeyUnlockedThin keystatus) $ do+		f <- inRepo $ toTopFilePath file+		afs <- Database.Keys.getAssociatedFiles key+		unless (getTopFilePath f `elem` map getTopFilePath afs) $+			Database.Keys.addAssociatedFile key f  verifyWorkTree :: Key -> FilePath -> Annex Bool verifyWorkTree key file = do@@ -372,7 +371,7 @@  - Not checked when a file is unlocked, or in direct mode.  -} checkKeySize :: Key -> KeyStatus -> ActionItem -> Annex Bool-checkKeySize _ KeyUnlocked _ = return True+checkKeySize _ KeyUnlockedThin _ = return True checkKeySize key _ ai = do 	file <- calcRepo $ gitAnnexLocation key 	ifM (liftIO $ doesFileExist file)@@ -450,7 +449,7 @@   where 	go False = do 		content <- calcRepo $ gitAnnexLocation key-		ifM (pure (isKeyUnlocked keystatus) <&&> (not <$> isUnmodified key content))+		ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content)) 			( nocheck 			, checkBackendOr badContent backend key content (mkActionItem afile) 			)@@ -700,28 +699,42 @@ withFsckDb NonIncremental _ = noop withFsckDb (ScheduleIncremental _ _ i) a = withFsckDb i a -data KeyStatus = KeyLocked | KeyUnlocked | KeyMissing+data KeyStatus+	= KeyMissing+	| KeyPresent+	| KeyUnlockedThin+	-- ^ An annex.thin worktree file is hard linked to the object.+	| KeyLockedThin+	-- ^ The object has hard links, but the file being fscked+	-- is not the one that hard links to it.+	deriving (Show) -isKeyUnlocked :: KeyStatus -> Bool-isKeyUnlocked KeyUnlocked = True-isKeyUnlocked KeyLocked = False-isKeyUnlocked KeyMissing = False+isKeyUnlockedThin :: KeyStatus -> Bool+isKeyUnlockedThin KeyUnlockedThin = True+isKeyUnlockedThin KeyLockedThin = False+isKeyUnlockedThin KeyPresent = False+isKeyUnlockedThin KeyMissing = False  getKeyStatus :: Key -> Annex KeyStatus getKeyStatus key = ifM isDirect-	( return KeyUnlocked+	( return KeyUnlockedThin 	, catchDefaultIO KeyMissing $ do-		unlocked <- not . null <$> Database.Keys.getAssociatedFiles key-		return $ if unlocked then KeyUnlocked else KeyLocked+		afs <- not . null <$> Database.Keys.getAssociatedFiles key+		obj <- calcRepo $ gitAnnexLocation key+		multilink <- ((> 1) . linkCount <$> liftIO (getFileStatus obj))+		return $ if multilink && afs+			then KeyUnlockedThin+			else KeyPresent 	)  getKeyFileStatus :: Key -> FilePath -> Annex KeyStatus getKeyFileStatus key file = do 	s <- getKeyStatus key 	case s of-		KeyLocked -> catchDefaultIO KeyLocked $+		KeyUnlockedThin -> catchDefaultIO KeyUnlockedThin $ 			ifM (isJust <$> isAnnexLink file)-				( return KeyLocked-				, return KeyUnlocked+				( return KeyLockedThin+				, return KeyUnlockedThin 				) 		_ -> return s+

Command/FuzzTest.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.FuzzTest where

Command/GCryptSetup.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.GCryptSetup where

Command/Get.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010, 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Get where

Command/Group.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Group where

Command/GroupWanted.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.GroupWanted where

Command/Help.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Help where

Command/Import.hs view

@@ -1,10 +1,12 @@ {- git-annex command  -- - Copyright 2012-2017 Joey Hess <id@joeyh.name>+ - Copyright 2012-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE ApplicativeDo #-}+ module Command.Import where  import Command@@ -12,6 +14,8 @@ import qualified Annex import qualified Command.Add import qualified Command.Reinject+import qualified Types.Remote as Remote+import qualified Git.Ref import Utility.CopyFile import Backend import Types.KeySource@@ -20,29 +24,52 @@ import Annex.FileMatcher import Annex.Ingest import Annex.InodeSentinal+import Annex.Import+import Annex.RemoteTrackingBranch import Utility.InodeCache import Logs.Location+import Git.FilePath+import Git.Types+import Git.Branch+import Types.Import  cmd :: Command cmd = notBareRepo $ 	withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $ 		command "import" SectionCommon -			"move and add files from outside git working copy"-			paramPaths (seek <$$> optParser)--data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates | ReinjectDuplicates-	deriving (Eq)+			"import files from elsewhere into the repository"+			(paramPaths ++ "|BRANCH[:SUBDIR]")+			(seek <$$> optParser) -data ImportOptions = ImportOptions-	{ importFiles :: CmdParams-	, duplicateMode :: DuplicateMode-	}+data ImportOptions +	= LocalImportOptions+		{ importFiles :: CmdParams+		, duplicateMode :: DuplicateMode+		}+	| RemoteImportOptions+		{ importFromRemote :: DeferredParse Remote+		, importToBranch :: Branch+		, importToSubDir :: Maybe FilePath+		}  optParser :: CmdParamsDesc -> Parser ImportOptions-optParser desc = ImportOptions-	<$> cmdParams desc-	<*> (fromMaybe Default <$> optional duplicateModeParser)+optParser desc = do+	ps <- cmdParams desc+	mfromremote <- optional $ parseRemoteOption <$> parseFromOption+	dupmode <- fromMaybe Default <$> optional duplicateModeParser+	return $ case mfromremote of+		Nothing -> LocalImportOptions ps dupmode+		Just r -> case ps of+			[bs] -> +				let (branch, subdir) = separate (== ':') bs+				in RemoteImportOptions r+					(Ref branch)+					(if null subdir then Nothing else Just subdir)+			_ -> giveup "expected BRANCH[:SUBDIR]" +data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates | ReinjectDuplicates+	deriving (Eq)+ duplicateModeParser :: Parser DuplicateMode duplicateModeParser =  	flag' Duplicate@@ -67,17 +94,26 @@ 		)  seek :: ImportOptions -> CommandSeek-seek o = allowConcurrentOutput $ do+seek o@(LocalImportOptions {}) = allowConcurrentOutput $ do 	repopath <- liftIO . absPath =<< fromRepo Git.repoPath 	inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath (importFiles o) 	unless (null inrepops) $ do 		giveup $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops 	largematcher <- largeFilesMatcher-	(commandAction . start largematcher (duplicateMode o))+	(commandAction . startLocal largematcher (duplicateMode o)) 		`withPathContents` importFiles o+seek o@(RemoteImportOptions {}) = allowConcurrentOutput $ do+	r <- getParsed (importFromRemote o)+	unlessM (Remote.isImportSupported r) $+		giveup "That remote does not support imports."+	subdir <- maybe+		(pure Nothing)+		(Just <$$> inRepo . toTopFilePath)+		(importToSubDir o)+	seekRemote r (importToBranch o) subdir -start :: GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart-start largematcher mode (srcfile, destfile) =+startLocal :: GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart+startLocal largematcher mode (srcfile, destfile) = 	ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile) 		( do 			showStart "import" destfile@@ -110,7 +146,12 @@ 					Nothing -> importfilechecked ld k 					Just s 						| isDirectory s -> notoverwriting "(is a directory)"-						| isSymbolicLink s -> notoverwriting "(is a symlink)"+						| isSymbolicLink s -> ifM (Annex.getState Annex.force)+							( do+								liftIO $ nukeFile destfile+								importfilechecked ld k+							, notoverwriting "(is a symlink)"+							) 						| otherwise -> ifM (Annex.getState Annex.force) 							( do 								liftIO $ nukeFile destfile@@ -209,3 +250,62 @@ 	(tocheck, preverified) <- verifiableCopies key [] 	verifyEnoughCopiesToDrop [] key Nothing need [] preverified tocheck 		(const yes) no++seekRemote :: Remote -> Branch -> Maybe TopFilePath -> CommandSeek+seekRemote remote branch msubdir = do+	importtreeconfig <- case msubdir of+		Nothing -> return ImportTree+		Just subdir ->+			let mk tree = pure $ ImportSubTree subdir tree+			in fromtrackingbranch Git.Ref.tree >>= \case+				Just tree -> mk tree+				Nothing -> inRepo (Git.Ref.tree branch) >>= \case+					Just tree -> mk tree+					Nothing -> giveup $ "Unable to find base tree for branch " ++ fromRef branch+	+	parentcommit <- fromtrackingbranch Git.Ref.sha+	let importcommitconfig = ImportCommitConfig parentcommit ManualCommit importmessage++	importable <- download importtreeconfig =<< listcontents+	void $ includeCommandAction $+		commitRemote remote branch tb parentcommit importtreeconfig importcommitconfig importable+  where+	importmessage = "import from " ++ Remote.name remote++	tb = mkRemoteTrackingBranch remote branch++	fromtrackingbranch a = inRepo $ a (fromRemoteTrackingBranch tb)++	listcontents = do+		showStart' "list" (Just (Remote.name remote))+		Remote.listImportableContents (Remote.importActions remote) >>= \case+			Nothing -> do+				showEndFail+				giveup $ "Unable to list contents of " ++ Remote.name remote+			Just importable -> do+				showEndOk+				return importable++	download importtreeconfig importablecontents =+		downloadImport remote importtreeconfig importablecontents >>= \case+			Nothing -> giveup $ "Failed to import some files from " ++ Remote.name remote ++ ". Re-run command to resume import."+			Just importable -> return importable++commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents Key -> CommandStart+commitRemote remote branch tb parentcommit importtreeconfig importcommitconfig importable = do+	showStart' "update" (Just $ fromRef $ fromRemoteTrackingBranch tb)+	next $ do+		importcommit <- buildImportCommit remote importtreeconfig importcommitconfig importable+		next $ updateremotetrackingbranch importcommit+		+  where+	-- Update the tracking branch. Done even when there+	-- is nothing new to import, to make sure it exists.+	updateremotetrackingbranch importcommit =+		case importcommit <|> parentcommit of+			Just c -> do+				setRemoteTrackingBranch tb c+				return True+			Nothing -> do+				warning $ "Nothing to import and " ++ fromRef branch ++ " does not exist."+				return False

Command/ImportFeed.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/InAnnex.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.InAnnex where

Command/Indirect.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Indirect where

Command/Info.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns, DeriveDataTypeable, CPP #-}@@ -597,7 +597,7 @@ getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo) getTreeStatInfo o r = do 	fast <- Annex.getState Annex.fast-	(ls, cleanup) <- inRepo $ LsTree.lsTree r+	(ls, cleanup) <- inRepo $ LsTree.lsTree LsTree.LsTreeRecursive r 	(presentdata, referenceddata, repodata) <- go fast ls initial 	ifM (liftIO cleanup) 		( return $ Just $

Command/Init.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Init where

Command/InitRemote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011,2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.InitRemote where

Command/Inprogress.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Inprogress where

Command/List.hs view

@@ -3,7 +3,7 @@  - Copyright 2013 Joey Hess <id@joeyh.name>  - Copyright 2013 Antoine Beaupré  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.List where

Command/Lock.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010,2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Lock where

Command/LockContent.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.LockContent where

Command/Log.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012, 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/LookupKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.LookupKey where

Command/Map.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Map where

Command/MatchExpression.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.MatchExpression where

Command/Merge.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011, 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Merge where

Command/MetaData.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.MetaData where

Command/Migrate.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Migrate where@@ -70,7 +70,7 @@ 	go (Just (newkey, knowngoodcontent)) 		| knowngoodcontent = finish newkey 		| otherwise = stopUnless checkcontent $ finish newkey-	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked afile+	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyPresent afile 	finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey) 		( do 			_ <- copyMetaData oldkey newkey

Command/Mirror.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Mirror where

Command/Move.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Move where

Command/Multicast.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/NotifyChanges.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.NotifyChanges where

Command/NumCopies.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.NumCopies where

Command/P2P.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.P2P where

Command/P2PStdIO.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.P2PStdIO where

Command/PostReceive.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.PostReceive where

Command/PreCommit.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/Proxy.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Proxy where

Command/ReKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.ReKey where

Command/ReadPresentKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.ReadPresentKey where

Command/RecvKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.RecvKey where

Command/RegisterUrl.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

Command/Reinit.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Reinit where

Command/Reinject.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Reinject where

Command/RemoteDaemon.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/Repair.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Repair where

Command/Required.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Required where

Command/ResolveMerge.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.ResolveMerge where

Command/RmUrl.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.RmUrl where

Command/Schedule.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Schedule where

Command/Semitrust.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Semitrust where

Command/SendKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010,2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.SendKey where

Command/SetKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010, 2015 Joey Hess <joey@kitenet.net>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.SetKey where

Command/SetPresentKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.SetPresentKey where

Command/Smudge.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Smudge where

Command/Status.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Status where

Command/Sync.hs view

@@ -1,11 +1,13 @@ {- git-annex command  -  - Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>- - Copyright 2011-2017 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE FlexibleContexts #-}+ module Command.Sync ( 	cmd, 	CurrBranch,@@ -37,6 +39,7 @@ import qualified Git.Types as Git import qualified Git.Ref import qualified Git+import Git.FilePath import qualified Remote.Git import Config import Config.GitConfig@@ -47,6 +50,7 @@ import Command.Get (getKey') import qualified Command.Move import qualified Command.Export+import qualified Command.Import import Annex.Drop import Annex.UUID import Logs.UUID@@ -57,7 +61,6 @@ import Annex.BloomFilter import Annex.UpdateInstead import Annex.Export-import Annex.LockFile import Annex.TaggedPush import Annex.CurrentBranch import qualified Database.Export as Export@@ -168,7 +171,8 @@ 	let gitremotes = filter Remote.gitSyncableRemote remotes 	dataremotes <- filter (\r -> Remote.uuid r /= NoUUID) 		<$> filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) remotes-	let exportremotes = filter (exportTree . Remote.config) dataremotes+	let (exportremotes, keyvalueremotes) = partition (exportTree . Remote.config) dataremotes+	let importremotes = filter (importTree . Remote.config) dataremotes  	if cleanupOption o 		then do@@ -185,13 +189,17 @@ 				, map (withbranch . pullRemote o mergeConfig) gitremotes 				,  [ mergeAnnex ] 				]-			+				 			whenM shouldsynccontent $ do-				-- Send content to any exports first, in -				-- case that lets content be dropped from-				-- other repositories.-				exportedcontent <- withbranch $ seekExportContent exportremotes-				syncedcontent <- withbranch $ seekSyncContent o dataremotes+				mapM_ (withbranch . importRemote o mergeConfig) importremotes+			+				-- Send content to any exports before other+				-- repositories, in case that lets content+				-- be dropped from other repositories.+				exportedcontent <- withbranch $+					seekExportContent (Just o) exportremotes+				syncedcontent <- withbranch $+					seekSyncContent o keyvalueremotes 				-- Transferring content can take a while, 				-- and other changes can be pushed to the 				-- git-annex branch on the remotes in the@@ -221,10 +229,11 @@ mergeConfig =  	[ Git.Merge.MergeNonInteractive 	-- In several situations, unrelated histories should be merged-	-- together. This includes pairing in the assistant, and merging-	-- from a remote into a newly created direct mode repo.+	-- together. This includes pairing in the assistant, merging+	-- from a remote into a newly created direct mode repo,+	-- and an initial merge from an import from a special remote. 	-- (Once direct mode is removed, this could be changed, so only-	-- the assistant uses it.)+	-- the assistant and import from special remotes use it.) 	, Git.Merge.MergeUnrelatedHistories 	] @@ -400,6 +409,23 @@ 				[Param "fetch", Param $ Remote.name remote] 	wantpull = remoteAnnexPull (Remote.gitconfig remote) +importRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandSeek+importRemote o mergeconfig remote currbranch+	| not (pullOption o) || not wantpull = noop+	| otherwise = case remoteAnnexTrackingBranch (Remote.gitconfig remote) of+		Nothing -> noop+		Just tb -> do+			let (b, s) = separate (== ':') (Git.fromRef tb)+			let branch = Git.Ref b+			let subdir = if null s+				then Nothing+				else Just (asTopFilePath s)+			Command.Import.seekRemote remote branch subdir+			void $ mergeRemote remote currbranch mergeconfig+				(resolveMergeOverride o)+  where+	wantpull = remoteAnnexPull (Remote.gitconfig remote)+ {- The remote probably has both a master and a synced/master branch.  - Which to merge from? Well, the master has whatever latest changes  - were committed (or pushed changes, if this is a bare remote),@@ -680,32 +706,39 @@ 	put dest = includeCommandAction $  		Command.Move.toStart' dest Command.Move.RemoveNever af k (mkActionItem af) -{- When a remote has an export-tracking branch, change the export to- - follow the current content of the branch. Otherwise, transfer any files+{- When a remote has an annex-tracking-branch configuration, change the export+ - to contain the current content of the branch. Otherwise, transfer any files  - that were part of an export but are not in the remote yet.  -   - Returns True if any file transfers were made.  -}-seekExportContent :: [Remote] -> CurrBranch -> Annex Bool-seekExportContent rs (currbranch, _) = or <$> forM rs go+seekExportContent :: Maybe SyncOptions -> [Remote] -> CurrBranch -> Annex Bool+seekExportContent o rs (currbranch, _) = or <$> forM rs go   where-	go r = withExclusiveLock (gitAnnexExportLock (Remote.uuid r)) $ do-		db <- Export.openDb (Remote.uuid r)-		exported <- case remoteAnnexExportTracking (Remote.gitconfig r) of+	go r+		| not (maybe True pullOption o) = return False+		| not (remoteAnnexPush (Remote.gitconfig r)) = return False+		| otherwise = bracket+			(Export.openDb (Remote.uuid r))+			Export.closeDb+			(\db -> Export.writeLockDbWhile db (go' r db))+	go' r db = do+		(exported, mtbcommitsha) <- case remoteAnnexTrackingBranch (Remote.gitconfig r) of 			Nothing -> nontracking r 			Just b -> do-				mcur <- inRepo $ Git.Ref.tree b-				case mcur of-					Nothing -> nontracking r-					Just cur -> do-						Command.Export.changeExport r db cur-						return [mkExported cur []]-		Export.closeDb db `after` fillexport r db (exportedTreeishes exported)+				mtree <- inRepo $ Git.Ref.tree b+				mtbcommitsha <- Command.Export.getExportCommit r b+				case (mtree, mtbcommitsha) of+					(Just tree, Just _) -> do+						Command.Export.changeExport r db tree+						return ([mkExported tree []], mtbcommitsha)+					_ -> nontracking r+		fillexport r db (exportedTreeishes exported) mtbcommitsha 		 	nontracking r = do 		exported <- getExport (Remote.uuid r) 		maybe noop (warnnontracking r exported) currbranch-		return exported+		return (exported, Nothing) 	 	warnnontracking r exported currb = inRepo (Git.Ref.tree currb) >>= \case 		Just currt | not (any (== currt) (exportedTreeishes exported)) ->@@ -713,15 +746,15 @@ 				[ "Not updating export to " ++ Remote.name r 				, "to reflect changes to the tree, because export" 				, "tracking is not enabled. "-				, "(Use git-annex export's --tracking option"-				, "to enable it.)"+				, "(Set " ++ gitconfig ++ " to enable it.)" 				] 		_ -> noop-+	  where+		gitconfig = show (remoteConfig r "tracking-branch") -	fillexport _ _ [] = return False-	fillexport r db (t:[]) = Command.Export.fillExport r db t-	fillexport r _ _ = do+	fillexport _ _ [] _ = return False+	fillexport r db (t:[]) mtbcommitsha = Command.Export.fillExport r db t mtbcommitsha+	fillexport r _ _ _ = do 		warnExportConflict r 		return False

Command/Test.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Test where

Command/TestRemote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.TestRemote where@@ -24,7 +24,7 @@ import Utility.CopyFile import Types.Messages import Types.Export-import Remote.Helper.Export+import Remote.Helper.ExportImport import Remote.Helper.Chunked import Git.Types

Command/TransferInfo.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.TransferInfo where

Command/TransferKey.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.TransferKey where

Command/TransferKeys.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012, 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

Command/Trust.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010, 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Trust where

Command/Unannex.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Unannex where

Command/Undo.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Undo where

Command/Ungroup.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Ungroup where

Command/Uninit.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Uninit where

Command/Unlock.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Unlock where

Command/Untrust.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Untrust where

Command/Unused.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

Command/Upgrade.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Upgrade where

Command/VAdd.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.VAdd where

Command/VCycle.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.VCycle where

Command/VFilter.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.VFilter where

Command/VPop.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.VPop where

Command/Version.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Version where

Command/Vicfg.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE RankNTypes #-}

Command/View.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.View where

Command/Wanted.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Wanted where

Command/Watch.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Watch where

Command/WebApp.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Command/Whereis.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Command.Whereis where

Config.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}@@ -93,6 +93,12 @@  setRemoteBare :: Git.Repo -> Bool -> Annex () setRemoteBare r b = setConfig (remoteConfig r "bare") (Git.Config.boolConfig b)++exportTree :: Remote.RemoteConfig -> Bool+exportTree c = fromMaybe False $ yesNo =<< M.lookup "exporttree" c++importTree :: Remote.RemoteConfig -> Bool+importTree c = fromMaybe False $ yesNo =<< M.lookup "importtree" c  isBareRepo :: Annex Bool isBareRepo = fromRepo Git.repoIsLocalBare

Config/Cost.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Config.Cost where

Config/DynamicConfig.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Config.DynamicConfig where

Config/Files.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# OPTIONS_GHC -fno-warn-tabs #-}@@ -56,7 +56,7 @@ 	modifyAutoStartFile $ 		filter (not . equalFilePath path') -{- The path to git-annex is written here; which is useful when cabal+{- The path to git-annex is written here; which is useful when something  - has installed it to some awful non-PATH location. -} programFile :: IO FilePath programFile = userConfigFile "program"

Config/GitConfig.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Config.GitConfig where

Config/Smudge.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Config.Smudge where@@ -24,8 +24,8 @@ 	-- Avoid that problem by running git status now. 	inRepo $ Git.Command.runQuiet [Param "status", Param "--porcelain"] -	setConfig (ConfigKey "filter.annex.smudge") "git-annex smudge %f"-	setConfig (ConfigKey "filter.annex.clean") "git-annex smudge --clean %f"+	setConfig (ConfigKey "filter.annex.smudge") "git-annex smudge -- %f"+	setConfig (ConfigKey "filter.annex.clean") "git-annex smudge --clean -- %f" 	lf <- Annex.fromRepo Git.attributesLocal 	gf <- Annex.fromRepo Git.attributes 	lfs <- readattr lf

Creds.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Creds (

Crypto.hs view

@@ -5,7 +5,7 @@  -  - Copyright 2011-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE FlexibleInstances #-}

+ Database/ContentIdentifier.hs view

@@ -0,0 +1,154 @@+{- Sqlite database of ContentIdentifiers imported from special remotes.+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -:+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}++module Database.ContentIdentifier (+	ContentIdentifierHandle,+	openDb,+	closeDb,+	flushDbQueue,+	recordContentIdentifier,+	getContentIdentifiers,+	getContentIdentifierKeys,+	recordAnnexBranchTree,+	getAnnexBranchTree,+	needsUpdateFromLog,+	updateFromLog,+	ContentIdentifiersId,+	AnnexBranchId,+) where++import Database.Types+import qualified Database.Queue as H+import Database.Init+import Annex.Locations+import Annex.Common hiding (delete)+import qualified Annex.Branch+import Types.Import+import Git.Types+import Git.Sha+import Git.FilePath+import qualified Git.Ref+import qualified Git.DiffTree as DiffTree+import Logs+import qualified Logs.ContentIdentifier as Log++import Database.Persist.Sql hiding (Key)+import Database.Persist.TH++data ContentIdentifierHandle = ContentIdentifierHandle H.DbQueue++share [mkPersist sqlSettings, mkMigrate "migrateContentIdentifier"] [persistLowerCase|+ContentIdentifiers+  remote UUID+  cid ContentIdentifier+  key IKey+  ContentIdentifiersIndexRemoteKey remote key+  ContentIdentifiersIndexRemoteCID remote cid+  UniqueRemoteCidKey remote cid key+-- The last git-annex branch tree sha that was used to update+-- ContentIdentifiers+AnnexBranch+  tree SRef+  UniqueTree tree+|]++{- Opens the database, creating it if it doesn't exist yet.+ -+ - Only a single process should write to the database at a time, so guard+ - any writes with the gitAnnexContentIdentifierLock.+ -}+openDb :: Annex ContentIdentifierHandle+openDb = do+	dbdir <- fromRepo gitAnnexContentIdentifierDbDir+	let db = dbdir </> "db"+	unlessM (liftIO $ doesFileExist db) $ do+		initDb db $ void $+			runMigrationSilent migrateContentIdentifier+	h <- liftIO $ H.openDbQueue H.SingleWriter db "content_identifiers"+	return $ ContentIdentifierHandle h++closeDb :: ContentIdentifierHandle -> Annex ()+closeDb (ContentIdentifierHandle h) = liftIO $ H.closeDbQueue h++queueDb :: ContentIdentifierHandle -> SqlPersistM () -> IO ()+queueDb (ContentIdentifierHandle h) = H.queueDb h checkcommit+  where+	-- commit queue after 1000 changes+	checkcommit sz _lastcommittime+		| sz > 1000 = return True+		| otherwise = return False++flushDbQueue :: ContentIdentifierHandle -> IO ()+flushDbQueue (ContentIdentifierHandle h) = H.flushDbQueue h++-- Be sure to also update the git-annex branch when using this.+recordContentIdentifier :: ContentIdentifierHandle -> UUID -> ContentIdentifier -> Key -> IO ()+recordContentIdentifier h u cid k = queueDb h $ do+	void $ insertUnique $ ContentIdentifiers u cid (toIKey k)++getContentIdentifiers :: ContentIdentifierHandle -> UUID -> Key -> IO [ContentIdentifier]+getContentIdentifiers (ContentIdentifierHandle h) u k = H.queryDbQueue h $ do+	l <- selectList+		[ ContentIdentifiersKey ==. toIKey k+		, ContentIdentifiersRemote ==. u+		] []+	return $ map (contentIdentifiersCid . entityVal) l++getContentIdentifierKeys :: ContentIdentifierHandle -> UUID -> ContentIdentifier -> IO [Key]+getContentIdentifierKeys (ContentIdentifierHandle h) u cid = +	H.queryDbQueue h $ do+		l <- selectList+			[ ContentIdentifiersCid ==. cid+			, ContentIdentifiersRemote ==. u+			] []+		return $ map (fromIKey . contentIdentifiersKey . entityVal) l++recordAnnexBranchTree :: ContentIdentifierHandle -> Sha -> IO ()+recordAnnexBranchTree h s = queueDb h $ do+        deleteWhere ([] :: [Filter AnnexBranch])+        void $ insertUnique $ AnnexBranch $ toSRef s++getAnnexBranchTree :: ContentIdentifierHandle -> IO Sha+getAnnexBranchTree (ContentIdentifierHandle h) = H.queryDbQueue h $ do+        l <- selectList ([] :: [Filter AnnexBranch]) []+        case l of+                (s:[]) -> return $ fromSRef $ annexBranchTree $ entityVal s+                _ -> return emptyTree++{- Check if the git-annex branch has been updated and the database needs+ - to be updated with any new content identifiers in it. -}+needsUpdateFromLog :: ContentIdentifierHandle -> Annex (Maybe (Sha, Sha))+needsUpdateFromLog db = do+	oldtree <- liftIO $ getAnnexBranchTree db+	inRepo (Git.Ref.tree Annex.Branch.fullname) >>= \case+		Just currtree | currtree /= oldtree ->+			return $ Just (oldtree, currtree)+		_ -> return Nothing++{- The database should be locked for write when calling this. -}+updateFromLog :: ContentIdentifierHandle -> (Sha, Sha) -> Annex ()+updateFromLog db (oldtree, currtree) = do+	(l, cleanup) <- inRepo $+		DiffTree.diffTreeRecursive oldtree currtree+	mapM_ go l+	void $ liftIO $ cleanup+	liftIO $ do+		recordAnnexBranchTree db currtree+		flushDbQueue db+  where+	go ti = case extLogFileKey remoteContentIdentifierExt (getTopFilePath (DiffTree.file ti)) of+		Nothing -> return ()+		Just k -> do+			l <- Log.getContentIdentifiers k+			liftIO $ forM_ l $ \(u, cids) ->+				forM_ cids $ \cid ->+					recordContentIdentifier db u cid k

Database/Export.hs view

@@ -1,8 +1,8 @@ {- Sqlite database used for exports to special remotes.  -- - Copyright 2017 Joey Hess <id@joeyh.name>+ - Copyright 2017-2019 Joey Hess <id@joeyh.name>  -:- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}@@ -15,6 +15,7 @@ 	ExportHandle, 	openDb, 	closeDb,+	writeLockDbWhile, 	flushDbQueue, 	addExportedLocation, 	removeExportedLocation,@@ -23,16 +24,20 @@ 	getExportTreeCurrent, 	recordExportTreeCurrent, 	getExportTree,+	getExportTreeKey, 	addExportTree, 	removeExportTree, 	updateExportTree, 	updateExportTree', 	updateExportTreeFromLog,+	updateExportDb, 	ExportedId, 	ExportedDirectoryId, 	ExportTreeId, 	ExportTreeCurrentId, 	ExportUpdateResult(..),+	ExportDiffUpdater,+	runExportDiffUpdater, ) where  import Database.Types@@ -44,6 +49,7 @@ import Annex.Export import qualified Logs.Export as Log import Annex.LockFile+import Annex.LockPool import Git.Types import Git.Sha import Git.FilePath@@ -167,6 +173,20 @@   where 	ik = toIKey k +{- Get keys that might be currently exported to a location.+ -+ - Note that the database does not currently have an index to make this+ - fast.+ -+ - Note that this does not see recently queued changes.+ -}+getExportTreeKey :: ExportHandle -> ExportLocation -> IO [Key]+getExportTreeKey (ExportHandle h _) el = H.queryDbQueue h $ do+	map (fromIKey . exportTreeKey . entityVal) +		<$> selectList [ExportTreeFile ==. ef] []+  where+	ef = toSFilePath (fromExportLocation el)+ addExportTree :: ExportHandle -> Key -> ExportLocation -> IO () addExportTree h k loc = queueDb h $ 	void $ insertUnique $ ExportTree ik ef@@ -181,48 +201,131 @@ 	ik = toIKey k 	ef = toSFilePath (fromExportLocation loc) -{- Diff from the old to the new tree and update the ExportTree table. -}-updateExportTree :: ExportHandle -> Sha -> Sha -> Annex ()-updateExportTree h old new = do+-- An action that is passed the old and new values that were exported,+-- and updates state.+type ExportDiffUpdater+	= ExportHandle+	-> Maybe ExportKey+	-- ^ old exported key+	-> Maybe ExportKey+	-- ^ new exported key+	-> Git.DiffTree.DiffTreeItem+	-> Annex ()++mkExportDiffUpdater+	:: (ExportHandle -> Key -> ExportLocation -> IO ())+	-> (ExportHandle -> Key -> ExportLocation -> IO ())+	-> ExportDiffUpdater+mkExportDiffUpdater removeold addnew h srcek dstek i = do+	case srcek of+		Nothing -> return ()+		Just k -> liftIO $ removeold h (asKey k) loc+	case dstek of+		Nothing -> return ()+		Just k -> liftIO $ addnew h (asKey k) loc+  where+	loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i++runExportDiffUpdater :: ExportDiffUpdater -> ExportHandle -> Sha -> Sha -> Annex ()+runExportDiffUpdater updater h old new = do 	(diff, cleanup) <- inRepo $ 		Git.DiffTree.diffTreeRecursive old new 	forM_ diff $ \i -> do 		srcek <- getek (Git.DiffTree.srcsha i) 		dstek <- getek (Git.DiffTree.dstsha i)-		updateExportTree' h srcek dstek i+		updater h srcek dstek i 	void $ liftIO cleanup   where 	getek sha 		| sha == nullSha = return Nothing 		| otherwise = Just <$> exportKey sha -updateExportTree' :: ExportHandle -> Maybe ExportKey -> Maybe ExportKey -> Git.DiffTree.DiffTreeItem -> Annex ()-updateExportTree' h srcek dstek i = do-	case srcek of-		Nothing -> return ()-		Just k -> liftIO $ removeExportTree h (asKey k) loc-	case dstek of-		Nothing -> return ()-		Just k -> liftIO $ addExportTree h (asKey k) loc+{- Diff from the old to the new tree and update the ExportTree table. -}+updateExportTree :: ExportHandle -> Sha -> Sha -> Annex ()+updateExportTree = runExportDiffUpdater updateExportTree'++updateExportTree' :: ExportDiffUpdater+updateExportTree' = mkExportDiffUpdater removeExportTree addExportTree++{- Diff from the old to the new tree and update all tables in the export+ - database. Should only be used when all the files in the new tree have+ - been verified to already be present in the export remote. -}+updateExportDb :: ExportHandle -> Sha -> Sha -> Annex ()+updateExportDb = runExportDiffUpdater $ mkExportDiffUpdater removeold addnew   where-	loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i+	removeold h k loc = liftIO $ do+		removeExportTree h k loc+		removeExportedLocation h k loc+	addnew h k loc = liftIO $ do+		addExportTree h k loc+		addExportedLocation h k loc +{- Runs an action with the database locked for write. Waits for any other+ - writers to finish first. The queue is flushed at the end.+ -+ - This first updates the ExportTree table with any new information + - from the git-annex branch export log.+ -}+writeLockDbWhile :: ExportHandle -> Annex a -> Annex a+writeLockDbWhile db@(ExportHandle _ u) a = do+	updatelck <- takeExclusiveLock (gitAnnexExportUpdateLock u)+	withExclusiveLock (gitAnnexExportLock u) $ do+		bracket_ (setup updatelck) cleanup a+  where+	setup updatelck = do+		void $ updateExportTreeFromLog' db+		-- flush the update so it's available immediately to+		-- anything waiting on the updatelck+		liftIO $ flushDbQueue db+		liftIO $ dropLock updatelck+	cleanup = liftIO $ flushDbQueue db+ data ExportUpdateResult = ExportUpdateSuccess | ExportUpdateConflict 	deriving (Eq) +{- Updates the ExportTree table with information from the+ - git-annex branch export log.+ -+ - This can safely be called whether the database is locked for write or+ - not. Either way, it will block until the update is complete.+ -} updateExportTreeFromLog :: ExportHandle -> Annex ExportUpdateResult-updateExportTreeFromLog db@(ExportHandle _ u) = -	withExclusiveLock (gitAnnexExportLock u) $ do-		old <- liftIO $ fromMaybe emptyTree-			<$> getExportTreeCurrent db-		l <- Log.getExport u-		case Log.exportedTreeishes l of-			[] -> return ExportUpdateSuccess-			(new:[]) -				| new /= old -> do-					updateExportTree db old new-					liftIO $ recordExportTreeCurrent db new-					liftIO $ flushDbQueue db-					return ExportUpdateSuccess-				| new == old -> return ExportUpdateSuccess-			_ts -> return ExportUpdateConflict+updateExportTreeFromLog db@(ExportHandle _ u) =+	-- If another process or thread is performing the update,+	-- this will block until it's done.+	withExclusiveLock (gitAnnexExportUpdateLock u) $ do+		-- If the database is locked by something else,+		-- this will not run the update. But, in that case,+		-- writeLockDbWhile is running, and has already+		-- completed the update, so we don't need to do anything.+		mr <- tryExclusiveLock (gitAnnexExportLock u) $+			updateExportTreeFromLog' db+		case mr of+			Just r -> return r+			Nothing -> do+				old <- liftIO $ fromMaybe emptyTree+					<$> getExportTreeCurrent db+				l <- Log.getExport u+				return $ case Log.exportedTreeishes l of+					[] -> ExportUpdateSuccess+					(new:[]) +						| new /= old -> ExportUpdateSuccess+						| new == old -> ExportUpdateSuccess+					_ts -> ExportUpdateConflict++{- The database should be locked when calling this. -}+updateExportTreeFromLog' :: ExportHandle -> Annex ExportUpdateResult+updateExportTreeFromLog' db@(ExportHandle _ u) = do+	old <- liftIO $ fromMaybe emptyTree+		<$> getExportTreeCurrent db+	l <- Log.getExport u+	case Log.exportedTreeishes l of+		[] -> return ExportUpdateSuccess+		(new:[]) +			| new /= old -> do+				updateExportTree db old new+				liftIO $ recordExportTreeCurrent db new+				liftIO $ flushDbQueue db+				return ExportUpdateSuccess+			| new == old -> return ExportUpdateSuccess+		_ts -> return ExportUpdateConflict

Database/Fsck.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -:- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}

Database/Handle.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Database.Handle (

Database/Init.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Database/Keys.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE ScopedTypeVariables #-}

Database/Keys/Handle.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -:- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Database.Keys.Handle (

Database/Keys/SQL.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}

Database/Queue.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

Database/Types.hs view

@@ -1,22 +1,29 @@ {- types for SQL databases  -- - Copyright 2015-2017 Joey Hess <id@joeyh.name>+ - Copyright 2015-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  module Database.Types where  import Database.Persist.TH+import Database.Persist.Class hiding (Key)+import Database.Persist.Sql hiding (Key) import Data.Maybe import Data.Char+import qualified Data.ByteString as S+import qualified Data.Text as T  import Utility.PartialPrelude import Key import Utility.InodeCache import Git.Types (Ref(..))+import Types.UUID+import Types.Import  -- A serialized Key newtype SKey = SKey String@@ -112,3 +119,26 @@  fromSRef :: SRef -> Ref fromSRef (SRef r) = r++instance PersistField UUID where+	toPersistValue u = toPersistValue b+	  where+		b :: S.ByteString+		b = fromUUID u+	fromPersistValue v = toUUID <$> go+	  where+	 	go :: Either T.Text S.ByteString+		go = fromPersistValue v++instance PersistFieldSql UUID where+	sqlType _ = SqlBlob++instance PersistField ContentIdentifier where+	toPersistValue (ContentIdentifier b) = toPersistValue b+	fromPersistValue v = ContentIdentifier <$> go+	  where+	 	go :: Either T.Text S.ByteString+		go = fromPersistValue v++instance PersistFieldSql ContentIdentifier where+	sqlType _ = SqlBlob

Git.hs view

@@ -5,7 +5,7 @@  -  - Copyright 2010-2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/AutoCorrect.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.AutoCorrect where

Git/Branch.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}

Git/BuildVersion.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.BuildVersion where

Git/CatFile.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.CatFile (

Git/CheckAttr.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.CheckAttr where

Git/CheckIgnore.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.CheckIgnore (

Git/Command.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/Command/Batch.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Command.Batch where

Git/Config.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Config where

Git/ConfigTypes.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012, 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.ConfigTypes where

Git/Construct.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/CurrentRepo.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.CurrentRepo where

Git/DiffTree.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.DiffTree (

Git/DiffTreeItem.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.DiffTreeItem (

Git/Env.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Env where

Git/FileMode.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/FilePath.hs view

@@ -7,7 +7,7 @@  -  - Copyright 2012-2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/Filename.hs view

@@ -3,7 +3,7 @@  -  - Copyright 2010, 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Filename where

Git/Fsck.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns, CPP #-}

Git/GCrypt.hs view

@@ -4,7 +4,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.GCrypt where

Git/HashObject.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/Hook.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/Index.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Index where

Git/LockFile.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/LsFiles.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.LsFiles (

Git/LsTree.hs view

@@ -1,14 +1,15 @@ {- git ls-tree interface  -- - Copyright 2011-2016 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns #-}  module Git.LsTree ( 	TreeItem(..),+	LsTreeMode(..), 	lsTree, 	lsTree', 	lsTreeParams,@@ -34,26 +35,30 @@ 	, file :: TopFilePath 	} deriving Show -{- Lists the complete contents of a tree, recursing into sub-trees,- - with lazy output. -}-lsTree :: Ref -> Repo -> IO ([TreeItem], IO Bool)+data LsTreeMode = LsTreeRecursive | LsTreeNonRecursive++{- Lists the contents of a tree, with lazy output. -}+lsTree :: LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool) lsTree = lsTree' [] -lsTree' :: [CommandParam] -> Ref -> Repo -> IO ([TreeItem], IO Bool)-lsTree' ps t repo = do-	(l, cleanup) <- pipeNullSplit (lsTreeParams t ps) repo+lsTree' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)+lsTree' ps lsmode t repo = do+	(l, cleanup) <- pipeNullSplit (lsTreeParams lsmode t ps) repo 	return (map parseLsTree l, cleanup) -lsTreeParams :: Ref -> [CommandParam] -> [CommandParam]-lsTreeParams r ps =+lsTreeParams :: LsTreeMode -> Ref -> [CommandParam] -> [CommandParam]+lsTreeParams lsmode r ps = 	[ Param "ls-tree" 	, Param "--full-tree" 	, Param "-z"-	, Param "-r"-	] ++ ps +++	] ++ recursiveparams ++ ps ++ 	[ Param "--" 	, File $ fromRef r 	]+  where+	recursiveparams = case lsmode of+		LsTreeRecursive -> [ Param "-r" ]+		LsTreeNonRecursive -> []  {- Lists specified files in a tree. -} lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]

Git/Merge.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Merge (@@ -10,6 +10,7 @@ 	CommitMode(..), 	merge, 	merge',+	mergeUnrelatedHistoriesParam, 	stageMerge, ) where @@ -44,14 +45,20 @@  merge'' :: [CommandParam] -> [MergeConfig] -> Repo -> IO Bool merge'' ps mergeconfig r-	| MergeUnrelatedHistories `elem` mergeconfig =-		ifM (Git.Version.older "2.9.0")-			( go ps-			, go (ps ++ [Param "--allow-unrelated-histories"])-			)+	| MergeUnrelatedHistories `elem` mergeconfig = do+		up <- mergeUnrelatedHistoriesParam+		go (ps ++ maybeToList up) 	| otherwise = go ps   where 	go ps' = runBool ps' r++{- Git used to default to merging unrelated histories; newer versions need+ - an option. -}+mergeUnrelatedHistoriesParam :: IO (Maybe CommandParam)+mergeUnrelatedHistoriesParam = ifM (Git.Version.older "2.9.0")+	( return Nothing+	, return (Just (Param "--allow-unrelated-histories"))+	)  {- Stage the merge into the index, but do not commit it.-} stageMerge :: Ref -> [MergeConfig] -> Repo -> IO Bool

Git/Objects.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Objects where

Git/Queue.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP, BangPatterns #-}

Git/Ref.hs view

@@ -1,8 +1,8 @@ {- git ref stuff  -- - Copyright 2011-2013 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Ref where@@ -33,11 +33,18 @@  - Converts such a fully qualified ref into a base ref  - (eg: master or origin/master). -} base :: Ref -> Ref-base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef+base = removeBase "refs/heads/" . removeBase "refs/remotes/"++{- Removes a directory such as "refs/heads/master" from a+ - fully qualified ref. Any ref not starting with it is left as-is. -}+removeBase :: String -> Ref -> Ref+removeBase dir (Ref r)+	| prefix `isPrefixOf` r = Ref (drop (length prefix) r)+	| otherwise = Ref r   where-	remove prefix s-		| prefix `isPrefixOf` s = drop (length prefix) s-		| otherwise = s+	prefix = case end dir of+		['/'] -> dir+		_ -> dir ++ "/"  {- Given a directory such as "refs/remotes/origin", and a ref such as  - refs/heads/master, yields a version of that ref under the directory,@@ -88,9 +95,11 @@ sha :: Branch -> Repo -> IO (Maybe Sha) sha branch repo = process <$> showref repo   where-	showref = pipeReadStrict [Param "show-ref",-		Param "--hash", -- get the hash-		Param $ fromRef branch]+	showref = pipeReadStrict+		[ Param "show-ref"+		, Param "--hash" -- get the hash+		, Param $ fromRef branch+		] 	process [] = Nothing 	process s = Just $ Ref $ firstLine s

Git/RefLog.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.RefLog where

Git/Remote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/Remote/Remove.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Git/Repair.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Repair (@@ -341,7 +341,7 @@ verifyTree missing treesha r 	| S.member treesha missing = return False 	| otherwise = do-		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams treesha []) r+		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive treesha []) r 		let objshas = map (LsTree.sha . LsTree.parseLsTree) ls 		if any (`S.member` missing) objshas 			then do

Git/Sha.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Sha where

Git/Ssh.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Ssh (module Git.Ssh, module Utility.SshHost) where

Git/Status.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Status where

Git/Tree.hs view

@@ -1,8 +1,8 @@ {- git trees  -- - Copyright 2016 Joey Hess <id@joeyh.name>+ - Copyright 2016-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-}@@ -12,8 +12,13 @@ 	TreeContent(..), 	getTree, 	recordTree,+	recordTree', 	TreeItem(..),+	treeItemsToTree, 	adjustTree,+	graftTree,+	graftTree',+	withMkTreeHandle, 	treeMode, ) where @@ -47,15 +52,15 @@ 	deriving (Show, Eq, Ord)  {- Gets the Tree for a Ref. -}-getTree :: Ref -> Repo -> IO Tree-getTree r repo = do-	(l, cleanup) <- lsTreeWithObjects r repo+getTree :: LsTree.LsTreeMode -> Ref -> Repo -> IO Tree+getTree lstreemode r repo = do+	(l, cleanup) <- lsTreeWithObjects lstreemode r repo 	let !t = either (\e -> error ("ls-tree parse error:" ++ e)) id 		(extractTree l) 	void cleanup 	return t -lsTreeWithObjects :: Ref -> Repo -> IO ([LsTree.TreeItem], IO Bool)+lsTreeWithObjects :: LsTree.LsTreeMode -> Ref -> Repo -> IO ([LsTree.TreeItem], IO Bool) lsTreeWithObjects = LsTree.lsTree' [Param "-t"]  newtype MkTreeHandle = MkTreeHandle CoProcess.CoProcessHandle@@ -181,7 +186,7 @@ 	-> m Sha adjustTree adjusttreeitem addtreeitems removefiles r repo = 	withMkTreeHandle repo $ \h -> do-		(l, cleanup) <- liftIO $ lsTreeWithObjects r repo+		(l, cleanup) <- liftIO $ lsTreeWithObjects LsTree.LsTreeRecursive r repo 		(l', _, _) <- go h False [] 1 inTopTree l 		l'' <- adjustlist h 0 inTopTree (const True) l' 		sha <- liftIO $ mkTree h l''@@ -228,6 +233,69 @@ 	removeset = S.fromList $ map (normalise . gitPath) removefiles 	removed (TreeBlob f _ _) = S.member (normalise (gitPath f)) removeset 	removed _ = False++{- Grafts subtree into the basetree at the specified location, replacing+ - anything that the basetree already had at that location.+ -+ - This is generally much more efficient than using getTree and recordTree,+ - or adjustTree, since it only needs to traverse from the top of the tree+ - down to the graft location. It does not buffer the whole tree in memory.+ -}+graftTree+	:: Sha+	-> TopFilePath+	-> Sha+	-> Repo+	-> IO Sha+graftTree subtree graftloc basetree repo =+	withMkTreeHandle repo $ graftTree' subtree graftloc basetree repo++graftTree'+	:: Sha+	-> TopFilePath+	-> Sha+	-> Repo+	-> MkTreeHandle+	-> IO Sha+graftTree' subtree graftloc basetree repo hdl = go basetree graftdirs+  where+	go tsha (topmostgraphdir:restgraphdirs) = do+		Tree t <- getTree LsTree.LsTreeNonRecursive tsha repo+		t' <- case partition isabovegraft t of+			([], _) -> do+				graft <- graftin (topmostgraphdir:restgraphdirs)+				return (graft:t)+			-- normally there can only be one matching item+			-- in the tree, but it's theoretically possible+			-- for a git tree to have multiple items with the+			-- same name, so process them all+			(matching, rest) -> do+				newshas <- forM matching $ \case+					RecordedSubTree tloc tsha' _+						| null restgraphdirs -> return $+							RecordedSubTree tloc subtree []+						| otherwise -> do+							tsha'' <- go tsha' restgraphdirs+							return $ RecordedSubTree tloc tsha'' []+					_ -> graftin (topmostgraphdir:restgraphdirs)+				return (newshas ++ rest)+		mkTree hdl t'+	go _ [] = return subtree++	isabovegraft i = beneathSubTree i graftloc || gitPath i == gitPath graftloc+	+	graftin t = recordSubTree hdl $ graftin' t+	graftin' [] = RecordedSubTree graftloc subtree []+	graftin' (d:rest) +		| d == graftloc = graftin' []+		| otherwise = NewSubTree d [graftin' rest]+	+	-- For a graftloc of "foo/bar/baz", this generates+	-- ["foo", "foo/bar", "foo/bar/baz"]+	graftdirs = map (asTopFilePath . toInternalGitPath) $+		mkpaths [] $ splitDirectories $ gitPath graftloc+	mkpaths _ [] = []+	mkpaths base (d:rest) = (joinPath base </> d) : mkpaths (base ++ [d]) rest  {- Assumes the list is ordered, with tree objects coming right before their  - contents. -}

Git/Types.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Types where

Git/UnionMerge.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.UnionMerge (

Git/UpdateIndex.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE BangPatterns, CPP #-}

Git/Url.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010, 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.Url (

Git/Version.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011, 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# OPTIONS_GHC -fno-warn-tabs #-}

Key.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# OPTIONS_GHC -fno-warn-orphans #-}

Limit.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Limit where

Limit/Wanted.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Limit.Wanted where

Logs.hs view

@@ -1,8 +1,8 @@ {- git-annex log file names  -- - Copyright 2013-2018 Joey Hess <id@joeyh.name>+ - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs where@@ -12,7 +12,7 @@  {- There are several varieties of log file formats. -} data LogVariety-	= UUIDBasedLog+	= OldUUIDBasedLog 	| NewUUIDBasedLog 	| ChunkLog Key 	| PresenceLog Key@@ -24,16 +24,18 @@  - of logs used by git-annex, if it's a known path. -} getLogVariety :: FilePath -> Maybe LogVariety getLogVariety f-	| f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog+	| f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog+	| f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog 	| isRemoteStateLog f = Just NewUUIDBasedLog-	| isChunkLog f = ChunkLog <$> chunkLogFileKey f+	| isRemoteContentIdentifierLog f = Just NewUUIDBasedLog+	| isChunkLog f = ChunkLog <$> extLogFileKey chunkLogExt f 	| isRemoteMetaDataLog f = Just RemoteMetaDataLog 	| isMetaDataLog f || f `elem` otherLogs = Just OtherLog 	| otherwise = PresenceLog <$> firstJust (presenceLogs f) -{- All the uuid-based logs stored in the top of the git-annex branch. -}-topLevelUUIDBasedLogs :: [FilePath]-topLevelUUIDBasedLogs =+{- All the old-format uuid-based logs stored in the top of the git-annex branch. -}+topLevelOldUUIDBasedLogs :: [FilePath]+topLevelOldUUIDBasedLogs = 	[ uuidLog 	, remoteLog 	, trustLog@@ -44,9 +46,15 @@ 	, activityLog 	, differenceLog 	, multicastLog-	, exportLog 	] +{- All the new-format uuid-based logs stored in the top of the git-annex branch. -}+topLevelNewUUIDBasedLogs :: [FilePath]+topLevelNewUUIDBasedLogs =+	[ exportLog+	]++ {- All the ways to get a key from a presence log file -} presenceLogs :: FilePath -> [Maybe Key] presenceLogs f =@@ -54,7 +62,7 @@ 	, locationLogFileKey f 	] -{- Logs that are neither UUID based nor presence logs. -}+{- Top-level logs that are neither UUID based nor presence logs. -} otherLogs :: [FilePath] otherLogs = 	[ numcopiesLog@@ -107,16 +115,6 @@ locationLogFile :: GitConfig -> Key -> String locationLogFile config key = branchHashDir config key </> keyFile key ++ ".log" -{- Converts a pathname into a key if it's a location log. -}-locationLogFileKey :: FilePath -> Maybe Key-locationLogFileKey path-	| ["remote", "web"] `isPrefixOf` splitDirectories dir = Nothing-	| ext == ".log" = fileKey base-	| otherwise = Nothing-  where-	(dir, file) = splitFileName path-	(base, ext) = splitAt (length file - 4) file- {- The filename of the url log for a given key. -} urlLogFile :: GitConfig -> Key -> FilePath urlLogFile config key = branchHashDir config key </> keyFile key ++ urlLogExt@@ -133,17 +131,6 @@ urlLogExt :: String urlLogExt = ".log.web" -{- Converts a url log file into a key.- - (Does not work on oldurlLogs.) -}-urlLogFileKey :: FilePath -> Maybe Key-urlLogFileKey path-	| ext == urlLogExt = fileKey base-	| otherwise = Nothing-  where-	file = takeFileName path-	(base, ext) = splitAt (length file - extlen) file-	extlen = length urlLogExt- {- Does not work on oldurllogs. -} isUrlLog :: FilePath -> Bool isUrlLog file = urlLogExt `isSuffixOf` file@@ -163,15 +150,6 @@ chunkLogFile :: GitConfig -> Key -> FilePath chunkLogFile config key = branchHashDir config key </> keyFile key ++ chunkLogExt -chunkLogFileKey :: FilePath -> Maybe Key-chunkLogFileKey path-	| ext == chunkLogExt = fileKey base-	| otherwise = Nothing-  where-	file = takeFileName path-	(base, ext) = splitAt (length file - extlen) file-	extlen = length chunkLogExt- chunkLogExt :: String chunkLogExt = ".log.cnk" @@ -197,3 +175,35 @@  isRemoteMetaDataLog :: FilePath -> Bool isRemoteMetaDataLog path = remoteMetaDataLogExt `isSuffixOf` path++{- The filename of the remote content identifier log for a given key. -}+remoteContentIdentifierLogFile :: GitConfig -> Key -> FilePath+remoteContentIdentifierLogFile config key = branchHashDir config key </> keyFile key ++ remoteContentIdentifierExt++remoteContentIdentifierExt :: String+remoteContentIdentifierExt = ".log.cid"++isRemoteContentIdentifierLog :: FilePath -> Bool+isRemoteContentIdentifierLog path = remoteContentIdentifierExt `isSuffixOf` path++{- From an extension and a log filename, get the key that it's a log for. -}+extLogFileKey :: String -> FilePath -> Maybe Key+extLogFileKey expectedext path+	| ext == expectedext = fileKey base+	| otherwise = Nothing+  where+	file = takeFileName path+	(base, ext) = splitAt (length file - extlen) file+	extlen = length expectedext++{- Converts a url log file into a key.+ - (Does not work on oldurlLogs.) -}+urlLogFileKey :: FilePath -> Maybe Key+urlLogFileKey = extLogFileKey urlLogExt++{- Converts a pathname into a key if it's a location log. -}+locationLogFileKey :: FilePath -> Maybe Key+locationLogFileKey path+	-- Want only xx/yy/foo.log, not .log files in other places.+	| length (splitDirectories path) /= 3 = Nothing+	| otherwise = extLogFileKey ".log" path

Logs/Activity.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Activity (@@ -29,12 +29,12 @@ recordActivity act uuid = do 	c <- liftIO currentVectorClock 	Annex.Branch.change activityLog $-		buildLog buildActivity+		buildLogOld buildActivity 			. changeLog c uuid (Right act)-			. parseLog parseActivity+			. parseLogOld parseActivity  lastActivities :: Maybe Activity -> Annex (Log Activity)-lastActivities wantact = parseLog (onlywanted =<< parseActivity)+lastActivities wantact = parseLogOld (onlywanted =<< parseActivity) 	<$> Annex.Branch.get activityLog   where 	onlywanted (Right a) | wanted a = pure a

Logs/Chunk.hs view

@@ -12,7 +12,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Chunk (

Logs/Chunk/Pure.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014, 2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Chunk.Pure

Logs/Config.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Config (

+ Logs/ContentIdentifier.hs view

@@ -0,0 +1,47 @@+{- Remote content identifier logs.+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Logs.ContentIdentifier (+	module X,+	recordContentIdentifier,+	getContentIdentifiers,+) where++import Annex.Common+import Logs+import Logs.MapLog+import Types.Import+import qualified Annex.Branch+import Logs.ContentIdentifier.Pure as X+import qualified Annex++import qualified Data.Map as M+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty++-- | Records a remote's content identifier and the key that it corresponds to.+--+-- A remote may use multiple content identifiers for the same key over time,+-- so ones that were recorded before are preserved.+recordContentIdentifier :: UUID -> ContentIdentifier -> Key -> Annex ()+recordContentIdentifier u cid k = do+	c <- liftIO currentVectorClock+	config <- Annex.getGitConfig+	Annex.Branch.change (remoteContentIdentifierLogFile config k) $+		buildLog . addcid c . parseLog+  where+	addcid c l = changeMapLog c u (cid :| contentIdentifierList (M.lookup u m)) l+	  where+		m = simpleMap l++-- | Get all known content identifiers for a key.+getContentIdentifiers :: Key -> Annex [(UUID, [ContentIdentifier])]+getContentIdentifiers k = do+	config <- Annex.getGitConfig+	map (\(u, l) -> (u, NonEmpty.toList l) )+		. M.toList . simpleMap . parseLog+		<$> Annex.Branch.get (remoteContentIdentifierLogFile config k)

+ Logs/ContentIdentifier/Pure.hs view

@@ -0,0 +1,75 @@+{- Remote content identifier logs, pure operations.+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Logs.ContentIdentifier.Pure where++import Annex.Common+import Logs.UUIDBased+import Types.Import+import Utility.Base64++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import qualified Data.Attoparsec.ByteString.Lazy as A+import qualified Data.Attoparsec.ByteString.Char8 as A8+import Data.ByteString.Builder+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty++-- A ContentIdentifier can contain "", so to avoid ambiguity+-- in parsing, the list of them in the log must be non-empty.+type ContentIdentifierLog = Log (NonEmpty ContentIdentifier)++contentIdentifierList :: Maybe (NonEmpty ContentIdentifier) -> [ContentIdentifier]+contentIdentifierList (Just l) = Data.List.NonEmpty.toList l+contentIdentifierList Nothing = []++buildLog :: ContentIdentifierLog -> Builder+buildLog = buildLogNew buildContentIdentifierList++buildContentIdentifierList :: (NonEmpty ContentIdentifier) -> Builder+buildContentIdentifierList l = case l of+	c :| [] -> buildcid c+	(c :| cs) -> go (c:cs)+  where+	buildcid (ContentIdentifier c)+		| S8.any (`elem` [':', '\r', '\n']) c || "!" `S8.isPrefixOf` c =+			charUtf8 '!' <> byteString (toB64' c)+		| otherwise = byteString c+	go [] = mempty+	go (c:[]) = buildcid c+	go (c:cs) = buildcid c <> charUtf8 ':' <> go cs++parseLog :: L.ByteString -> ContentIdentifierLog+parseLog = parseLogNew parseContentIdentifierList++parseContentIdentifierList :: A.Parser (NonEmpty ContentIdentifier)+parseContentIdentifierList = do+	first <- cidparser+	listparser first []+  where+	cidparser = do+		b <- A8.takeWhile (/= ':')+		return $ if "!" `S8.isPrefixOf` b+			then ContentIdentifier $ fromMaybe b (fromB64Maybe' (S.drop 1 b))+			else ContentIdentifier b+	listparser first rest = ifM A8.atEnd+		( return (first :| reverse rest)+		, do+			_ <- A8.char ':'+			cid <- cidparser+			listparser first (cid:rest)+		)++prop_parse_build_contentidentifier_log :: NonEmpty ContentIdentifier -> Bool+prop_parse_build_contentidentifier_log l =+	let v = A.parseOnly parseContentIdentifierList $ L.toStrict $ +		toLazyByteString $ buildContentIdentifierList l+	in v == Right l

Logs/Difference.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Difference (@@ -27,9 +27,9 @@ recordDifferences ds@(Differences {}) uuid = do 	c <- liftIO currentVectorClock 	Annex.Branch.change differenceLog $-		buildLog byteString +		buildLogOld byteString  			. changeLog c uuid (encodeBS $ showDifferences ds) -			. parseLog A.takeByteString+			. parseLogOld A.takeByteString recordDifferences UnknownDifferences _ = return ()  -- Map of UUIDs that have Differences recorded.

Logs/Difference/Pure.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Difference.Pure (@@ -20,7 +20,7 @@  parseDifferencesLog :: L.ByteString -> (M.Map UUID Differences) parseDifferencesLog = simpleMap-	. parseLog (readDifferences . decodeBS <$> A.takeByteString)+	. parseLogOld (readDifferences . decodeBS <$> A.takeByteString)  -- The sum of all recorded differences, across all UUIDs. allDifferences :: M.Map UUID Differences -> Differences

Logs/Export.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Export (@@ -124,7 +124,7 @@ 		buildExportLog  			. changeMapLog c ep new 			. parseExportLog-	Annex.Branch.graftTreeish newtree (asTopFilePath "export.tree")+	Annex.Branch.rememberTreeish newtree (asTopFilePath "export.tree")  parseExportLog :: L.ByteString -> MapLog ExportParticipants Exported parseExportLog = parseMapLog exportParticipantsParser exportedParser

Logs/FsckResults.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.FsckResults (

Logs/Group.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012, 2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Group (@@ -40,7 +40,7 @@ 	curr <- lookupGroups uuid 	c <- liftIO currentVectorClock 	Annex.Branch.change groupLog $-		buildLog buildGroup . changeLog c uuid (modifier curr) . parseLog parseGroup+		buildLogOld buildGroup . changeLog c uuid (modifier curr) . parseLogOld parseGroup 	 	-- The changed group invalidates the preferred content cache. 	Annex.changeState $ \s -> s@@ -76,7 +76,8 @@ {- Loads the map, updating the cache. -} groupMapLoad :: Annex GroupMap groupMapLoad = do-	m <- makeGroupMap . simpleMap . parseLog parseGroup <$> Annex.Branch.get groupLog+	m <- makeGroupMap . simpleMap . parseLogOld parseGroup+		<$> Annex.Branch.get groupLog 	Annex.changeState $ \s -> s { Annex.groupmap = Just m } 	return m

Logs/Location.hs view

@@ -10,7 +10,7 @@  -   - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Location (

Logs/MapLog.hs view

@@ -8,7 +8,7 @@  -  - Copyright 2014, 2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.MapLog (@@ -20,6 +20,7 @@ import Common import Annex.VectorClock import Logs.Line+import Utility.QuickCheck  import qualified Data.ByteString.Lazy as L import qualified Data.Map.Strict as M@@ -31,6 +32,9 @@ 	{ changed :: VectorClock 	, value :: v 	} deriving (Eq, Show)++instance Arbitrary v => Arbitrary (LogEntry v) where+	arbitrary = LogEntry <$> arbitrary <*> arbitrary  type MapLog f v = M.Map f (LogEntry v)

Logs/MetaData.hs view

@@ -20,7 +20,7 @@  - and so foo currently has no value.  -  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.MetaData (

Logs/MetaData/Pure.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# OPTIONS_GHC -fno-warn-orphans #-}

Logs/Multicast.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2017, 2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Multicast (@@ -27,12 +27,12 @@ recordFingerprint fp uuid = do 	c <- liftIO currentVectorClock 	Annex.Branch.change multicastLog $-		buildLog buildFindgerPrint+		buildLogOld buildFindgerPrint 			. changeLog c uuid fp-			. parseLog fingerprintParser+			. parseLogOld fingerprintParser  knownFingerPrints :: Annex (M.Map UUID Fingerprint)-knownFingerPrints = simpleMap . parseLog fingerprintParser+knownFingerPrints = simpleMap . parseLogOld fingerprintParser 	<$> Annex.Branch.get activityLog  fingerprintParser :: A.Parser Fingerprint

Logs/NumCopies.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# OPTIONS_GHC -fno-warn-orphans #-}

Logs/PreferredContent.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.PreferredContent (@@ -74,7 +74,7 @@ 	groupmap <- groupMap 	configmap <- readRemoteLog 	let genmap l gm = simpleMap-		. parseLogWithUUID (\u -> makeMatcher groupmap configmap gm u . decodeBS <$> A.takeByteString)+		. parseLogOldWithUUID (\u -> makeMatcher groupmap configmap gm u . decodeBS <$> A.takeByteString) 		<$> Annex.Branch.get l 	pc <- genmap preferredContentLog =<< groupPreferredContentMapRaw 	rc <- genmap requiredContentLog M.empty

Logs/PreferredContent/Raw.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.PreferredContent.Raw where@@ -32,9 +32,9 @@ setLog logfile uuid@(UUID _) val = do 	c <- liftIO currentVectorClock 	Annex.Branch.change logfile $-		buildLog buildPreferredContentExpression+		buildLogOld buildPreferredContentExpression 		. changeLog c uuid val-		. parseLog parsePreferredContentExpression+		. parseLogOld parsePreferredContentExpression 	Annex.changeState $ \s -> s  		{ Annex.preferredcontentmap = Nothing 		, Annex.requiredcontentmap = Nothing@@ -70,11 +70,11 @@ buildPreferredContentExpression = byteString . encodeBS  preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)-preferredContentMapRaw = simpleMap . parseLog parsePreferredContentExpression+preferredContentMapRaw = simpleMap . parseLogOld parsePreferredContentExpression 	<$> Annex.Branch.get preferredContentLog  requiredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)-requiredContentMapRaw = simpleMap . parseLog parsePreferredContentExpression+requiredContentMapRaw = simpleMap . parseLogOld parsePreferredContentExpression 	<$> Annex.Branch.get requiredContentLog  groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression)

Logs/Presence.hs view

@@ -8,7 +8,7 @@  -   - Copyright 2010-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Presence (

Logs/Presence/Pure.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Presence.Pure where@@ -122,6 +122,5 @@ 		arbinfo = (encodeBS <$> arbitrary) `suchThat` 			(\b -> C8.notElem '\n' b && C8.notElem '\r' b) -prop_parse_build_log :: [LogLine] -> Bool-prop_parse_build_log l = parseLog (toLazyByteString (buildLog l)) == l-+prop_parse_build_presence_log :: [LogLine] -> Bool+prop_parse_build_presence_log l = parseLog (toLazyByteString (buildLog l)) == l

Logs/Remote.hs view

@@ -2,7 +2,7 @@  -   - Copyright 2011 Joey Hess <id@joeyh.name>  - - - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Remote (@@ -33,13 +33,13 @@ configSet u cfg = do 	c <- liftIO currentVectorClock 	Annex.Branch.change remoteLog $-		buildLog (byteString . encodeBS . showConfig)+		buildLogOld (byteString . encodeBS . showConfig) 			. changeLog c u cfg-			. parseLog remoteConfigParser+			. parseLogOld remoteConfigParser  {- Map of remotes by uuid containing key/value config maps. -} readRemoteLog :: Annex (M.Map UUID RemoteConfig)-readRemoteLog = simpleMap . parseLog remoteConfigParser+readRemoteLog = simpleMap . parseLogOld remoteConfigParser 	<$> Annex.Branch.get remoteLog  remoteConfigParser :: A.Parser RemoteConfig

Logs/RemoteState.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014, 2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.RemoteState (

Logs/Schedule.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Schedule (@@ -34,15 +34,15 @@ scheduleSet uuid@(UUID _) activities = do 	c <- liftIO currentVectorClock 	Annex.Branch.change scheduleLog $-		buildLog byteString +		buildLogOld byteString  			. changeLog c uuid (encodeBS val)-			. parseLog A.takeByteString+			. parseLogOld A.takeByteString   where 	val = fromScheduledActivities activities scheduleSet NoUUID _ = error "unknown UUID; cannot modify"  scheduleMap :: Annex (M.Map UUID [ScheduledActivity])-scheduleMap = simpleMap . parseLog parser <$> Annex.Branch.get scheduleLog+scheduleMap = simpleMap . parseLogOld parser <$> Annex.Branch.get scheduleLog   where 	parser = either fail pure . parseScheduledActivities . decodeBS  		=<< A.takeByteString

Logs/SingleValue.hs view

@@ -8,7 +8,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.SingleValue (

Logs/SingleValue/Pure.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.SingleValue.Pure where

Logs/Transfer.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Logs/Transitions.hs view

@@ -9,7 +9,7 @@  -  - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Transitions where

Logs/Trust.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Trust (

Logs/Trust/Basic.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Trust.Basic (@@ -24,9 +24,9 @@ trustSet uuid@(UUID _) level = do 	c <- liftIO currentVectorClock 	Annex.Branch.change trustLog $-		buildLog buildTrustLevel .+		buildLogOld buildTrustLevel . 			changeLog c uuid level .-				parseLog trustLevelParser+				parseLogOld trustLevelParser 	Annex.changeState $ \s -> s { Annex.trustmap = Nothing } trustSet NoUUID _ = error "unknown UUID; cannot modify"

Logs/Trust/Pure.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings #-}@@ -19,7 +19,7 @@ import Data.ByteString.Builder  calcTrustMap :: L.ByteString -> TrustMap-calcTrustMap = simpleMap . parseLog trustLevelParser+calcTrustMap = simpleMap . parseLogOld trustLevelParser  trustLevelParser :: A.Parser TrustLevel trustLevelParser = (totrust <$> A8.anyChar <* A.endOfInput)

Logs/UUID.hs view

@@ -4,7 +4,7 @@  -  - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.UUID (@@ -32,7 +32,7 @@ describeUUID uuid desc = do 	c <- liftIO currentVectorClock 	Annex.Branch.change uuidLog $-		buildLog buildUUIDDesc . changeLog c uuid desc . parseUUIDLog+		buildLogOld buildUUIDDesc . changeLog c uuid desc . parseUUIDLog  {- The map is cached for speed. -} uuidDescMap :: Annex UUIDDescMap@@ -53,4 +53,4 @@ 	preferold = flip const  parseUUIDLog :: L.ByteString -> Log UUIDDesc-parseUUIDLog = parseLog (UUIDDesc <$> A.takeByteString)+parseUUIDLog = parseLogOld (UUIDDesc <$> A.takeByteString)

Logs/UUIDBased.hs view

@@ -3,15 +3,15 @@  - This is used to store information about UUIDs in a way that can  - be union merged.  -- - A line of the log will look like: "UUID[ INFO[ timestamp=foo]]"+ - The old format looks like: "UUID[ INFO[ timestamp=foo]]"  - The timestamp is last for backwards compatability reasons,- - and may not be present on old log lines.+ - and may not be present on very old log lines.  -  - New uuid based logs instead use the form: "timestamp UUID INFO"  -   - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings, TupleSections #-}@@ -21,10 +21,10 @@ 	LogEntry(..), 	VectorClock, 	currentVectorClock,-	parseLog,+	parseLogOld, 	parseLogNew,-	parseLogWithUUID,-	buildLog,+	parseLogOldWithUUID,+	buildLogOld, 	buildLogNew, 	changeLog, 	addLog,@@ -48,8 +48,8 @@  type Log v = MapLog UUID v -buildLog :: (v -> Builder) -> Log v -> Builder-buildLog builder = mconcat . map genline . M.toList+buildLogOld :: (v -> Builder) -> Log v -> Builder+buildLogOld builder = mconcat . map genline . M.toList   where 	genline (u, LogEntry c@(VectorClock {}) v) = 		buildUUID u <> sp <> builder v <> sp <>@@ -59,15 +59,15 @@ 	sp = charUtf8 ' ' 	nl = charUtf8 '\n' -parseLog :: A.Parser a -> L.ByteString -> Log a-parseLog = parseLogWithUUID . const+parseLogOld :: A.Parser a -> L.ByteString -> Log a+parseLogOld = parseLogOldWithUUID . const -parseLogWithUUID :: (UUID -> A.Parser a) -> L.ByteString -> Log a-parseLogWithUUID parser = fromMaybe M.empty . A.maybeResult-	. A.parse (logParser parser)+parseLogOldWithUUID :: (UUID -> A.Parser a) -> L.ByteString -> Log a+parseLogOldWithUUID parser = fromMaybe M.empty . A.maybeResult+	. A.parse (logParserOld parser) -logParser :: (UUID -> A.Parser a) -> A.Parser (Log a)-logParser parser = M.fromListWith best <$> parseLogLines go+logParserOld :: (UUID -> A.Parser a) -> A.Parser (Log a)+logParserOld parser = M.fromListWith best <$> parseLogLines go   where 	go = do 		u <- toUUID <$> A8.takeWhile1 (/= ' ')

Logs/Unused.hs view

@@ -12,7 +12,7 @@  -  - Copyright 2010-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Unused (

Logs/View.hs view

@@ -6,7 +6,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.View (

Logs/Web.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Logs.Web (

Messages.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Messages (

Messages/Concurrent.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}

Messages/Internal.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Messages.Internal where

Messages/JSON.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings, GADTs #-}

Messages/Progress.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2010-2015 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Messages.Progress where

P2P/Address.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module P2P.Address where

P2P/Annex.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE RankNTypes, FlexibleContexts #-}

P2P/Auth.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module P2P.Auth where

P2P/IO.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2016-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE RankNTypes, FlexibleContexts, CPP #-}

P2P/Protocol.hs view

@@ -4,7 +4,7 @@  -  - Copyright 2016-2018 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE DeriveFunctor, TemplateHaskell, FlexibleContexts #-}

Remote.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings #-}

Remote/Adb.hs view

@@ -17,7 +17,7 @@ import Config.Cost import Remote.Helper.Special import Remote.Helper.Messages-import Remote.Helper.Export+import Remote.Helper.ExportImport import Annex.UUID import Utility.Metered @@ -35,6 +35,7 @@ 	, generate = gen 	, setup = adbSetup 	, exportSupported = exportIsSupported+	, importSupported = importUnsupported 	}  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)@@ -61,6 +62,7 @@ 			, removeExportDirectory = Just $ removeExportDirectoryM serial adir 			, renameExport = renameExportM serial adir 			}+		, importActions = importUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairRepo = Nothing@@ -220,9 +222,9 @@   where 	aloc = androidExportLocation adir loc -renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex Bool-renameExportM serial adir _k old new = liftIO $ adbShellBool serial-	[Param "mv", Param "-f", File oldloc, File newloc]+renameExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)+renameExportM serial adir _k old new = liftIO $ Just <$> +	adbShellBool serial [Param "mv", Param "-f", File oldloc, File newloc]   where 	oldloc = fromAndroidPath $ androidExportLocation adir old 	newloc = fromAndroidPath $ androidExportLocation adir new

Remote/BitTorrent.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}@@ -27,7 +27,7 @@ import Annex.Tmp import Annex.UUID import qualified Annex.Url as Url-import Remote.Helper.Export+import Remote.Helper.ExportImport  import Network.URI @@ -43,6 +43,7 @@ 	, generate = gen 	, setup = error "not supported" 	, exportSupported = exportUnsupported+	, importSupported = importUnsupported 	}  -- There is only one bittorrent remote, and it always exists.@@ -68,6 +69,7 @@ 		, checkPresent = checkKey 		, checkPresentCheap = False 		, exportActions = exportUnsupported+		, importActions = importUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairRepo = Nothing

Remote/Bup.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.Bup (remote) where@@ -25,7 +25,7 @@ import qualified Remote.Helper.Ssh as Ssh import Remote.Helper.Special import Remote.Helper.Messages-import Remote.Helper.Export+import Remote.Helper.ExportImport import Utility.Hash import Utility.UserInfo import Annex.UUID@@ -41,6 +41,7 @@ 	, generate = gen 	, setup = bupSetup 	, exportSupported = exportUnsupported+	, importSupported = importUnsupported 	}  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)@@ -67,6 +68,7 @@ 		, checkPresent = checkPresentDummy 		, checkPresentCheap = bupLocal buprepo 		, exportActions = exportUnsupported+		, importActions = importUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairRepo = Nothing

Remote/Ddar.hs view

@@ -3,7 +3,7 @@  - Copyright 2011 Joey Hess <id@joeyh.name>  - Copyright 2014 Robie Basak <robie@justgohome.co.uk>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.Ddar (remote) where@@ -19,7 +19,7 @@ import Config import Config.Cost import Remote.Helper.Special-import Remote.Helper.Export+import Remote.Helper.ExportImport import Annex.Ssh import Annex.UUID import Utility.SshHost@@ -36,6 +36,7 @@ 	, generate = gen 	, setup = ddarSetup 	, exportSupported = exportUnsupported+	, importSupported = importUnsupported 	}  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)@@ -66,6 +67,7 @@ 		, checkPresent = checkPresentDummy 		, checkPresentCheap = ddarLocal ddarrepo 		, exportActions = exportUnsupported+		, importActions = importUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairRepo = Nothing

Remote/Directory.hs view

@@ -1,8 +1,8 @@ {- A "remote" that is just a filesystem directory.  -- - Copyright 2011-2017 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-}@@ -26,12 +26,14 @@ import Config import Utility.FileMode import Remote.Helper.Special-import Remote.Helper.Export+import Remote.Helper.ExportImport+import Types.Import import qualified Remote.Directory.LegacyChunked as Legacy import Annex.Content import Annex.UUID import Utility.Metered import Utility.Tmp+import Utility.InodeCache  remote :: RemoteType remote = RemoteType@@ -40,6 +42,7 @@ 	, generate = gen 	, setup = directorySetup 	, exportSupported = exportIsSupported+	, importSupported = importIsSupported 	}  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)@@ -73,6 +76,14 @@ 				, removeExportDirectory = Nothing 				, renameExport = renameExportM dir 				}+			, importActions = ImportActions+				{ listImportableContents = listImportableContentsM dir+				, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM dir+				, storeExportWithContentIdentifier = storeExportWithContentIdentifierM dir+				, removeExportWithContentIdentifier = removeExportWithContentIdentifierM dir+				, removeExportDirectoryWhenEmpty = Nothing+				, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM dir+				} 			, whereisKey = Nothing 			, remoteFsck = Nothing 			, repairRepo = Nothing@@ -227,14 +238,17 @@ checkPresentM d _ k = checkPresentGeneric d (locations d k)  checkPresentGeneric :: FilePath -> [FilePath] -> Annex Bool-checkPresentGeneric d ps = liftIO $-	ifM (anyM doesFileExist ps)-		( return True-		, ifM (doesDirectoryExist d)-			( return False-			, giveup $ "directory " ++ d ++ " is not accessible"-			)+checkPresentGeneric d ps = checkPresentGeneric' d $+	liftIO $ anyM doesFileExist ps++checkPresentGeneric' :: FilePath -> Annex Bool -> Annex Bool+checkPresentGeneric' d check = ifM check+	( return True+	, ifM (liftIO $ doesDirectoryExist d)+		( return False+		, giveup $ "directory " ++ d ++ " is not accessible" 		)+	)  storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool storeExportM d src _k loc p = liftIO $ catchBoolIO $ do@@ -265,13 +279,15 @@ checkPresentExportM d _k loc = 	checkPresentGeneric d [exportPath d loc] -renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex Bool-renameExportM d _k oldloc newloc = liftIO $ catchBoolIO $ do-	createDirectoryIfMissing True (takeDirectory dest)-	renameFile src dest-	removeExportLocation d oldloc-	return True+renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)+renameExportM d _k oldloc newloc = liftIO $ Just <$> go   where+	go = catchBoolIO $ do+		createDirectoryIfMissing True (takeDirectory dest)+		renameFile src dest+		removeExportLocation d oldloc+		return True+	 	src = exportPath d oldloc 	dest = exportPath d newloc @@ -288,3 +304,157 @@ 	go Nothing _ = return () 	go (Just loc') _ = go (upFrom loc') 		=<< tryIO (removeDirectory $ exportPath topdir (mkExportLocation loc'))++listImportableContentsM :: FilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))+listImportableContentsM dir = catchMaybeIO $ liftIO $ do+	l <- dirContentsRecursive dir+	l' <- mapM go l+	return $ ImportableContents (catMaybes l') []+  where+	go f = do+		st <- getFileStatus f+		mkContentIdentifier f st >>= \case+			Nothing -> return Nothing+			Just cid -> do+				relf <- relPathDirToFile dir f+				sz <- getFileSize' f st+				return $ Just (mkImportLocation relf, (cid, sz))++-- Make a ContentIdentifier that contains an InodeCache.+--+-- The InodeCache is generated without checking a sentinal file.+-- So in a case when a remount etc causes all the inodes to change,+-- files may appear to be modified when they are not, which will only+-- result in extra work to re-import them.+--+-- If the file is not a regular file, this will return Nothing.+mkContentIdentifier :: FilePath -> FileStatus -> IO (Maybe ContentIdentifier)+mkContentIdentifier f st =+	fmap (ContentIdentifier . encodeBS . showInodeCache)+		<$> toInodeCache noTSDelta f st++retrieveExportWithContentIdentifierM :: FilePath -> ExportLocation -> ContentIdentifier -> FilePath -> Annex (Maybe Key) -> MeterUpdate -> Annex (Maybe Key)+retrieveExportWithContentIdentifierM dir loc cid dest mkkey p = +	catchDefaultIO Nothing $ precheck $ docopy postcheck+  where+	f = exportPath dir loc++	docopy cont = do+#ifndef mingw32_HOST_OS+		-- Need a duplicate fd for the post check, since+		-- hGetContentsMetered closes its handle.+		fd <- liftIO $ openFd f ReadOnly Nothing defaultFileFlags+		dupfd <- liftIO $ dup fd+		h <- liftIO $ fdToHandle fd+#else+		h <- liftIO $ openBinaryFile f ReadMode+#endif+		liftIO $ hGetContentsMetered h p >>= L.writeFile dest+		k <- mkkey+#ifndef mingw32_HOST_OS+		cont dupfd (return k)+#else+		cont (return k)+#endif+	+	-- Check before copy, to avoid expensive copy of wrong file+	-- content.+	precheck cont = comparecid cont+		=<< liftIO . mkContentIdentifier f+		=<< liftIO (getFileStatus f)++	-- Check after copy, in case the file was changed while it was+	-- being copied.+	--+	-- When possible (not on Windows), check the same handle+	-- Check the same handle that the file was copied from.+	-- Avoids some race cases where the file is modified while+	-- it's copied but then gets restored to the original content+	-- afterwards.+	--+	-- This does not guard against every possible race, but neither+	-- can InodeCaches detect every possible modification to a file.+	-- It's probably as good or better than git's handling of similar+	-- situations with files being modified while it's updating the+	-- working tree for a merge.+#ifndef mingw32_HOST_OS+	postcheck fd cont = do+#else+	postcheck cont = do+#endif+		currcid <- liftIO $ mkContentIdentifier f+#ifndef mingw32_HOST_OS+			=<< getFdStatus fd+#else+			=<< getFileStatus f+#endif+		comparecid cont currcid+	+	comparecid cont currcid+		| currcid == Just cid = cont+		| otherwise = return Nothing++storeExportWithContentIdentifierM :: FilePath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Maybe ContentIdentifier)+storeExportWithContentIdentifierM dir src _k loc overwritablecids p =+	catchDefaultIO Nothing $ do+		liftIO $ createDirectoryIfMissing True destdir+		withTmpFileIn destdir template $ \tmpf tmph -> do+			liftIO $ withMeteredFile src p (L.hPut tmph)+			liftIO $ hFlush tmph+			liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf >>= \case+				Nothing -> return Nothing+				Just newcid ->+					checkExportContent dir loc (newcid:overwritablecids) Nothing $ const $ do+						liftIO $ rename tmpf dest+						return (Just newcid)+  where+	dest = exportPath dir loc+	(destdir, base) = splitFileName dest+	template = relatedTemplate (base ++ ".tmp")++removeExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool+removeExportWithContentIdentifierM dir k loc removeablecids =+	checkExportContent dir loc removeablecids False $ \case+		DoesNotExist -> return True+		KnownContentIdentifier -> removeExportM dir k loc++checkPresentExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool+checkPresentExportWithContentIdentifierM dir _k loc knowncids =+	checkPresentGeneric' dir $+		checkExportContent dir loc knowncids False $ \case+			DoesNotExist -> return False+			KnownContentIdentifier -> return True++data CheckResult = DoesNotExist | KnownContentIdentifier++-- Checks if the content at an ExportLocation is in the knowncids,+-- and only runs the callback that modifies it if it's safe to do so.+--+-- This should avoid races to the extent possible. However,+-- if something has the file open for write, it could write to the handle+-- after the callback has overwritten or deleted it, and its write would+-- be lost, and we don't need to detect that.+-- (In similar situations, git doesn't either!) +--+-- It follows that if something is written to the destination file+-- shortly before, it's acceptable to run the callback anyway, as that's+-- nearly indistinguishable from the above case.+--+-- So, it suffices to check if the destination file's current+-- content is known, and immediately run the callback.+checkExportContent :: FilePath -> ExportLocation -> [ContentIdentifier] -> a -> (CheckResult -> Annex a) -> Annex a+checkExportContent dir loc knowncids unsafe callback = +	tryWhenExists (liftIO $ getFileStatus dest) >>= \case+		Just destst+			| not (isRegularFile destst) -> return unsafe+			| otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier dest destst) >>= \case+				Just destcid+					| destcid `elem` knowncids -> callback KnownContentIdentifier+					-- dest exists with other content+					| otherwise -> return unsafe+				-- should never happen+				Nothing -> return unsafe+		-- dest does not exist+		Nothing -> callback DoesNotExist+  where+	dest = exportPath dir loc

Remote/Directory/LegacyChunked.hs view

@@ -4,7 +4,7 @@  -  - Copyright 2011-2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.Directory.LegacyChunked where

Remote/External.hs view

@@ -19,8 +19,7 @@ import Git.Config (isTrue, boolConfig) import Git.Env import Remote.Helper.Special-import Remote.Helper.Export-import Annex.Export+import Remote.Helper.ExportImport import Remote.Helper.ReadOnly import Remote.Helper.Messages import Utility.Metered@@ -48,6 +47,7 @@ 	, generate = gen 	, setup = externalSetup 	, exportSupported = checkExportSupported+	, importSupported = importUnsupported 	}  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)@@ -119,6 +119,7 @@ 			, checkPresent = checkPresentDummy 			, checkPresentCheap = False 			, exportActions = exportactions+			, importActions = importUnsupported 			, whereisKey = towhereis 			, remoteFsck = Nothing 			, repairRepo = Nothing@@ -306,25 +307,28 @@   where 	req = REMOVEEXPORTDIRECTORY dir -renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex Bool-renameExportM external k src dest = safely $+renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)+renameExportM external k src dest = safely' (Just False) $ 	handleRequestExport external src req k Nothing $ \resp -> case resp of 		RENAMEEXPORT_SUCCESS k'-			| k' == k -> result True+			| k' == k -> result (Just True) 		RENAMEEXPORT_FAILURE k' -			| k' == k -> result False-		UNSUPPORTED_REQUEST -> result False+			| k' == k -> result (Just False)+		UNSUPPORTED_REQUEST -> result Nothing 		_ -> Nothing   where 	req sk = RENAMEEXPORT sk dest  safely :: Annex Bool -> Annex Bool-safely a = go =<< tryNonAsync a+safely = safely' False++safely' :: a -> Annex a -> Annex a+safely' onerr a = go =<< tryNonAsync a   where 	go (Right r) = return r 	go (Left e) = do 		toplevelWarning False (show e)-		return False+		return onerr  {- Sends a Request to the external remote, and waits for it to generate  - a Response. That is fed into the responsehandler, which should return

Remote/GCrypt.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2013 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.GCrypt (@@ -38,7 +38,7 @@ import Remote.Helper.Encryptable import Remote.Helper.Special import Remote.Helper.Messages-import Remote.Helper.Export+import Remote.Helper.ExportImport import qualified Remote.Helper.Ssh as Ssh import Utility.Metered import Annex.UUID@@ -61,6 +61,7 @@ 	, generate = gen 	, setup = gCryptSetup 	, exportSupported = exportUnsupported+	, importSupported = importUnsupported 	}  chainGen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)@@ -119,6 +120,7 @@ 		, checkPresent = checkPresentDummy 		, checkPresentCheap = repoCheap r 		, exportActions = exportUnsupported+		, importActions = importUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairRepo = Nothing

Remote/Git.hs view

@@ -48,7 +48,7 @@ import Utility.SimpleProtocol import Remote.Helper.Git import Remote.Helper.Messages-import Remote.Helper.Export+import Remote.Helper.ExportImport import qualified Remote.Helper.Ssh as Ssh import qualified Remote.GCrypt import qualified Remote.P2P@@ -72,6 +72,7 @@ 	, generate = gen 	, setup = gitSetup 	, exportSupported = exportUnsupported+	, importSupported = importUnsupported 	}  list :: Bool -> Annex [Git.Repo]@@ -165,6 +166,7 @@ 			, checkPresent = inAnnex new st 			, checkPresentCheap = repoCheap r 			, exportActions = exportUnsupported+			, importActions = importUnsupported 			, whereisKey = Nothing 			, remoteFsck = if Git.repoIsUrl r 				then Nothing

Remote/Glacier.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.Glacier (remote, jobList, checkSaneGlacierCommand) where@@ -18,7 +18,7 @@ import Config.Cost import Remote.Helper.Special import Remote.Helper.Messages-import Remote.Helper.Export+import Remote.Helper.ExportImport import qualified Remote.Helper.AWS as AWS import Creds import Utility.Metered@@ -36,6 +36,7 @@ 	, generate = gen 	, setup = glacierSetup 	, exportSupported = exportUnsupported+	, importSupported = importUnsupported 	}  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)@@ -65,6 +66,7 @@ 			, checkPresent = checkPresentDummy 			, checkPresentCheap = False 			, exportActions = exportUnsupported+			, importActions = importUnsupported 			, whereisKey = Nothing 			, remoteFsck = Nothing 			, repairRepo = Nothing

Remote/Helper/AWS.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011-2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings #-}

Remote/Helper/Chunked.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2014 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.Helper.Chunked (

Remote/Helper/Chunked/Legacy.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2012 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.Helper.Chunked.Legacy where

Remote/Helper/Encryptable.hs view

@@ -2,7 +2,7 @@  -  - Copyright 2011 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU GPL version 3 or higher.+ - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.Helper.Encryptable (

− Remote/Helper/Export.hs

file too large to diff

+ Remote/Helper/ExportImport.hs view

file too large to diff

Remote/Helper/Git.hs view

file too large to diff

Remote/Helper/Hooks.hs view

file too large to diff

Remote/Helper/Http.hs view

file too large to diff

Remote/Helper/Messages.hs view

file too large to diff

Remote/Helper/P2P.hs view

file too large to diff

Remote/Helper/ReadOnly.hs view

file too large to diff

Remote/Helper/Special.hs view

file too large to diff

Remote/Hook.hs view

file too large to diff

Remote/List.hs view

file too large to diff

Remote/P2P.hs view

file too large to diff

Remote/Rsync.hs view

file too large to diff

Remote/Rsync/RsyncUrl.hs view

file too large to diff

Remote/S3.hs view

file too large to diff

Remote/Tahoe.hs view

file too large to diff

Remote/Web.hs view

file too large to diff

Remote/WebDAV.hs view

file too large to diff

Remote/WebDAV/DavLocation.hs view

file too large to diff

RemoteDaemon/Common.hs view

file too large to diff

RemoteDaemon/Core.hs view

file too large to diff

RemoteDaemon/Transport.hs view

file too large to diff

RemoteDaemon/Transport/GCrypt.hs view

file too large to diff

RemoteDaemon/Transport/Ssh.hs view

file too large to diff

RemoteDaemon/Transport/Ssh/Types.hs view

file too large to diff

RemoteDaemon/Transport/Tor.hs view

file too large to diff

RemoteDaemon/Types.hs view

file too large to diff

Test.hs view

file too large to diff

Test/Framework.hs view

file too large to diff

Types.hs view

file too large to diff

Types/ActionItem.hs view

file too large to diff

Types/Availability.hs view

file too large to diff

Types/Backend.hs view

file too large to diff

Types/Benchmark.hs view

file too large to diff

Types/BranchState.hs view

file too large to diff

Types/CleanupActions.hs view

file too large to diff

Types/Command.hs view

file too large to diff

Types/Concurrency.hs view

file too large to diff

Types/Creds.hs view

file too large to diff

Types/Crypto.hs view

file too large to diff

Types/DeferredParse.hs view

file too large to diff

Types/DesktopNotify.hs view

file too large to diff

Types/Difference.hs view

file too large to diff

Types/Distribution.hs view

file too large to diff

Types/Export.hs view

file too large to diff

Types/FileMatcher.hs view

file too large to diff

Types/GitConfig.hs view

file too large to diff

Types/Group.hs view

file too large to diff

+ Types/Import.hs view

file too large to diff

Types/Key.hs view

file too large to diff

Types/KeySource.hs view

file too large to diff

Types/LockCache.hs view

file too large to diff

Types/Messages.hs view

file too large to diff

Types/MetaData.hs view

file too large to diff

Types/NumCopies.hs view

file too large to diff

Types/RefSpec.hs view

file too large to diff

Types/Remote.hs view

file too large to diff

Types/ScheduledActivity.hs view

file too large to diff

Types/StandardGroups.hs view

file too large to diff

Types/StoreRetrieve.hs view

file too large to diff

Types/Test.hs view

file too large to diff

Types/Transfer.hs view

file too large to diff

Types/TrustLevel.hs view

file too large to diff

Types/UUID.hs view

file too large to diff

Types/UrlContents.hs view

file too large to diff

Types/View.hs view

file too large to diff

Upgrade.hs view

file too large to diff

Upgrade/V0.hs view

file too large to diff

Upgrade/V1.hs view

file too large to diff

Upgrade/V2.hs view

file too large to diff

Upgrade/V3.hs view

file too large to diff

Upgrade/V4.hs view

file too large to diff

Upgrade/V5.hs view

file too large to diff

Utility/QuickCheck.hs view

file too large to diff

Utility/Tmp.hs view

file too large to diff

Utility/Tor.hs view

file too large to diff

Utility/Yesod.hs view

file too large to diff

doc/git-annex-export.mdwn view

file too large to diff

doc/git-annex-import.mdwn view

file too large to diff

doc/git-annex-sync.mdwn view

file too large to diff

doc/git-annex.mdwn view

file too large to diff

git-annex.cabal view

file too large to diff

git-annex.hs view

file too large to diff

stack.yaml view

file too large to diff