packages feed

git-annex 6.20170101 → 6.20170214

raw patch · 97 files changed

+853/−306 lines, 97 files

Files

Annex/Branch.hs view
@@ -233,7 +233,7 @@ getRef :: Ref -> FilePath -> Annex String getRef ref file = withIndex $ decodeBS <$> catFile ref file -{- Applies a function to modifiy the content of a file.+{- Applies a function to modify the content of a file.  -  - Note that this does not cause the branch to be merged, it only  - modifes the current content of the file on the branch.@@ -574,7 +574,7 @@ 		<$> catFile ref differenceLog 	mydiffs <- annexDifferences <$> Annex.getGitConfig 	when (theirdiffs /= mydiffs) $-		giveup "Remote repository is tuned in incompatable way; cannot be merged with local repository."+		giveup "Remote repository is tuned in incompatible way; cannot be merged with local repository."  ignoreRefs :: [Git.Sha] -> Annex () ignoreRefs rs = do
Annex/Direct.hs view
@@ -441,7 +441,7 @@  - this way things that show HEAD (eg shell prompts) will  - hopefully show just "master". -} directBranch :: Ref -> Ref-directBranch orighead = case split "/" $ fromRef orighead of+directBranch orighead = case splitc '/' $ fromRef orighead of 	("refs":"heads":"annex":"direct":_) -> orighead 	("refs":"heads":rest) -> 		Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest@@ -452,7 +452,7 @@  - Any other ref is left unchanged.  -} fromDirectBranch :: Ref -> Ref-fromDirectBranch directhead = case split "/" $ fromRef directhead of+fromDirectBranch directhead = case splitc '/' $ fromRef directhead of 	("refs":"heads":"annex":"direct":rest) ->  		Ref $ "refs/heads/" ++ intercalate "/" rest 	_ -> directhead
Annex/Ingest.hs view
@@ -1,6 +1,6 @@ {- git-annex content ingestion  -- - Copyright 2010-2016 Joey Hess <id@joeyh.name>+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -10,6 +10,7 @@ 	LockDownConfig(..), 	lockDown, 	ingestAdd,+	ingestAdd', 	ingest, 	ingest', 	finishIngestDirect,@@ -116,10 +117,13 @@ {- Ingests a locked down file into the annex. Updates the work tree and  - index. -} ingestAdd :: Maybe LockedDown -> Annex (Maybe Key)-ingestAdd Nothing = return Nothing-ingestAdd ld@(Just (LockedDown cfg source)) = do-	(mk, mic) <- ingest ld-	case mk of+ingestAdd ld = ingestAdd' ld Nothing++ingestAdd' :: Maybe LockedDown -> Maybe Key -> Annex (Maybe Key)+ingestAdd' Nothing _ = return Nothing+ingestAdd' ld@(Just (LockedDown cfg source)) mk = do+	(mk', mic) <- ingest ld mk+	case mk' of 		Nothing -> return Nothing 		Just k -> do 			let f = keyFilename source@@ -140,14 +144,17 @@ {- Ingests a locked down file into the annex. Does not update the working  - tree or the index.  -}-ingest :: Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache)+ingest :: Maybe LockedDown -> Maybe Key -> Annex (Maybe Key, Maybe InodeCache) ingest = ingest' Nothing -ingest' :: Maybe Backend -> Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache)-ingest' _ Nothing = return (Nothing, Nothing)-ingest' preferredbackend (Just (LockedDown cfg source)) = withTSDelta $ \delta -> do-	backend <- maybe (chooseBackend $ keyFilename source) (return . Just) preferredbackend-	k <- genKey source backend+ingest' :: Maybe Backend -> Maybe LockedDown -> Maybe Key -> Annex (Maybe Key, Maybe InodeCache)+ingest' _ Nothing _ = return (Nothing, Nothing)+ingest' preferredbackend (Just (LockedDown cfg source)) mk = withTSDelta $ \delta -> do+	k <- case mk of+		Nothing -> do+			backend <- maybe (chooseBackend $ keyFilename source) (return . Just) preferredbackend+			fmap fst <$> genKey source backend+		Just k -> return (Just k) 	let src = contentLocation source 	ms <- liftIO $ catchMaybeIO $ getFileStatus src 	mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta src) ms@@ -156,7 +163,7 @@ 		(Just newc, Just c) | compareStrong c newc -> go k mcache ms 		_ -> failure "changed while it was being added"   where-	go (Just (key, _)) mcache (Just s)+	go (Just key) mcache (Just s) 		| lockingFile cfg = golocked key mcache s 		| otherwise = ifM isDirect 			( godirect key mcache s
Annex/Init.hs view
@@ -119,7 +119,7 @@  {- Will automatically initialize if there is already a git-annex  - branch from somewhere. Otherwise, require a manual init- - to avoid git-annex accidentially being run in git+ - to avoid git-annex accidentally being run in git  - repos that did not intend to use it.  -  - Checks repository version and handles upgrades too.
Annex/Perms.hs view
@@ -148,7 +148,7 @@ 	)  {- Blocks writing to the directory an annexed file is in, to prevent the- - file accidentially being deleted. However, if core.sharedRepository+ - file accidentally being deleted. However, if core.sharedRepository  - is set, this is not done, since the group must be allowed to delete the  - file.  -}
Annex/SpecialRemote.hs view
@@ -9,7 +9,7 @@  import Annex.Common import Remote (remoteTypes, remoteMap)-import Types.Remote (RemoteConfig, RemoteConfigKey, typename, setup)+import Types.Remote (RemoteConfig, RemoteConfigKey, SetupStage(..), typename, setup) import Logs.Remote import Logs.Trust import qualified Git.Config@@ -79,7 +79,7 @@ 		case (M.lookup nameKey c, findType c) of 			(Just name, Right t) -> whenM (canenable u) $ do 				showSideAction $ "Auto enabling special remote " ++ name-				res <- tryNonAsync $ setup t (Just u) Nothing c def+				res <- tryNonAsync $ setup t Enable (Just u) Nothing c def 				case res of 					Left e -> warning (show e) 					Right _ -> return ()
Annex/TaggedPush.hs view
@@ -39,7 +39,7 @@ 	]  fromTaggedBranch :: Git.Branch -> Maybe (UUID, Maybe String)-fromTaggedBranch b = case split "/" $ Git.fromRef b of+fromTaggedBranch b = case splitc '/' $ Git.fromRef b of 	("refs":"synced":u:info:_base) -> 		Just (toUUID u, fromB64Maybe info) 	("refs":"synced":u:_base) ->
Assistant/MakeRemote.hs view
@@ -49,9 +49,9 @@ 	go =<< Annex.SpecialRemote.findExisting name   where 	go Nothing = setupSpecialRemote name Rsync.remote config Nothing-		(Nothing, Annex.SpecialRemote.newConfig name)+		(Nothing, R.Init, Annex.SpecialRemote.newConfig name) 	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing-		(Just u, c)+		(Just u, R.Enable, c) 	config = M.fromList 		[ ("encryption", "shared") 		, ("rsyncurl", location)@@ -81,7 +81,7 @@ 		r <- Annex.SpecialRemote.findExisting fullname 		case r of 			Nothing -> setupSpecialRemote fullname remotetype config mcreds-				(Nothing, Annex.SpecialRemote.newConfig fullname)+				(Nothing, R.Init, Annex.SpecialRemote.newConfig fullname) 			Just _ -> go (n + 1)  {- Enables an existing special remote. -}@@ -90,19 +90,19 @@ 	r <- Annex.SpecialRemote.findExisting name 	case r of 		Nothing -> error $ "Cannot find a special remote named " ++ name-		Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, c)+		Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable, c) -setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName+setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Annex RemoteName setupSpecialRemote = setupSpecialRemote' True -setupSpecialRemote' :: Bool -> RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName-setupSpecialRemote' setdesc name remotetype config mcreds (mu, c) = do+setupSpecialRemote' :: Bool -> RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Annex RemoteName+setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) = do 	{- Currently, only 'weak' ciphers can be generated from the 	 - assistant, because otherwise GnuPG may block once the entropy 	 - pool is drained, and as of now there's no way to tell the user 	 - to perform IO actions to refill the pool. -} 	let weakc = M.insert "highRandomQuality" "false" $ M.union config c-	(c', u) <- R.setup remotetype mu mcreds weakc def+	(c', u) <- R.setup remotetype ss mu mcreds weakc def 	configSet u c' 	when setdesc $ 		whenM (isNothing . M.lookup u <$> uuidMap) $
Assistant/Ssh.hs view
@@ -383,7 +383,7 @@  {- Extracts the real hostname from a mangled ssh hostname. -} unMangleSshHostName :: String -> String-unMangleSshHostName h = case split "-" h of+unMangleSshHostName h = case splitc '-' h of 	("git":"annex":rest) -> unescape (intercalate "-" (beginning rest)) 	_ -> h   where
Assistant/Threads/Committer.hs view
@@ -322,7 +322,7 @@ 		doadd = sanitycheck ks $ do 			(mkey, mcache) <- liftAnnex $ do 				showStart "add" $ keyFilename ks-				ingest $ Just $ LockedDown lockdownconfig ks+				ingest (Just $ LockedDown lockdownconfig ks) Nothing 			maybe (failedingest change) (done change mcache $ keyFilename ks) mkey 	add _ _ = return Nothing 
Assistant/Threads/PairListener.hs view
@@ -49,8 +49,8 @@ 					debug ["ignoring message that looped back"] 					go reqs cache sock 				(_, _, False, _) -> do-					liftAnnex $ warning-						"illegal control characters in pairing message; ignoring"+					liftAnnex $ warning $+						"illegal control characters in pairing message; ignoring (" ++ show (pairMsgData m) ++ ")" 					go reqs cache sock 				-- PairReq starts a pairing process, so a 				-- new one is always heeded, even if
Assistant/Threads/Watcher.hs view
@@ -42,6 +42,7 @@ import Git.Types import Git.FilePath import Config+import Config.GitConfig import Utility.ThreadScheduler import Logs.Location import qualified Database.Keys@@ -83,7 +84,7 @@  watchThread :: NamedThread watchThread = namedThread "Watcher" $-	ifM (liftAnnex $ annexAutoCommit <$> Annex.getGitConfig)+	ifM (liftAnnex $ getGitConfigVal annexAutoCommit) 		( runWatcher 		, waitFor ResumeWatcher runWatcher 		)
Assistant/WebApp/Configurators/Edit.hs view
@@ -43,6 +43,7 @@ import Annex.UUID import Assistant.Ssh import Config+import Config.GitConfig  import qualified Data.Text as T import qualified Data.Map as M@@ -76,7 +77,7 @@  	syncable <- case mremote of 		Just r -> return $ remoteAnnexSync $ Remote.gitconfig r-		Nothing -> annexAutoCommit <$> Annex.getGitConfig+		Nothing -> getGitConfigVal annexAutoCommit  	return $ RepoConfig 		(T.pack $ maybe "here" Remote.name mremote)
Assistant/WebApp/RepoList.hs view
@@ -12,7 +12,6 @@ import Assistant.WebApp.Common import Assistant.DaemonStatus import Assistant.WebApp.Notifications-import qualified Annex import qualified Remote import qualified Types.Remote as Remote import Remote.List (remoteListRefresh)@@ -21,6 +20,7 @@ import Logs.Trust import Logs.Group import Config+import Config.GitConfig import Git.Remote import Assistant.Sync import Config.Cost@@ -152,7 +152,7 @@ 			if includeHere reposelector 				then do 					r <- RepoUUID <$> getUUID-					autocommit <- annexAutoCommit <$> Annex.getGitConfig+					autocommit <- getGitConfigVal annexAutoCommit 					let hereactions = if autocommit 						then mkSyncingRepoActions r 						else mkNotSyncingRepoActions r
Backend/Hash.hs view
@@ -103,7 +103,7 @@ 	es = filter (not . null) $ reverse $ 		take 2 $ map (filter validInExtension) $ 		takeWhile shortenough $-		reverse $ split "." $ takeExtensions f+		reverse $ splitc '.' $ takeExtensions f 	shortenough e = length e <= 4 -- long enough for "jpeg"  {- A key's checksum is checked during fsck. -}
Build/OSXMkLibs.hs view
@@ -25,6 +25,7 @@ import Utility.Path import Utility.Exception import Utility.Env+import Utility.Misc  import qualified Data.Map as M import qualified Data.Set as S@@ -95,7 +96,7 @@   where 	go Nothing = return l 	go (Just p) = fromMaybe l-		<$> firstM doesFileExist (map (</> f) (split ":" p))+		<$> firstM doesFileExist (map (</> f) (splitc ':' p)) 	f = takeFileName l  {- Expands any @rpath in the list of libraries.
CHANGELOG view
@@ -1,3 +1,62 @@+git-annex (6.20170214) unstable; urgency=medium++  * Increase default cost for p2p remotes from 200 to 1000.+    This makes git-annex prefer transferring data from special+    remotes when possible.+  * Remove -j short option for --json-progress; that option was already+    taken for --json.+  * vicfg: Include the numcopies configuation.+  * config: New command for storing configuration in the git-annex branch.+  * annex.autocommit can be configured via git-annex config, to control+    the default behavior in all clones of a repository.+  * New annex.synccontent config setting, which can be set to true to make+    git annex sync default to --content. This may become the default at+    some point in the future. As well as being configuable by git config,+    it can be configured by git-annex config to control the default+    behavior in all clones of a repository.+  * stack.yaml: Update to lts-7.18.+  * Some optimisations to string splitting code.+  * unused: When large files are checked right into git, avoid buffering+    their contents in memory.+  * unused: Improved memory use significantly when there are a lot+    of differences between branches.+  * Wormhole pairing will start to provide an appid to wormhole on+    2021-12-31. An appid can't be provided now because Debian stable is going+    to ship a older version of git-annex that does not provide an appid.+    Assumption is that by 2021-12-31, this version of git-annex will be+    shipped in a Debian stable release. If that turns out to not be the+    case, this change will need to be cherry-picked into the git-annex in+    Debian stable, or its wormhole pairing will break.+  * Fix build with aws 0.16. Thanks, aristidb.+  * assistant: Make --autostart --foreground wait for the children it+    starts. Before, the --foreground was ignored when autostarting.+  * initremote: When a uuid= parameter is passed, use the specified+    UUID for the new special remote, instead of generating a UUID.+    This can be useful in some situations, eg when the same data can be+    accessed via two different special remote backends.+  * import: Changed how --deduplicate, --skip-duplicates, and+    --clean-duplicates determine if a file is a duplicate.+    Before, only content known to be present somewhere was considered+    a duplicate. Now, any content that has been annexed before will be+    considered a duplicate, even if all annexed copies of the data have+    been lost.+    Note that --clean-duplicates and --deduplicate still check+    numcopies, so won't delete duplicate files unless there's an annexed+    copy.+  * import: --deduplicate and --skip-duplicates were implemented+    inneficiently; they unncessarily hashed each file twice. They have+    been improved to only hash once.+  * import: Added --reinject-duplicates.+  * Added git template directory to Linux standalone tarball and OSX+    app bundle.+  * Improve pid locking code to work on filesystems that don't support hard+    links.+  * S3: Fix check of uuid file stored in bucket, which was not working.+  * Work around sqlite's incorrect handling of umask when creating+    databases.++ -- Joey Hess <id@joeyh.name>  Tue, 14 Feb 2017 14:22:00 -0400+ git-annex (6.20170101) unstable; urgency=medium    * XMPP support has been removed from the assistant in this release.@@ -992,7 +1051,7 @@   * webapp: Support enabling known gitlab.com remotes.   * Fix rsync special remote to work when -Jn is used for concurrent     uploads.-  * The last release accidentially removed a number of options from the+  * The last release accidentally removed a number of options from the     copy command. (-J, file matching options, etc). These have been added     back.   * init: Detect when the filesystem is crippled such that it ignores@@ -1202,7 +1261,7 @@     (endpoint, port, storage class)   * S3: Let git annex enableremote be used, without trying to recreate     a bucket that should already exist.-  * S3: Fix incompatability with bucket names used by hS3; the aws library+  * S3: Fix incompatibility with bucket names used by hS3; the aws library     cannot handle upper-case bucket names. git-annex now converts them to     lower case automatically.   * import: Check for gitignored files before moving them into the tree.@@ -1599,7 +1658,7 @@    * Remove fixup code for bad bare repositories created by     versions 5.20131118 through 5.20131127. That fixup code would-    accidentially fire when --git-dir was incorrectly+    accidentally fire when --git-dir was incorrectly     pointed at the working tree of a git-annex repository,     possibly resulting in data loss. Closes: #768093   * Windows: Fix crash when user.name is not set in git config.@@ -3385,7 +3444,7 @@   * webapp: Has a page to view the log, accessed from the control menu.   * webapp: Fix crash adding removable drive that has an annex directory     in it that is not a git repository.-  * Deal with incompatability in gpg2, which caused prompts for encryption+  * Deal with incompatibility in gpg2, which caused prompts for encryption     passphrases rather than using the supplied --passphrase-fd.   * bugfix: Union merges involving two or more repositories could sometimes     result in data from one repository getting lost. This could result@@ -3485,7 +3544,7 @@     associated with a file.   * webapp: S3 and Glacier forms now have a select list of all     currently-supported AWS regions.-  * webdav: Avoid trying to set props, avoiding incompatability with+  * webdav: Avoid trying to set props, avoiding incompatibility with     livedrive.com. Needs DAV version 0.3.   * webapp: Prettify error display.   * webapp: Fix bad interaction between required fields and modals.@@ -4914,7 +4973,7 @@   * Note that git-annex 0.04 cannot transfer content from old repositories     that have not yet been upgraded.   * Annexed file contents are now made unwritable and put in unwriteable-    directories, to avoid them accidentially being removed or modified.+    directories, to avoid them accidentally being removed or modified.     (Thanks Josh Triplett for the idea.)   * Add build dep on libghc6-testpack-dev. Closes: #603016   * Avoid using runghc to run test suite as it is not available on all
CmdLine/GitAnnex.hs view
@@ -84,6 +84,7 @@ import qualified Command.Required import qualified Command.Schedule import qualified Command.Ungroup+import qualified Command.Config import qualified Command.Vicfg import qualified Command.Sync import qualified Command.Mirror@@ -158,6 +159,7 @@ 	, Command.Required.cmd 	, Command.Schedule.cmd 	, Command.Ungroup.cmd+	, Command.Config.cmd 	, Command.Vicfg.cmd 	, Command.LookupKey.cmd 	, Command.CalcKey.cmd
CmdLine/GitAnnex/Options.hs view
@@ -294,7 +294,7 @@  jsonProgressOption :: GlobalOption jsonProgressOption = globalFlag (Annex.setOutput (JSONOutput True))-	( long "json-progress" <> short 'j'+	( long "json-progress" 	<> help "include progress in JSON output" 	<> hidden 	)
Command/AddUrl.hs view
@@ -387,7 +387,7 @@ 		] 	frombits a = intercalate "/" $ a urlbits 	urlbits = map (truncateFilePath pathmax . sanitizeFilePath) $-		filter (not . null) $ split "/" fullurl+		filter (not . null) $ splitc '/' fullurl  urlString2file :: URLString -> Maybe Int -> Int -> FilePath urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of
Command/Assistant.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant  -- - Copyright 2012-2015 Joey Hess <id@joeyh.name>+ - Copyright 2012-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -16,6 +16,8 @@ import Utility.HumanTime import Assistant.Install +import Control.Concurrent.Async+ cmd :: Command cmd = dontCheck repoExists $ notBareRepo $ 	noRepo (startNoRepo <$$> optParser) $@@ -68,6 +70,7 @@ 	| autoStopOption o = autoStop 	| otherwise = giveup "Not in a git repository." +-- Does not return autoStart :: AssistantOptions -> IO () autoStart o = do 	dirs <- liftIO readAutoStartFile@@ -76,28 +79,47 @@ 		giveup $ "Nothing listed in " ++ f 	program <- programPath 	haveionice <- pure Build.SysConfig.ionice <&&> inPath "ionice"-	forM_ dirs $ \d -> do+	pids <- forM dirs $ \d -> do 		putStrLn $ "git-annex autostart in " ++ d-		ifM (catchBoolIO $ go haveionice program d)-			( putStrLn "ok"-			, putStrLn "failed"-			)+		mpid <- catchMaybeIO $ go haveionice program d+		if foregroundDaemonOption (daemonOptions o)+			then return mpid+			else do+				case mpid of+					Nothing -> putStrLn "failed"+					Just pid -> ifM (checkSuccessProcess pid)+						( putStrLn "ok"+						, putStrLn "failed"+						)+				return Nothing+	-- Wait for any foreground jobs to finish and propigate exit status.+	ifM (all (== True) <$> mapConcurrently checkSuccessProcess (catMaybes pids))+		( exitSuccess+		, exitFailure+		)   where 	go haveionice program dir = do 		setCurrentDirectory dir 		-- First stop any old daemon running in this directory, which 		-- might be a leftover from an old login session. Such a 		-- leftover might be left in an environment where it is-		-- unavble to use the ssh agent or other login session+		-- unable to use the ssh agent or other login session 		-- resources. 		void $ boolSystem program [Param "assistant", Param "--stop"]-		if haveionice-			then boolSystem "ionice" (Param "-c3" : Param program : baseparams)-			else boolSystem program baseparams+		(Nothing, Nothing, Nothing, pid) <- createProcess p+		return pid 	  where-		baseparams =-			[ Param "assistant"-			, Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) (startDelayOption o))+		p+			| haveionice = proc "ionice"+				(toCommand $ Param "-c3" : Param program : baseparams)+			| otherwise = proc program+				(toCommand baseparams)+		baseparams = catMaybes+			[ Just $ Param "assistant"+			, Just $ Param $ "--startdelay=" ++ fromDuration (fromMaybe (Duration 5) (startDelayOption o))+			, if foregroundDaemonOption (daemonOptions o)+				then Just $ Param "--foreground"+				else Nothing 			]  autoStop :: IO ()
+ Command/Config.hs view
@@ -0,0 +1,65 @@+{- git-annex command+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.Config where++import Command+import Logs.Config++cmd :: Command+cmd = command "config" SectionSetup "configuration stored in git-annex branch"+	paramNothing (seek <$$> optParser)++data Action+	= SetConfig ConfigName ConfigValue+	| GetConfig ConfigName+	| UnsetConfig ConfigName++type Name = String+type Value = String++optParser :: CmdParamsDesc -> Parser Action+optParser _ = setconfig <|> getconfig <|> unsetconfig+  where+	setconfig = SetConfig+		<$> strOption+			( long "set"+			<> help "set configuration"+			<> metavar paramName+			)+		<*> strArgument+			( metavar paramValue+			)+	getconfig = GetConfig <$> strOption+		( long "get"+		<> help "get configuration"+		<> metavar paramName+		)+	unsetconfig = UnsetConfig <$> strOption+		( long "unset"+		<> help "unset configuration"+		<> metavar paramName+		)++seek :: Action -> CommandSeek+seek (SetConfig name val) = commandAction $ do+	showStart name val+	next $ next $ do+		setGlobalConfig name val+		return True+seek (UnsetConfig name) = commandAction $ do+	showStart name "unset"+	next $ next $ do+		unsetGlobalConfig name+		return True+seek (GetConfig name) = commandAction $ do+	mv <- getGlobalConfig name+	case mv of+		Nothing -> stop+		Just v -> do+			liftIO $ putStrLn v+			stop
Command/Direct.hs view
@@ -26,7 +26,7 @@ start :: CommandStart start = ifM versionSupportsDirectMode 	( ifM isDirect ( stop , next perform )-	, giveup "Direct mode is not suppported by this repository version. Use git-annex unlock instead."+	, giveup "Direct mode is not supported by this repository version. Use git-annex unlock instead." 	)  perform :: CommandPerform
Command/EnableRemote.hs view
@@ -69,7 +69,7 @@  performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform performSpecialRemote t u c gc = do-	(c', u') <- R.setup t (Just u) Nothing c gc+	(c', u') <- R.setup t R.Enable (Just u) Nothing c gc 	next $ cleanupSpecialRemote u' c'  cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup
Command/Import.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2012-2013 Joey Hess <id@joeyh.name>+ - Copyright 2012-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -11,13 +11,17 @@ import qualified Git import qualified Annex import qualified Command.Add+import qualified Command.Reinject import Utility.CopyFile import Backend-import Remote import Types.KeySource import Annex.CheckIgnore import Annex.NumCopies import Annex.FileMatcher+import Annex.Ingest+import Annex.InodeSentinal+import Utility.InodeCache+import Logs.Location  cmd :: Command cmd = withGlobalOptions (jobsOption : jsonOption : fileMatchingOptions) $ notBareRepo $@@ -25,7 +29,7 @@ 		"move and add files from outside git working copy" 		paramPaths (seek <$$> optParser) -data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates+data DuplicateMode = Default | Duplicate | DeDuplicate | CleanDuplicates | SkipDuplicates | ReinjectDuplicates 	deriving (Eq)  data ImportOptions = ImportOptions@@ -54,8 +58,12 @@ 		) 	<|> flag' SkipDuplicates 		( long "skip-duplicates"-		<> help "import only new files"+		<> help "import only new files (do not delete source files)" 		)+	<|> flag' ReinjectDuplicates+		( long "reinject-duplicates"+		<> help "import new files, and reinject the content of files that were imported before"+		)  seek :: ImportOptions -> CommandSeek seek o = allowConcurrentOutput $ do@@ -70,12 +78,8 @@ start largematcher mode (srcfile, destfile) = 	ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile) 		( do-			ma <- pickaction-			case ma of-				Nothing -> stop-				Just a -> do-					showStart "import" destfile-					next a+			showStart "import" destfile+			next pickaction 		, stop 		)   where@@ -89,7 +93,10 @@ 				warning "Could not verify that the content is still present in the annex; not removing from the import location." 				stop 			)-	importfile = checkdestdir $ do+	reinject k = do+		showNote "reinjecting"+		Command.Reinject.perform srcfile k+	importfile ld k = checkdestdir $ do 		ignored <- not <$> Annex.getState Annex.force <&&> checkIgnored destfile 		if ignored 			then do@@ -98,14 +105,14 @@ 			else do 				existing <- liftIO (catchMaybeIO $ getSymbolicLinkStatus destfile) 				case existing of-					Nothing -> importfilechecked+					Nothing -> importfilechecked ld k 					Just s 						| isDirectory s -> notoverwriting "(is a directory)" 						| isSymbolicLink s -> notoverwriting "(is a symlink)" 						| otherwise -> ifM (Annex.getState Annex.force) 							( do 								liftIO $ nukeFile destfile-								importfilechecked+								importfilechecked ld k 							, notoverwriting "(use --force to override, or a duplication option such as --deduplicate to clean up)" 							) 	checkdestdir cont = do@@ -119,33 +126,77 @@ 					warning $ "not importing " ++ destfile ++ " because " ++ destdir ++ " is not a directory" 					stop -	importfilechecked = do+	importfilechecked ld k = do+		-- Move or copy the src file to the dest file.+		-- The dest file is what will be ingested. 		liftIO $ createDirectoryIfMissing True (parentDir destfile) 		liftIO $ if mode == Duplicate || mode == SkipDuplicates 			then void $ copyFileExternal CopyAllMetaData srcfile destfile 			else moveFile srcfile destfile+		-- Get the inode cache of the dest file. It should be+		-- weakly the same as the origianlly locked down file's+		-- inode cache. (Since the file may have been copied,+		-- its inodes may not be the same.)+		newcache <- withTSDelta $ liftIO . genInodeCache destfile+		let unchanged = case (newcache, inodeCache (keySource ld)) of+			(_, Nothing) -> True+			(Just newc, Just c) | compareWeak c newc -> True+			_ -> False+		unless unchanged $+			giveup "changed while it was being added"+		-- The LockedDown needs to be adjusted, since the destfile+		-- is what will be ingested.+		let ld' = ld+			{ keySource = KeySource+				{ keyFilename = destfile+				, contentLocation = destfile+				, inodeCache = newcache+				}+			} 		ifM (checkFileMatcher largematcher destfile)-			( Command.Add.perform destfile+			( ingestAdd' (Just ld') (Just k)+				>>= maybe+					stop+					(\addedk -> next $ Command.Add.cleanup addedk True) 			, next $ Command.Add.addSmall destfile  			) 	notoverwriting why = do 		warning $ "not overwriting existing " ++ destfile ++ " " ++ why 		stop-	checkdup dupa notdupa = do-		backend <- chooseBackend destfile-		let ks = KeySource srcfile srcfile Nothing-		v <- genKey ks backend+	lockdown a = do+		lockingfile <- not <$> addUnlocked+		-- Minimal lock down with no hard linking so nothing+		-- has to be done to clean up from it.+		let cfg = LockDownConfig+			{ lockingFile = lockingfile+			, hardlinkFileTmp = False+			}+		v <- lockDown cfg srcfile 		case v of-			Just (k, _) -> ifM (not . null <$> keyLocations k)-				( return (maybe Nothing (\a -> Just (a k)) dupa)-				, return notdupa-				)-			_ -> return notdupa-	pickaction = case mode of-		DeDuplicate -> checkdup (Just deletedup) (Just importfile)-		CleanDuplicates -> checkdup (Just deletedup) Nothing-		SkipDuplicates -> checkdup Nothing (Just importfile)-		_ -> return (Just importfile)+			Just ld -> do+				backend <- chooseBackend destfile+				v' <- genKey (keySource ld) backend+				case v' of+					Just (k, _) -> a (ld, k)+					Nothing -> giveup "failed to generate a key"+			Nothing -> stop+	checkdup k dupa notdupa = ifM (isKnownKey k)+		( dupa+		, notdupa+		)+	pickaction = lockdown $ \(ld, k) -> case mode of+		DeDuplicate -> checkdup k (deletedup k) (importfile ld k)+		CleanDuplicates -> checkdup k+			(deletedup k)+			(skipbecause "not duplicate")+		SkipDuplicates -> checkdup k +			(skipbecause "duplicate")+			(importfile ld k)+		ReinjectDuplicates -> checkdup k+			(reinject k)+			(importfile ld k)+		_ -> importfile ld k+	skipbecause s = showNote (s ++ "; skipping") >> next (return True)  verifyExisting :: Key -> FilePath -> (CommandPerform, CommandPerform) -> CommandPerform verifyExisting key destfile (yes, no) = do
Command/InitRemote.hs view
@@ -46,8 +46,14 @@  perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform perform t name c = do-	(c', u) <- R.setup t Nothing Nothing c def+	(c', u) <- R.setup t R.Init cu Nothing c def 	next $ cleanup u name c'+  where+	cu = case M.lookup "uuid" c of+		Just s+			| isUUID s -> Just (toUUID s)+			| otherwise -> giveup "invalid uuid"+		Nothing -> Nothing  cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup cleanup u name c = do
Command/Map.hs view
@@ -92,7 +92,7 @@ 	| otherwise = "localhost"  basehostname :: Git.Repo -> String-basehostname r = fromMaybe "" $ headMaybe $ split "." $ hostname r+basehostname r = fromMaybe "" $ headMaybe $ splitc '.' $ hostname r  {- A name to display for a repo. Uses the name from uuid.log if available,  - or the remote name if not. -}
Command/P2P.hs view
@@ -26,6 +26,7 @@  import Control.Concurrent.Async import qualified Data.Text as T+import Data.Time.Clock.POSIX  cmd :: Command cmd = command "p2p" SectionSetup@@ -224,10 +225,32 @@ 		observer <- liftIO Wormhole.mkCodeObserver 		producer <- liftIO Wormhole.mkCodeProducer 		void $ liftIO $ async $ ui observer producer+		-- Provide an appid to magic wormhole, to avoid using+		-- the same channels that other wormhole users use.+		--+		-- Since a version of git-annex that did not provide an+		-- appid is shipping in Debian 9, and having one side+		-- provide an appid while the other does not will make+		-- wormhole fail, this is deferred until 2021-12-31.+		-- After that point, all git-annex's should have been+		-- upgraded to include this code, and they will start+		-- providing an appid.+		--+		-- This assumes reasonably good client clocks. If the clock+		-- is completely wrong, it won't use the appid at that+		-- point, and pairing will fail. On 2021-12-31, minor clock+		-- skew may also cause transient problems.+		--+		-- After 2021-12-31, this can be changed to simply+		-- always provide the appid.+		now <- liftIO getPOSIXTime+		let wormholeparams = if now < 1640950000+			then []+			else Wormhole.appId "git-annex.branchable.com/p2p-setup" 		(sendres, recvres) <- liftIO $-			Wormhole.sendFile sendf observer []+			Wormhole.sendFile sendf observer wormholeparams 				`concurrently`-			Wormhole.receiveFile recvf producer []+			Wormhole.receiveFile recvf producer wormholeparams 		liftIO $ nukeFile sendf 		if sendres /= True 			then return SendFailed
Command/Reinject.hs view
@@ -43,9 +43,12 @@ 	| src == dest = stop 	| otherwise = notAnnexed src $ do 		showStart "reinject" dest-		next $ ifAnnexed dest-			(\key -> perform src key (verifyKeyContent DefaultVerify UnVerified key src))-			stop+		next $ ifAnnexed dest go stop+  where+	go key = ifM (verifyKeyContent DefaultVerify UnVerified key src)+		( perform src key+		, error "failed"+		) startSrcDest _ = giveup "specify a src file and a dest file"  startKnown :: FilePath -> CommandStart@@ -55,7 +58,7 @@ 	case mkb of 		Nothing -> error "Failed to generate key" 		Just (key, _) -> ifM (isKnownKey key)-			( next $ perform src key (return True)+			( next $ perform src key 			, do 				warning "Not known content; skipping" 				next $ next $ return True@@ -65,19 +68,15 @@ notAnnexed src = ifAnnexed src $ 	giveup $ "cannot used annexed file as src: " ++ src -perform :: FilePath -> Key -> Annex Bool -> CommandPerform-perform src key verify = ifM move+perform :: FilePath -> Key -> CommandPerform+perform src key = ifM move 	( next $ cleanup key 	, error "failed" 	)   where-	move = checkDiskSpaceToGet key False $-		ifM verify-			( do-				moveAnnex key src-				return True-			, return False-			)+	move = checkDiskSpaceToGet key False $ do+		moveAnnex key src+		return True  cleanup :: Key -> CommandCleanup cleanup key = do
Command/Smudge.hs view
@@ -88,7 +88,7 @@ 					<$> catKeyFile file 				liftIO . emitPointer 					=<< go-					=<< ingest' currbackend+					=<< (\ld -> ingest' currbackend ld Nothing) 					=<< lockDown cfg file 			, liftIO $ B.hPut stdout b 			)
Command/Sync.hs view
@@ -39,6 +39,7 @@ import qualified Git import qualified Remote.Git import Config+import Config.GitConfig import Annex.Wanted import Annex.Content import Command.Get (getKey')@@ -65,10 +66,12 @@ data SyncOptions  = SyncOptions 	{ syncWith :: CmdParams 	, commitOption :: Bool+	, noCommitOption :: Bool 	, messageOption :: Maybe String 	, pullOption :: Bool 	, pushOption :: Bool 	, contentOption :: Bool+	, noContentOption :: Bool 	, keyOptions :: Maybe KeyOptions 	} @@ -78,9 +81,14 @@ 		( metavar desc 		<> completeRemotes 		))-	<*> invertableSwitch "commit" True-		( help "avoid git commit" +	<*> switch+		( long "commit"+		<> help "commit changes to git" 		)+	<*> switch+		( long "no-commit"+		<> help "avoid git commit" +		) 	<*> optional (strOption 		( long "message" <> short 'm' <> metavar "MSG" 		<> help "commit message"@@ -91,9 +99,14 @@ 	<*> invertableSwitch "push" True 		( help "avoid git pushes to remotes"  		)-	<*> invertableSwitch "content" False-		( help "also transfer file contents" +	<*> switch +		( long "content"+		<> help "transfer file contents"  		)+	<*> switch+		( long "no-content"+		<> help "do not transfer file contents"+		) 	<*> optional parseAllOption  seek :: SyncOptions -> CommandSeek@@ -117,22 +130,24 @@ 		, map (withbranch . pullRemote o mergeConfig) gitremotes 		,  [ mergeAnnex ] 		]-	when (contentOption o) $-		whenM (seekSyncContent o dataremotes) $-			-- Transferring content can take a while,-			-- and other changes can be pushed to the git-annex-			-- branch on the remotes in the meantime, so pull-			-- and merge again to avoid our push overwriting-			-- those changes.-			mapM_ includeCommandAction $ concat-				[ map (withbranch . pullRemote o mergeConfig) gitremotes-				, [ commitAnnex, mergeAnnex ]-				]+	whenM (shouldsynccontent <&&> seekSyncContent o dataremotes) $+		-- Transferring content can take a while,+		-- and other changes can be pushed to the git-annex+		-- branch on the remotes in the meantime, so pull+		-- and merge again to avoid our push overwriting+		-- those changes.+		mapM_ includeCommandAction $ concat+			[ map (withbranch . pullRemote o mergeConfig) gitremotes+			, [ commitAnnex, mergeAnnex ]+			] 	 	void $ includeCommandAction $ withbranch pushLocal 	-- Pushes to remotes can run concurrently. 	mapM_ (commandAction . withbranch . pushRemote o) gitremotes-	+  where+	shouldsynccontent = pure (contentOption o)+		<||> (pure (not (noContentOption o)) <&&> getGitConfigVal annexSyncContent)+ type CurrBranch = (Maybe Git.Branch, Maybe Adjustment)  {- There may not be a branch checked out until after the commit,@@ -237,7 +252,7 @@ 		)   where 	shouldcommit = pure (commitOption o)-		<&&> (annexAutoCommit <$> Annex.getGitConfig)+		<||> (pure (not (noCommitOption o)) <&&> getGitConfigVal annexAutoCommit)  commitMsg :: Annex String commitMsg = do
Command/Unannex.hs view
@@ -26,7 +26,7 @@ cmd :: Command cmd = withGlobalOptions annexedMatchingOptions $ 	command "unannex" SectionUtility-		"undo accidential add command"+		"undo accidental add command" 		paramPaths (withParams seek)  seek :: CmdParams -> CommandSeek
Command/Unused.hs view
@@ -25,7 +25,6 @@ import qualified Git.DiffTree as DiffTree import qualified Remote import qualified Annex.Branch-import Annex.Link import Annex.CatFile import Annex.WorkTree import Types.RefSpec@@ -269,11 +268,10 @@ 	forM_ ds go 	liftIO $ void clean   where-	go d = do+  	go d = do 		let sha = extractsha d 		unless (sha == nullSha) $-			(parseLinkOrPointer <$> catObject sha)-				>>= maybe noop a+			catKey sha >>= maybe noop a  {- Filters out keys that have an associated file that's not modified. -} associatedFilesFilter :: [Key] -> Annex [Key]
Command/Vicfg.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>+ - Copyright 2012-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -24,12 +24,15 @@ import Logs.Group import Logs.PreferredContent import Logs.Schedule+import Logs.Config+import Logs.NumCopies import Types.StandardGroups import Types.ScheduledActivity+import Types.NumCopies import Remote  cmd :: Command-cmd = command "vicfg" SectionSetup "edit git-annex's configuration"+cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch" 	paramNothing (withParams seek)  seek :: CmdParams -> CommandSeek@@ -66,6 +69,8 @@ 	, cfgRequiredContentMap :: M.Map UUID PreferredContentExpression 	, cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression 	, cfgScheduleMap :: M.Map UUID [ScheduledActivity]+	, cfgGlobalConfigs :: M.Map ConfigName ConfigValue+	, cfgNumCopies :: Maybe NumCopies 	}  getCfg :: Annex Cfg@@ -76,6 +81,8 @@ 	<*> requiredContentMapRaw 	<*> groupPreferredContentMapRaw 	<*> scheduleMap+	<*> loadGlobalConfig+	<*> getGlobalNumCopies  setCfg :: Cfg -> Cfg -> Annex () setCfg curcfg newcfg = do@@ -86,6 +93,8 @@ 	mapM_ (uncurry requiredContentSet) $ M.toList $ cfgRequiredContentMap diff 	mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff 	mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff+	mapM_ (uncurry setGlobalConfig) $ M.toList $ cfgGlobalConfigs diff+	maybe noop setGlobalNumCopies $ cfgNumCopies diff  {- Default config has all the keys from the input config, but with their  - default values. -}@@ -97,6 +106,8 @@ 	, cfgRequiredContentMap = mapdef $ cfgRequiredContentMap curcfg 	, cfgGroupPreferredContentMap = mapdef $ cfgGroupPreferredContentMap curcfg 	, cfgScheduleMap = mapdef $ cfgScheduleMap curcfg+	, cfgGlobalConfigs = mapdef $ cfgGlobalConfigs curcfg+	, cfgNumCopies = Nothing 	}   where 	mapdef :: forall k v. Default v => M.Map k v -> M.Map k v@@ -110,6 +121,8 @@ 	, cfgRequiredContentMap = diff cfgRequiredContentMap 	, cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap 	, cfgScheduleMap = diff cfgScheduleMap+	, cfgGlobalConfigs = diff cfgGlobalConfigs+	, cfgNumCopies = cfgNumCopies newcfg 	}   where 	diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)@@ -125,6 +138,8 @@ 	, standardgroups 	, requiredcontent 	, schedule+	, numcopies+	, globalconfigs 	]   where 	intro =@@ -197,10 +212,26 @@ 		(\(l, u) -> line "schedule" u $ fromScheduledActivities l) 		(\u -> line "schedule" u "") +	globalconfigs = settings' cfg S.empty cfgGlobalConfigs+		[ com "Other global configuration"+		]+		(\(s, g) -> gline g s)+		(\g -> gline g "")+	  where+		gline g val = [ unwords ["config", g, "=", val] ]+ 	line setting u val = 		[ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")" 		, unwords [setting, fromUUID u, "=", val] 		]++	line' setting Nothing = com $ unwords [setting, "default", "="]+	line' setting (Just val) = unwords [setting, "default", "=", val]++	numcopies =+		[ com "Numcopies configuration"+		, line' "numcopies" (show . fromNumCopies <$> cfgNumCopies cfg)+		] 	 settings :: Ord v => Cfg -> M.Map UUID String -> (Cfg -> M.Map UUID v) -> [String] -> ((v, UUID) -> [String]) -> (UUID -> [String]) -> [String] settings cfg descs = settings' cfg (M.keysSet descs)@@ -274,6 +305,12 @@ 			Right l ->  				let m = M.insert u l (cfgScheduleMap cfg) 				in Right $ cfg { cfgScheduleMap = m }+		| setting == "config" =+			let m = M.insert f val (cfgGlobalConfigs cfg)+			in Right $ cfg { cfgGlobalConfigs = m }+		| setting == "numcopies" = case readish val of+			Nothing -> Left "parse error (expected an integer)"+			Just n -> Right $ cfg { cfgNumCopies = Just (NumCopies n) } 		| otherwise = badval "setting" setting 	  where 		u = toUUID f
Config.hs view
@@ -1,6 +1,6 @@ {- Git configuration  -- - Copyright 2011-2014 Joey Hess <id@joeyh.name>+ - Copyright 2011-2017 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -24,7 +24,8 @@ instance Show ConfigKey where 	show (ConfigKey s) = s -{- Looks up a setting in git config. -}+{- Looks up a setting in git config. This is not as efficient as using the+ - GitConfig type. -} getConfig :: ConfigKey -> String -> Annex String getConfig (ConfigKey key) d = fromRepo $ Git.Config.get key d 
+ Config/GitConfig.hs view
@@ -0,0 +1,36 @@+{- git-annex configuration+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Config.GitConfig where++import Annex.Common+import qualified Annex+import Types.GitConfig+import Git.Types+import Logs.Config++{- Gets a specific setting from GitConfig. If necessary, loads the+ - repository-global defaults when the GitConfig does not yet + - have a value. -}+getGitConfigVal :: (GitConfig -> Configurable a) -> Annex a+getGitConfigVal f = do+	v <- f <$> Annex.getGitConfig+	case v of+		HasConfig c -> return c+		DefaultConfig _ -> do+			r <- Annex.gitRepo+			m <- loadGlobalConfig+			let globalgc = extractGitConfig (r { config = m })+			-- This merge of the repo-global config and the git+			-- config makes all repository-global default+			-- values populate the GitConfig with HasConfig+			-- values, so it will only need to be done once.+			Annex.changeGitConfig (\gc -> mergeGitConfig gc globalgc)+			v' <- f <$> Annex.getGitConfig+			case v' of+				HasConfig c -> return c+				DefaultConfig d -> return d
Crypto.hs view
@@ -231,8 +231,8 @@  		{- When the remote is configured to use public-key encryption, 		 - look up the recipient keys and add them to the option list. -} 		case M.lookup "encryption" c of-			Just "pubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "cipherkeys" c-			Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (split ",") $ M.lookup "pubkeys" c+			Just "pubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup "cipherkeys" c+			Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup "pubkeys" c 			_ -> [] 	getGpgDecParams (_c,gc) = map Param (remoteAnnexGnupgDecryptOptions gc) 
Database/Fsck.hs view
@@ -22,11 +22,10 @@  import Database.Types import qualified Database.Queue as H+import Database.Init import Annex.Locations-import Utility.PosixFiles import Utility.Exception import Annex.Common-import Annex.Perms import Annex.LockFile  import Database.Persist.TH@@ -61,17 +60,8 @@ 	dbdir <- fromRepo (gitAnnexFsckDbDir u) 	let db = dbdir </> "db" 	unlessM (liftIO $ doesFileExist db) $ do-		let tmpdbdir = dbdir ++ ".tmp"-		let tmpdb = tmpdbdir </> "db"-		liftIO $ do-			createDirectoryIfMissing True tmpdbdir-			H.initDb tmpdb $ void $-				runMigrationSilent migrateFsck-		setAnnexDirPerm tmpdbdir-		setAnnexFilePerm tmpdb-		liftIO $ do-			void $ tryIO $ removeDirectoryRecursive dbdir-			rename tmpdbdir dbdir+		initDb db $ void $+			runMigrationSilent migrateFsck 	lockFileCached =<< fromRepo (gitAnnexFsckDbLock u) 	h <- liftIO $ H.openDbQueue db "fscked" 	return $ FsckHandle h u
Database/Handle.hs view
@@ -9,7 +9,6 @@  module Database.Handle ( 	DbHandle,-	initDb, 	openDb, 	TableName, 	queryDb,@@ -37,26 +36,6 @@ {- A DbHandle is a reference to a worker thread that communicates with  - the database. It has a MVar which Jobs are submitted to. -} data DbHandle = DbHandle (Async ()) (MVar Job)--{- Ensures that the database is initialized. Pass the migration action for- - the database.- -- - The database is initialized using WAL mode, to prevent readers- - from blocking writers, and prevent a writer from blocking readers.- -}-initDb :: FilePath -> SqlPersistM () -> IO ()-initDb f migration = do-	let db = T.pack f-	enableWAL db-	runSqlite db migration--enableWAL :: T.Text -> IO ()-enableWAL db = do-	conn <- Sqlite.open db-	stmt <- Sqlite.prepare conn (T.pack "PRAGMA journal_mode=WAL;")-	void $ Sqlite.step stmt-	void $ Sqlite.finalize stmt-	Sqlite.close conn  {- Name of a table that should exist once the database is initialized. -} type TableName = String
+ Database/Init.hs view
@@ -0,0 +1,55 @@+{- Persistent sqlite database initialization+ -+ - Copyright 2015-2017 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Database.Init where++import Annex.Common+import Annex.Perms+import Utility.FileMode++import Database.Persist.Sqlite+import qualified Database.Sqlite as Sqlite+import Control.Monad.IO.Class (liftIO)+import qualified Data.Text as T++{- Ensures that the database is freshly initialized. Deletes any+ - existing database. Pass the migration action for the database.+ -+ - The database is initialized using WAL mode, to prevent readers+ - from blocking writers, and prevent a writer from blocking readers.+ -+ - The permissions of the database are set based on the+ - core.sharedRepository setting. Setting these permissions on the main db+ - file causes Sqlite to always use the same permissions for additional+ - files it writes later on+ -}+initDb :: FilePath -> SqlPersistM () -> Annex ()+initDb db migration = do+	let dbdir = takeDirectory db+	let tmpdbdir = dbdir ++ ".tmp"+	let tmpdb = tmpdbdir </> "db"+	liftIO $ do+		createDirectoryIfMissing True tmpdbdir+		let tdb = T.pack tmpdb+		enableWAL tdb+		runSqlite tdb migration+	setAnnexDirPerm tmpdbdir+	-- Work around sqlite bug that prevents it from honoring+	-- less restrictive umasks.+	liftIO $ setFileMode tmpdb =<< defaultFileMode+	setAnnexFilePerm tmpdb+	liftIO $ do+		void $ tryIO $ removeDirectoryRecursive dbdir+		rename tmpdbdir dbdir++enableWAL :: T.Text -> IO ()+enableWAL db = do+	conn <- Sqlite.open db+	stmt <- Sqlite.prepare conn (T.pack "PRAGMA journal_mode=WAL;")+	void $ Sqlite.step stmt+	void $ Sqlite.finalize stmt+	Sqlite.close conn
Database/Keys.hs view
@@ -25,11 +25,11 @@ import Database.Types import Database.Keys.Handle import qualified Database.Queue as H+import Database.Init import Annex.Locations import Annex.Common hiding (delete) import Annex.Version (versionUsesKeysDatabase) import qualified Annex-import Annex.Perms import Annex.LockFile import Utility.InodeCache import Annex.InodeSentinal@@ -120,11 +120,7 @@ 	case (dbexists, createdb) of 		(True, _) -> open db 		(False, True) -> do-			liftIO $ do-				createDirectoryIfMissing True dbdir-				H.initDb db SQL.createTables-			setAnnexDirPerm dbdir-			setAnnexFilePerm db+			initDb db SQL.createTables 			open db 		(False, False) -> return DbUnavailable   where
Database/Queue.hs view
@@ -9,7 +9,6 @@  module Database.Queue ( 	DbQueue,-	initDb, 	openDbQueue, 	queryDbQueue, 	closeDbQueue,
Git/Command.hs view
@@ -91,16 +91,16 @@ pipeNullSplit :: [CommandParam] -> Repo -> IO ([String], IO Bool) pipeNullSplit params repo = do 	(s, cleanup) <- pipeReadLazy params repo-	return (filter (not . null) $ split sep s, cleanup)+	return (filter (not . null) $ splitc sep s, cleanup)   where-	sep = "\0"+	sep = '\0'  pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [String] pipeNullSplitStrict params repo = do 	s <- pipeReadStrict params repo-	return $ filter (not . null) $ split sep s+	return $ filter (not . null) $ splitc sep s   where-	sep = "\0"+	sep = '\0'  pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [String] pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
Git/Config.hs view
@@ -132,7 +132,7 @@ 	-- --list output will have an = in the first line 	| all ('=' `elem`) (take 1 ls) = sep '=' ls 	-- --null --list output separates keys from values with newlines-	| otherwise = sep '\n' $ split "\0" s+	| otherwise = sep '\n' $ splitc '\0' s   where 	ls = lines s 	sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) .
Git/Construct.hs view
@@ -26,7 +26,7 @@ #ifndef mingw32_HOST_OS import System.Posix.User #endif-import qualified Data.Map as M hiding (map, split)+import qualified Data.Map as M import Network.URI  import Common@@ -143,7 +143,7 @@ remoteNamedFromKey k = remoteNamed basename   where 	basename = intercalate "." $ -		reverse $ drop 1 $ reverse $ drop 1 $ split "." k+		reverse $ drop 1 $ reverse $ drop 1 $ splitc '.' k  {- Constructs a new Repo for one of a Repo's remotes using a given  - location (ie, an url). -}
Git/DiffTree.hs view
@@ -89,7 +89,7 @@ getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool) getdiff command params repo = do 	(diff, cleanup) <- pipeNullSplit ps repo-	return (fromMaybe (error $ "git " ++ show (toCommand ps) ++ " parse failed") (parseDiffRaw diff), cleanup)+	return (parseDiffRaw diff, cleanup)   where 	ps =  		command :@@ -100,24 +100,23 @@ 		params  {- Parses --raw output used by diff-tree and git-log. -}-parseDiffRaw :: [String] -> Maybe [DiffTreeItem]-parseDiffRaw l = go l []+parseDiffRaw :: [String] -> [DiffTreeItem]+parseDiffRaw l = go l   where-	go [] c = Just c-	go (info:f:rest) c = case mk info f of-		Nothing -> Nothing-		Just i -> go rest (i:c)-	go (_:[]) _ = Nothing+	go [] = []+	go (info:f:rest) = mk info f : go rest+	go (s:[]) = error $ "diff-tree parse error near \"" ++ s ++ "\""  	mk info f = DiffTreeItem-		<$> readmode srcm-		<*> readmode dstm-		<*> extractSha ssha-		<*> extractSha dsha-		<*> pure s-		<*> pure (asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f)+		{ srcmode = readmode srcm+		, dstmode = readmode dstm+		, srcsha = fromMaybe (error "bad srcsha") $ extractSha ssha+		, dstsha = fromMaybe (error "bad dstsha") $ extractSha dsha+		, status = s+		, file = asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f+		} 	  where-		readmode = fst <$$> headMaybe . readOct+		readmode = fst . Prelude.head . readOct  		-- info = :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status> 		-- All fields are fixed, so we can pull them out of
Git/Ref.hs view
@@ -144,6 +144,6 @@ 	ends v = v `isSuffixOf` s 	begins v = v `isPrefixOf` s -	pathbits = split "/" s+	pathbits = splitc '/' s 	illegalchars = " ~^:?*[\\" ++ controlchars 	controlchars = chr 0o177 : [chr 0 .. chr (0o40-1)]
Limit.hs view
@@ -161,7 +161,7 @@ addCopies = addLimit . limitCopies  limitCopies :: MkLimit Annex-limitCopies want = case split ":" want of+limitCopies want = case splitc ':' want of 	[v, n] -> case parsetrustspec v of 		Just checker -> go n $ checktrust checker 		Nothing -> go n $ checkgroup v
Logs.hs view
@@ -63,6 +63,9 @@ numcopiesLog :: FilePath numcopiesLog = "numcopies.log" +configLog :: FilePath+configLog = "config.log"+ remoteLog :: FilePath remoteLog = "remote.log" 
+ Logs/Config.hs view
@@ -0,0 +1,55 @@+{- git-annex repository-global config log+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Logs.Config (+	ConfigName,+	ConfigValue,+	setGlobalConfig,+	unsetGlobalConfig,+	getGlobalConfig,+	loadGlobalConfig,+) where++import Annex.Common+import Logs+import Logs.MapLog+import qualified Annex.Branch++import Data.Time.Clock.POSIX+import qualified Data.Map as M++type ConfigName = String+type ConfigValue = String++setGlobalConfig :: ConfigName -> ConfigValue -> Annex ()+setGlobalConfig name new = do+	curr <- getGlobalConfig name+	when (curr /= Just new) $+		setGlobalConfig' name new++setGlobalConfig' :: ConfigName -> ConfigValue -> Annex ()+setGlobalConfig' name new = do+	now <- liftIO getPOSIXTime+	Annex.Branch.change configLog $ +		showMapLog id id . changeMapLog now name new . parseGlobalConfig++unsetGlobalConfig :: ConfigName -> Annex ()+unsetGlobalConfig name = do+	curr <- getGlobalConfig name+	when (curr /= Nothing) $+		setGlobalConfig' name "" -- set to empty string to unset++-- Reads the global config log every time.+getGlobalConfig :: ConfigName -> Annex (Maybe ConfigValue)+getGlobalConfig name = M.lookup name <$> loadGlobalConfig++parseGlobalConfig :: String -> MapLog ConfigName ConfigValue+parseGlobalConfig = parseMapLog Just Just++loadGlobalConfig :: Annex (M.Map ConfigName ConfigValue)+loadGlobalConfig = M.filter (not . null) . simpleMap . parseGlobalConfig+	<$> Annex.Branch.get configLog
Logs/NumCopies.hs view
@@ -24,7 +24,10 @@ 	deserialize = NumCopies <$$> readish  setGlobalNumCopies :: NumCopies -> Annex ()-setGlobalNumCopies = setLog numcopiesLog+setGlobalNumCopies new = do+	curr <- getGlobalNumCopies+	when (curr /= Just new) $+		setLog numcopiesLog new  {- Value configured in the numcopies log. Cached for speed. -} getGlobalNumCopies :: Annex (Maybe NumCopies)
Logs/Transfer.hs view
@@ -268,7 +268,7 @@ 	filename 		| end rest == "\n" = beginning rest 		| otherwise = rest-	bits = split " " firstline+	bits = splitc ' ' firstline 	numbits = length bits 	time = if numbits > 0 		then Just <$> parsePOSIXTime =<< headMaybe bits
Logs/UUID.hs view
@@ -66,7 +66,7 @@ 	newertime (LogEntry (Date d) _) = d + minimumPOSIXTimeSlice 	newertime (LogEntry Unknown _) = minimumPOSIXTimeSlice 	minimumPOSIXTimeSlice = 0.000001-	isuuid s = length s == 36 && length (split "-" s) == 5+	isuuid s = length s == 36 && length (splitc '-' s) == 5  {- Records the uuid in the log, if it's not already there. -} recordUUID :: UUID -> Annex ()
Remote.hs view
@@ -140,7 +140,7 @@ byNameOrGroup :: RemoteName -> Annex [Remote] byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." ++ n))   where-	go (Just l) = catMaybes <$> mapM (byName . Just) (split " " l)+	go (Just l) = catMaybes <$> mapM (byName . Just) (splitc ' ' l) 	go Nothing = maybeToList <$> byName (Just n)  {- Only matches remote name, not UUID -}
Remote/BitTorrent.hs view
@@ -302,7 +302,7 @@ 		=<< ariaParams ps  parseAriaProgress :: Integer -> ProgressParser-parseAriaProgress totalsize = go [] . reverse . split ['\r']+parseAriaProgress totalsize = go [] . reverse . splitc '\r'   where 	go remainder [] = (Nothing, remainder) 	go remainder (x:xs) = case readish (findpercent x) of
Remote/Bup.hs view
@@ -90,8 +90,8 @@ 		{ chunkConfig = NoChunks 		} -bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-bupSetup mu _ c gc = do+bupSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+bupSetup _ mu _ c gc = do 	u <- maybe (liftIO genUUID) return mu  	-- verify configuration is sane@@ -254,7 +254,7 @@ 			else giveup "please specify an absolute path" 	| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir   where-	bits = split ":" r+	bits = splitc ':' r 	host = Prelude.head bits 	dir = intercalate ":" $ drop 1 bits 	-- "host:~user/dir" is not supported specially by bup;
Remote/Ddar.hs view
@@ -82,8 +82,8 @@ 		{ chunkConfig = NoChunks 		} -ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-ddarSetup mu _ c gc = do+ddarSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+ddarSetup _ mu _ c gc = do 	u <- maybe (liftIO genUUID) return mu  	-- verify configuration is sane
Remote/Directory.hs view
@@ -77,8 +77,8 @@   where 	dir = fromMaybe (giveup "missing directory") $ remoteAnnexDirectory gc -directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-directorySetup mu _ c gc = do+directorySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+directorySetup _ mu _ c gc = do 	u <- maybe (liftIO genUUID) return mu 	-- verify configuration is sane 	let dir = fromMaybe (giveup "Specify directory=") $
Remote/External.hs view
@@ -109,8 +109,8 @@ 			rmt 	externaltype = fromMaybe (giveup "missing externaltype") (remoteAnnexExternalType gc) -externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-externalSetup mu _ c gc = do+externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+externalSetup _ mu _ c gc = do 	u <- maybe (liftIO genUUID) return mu 	let externaltype = fromMaybe (giveup "Specify externaltype=") $ 		M.lookup "externaltype" c
Remote/GCrypt.hs view
@@ -169,8 +169,8 @@ unsupportedUrl :: a unsupportedUrl = giveup "using non-ssh remote repo url with gcrypt is not supported" -gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-gCryptSetup mu _ c gc = go $ M.lookup "gitrepo" c+gCryptSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c   where 	remotename = fromJust (M.lookup "name" c) 	go Nothing = giveup "Specify gitrepo="
Remote/Git.hs view
@@ -96,8 +96,8 @@  - No attempt is made to make the remote be accessible via ssh key setup,  - etc.  -}-gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-gitSetup Nothing _ c _ = do+gitSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+gitSetup Init mu _ c _ = do 	let location = fromMaybe (giveup "Specify location=url") $ 		Url.parseURIRelaxed =<< M.lookup "location" c 	g <- Annex.gitRepo@@ -105,8 +105,10 @@ 		[r] -> getRepoUUID r 		[] -> giveup "could not find existing git remote with specified location" 		_ -> giveup "found multiple git remotes with specified location"-	return (c, u)-gitSetup (Just u) _ c _ = do+	if isNothing mu || mu == Just u+		then return (c, u)+		else error "git remote did not have specified uuid"+gitSetup Enable (Just u) _ c _ = do 	inRepo $ Git.Command.run 		[ Param "remote" 		, Param "add"@@ -114,6 +116,7 @@ 		, Param $ fromMaybe (giveup "no location") (M.lookup "location" c) 		] 	return (c, u)+gitSetup Enable Nothing _ _ _ = error "unable to enable git remote with no specified uuid"  {- It's assumed to be cheap to read the config of non-URL remotes, so this is  - done each time git-annex is run in a way that uses remotes.
Remote/Glacier.hs view
@@ -78,16 +78,16 @@ 		{ chunkConfig = NoChunks 		} -glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-glacierSetup mu mcreds c gc = do+glacierSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+glacierSetup ss mu mcreds c gc = do 	u <- maybe (liftIO genUUID) return mu-	glacierSetup' (isJust mu) u mcreds c gc-glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-glacierSetup' enabling u mcreds c gc = do+	glacierSetup' ss u mcreds c gc+glacierSetup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+glacierSetup' ss u mcreds c gc = do 	(c', encsetup) <- encryptionSetup c gc 	c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds 	let fullconfig = c'' `M.union` defaults-	unless enabling $+	when (ss == Init) $ 		genVault fullconfig gc u 	gitConfigSpecialRemote u fullconfig "glacier" "true" 	return (fullconfig, u)
Remote/Helper/Encryptable.hs view
@@ -70,7 +70,7 @@ 			(map ("encryption=" ++) 				["none","shared","hybrid","pubkey", "sharedpubkey"]) 			++ "."-	key = fromMaybe (giveup "Specifiy keyid=...") $ M.lookup "keyid" c+	key = fromMaybe (giveup "Specify keyid=...") $ M.lookup "keyid" c 	newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++ 		maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c) 	cannotchange = giveup "Cannot set encryption type of existing remotes."@@ -165,7 +165,7 @@ 		Just $ SharedCipher (fromB64bs t) 	_ -> Nothing   where-	readkeys = KeyIds . split ","+	readkeys = KeyIds . splitc ','  describeEncryption :: RemoteConfig -> String describeEncryption c = case extractCipher c of
Remote/Hook.hs view
@@ -70,8 +70,8 @@   where 	hooktype = fromMaybe (giveup "missing hooktype") $ remoteAnnexHookType gc -hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-hookSetup mu _ c gc = do+hookSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+hookSetup _ mu _ c gc = do 	u <- maybe (liftIO genUUID) return mu 	let hooktype = fromMaybe (giveup "Specify hooktype=") $ 		M.lookup "hooktype" c
Remote/P2P.hs view
@@ -45,7 +45,7 @@ chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) chainGen addr r u c gc = do 	connpool <- mkConnectionPool-	cst <- remoteCost gc expensiveRemoteCost+	cst <- remoteCost gc veryExpensiveRemoteCost 	let this = Remote  		{ uuid = u 		, cost = cst
Remote/Rsync.hs view
@@ -137,8 +137,8 @@ 	loginopt = maybe [] (\l -> ["-l",l]) login 	fromNull as xs = if null xs then as else xs -rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-rsyncSetup mu _ c gc = do+rsyncSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+rsyncSetup _ mu _ c gc = do 	u <- maybe (liftIO genUUID) return mu 	-- verify configuration is sane 	let url = fromMaybe (giveup "Specify rsyncurl=") $
Remote/S3.hs view
@@ -7,6 +7,7 @@  {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}  module Remote.S3 (remote, iaHost, configIA, iaItemUrl) where@@ -106,12 +107,12 @@ 			, checkUrl = Nothing 			} -s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-s3Setup mu mcreds c gc = do+s3Setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+s3Setup ss mu mcreds c gc = do 	u <- maybe (liftIO genUUID) return mu-	s3Setup' (isNothing mu) u mcreds c gc-s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-s3Setup' new u mcreds c gc+	s3Setup' ss u mcreds c gc+s3Setup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+s3Setup' ss u mcreds c gc 	| configIA c = archiveorg 	| otherwise = defaulthost   where@@ -133,7 +134,7 @@ 		(c', encsetup) <- encryptionSetup c gc 		c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds 		let fullconfig = c'' `M.union` defaults-		when new $+		when (ss == Init) $ 			genBucket fullconfig gc u 		use fullconfig @@ -221,7 +222,7 @@ 						let popper = handlePopper numchunks defaultChunkSize p' fh 						let req = S3.uploadPart (bucket info) object partnum uploadid $ 							 RequestBodyStream (fromIntegral sz) popper-						S3.UploadPartResponse _ etag <- sendS3Handle h req+						S3.UploadPartResponse { S3.uprETag = etag } <- sendS3Handle h req 						sendparts (offsetMeterUpdate meter (toBytesProcessed sz)) (etag:etags) (partnum + 1) 			sendparts p [] 1 @@ -355,7 +356,8 @@  {- Writes the UUID to an annex-uuid file within the bucket.  -- - If the file already exists in the bucket, it must match.+ - If the file already exists in the bucket, it must match,+ - or this fails.  -  - Note that IA buckets can only created by having a file  - stored in them. So this also takes care of that.@@ -365,6 +367,9 @@ 	v <- checkUUIDFile c u info h 	case v of 		Right True -> noop+		Right False -> do+			warning "The bucket already exists, and its annex-uuid file indicates it is used by a different special remote."+			giveup "Cannot reuse this bucket." 		_ -> void $ sendS3Handle h mkobject   where 	file = T.pack $ uuidFile c@@ -375,15 +380,17 @@ {- Checks if the UUID file exists in the bucket  - and has the specified UUID already. -} checkUUIDFile :: RemoteConfig -> UUID -> S3Info -> S3Handle -> Annex (Either SomeException Bool)-checkUUIDFile c u info h = tryNonAsync $ check <$> get+checkUUIDFile c u info h = tryNonAsync $ liftIO $ runResourceT $ do+	resp <- tryS3 $ sendS3Handle' h (S3.getObject (bucket info) file)+	case resp of+		Left _ -> return False+		Right r -> do+			v <- AWS.loadToMemory r+			let !ok = check v+			return ok   where-	get = liftIO -		. runResourceT -		. either (pure . Left) (Right <$$> AWS.loadToMemory)-		=<< tryS3 (sendS3Handle h (S3.getObject (bucket info) file))-	check (Right (S3.GetObjectMemoryResponse _meta rsp)) =+	check (S3.GetObjectMemoryResponse _meta rsp) = 		responseStatus rsp == ok200 && responseBody rsp == uuidb-	check (Left _S3Error) = False  	file = T.pack $ uuidFile c 	uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u]@@ -391,6 +398,9 @@ uuidFile :: RemoteConfig -> FilePath uuidFile c = getFilePrefix c ++ "annex-uuid" +tryS3 :: ResourceT IO a -> ResourceT IO (Either S3.S3Error a)+tryS3 a = (Right <$> a) `catch` (pure . Left)+ data S3Handle = S3Handle  	{ hmanager :: Manager 	, hawscfg :: AWS.Configuration@@ -464,9 +474,6 @@ 		[(p, _)] -> p 		_ -> giveup $ "bad S3 port value: " ++ s 	cfg = S3.s3 proto endpoint False--tryS3 :: Annex a -> Annex (Either S3.S3Error a)-tryS3 a = (Right <$> a) `catch` (pure . Left)  data S3Info = S3Info 	{ bucket :: S3.Bucket
Remote/Tahoe.hs view
@@ -91,8 +91,8 @@ 		, checkUrl = Nothing 		} -tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-tahoeSetup mu _ c _ = do+tahoeSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+tahoeSetup _ mu _ c _ = do 	furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c) 		<$> liftIO (getEnv "TAHOE_FURL") 	u <- maybe (liftIO genUUID) return mu
Remote/WebDAV.hs view
@@ -86,8 +86,8 @@ 			} 		chunkconfig = getChunkConfig c -webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-webdavSetup mu mcreds c gc = do+webdavSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+webdavSetup _ mu mcreds c gc = do 	u <- maybe (liftIO genUUID) return mu 	url <- case M.lookup "url" c of 		Nothing -> giveup "Specify url="
Test.hs view
@@ -122,7 +122,7 @@ 		Just act -> ifM act 			( exitSuccess 			, do-				putStrLn "  (This could be due to a bug in git-annex, or an incompatability"+				putStrLn "  (This could be due to a bug in git-annex, or an incompatibility" 				putStrLn "   with utilities, such as git, installed on this system.)" 				exitFailure 			)@@ -366,8 +366,8 @@ 	git_annex "drop" ["--force", imported1, imported2, imported5] @? "drop failed" 	annexed_notpresent_imported imported2 	(toimportdup, importfdup, importeddup) <- mktoimport importdir "importdup"-	git_annex "import" ["--clean-duplicates", toimportdup] -		@? "import of missing duplicate with --clean-duplicates failed"+	not <$> git_annex "import" ["--clean-duplicates", toimportdup] +		@? "import of missing duplicate with --clean-duplicates failed to fail" 	checkdoesnotexist importeddup 	checkexists importfdup   where@@ -452,7 +452,7 @@ 	git_annex "untrust" ["origin"] @? "untrust of origin failed" 	git_annex "get" [annexedfile] @? "get failed" 	annexed_present annexedfile-	not <$> git_annex "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file"+	not <$> git_annex "drop" [annexedfile] @? "drop wrongly succeeded with only an untrusted copy of the file" 	annexed_present annexedfile 	inmainrepo $ annexed_present annexedfile 
Types/GitConfig.hs view
@@ -6,8 +6,10 @@  -}  module Types.GitConfig ( +	Configurable(..), 	GitConfig(..), 	extractGitConfig,+	mergeGitConfig, 	RemoteGitConfig(..), 	extractRemoteGitConfig, ) where@@ -29,6 +31,15 @@ import Utility.Gpg (GpgCmd, mkGpgCmd) import Utility.ThreadScheduler (Seconds(..)) +-- | A configurable value, that may not be fully determined yet.+data Configurable a+	= HasConfig a+	-- ^ Value is fully determined.+	| DefaultConfig a+	-- ^ A default value is known, but not all config sources+	-- have been read yet.+	deriving (Show)+ {- Main git-annex settings. Each setting corresponds to a git-config key  - such as annex.foo -} data GitConfig = GitConfig@@ -46,7 +57,8 @@ 	, annexDelayAdd :: Maybe Int 	, annexHttpHeaders :: [String] 	, annexHttpHeadersCommand :: Maybe String-	, annexAutoCommit :: Bool+	, annexAutoCommit :: Configurable Bool+	, annexSyncContent :: Configurable Bool 	, annexDebug :: Bool 	, annexWebOptions :: [String] 	, annexQuviOptions :: [String]@@ -93,7 +105,10 @@ 	, annexDelayAdd = getmayberead (annex "delayadd") 	, annexHttpHeaders = getlist (annex "http-headers") 	, annexHttpHeadersCommand = getmaybe (annex "http-headers-command")-	, annexAutoCommit = getbool (annex "autocommit") True+	, annexAutoCommit = configurable True $ +		getmaybebool (annex "autocommit")+	, annexSyncContent = configurable False $ +		getmaybebool (annex "synccontent") 	, annexDebug = getbool (annex "debug") False 	, annexWebOptions = getwords (annex "web-options") 	, annexQuviOptions = getwords (annex "quvi-options")@@ -133,9 +148,26 @@ 	getlist k = Git.Config.getList k r 	getwords k = fromMaybe [] $ words <$> getmaybe k +	configurable d Nothing = DefaultConfig d+	configurable _ (Just v) = HasConfig v+ 	annex k = "annex." ++ k 			 	onemegabyte = 1000000++{- Merge a GitConfig that comes from git-config with one containing+ - repository-global defaults. -}+mergeGitConfig :: GitConfig -> GitConfig -> GitConfig+mergeGitConfig gitconfig repoglobals = gitconfig+	{ annexAutoCommit = merge annexAutoCommit+	, annexSyncContent = merge annexSyncContent+	}+  where+	merge f = case f gitconfig of+		HasConfig v -> HasConfig v+		DefaultConfig d -> case f repoglobals of+			HasConfig v -> HasConfig v+			DefaultConfig _ -> HasConfig d  {- Per-remote git-annex settings. Each setting corresponds to a git-config  - key such as <remote>.annex-foo, or if that is not set, a default from
Types/RefSpec.hs view
@@ -25,7 +25,7 @@ allRefSpec = [AddMatching $ compileGlob "*" CaseSensative]  parseRefSpec :: String -> Either String RefSpec-parseRefSpec v = case partitionEithers (map mk $ split ":" v) of+parseRefSpec v = case partitionEithers (map mk $ splitc ':' v) of 	([],refspec) -> Right refspec 	(e:_,_) -> Left e   where
Types/Remote.hs view
@@ -14,6 +14,7 @@ 	, RemoteConfig 	, RemoteTypeA(..) 	, RemoteA(..)+	, SetupStage(..) 	, Availability(..) 	, Verification(..) 	, unVerified@@ -38,8 +39,12 @@ import Utility.Url  type RemoteConfigKey = String+ type RemoteConfig = M.Map RemoteConfigKey String +data SetupStage = Init | Enable+	deriving (Eq)+ {- There are different types of remotes. -} data RemoteTypeA a = RemoteType { 	-- human visible type name@@ -49,8 +54,8 @@ 	enumerate :: Bool -> a [Git.Repo], 	-- generates a remote of this type 	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)),-	-- initializes or changes a remote-	setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID)+	-- initializes or enables a remote+	setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID) }  instance Eq (RemoteTypeA a) where
Upgrade/V1.hs view
@@ -148,7 +148,7 @@ 		, keyMtime = t 		}   where-	bits = split ":" v+	bits = splitc ':' v 	b = Prelude.head bits 	n = intercalate ":" $ drop (if wormy then 3 else 1) bits 	t = if wormy
Utility/DottedVersion.hs view
@@ -25,7 +25,7 @@ normalize :: String -> DottedVersion normalize v = DottedVersion v $  	sum $ mult 1 $ reverse $ extend precision $ take precision $-		map readi $ split "." v+		map readi $ splitc '.' v   where 	extend n l = l ++ replicate (n - length l) 0 	mult _ [] = []
Utility/FileMode.hs view
@@ -1,6 +1,6 @@ {- File mode utilities.  -- - Copyright 2010-2012 Joey Hess <id@joeyh.name>+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -129,6 +129,21 @@ #else withUmask _ a = a #endif++getUmask :: IO FileMode+#ifndef mingw32_HOST_OS+getUmask = bracket setup cleanup return+  where+	setup = setFileCreationMask nullFileMode+	cleanup = setFileCreationMask+#else+getUmask = return nullFileMode+#endif++defaultFileMode :: IO FileMode+defaultFileMode = do+	umask <- getUmask+	return $ intersectFileModes (complement umask) stdFileMode  combineModes :: [FileMode] -> FileMode combineModes [] = 0
Utility/Gpg.hs view
@@ -162,7 +162,7 @@ findPubKeys cmd for = KeyIds . parse . lines <$> readStrict cmd params   where 	params = [Param "--with-colons", Param "--list-public-keys", Param for]-	parse = mapMaybe (keyIdField . split ":")+	parse = mapMaybe (keyIdField . splitc ':') 	keyIdField ("pub":_:_:_:f:_) = Just f 	keyIdField _ = Nothing @@ -175,7 +175,7 @@   where 	makemap = M.fromList . parse . lines <$> readStrict cmd params 	params = [Param "--with-colons", Param "--list-secret-keys", Param "--fixed-list-mode"]-	parse = extract [] Nothing . map (split ":")+	parse = extract [] Nothing . map (splitc ':') 	extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) = 		extract ((keyid, decode_c userid):c) Nothing rest 	extract c (Just keyid) rest@(("sec":_):_) =
Utility/LockFile/PidLock.hs view
@@ -150,14 +150,30 @@ -- open(2) suggests that link can sometimes appear to fail -- on NFS but have actually succeeded, and the way to find out is to stat -- the file and check its link count etc.+--+-- However, not all filesystems support hard links. So, first probe+-- to see if they are supported. If not, use open with O_EXCL. linkToLock :: SideLockHandle -> FilePath -> FilePath -> IO Bool linkToLock Nothing _ _ = return False linkToLock (Just _) src dest = do-	_ <- tryIO $ createLink src dest-	ifM (catchBoolIO checklinked)-		( catchBoolIO $ not <$> checkInsaneLustre dest-		, return False-		)+	let probe = src ++ ".lnk"+	v <- tryIO $ createLink src probe+	nukeFile probe+	case v of+		Right _ -> do+			_ <- tryIO $ createLink src dest+			ifM (catchBoolIO checklinked)+				( catchBoolIO $ not <$> checkInsaneLustre dest+				, return False+				)+		Left _ -> catchBoolIO $ do+			fd <- openFd dest WriteOnly+				(Just $ combineModes readModes)+				(defaultFileFlags {exclusive = True})+			h <- fdToHandle fd+			readFile src >>= hPutStr h+			hClose h+			return True   where 	checklinked = do 		x <- getSymbolicLinkStatus src
Utility/LockFile/Windows.hs view
@@ -38,7 +38,7 @@ {- Windows considers just opening a file enough to lock it. This will  - create the LockFile if it does not already exist.  -- - Will fail if the file is already open with an incompatable ShareMode.+ - Will fail if the file is already open with an incompatible ShareMode.  - Note that this may happen if an unrelated process, such as a virus  - scanner, even looks at the file. See http://support.microsoft.com/kb/316609  -
Utility/Lsof.hs view
@@ -107,7 +107,7 @@ 	parsemode ('u':_) = OpenReadWrite 	parsemode _ = OpenUnknown -	splitnull = split "\0"+	splitnull = splitc '\0'  	parsefail = error $ "failed to parse lsof output: " ++ show s 
Utility/MagicWormhole.hs view
@@ -18,6 +18,7 @@ 	waitCode, 	sendCode, 	WormHoleParams,+	appId, 	sendFile, 	receiveFile, 	isInstalled,@@ -86,6 +87,11 @@ sendCode (CodeProducer p) = putMVar p  type WormHoleParams = [CommandParam]++-- | An appid should be provided when using wormhole in an app, to avoid+-- using the same channel space as ad-hoc wormhole users.+appId :: String -> WormHoleParams+appId s = [Param "--appid", Param s]  -- | Sends a file. Once the send is underway, and the Code has been -- generated, it will be sent to the CodeObserver. (This may not happen,
Utility/Misc.hs view
@@ -45,6 +45,14 @@ 		| null b = r 		| otherwise = (a, tail b) +{- Split on a single character. This is over twice as fast as using+ - Data.List.Utils.split on a list of length 1, while producing+ - identical results. -}+splitc :: Char -> String -> [String]+splitc c s = case break (== c) s of+	(i, _c:rest) -> i : splitc c rest+	(i, []) -> i : []+ {- Breaks out the first line. -} firstLine :: String -> String firstLine = takeWhile (/= '\n')
Utility/PartialPrelude.hs view
@@ -2,7 +2,7 @@  - bugs.  -  - This exports functions that conflict with the prelude, which avoids- - them being accidentially used.+ - them being accidentally used.  -}  {-# OPTIONS_GHC -fno-warn-tabs #-}
Utility/Quvi.hs view
@@ -124,14 +124,14 @@ 		Nothing -> return False 		Just auth -> do 			let domain = map toLower $ uriRegName auth-			let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ split "." domain+			let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ splitc '.' domain 			any (\h -> domain `isSuffixOf` h || basedomain `isSuffixOf` h)  				. map (map toLower) <$> listdomains Quvi09 	secondlevel = snd <$> processTranscript "quvi" 		(toCommand [Param "dump", Param "-o", Param url]) Nothing  listdomains :: QuviVersion -> IO [String]-listdomains Quvi09 = concatMap (split ",") +listdomains Quvi09 = concatMap (splitc ',')  	. concatMap (drop 1 . words)  	. filter ("domains: " `isPrefixOf`) . lines 	<$> readQuvi (toCommand [Param "info", Param "-p", Param "domains"])
Utility/Rsync.hs view
@@ -24,7 +24,7 @@ 	{- rsync requires some weird, non-shell like quoting in 	- here. A doubled single quote inside the single quoted 	- string is a single quote. -}-	escape s = "'" ++  intercalate "''" (split "'" s) ++ "'"+	escape s = "'" ++  intercalate "''" (splitc '\'' s) ++ "'"  {- Runs rsync in server mode to send a file. -} rsyncServerSend :: [CommandParam] -> FilePath -> IO Bool@@ -123,7 +123,7 @@ 	{- Find chunks that each start with delim. 	 - The first chunk doesn't start with it 	 - (it's empty when delim is at the start of the string). -}-	progresschunks = drop 1 . split [delim]+	progresschunks = drop 1 . splitc delim 	findbytesstart s = dropWhile isSpace s  	parsebytes :: String -> Maybe Integer
Utility/SafeCommand.hs view
@@ -11,7 +11,7 @@  import System.Exit import Utility.Process-import Data.String.Utils+import Utility.Misc import System.FilePath import Data.Char import Data.List@@ -86,7 +86,7 @@ shellEscape f = "'" ++ escaped ++ "'"   where 	-- replace ' with '"'"'-	escaped = intercalate "'\"'\"'" $ split "'" f+	escaped = intercalate "'\"'\"'" $ splitc '\'' f  -- | Unescapes a set of shellEscaped words or filenames. shellUnEscape :: String -> [String]
doc/git-annex-adjust.mdwn view
@@ -20,7 +20,7 @@ usual. Any commits that you make will initially only be made to the adjusted branch.  -To propigate changes from the adjusted branch back to the original branch,+To propagate changes from the adjusted branch back to the original branch, and to other repositories, as well as to merge in changes from other repositories, use `git annex sync`. 
doc/git-annex-import.mdwn view
@@ -33,10 +33,9 @@    Do not delete files from the import location. -  This could allow importing the same files repeatedly-  to different locations in a repository. More likely, it could be used to-  import the same files to a number of different branches or separate git-  repositories.+  Running with this option repeatedly can import the same files into+  different git repositories, or branches, or different locations in a git+  repository.  * `--deduplicate` @@ -45,13 +44,19 @@  * `--skip-duplicates` -  Only import files that are not duplicates; and avoid deleting-  duplicate files from the import location.+  Only import files that are not duplicates. Avoids deleting any+  files from the import location.  * `--clean-duplicates`    Does not import any files, but any files found in the import location   that are duplicates are deleted.++* `--reinject-duplicates`++  Imports files that are not duplicates. Files that are duplicates have+  their content reinjected into the annex (similar to+  [[git-annex-reinject]]).  * `--force` 
doc/git-annex-initremote.mdwn view
@@ -33,6 +33,12 @@ course, this works best when the special remote does not need anything special to be done to get it enabled. +Normally, git-annex generates a new UUID for the new special remote.+If you want to, you can specify a UUID for it to use, by passing a+uuid=whatever parameter. This can be useful in some situations, eg when the+same data can be accessed via two different special remote backends.+But if in doubt, don't do this.+ # OPTIONS  * `--fast`
doc/git-annex-numcopies.mdwn view
@@ -9,9 +9,12 @@ # DESCRIPTION  Tells git-annex how many copies it should preserve of files, over all-repositories. The default is 1.+repositories. The default is 1.   Run without a number to get the current value.++This configuration is stored in the git-annex branch, so it will be seen+by all clones of the repository.  When git-annex is asked to drop a file, it first verifies that the required number of copies can be satisfied among all the other
doc/git-annex-reinit.mdwn view
@@ -14,9 +14,12 @@ setting it back up.  Use this with caution; it can be confusing to have two existing-repositories with the same UUID. Also, you will probably want to run-a fsck.+repositories with the same UUID.  +Make sure you run `git annex fsck` after changing the UUID of a+repository to make sure location tracking information is recorded+correctly.+ Like `git annex init`, this attempts to enable any special remotes that are configured with autoenable=true. @@ -25,6 +28,8 @@ [[git-annex]](1)  [[git-annex-init]](1)++[[git-annex-fsck]](1)  # AUTHOR 
doc/git-annex-shell.mdwn view
@@ -149,7 +149,7 @@  Obviously, `ssh-rsa AAAAB3NzaC1y[...] user@example.com` needs to replaced with your SSH key. The above also assumes `git-annex-shell`-is availble in your `$PATH`, use an absolute path if it is not the+is available in your `$PATH`, use an absolute path if it is not the case.  # SEE ALSO
doc/git-annex-sync.mdwn view
@@ -42,7 +42,9 @@  * `--commit`, `--no-commit` -  A commit is done by default. Use --no-commit to avoid committing local changes.+  A commit is done by default (unless annex.autocommit is set to false).+  +  Use --no-commit to avoid committing local changes.  * `--message=msg` @@ -60,7 +62,10 @@    Normally, syncing does not transfer the contents of annexed files.   The --content option causes the content of files in the work tree-  to also be uploaded and downloaded as necessary.  +  to also be uploaded and downloaded as necessary.++  The annex.synccontent configuration can be set to true to make content+  be synced by default.    Normally this tries to get each annexed file in the work tree   that the local repository  does not yet have, and then copies each
doc/git-annex-vicfg.mdwn view
@@ -1,6 +1,6 @@ # NAME -git-annex vicfg - edit git-annex's configuration+git-annex vicfg - edit configuration in git-annex branch  # SYNOPSIS @@ -8,13 +8,18 @@  # DESCRIPTION -Opens EDITOR on a temp file containing all of git-annex's global -configuration settings, and when it exits, stores any-changes made back to the git-annex branch.+Opens EDITOR on a temp file containing all of git-annex's +configuration settings that are stored in the git-annex branch, +and when it exits, stores any changes made back to the git-annex branch. +Unlike git config settings, these configuration settings can be seen+by all clones of the repository.+ # SEE ALSO  [[git-annex]](1)++git-config(1)  # AUTHOR 
doc/git-annex.mdwn view
@@ -280,6 +280,12 @@    See [[git-annex-schedule]](1) for details. +* `config`++  Get and set other configuration stored in git-annex branch.+  +  See [[git-annex-config]](1) for details.+ * `vicfg`    Opens EDITOR on a temp file containing most of the above configuration@@ -999,6 +1005,16 @@    Set to false to prevent the git-annex assistant and git-annex sync   from automatically committing changes to files in the repository.++  To configure the behavior in all clones of the repository,+  this can be set in [[git-annex-config]].++* `annex.synccontent`++  Set to true to make git-annex sync default to syncing content.++  To configure the behavior in all clones of the repository,+  this can be set in [[git-annex-config]].  * `annex.startupscan` 
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 6.20170101+Version: 6.20170214 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -694,6 +694,7 @@     Command.CalcKey     Command.CheckPresentKey     Command.Commit+    Command.Config     Command.ConfigList     Command.ContentLocation     Command.Copy@@ -792,10 +793,12 @@     Config     Config.Cost     Config.Files+    Config.GitConfig     Creds     Crypto     Database.Fsck     Database.Handle+    Database.Init     Database.Keys     Database.Keys.Handle     Database.Keys.SQL@@ -850,6 +853,7 @@     Logs.Activity     Logs.Chunk     Logs.Chunk.Pure+    Logs.Config     Logs.Difference     Logs.Difference.Pure     Logs.FsckResults
stack.yaml view
@@ -17,9 +17,12 @@     androidsplice: false packages: - '.'-resolver: lts-5.18 extra-deps:-- process-1.3.0.0-- concurrent-output-1.7.7+- esqueleto-2.5.1+- yesod-default-1.2.0+- bloomfilter-2.0.1.0+- network-multicast-0.2.0+- torrent-10000.0.1 explicit-setup-deps:   git-annex: true+resolver: lts-7.18