git-annex 6.20170101 → 6.20170214
raw patch · 97 files changed
+853/−306 lines, 97 files
Files
- Annex/Branch.hs +2/−2
- Annex/Direct.hs +2/−2
- Annex/Ingest.hs +19/−12
- Annex/Init.hs +1/−1
- Annex/Perms.hs +1/−1
- Annex/SpecialRemote.hs +2/−2
- Annex/TaggedPush.hs +1/−1
- Assistant/MakeRemote.hs +8/−8
- Assistant/Ssh.hs +1/−1
- Assistant/Threads/Committer.hs +1/−1
- Assistant/Threads/PairListener.hs +2/−2
- Assistant/Threads/Watcher.hs +2/−1
- Assistant/WebApp/Configurators/Edit.hs +2/−1
- Assistant/WebApp/RepoList.hs +2/−2
- Backend/Hash.hs +1/−1
- Build/OSXMkLibs.hs +2/−1
- CHANGELOG +65/−6
- CmdLine/GitAnnex.hs +2/−0
- CmdLine/GitAnnex/Options.hs +1/−1
- Command/AddUrl.hs +1/−1
- Command/Assistant.hs +35/−13
- Command/Config.hs +65/−0
- Command/Direct.hs +1/−1
- Command/EnableRemote.hs +1/−1
- Command/Import.hs +80/−29
- Command/InitRemote.hs +7/−1
- Command/Map.hs +1/−1
- Command/P2P.hs +25/−2
- Command/Reinject.hs +12/−13
- Command/Smudge.hs +1/−1
- Command/Sync.hs +32/−17
- Command/Unannex.hs +1/−1
- Command/Unused.hs +2/−4
- Command/Vicfg.hs +39/−2
- Config.hs +3/−2
- Config/GitConfig.hs +36/−0
- Crypto.hs +2/−2
- Database/Fsck.hs +3/−13
- Database/Handle.hs +0/−21
- Database/Init.hs +55/−0
- Database/Keys.hs +2/−6
- Database/Queue.hs +0/−1
- Git/Command.hs +4/−4
- Git/Config.hs +1/−1
- Git/Construct.hs +2/−2
- Git/DiffTree.hs +14/−15
- Git/Ref.hs +1/−1
- Limit.hs +1/−1
- Logs.hs +3/−0
- Logs/Config.hs +55/−0
- Logs/NumCopies.hs +4/−1
- Logs/Transfer.hs +1/−1
- Logs/UUID.hs +1/−1
- Remote.hs +1/−1
- Remote/BitTorrent.hs +1/−1
- Remote/Bup.hs +3/−3
- Remote/Ddar.hs +2/−2
- Remote/Directory.hs +2/−2
- Remote/External.hs +2/−2
- Remote/GCrypt.hs +2/−2
- Remote/Git.hs +7/−4
- Remote/Glacier.hs +6/−6
- Remote/Helper/Encryptable.hs +2/−2
- Remote/Hook.hs +2/−2
- Remote/P2P.hs +1/−1
- Remote/Rsync.hs +2/−2
- Remote/S3.hs +25/−18
- Remote/Tahoe.hs +2/−2
- Remote/WebDAV.hs +2/−2
- Test.hs +4/−4
- Types/GitConfig.hs +34/−2
- Types/RefSpec.hs +1/−1
- Types/Remote.hs +7/−2
- Upgrade/V1.hs +1/−1
- Utility/DottedVersion.hs +1/−1
- Utility/FileMode.hs +16/−1
- Utility/Gpg.hs +2/−2
- Utility/LockFile/PidLock.hs +21/−5
- Utility/LockFile/Windows.hs +1/−1
- Utility/Lsof.hs +1/−1
- Utility/MagicWormhole.hs +6/−0
- Utility/Misc.hs +8/−0
- Utility/PartialPrelude.hs +1/−1
- Utility/Quvi.hs +2/−2
- Utility/Rsync.hs +2/−2
- Utility/SafeCommand.hs +2/−2
- doc/git-annex-adjust.mdwn +1/−1
- doc/git-annex-import.mdwn +11/−6
- doc/git-annex-initremote.mdwn +6/−0
- doc/git-annex-numcopies.mdwn +4/−1
- doc/git-annex-reinit.mdwn +7/−2
- doc/git-annex-shell.mdwn +1/−1
- doc/git-annex-sync.mdwn +7/−2
- doc/git-annex-vicfg.mdwn +9/−4
- doc/git-annex.mdwn +16/−0
- git-annex.cabal +5/−1
- stack.yaml +6/−3
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